--- gforth/prims2x.fs 1996/05/23 15:13:12 1.22 +++ gforth/prims2x.fs 1997/02/06 21:23:05 1.25 @@ -42,7 +42,9 @@ warnings off -require interpretation.fs +include extend.fs + +\ require interpretation.fs require debugging.fs [IFUNDEF] vocabulary include search-order.fs [THEN] [IFUNDEF] environment? include environ.fs [THEN] @@ -57,7 +59,7 @@ maxchar 1+ constant eof-char : read-whole-file ( c-addr1 file-id -- c-addr2 ) \ reads the contents of the file file-id puts it into memory at c-addr1 \ c-addr2 is the first address after the file block - >r dup -1 r> read-file throw + ; + >r dup $7fffffff r> read-file throw + ; variable rawinput \ pointer to next character to be scanned variable endrawinput \ pointer to the end of the input (the char after the last) @@ -66,6 +68,8 @@ variable line \ line number of char poin 1 line ! 2variable filename \ filename of original input file 0 0 filename 2! +2variable f-comment +0 0 f-comment 2! variable skipsynclines \ are sync lines ("#line ...") invisible to the parser? skipsynclines on @@ -165,7 +169,7 @@ print-token ! 0. r> 6 chars + 20 >number drop >r drop line ! r> ( c-addr ) dup c@ bl = if char+ dup c@ [char] " <> abort" sync line syntax" - char+ dup 100 [char] " scan drop swap 2dup - save-string filename 2! + char+ dup 100 [char] " scan drop swap 2dup - save-mem filename 2! char+ endif dup c@ nl-char <> abort" sync line syntax" @@ -224,7 +228,8 @@ eof-char singleton charclass eof nowhite ++ <- name ( -- ) -(( ` \ nonl ** nl +(( {{ start }} ` \ nonl ** nl {{ end + 2dup 2 min s" \+" compare 0= IF f-comment 2! ELSE 2drop THEN }} )) <- comment ( -- ) (( {{ effect-in }} (( {{ start }} c-name {{ end 2 pick item-name 2! item-descr + }} blank ** )) ** {{ effect-in-end ! }} @@ -596,10 +601,14 @@ set-current ." &&I_" c-name 2@ type ." ," cr ; : output-alias ( -- ) + f-comment 2@ nip + IF cr f-comment 2@ 2 /string type 0 0 f-comment 2! THEN primitive-number @ . ." alias " forth-name 2@ type cr -1 primitive-number +! ; : output-forth ( -- ) + f-comment 2@ 2 min s" \+" compare 0= + IF cr f-comment 2@ 2 /string type 0 0 f-comment 2! THEN forth-code @ 0= IF output-alias ELSE ." : " forth-name 2@ type ." ( "