--- gforth/stuff.fs 2001/01/19 21:07:05 1.19 +++ gforth/stuff.fs 2003/01/22 18:52:47 1.25 @@ -66,8 +66,10 @@ AUser CSP \G equivalent to @code{] literal} ] postpone literal ; +[ifundef] in-dictionary? : in-dictionary? ( x -- f ) forthstart dictionary-end within ; +[endif] : in-return-stack? ( addr -- f ) rp0 @ swap - [ forthstart 6 cells + ]L @ u< ; @@ -107,11 +109,58 @@ AUser CSP lastxt r> cell+ ! \ patch the literal ; immediate +\ !! rewrite slurp-file using slurp-fid : slurp-file ( c-addr1 u1 -- c-addr2 u2 ) - \ c-addr1 u1 is the filename, c-addr2 u2 is the file's contents + \G @var{c-addr1 u1} is the filename, @var{c-addr2 u2} is the file's contents r/o bin open-file throw >r r@ file-size throw abort" file too large" dup allocate throw swap 2dup r@ read-file throw over <> abort" could not read whole file" r> close-file throw ; +: slurp-fid { fid -- addr u } + \G @var{addr u} is the content of the file @var{fid} + 0 0 begin ( awhole uwhole ) + dup 1024 + dup >r extend-mem ( anew awhole uwhole R: unew ) + rot r@ fid read-file throw ( awhole uwhole uread R: unew ) + r> 2dup = + while ( awhole uwhole uread unew ) + 2drop + repeat + - + dup >r resize throw r> ; + +\ ]] ... [[ + +: compile-literal ( n -- ) + postpone literal ; + +: [[ ( -- ) +\G switch from postpone state to compile state + \ this is only a marker; it is never really interpreted + compile-only-error ; immediate + +: postponer ( c-addr u -- ) + 2dup find-name dup if ( c-addr u nt ) + nip nip name>comp + 2dup [comp'] [[ d= if + 2drop ['] compiler is parser + else + postpone, + endif + else + drop + 2dup snumber? dup if + 0> IF + swap postpone literal postpone compile-literal + THEN + postpone Literal postpone compile-literal + 2drop + ELSE + drop no.extensions + THEN + then ; + +: ]] ( -- ) + \ switch into postpone state + ['] postponer is parser state on ; immediate restrict +