--- gforth/prims2x.fs 1998/12/08 22:02:50 1.35 +++ gforth/prims2x.fs 1999/04/25 21:06:52 1.41 @@ -42,14 +42,19 @@ warnings off -require search.fs -require extend.fs +[IFUNDEF] vocabulary \ we are executed just with kernel image + \ load the rest that is needed + \ (require fails because this file is needed from a + \ different directory with the wordlibraries) +include ./search.fs +include ./extend.fs +[THEN] + +[IFUNDEF] environment? +include ./environ.fs +[THEN] -\ require interpretation.fs -\ require debugs.fs -[IFUNDEF] vocabulary include search.fs [THEN] -[IFUNDEF] environment? include environ.fs [THEN] -include gray.fs +include ./gray.fs 100 constant max-effect \ number of things on one side of a stack effect 255 constant maxchar @@ -57,11 +62,6 @@ maxchar 1+ constant eof-char #tab constant tab-char #lf constant nl-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 $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) variable cookedinput \ pointer to the next char to be parsed @@ -81,9 +81,16 @@ Variable flush-comment flush-comment off f-comment 2@ nip IF cr f-comment 2@ 2 /string 1- dup IF - flush-comment @ 1 = - IF ." #ifdef HAS_" bounds ?DO I c@ toupper emit LOOP - ELSE ." has? " type ." [IF]" THEN cr + 2dup s" -" compare 0= + IF + flush-comment @ 1 = + IF ." #else" + ELSE ." [ELSE]" THEN + ELSE + flush-comment @ 1 = + IF ." #ifdef HAS_" bounds ?DO I c@ toupper emit LOOP + ELSE ." has? " type ." [IF]" THEN + THEN cr ELSE flush-comment @ 1 = IF ." #endif" ELSE ." [THEN]" THEN cr THEN 0 0 f-comment 2! THEN ; @@ -269,7 +276,7 @@ nowhite ++ (( nl || eof )) )) <- primitive ( -- ) -(( (( primitive {{ printprim }} )) ** eof )) +(( (( primitive {{ printprim }} )) ** eof )) parser primitives2something warnings @ [IF] .( parser generated ok ) cr @@ -279,9 +286,9 @@ warnings @ [IF] \ fileid is for the input file, xt ( -- ) is for the output word output ! here dup rawinput ! cookedinput ! - here swap read-whole-file - dup endrawinput ! - here - allot + here unused rot read-file throw + dup here + endrawinput ! + allot align checksyncline \ begin @@ -654,13 +661,12 @@ set-current : output-label ( -- ) 1 flush-comment ! ?flush-comment - ." [" -2 primitive-number @ - 0 .r ." ] " ." (Label)&&I_" c-name 2@ type ." ," cr -1 primitive-number +! ; : output-alias ( -- ) flush-comment on ?flush-comment - primitive-number @ . ." alias " forth-name 2@ type cr + ( primitive-number @ . ." alias " ) ." Primitive " forth-name 2@ type cr -1 primitive-number +! ; : output-forth ( -- ) flush-comment on @@ -717,4 +723,3 @@ set-current : process ( xt -- ) bl word count rot process-file ; -