--- gforth/prims2x.fs 2001/02/24 09:58:31 1.82 +++ gforth/prims2x.fs 2001/02/27 10:30:02 1.85 @@ -484,13 +484,14 @@ does> ( item -- ) item declaration ; \ types pointed to by stacks for use in combined prims -s" Cell" single 0 create-type cell-type -s" Float" single 0 create-type float-type - -s" sp" save-mem cell-type s" (Cell)" make-stack data-stack -s" fp" save-mem float-type s" " make-stack fp-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 +\ !! output-c-combined shouldn't use these names! +s" Cell" single 0 create-type w +s" Float" single 0 create-type r + +s" sp" save-mem w s" (Cell)" make-stack data-stack +s" fp" save-mem r s" " make-stack fp-stack +s" rp" save-mem w s" (Cell)" make-stack return-stack +s" IP" save-mem w s" error don't use # on results" make-stack inst-stream ' inst-in-index inst-stream stack-in-index-xt ! ' inst-stream inst-stream-f \ !! initialize stack-in and stack-out @@ -589,15 +590,16 @@ s" IP" save-mem cell-type s" error don' ." 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 @@ -633,7 +635,7 @@ s" IP" save-mem cell-type s" error don' 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 @@ -921,7 +923,14 @@ s" IP" save-mem cell-type s" error don' fetches ; : part-output-c-tail ( -- ) - output-c-tail ; + 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 @@ -934,7 +943,7 @@ s" IP" save-mem cell-type s" error don' 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 ; @@ -968,13 +977,13 @@ s" IP" save-mem cell-type s" error don' ; -\ compile VM insts +\ peephole optimization rules \ in order for this to work as intended, shorter combinations for each \ length must be present, and the longer combinations must follow \ shorter ones (this restriction may go away in the future). -: output-pregen-combined ( -- ) +: output-peephole ( -- ) combined-prims num-combined @ 1- cells combinations search-wordlist s" the prefix for this combination must be defined earlier" ?print-error ." {"