-
Notifications
You must be signed in to change notification settings - Fork 1
/
assign.fiv
374 lines (360 loc) · 10.8 KB
/
assign.fiv
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
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
X
!00000000
-*-
v
^
!00000112
\ This exponent program does not work well on numbers close to zero.
\ For example, .01 2. ^ yields: .0000709 (It should be .0001)
\
\ We wrote a ^ module that works fine, but I don't have it. Put yours
\ in instead of this one.
float
: ^
fswap flog f* fexp
;
-*-
>
:=
!0000022B
( addr -> )
\ Compiles the following expression storing the results at addr. The expression
\ is terminated by a semicolon. If any thing is not in the operator list, it is
\ considered a variable. You can easily die if you mess up and put a module in
\ as a variable.
float
: :=
state c@ 0= abort" Assignment statments are only allowed in compile mode."
>in @ 10 text >in !
pad 1- buff 150 move \ Save the expression for error messages.
['] abort 64
express
drop drop drop drop
compile f!
1 >in +!
; immediate
-*-
v
PP
!0000024D
\ This is a debugging print routine.
: pp 0 \ <<<--- If this is a 1, run time trace occurs on expressions.
\ is a 2, the postfix expression is printed.
\ is none of the above, nothing happens.
dup 1 = if \ Run time debugging.
drop
[compile] literal compile count compile type
compile .s
compile key compile drop
else
2 = if \ Compile time debugging
count type
else
drop \ No debugging.
endif
endif
;
-*-
>
BUFF
!00000017
create buff 200 allot
-*-
>
OPLIST
!000001AC
\ ( string -> addr num )
\ Returns the address and number of the operator or identifier.
\ Operator Num
\ --------------
\ constant 0
\ variable 8
\ + 16
\ - 24
\ * 32
\ / 40
\ ( 48
\ ) 56
\ ; 64
\ [ 72
\ ] 80
\ ^ 88
define oplist
-*-
v
DEFINE
!000004DB
float
: define
create \ Create the module.
here \ Address of number of entries.
0 , \ Number of entries spot.
here \ Addr of beginning of list.
" +" , ['] f+ , \ All arithmetic is done in floating point.
" -" , ['] f- ,
" *" , ['] f* ,
" /" , ['] f/ ,
" (" , ['] abort , \ Left paren.
" )" , ['] abort , \ Right paren.
" ;" , ['] abort , \ End of statement marker.
" [" , ['] abort , \ Begin subscript (or function) marker.
" ]" , ['] abort , \ Close subscript (or function) marker.
" ^" , ['] ^ , \ You must supply exponent routine.
here swap - \ Compute length of list.
swap ! \ Save this away. (Number of entries = length/8)
does>
dup 4 + swap @ 0 do
stack ab|abab @ str= if
swap drop 4 + @ i 16 + exit
endif
8 +
8 +loop
drop dup find
-1 = if stack ab|b 8 exit \ Token
else a->i swap c@ 0= if stack ab|b i->f 0 exit endif \ Integer
drop a->f s->f c@ 0= if 0 exit endif \ Float
endif
0 24 gotoxy cr cr buff count type cr
." Token Not Found error in := statement: " count type cr cr abort
;
-*-
v
STR=
!00000101
( str1 str2 -> flag )
\ flag = -1 if str1 = str2
\ otherwise flag = 0
: str=
over c@ 1+ 0 do \ For 0 to character count do:
over c@ over c@ =
if else drop drop 0 exit endif
1+ swap 1+
loop
drop drop -1
;
-*-
^
^
>
PREC
!0000000D
define prec
-*-
v
DEFINE
!00000585
: define
create
\ 0 8 16 24 32 40 48 56 64 72 80 88
\ lit var + - * / ( ) ; [ ] ^
\ +----------------------------------------------------------------------
( lit) 15 c, 15 c, 0 c, 0 c, 0 c, 0 c, 15 c, 1 c, 1 c, 15 c, 1 c, 0 c,
( var) 15 c, 15 c, 0 c, 0 c, 0 c, 0 c, 15 c, 1 c, 1 c, 15 c, 1 c, 0 c,
( + ) 1 c, 1 c, 1 c, 1 c, 0 c, 0 c, 15 c, 1 c, 1 c, 15 c, 1 c, 0 c,
( - ) 1 c, 1 c, 1 c, 1 c, 0 c, 0 c, 15 c, 1 c, 1 c, 15 c, 1 c, 0 c,
( * ) 1 c, 1 c, 1 c, 1 c, 1 c, 1 c, 15 c, 1 c, 1 c, 15 c, 1 c, 0 c,
( / ) 1 c, 1 c, 1 c, 1 c, 1 c, 1 c, 15 c, 1 c, 1 c, 15 c, 1 c, 0 c,
( { ) 1 c, 1 c, 0 c, 0 c, 0 c, 0 c, 0 c, 2 c, 15 c, 15 c, 15 c, 0 c,
( } ) 15 c, 15 c, 15 c, 15 c, 15 c, 15 c, 15 c, 15 c, 15 c, 15 c, 15 c, 15 c,
( ; ) 0 c, 0 c, 0 c, 0 c, 0 c, 0 c, 0 c, 15 c, 3 c, 15 c, 15 c, 0 c,
( [ ) 1 c, 1 c, 0 c, 0 c, 0 c, 0 c, 0 c, 15 c, 15 c, 15 c, 4 c, 0 c,
( ] ) 15 c, 15 c, 15 c, 15 c, 15 c, 15 c, 15 c, 15 c, 15 c, 15 c, 15 c, 15 c,
( ^ ) 1 c, 1 c, 1 c, 1 c, 1 c, 1 c, 0 c, 1 c, 1 c, 15 c, 1 c, 0 c,
does>
stack abc|bca 8 / stack abc|bca 8 /
swap 12 * + dup 144 u< if else
0 24 gotoxy cr
buff count type
." You have an ill eagle in your := statement " abort
endif
+ c@
;
-*-
^
>
EXPRESS
!0000035C
\ ( -> ) Compiles an expression pointed to by >in.
float
: express
32 word oplist \ Get a token.
dup 0 = if drop " c" pp [compile] fliteral else \ Compile a constant.
dup 8 = if drop \ This is a variable or array.
array? \ Compile subscripts if an array.
" a" pp
[compile] literal \ Compile execution address.
compile execute compile f@ else \ Compile an EXECUTE and a Fetch.
dup 48 = if express else
dup 56 = if reduce express else \ End of parenthesis?
0 24 gotoxy cr cr buff count type cr
." Something is out of order in your := statement! " cr cr abort
endif
endif
endif
endif
32 word oplist reduce \ Reduce operators.
;
-*-
v
ARRAY?
!00000205
\ Check to see if we are dealing with an array. If so, evaluate the subscripts.
float
: array?
>in @ 32 word oplist dup 72 = if \ Is it an array?
" [" pp
stack abc|bc \ If so, get rid of the text pointer.
express \ Evaluate the subscript expression.
compile f->i \ Force to integer
else
drop drop >in ! \ Restore the text pointer if it's not
endif \ an array.
;
-*-
>
REDUCE
!0000037C
\ Reduces an operator.
float
: reduce
stack ABCD|ABCDBD
prec \ Get precedence code.
dup 1 = if \ 1 = Reduce an operator.
stack ABCDE|CDA
" &" pp
[compile] literal compile execute
reduce exit
endif
dup 4 = if \ End a subscript.
" ]" pp
drop drop drop drop drop \ Drop brackets, and
array? exit \ check for more subscripts.
endif
dup 2 = if drop drop drop drop drop exit endif \ Remove paren's from stack.
dup 15 = if \ An ill eagle state found.
0 24 gotoxy cr cr buff count type cr
." I can't figure out your := statement. Sorry." cr cr abort
endif
3 = if exit endif \ End of statement found.
express
;
-*-
^
^
>
README
!0000055D
float
: readme
\ These are some examples of expressions.
a := 3.5 + 1.0 + -6.7 - 8.001 * 3.5 + 7.6 ;
\ Every token ( a number, operator, variable ) MUST be seperated by a space.
5 0 do
i i->f k f!
3 d := 7.5 ;
2 k @ e := 9.6 ;
3 d := d [ 3 ] + e [ 2 ] [ k ] ;
loop
\ Notice that to the left of the := you use Fifth code to get the address
\ the results of the expression are to be stored at.
\ Notice how pairs of subscripts can be specified. This is the same as
\ Basic's e(2,5). This is the same notation C uses. The subscripts are
\ handled by the array, NOT by :=. See E ad D's definition.
\ Another limitation is that I can not be used as a subscript. Store I in
\ a convienent variable, then use the variable.
a := 5. + 2. * 0. ; \ Same as a := 5. + ( 2. * 0. ) ;
c := a + a * 2. ^ 3. ^ 2. ; \ Same as a := a + ( a * ( 2. ^ ( 3. ^ 2. ) ) ) ;
\ The order of operations between operators hold. A little "behind the scenes"
\ explaination is in order now. What does the := module do? Given the
\ following:
\
\ := 4. + 3. * 7.
\
\ The := module compiles the code to do:
\
\ 4. 3. 7. f* f+ f!
\
\ Thus If you neglect to leave a valid address on the stack, := is going to
\ blow up. Also, if you specify a procedure instead of a variable, your
\ system will most likely crash.
;
-*-
v
A
!00000013
float fvariable a
-*-
>
B
!00000013
float fvariable b
-*-
>
C
!00000013
float fvariable c
-*-
>
D
!000000A8
( subscript -> address )
\ D is a 10 element array. See DEFINE below for D's definition.
\ Takes the subscript and returns the address of that element.
define d
-*-
v
DEFINE
!000002CD
\ The execution of this module will create a array which takes a subscript
\ from the stack and returns the address of that element.
: define
create \ Create a module.
10 10 * allot \ Allot room for 10 elements, 10 bytes each.
does> \ Define this module's run time behavior.
\ ( Remember that the address of beginning of the 10
\ elements allotted above has been pushed on the
\ stack prior to this code. )
swap dup 10 u< if else \ Do range checking.
." Out of range" abort
endif
10 * + \ Multiply the subscript by 10, add to beginning address.
;
-*-
^
>
E
!000000A8
( subscript subscript -> address )
\ Expects two subscripts, returns address of the specified element.
\ E is a 5x5 array. See DEFINE for the definition.
define e
-*-
v
DEFINE
!000003A6
\ The execution of this module will create a array which takes two subscripts
\ from the stack and returns the address of that element.
: define
create \ Create a module.
5 5 * 10 * allot \ Allot room for a 5x5 array, each element is 10 bytes.
does> \ Define this module's run time behavior.
\ ( Remember that the address of beginning of the
\ first element has been pushed on the stack
\ on top of the subscripts prior to the execution
\ of this code. )
stack abc|cabab \ Put subscripts on top of stack, address on bottom.
5 u< swap 5 u< and \ Are both subscripts under 5?
if else \ If not, you have an error.
." Out of range" abort
endif
5 * + 10 * + \ Multiply the subscript by 10, add to beginning address.
;
-*-
^
>
K
!00000013
float fvariable k
-*-
^
^