version 1.75, 2001/01/24 13:53:32
|
version 1.77, 2001/02/06 16:53:06
|
Line 50 warnings off
|
Line 50 warnings off
|
include ./search.fs |
include ./search.fs |
include ./extend.fs |
include ./extend.fs |
[THEN] |
[THEN] |
|
include ./stuff.fs |
|
|
[IFUNDEF] environment? |
[IFUNDEF] environment? |
include ./environ.fs |
include ./environ.fs |
Line 178 create stacks max-stacks cells allot \ a
|
Line 179 create stacks max-stacks cells allot \ a
|
i xt execute |
i xt execute |
item% %size +loop ; |
item% %size +loop ; |
|
|
|
\ types |
|
|
|
: print-type-prefix ( type -- ) |
|
body> >head name>string type ; |
|
|
\ various variables for storing stuff of one primitive |
\ various variables for storing stuff of one primitive |
|
|
struct% |
struct% |
Line 257 Variable function-number 0 function-numb
|
Line 263 Variable function-number 0 function-numb
|
\ fetch a single stack item from its stack |
\ fetch a single stack item from its stack |
>r |
>r |
r@ item-name 2@ type |
r@ item-name 2@ type |
." = (" |
." = vm_" r@ item-stack @ stack-type @ type-c-name 2@ type |
r@ item-type @ type-c-name 2@ type ." ) " |
." 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 |
." ;" cr |
." );" cr |
rdrop ; |
rdrop ; |
|
|
: fetch-double ( item -- ) |
: fetch-double ( item -- ) |
Line 296 Variable function-number 0 function-numb
|
Line 302 Variable function-number 0 function-numb
|
|
|
: really-store-single ( item -- ) |
: really-store-single ( item -- ) |
>r |
>r |
r@ item-out-index r@ item-stack @ stack-access ." = " |
r@ item-out-index r@ item-stack @ stack-access ." = vm_" |
r@ item-stack @ stack-cast 2@ type |
r@ item-type @ print-type-prefix ." 2" |
r@ item-name 2@ type ." ;" |
r@ item-stack @ stack-type @ type-c-name 2@ type ." (" |
|
r@ item-name 2@ type ." );" |
rdrop ; |
rdrop ; |
|
|
: store-single ( item -- ) |
: store-single ( item -- ) |
Line 422 s" Cell" single 0 create-type cell-type
|
Line 429 s" Cell" single 0 create-type cell-type
|
s" Float" single 0 create-type float-type |
s" Float" single 0 create-type float-type |
|
|
s" sp" save-mem cell-type s" (Cell)" make-stack data-stack |
s" sp" save-mem cell-type s" (Cell)" make-stack data-stack |
s" fp" save-mem cell-type s" " make-stack fp-stack |
s" fp" save-mem float-type s" " make-stack fp-stack |
s" rp" save-mem float-type s" (Cell)" make-stack return-stack |
s" rp" save-mem cell-type s" (Cell)" make-stack return-stack |
s" IP" save-mem cell-type s" error don't use # on results" make-stack inst-stream |
s" IP" save-mem cell-type s" error don't use # on results" make-stack inst-stream |
' inst-in-index inst-stream stack-in-index-xt ! |
' inst-in-index inst-stream stack-in-index-xt ! |
\ !! initialize stack-in and stack-out |
\ !! initialize stack-in and stack-out |
Line 530 s" IP" save-mem cell-type s" error don'
|
Line 537 s" IP" save-mem cell-type s" error don'
|
repeat |
repeat |
2drop type ; |
2drop type ; |
|
|
: print-type-prefix ( type -- ) |
|
body> >head .name ; |
|
|
|
: print-debug-arg { item -- } |
: print-debug-arg { item -- } |
." fputs(" quote space item item-name 2@ type ." =" quote ." , vm_out); " |
." fputs(" quote space item item-name 2@ type ." =" quote ." , vm_out); " |
." printarg_" item item-type @ print-type-prefix |
." printarg_" item item-type @ print-type-prefix |