--- gforth/prims2x.fs 1997/02/06 21:23:05 1.25 +++ gforth/prims2x.fs 1997/09/13 12:04:59 1.28 @@ -45,8 +45,8 @@ warnings off include extend.fs \ require interpretation.fs -require debugging.fs -[IFUNDEF] vocabulary include search-order.fs [THEN] +\ require debugs.fs +[IFUNDEF] vocabulary include search.fs [THEN] [IFUNDEF] environment? include environ.fs [THEN] include gray.fs @@ -73,6 +73,13 @@ variable line \ line number of char poin variable skipsynclines \ are sync lines ("#line ...") invisible to the parser? 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 ; + : start ( -- addr ) cookedinput @ ; @@ -228,7 +235,7 @@ eof-char singleton charclass eof nowhite ++ <- name ( -- ) -(( {{ start }} ` \ nonl ** nl {{ end +(( {{ ?flush-comment start }} ` \ nonl ** nl {{ end 2dup 2 min s" \+" compare 0= IF f-comment 2! ELSE 2drop THEN }} )) <- comment ( -- ) @@ -600,17 +607,17 @@ set-current : output-label ( -- ) ." &&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 +: output-alias ( -- ) flush-comment on + ?flush-comment 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 +: output-forth ( -- ) flush-comment on + ?flush-comment forth-code @ 0= - IF output-alias + IF \ output-alias + \ this is bad for ec: an alias is compiled if tho word does not exist! + \ JAW ELSE ." : " forth-name 2@ type ." ( " effect-in effect-in-end @ .stack-list ." -- " effect-out effect-out-end @ .stack-list ." )" cr