1 \ @(#) misc1.fth 98/01/26 1.2
5 \ Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom
7 \ Permission to use, copy, modify, and/or distribute this
8 \ software for any purpose with or without fee is hereby granted.
10 \ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
11 \ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
12 \ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL
13 \ THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
14 \ CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING
15 \ FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
16 \ CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
17 \ OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
25 : (WARNING") ( flag $message -- )
32 : WARNING" ( flag <message> -- , print warning if true. )
33 [compile] " ( compile message )
40 : (ABORT") ( flag $message -- )
49 : ABORT" ( flag <message> -- , print warning if true. )
50 [compile] " ( compile message )
58 : ?PAUSE ( -- , Pause if key hit. )
60 IF key drop cr ." Hit space to continue, any other key to abort:"
61 key dup emit BL = not abort" Terminated"
67 : CR? ( -- , do CR if near end )
68 OUT @ #cols 16 - 10 max >
73 : CLS ( -- clear screen )
76 : PAGE ( -- , clear screen, compatible with Brodie )
80 : $ ( <number> -- N , convert next number as hex )
82 bl lword number? num_type_single = not
83 abort" Not a single number!"
97 variable TAB-WIDTH 8 TAB-WIDTH !
98 : TAB ( -- , tab over to next stop )
100 tab-width @ swap - spaces
103 $ 20 constant FLAG_SMUDGE
109 WHILE ( -- count NFA )
110 dup c@ flag_smudge and 0=
112 dup id. tab cr? ?pause
125 : >NAME ( xt -- nfa , scans dictionary for closest nfa, SLOW! )
130 IF ( -- addr nfa ) 2dup name> ( addr nfa addr xt ) <
131 IF true ( addr below this cfa, can't be it)
133 2dup name> ( addr nfa addr xt ) =
134 IF ( found it ! ) dup closest-nfa ! false
135 ELSE dup name> closest-xt @ >
136 IF dup closest-nfa ! dup name> closest-xt !
145 REPEAT ( -- cfa nfa )
150 : @EXECUTE ( addr -- , execute if non-zero )
156 : TOLOWER ( char -- char_lower )
159 IF ascii A - ascii a +
164 : EVALUATE ( i*x c-addr num -- j*x , evaluate string of Forth )
165 \ save current input state and switch to passed in string
171 \ interpret the string
173 \ restore input state
179 : \S ( -- , comment out rest of file )
182 BEGIN \ using REFILL is safer than popping SOURCE-ID