--- gforth/kernel/quotes.fs 2001/05/04 07:41:03 1.4 +++ gforth/kernel/quotes.fs 2003/03/09 15:17:06 1.10 @@ -1,6 +1,6 @@ \ quote: S" and ." words -\ Copyright (C) 1996,1998,1999 Free Software Foundation, Inc. +\ Copyright (C) 1996,1998,1999,2002 Free Software Foundation, Inc. \ This file is part of Gforth. @@ -22,10 +22,35 @@ require ./vars.fs +: CLiteral ( Compilation c-addr1 u ; run-time -- c-addr ) + 2>r postpone ahead here 2r> s, >r postpone then + r> postpone literal ; immediate restrict + +: SLiteral ( Compilation c-addr1 u ; run-time -- c-addr2 u ) \ string +\G Compilation: compile the string specified by @i{c-addr1}, +\G @i{u} into the current definition. Run-time: return +\G @i{c-addr2 u} describing the address and length of the +\G string. + tuck 2>r postpone ahead here 2r> chars mem, align >r postpone then + r> postpone literal postpone literal ; immediate restrict + +\ \ abort" 22feb93py + +: abort" ( compilation 'ccc"' -- ; run-time f -- ) \ core,exception-ext abort-quote +\G If any bit of @i{f} is non-zero, perform the function of @code{-2 throw}, +\G displaying the string @i{ccc} if there is no exception frame on the +\G exception stack. + postpone if [char] " parse postpone cliteral postpone c(abort") + postpone then ; immediate restrict + \ create s"-buffer /line chars allot has? compiler 0= [IF] : s" [ELSE] :noname [THEN] - [char] " parse save-mem ; + [char] " parse +[ has? OS [IF] ] + save-mem +[ [THEN] ] +; \ /line min >r s"-buffer r@ cmove \ s"-buffer r> ; has? compiler [IF] @@ -45,7 +70,7 @@ interpret/compile: S" ( compilation 'ccc [THEN] :noname [char] " parse type ; -:noname postpone (.") ," align ; +:noname [char] " parse postpone sLiteral postpone type ; interpret/compile: ." ( compilation 'ccc"' -- ; run-time -- ) \ core dot-quote \G Compilation: Parse a string @i{ccc} delimited by a " (double \G quote). At run-time, display the string. Interpretation semantics