--- gforth/prims2x.fs 2001/02/24 17:24:44 1.84 +++ gforth/prims2x.fs 2001/02/28 22:31:43 1.87 @@ -585,20 +585,28 @@ s" IP" save-mem w s" error don't use # o : stores ( -- ) prim prim-effect-out prim prim-effect-out-end @ ['] store map-items ; +: output-super-end ( -- ) + prim prim-c-code 2@ s" SET_IP" search if + ." SUPER_END;" cr + endif + 2drop ; + : output-c-tail ( -- ) \ the final part of the generated C code + output-super-end ." NEXT_P1;" cr stores fill-tos - ." NEXT_P2;" cr ; + ." NEXT_P2;" ; -: type-c ( c-addr u -- ) - \ like TYPE, but replaces "TAIL;" with tail code +: type-c-code ( c-addr u xt -- ) + \ like TYPE, but replaces "TAIL;" with tail code produced by xt + { xt } begin ( c-addr1 u1 ) 2dup s" TAIL;" search while ( c-addr1 u1 c-addr3 u3 ) 2dup 2>r drop nip over - type - output-c-tail + xt execute 2r> 5 /string \ !! resync #line missing repeat @@ -634,7 +642,7 @@ s" IP" save-mem w s" error don't use # o stack-pointer-updates ." {" cr ." #line " c-line @ . quote c-filename 2@ type quote cr - prim prim-c-code 2@ type-c + prim prim-c-code 2@ ['] output-c-tail type-c-code ." }" cr output-c-tail ." }" cr @@ -660,6 +668,17 @@ s" IP" save-mem w s" error don't use # o ." ip += " inst-stream stack-in @ 1+ 0 .r ." ;" cr ." } else " ; +: 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 + ." 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 + ." return;" cr + endif + ." } else " cr ; + : gen-arg-parm { item -- } item item-stack @ inst-stream = if ." , " item item-type @ type-c-name 2@ type space @@ -900,6 +919,8 @@ s" IP" save-mem w s" error don't use # o : process-combined ( -- ) combined combined-prims num-combined @ cells combinations ['] constant insert-wordlist + combined-prims num-combined @ 1- th ( last-part ) + @ prim-c-code 2@ prim prim-c-code 2! \ used by output-super-end prim compute-effects prim init-effects output-combined perform ; @@ -922,8 +943,14 @@ s" IP" save-mem w s" error don't use # o fetches ; : part-output-c-tail ( -- ) - stores - fill-tos ; + stores ; + +: output-combined-tail ( -- ) + part-output-c-tail + prim >r combined to prim + in-part @ >r in-part off + output-c-tail + r> in-part ! r> to prim ; : output-part ( p -- ) to prim @@ -936,7 +963,7 @@ s" IP" save-mem w s" error don't use # o prim add-depths \ !! right place? ." {" cr ." #line " c-line @ . quote c-filename 2@ type quote cr - prim prim-c-code 2@ type-c \ !! deal with TAIL + prim prim-c-code 2@ ['] output-combined-tail type-c-code ." }" cr part-output-c-tail ." }" cr ;