--- gforth/prims2x.fs 2003/03/08 19:52:05 1.133 +++ gforth/prims2x.fs 2003/05/13 09:36:59 1.138 @@ -1,6 +1,6 @@ \ converts primitives to, e.g., C code -\ Copyright (C) 1995,1996,1997,1998,2000 Free Software Foundation, Inc. +\ Copyright (C) 1995,1996,1997,1998,2000,2003 Free Software Foundation, Inc. \ This file is part of Gforth. @@ -51,8 +51,15 @@ \ (stack-in-index-xt and a test for stack==instruction-stream); there \ should be only one. +\ for backwards compatibility, jaw +require compat/strcomp.fs + warnings off +\ redefinitions of kernel words not present in gforth-0.6.1 +: latestxt lastcfa @ ; +: latest last @ ; + [IFUNDEF] try include startup.fs [THEN] @@ -608,7 +615,7 @@ wordlist constant type-names \ this is h get-current type-names set-current stack-type 2dup nextname stack-type-name set-current - stack-pointer lastxt >body stack-name nextname make-stack ; + stack-pointer latestxt >body stack-name nextname make-stack ; stack inst-stream IP Cell ' inst-in-index inst-stream stack-in-index-xt ! @@ -1264,8 +1271,8 @@ variable tail-nextp2 \ xt to execute for \ 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 */ -\ int *components; /* array of vm_prim indexes of components */ \ }; \ How do you know which primitive or combined instruction this @@ -1290,17 +1297,36 @@ variable tail-nextp2 \ xt to execute for : output-num-part ( p -- ) prim-num @ 4 .r ." ," ; +: super2-length ( -- n ) + combined if + num-combined @ + else + 1 + endif ; + +: output-name-comment ( -- ) + ." /* " prim prim-name 2@ type ." */" ; + +variable offset-super2 0 offset-super2 ! \ offset into the super2 table + : output-costs ( -- ) + \ description of superinstructions and simple instructions ." {" prim compute-costs rot 2 .r ." ," swap 2 .r ." ," 2 .r ." ," + offset-super2 @ 5 .r ." ," + super2-length dup 2 .r ." }," offset-super2 +! + output-name-comment + cr ; + +: output-super2 ( -- ) + \ table of superinstructions without requirement for existing prefixes combined if - num-combined @ 2 .r - ." , ((int []){" ['] output-num-part map-combined ." })}, /* " + ['] output-num-part map-combined else - ." 1, ((int []){" prim prim-num @ 4 .r ." })}, /* " + prim output-num-part endif - prim prim-name 2@ type ." */" - cr ; + output-name-comment + cr ; \ the parser @@ -1477,7 +1503,8 @@ Variable c-flag 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 ** )) ?? - (( simple-primitive || combined-primitive )) {{ 1 function-number +! }} + (( simple-primitive || combined-primitive )) + {{ 1 function-number +! }} )) <- primitive ( -- ) (( (( comment || primitive || nl white ** )) ** eof ))