Powered by ViewCVS 1.0-dev
| 1 : | pazsan | 1.1 | \ Input handling (object oriented) 22oct00py |
| 2 : | |||
| 3 : | anton | 1.23 | \ Copyright (C) 2000,2003,2004,2005,2006,2007 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 : | anton | 1.22 | input-method source ( -- addr u ) \ core source |
| 30 : | pazsan | 1.4 | \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 : | anton | 1.11 | cell input-var >in ( -- addr ) \ core to-in |
| 57 : | pazsan | 1.1 | \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 : | anton | 1.17 | 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!}. | ||
| 65 : | anton | 1.22 | cell input-var #tib ( -- addr ) \ core-ext-obsolescent number-t-i-b |
| 66 : | pazsan | 1.1 | \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. | ||
| 70 : | anton | 1.11 | cell input-var max#tib ( -- addr ) \ gforth max-number-t-i-b |
| 71 : | pazsan | 1.1 | \G @code{input-var} variable -- This cell contains the maximum |
| 72 : | \G size of the current tib. | ||
| 73 : | anton | 1.11 | cell input-var old-input ( -- addr ) \ gforth |
| 74 : | pazsan | 1.1 | \G @code{input-var} variable -- This cell contains the pointer to |
| 75 : | \G the previous input buffer | ||
| 76 : | anton | 1.11 | cell input-var loadline ( -- addr ) \ gforth |
| 77 : | pazsan | 1.1 | \G @code{input-var} variable -- This cell contains the line that's |
| 78 : | \G currently loaded from | ||
| 79 : | has? file [IF] | ||
| 80 : | anton | 1.11 | cell input-var loadfile ( -- addr ) \ gforth |
| 81 : | pazsan | 1.1 | \G @code{input-var} variable -- This cell contains the file the |
| 82 : | \G input buffer is associated with (0 if none) | ||
| 83 : | anton | 1.22 | cell input-var blk ( -- addr ) \ block b-l-k |
| 84 : | pazsan | 1.1 | \G @code{input-var} variable -- This cell contains the current |
| 85 : | \G block number | ||
| 86 : | anton | 1.11 | cell input-var #fill-bytes ( -- addr ) \ gforth |
| 87 : | pazsan | 1.1 | \G @code{input-var} variable -- number of bytes read via |
| 88 : | \G (read-line) by the last refill | ||
| 89 : | anton | 1.11 | 2 cells input-var loadfilename ( -- addr ) \ gforth |
| 90 : | anton | 1.5 | \G @code{input-var} variable -- addr u describes name of currently |
| 91 : | \G interpreted input (file name or somesuch) | ||
| 92 : | pazsan | 1.1 | [THEN] |
| 93 : | anton | 1.22 | 0 input-var tib ( -- addr ) \ core-ext-obsolescent t-i-b |
| 94 : | pazsan | 1.1 | |
| 95 : | Constant tib+ | ||
| 96 : | |||
| 97 : | anton | 1.15 | \ helper words |
| 98 : | |||
| 99 : | anton | 1.16 | : input-lexeme! ( c-addr u -- ) |
| 100 : | \ record that the current lexeme us c-addr u | ||
| 101 : | anton | 1.17 | input-lexeme 2! ; |
| 102 : | |||
| 103 : | : input-start-line ( -- ) | ||
| 104 : | >in off source drop 0 input-lexeme! ; | ||
| 105 : | anton | 1.15 | |
| 106 : | pazsan | 1.1 | \ terminal input implementation |
| 107 : | |||
| 108 : | pazsan | 1.4 | :noname ( in 1 -- ) 1 <> -12 and throw >in ! ; |
| 109 : | pazsan | 1.1 | \ restore-input |
| 110 : | pazsan | 1.4 | :noname ( -- in 1 ) >in @ 1 ; \ save-input |
| 111 : | pazsan | 1.2 | ' false \ source-id |
| 112 : | pazsan | 1.4 | :noname ( -- flag ) [ has? file [IF] ] |
| 113 : | pazsan | 1.3 | stdin file-eof? IF false EXIT THEN [ [THEN] ] |
| 114 : | tib max#tib @ accept #tib ! | ||
| 115 : | anton | 1.15 | input-start-line true 1 loadline +! ; \ refill |
| 116 : | pazsan | 1.4 | :noname ( -- addr u ) tib #tib @ ; \ source |
| 117 : | pazsan | 1.1 | |
| 118 : | | Create terminal-input A, A, A, A, A, | ||
| 119 : | pazsan | 1.4 | :noname ( -- addr u ) tib @ #tib @ ; \ source |
| 120 : | pazsan | 1.1 | | Create evaluate-input |
| 121 : | pazsan | 1.2 | 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 | ||
| 126 : | pazsan | 1.1 | |
| 127 : | \ file input implementation | ||
| 128 : | |||
| 129 : | has? file [IF] | ||
| 130 : | anton | 1.11 | : read-line ( c_addr u1 wfileid -- u2 flag wior ) \ file |
| 131 : | (read-line) nip ; | ||
| 132 : | pazsan | 1.3 | |
| 133 : | pazsan | 1.4 | :noname ( in line# udpos 4 -- ) 4 <> -12 and throw |
| 134 : | pazsan | 1.1 | loadfile @ reposition-file throw |
| 135 : | refill 0= -36 and throw \ should never throw | ||
| 136 : | loadline ! >in ! ; \ restore-input | ||
| 137 : | pazsan | 1.4 | :noname ( -- in line# udpos 4 ) >in @ sourceline# |
| 138 : | pazsan | 1.1 | loadfile @ file-position throw #fill-bytes @ 0 d- |
| 139 : | 4 ; \ save-input | ||
| 140 : | pazsan | 1.4 | :noname ( -- file ) loadfile @ ; \ source-id |
| 141 : | :noname ( -- flag ) | ||
| 142 : | anton | 1.15 | #tib off #fill-bytes off input-start-line |
| 143 : | pazsan | 1.3 | 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 +! ; | ||
| 152 : | pazsan | 1.1 | \ 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 @ ! ; | ||
| 166 : | pazsan | 1.3 | : expand-tib ( n -- ) |
| 167 : | dup tib+ + current-input @ swap resize throw current-input ! | ||
| 168 : | max#tib ! tib max#tib @ #tib @ /string 0 fill ; | ||
| 169 : | pazsan | 1.1 | 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 | ||
| 177 : | anton | 1.15 | input-error-data >error |
| 178 : | pazsan | 1.1 | 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 ; | ||
| 207 : | anton | 1.5 | \ s" *the terminal*" loadfilename 2! |
| 208 : | pazsan | 1.1 | |
| 209 : | anton | 1.14 | : 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> | ||
| 213 : | pazsan | 1.1 | [ has? file [IF] ] |
| 214 : | anton | 1.14 | loadfilename 2! |
| 215 : | [ [ELSE] ] | ||
| 216 : | 2drop | ||
| 217 : | pazsan | 1.1 | [ [THEN] ] |
| 218 : | pazsan | 1.2 | -1 loadline ! #tib ! tib ! |
| 219 : | pazsan | 1.20 | r> catch pop-file throw ; |
| 220 : | anton | 1.14 | |
| 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 ; | ||
| 225 : | anton | 1.6 | |
| 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 ; | ||
| 233 : | pazsan | 1.1 | |
| 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 : | anton | 1.22 | : query ( -- ) \ core-ext-obsolescent |
| 243 : | pazsan | 1.1 | \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}. | ||
| 246 : | anton | 1.12 | clear-tibstack refill 0= -39 and throw ; |
| 247 : | pazsan | 1.1 | |
| 248 : | \ load a file | ||
| 249 : | |||
| 250 : | has? file [IF] | ||
| 251 : | anton | 1.9 | 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 : | |||
| 256 : | pazsan | 1.1 | : read-loop ( i*x -- j*x ) \ gforth |
| 257 : | \G refill and interpret a file until EOF | ||
| 258 : | anton | 1.9 | BEGIN refill WHILE interpret line-end-hook REPEAT ; |
| 259 : | pazsan | 1.1 | |
| 260 : | anton | 1.7 | : 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 | ||
| 262 : | anton | 1.5 | loadfilename 2! loadfile ! |
| 263 : | anton | 1.7 | r> catch |
| 264 : | pazsan | 1.1 | loadfile @ close-file swap 2dup or |
| 265 : | pazsan | 1.20 | pop-file drop throw throw ; |
| 266 : | pazsan | 1.1 | |
| 267 : | anton | 1.11 | : execute-parsing-file ( i*x fileid xt -- j*x ) \ gforth |
| 268 : | anton | 1.7 | \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 : | |||
| 272 : | anton | 1.11 | : include-file ( i*x wfileid -- j*x ) \ file |
| 273 : | pazsan | 1.1 | \G Interpret (process using the text interpreter) the contents of |
| 274 : | \G the file @var{wfileid}. | ||
| 275 : | anton | 1.7 | ['] read-loop execute-parsing-file ; |
| 276 : | pazsan | 1.1 | [THEN] |
|
CVS Admin Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |