Diff for /gforth/extend.fs between versions 1.36 and 1.47

version 1.36, 1999/11/08 22:01:08 version 1.47, 2002/12/04 10:42:58
Line 1 Line 1
 \ EXTEND.FS    CORE-EXT Word not fully tested!         12may93jaw  \ EXTEND.FS    CORE-EXT Word not fully tested!         12may93jaw
   
 \ Copyright (C) 1995,1998 Free Software Foundation, Inc.  \ Copyright (C) 1995,1998,2000 Free Software Foundation, Inc.
   
 \ This file is part of Gforth.  \ This file is part of Gforth.
   
Line 16 Line 16
   
 \ You should have received a copy of the GNU General Public License  \ You should have received a copy of the GNU General Public License
 \ along with this program; if not, write to the Free Software  \ along with this program; if not, write to the Free Software
 \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.  \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
   
   
 \ May be cross-compiled  \ May be cross-compiled
Line 25  decimal Line 25  decimal
   
 \ .(                                                    12may93jaw  \ .(                                                    12may93jaw
   
 : .(   ( "ccc<paren>" -- ) \ core-ext dot-paren  : .(   ( compilation,interpretation "ccc<paren>" -- ) \ core-ext dot-paren
   \G Parse a string @i{ccc} delimited by a @code{)} (right    \G Compilation and interpretation semantics: Parse a string @i{ccc}
   \G parenthesis). Display the string. This is often used to display    \G delimited by a @code{)} (right parenthesis). Display the
   \G progress information during compilation; see examples below.    \G string. This is often used to display progress information during
     \G compilation; see examples below.
   [char] ) parse type ; immediate    [char] ) parse type ; immediate
   
 \ VALUE 2>R 2R> 2R@                                     17may93jaw  \ VALUE 2>R 2R> 2R@                                     17may93jaw
Line 42  decimal Line 43  decimal
   
 ' drop alias d>s ( d -- n ) \ double            d_to_s  ' drop alias d>s ( d -- n ) \ double            d_to_s
   
 : m*/ ( d1 n2 u3 -- dqout ) \ double m-star-slash  : m*/ ( d1 n2 u3 -- dquot ) \ double m-star-slash
       \G dquot=(d1*n2)/u3, with the intermediate result being triple-precision.
       \G In ANS Forth u3 can only be a positive signed number.
     >r s>d >r abs -rot      >r s>d >r abs -rot
     s>d r> xor r> swap >r >r dabs rot tuck um* 2swap um*      s>d r> xor r> swap >r >r dabs rot tuck um* 2swap um*
     swap >r 0 d+ r> -rot r@ um/mod -rot r> um/mod nip swap      swap >r 0 d+ r> -rot r@ um/mod -rot r> um/mod nip swap
Line 70  decimal Line 73  decimal
   
 \ C"                                                    17may93jaw  \ C"                                                    17may93jaw
   
 : (c")     "lit ;  
   
 : CLiteral  
     postpone (c") here over char+ allot  place align ; immediate restrict  
   
 : C" ( compilation "ccc<quote>" -- ; run-time  -- c-addr ) \ core-ext c-quote  : C" ( compilation "ccc<quote>" -- ; run-time  -- c-addr ) \ core-ext c-quote
     \G Compilation: parse a string @i{ccc} delimited by a @code{"}      \G Compilation: parse a string @i{ccc} delimited by a @code{"}
     \G (double quote). At run-time, return @i{c-addr} which      \G (double quote). At run-time, return @i{c-addr} which
Line 85  decimal Line 83  decimal
 \ [COMPILE]                                             17may93jaw  \ [COMPILE]                                             17may93jaw
   
 : [compile] ( compilation "name" -- ; run-time ? -- ? ) \ core-ext bracket-compile  : [compile] ( compilation "name" -- ; run-time ? -- ? ) \ core-ext bracket-compile
     comp' drop compile, ; immediate      comp' drop
       dup [ comp' exit drop ] literal = if
           execute \ EXIT has default compilation semantics, perform them
       else
           compile,
       then ; immediate
   
 \ CONVERT                                               17may93jaw  \ CONVERT                                               17may93jaw
   
Line 95  decimal Line 98  decimal
   
 \ ERASE                                                 17may93jaw  \ ERASE                                                 17may93jaw
   
 : erase ( addr len -- ) \ core-ext  : erase ( addr u -- ) \ core-ext
     \G If @i{len}>0, clear all bits in each location of a memory region      \G Clear all bits in @i{u} aus starting at @i{addr}.
     \G of @i{len} address units starting at address @i{addr}.  
     \ !! dependence on "1 chars 1 ="      \ !! dependence on "1 chars 1 ="
     ( 0 1 chars um/mod nip )  0 fill ;      ( 0 1 chars um/mod nip )  0 fill ;
 : blank ( c-addr u -- ) \ string  : blank ( c-addr u -- ) \ string
     \G If @i{u}>0, store the character value for a space in each      \G Store the space character into @i{u} chars starting at @i{c-addr}.
     \G location of a memory region  
     \G of @i{u} character units starting at address @i{c-addr}.  
     bl fill ;      bl fill ;
   
 \ SEARCH                                                02sep94py  \ SEARCH                                                02sep94py
Line 127  decimal Line 127  decimal
   
 \ SOURCE-ID SAVE-INPUT RESTORE-INPUT                    11jun93jaw  \ SOURCE-ID SAVE-INPUT RESTORE-INPUT                    11jun93jaw
   
   [IFUNDEF] source-id
 : source-id ( -- 0 | -1 | fileid ) \ core-ext,file source-i-d  : source-id ( -- 0 | -1 | fileid ) \ core-ext,file source-i-d
     \G Return 0 (the input source is the user input device), -1 (the      \G Return 0 (the input source is the user input device), -1 (the
     \G input source is a string being processed by @code{evaluate}) or      \G input source is a string being processed by @code{evaluate}) or
Line 142  decimal Line 143  decimal
     loadfile @      loadfile @
     if      if
         loadfile @ file-position throw          loadfile @ file-position throw
           [IFDEF] #fill-bytes #fill-bytes @ [ELSE] #tib @ 1+ [THEN] 0 d-
     else      else
         blk @          blk @
         linestart @          linestart @
Line 163  decimal Line 165  decimal
     loadfile @ 0<>      loadfile @ 0<>
     if      if
         loadfile @ reposition-file throw          loadfile @ reposition-file throw
           refill 0= -36 and throw \ should never throw
     else      else
         linestart !          linestart !
         blk !          blk !
Line 174  decimal Line 177  decimal
     r> loadline !      r> loadline !
     >in !      >in !
     false ;      false ;
   [THEN]
 \ This things we don't need, but for being complete... jaw  \ This things we don't need, but for being complete... jaw
   
 \ EXPECT SPAN                                           17may93jaw  \ EXPECT SPAN                                           17may93jaw

Removed from v.1.36  
changed lines
  Added in v.1.47


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>