--- gforth/prims2x.fs 1998/11/22 23:18:10 1.34 +++ gforth/prims2x.fs 1999/05/10 12:50:49 1.42 @@ -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 @@ -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 ; @@ -244,7 +251,20 @@ eof-char singleton charclass eof nowhite ++ <- name ( -- ) -(( {{ ?flush-comment start }} ` \ nonl ** nl {{ end +Variable forth-flag +Variable c-flag + +(( (( ` f || ` F )) {{ start }} nonl ** + {{ end forth-flag @ IF type cr ELSE 2drop THEN }} +)) <- forth-comment ( -- ) + +(( (( ` c || ` C )) {{ start }} nonl ** + {{ end c-flag @ IF type cr ELSE 2drop THEN }} +)) <- c-comment ( -- ) + +(( (( forth-comment || c-comment )) ?? nonl ** )) <- comment-body + +(( {{ ?flush-comment start }} ` \ comment-body nl {{ end 2dup 2 min s" \+" compare 0= IF f-comment 2! ELSE 2drop THEN }} )) <- comment ( -- ) @@ -269,7 +289,7 @@ nowhite ++ (( nl || eof )) )) <- primitive ( -- ) -(( (( primitive {{ printprim }} )) ** eof )) +(( (( primitive {{ printprim }} )) ** eof )) parser primitives2something warnings @ [IF] .( parser generated ok ) cr @@ -279,9 +299,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 +674,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 +736,3 @@ set-current : process ( xt -- ) bl word count rot process-file ; -