X-Git-Url: http://git.subgeniuskitty.com/pforth/.git/blobdiff_plain/b60d4a658481962a2d8f3024674977c94c1b93b6..0868989592470c064bae35eea78a6d23669d1995:/fth/system.fth diff --git a/fth/system.fth b/fth/system.fth index b74c812..5e7aff0 100644 --- a/fth/system.fth +++ b/fth/system.fth @@ -360,6 +360,10 @@ 2* swap ; +: D= ( xd1 xd2 -- flag ) + rot = -rot = and +; + \ define some useful constants ------------------------------ 1 0= constant FALSE 0 0= constant TRUE @@ -716,9 +720,9 @@ ustack 0stackp \ -------------- INCLUDE ------------------------------------------ variable TRACE-INCLUDE -: INCLUDE.MARK.START ( $filename -- , mark start of include for FILE?) +: INCLUDE.MARK.START ( c-addr u -- , mark start of include for FILE?) " ::::" pad $MOVE - count pad $APPEND + pad $APPEND pad ['] noop (:) ; @@ -726,19 +730,18 @@ variable TRACE-INCLUDE " ;;;;" ['] noop (:) ; -: $INCLUDE ( $filename -- ) -\ Print messages. +: INCLUDED ( c-addr u -- ) + \ Print messages. trace-include @ IF - >newline ." Include " dup count type cr + >newline ." Include " 2dup type cr THEN here >r - dup - count r/o open-file - IF ( -- $filename bad-fid ) - drop ." Could not find file " $type cr abort - ELSE ( -- $filename good-fid ) - swap include.mark.start + 2dup r/o open-file + IF ( -- c-addr u bad-fid ) + drop ." Could not find file " type cr abort + ELSE ( -- c-addr u good-fid ) + -rot include.mark.start depth >r include-file \ will also close the file depth 1+ r> - @@ -757,6 +760,8 @@ variable TRACE-INCLUDE rdrop ; +: $INCLUDE ( $filename -- ) count included ; + create INCLUDE-SAVE-NAME 128 allot : INCLUDE ( -- ) BL lword