version 1.105, 2002/06/02 10:31:28
|
version 1.106, 2002/06/02 15:46:16
|
Line 312 defer inst-stream-f ( -- stack )
|
Line 312 defer inst-stream-f ( -- stack )
|
item-stack @ stack-type @ type-c-name 2@ ; |
item-stack @ stack-type @ type-c-name 2@ ; |
|
|
: fetch-single ( item -- ) |
: fetch-single ( item -- ) |
\ fetch a single stack item from its stack |
\ fetch a single stack item from its stack |
>r |
>r |
r@ item-name 2@ type |
." vm_" r@ item-stack-type-name type |
." = vm_" r@ item-stack-type-name type |
." 2" r@ item-type @ print-type-prefix ." (" |
." 2" r@ item-type @ print-type-prefix ." (" |
r@ item-in-index r@ item-stack @ stack-access ." ," |
r@ item-in-index r@ item-stack @ stack-access |
r@ item-name 2@ type |
." );" cr |
." );" cr |
rdrop ; |
rdrop ; |
|
|
: fetch-double ( item -- ) |
: fetch-double ( item -- ) |
\ fetch a double stack item from its stack |
\ fetch a double stack item from its stack |
>r |
>r |
." vm_two" |
." vm_two" |
r@ item-stack-type-name type ." 2" |
r@ item-stack-type-name type ." 2" |
r@ item-type @ print-type-prefix ." (" |
r@ item-type @ print-type-prefix ." (" |
r@ item-name 2@ type ." , " |
r@ item-in-index r@ item-stack @ 2dup ." (Cell)" stack-access |
r@ item-in-index r@ item-stack @ 2dup ." (Cell)" stack-access |
." , " -1 under+ ." (Cell)" stack-access |
." , " -1 under+ ." (Cell)" stack-access |
." , " r@ item-name 2@ type |
." );" cr |
." )" cr |
rdrop ; |
rdrop ; |
|
|
: same-as-in? ( item -- f ) |
: same-as-in? ( item -- f ) |
\ f is true iff the offset and stack of item is the same as on input |
\ f is true iff the offset and stack of item is the same as on input |
Line 355 defer inst-stream-f ( -- stack )
|
Line 355 defer inst-stream-f ( -- stack )
|
>r r@ item-stack @ stack-out @ r> item-offset @ - 1- ; |
>r r@ item-stack @ stack-out @ r> item-offset @ - 1- ; |
|
|
: really-store-single ( item -- ) |
: really-store-single ( item -- ) |
>r |
>r |
r@ item-out-index r@ item-stack @ stack-access ." = vm_" |
." vm_" |
r@ item-type @ print-type-prefix ." 2" |
r@ item-type @ print-type-prefix ." 2" |
r@ item-stack-type-name type ." (" |
r@ item-stack-type-name type ." (" |
r@ item-name 2@ type ." );" |
r@ item-name 2@ type ." ," |
rdrop ; |
r@ item-out-index r@ item-stack @ stack-access ." );" |
|
rdrop ; |
|
|
: store-single ( item -- ) |
: store-single ( item -- ) |
>r |
>r |
Line 385 defer inst-stream-f ( -- stack )
|
Line 386 defer inst-stream-f ( -- stack )
|
r@ item-name 2@ type ." , " |
r@ item-name 2@ type ." , " |
r@ item-out-index r@ item-stack @ 2dup stack-access |
r@ item-out-index r@ item-stack @ 2dup stack-access |
." , " -1 under+ stack-access |
." , " -1 under+ stack-access |
." );" cr |
." )" cr |
rdrop ; |
rdrop ; |
|
|
: single ( -- xt1 xt2 n ) |
: single ( -- xt1 xt2 n ) |
Line 673 stack inst-stream IP Cell
|
Line 674 stack inst-stream IP Cell
|
: disasm-arg { item -- } |
: disasm-arg { item -- } |
item item-stack @ inst-stream = if |
item item-stack @ inst-stream = if |
." fputc(' ', vm_out); " |
." fputc(' ', vm_out); " |
." printarg_" item item-type @ print-type-prefix |
\ !! change this to first convert args to the right type and |
|
\ then print them |
|
." /* printarg_" item item-type @ print-type-prefix |
." ((" item item-type @ type-c-name 2@ type ." )" |
." ((" item item-type @ type-c-name 2@ type ." )" |
." ip[" item item-offset @ 1+ 0 .r ." ]);" cr |
." ip[" item item-offset @ 1+ 0 .r ." ]); */" cr |
endif ; |
endif ; |
|
|
: disasm-args ( -- ) |
: disasm-args ( -- ) |
Line 683 stack inst-stream IP Cell
|
Line 686 stack inst-stream IP Cell
|
|
|
: output-disasm ( -- ) |
: output-disasm ( -- ) |
\ generate code for disassembling VM instructions |
\ generate code for disassembling VM instructions |
." if (ip[0] == prim[" function-number @ 0 .r ." ]) {" cr |
." if (VM_IS_INST(*ip, " function-number @ 0 .r ." )) {" cr |
." fputs(" quote prim prim-name 2@ type quote ." , vm_out);" cr |
." fputs(" quote prim prim-name 2@ type quote ." , vm_out);" cr |
disasm-args |
disasm-args |
." ip += " inst-stream stack-in @ 1+ 0 .r ." ;" cr |
." ip += " inst-stream stack-in @ 1+ 0 .r ." ;" cr |