--- gforth/prims2x.fs 2001/06/16 22:53:36 1.98 +++ gforth/prims2x.fs 2002/02/10 14:02:25 1.104 @@ -647,7 +647,7 @@ stack inst-stream IP Cell 2drop type ; : print-entry ( -- ) - ." I_" prim prim-c-name 2@ type ." :" ; + ." LABEL(" prim prim-c-name 2@ type ." ):" ; : output-c ( -- ) print-entry ." /* " prim prim-name 2@ type ." ( " prim prim-stack-string 2@ type ." ) */" cr @@ -693,7 +693,7 @@ stack inst-stream IP Cell : output-profile ( -- ) \ generate code for postprocessing the VM block profile stuff ." 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 prim prim-c-code 2@ s" SET_IP" search nip nip prim prim-c-code 2@ s" SUPER_END" search nip nip or if @@ -703,6 +703,30 @@ stack inst-stream IP Cell endif ." }" 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 -- } item item-stack @ inst-stream = if ." , " item item-type @ type-c-name 2@ type space @@ -767,7 +791,7 @@ stack inst-stream IP Cell \ cr ; : output-label ( -- ) - ." (Label)&&I_" prim prim-c-name 2@ type ." ," cr ; + ." INST_ADDR(" prim prim-c-name 2@ type ." )," cr ; : output-alias ( -- ) ( primitive-number @ . ." alias " ) ." Primitive " prim prim-name 2@ type cr ; @@ -799,6 +823,11 @@ stack inst-stream IP Cell name-line @ 0 .r ." ,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 : register-doc ( -- ) prim prim-name 2@ documentation ['] create insert-wordlist @@ -1216,6 +1245,7 @@ Variable c-flag line @ name-line ! filename 2@ name-filename 2! function-number @ prim prim-num ! 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 +! }} )) <- primitive ( -- )