Annotation of gforth/kernel/input.fs, revision 1.1
1.1 ! pazsan 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]
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to input.fs CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [gforth] / gforth / kernel