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