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

Diff for /gforth/kernel/int.fs between versions 1.137 and 1.138

version 1.137, 2006/02/19 22:15:05 version 1.138, 2006/02/25 18:28:12
Line 67  Defer source ( -- c-addr u ) \ core Line 67  Defer source ( -- c-addr u ) \ core
     ELSE      ELSE
         (word)          (word)
     THEN      THEN
   [ has? new-input [IF] ]
     2dup input-lexeme!      2dup input-lexeme!
   [ [THEN] ]
     2dup + r> - 1+ r> min >in ! ;      2dup + r> - 1+ r> min >in ! ;
   
 : word   ( char "<chars>ccc<char>-- c-addr ) \ core  : word   ( char "<chars>ccc<char>-- c-addr ) \ core
Line 88  Defer source ( -- c-addr u ) \ core Line 90  Defer source ( -- c-addr u ) \ core
     >r  source  >in @ over min /string ( c-addr1 u1 )      >r  source  >in @ over min /string ( c-addr1 u1 )
     over  swap r>  scan >r      over  swap r>  scan >r
     over - dup r> IF 1+ THEN  >in +!      over - dup r> IF 1+ THEN  >in +!
     2dup input-lexeme! ;  [ has? new-input [IF] ]
       2dup input-lexeme!
   [ [THEN] ] ;
   
 \ name                                                 13feb93py  \ name                                                 13feb93py
   
Line 96  Defer source ( -- c-addr u ) \ core Line 100  Defer source ( -- c-addr u ) \ core
   
 : (name) ( -- c-addr count ) \ gforth  : (name) ( -- c-addr count ) \ gforth
     source 2dup >r >r >in @ /string (parse-white)      source 2dup >r >r >in @ /string (parse-white)
   [ has? new-input [IF] ]
     2dup input-lexeme!      2dup input-lexeme!
   [ [THEN] ]
     2dup + r> - 1+ r> min >in ! ;      2dup + r> - 1+ r> min >in ! ;
 \    name count ;  \    name count ;
 [THEN]  [THEN]
Line 678  Variable #fill-bytes Line 684  Variable #fill-bytes
 [THEN]  [THEN]
   
 has? new-input 0= [IF]  has? new-input 0= [IF]
 : input-start-line ( -- ) >in off ;  : input-start-line ( -- )  >in off ;
 : input-lexeme! ( c-addr n -- ) 2drop ;  
 : refill ( -- flag ) \ core-ext,block-ext,file-ext  : refill ( -- flag ) \ core-ext,block-ext,file-ext
     \G Attempt to fill the input buffer from the input source.  When      \G Attempt to fill the input buffer from the input source.  When
     \G the input source is the user input device, attempt to receive      \G the input source is the user input device, attempt to receive
Line 695  has? new-input 0= [IF] Line 700  has? new-input 0= [IF]
     \G and return true; otherwise, return false.  A successful result      \G and return true; otherwise, return false.  A successful result
     \G includes receipt of a line containing 0 characters.      \G includes receipt of a line containing 0 characters.
     [ has? file [IF] ]      [ has? file [IF] ]
         blk @  IF  1 blk +!  true  input-start-line  EXIT  THEN          blk @  IF  1 blk +!  true  EXIT  THEN
         [ [THEN] ]          [ [THEN] ]
     tib /line      tib /line
     [ has? file [IF] ]      [ has? file [IF] ]
Line 709  has? new-input 0= [IF] Line 714  has? new-input 0= [IF]
         THEN          THEN
         1 loadline +!          1 loadline +!
         [ [THEN] ]          [ [THEN] ]
     swap #tib ! input-start-line ;      swap #tib !
       input-start-line ;
   
 : query   ( -- ) \ core-ext  : query   ( -- ) \ core-ext
     \G Make the user input device the input source. Receive input into      \G Make the user input device the input source. Receive input into
Line 801  Defer .status Line 807  Defer .status
             \ if stderr does not work either, already DoError causes a hang              \ if stderr does not work either, already DoError causes a hang
             2 (bye)              2 (bye)
         endif          endif
         refill WHILE          refill  WHILE
             interpret prompt              interpret prompt
     REPEAT      REPEAT
     bye ;      bye ;
Line 1035  has? new-input 0= [IF] Line 1041  has? new-input 0= [IF]
     sp@ $10 cells +      sp@ $10 cells +
     [ [THEN] ]      [ [THEN] ]
 [ [THEN] ]  [ [THEN] ]
     dup >tib ! tibstack ! #tib off input-start-line ;      dup >tib ! tibstack ! #tib off
       input-start-line ;
 [THEN]  [THEN]
   
 : boot ( path n **argv argc -- )  : boot ( path n **argv argc -- )
Removed from v.1.137  
changed lines
  Added in v.1.138

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