--- gforth/prims2x.fs 2002/08/09 09:42:35 1.108 +++ gforth/prims2x.fs 2002/08/20 07:59:01 1.110 @@ -60,9 +60,9 @@ include startup.fs : struct% struct ; \ struct is redefined in gray warnings off +\ warnings on include ./gray.fs - 32 constant max-effect \ number of things on one side of a stack effect 4 constant max-stacks \ the max. number of stacks (including inst-stream). 255 constant maxchar @@ -645,20 +645,20 @@ stack inst-stream IP Cell ." NEXT_P2;" cr ; : type-c-code ( c-addr u xt -- ) - \ like TYPE, but replaces "TAIL;" with tail code produced by xt + \ like TYPE, but replaces "INST_TAIL;" with tail code produced by xt { xt } begin ( c-addr1 u1 ) - 2dup s" TAIL;" search + 2dup s" INST_TAIL;" search while ( c-addr1 u1 c-addr3 u3 ) 2dup 2>r drop nip over - type xt execute - 2r> 5 /string + 2r> 10 /string \ !! resync #line missing repeat 2drop type ; : print-entry ( -- ) - ." LABEL(" 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 @@ -1165,6 +1165,8 @@ bl singleton tab-char over add-member nl-char singleton eof-char over add-member complement charclass nonl nl-char singleton eof-char over add-member char : over add-member complement charclass nocolonnl +nl-char singleton eof-char over add-member + char } over add-member complement charclass nobracenl bl 1+ maxchar .. char \ singleton complement intersection charclass nowhitebq bl 1+ maxchar .. charclass nowhite @@ -1176,7 +1178,7 @@ nl-char singleton eof-char over add-memb (( letter (( letter || digit )) ** )) <- c-ident ( -- ) -(( ` # ?? (( letter || digit || ` : )) ** +(( ` # ?? (( letter || digit || ` : )) ++ )) <- stack-ident ( -- ) (( nowhitebq nowhite ** )) @@ -1239,7 +1241,10 @@ Variable c-flag (( {{ start }} c-ident {{ end prim 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 }} (( nocolonnl nonl ** nleof white ** )) ** {{ end prim prim-c-code 2! skipsynclines on }} + {{ skipsynclines off line @ c-line ! filename 2@ c-filename 2! start }} + (( (( ` { nonl ** nleof (( (( nobracenl {{ line @ drop }} nonl ** )) ?? nleof )) ** ` } white ** nleof white ** )) + || (( nocolonnl nonl ** nleof white ** )) ** )) + {{ end prim prim-c-code 2! skipsynclines on }} (( ` : white ** nleof {{ start }} (( nonl ++ nleof white ** )) ++ {{ end prim prim-forth-code 2! }} )) ?? {{ process-simple }} @@ -1254,7 +1259,8 @@ Variable c-flag (( {{ make-prim to prim 0 to combined 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 ++ + 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 +! }} )) <- primitive ( -- )