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