1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
|
\ @(#) quit.fth 98/01/26 1.2
\ Outer Interpreter in Forth
\
\ This used so that THROW can be caught by QUIT.
\
\ Author: Phil Burk
\ Copyright 1994 3DO, Phil Burk, Larry Polansky, Devid Rosenboom
\
\ The pForth software code is dedicated to the public domain,
\ and any third party may reproduce, distribute and modify
\ the pForth software code or any derivative works thereof
\ without any compensation or license. The pForth software
\ code is provided on an "as is" basis without any warranty
\ of any kind, including, without limitation, the implied
\ warranties of merchantability and fitness for a particular
\ purpose and their equivalents under the laws of any jurisdiction.
include? catch catch.fth
anew task-quit.fth
: FIND&COMPILE ( $word -- {n} , find word in dictionary and handle it )
dup >r \ save in case needed
find ( -- xt flag | $word 0 )
CASE
-1 OF \ not immediate
state @ \ compiling?
IF compile,
ELSE execute
THEN
ENDOF
1 OF execute \ immediate, so execute regardless of STATE
ENDOF
0 OF
number? \ is it a number?
num_type_single =
IF ?literal \ compile it or leave it on stack
ELSE
r@ count type ." is not recognized!!" cr
abort
THEN
ENDOF
ENDCASE
rdrop
;
: CHECK.STACK \ throw exception if stack underflows
depth 0<
IF
." QUIT: Stack underflow!" cr
depth negate 0 \ restore depth
?DO 0
LOOP
ERR_UNDERFLOW throw
THEN
;
\ interpret whatever is in source
: INTERPRET ( ?? -- ?? )
BEGIN
>in @ source nip ( 1- ) < \ any input left? !!! is -1 needed?
WHILE
bl word
dup c@ 0>
IF
0 >r \ flag
local-compiler @
IF
dup local-compiler @ execute ( ?? -- ?? )
r> drop TRUE >r
THEN
r> 0=
IF
find&compile ( -- {n} , may leave numbers on stack )
THEN
ELSE
drop
THEN
check.stack
REPEAT
;
: EVALUATE ( i*x c-addr num -- j*x , evaluate string of Forth )
\ save current input state and switch to pased in string
source >r >r
set-source
-1 push-source-id
>in @ >r
0 >in !
\ interpret the string
interpret
\ restore input state
pop-source-id drop
r> >in !
r> r> set-source
;
: POSTPONE ( <name> -- )
bl word find
CASE
0 OF ." Postpone could not find " count type cr abort ENDOF
1 OF compile, ENDOF \ immediate
-1 OF (compile) ENDOF \ normal
ENDCASE
; immediate
: OK
." OK "
trace-stack @
IF .s
ELSE cr
THEN
;
variable QUIT-QUIT
: QUIT ( -- , interpret input until none left )
quit-quit off
postpone [
BEGIN
refill
quit-quit @ 0= and
WHILE
\ ." TIB = " source type cr
['] interpret catch ?dup
IF
." Exception # " . cr
ELSE
state @ 0= IF ok THEN
THEN
REPEAT
;
|
