Annotation of gforth/kernel/input.fs, revision 1.19

1.1       pazsan      1: \ Input handling (object oriented)                      22oct00py
                      2: 
1.13      anton       3: \ Copyright (C) 2000,2003,2004,2005 Free Software Foundation, Inc.
1.1       pazsan      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
1.4       pazsan     29: input-method source ( -- addr u ) \ core-ext,file source
                     30:     \G Return address @i{addr} and length @i{u} of the current input
                     31:     \G buffer
1.1       pazsan     32: input-method refill ( -- flag ) \ core-ext,block-ext,file-ext
                     33:     \G Attempt to fill the input buffer from the input source.  When
                     34:     \G the input source is the user input device, attempt to receive
                     35:     \G input into the terminal input device. If successful, make the
                     36:     \G result the input buffer, set @code{>IN} to 0 and return true;
                     37:     \G otherwise return false. When the input source is a block, add 1
                     38:     \G to the value of @code{BLK} to make the next block the input
                     39:     \G source and current input buffer, and set @code{>IN} to 0;
                     40:     \G return true if the new value of @code{BLK} is a valid block
                     41:     \G number, false otherwise. When the input source is a text file,
                     42:     \G attempt to read the next line from the file. If successful,
                     43:     \G make the result the current input buffer, set @code{>IN} to 0
                     44:     \G and return true; otherwise, return false.  A successful result
                     45:     \G includes receipt of a line containing 0 characters.
                     46: input-method source-id ( -- 0 | -1 | fileid ) \ core-ext,file source-i-d
                     47:     \G Return 0 (the input source is the user input device), -1 (the
                     48:     \G input source is a string being processed by @code{evaluate}) or
                     49:     \G a @i{fileid} (the input source is the file specified by
                     50:     \G @i{fileid}).
                     51: | input-method (save-input) ( -- x1 .. xn n ) \ gforth
                     52: | input-method (restore-input) ( x1 .. xn n -- ) \ gforth
                     53: drop
                     54: 
                     55: cell \ the first cell points to the method table
1.11      anton      56: cell input-var >in ( -- addr ) \ core to-in
1.1       pazsan     57:     \G @code{input-var} variable -- @i{a-addr} is the address of a
                     58:     \G cell containing the char offset from the start of the input
                     59:     \G buffer to the start of the parse area.
1.17      anton      60: 2 cells input-var input-lexeme ( -- a-addr ) \ gforth-internal
                     61:     \G @code{input-var} variable -- @i{a-addr} is the address of two
                     62:     \G cells containing the string (in c-addr u form) parsed with
                     63:     \G @code{parse}, @code{parse-name} or @code{word}.  If you do your
                     64:     \G own parsing, you can set it with @code{input-lexeme!}.
1.11      anton      65: cell input-var #tib ( -- addr ) \ core-ext number-t-i-b
1.1       pazsan     66:     \G @code{input-var} variable -- @i{a-addr} is the address of a
                     67:     \G cell containing the number of characters in the terminal input
                     68:     \G buffer. OBSOLESCENT: @code{source} superceeds the function of
                     69:     \G this word.
1.11      anton      70: cell input-var max#tib ( -- addr ) \ gforth max-number-t-i-b
1.1       pazsan     71:     \G @code{input-var} variable -- This cell contains the maximum
                     72:     \G size of the current tib.
1.11      anton      73: cell input-var old-input ( -- addr ) \ gforth
1.1       pazsan     74:     \G @code{input-var} variable -- This cell contains the pointer to
                     75:     \G the previous input buffer
1.11      anton      76: cell input-var loadline ( -- addr ) \ gforth
1.1       pazsan     77:     \G @code{input-var} variable -- This cell contains the line that's
                     78:     \G currently loaded from
                     79: has? file [IF]
1.11      anton      80: cell input-var loadfile ( -- addr ) \ gforth
1.1       pazsan     81:     \G @code{input-var} variable -- This cell contains the file the
                     82:     \G input buffer is associated with (0 if none)
1.11      anton      83: cell input-var blk ( -- addr ) \ block
1.1       pazsan     84:     \G @code{input-var} variable -- This cell contains the current
                     85:     \G block number
1.11      anton      86: cell input-var #fill-bytes ( -- addr ) \ gforth
1.1       pazsan     87:     \G @code{input-var} variable -- number of bytes read via
                     88:     \G (read-line) by the last refill
1.11      anton      89: 2 cells input-var loadfilename ( -- addr ) \ gforth
1.5       anton      90:     \G @code{input-var} variable -- addr u describes name of currently
                     91:     \G interpreted input (file name or somesuch)
1.1       pazsan     92: [THEN]
1.11      anton      93: 0 input-var tib ( -- addr ) \ core
1.1       pazsan     94: 
                     95: Constant tib+
                     96: 
1.15      anton      97: \ helper words
                     98: 
1.16      anton      99: : input-lexeme! ( c-addr u -- )
                    100:     \ record that the current lexeme us c-addr u
1.17      anton     101:     input-lexeme 2! ;
                    102: 
                    103: : input-start-line ( -- )
                    104:     >in off  source drop 0 input-lexeme! ;
1.15      anton     105: 
1.1       pazsan    106: \ terminal input implementation
                    107: 
1.4       pazsan    108: :noname ( in 1 -- ) 1 <> -12 and throw >in ! ;
1.1       pazsan    109:                        \ restore-input
1.4       pazsan    110: :noname ( -- in 1 ) >in @ 1 ;     \ save-input
1.2       pazsan    111: ' false                \ source-id
1.4       pazsan    112: :noname ( -- flag ) [ has? file [IF] ] 
1.3       pazsan    113:     stdin file-eof?  IF  false  EXIT  THEN [ [THEN] ]
                    114:     tib max#tib @ accept #tib !
1.15      anton     115:     input-start-line true 1 loadline +! ;     \ refill
1.4       pazsan    116: :noname ( -- addr u ) tib #tib @ ;   \ source
1.1       pazsan    117: 
                    118: | Create terminal-input   A, A, A, A, A,
1.4       pazsan    119: :noname ( -- addr u ) tib @ #tib @ ; \ source
1.1       pazsan    120: | Create evaluate-input
1.2       pazsan    121:     A,                  \ source
                    122:     ' false A,          \ refill
                    123:     ' true A,           \ source-id
                    124:     terminal-input 3 cells + @ A, \ terminal::restore-input
                    125:     terminal-input 4 cells + @ A, \ terminal::save-input
1.1       pazsan    126: 
                    127: \ file input implementation
                    128: 
                    129: has? file [IF]
1.11      anton     130: : read-line ( c_addr u1 wfileid -- u2 flag wior ) \ file
                    131:     (read-line) nip ;
1.3       pazsan    132: 
1.4       pazsan    133: :noname  ( in line# udpos 4 -- ) 4 <> -12 and throw
1.1       pazsan    134:     loadfile @ reposition-file throw
                    135:     refill 0= -36 and throw \ should never throw
                    136:     loadline ! >in ! ; \ restore-input
1.4       pazsan    137: :noname  ( -- in line# udpos 4 ) >in @ sourceline#
1.1       pazsan    138:     loadfile @ file-position throw #fill-bytes @ 0 d-
                    139:     4 ;                \ save-input
1.4       pazsan    140: :noname  ( -- file ) loadfile @ ;  \ source-id
                    141: :noname  ( -- flag )
1.15      anton     142:     #tib off #fill-bytes off input-start-line
1.3       pazsan    143:     BEGIN
                    144:        tib max#tib @ #tib @ /string
                    145:        loadfile @ (read-line) throw #fill-bytes +!
                    146:        swap #tib +!
                    147:        \ auto-expanding the tib
                    148:        dup #tib @ #fill-bytes @ = and WHILE
                    149:            drop max#tib @ 2* expand-tib
                    150:     REPEAT
                    151:     1 loadline +! ;
1.1       pazsan    152:                        \ refill
                    153: terminal-input @       \ source -> terminal-input::source
                    154: 
                    155: | Create file-input  A, A, A, A, A,
                    156: [THEN]
                    157: 
                    158: \ push-file, pop-file
                    159: 
                    160: : new-tib ( method n -- ) \ gforth
                    161:     \G Create a new entry of the tib stack, size @i{n}, method table
                    162:     \G @i{method}.
                    163:     dup >r tib+ + dup allocate throw tuck swap 0 fill
                    164:     current-input @ swap current-input ! old-input ! r> max#tib !
                    165:     current-input @ ! ;
1.3       pazsan    166: : expand-tib ( n -- )
                    167:     dup tib+ + current-input @ swap resize throw current-input !
                    168:     max#tib ! tib max#tib @ #tib @ /string 0 fill ;
1.1       pazsan    169: has? file [IF]
                    170: : push-file  ( -- ) \ gforth
                    171:     \G Create a new file input buffer
                    172:     file-input def#tib new-tib ;
                    173: [THEN]
                    174: : pop-file ( throw-code -- throw-code ) \ gforth
                    175:     \G pop and free the current top input buffer
                    176:     dup IF
1.15      anton     177:        input-error-data >error
1.1       pazsan    178:     THEN
                    179:     current-input @ old-input @ current-input ! free throw ;
                    180: 
                    181: \ save-input, restore-input
                    182: 
                    183: : save-input ( -- x1 .. xn n ) \ core-ext
                    184:     \G The @i{n} entries @i{xn - x1} describe the current state of the
                    185:     \G input source specification, in some platform-dependent way that can
                    186:     \G be used by @code{restore-input}.
                    187:     (save-input) current-input @ swap 1+ ;
                    188: : restore-input ( x1 .. xn n -- flag ) \ core-ext
                    189:     \G Attempt to restore the input source specification to the state
                    190:     \G described by the @i{n} entries @i{xn - x1}. @i{flag} is true if
                    191:     \G the restore fails.  In Gforth with the new input code, it fails
                    192:     \G only with a flag that can be used to throw again; it is also
                    193:     \G possible to save and restore between different active input
                    194:     \G streams. Note that closing the input streams must happen in the
                    195:     \G reverse order as they have been opened, but in between
                    196:     \G everything is allowed.
                    197:     current-input @ >r swap current-input ! 1- dup >r
                    198:     ['] (restore-input) catch
                    199:     dup IF  r> 0 ?DO  nip  LOOP  r> current-input !  EXIT  THEN
                    200:     rdrop rdrop ;
                    201: 
                    202: \ create terminal input block
                    203: 
                    204: : create-input ( -- )
                    205:     \G create a new terminal input
                    206:     terminal-input def#tib new-tib ;
1.5       anton     207:     \ s" *the terminal*" loadfilename 2!
1.1       pazsan    208: 
1.14      anton     209: : execute-parsing-wrapper ( ... addr1 u1 xt addr2 u2 -- ... ) \ gforth-internal
                    210:     \ addr1 u1 is the string to be processed, xt is the word for
                    211:     \ processing it, addr2 u2 is the name of the input source
                    212:     rot >r 2>r evaluate-input cell new-tib 2r> 
1.1       pazsan    213: [ has? file [IF] ]
1.14      anton     214:     loadfilename 2!
                    215: [ [ELSE] ]
                    216:     2drop
1.1       pazsan    217: [ [THEN] ]
1.2       pazsan    218:     -1 loadline ! #tib ! tib !
1.19    ! pazsan    219:     r> catch pop-file rethrow ;
1.14      anton     220: 
                    221: : execute-parsing ( ... addr u xt -- ... ) \ gforth
                    222: \G Make @i{addr u} the current input source, execute @i{xt @code{(
                    223: \G ... -- ... )}}, then restore the previous input source.
                    224:     s" *evaluated string*" execute-parsing-wrapper ;
1.6       anton     225: 
                    226: : evaluate ( ... addr u -- ... ) \ core,block
                    227: \G Save the current input source specification. Store @code{-1} in
                    228: \G @code{source-id} and @code{0} in @code{blk}. Set @code{>IN} to
                    229: \G @code{0} and make the string @i{c-addr u} the input source and
                    230: \G input buffer. Interpret. When the parse area is empty, restore the
                    231: \G input source specification.
                    232:     ['] interpret execute-parsing ;
1.1       pazsan    233: 
                    234: \ clear tibstack
                    235: 
                    236: : clear-tibstack ( -- ) \ gforth
                    237:     \G clears the tibstack; if there is none, create the bottom entry:
                    238:     \G the terminal input buffer.
                    239:     current-input @ 0= IF  create-input  THEN
                    240:     BEGIN  old-input @  WHILE  0 pop-file drop  REPEAT ;
                    241: 
                    242: : query ( -- ) \ core-ext
                    243:     \G Make the user input device the input source. Receive input into
                    244:     \G the Terminal Input Buffer. Set @code{>IN} to zero. OBSOLESCENT:
                    245:     \G superceeded by @code{accept}.
1.12      anton     246:     clear-tibstack  refill 0= -39 and throw ;
1.1       pazsan    247: 
                    248: \ load a file
                    249: 
                    250: has? file [IF]
1.9       anton     251: defer line-end-hook ( -- ) \ gforth
                    252: \G called at every end-of-line when text-interpreting from a file    
                    253: \ alternatively we could use a wrapper for REFILL
                    254: ' noop is line-end-hook
                    255:     
1.1       pazsan    256: : read-loop ( i*x -- j*x ) \ gforth
                    257:     \G refill and interpret a file until EOF
1.9       anton     258:     BEGIN  refill  WHILE  interpret line-end-hook REPEAT ;
1.1       pazsan    259: 
1.7       anton     260: : execute-parsing-named-file ( i*x wfileid filename-addr filename-u xt -- j*x )
                    261:     >r push-file \ dup 2* cells included-files 2@ drop + 2@ type
1.5       anton     262:     loadfilename 2!  loadfile !
1.7       anton     263:     r> catch
1.1       pazsan    264:     loadfile @ close-file swap 2dup or
1.19    ! pazsan    265:     pop-file  drop rethrow throw ;
1.1       pazsan    266: 
1.11      anton     267: : execute-parsing-file ( i*x fileid xt -- j*x ) \ gforth
1.7       anton     268: \G Make @i{fileid} the current input source, execute @i{xt @code{( i*x
                    269: \G -- j*x )}}, then restore the previous input source.
                    270:     s" *a file*" rot execute-parsing-named-file ;
                    271: 
1.11      anton     272: : include-file ( i*x wfileid -- j*x ) \ file
1.1       pazsan    273:     \G Interpret (process using the text interpreter) the contents of
                    274:     \G the file @var{wfileid}.
1.7       anton     275:     ['] read-loop execute-parsing-file ;
1.1       pazsan    276: [THEN]

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