Return to input.fs CVS log

Up to [gforth] / gforth / kernel

Added new input handling (OO approach). Only available if capability
new-input is true (so setting that to false in machpc.fs gets you the old
input handling back).

    1: \ Input handling (object oriented)                      22oct00py
    2: 
    3: \ Copyright (C) 2000 Free Software Foundation, Inc.
    4: 
    5: \ This file is part of Gforth.
    6: 
    7: \ Gforth is free software; you can redistribute it and/or
    8: \ modify it under the terms of the GNU General Public License
    9: \ as published by the Free Software Foundation; either version 2
   10: \ of the License, or (at your option) any later version.
   11: 
   12: \ This program is distributed in the hope that it will be useful,
   13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
   14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   15: \ GNU General Public License for more details.
   16: 
   17: \ You should have received a copy of the GNU General Public License
   18: \ along with this program; if not, write to the Free Software
   19: \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
   20: 
   21: \ input handling structure:
   22: 
   23: | : input-method ( m "name" -- m' )  Create dup , cell+
   24: DOES> ( ... -- ... ) @ current-input @ @ + perform ;
   25: | : input-var ( v size "name" -- v' )  Create  over , +
   26: DOES> ( -- addr ) @ current-input @ + ;
   27: 
   28: 0
   29: input-method source ( -- 0 | -1 | fileid ) \ core-ext,file source-i-d
   30:     \G Return 0 (the input source is the user input device), -1 (the
   31:     \G input source is a string being processed by @code{evaluate}) or
   32:     \G a @i{fileid} (the input source is the file specified by
   33:     \G @i{fileid}).
   34: input-method refill ( -- flag ) \ core-ext,block-ext,file-ext
   35:     \G Attempt to fill the input buffer from the input source.  When
   36:     \G the input source is the user input device, attempt to receive
   37:     \G input into the terminal input device. If successful, make the
   38:     \G result the input buffer, set @code{>IN} to 0 and return true;
   39:     \G otherwise return false. When the input source is a block, add 1
   40:     \G to the value of @code{BLK} to make the next block the input
   41:     \G source and current input buffer, and set @code{>IN} to 0;
   42:     \G return true if the new value of @code{BLK} is a valid block
   43:     \G number, false otherwise. When the input source is a text file,
   44:     \G attempt to read the next line from the file. If successful,
   45:     \G make the result the current input buffer, set @code{>IN} to 0
   46:     \G and return true; otherwise, return false.  A successful result
   47:     \G includes receipt of a line containing 0 characters.
   48: input-method source-id ( -- 0 | -1 | fileid ) \ core-ext,file source-i-d
   49:     \G Return 0 (the input source is the user input device), -1 (the
   50:     \G input source is a string being processed by @code{evaluate}) or
   51:     \G a @i{fileid} (the input source is the file specified by
   52:     \G @i{fileid}).
   53: | input-method (save-input) ( -- x1 .. xn n ) \ gforth
   54: | input-method (restore-input) ( x1 .. xn n -- ) \ gforth
   55: drop
   56: 
   57: cell \ the first cell points to the method table
   58: cell input-var >in \ core to-in
   59:     \G @code{input-var} variable -- @i{a-addr} is the address of a
   60:     \G cell containing the char offset from the start of the input
   61:     \G buffer to the start of the parse area.
   62: cell input-var #tib \ core-ext number-t-i-b
   63:     \G @code{input-var} variable -- @i{a-addr} is the address of a
   64:     \G cell containing the number of characters in the terminal input
   65:     \G buffer. OBSOLESCENT: @code{source} superceeds the function of
   66:     \G this word.
   67: cell input-var max#tib \ gforth max-number-t-i-b
   68:     \G @code{input-var} variable -- This cell contains the maximum
   69:     \G size of the current tib.
   70: cell input-var old-input \ gforth
   71:     \G @code{input-var} variable -- This cell contains the pointer to
   72:     \G the previous input buffer
   73: cell input-var loadline \ gforth
   74:     \G @code{input-var} variable -- This cell contains the line that's
   75:     \G currently loaded from
   76: has? file [IF]
   77: cell input-var loadfile \ gforth
   78:     \G @code{input-var} variable -- This cell contains the file the
   79:     \G input buffer is associated with (0 if none)
   80: cell input-var blk \ block
   81:     \G @code{input-var} variable -- This cell contains the current
   82:     \G block number
   83: cell input-var #fill-bytes \ gforth
   84:     \G @code{input-var} variable -- number of bytes read via
   85:     \G (read-line) by the last refill
   86: cell input-var loadfilename# \ gforth
   87:     \G @code{input-var} variable -- This cell contains the index into
   88:     \G the file name array and allows to identify the loaded file.
   89: [THEN]
   90: 0 input-var tib
   91: 
   92: Constant tib+
   93: 
   94: \ terminal input implementation
   95: 
   96: :noname  1 <> -12 and throw >in ! ;
   97:                        \ restore-input
   98: :noname  >in @ 1 ;     \ save-input
   99: :noname  0 ;           \ source-id
  100: :noname  tib max#tib @ accept #tib !
  101:     >in off true 1 loadline +! ;     \ refill
  102: :noname  tib #tib @ ;  \ source
  103: 
  104: | Create terminal-input   A, A, A, A, A,
  105: | Create evaluate-input
  106:     terminal-input @ A,
  107:     ' false A,
  108:     terminal-input 2 cells + @ A,
  109:     terminal-input 3 cells + @ A,
  110:     terminal-input 4 cells + @ A,
  111: 
  112: \ file input implementation
  113: 
  114: has? file [IF]
  115: :noname  4 <> -12 and throw
  116:     loadfile @ reposition-file throw
  117:     refill 0= -36 and throw \ should never throw
  118:     loadline ! >in ! ; \ restore-input
  119: :noname  >in @ sourceline#
  120:     loadfile @ file-position throw #fill-bytes @ 0 d-
  121:     4 ;                \ save-input
  122: :noname  loadfile @ ;  \ source-id
  123: :noname  tib max#tib @ loadfile @ (read-line) throw #fill-bytes !
  124:     swap #tib ! >in off 1 loadline +! ;
  125:                        \ refill
  126: terminal-input @       \ source -> terminal-input::source
  127: 
  128: | Create file-input  A, A, A, A, A,
  129: [THEN]
  130: 
  131: \ push-file, pop-file
  132: 
  133: : new-tib ( method n -- ) \ gforth
  134:     \G Create a new entry of the tib stack, size @i{n}, method table
  135:     \G @i{method}.
  136:     dup >r tib+ + dup allocate throw tuck swap 0 fill
  137:     current-input @ swap current-input ! old-input ! r> max#tib !
  138:     current-input @ ! ;
  139: has? file [IF]
  140: : push-file  ( -- ) \ gforth
  141:     \G Create a new file input buffer
  142:     file-input def#tib new-tib ;
  143: [THEN]
  144: : pop-file ( throw-code -- throw-code ) \ gforth
  145:     \G pop and free the current top input buffer
  146:     dup IF
  147: 	source >in @ sourceline#
  148: 	[ has? file [IF] ] sourcefilename [ [THEN] ]
  149: 	>error
  150:     THEN
  151:     current-input @ old-input @ current-input ! free throw ;
  152: 
  153: \ save-input, restore-input
  154: 
  155: : save-input ( -- x1 .. xn n ) \ core-ext
  156:     \G The @i{n} entries @i{xn - x1} describe the current state of the
  157:     \G input source specification, in some platform-dependent way that can
  158:     \G be used by @code{restore-input}.
  159:     (save-input) current-input @ swap 1+ ;
  160: : restore-input ( x1 .. xn n -- flag ) \ core-ext
  161:     \G Attempt to restore the input source specification to the state
  162:     \G described by the @i{n} entries @i{xn - x1}. @i{flag} is true if
  163:     \G the restore fails.  In Gforth with the new input code, it fails
  164:     \G only with a flag that can be used to throw again; it is also
  165:     \G possible to save and restore between different active input
  166:     \G streams. Note that closing the input streams must happen in the
  167:     \G reverse order as they have been opened, but in between
  168:     \G everything is allowed.
  169:     current-input @ >r swap current-input ! 1- dup >r
  170:     ['] (restore-input) catch
  171:     dup IF  r> 0 ?DO  nip  LOOP  r> current-input !  EXIT  THEN
  172:     rdrop rdrop ;
  173: 
  174: \ create terminal input block
  175: 
  176: : create-input ( -- )
  177:     \G create a new terminal input
  178:     terminal-input def#tib new-tib ;
  179:     ( loadfilename# off ) \ "*the terminal*"
  180: 
  181: : evaluate ( addr u -- ) \ core,block
  182:     \G Save the current input source specification. Store @code{-1} in
  183:     \G @code{source-id} and @code{0} in @code{blk}. Set @code{>IN} to
  184:     \G @code{0} and make the string @i{c-addr u} the input source
  185:     \G and input buffer. Interpret. When the parse area is empty,
  186:     \G restore the input source specification.
  187:     evaluate-input over new-tib
  188: [ has? file [IF] ]
  189:     1 loadfilename# ! \ "*evaluated string*"
  190: [ [THEN] ]
  191:     -1 loadline ! dup #tib ! tib swap move
  192:     ['] interpret catch pop-file throw ;
  193: 
  194: \ clear tibstack
  195: 
  196: : clear-tibstack ( -- ) \ gforth
  197:     \G clears the tibstack; if there is none, create the bottom entry:
  198:     \G the terminal input buffer.
  199:     current-input @ 0= IF  create-input  THEN
  200:     BEGIN  old-input @  WHILE  0 pop-file drop  REPEAT ;
  201: 
  202: : query ( -- ) \ core-ext
  203:     \G Make the user input device the input source. Receive input into
  204:     \G the Terminal Input Buffer. Set @code{>IN} to zero. OBSOLESCENT:
  205:     \G superceeded by @code{accept}.
  206:     clear-tibstack  refill drop ;
  207: 
  208: \ load a file
  209: 
  210: has? file [IF]
  211: : read-loop ( i*x -- j*x ) \ gforth
  212:     \G refill and interpret a file until EOF
  213:     BEGIN  refill  WHILE  interpret  REPEAT ;
  214: 
  215: : include-file2 ( i*x wfileid loadfilename# -- j*x )
  216:     push-file \ dup 2* cells included-files 2@ drop + 2@ type
  217:     loadfilename# !  loadfile !
  218:     ['] read-loop catch
  219:     loadfile @ close-file swap 2dup or
  220:     pop-file  drop throw throw ;
  221: 
  222: : include-file ( i*x wfileid -- j*x )
  223:     \G Interpret (process using the text interpreter) the contents of
  224:     \G the file @var{wfileid}.
  225:     3 include-file2 ;
  226: [THEN]