--- gforth/prims2x.fs 2003/10/09 14:15:19 1.144 +++ gforth/prims2x.fs 2003/10/16 18:48:03 1.146 @@ -267,6 +267,7 @@ struct% cell% 2* field prim-name cell% 2* field prim-wordset cell% 2* field prim-c-name + cell% 2* field prim-c-name-orig \ for reprocessed prims, the original name cell% 2* field prim-doc cell% 2* field prim-c-code cell% 2* field prim-forth-code @@ -302,6 +303,9 @@ variable in-part \ true if processing a r> to prim throw ; +: prim-c-name-2! ( c-addr u -- ) + 2dup prim prim-c-name 2! prim prim-c-name-orig 2! ; + 1000 constant max-combined create combined-prims max-combined cells allot variable num-combined @@ -887,6 +891,17 @@ stack inst-stream IP Cell endif 2drop ; + +defer output-nextp0 +:noname ( -- ) + ." NEXT_P0;" cr ; +is output-nextp0 + +defer output-nextp1 +:noname ( -- ) + ." NEXT_P1;" cr ; +is output-nextp1 + : output-nextp2 ( -- ) ." NEXT_P2;" cr ; @@ -901,7 +916,7 @@ variable tail-nextp2 \ xt to execute for \ the final part of the generated C code, with xt printing LABEL2 or not. output-super-end print-debug-results - ." NEXT_P1;" cr + output-nextp1 stores fill-state xt execute ; @@ -909,7 +924,7 @@ variable tail-nextp2 \ xt to execute for : output-c-tail1-no-stores { xt -- } \ the final part of the generated C code for combinations output-super-end - ." NEXT_P1;" cr + output-nextp1 fill-state xt execute ; @@ -952,7 +967,7 @@ variable tail-nextp2 \ xt to execute for ." {" cr ." DEF_CA" cr print-declarations - ." NEXT_P0;" cr + output-nextp0 spill-state fetches print-debug-args @@ -1454,7 +1469,7 @@ variable reprocessed-num 0 reprocessed-n ." {" cr ." DEF_CA" cr print-declarations-combined - ." NEXT_P0;" cr + output-nextp0 spill-state \ fetches \ now in parts \ print-debug-args @@ -1494,11 +1509,14 @@ variable reprocessed-num 0 reprocessed-n \ This is intended as initializer for a structure like this \ struct cost { -\ int loads; /* number of stack loads */ -\ int stores; /* number of stack stores */ -\ int updates; /* number of stack pointer updates */ -\ int offset; /* offset into super2 table */ -\ int length; /* number of components */ +\ char loads; /* number of stack loads */ +\ char stores; /* number of stack stores */ +\ char updates; /* number of stack pointer updates */ +\ char branch; /* is it a branch (SET_IP) */ +\ char state_in; /* state on entry */ +\ char state_out; /* state on exit */ +\ short offset; /* offset into super2 table */ +\ char length; /* number of components */ \ }; \ How do you know which primitive or combined instruction this @@ -1528,7 +1546,7 @@ variable reprocessed-num 0 reprocessed-n loop ; : output-num-part ( p -- ) - ." N_" prim-c-name 2@ type ." ," ; + ." N_" prim-c-name-orig 2@ type ." ," ; \ prim-num @ 4 .r ." ," ; : output-name-comment ( -- ) @@ -1566,13 +1584,15 @@ variable offset-super2 0 offset-super2 output-name-comment cr ; -: output-super2 ( -- ) - \ table of superinstructions without requirement for existing prefixes - combined if - ['] output-num-part map-combined - else +: output-super2-simple ( -- ) + prim prim-c-name 2@ prim prim-c-name-orig 2@ d= if prim output-num-part - endif + output-name-comment + cr + endif ; + +: output-super2-combined ( -- ) + ['] output-num-part map-combined output-name-comment cr ; @@ -1733,7 +1753,7 @@ Variable c-flag (( {{ prim create-prim }} ` ( white ** {{ start }} stack-effect {{ end prim prim-stack-string 2! }} ` ) white ** (( {{ start }} forth-ident {{ end prim prim-wordset 2! }} white ** - (( {{ start }} c-ident {{ end prim prim-c-name 2! }} )) ?? + (( {{ start }} c-ident {{ end 2dup prim-c-name-2! }} )) ?? )) ?? nleof (( ` " ` " {{ start }} (( noquote ++ ` " )) ++ {{ end 1- prim prim-doc 2! }} ` " white ** nleof )) ?? {{ skipsynclines off line @ c-line ! filename 2@ c-filename 2! start }} @@ -1755,8 +1775,8 @@ Variable c-flag line @ name-line ! filename 2@ name-filename 2! function-number @ prim prim-num ! start }} [ifdef] vmgen c-ident [else] forth-ident [then] {{ end - 2dup prim prim-name 2! prim prim-c-name 2! }} white ** - (( ` / white ** {{ start }} c-ident {{ end prim prim-c-name 2! }} white ** )) ?? + 2dup prim prim-name 2! prim-c-name-2! }} white ** + (( ` / white ** {{ start }} c-ident {{ end prim-c-name-2! }} white ** )) ?? (( simple-primitive || combined-primitive )) {{ 1 function-number +! }} )) <- primitive ( -- )