-
Notifications
You must be signed in to change notification settings - Fork 15
/
find.zap
578 lines (545 loc) · 12 KB
/
find.zap
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
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
.SEGMENT "0"
.FUNCT FIND-DESCENDANTS:ANY:2:2,PARENT,FLAGS,F,FOBJ
SET 'F,FINDER
EQUAL? PARENT,GLOBAL-HERE \?CND1
SET 'PARENT,HERE
?CND1: FIRST? PARENT >FOBJ \TRUE
?PRG6: CALL2 VISIBLE?,FOBJ
ZERO? STACK /?CND8
BTST FLAGS,8 /?CND10
BTST FLAGS,1 \?PRF16
PUSH 1
JUMP ?PEN14
?PRF16: PUSH 0
?PEN14: CALL MATCH-OBJECT,FOBJ,F,STACK
ZERO? STACK /FALSE
?CND10: BTST FLAGS,4 \?CND8
FIRST? FOBJ \?CND8
EQUAL? FOBJ,WINNER /?CND8
FSET? FOBJ,SEARCHBIT \?PRD24
FSET? FOBJ,OPENBIT /?CCL18
FSET? FOBJ,TRANSBIT /?CCL18
?PRD24: FSET? FOBJ,SURFACEBIT \?CND8
?CCL18: BTST FLAGS,1 \?CCL33
PUSH 5
JUMP ?CND31
?CCL33: PUSH 4
?CND31: CALL FIND-DESCENDANTS,FOBJ,STACK
ZERO? STACK /FALSE
?CND8: NEXT? FOBJ >FOBJ /?PRG6
RTRUE
.FUNCT EXCLUDED?:ANY:2:2,FOBJ,F,EXC,PHRASE,CT,VEC,VV
GET F,8 >EXC
ZERO? EXC /FALSE
GET EXC,3 >PHRASE
GET PHRASE,1 >CT
ADD PHRASE,6 >VEC
?PRG6: DLESS? 'CT,0 \?CND8
SET 'VV,FALSE-VALUE
JUMP ?REP7
?CND8: GET VEC,0
EQUAL? FOBJ,STACK \?CND10
SET 'VV,TRUE-VALUE
?REP7: ZERO? VV \TRUE
GET EXC,1 >EXC
ZERO? EXC /FALSE
GET EXC,3 >PHRASE
GET PHRASE,1 >CT
ADD PHRASE,6 >VEC
JUMP ?PRG6
?CND10: ADD VEC,4 >VEC
JUMP ?PRG6
.FUNCT INVALID-OBJECT?:ANY:1:1,OBJ
RFALSE
.FUNCT MATCH-OBJECT:ANY:3:3,FOBJ,F,INCLUDE?,NOUN,ADJS,APP,TB,RES,?TMP1
GET F,9 >RES
FSET? FOBJ,INVISIBLE /TRUE
GET F,6 >NOUN
EQUAL? NOUN,FALSE-VALUE,W?ONE /?PRD6
GETPT FOBJ,P?SYNONYM >TB
ZERO? TB /TRUE
PTSIZE TB
DIV STACK,2
INTBL? NOUN,TB,STACK \TRUE
?PRD6: GET F,7 >ADJS
ZERO? ADJS /?PRD11
CALL CHECK-ADJS,FOBJ,F,ADJS
ZERO? STACK /TRUE
?PRD11: GET F,5 >ADJS
ZERO? ADJS /?PRD14
CALL CHECK-ADJS,FOBJ,F,ADJS
ZERO? STACK /TRUE
?PRD14: CALL EXCLUDED?,FOBJ,F
ZERO? STACK \TRUE
GET F,1
BTST STACK,1 /?CTR2
CALL2 INVALID-OBJECT?,FOBJ
ZERO? STACK \TRUE
?CTR2: ZERO? INCLUDE? /TRUE
GET F,5 >ADJS
ZERO? ADJS /?CCL24
GET ADJS,4 >?TMP1
GETPT FOBJ,P?ADJECTIVE
PTSIZE STACK
DIV STACK,2
EQUAL? ?TMP1,STACK \?CCL24
PUT RES,1,1
PUT RES,2,FALSE-VALUE
PUT RES,4,FOBJ
EQUAL? FOBJ,HERE \FALSE
PUT RES,4,GLOBAL-HERE
RFALSE
?CCL24: GET F,0 >APP
ZERO? APP /?CCL31
GET F,1
BTST STACK,1 /?CCL31
GET RES,1
ZERO? STACK /?CTR35
GET F,2
ZERO? STACK /?CCL36
?CTR35: CALL ADD-OBJECT,FOBJ,F
RSTACK
?CCL36: CALL TEST-OBJECT,FOBJ,APP,F
ZERO? STACK /FALSE
GET RES,1
EQUAL? STACK,1 \?CCL43
GET RES,4
CALL TEST-OBJECT,STACK,APP,F
ZERO? STACK \?CCL46
PUT RES,4,FOBJ
EQUAL? FOBJ,HERE \TRUE
PUT RES,4,GLOBAL-HERE
RTRUE
?CCL46: CALL ADD-OBJECT,FOBJ,F
RSTACK
?CCL43: CALL ADD-OBJECT,FOBJ,F
RSTACK
?CCL31: ZERO? APP \?CCL50
GET F,1
BTST STACK,1 \?CTR52
GET F,2
ZERO? STACK /TRUE
?CTR52: CALL ADD-OBJECT,FOBJ,F
RSTACK
?CCL50: CALL TEST-OBJECT,FOBJ,APP,F
ZERO? STACK /TRUE
CALL ADD-OBJECT,FOBJ,F
RSTACK
.FUNCT TEST-OBJECT:ANY:3:3,FOBJ,APP,F,N,NN,?TMP1
BAND APP,65280
ZERO? STACK \?CCL3
BTST APP,128 \?CCL6
BAND APP,63
FSET? FOBJ,STACK /FALSE
RTRUE
?CCL6: FSET? FOBJ,APP /TRUE
RFALSE
?CCL3: GET APP,1
BTST STACK,256 \?CND12
GET APP,1
BAND STACK,63
GETP FOBJ,STACK >?TMP1
GET APP,2
EQUAL? ?TMP1,STACK /TRUE
RFALSE
?CND12: GET APP,0 >N
?PRG17: GET APP,N >NN
BTST NN,128 \?CCL21
BAND NN,63
FSET? FOBJ,STACK /?CND19
RTRUE
?CCL21: FSET? FOBJ,NN /TRUE
?CND19: DLESS? 'N,1 \?PRG17
RFALSE
.FUNCT ADD-OBJECT:ANY:2:2,OBJ,F,VEC,NC,DOIT?,SYN,WHICH,?TMP1
GET F,9 >VEC
SET 'DOIT?,TRUE-VALUE
GET F,3 >SYN
GET F,4 >WHICH
EQUAL? OBJ,HERE \?CND1
SET 'OBJ,GLOBAL-HERE
?CND1: GET F,2
ZERO? STACK \?CND3
ZERO? SYN /?CND3
GET VEC,1
EQUAL? 1,STACK \?CND3
CALL MULTIPLE-EXCEPTION?,OBJ,SYN,WHICH,F
ZERO? STACK /?CCL10
SET 'DOIT?,FALSE-VALUE
JUMP ?CND3
?CCL10: GET VEC,4
CALL MULTIPLE-EXCEPTION?,STACK,SYN,WHICH,F
ZERO? STACK /?CND3
PUT VEC,4,OBJ
SET 'DOIT?,FALSE-VALUE
?CND3: ZERO? DOIT? /TRUE
GET F,2
ZERO? STACK /?PRD17
GET F,3
ZERO? STACK /?PRD17
GET F,3 >?TMP1
GET F,4
CALL MULTIPLE-EXCEPTION?,OBJ,?TMP1,STACK,F
ZERO? STACK \TRUE
?PRD17: CALL NOT-IN-FIND-RES?,OBJ,VEC >WHICH
ZERO? WHICH /TRUE
GET VEC,1
ADD 1,STACK
PUT VEC,1,STACK
PUT WHICH,0,OBJ
GET F,2
EQUAL? STACK,NP-QUANT-A /FALSE
RTRUE
.FUNCT NOT-IN-FIND-RES?:ANY:2:3,OBJ,VEC,NO-CHANGE?,CT,SZ,ANS,NVEC,NEW-OBJECT
GET VEC,1 >CT
GET VEC,0 >SZ
?PRG1: ADD VEC,8 >ANS
LESS? CT,1 \?CCL5
RETURN ANS
?CCL5: GRTR? CT,SZ \?CCL7
SUB CT,SZ >CT
JUMP ?CND3
?CCL7: SET 'SZ,CT
?CND3: INTBL? OBJ,ANS,SZ /FALSE
GET VEC,2 >NVEC
ZERO? NVEC /?CCL12
SET 'VEC,NVEC
SET 'SZ,FIND-RES-MAXOBJ
JUMP ?PRG1
?CCL12: LESS? SZ,FIND-RES-MAXOBJ \?CCL14
MUL 2,SZ
ADD ANS,STACK
RSTACK
?CCL14: ZERO? NO-CHANGE? \TRUE
SET 'SZ,FIND-RES-MAXOBJ
CALL DO-PMEM-ALLOC,7,9 >NEW-OBJECT
SET 'NVEC,NEW-OBJECT
PUT VEC,2,NVEC
ADD NVEC,8
RSTACK
.FUNCT EVERYWHERE-VERB?:ANY:0:2,WHICH,SYNTAX,SYN
ASSIGNED? 'WHICH /?CND1
GET FINDER,4 >WHICH
?CND1: ASSIGNED? 'SYNTAX /?CND3
GET PARSE-RESULT,3 >SYNTAX
?CND3: EQUAL? WHICH,1 \?CCL7
GETB SYNTAX,5 >SYN
JUMP ?CND5
?CCL7: GETB SYNTAX,9 >SYN
?CND5: BTST SYN,128 \FALSE
BTST SYN,64 \TRUE
RFALSE
.FUNCT MULTIPLE-EXCEPTION?:ANY:4:4,OBJ,SYNTAX,WHICH,F,L,VB
LOC OBJ >L
GET SYNTAX,0 >VB
EQUAL? OBJ,FALSE-VALUE,ROOMS \?CCL3
INC 'P-NOT-HERE
RTRUE
?CCL3: CALL EVERYWHERE-VERB?,WHICH,SYNTAX
ZERO? STACK \?CCL5
CALL2 ACCESSIBLE?,OBJ
ZERO? STACK /TRUE
?CCL5: EQUAL? VB,V?TAKE \?CCL9
GET F,6
ZERO? STACK \?CCL9
EQUAL? WHICH,1 \?CCL9
FSET? OBJ,TAKEBIT /?CCL15
FSET? OBJ,TRYTAKEBIT \TRUE
?CCL15: EQUAL? L,WINNER /TRUE
RFALSE
?CCL9: EQUAL? VB,V?DROP \FALSE
IN? OBJ,WINNER \TRUE
RFALSE
.FUNCT CHECK-ADJS-THERE?:ANY:1:1,OWNER,TMP
GET OWNER-SR-THERE,1 >TMP
ZERO? TMP /FALSE
INTBL? OWNER,OWNER-SR-THERE+8,TMP /TRUE
RFALSE
.FUNCT CHECK-ADJS:ANY:3:3,OBJ,F,ADJS,CNT,TMP,OWNER,ID,VEC,CT,ADJ,FL,OADJS,NUM,?TMP1
GETP OBJ,P?OWNER >OWNER
GETB ADJS,1
EQUAL? STACK,2 /?CCL2
GET ADJS,2 >TMP
ZERO? TMP /?CND1
?CCL2: SET 'ID,OWNER
LESS? 0,ID \?CCL7
SET 'ID,OWNER
GRTR? ID,LAST-OBJECT /?CCL7
EQUAL? OWNER,TMP /?CND1
EQUAL? OWNER,ROOMS \?CCL14
GET OWNER-SR-HERE,1
ZERO? STACK /?CCL17
GET OWNER-SR-HERE,4 >ID
JUMP ?CND1
?CCL17: GET OWNER-SR-THERE,1
ZERO? STACK /FALSE
GET OWNER-SR-THERE,4 >ID
JUMP ?CND1
?CCL14: GET OWNER-SR-HERE,1 >TMP
ZERO? TMP \?CCL21
CALL2 CHECK-ADJS-THERE?,OWNER
ZERO? STACK \?CND1
RFALSE
?CCL21: INTBL? OWNER,OWNER-SR-HERE+8,TMP /?CND1
CALL2 CHECK-ADJS-THERE?,OWNER
ZERO? STACK \?CND1
RFALSE
?CCL7: ZERO? OWNER /?CCL28
GET OWNER-SR-HERE,1 >CNT
ZERO? CNT \?CCL31
SET 'ID,PLAYER
JUMP ?CND1
?CCL31: ADD OWNER,2 >TMP
SET 'VEC,OWNER-SR-HERE+8
?PRG33: DLESS? 'CNT,0 /FALSE
GET VEC,0 >?TMP1
GET OWNER,0
INTBL? ?TMP1,TMP,STACK >ID \?CCL39
GET ID,0 >ID
JUMP ?CND1
?CCL39: ADD VEC,2 >VEC
JUMP ?PRG33
?CCL28: LESS? 0,TMP \?CCL41
GRTR? TMP,LAST-OBJECT /?CCL41
CALL HELD?,OBJ,TMP
ZERO? STACK \?CND1
RFALSE
?CCL41: GET OWNER-SR-HERE,1 >TMP
ZERO? TMP /FALSE
LOC OBJ
INTBL? STACK,OWNER-SR-HERE+8,TMP >ID \FALSE
?CND1: EQUAL? ID,0,OBJ /?CND50
GET F,9
PUT STACK,3,ID
?CND50: GETB ADJS,1
EQUAL? STACK,2 /TRUE
ADD ADJS,10 >VEC
GET ADJS,4 >CT
GETPT OBJ,P?ADJECTIVE >OADJS
PTSIZE OADJS
DIV STACK,2 >NUM
?PRG54: DLESS? 'CT,0 /TRUE
GET VEC,CT >ADJ
SET 'ID,ADJ
EQUAL? ADJ,W?NO.WORD /?PRG54
INTBL? ID,OADJS,NUM /?PRG54
EQUAL? ID,W?CLOSED,W?SHUT \?CCL63
FSET? OBJ,OPENBIT \?PRG54
?CCL63: EQUAL? ID,W?OPEN \FALSE
FSET? OBJ,OPENBIT /?PRG54
RFALSE
.FUNCT SEARCH-IN-LG?:ANY:1:1,OBJ
RFALSE
.FUNCT EXCLUDE-HERE-OBJECT?:ANY:0:0
RFALSE
.FUNCT FIND-OBJECTS:ANY:0:3,SEARCH,PARENT,NO-ADJACENT,GLBS,CONT?,N,RES,NEW-OBJECT,LOSING?,FLAG,?PR-FLAG,O,OBJ,?TMP1,?TMP2
ASSIGNED? 'SEARCH /?CND1
GET FINDER,4
EQUAL? 1,STACK \?CCL5
GET PARSE-RESULT,3
GETB STACK,5 >SEARCH
JUMP ?CND1
?CCL5: GET PARSE-RESULT,3
GETB STACK,9 >SEARCH
?CND1: SET 'CONT?,TRUE-VALUE
GET FINDER,9 >RES
PUT RES,1,0
PUT RES,2,FALSE-VALUE
ZERO? PARENT /?CCL8
CALL FIND-DESCENDANTS,PARENT,7
ZERO? STACK /?CND6
GET RES,1
ZERO? STACK \?CND6
?CCL8: ZERO? PARENT /?CND13
ZERO? NO-ADJACENT \?CND13
GET FINDER,5 >GLBS
ZERO? GLBS \?CND13
CALL DO-PMEM-ALLOC,1,8 >NEW-OBJECT
PUT NEW-OBJECT,2,PARENT
SET 'GLBS,NEW-OBJECT
PUT FINDER,5,GLBS
?CND13: BTST SEARCH,128 \?CND19
BTST SEARCH,64 /?CND19
FIRST? GENERIC-OBJECTS \?CND19
FIRST? GENERIC-OBJECTS >NEW-OBJECT /?PRG25
?PRG25: CALL MATCH-OBJECT,NEW-OBJECT,FINDER,TRUE-VALUE
ZERO? STACK /?REP26
NEXT? NEW-OBJECT >NEW-OBJECT /?PRG25
?REP26: GET RES,1 >CONT?
ZERO? CONT? /?CND19
EQUAL? CONT?,1 /TRUE
RFALSE
?CND19: SET 'LOSING?,FALSE-VALUE
?PRG35: ZERO? LOSING? \?PRD40
BAND SEARCH,12
ZERO? STACK \?CCL38
?PRD40: ZERO? LOSING? /?CND37
?CCL38: ZERO? LOSING? \?CTR44
BTST SEARCH,8 \?CCL45
?CTR44: SET '?PR-FLAG,6
JUMP ?CND43
?CCL45: SET '?PR-FLAG,2
?CND43: ZERO? LOSING? \?CTR49
BAND SEARCH,12
ZERO? STACK /?CCL50
?CTR49: BOR 1,?PR-FLAG >FLAG
JUMP ?CND48
?CCL50: BAND ?PR-FLAG,-2 >FLAG
?CND48: ZERO? LOSING? \?CCL55
BTST SEARCH,4 /?CCL55
BOR 8,FLAG
JUMP ?CND53
?CCL55: BAND FLAG,-9
?CND53: CALL FIND-DESCENDANTS,WINNER,STACK >CONT?
?CND37: ZERO? LOSING? \?CCL59
BAND SEARCH,3
ZERO? STACK /?CND58
?CCL59: ZERO? LOSING? \?CTR63
BAND SEARCH,3
ZERO? STACK /?CCL64
?CTR63: SET '?PR-FLAG,3
JUMP ?CND62
?CCL64: SET '?PR-FLAG,2
?CND62: ZERO? LOSING? \?CTR69
BTST SEARCH,2 \?CCL70
?CTR69: BOR 4,?PR-FLAG >FLAG
JUMP ?CND68
?CCL70: BAND ?PR-FLAG,-5 >FLAG
?CND68: ZERO? LOSING? \?CCL75
BTST SEARCH,1 /?CCL75
BOR 8,FLAG
JUMP ?CND73
?CCL75: BAND FLAG,-9
?CND73: CALL FIND-DESCENDANTS,HERE,STACK >CONT?
?CND58: GET RES,1
ZERO? STACK \?CND6
BTST SEARCH,15 /?CND78
ZERO? LOSING? \?CND78
GET TLEXV,0 >GLBS
ZERO? GLBS /?CCL86
GET GLBS,4
ZERO? STACK \?CTR85
GET GLBS,3
ZERO? STACK /?CCL86
?CTR85: SET 'LOSING?,TRUE-VALUE
JUMP ?PRG35
?CCL86: BTST SEARCH,64 \?CND78
BTST SEARCH,128 \FALSE
?CND78: GETPT HERE,P?GLOBAL >GLBS
ZERO? GLBS /?CND94
PTSIZE GLBS
DIV STACK,2 >N
?PRG97: DLESS? 'N,0 /?CND94
GET GLBS,N >O
CALL MATCH-OBJECT,O,FINDER,TRUE-VALUE >CONT?
ZERO? CONT? /?CND94
FIRST? O \?PRG97
BTST SEARCH,2 \?PRG97
CALL2 SEARCH-IN-LG?,O
ZERO? STACK /?PRG97
CALL FIND-DESCENDANTS,O,FD-INCLUDE? >CONT?
ZERO? CONT? \?PRG97
?CND94: ZERO? CONT? /?CND111
CALL1 EXCLUDE-HERE-OBJECT?
ZERO? STACK \?CND111
CALL MATCH-OBJECT,HERE,FINDER,TRUE-VALUE >CONT?
?CND111: ZERO? CONT? /?CND115
LOC PLAYER
EQUAL? HERE,STACK /?CND115
LOC PLAYER
GETP STACK,P?THINGS
ZERO? STACK /?CND115
LOC PLAYER
CALL TEST-THINGS,STACK,FINDER >CONT?
?CND115: ZERO? CONT? /?CND120
GETP HERE,P?THINGS
ZERO? STACK /?CND120
CALL TEST-THINGS,HERE,FINDER >CONT?
?CND120: GET RES,1
ZERO? STACK /?CND124
SET 'CONT?,FALSE-VALUE
?CND124: ZERO? CONT? /?CND126
BTST SEARCH,2 \?CCL130
PUSH 5
JUMP ?CND128
?CCL130: PUSH 1
?CND128: CALL FIND-DESCENDANTS,GLOBAL-OBJECTS,STACK >CONT?
?CND126: ZERO? CONT? /?CND131
GET RES,1
ZERO? STACK \?CND131
ZERO? NO-ADJACENT \?CND131
GETP HERE,P?ADJACENT >GLBS
ZERO? GLBS /?CND131
GETB GLBS,0 >N
?PRG137: GETB GLBS,N
ZERO? STACK /?CCL141
DEC 'N
GETB GLBS,N
ICALL FIND-OBJECTS,1,STACK,TRUE-VALUE
JUMP ?CND139
?CCL141: DEC 'N
?CND139: DLESS? 'N,1 \?PRG137
GET RES,1
ZERO? STACK /?CND131
SET 'CONT?,FALSE-VALUE
?CND131: ZERO? CONT? /?CND6
GET RES,1
ZERO? STACK \?CND6
BTST SEARCH,128 \?PRD152
BTST SEARCH,64 \?CCL147
?PRD152: GET PARSE-RESULT,1 >?TMP2
ADD WORD-FLAG-TABLE,2 >?TMP1
GET WORD-FLAG-TABLE,0
INTBL? ?TMP2,?TMP1,STACK,132 >O \?CCL157
GET O,1
JUMP ?CND155
?CCL157: PUSH FALSE-VALUE
?CND155: BTST STACK,512 \?CND6
?CCL147: SET 'OBJ,1
?PRG158: CALL MATCH-OBJECT,OBJ,FINDER,TRUE-VALUE
ZERO? STACK /?CND6
IGRTR? 'OBJ,LAST-OBJECT \?PRG158
?CND6: GET RES,1
EQUAL? STACK,1 /TRUE
RFALSE
.FUNCT TEST-THINGS:ANY:2:2,RM,F,CT,GLBS,N,NOUN,V,TTBL,MATCH,I,?TMP2,?TMP1
GETP RM,P?THINGS >GLBS
GETB GLBS,0 >N
INC 'GLBS
GET F,5 >CT
ZERO? CT /?CND1
GET CT,4 >CT
?CND1: GET F,6 >NOUN
GET F,5
ADD STACK,10 >V
SET 'MATCH,FALSE-VALUE
?PRG3: GET GLBS,1 >TTBL
ZERO? TTBL /?CND5
ADD TTBL,1 >?TMP1
GETB TTBL,0
INTBL? NOUN,?TMP1,STACK \?CND5
ZERO? CT \?CCL11
SET 'MATCH,TRUE-VALUE
JUMP ?CND9
?CCL11: GET GLBS,0 >TTBL
ZERO? TTBL /?CND9
SET 'I,0
?PRG13: GET V,I >?TMP2
ADD TTBL,1 >?TMP1
GETB TTBL,0
INTBL? ?TMP2,?TMP1,STACK \?CCL17
SET 'MATCH,TRUE-VALUE
JUMP ?CND9
?CCL17: SUB CT,1
IGRTR? 'I,STACK \?PRG13
?CND9: ZERO? MATCH /?CND5
SET 'LAST-PSEUDO-LOC,RM
GET GLBS,2
PUTP PSEUDO-OBJECT,P?ACTION,STACK
ICALL ADD-OBJECT,PSEUDO-OBJECT,F
RFALSE
?CND5: ADD GLBS,6 >GLBS
DLESS? 'N,1 \?PRG3
RFALSE
.ENDSEG
.ENDI