version 1.98, 2001/06/16 22:53:36
|
version 1.105, 2002/06/02 10:31:28
|
Line 423 wordlist constant prefixes
|
Line 423 wordlist constant prefixes
|
stack r@ type-stack ! |
stack r@ type-stack ! |
rdrop ; |
rdrop ; |
|
|
: type-prefix ( xt1 xt2 n stack "prefix" -- ) |
: type-prefix ( addr u xt1 xt2 n stack "prefix" -- ) |
get-current >r prefixes set-current |
get-current >r prefixes set-current |
create-type r> set-current |
create-type r> set-current |
does> ( item -- ) |
does> ( item -- ) |
Line 647 stack inst-stream IP Cell
|
Line 647 stack inst-stream IP Cell
|
2drop type ; |
2drop type ; |
|
|
: print-entry ( -- ) |
: print-entry ( -- ) |
." I_" prim prim-c-name 2@ type ." :" ; |
." LABEL(" prim prim-c-name 2@ type ." ):" ; |
|
|
: output-c ( -- ) |
: output-c ( -- ) |
print-entry ." /* " prim prim-name 2@ type ." ( " prim prim-stack-string 2@ type ." ) */" cr |
print-entry ." /* " prim prim-name 2@ type ." ( " prim prim-stack-string 2@ type ." ) */" cr |
Line 693 stack inst-stream IP Cell
|
Line 693 stack inst-stream IP Cell
|
: output-profile ( -- ) |
: output-profile ( -- ) |
\ generate code for postprocessing the VM block profile stuff |
\ generate code for postprocessing the VM block profile stuff |
." if (VM_IS_INST(*ip, " function-number @ 0 .r ." )) {" cr |
." if (VM_IS_INST(*ip, " function-number @ 0 .r ." )) {" cr |
." add_inst(b, " quote prim prim-name 2@ type quote ." );" cr |
." add_inst(b, " quote prim prim-name 2@ type quote ." );" cr |
." ip += " inst-stream stack-in @ 1+ 0 .r ." ;" cr |
." ip += " inst-stream stack-in @ 1+ 0 .r ." ;" cr |
prim prim-c-code 2@ s" SET_IP" search nip nip |
prim prim-c-code 2@ s" SET_IP" search nip nip |
prim prim-c-code 2@ s" SUPER_END" search nip nip or if |
prim prim-c-code 2@ s" SUPER_END" search nip nip or if |
Line 703 stack inst-stream IP Cell
|
Line 703 stack inst-stream IP Cell
|
endif |
endif |
." }" cr ; |
." }" cr ; |
|
|
|
: output-profile-combined ( -- ) |
|
\ generate code for postprocessing the VM block profile stuff |
|
." if (VM_IS_INST(*ip, " function-number @ 0 .r ." )) {" cr |
|
num-combined @ 0 +do |
|
." add_inst(b, " quote |
|
combined-prims i th @ prim-name 2@ type |
|
quote ." );" cr |
|
loop |
|
." ip += " inst-stream stack-in @ 1+ 0 .r ." ;" cr |
|
combined-prims num-combined @ 1- th @ prim-c-code 2@ s" SET_IP" search nip nip |
|
combined-prims num-combined @ 1- th @ prim-c-code 2@ s" SUPER_END" search nip nip or if |
|
." return;" cr |
|
else |
|
." goto _endif_;" cr |
|
endif |
|
." }" cr ; |
|
|
|
: output-superend ( -- ) |
|
\ output flag specifying whether the current word ends a dynamic superinst |
|
prim prim-c-code 2@ s" SET_IP" search nip nip |
|
prim prim-c-code 2@ s" SUPER_END" search nip nip or 0<> |
|
prim prim-c-code 2@ s" SUPER_CONTINUE" search nip nip 0= and |
|
negate 0 .r ." , /* " prim prim-name 2@ type ." */" cr ; |
|
|
: gen-arg-parm { item -- } |
: gen-arg-parm { item -- } |
item item-stack @ inst-stream = if |
item item-stack @ inst-stream = if |
." , " item item-type @ type-c-name 2@ type space |
." , " item item-type @ type-c-name 2@ type space |
Line 767 stack inst-stream IP Cell
|
Line 791 stack inst-stream IP Cell
|
\ cr ; |
\ cr ; |
|
|
: output-label ( -- ) |
: output-label ( -- ) |
." (Label)&&I_" prim prim-c-name 2@ type ." ," cr ; |
." INST_ADDR(" prim prim-c-name 2@ type ." )," cr ; |
|
|
: output-alias ( -- ) |
: output-alias ( -- ) |
( primitive-number @ . ." alias " ) ." Primitive " prim prim-name 2@ type cr ; |
( primitive-number @ . ." alias " ) ." Primitive " prim prim-name 2@ type cr ; |
Line 799 stack inst-stream IP Cell
|
Line 823 stack inst-stream IP Cell
|
name-line @ 0 .r |
name-line @ 0 .r |
." ,0" cr ; |
." ,0" cr ; |
|
|
|
: output-vi-tag ( -- ) |
|
name-filename 2@ type #tab emit |
|
prim prim-name 2@ type #tab emit |
|
." /^" prim prim-name 2@ type ." *(/" cr ; |
|
|
[IFDEF] documentation |
[IFDEF] documentation |
: register-doc ( -- ) |
: register-doc ( -- ) |
prim prim-name 2@ documentation ['] create insert-wordlist |
prim prim-name 2@ documentation ['] create insert-wordlist |
Line 1216 Variable c-flag
|
Line 1245 Variable c-flag
|
line @ name-line ! filename 2@ name-filename 2! |
line @ name-line ! filename 2@ name-filename 2! |
function-number @ prim prim-num ! |
function-number @ prim prim-num ! |
start }} forth-ident {{ end 2dup prim prim-name 2! prim prim-c-name 2! }} white ++ |
start }} forth-ident {{ end 2dup prim prim-name 2! prim prim-c-name 2! }} white ++ |
|
(( ` / white ** {{ start }} c-ident {{ end prim prim-c-name 2! }} white ** )) ?? |
(( simple-primitive || combined-primitive )) {{ 1 function-number +! }} |
(( simple-primitive || combined-primitive )) {{ 1 function-number +! }} |
)) <- primitive ( -- ) |
)) <- primitive ( -- ) |
|
|