--- gforth/prims2x.fs 1998/08/29 20:46:13 1.32 +++ gforth/prims2x.fs 1999/04/25 21:06:52 1.41 @@ -1,6 +1,6 @@ \ converts primitives to, e.g., C code -\ Copyright (C) 1995 Free Software Foundation, Inc. +\ Copyright (C) 1995,1996,1997,1998 Free Software Foundation, Inc. \ This file is part of Gforth. @@ -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 @@ -77,9 +77,23 @@ skipsynclines on Variable flush-comment flush-comment off : ?flush-comment - flush-comment @ 0= ?EXIT - f-comment 2@ nip - IF cr f-comment 2@ 2 /string type 0 0 f-comment 2! THEN ; + flush-comment @ 0= ?EXIT + f-comment 2@ nip + IF cr f-comment 2@ 2 /string 1- + dup IF + 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 ; : start ( -- addr ) cookedinput @ ; @@ -262,7 +276,7 @@ nowhite ++ (( nl || eof )) )) <- primitive ( -- ) -(( (( primitive {{ printprim }} )) ** eof )) +(( (( primitive {{ printprim }} )) ** eof )) parser primitives2something warnings @ [IF] .( parser generated ok ) cr @@ -272,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 @@ -466,7 +480,7 @@ s" DFloat *" single-type starts-with df_ s" SFloat *" single-type starts-with sf_ s" Xt" single-type starts-with xt s" WID" single-type starts-with wid -s" F83Name *" single-type starts-with f83name +s" struct F83Name *" single-type starts-with f83name set-current @@ -586,7 +600,8 @@ set-current i item-name 2@ type space item-descr +loop ; -: output-c ( -- ) +: output-c ( -- ) 1 flush-comment ! + ?flush-comment ." I_" c-name 2@ type ." : /* " forth-name 2@ type ." ( " stack-string 2@ type ." ) */" cr ." /* " doc 2@ type ." */" cr ." NAME(" [char] " emit forth-name 2@ type [char] " emit ." )" cr \ debugging @@ -644,13 +659,15 @@ set-current ." }" cr cr ; -: output-label ( -- ) - ." &&I_" c-name 2@ type ." ," cr ; +: output-label ( -- ) 1 flush-comment ! + ?flush-comment + ." (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 - -1 primitive-number +! ; + ?flush-comment + ( primitive-number @ . ." alias " ) ." Primitive " forth-name 2@ type cr + -1 primitive-number +! ; : output-forth ( -- ) flush-comment on ?flush-comment @@ -706,4 +723,3 @@ set-current : process ( xt -- ) bl word count rot process-file ; -