[BACK]Return to extend.fs CVS log [TXT] [DIR] Up to [gforth] / gforth

Diff for /gforth/extend.fs between versions 1.33 and 1.37

version 1.33, 1999/03/23 20:24:18 version 1.37, 2000/02/04 14:52:30
Line 26  decimal Line 26  decimal
 \ .(                                                    12may93jaw  \ .(                                                    12may93jaw
   
 : .(   ( "ccc<paren>" -- ) \ core-ext dot-paren  : .(   ( "ccc<paren>" -- ) \ core-ext dot-paren
   \G Parse a string @var{ccc} delimited by a @code{)} (right    \G Parse a string @i{ccc} delimited by a @code{)} (right
   \G parenthesis). Display the string. This is often used to display    \G parenthesis). Display the string. This is often used to display
   \G progress information during compilation; see examples below.    \G progress information during compilation; see examples below.
   [char] ) parse type ; immediate    [char] ) parse type ; immediate
Line 36  decimal Line 36  decimal
 \ !! 2value  \ !! 2value
   
 : 2Literal ( compilation w1 w2 -- ; run-time  -- w1 w2 ) \ double two-literal  : 2Literal ( compilation w1 w2 -- ; run-time  -- w1 w2 ) \ double two-literal
     \G Compile appropriate code such that, at run-time, cell pair @var{w1, w2} are      \G Compile appropriate code such that, at run-time, cell pair @i{w1, w2} are
     \G placed on the stack. Interpretation semantics are undefined.      \G placed on the stack. Interpretation semantics are undefined.
     swap postpone Literal  postpone Literal ; immediate restrict      swap postpone Literal  postpone Literal ; immediate restrict
   
Line 76  decimal Line 76  decimal
     postpone (c") here over char+ allot  place align ; immediate restrict      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 @var{ccc} delimited by a @code{"}      \G Compilation: parse a string @i{ccc} delimited by a @code{"}
     \G (double quote). At run-time, return @var{c-addr} which      \G (double quote). At run-time, return @i{c-addr} which
     \G specifies the counted string @var{ccc}.  Interpretation      \G specifies the counted string @i{ccc}.  Interpretation
     \G semantics are undefined.      \G semantics are undefined.
     [char] " parse postpone CLiteral ; immediate restrict      [char] " parse postpone CLiteral ; immediate restrict
   
 \ [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
   
 : convert ( ud1 c-addr1 -- ud2 c-addr2 ) \ core-ext  : convert ( ud1 c-addr1 -- ud2 c-addr2 ) \ core-ext
     \G OBSOLESCENT; superseded by @code{>number}.      \G OBSOLESCENT: superseded by @code{>number}.
     char+ true >number drop ;      char+ true >number drop ;
   
 \ ERASE                                                 17may93jaw  \ ERASE                                                 17may93jaw
   
 : erase ( addr len -- ) \ core-ext  : erase ( addr len -- ) \ core-ext
     \G If @var{len}>0, clear all bits in each location of a memory region      \G If @i{len}>0, clear all bits in each location of a memory region
     \G of @var{len} address units starting at address @var{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 ( addr len -- ) \ string  : blank ( c-addr u -- ) \ string
     \G If @var{len}>0, store the character value for a space in each      \G If @i{u}>0, store the character value for a space in each
     \G location of a memory region      \G location of a memory region
     \G of @var{len} character units starting at address @var{addr}.      \G of @i{u} character units starting at address @i{c-addr}.
     bl fill ;      bl fill ;
   
 \ SEARCH                                                02sep94py  \ SEARCH                                                02sep94py
   
 : search ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 flag ) \ string  : search ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 flag ) \ string
     \G Search the string specified by @var{c-addr1, u1} for the string      \G Search the string specified by @i{c-addr1, u1} for the string
     \G specified by @var{c-addr2, u2}. If @var{flag} is true: match was found      \G specified by @i{c-addr2, u2}. If @i{flag} is true: match was found
     \G at @var{c-addr3} with @var{u3} characters remaining. If @var{flag} is false:      \G at @i{c-addr3} with @i{u3} characters remaining. If @i{flag} is false:
     \G no match was found; @var{c-addr3, u3} are equal to @var{c-addr1, u1}.      \G no match was found; @i{c-addr3, u3} are equal to @i{c-addr1, u1}.
     \ not very efficient; but if we want efficiency, we'll do it as primitive      \ not very efficient; but if we want efficiency, we'll do it as primitive
     2>r 2dup      2>r 2dup
     begin      begin
Line 128  decimal Line 133  decimal
 \ SOURCE-ID SAVE-INPUT RESTORE-INPUT                    11jun93jaw  \ SOURCE-ID SAVE-INPUT RESTORE-INPUT                    11jun93jaw
   
 : source-id ( -- 0 | -1 | fileid ) \ core-ext,file source-i-d  : source-id ( -- 0 | -1 | fileid ) \ core-ext,file source-i-d
   loadfile @ dup 0= IF  drop sourceline# 0 min  THEN ;      \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
 : save-input ( -- x1 .. xn n ) \ core-ext      \G a @i{fileid} (the input source is the file specified by
       \G @i{fileid}).
       loadfile @ dup 0= IF  drop sourceline# 0 min  THEN ;
   
   : save-input ( -- xn .. x1 n ) \ core-ext
       \G The @i{n} entries @i{xn - x1} describe the current state of the
       \G input source specification, in some platform-dependent way that can
       \G be used by @code{restore-input}.
     >in @      >in @
     loadfile @      loadfile @
     if      if
Line 144  decimal Line 156  decimal
     source-id      source-id
     6 ;      6 ;
   
 : restore-input ( x1 .. xn n -- flag ) \ core-ext  : restore-input ( xn .. x1 n -- flag ) \ core-ext
       \G Attempt to restore the input source specification to the state
       \G described by the @i{n} entries @i{xn - x1}. @i{flag} is
       \G true if the restore fails.  In Gforth it fails pretty often
       \G (and sometimes with a @code{throw}).
     6 <> -12 and throw      6 <> -12 and throw
     source-id <> -12 and throw      source-id <> -12 and throw
     >tib !      >tib !
Line 168  decimal Line 184  decimal
   
 \ EXPECT SPAN                                           17may93jaw  \ EXPECT SPAN                                           17may93jaw
   
 variable span ( -- a-addr ) \ core-ext  variable span ( -- c-addr ) \ core-ext
 \ obsolescent  \G @code{Variable} -- @i{c-addr} is the address of a cell that stores the
   \G length of the last string received by @code{expect}. OBSOLESCENT.
 : expect ( c-addr +len -- ) \ core-ext  
     \ obsolescent; use accept  : expect ( c-addr +n -- ) \ core-ext
       \G Receive a string of at most @i{+n} characters, and store it
       \G in memory starting at @i{c-addr}. The string is
       \G displayed. Input terminates when the <return> key is pressed or
       \G @i{+n} characters have been received. The normal Gforth line
       \G editing capabilites are available. The length of the string is
       \G stored in @code{span}; it does not include the <return>
       \G character. OBSOLESCENT: superceeded by @code{accept}.
     0 rot over      0 rot over
     BEGIN ( maxlen span c-addr pos1 )      BEGIN ( maxlen span c-addr pos1 )
         key decode ( maxlen span c-addr pos2 flag )          key decode ( maxlen span c-addr pos2 flag )
Line 255  variable span ( -- a-addr ) \ core-ext Line 278  variable span ( -- a-addr ) \ core-ext
     THEN ;      THEN ;
   
 : marker ( "<spaces> name" -- ) \ core-ext  : marker ( "<spaces> name" -- ) \ core-ext
     \G Create a definition, @var{name} (called a @var{mark}) whose      \G Create a definition, @i{name} (called a @i{mark}) whose
     \G execution semantics are to remove itself and everything       \G execution semantics are to remove itself and everything 
     \G defined after it.      \G defined after it.
     marker, Create A,      marker, Create A,
Removed from v.1.33  
changed lines
  Added in v.1.37

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