-
Notifications
You must be signed in to change notification settings - Fork 27
/
parser.zap
2885 lines (2734 loc) · 60 KB
/
parser.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
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
.FUNCT PARSER,PTR,VAL,VERB,OF-FLAG,LEN,DIR,NW,LW,OWINNER,OMERGED,WRD,X,?TMP2,?TMP1
SET 'PTR,P-LEXSTART
?PRG1: ZERO? P-OFLAG \?CND3
COPYT P-ITBL,P-OTBL,P-ITBLLEN
?CND3: COPYT P-ITBL,0,P-ITBLLEN
SET 'P-NAM,FALSE-VALUE
SET 'P-ADJ,FALSE-VALUE
SET 'P-XNAM,FALSE-VALUE
SET 'P-XADJ,FALSE-VALUE
SET 'P-DIR-WORD,FALSE-VALUE
SET 'P-PNAM,FALSE-VALUE
SET 'P-PADJN,FALSE-VALUE
ZERO? P-OFLAG \?CND5
SET 'P-ACT,FALSE-VALUE
SET 'P-QWORD,FALSE-VALUE
SET 'P-LASTADJ,FALSE-VALUE
PUT P-NAMW,0,FALSE-VALUE
PUT P-NAMW,1,FALSE-VALUE
PUT P-ADJW,0,FALSE-VALUE
PUT P-ADJW,1,FALSE-VALUE
PUT P-OFW,0,FALSE-VALUE
PUT P-OFW,1,FALSE-VALUE
?CND5: SET 'OMERGED,P-MERGED
SET 'P-MERGED,FALSE-VALUE
SET 'P-END-ON-PREP,FALSE-VALUE
PUT P-PRSO,P-MATCHLEN,0
PUT P-PRSI,P-MATCHLEN,0
PUT P-BUTS,P-MATCHLEN,0
SET 'OWINNER,WINNER
ZERO? QUOTE-FLAG \?CND7
EQUAL? WINNER,PLAYER /?CND7
SET 'WINNER,PLAYER
LOC WINNER
FSET? STACK,VEHICLE /?CND11
LOC WINNER >HERE
?CND11: CALL1 IS-LIT? >LIT?
?CND7: ZERO? RESERVE-PTR /?CCL15
SET 'PTR,RESERVE-PTR
COPYT RESERVE-LEXV,P-LEXV,P-LEXV-LENGTH
COPYT RESERVE-INBUF,P-INBUF,P-INBUF-LENGTH
ZERO? VERBOSITY /?CND16
EQUAL? PLAYER,WINNER \?CND16
CRLF
?CND16: SET 'RESERVE-PTR,FALSE-VALUE
SET 'P-CONT,FALSE-VALUE
JUMP ?CND13
?CCL15: ZERO? P-CONT /?CCL21
SET 'PTR,P-CONT
SET 'P-CONT,FALSE-VALUE
ZERO? VERBOSITY /?CND13
EQUAL? PLAYER,WINNER \?CND13
CRLF
JUMP ?CND13
?CCL21: SET 'WINNER,PLAYER
SET 'QUOTE-FLAG,FALSE-VALUE
LOC WINNER
FSET? STACK,VEHICLE /?CND26
LOC WINNER >HERE
?CND26: CALL1 IS-LIT? >LIT?
GET 0,8
BTST STACK,4 \?CND28
ICALL1 V-REFRESH
?CND28: EQUAL? HERE,OLD-HERE /?CND30
ZERO? DMODE /?CTR32
EQUAL? IN-DBOX,SHOWING-STATS /?CTR32
EQUAL? PRIOR,SHOWING-INV,SHOWING-STATS \?CCL33
?CTR32: ICALL1 V-LOOK
JUMP ?CND30
?CCL33: ICALL1 DISPLAY-PLACE
?CND30: ZERO? DMODE /?CND37
ZERO? AUTO /?CND37
ZERO? NEW-DBOX /?CND37
EQUAL? IN-DBOX,SHOWING-ROOM \?CCL42
EQUAL? PRIOR,0,SHOWING-ROOM \?CCL42
BTST NEW-DBOX,SHOWING-ROOM \?CND37
SET 'X,P-IT-OBJECT
ICALL1 UPDATE-ROOMDESC
ICALL2 THIS-IS-IT,X
JUMP ?CND37
?CCL42: EQUAL? IN-DBOX,SHOWING-INV \?CCL48
EQUAL? PRIOR,0,SHOWING-INV \?CCL48
BTST NEW-DBOX,SHOWING-INV \?CND37
SET 'X,P-IT-OBJECT
ICALL1 UPDATE-INVENTORY
ICALL2 THIS-IS-IT,X
JUMP ?CND37
?CCL48: EQUAL? IN-DBOX,SHOWING-STATS \?CND37
EQUAL? PRIOR,0,SHOWING-STATS \?CND37
BTST NEW-DBOX,SHOWING-STATS \?CND37
SET 'X,ENDURANCE
ICALL1 TO-TOP-WINDOW
?PRG58: GET STATS,X
ICALL STAT-ROUTINE,X,STACK
IGRTR? 'X,LUCK \?PRG58
ICALL1 TO-BOTTOM-WINDOW
?CND37: ZERO? VERBOSITY /?CND62
CRLF
?CND62: PRINTC 62
ICALL1 READ-LEXV
?CND13: GETB P-LEXV,P-LEXWORDS >P-LEN
GET P-LEXV,PTR
EQUAL? STACK,W?QUOTE \?CND64
ADD PTR,P-LEXELEN >PTR
DEC 'P-LEN
?CND64: GET P-LEXV,PTR
EQUAL? STACK,W?THEN,W?PLEASE,W?SO \?CND66
ADD PTR,P-LEXELEN >PTR
DEC 'P-LEN
?CND66: LESS? 1,P-LEN \?CND68
GET P-LEXV,PTR
EQUAL? STACK,W?GO \?CND68
ADD PTR,P-LEXELEN
GET P-LEXV,STACK >NW
ZERO? NW /?CND68
CALL WT?,NW,64
ZERO? STACK /?CND68
ADD PTR,P-LEXELEN >PTR
DEC 'P-LEN
?CND68: ZERO? P-LEN \?CND74
PRINTI "[What?]"
CRLF
RFALSE
?CND74: GET P-LEXV,PTR >WRD
EQUAL? WRD,W?UNDO \?CND76
ICALL1 V-UNDO
RFALSE
?CND76: ISAVE >CAN-UNDO
EQUAL? CAN-UNDO,2 \?REP2
ICALL1 V-REFRESH
ICALL2 COMPLETED,STR?508
ZERO? DMODE /?CCL81
EQUAL? PRIOR,0,SHOWING-ROOM /?PRG1
?CCL81: CRLF
JUMP ?PRG1
?REP2: EQUAL? WRD,W?OOPS \?CCL86
ADD PTR,P-LEXELEN
GET P-LEXV,STACK
EQUAL? STACK,W?PERIOD,W?COMMA \?CND87
ADD PTR,P-LEXELEN >PTR
DEC 'P-LEN
?CND87: GRTR? P-LEN,1 /?CCL91
PRINTC 91
PRINT CANT
PRINTI "use OOPS that way.]"
CRLF
RFALSE
?CCL91: GET OOPS-TABLE,O-PTR
ZERO? STACK /?CCL93
GRTR? P-LEN,2 \?CND94
ADD PTR,P-LEXELEN
GET P-LEXV,STACK
EQUAL? STACK,W?QUOTE \?CND96
PRINTI "[Sorry. "
PRINT CANT
PRINTI "correct mistakes in quoted text.]"
CRLF
RFALSE
?CND96: PRINTI "[NOTE: Only the first word after OOPS is used.]"
CRLF
PRINT TAB
?CND94: GET OOPS-TABLE,O-PTR >?TMP1
ADD PTR,P-LEXELEN
GET P-LEXV,STACK
PUT AGAIN-LEXV,?TMP1,STACK
SET 'WINNER,OWINNER
MUL PTR,P-LEXELEN
ADD STACK,6
GETB P-LEXV,STACK >?TMP2
MUL PTR,P-LEXELEN
ADD STACK,7
GETB P-LEXV,STACK >?TMP1
GET OOPS-TABLE,O-PTR
MUL STACK,P-LEXELEN
ADD STACK,3
ICALL INBUF-ADD,?TMP2,?TMP1,STACK
COPYT AGAIN-LEXV,P-LEXV,P-LEXV-LENGTH
GETB P-LEXV,P-LEXWORDS >P-LEN
GET OOPS-TABLE,O-START >PTR
COPYT OOPS-INBUF,P-INBUF,P-INBUF-LENGTH
JUMP ?CND84
?CCL93: PUT OOPS-TABLE,O-END,FALSE-VALUE
PRINTI "[There was no word to replace in that sentence.]"
CRLF
RFALSE
?CCL86: EQUAL? WRD,W?AGAIN,W?G /?CND98
SET 'P-QWORD,FALSE-VALUE
SET 'P-NUMBER,-1
?CND98: PUT OOPS-TABLE,O-END,FALSE-VALUE
?CND84: GET P-LEXV,PTR
EQUAL? STACK,W?AGAIN,W?G \?CCL102
ZERO? P-OFLAG \?CTR104
ZERO? P-WON /?CTR104
GETB OOPS-INBUF,1
ZERO? STACK \?CCL105
?CTR104: PRINTC 91
PRINT CANT
PRINTI "use AGAIN that way.]"
CRLF
RFALSE
?CCL105: GRTR? P-LEN,1 \?CCL110
ADD PTR,P-LEXELEN
GET P-LEXV,STACK
EQUAL? STACK,W?PERIOD,W?COMMA,W?THEN /?CTR112
ADD PTR,P-LEXELEN
GET P-LEXV,STACK
EQUAL? STACK,W?AND \?CCL113
?CTR112: ADD PTR,4 >PTR
GETB P-LEXV,P-LEXWORDS
SUB STACK,2
PUTB P-LEXV,P-LEXWORDS,STACK
JUMP ?CND103
?CCL113: ICALL1 DONT-UNDERSTAND
RFALSE
?CCL110: ADD PTR,P-LEXELEN >PTR
GETB P-LEXV,P-LEXWORDS
SUB STACK,1
PUTB P-LEXV,P-LEXWORDS,STACK
?CND103: GETB P-LEXV,P-LEXWORDS
GRTR? STACK,0 \?CCL118
COPYT P-LEXV,RESERVE-LEXV,P-LEXV-LENGTH
COPYT P-INBUF,RESERVE-INBUF,P-INBUF-LENGTH
SET 'RESERVE-PTR,PTR
JUMP ?CND116
?CCL118: SET 'RESERVE-PTR,FALSE-VALUE
?CND116: SET 'WINNER,OWINNER
SET 'P-MERGED,OMERGED
COPYT OOPS-INBUF,P-INBUF,P-INBUF-LENGTH
COPYT AGAIN-LEXV,P-LEXV,P-LEXV-LENGTH
SET 'DIR,AGAIN-DIR
COPYT P-OTBL,P-ITBL,P-ITBLLEN
JUMP ?CND100
?CCL102: SET 'P-NUMBER,-1
COPYT P-LEXV,AGAIN-LEXV,P-LEXV-LENGTH
COPYT P-INBUF,OOPS-INBUF,P-INBUF-LENGTH
PUT OOPS-TABLE,O-START,PTR
MUL 4,P-LEN
PUT OOPS-TABLE,O-LENGTH,STACK
GETB P-LEXV,P-LEXWORDS
MUL P-LEXELEN,STACK
ADD PTR,STACK
MUL 2,STACK >LEN
SUB LEN,1
GETB P-LEXV,STACK >?TMP1
SUB LEN,2
GETB P-LEXV,STACK
ADD ?TMP1,STACK
PUT OOPS-TABLE,O-END,STACK
SET 'RESERVE-PTR,FALSE-VALUE
SET 'LEN,P-LEN
SET 'P-DIR,FALSE-VALUE
SET 'P-NCN,0
SET 'P-GETFLAGS,0
PUT P-ITBL,P-VERBN,0
?PRG119: DLESS? 'P-LEN,0 \?CND121
SET 'QUOTE-FLAG,FALSE-VALUE
JUMP ?CND100
?CND121: GET P-LEXV,PTR >WRD
CALL2 BUZZER-WORD?,WRD
ZERO? STACK \FALSE
ZERO? WRD \?CTR126
CALL QUOTED-WORD?,PTR,VERB >WRD
ZERO? WRD \?CTR126
CALL2 NUMBER?,PTR >WRD
ZERO? WRD /?CCL127
?CTR126: ZERO? P-LEN \?CCL133
SET 'NW,0
JUMP ?CND131
?CCL133: ADD PTR,P-LEXELEN
GET P-LEXV,STACK >NW
?CND131: EQUAL? WRD,W?TO \?CCL136
EQUAL? VERB,ACT?TELL,ACT?ASK \?CCL136
PUT P-ITBL,P-VERB,ACT?TELL
SET 'WRD,W?QUOTE
JUMP ?CND134
?CCL136: EQUAL? WRD,W?THEN \?CCL140
GRTR? P-LEN,0 \?CCL140
ZERO? VERB \?CCL140
ZERO? QUOTE-FLAG \?CCL140
PUT P-ITBL,P-VERB,ACT?TELL
PUT P-ITBL,P-VERBN,0
SET 'WRD,W?QUOTE
JUMP ?CND134
?CCL140: EQUAL? WRD,W?PERIOD \?CND134
EQUAL? LW,W?MR,W?MRS \?CND134
DEC 'P-NCN
ICALL CHANGE-LEXV,PTR,LW,TRUE-VALUE
SET 'WRD,LW
SET 'LW,0
?CND134: EQUAL? WRD,W?THEN,W?PERIOD,W?QUOTE \?CCL150
EQUAL? WRD,W?QUOTE \?CND151
GET P-LEXV,PTR
EQUAL? STACK,W?QUOTE \?CCL155
EQUAL? VERB,ACT?TELL,ACT?SAY \?CTR154
EQUAL? WINNER,PLAYER /?CCL155
?CTR154: CALL QUOTED-PHRASE?,PTR,VERB
ZERO? STACK /FALSE
ADD PTR,P-LEXELEN >PTR
JUMP ?PRG119
?CCL155: ZERO? QUOTE-FLAG /?CCL164
SET 'QUOTE-FLAG,FALSE-VALUE
JUMP ?CND151
?CCL164: SET 'QUOTE-FLAG,TRUE-VALUE
?CND151: ZERO? P-LEN /?PEN165
ADD PTR,P-LEXELEN >P-CONT
?PEN165: PUTB P-LEXV,P-LEXWORDS,P-LEN
JUMP ?CND100
?CCL150: CALL WT?,WRD,16,3 >VAL
ZERO? VAL /?CCL168
EQUAL? VERB,FALSE-VALUE,ACT?WALK,ACT?GO \?CCL168
EQUAL? LEN,1 /?CTR167
EQUAL? LEN,2 \?PRD174
EQUAL? VERB,ACT?WALK,ACT?GO /?CTR167
?PRD174: EQUAL? NW,W?THEN,W?PERIOD,W?QUOTE \?PRD177
GRTR? LEN,1 /?CTR167
?PRD177: ZERO? QUOTE-FLAG /?PRD180
EQUAL? LEN,2 \?PRD180
EQUAL? NW,W?QUOTE /?CTR167
?PRD180: GRTR? LEN,2 \?CCL168
EQUAL? NW,W?COMMA,W?AND \?CCL168
?CTR167: SET 'DIR,VAL
SET 'P-DIR-WORD,WRD
EQUAL? NW,W?COMMA,W?AND \?CND186
ADD PTR,P-LEXELEN
ICALL CHANGE-LEXV,STACK,W?THEN
?CND186: GRTR? LEN,2 /?CND123
SET 'QUOTE-FLAG,FALSE-VALUE
JUMP ?CND100
?CCL168: CALL WT?,WRD,64,1 >VAL
ZERO? VAL /?CCL191
ZERO? VERB \?CCL191
SET 'P-PRSA-WORD,WRD
SET 'VERB,VAL
PUT P-ITBL,P-VERB,VAL
PUT P-ITBL,P-VERBN,P-VTBL
PUT P-VTBL,0,WRD
MUL PTR,2
ADD STACK,2 >X
GETB P-LEXV,X
PUTB P-VTBL,2,STACK
ADD X,1
GETB P-LEXV,STACK
PUTB P-VTBL,3,STACK
JUMP ?CND123
?CCL191: CALL WT?,WRD,8,0 >VAL
ZERO? VAL \?CTR194
EQUAL? WRD,W?ALL,W?EVERYTHING /?CTR194
EQUAL? WRD,W?BOTH,W?A /?CTR194
CALL WT?,WRD,32
ZERO? STACK \?CTR194
CALL WT?,WRD,128
ZERO? STACK /?CCL195
?CTR194: GRTR? P-LEN,1 \?CCL203
EQUAL? NW,W?OF \?CCL203
EQUAL? VERB,ACT?TAKE /?CCL203
ZERO? VAL \?CCL203
EQUAL? WRD,W?A /?CCL203
EQUAL? WRD,W?ALL,W?BOTH,W?EVERYTHING /?CCL203
PUT P-OFW,P-NCN,WRD
SET 'OF-FLAG,TRUE-VALUE
JUMP ?CND123
?CCL203: ZERO? VAL /?CCL211
ZERO? P-LEN /?CTR210
EQUAL? NW,W?THEN,W?PERIOD \?CCL211
?CTR210: SET 'P-END-ON-PREP,TRUE-VALUE
LESS? P-NCN,2 \?CND123
PUT P-ITBL,P-PREP1,VAL
PUT P-ITBL,P-PREP1N,WRD
JUMP ?CND123
?CCL211: EQUAL? P-NCN,2 \?CCL219
PRINTI "[There are too many nouns in that sentence.]"
CRLF
RFALSE
?CCL219: INC 'P-NCN
SET 'P-ACT,VERB
CALL CLAUSE,PTR,VAL,WRD >PTR
ZERO? PTR /FALSE
LESS? PTR,0 \?CND123
SET 'QUOTE-FLAG,FALSE-VALUE
?CND100: PUT OOPS-TABLE,O-PTR,FALSE-VALUE
ZERO? DIR /?CND236
SET 'PRSA,V?WALK
SET 'P-WALK-DIR,DIR
SET 'AGAIN-DIR,DIR
SET 'PRSO,DIR
SET 'P-OFLAG,FALSE-VALUE
RTRUE
?CCL195: EQUAL? WRD,W?OF \?CCL225
ZERO? OF-FLAG /?CTR227
EQUAL? NW,W?PERIOD,W?THEN \?CCL228
?CTR227: ICALL2 CANT-USE,PTR
RFALSE
?CCL228: SET 'OF-FLAG,FALSE-VALUE
?CND123: SET 'LW,WRD
ADD PTR,P-LEXELEN >PTR
JUMP ?PRG119
?CCL225: CALL WT?,WRD,4
ZERO? STACK \?CND123
EQUAL? VERB,ACT?TELL \?CCL233
CALL WT?,WRD,64
ZERO? STACK /?CCL233
ICALL1 WAY-TO-TALK
RFALSE
?CCL233: ICALL2 CANT-USE,PTR
RFALSE
?CCL127: ICALL2 UNKNOWN-WORD,PTR
RFALSE
?CND236: SET 'P-WALK-DIR,FALSE-VALUE
SET 'AGAIN-DIR,FALSE-VALUE
ZERO? P-OFLAG /?CND238
CALL1 ORPHAN-MERGE
ZERO? STACK /?CND238
SET 'WINNER,OWINNER
?CND238: CALL1 SYNTAX-CHECK
ZERO? STACK /FALSE
CALL1 SNARF-OBJECTS
ZERO? STACK /FALSE
CALL1 MANY-CHECK
ZERO? STACK /FALSE
GETB P-SYNTAX,P-SLOC1
CALL ITAKE-CHECK,P-PRSO,STACK
ZERO? STACK /FALSE
GETB P-SYNTAX,P-SLOC2
CALL ITAKE-CHECK,P-PRSI,STACK
ZERO? STACK /FALSE
RTRUE
.FUNCT PCLEAR
SET 'P-CONT,FALSE-VALUE
SET 'QUOTE-FLAG,FALSE-VALUE
RFALSE
.FUNCT CHANGE-LEXV,PTR,WRD,PTRS?,X,Y,Z
ASSIGNED? 'PTRS? \?CND1
SUB PTR,P-LEXELEN
MUL 2,STACK
ADD 2,STACK >X
GETB P-LEXV,X >Y
MUL 2,PTR
ADD 2,STACK >Z
PUTB P-LEXV,Z,Y
PUTB AGAIN-LEXV,Z,Y
ADD 1,X
GETB P-LEXV,STACK >Y
MUL 2,PTR
ADD 3,STACK >Z
PUTB P-LEXV,Z,Y
PUTB AGAIN-LEXV,Z,Y
?CND1: PUT P-LEXV,PTR,WRD
PUT AGAIN-LEXV,PTR,WRD
RTRUE
.FUNCT WT?,PTR,BIT,B1,OFFS,TYP
ASSIGNED? 'B1 /?CND1
SET 'B1,5
?CND1: SET 'OFFS,P-P1OFF
GETB PTR,P-PSOFF >TYP
BTST TYP,BIT \FALSE
GRTR? B1,4 /TRUE
BAND TYP,P-P1BITS >TYP
EQUAL? TYP,B1 /?CND7
INC 'OFFS
?CND7: GETB PTR,OFFS
RSTACK
.FUNCT CLAUSE,PTR,VAL,WRD,FIRST??,ANDFLG,LW,OFF,NUM,NW,?TMP1
SET 'FIRST??,TRUE-VALUE
SUB P-NCN,1
MUL STACK,2 >OFF
ZERO? VAL /?CCL3
ADD P-PREP1,OFF >NUM
PUT P-ITBL,NUM,VAL
ADD NUM,1
PUT P-ITBL,STACK,WRD
ADD PTR,P-LEXELEN >PTR
JUMP ?CND1
?CCL3: INC 'P-LEN
?CND1: ZERO? P-LEN \?CND4
DEC 'P-NCN
RETURN -1
?CND4: ADD P-NC1,OFF >NUM
MUL PTR,2
ADD P-LEXV,STACK
PUT P-ITBL,NUM,STACK
GET P-LEXV,PTR
EQUAL? STACK,W?THE,W?A,W?AN /?CCL7
GET P-LEXV,PTR
EQUAL? STACK,W?$BUZZ \?PRG10
?CCL7: GET P-ITBL,NUM
ADD STACK,4
PUT P-ITBL,NUM,STACK
?PRG10: DLESS? 'P-LEN,0 \?CND12
ADD NUM,1 >?TMP1
MUL PTR,2
ADD P-LEXV,STACK
PUT P-ITBL,?TMP1,STACK
RETURN -1
?CND12: GET P-LEXV,PTR >WRD
CALL2 BUZZER-WORD?,WRD
ZERO? STACK \FALSE
ZERO? WRD \?CTR17
CALL2 QUOTED-WORD?,PTR >WRD
ZERO? WRD \?CTR17
CALL2 NUMBER?,PTR >WRD
ZERO? WRD /?CCL18
?CTR17: ZERO? P-LEN \?CCL24
SET 'NW,0
JUMP ?CND22
?CCL24: ADD PTR,P-LEXELEN
GET P-LEXV,STACK >NW
ZERO? NW \?CND22
ADD PTR,P-LEXELEN
CALL2 NUMBER?,STACK >NW
?CND22: EQUAL? WRD,W?QUOTE \?CCL29
EQUAL? P-ACT,ACT?TELL,ACT?SAY,ACT?NAME /?CCL29
CALL QUOTED-PHRASE?,PTR,P-ACT
ZERO? STACK /FALSE
ADD PTR,P-LEXELEN >PTR
JUMP ?PRG10
?CCL29: EQUAL? WRD,W?PERIOD \?CCL36
EQUAL? LW,W?MR,W?MRS \?CCL36
SET 'LW,0
JUMP ?CND14
?CCL36: EQUAL? WRD,W?AND,W?COMMA \?CCL40
SET 'ANDFLG,TRUE-VALUE
JUMP ?CND14
?CCL40: EQUAL? WRD,W?ALL,W?BOTH,W?EVERYTHING \?CCL42
EQUAL? NW,W?OF \?CND14
DEC 'P-LEN
ADD PTR,P-LEXELEN >PTR
JUMP ?CND14
?CCL42: EQUAL? WRD,W?THEN,W?PERIOD /?CTR45
CALL WT?,WRD,8
ZERO? STACK /?CCL46
GET P-ITBL,P-VERB
ZERO? STACK /?CCL46
ZERO? FIRST?? \?CCL46
?CTR45: INC 'P-LEN
ADD NUM,1 >?TMP1
MUL PTR,2
ADD P-LEXV,STACK
PUT P-ITBL,?TMP1,STACK
SUB PTR,P-LEXELEN
RSTACK
?CCL46: ZERO? ANDFLG /?CCL53
GET P-ITBL,P-VERBN
ZERO? STACK /?CTR52
CALL2 VERB-DIR-ONLY?,WRD
ZERO? STACK /?CCL53
?CTR52: SUB PTR,4 >PTR
ADD PTR,2
ICALL CHANGE-LEXV,STACK,W?THEN
ADD P-LEN,2 >P-LEN
JUMP ?CND14
?CCL53: CALL WT?,WRD,128
ZERO? STACK /?CCL59
GRTR? P-LEN,0 \?CCL62
EQUAL? NW,W?OF \?CCL62
EQUAL? WRD,W?ALL,W?EVERYTHING /?CCL62
SUB P-NCN,1
PUT P-OFW,STACK,WRD
JUMP ?CND14
?CCL62: CALL WT?,WRD,32
ZERO? STACK /?CCL66
ZERO? NW /?CCL66
CALL WT?,NW,128
ZERO? STACK \?CND14
?CCL66: ZERO? ANDFLG \?CCL71
EQUAL? NW,W?BUT,W?EXCEPT /?CCL71
EQUAL? NW,W?AND,W?COMMA /?CCL71
ADD NUM,1 >?TMP1
ADD PTR,2
MUL STACK,2
ADD P-LEXV,STACK
PUT P-ITBL,?TMP1,STACK
RETURN PTR
?CCL71: SET 'ANDFLG,FALSE-VALUE
JUMP ?CND14
?CCL59: CALL WT?,WRD,32
ZERO? STACK \?CND14
CALL WT?,WRD,4
ZERO? STACK \?CND14
ZERO? ANDFLG /?CCL78
GET P-ITBL,P-VERB
ZERO? STACK \?CCL78
SUB PTR,4 >PTR
ADD PTR,2
ICALL CHANGE-LEXV,STACK,W?THEN
ADD P-LEN,2 >P-LEN
?CND14: SET 'LW,WRD
SET 'FIRST??,FALSE-VALUE
ADD PTR,P-LEXELEN >PTR
JUMP ?PRG10
?CCL78: CALL WT?,WRD,8
ZERO? STACK \?CND14
ICALL2 CANT-USE,PTR
RFALSE
?CCL18: ICALL2 UNKNOWN-WORD,PTR
RFALSE
.FUNCT SPOKEN-TO,WHO
EQUAL? WHO,QCONTEXT \?CCL2
EQUAL? HERE,QCONTEXT-ROOM /TRUE
?CCL2: ICALL2 SEE-CHARACTER,WHO
PRINTI "[spoken to "
ICALL2 THE-PRINT,WHO
PRINT BRACKET
RTRUE
.FUNCT ANYONE-HERE?,OBJ
CALL1 QCONTEXT-GOOD? >OBJ
ZERO? OBJ /?PRD4
RETURN OBJ
?PRD4: FIRST? HERE >OBJ /?PRG5
RETURN OBJ
?PRG5: FSET? OBJ,PERSON \?CCL9
EQUAL? OBJ,PLAYER,WINNER /?CCL9
FSET? OBJ,PLURAL /?CCL9
RETURN OBJ
?CCL9: NEXT? OBJ >OBJ /?PRG5
RETURN OBJ
.FUNCT SEE-CHARACTER,OBJ
FSET? OBJ,FEMALE \?CCL3
SET 'P-HER-OBJECT,OBJ
JUMP ?CND1
?CCL3: SET 'P-HIM-OBJECT,OBJ
?CND1: SET 'QCONTEXT,OBJ
LOC OBJ >QCONTEXT-ROOM
RFALSE
.FUNCT QCONTEXT-GOOD?
ZERO? QCONTEXT /FALSE
FSET? QCONTEXT,PERSON \FALSE
EQUAL? HERE,QCONTEXT-ROOM \FALSE
CALL2 VISIBLE?,QCONTEXT
ZERO? STACK /FALSE
RETURN QCONTEXT
.FUNCT THIS-IS-IT,OBJ
ZERO? OBJ /FALSE
EQUAL? OBJ,PLAYER,ME,INTNUM /FALSE
EQUAL? OBJ,INTDIR,LEFT,RIGHT /FALSE
FSET? OBJ,FEMALE \?CCL8
SET 'P-HER-OBJECT,OBJ
RFALSE
?CCL8: FSET? OBJ,PERSON \?CCL10
SET 'P-HIM-OBJECT,OBJ
RFALSE
?CCL10: FSET? OBJ,PLURAL \?CCL12
SET 'P-THEM-OBJECT,OBJ
RFALSE
?CCL12: SET 'P-IT-OBJECT,OBJ
RFALSE
.FUNCT FAKE-ORPHAN,TMP,X
ICALL ORPHAN,P-SYNTAX,FALSE-VALUE
ICALL1 BE-SPECIFIC
GET P-OTBL,P-VERBN >TMP
ZERO? TMP \?CCL3
PRINTB W?TELL
JUMP ?CND1
?CCL3: GETB P-VTBL,2
ZERO? STACK \?CCL5
GET TMP,0
PRINTB STACK
JUMP ?CND1
?CCL5: GETB TMP,2 >X
GETB TMP,3
ICALL WORD-PRINT,X,STACK
PUTB P-VTBL,2,0
?CND1: SET 'P-OFLAG,TRUE-VALUE
SET 'P-WON,FALSE-VALUE
PRINTR "?]"
.FUNCT PERFORM,A,O,I,V,WHO,OA,OO,OI,ONP,X
EQUAL? WINNER,PLAYER /?CND1
FSET? WINNER,PERSON /?CND1
ICALL2 NOT-LIKELY,WINNER
PRINT STR?509
ICALL1 PCLEAR
RETURN 2
?CND1: SET 'OA,PRSA
SET 'OO,PRSO
SET 'OI,PRSI
SET 'ONP,NOW-PRSI?
CALL1 ANYONE-HERE? >WHO
SET 'PRSA,A
EQUAL? WINNER,PLAYER /?CCL9
INTBL? PRSA,GAME-VERBS,NGVERBS >X \?CCL9
PRINTC 91
PRINT CANT
PRINTI "tell characters to do that.]"
CRLF
RETURN 2
?CCL9: ZERO? LIT? \?CCL15
INTBL? PRSA,SEEVERBS,NSVERBS >X \?CCL15
ICALL1 TOO-DARK
RETURN 2
?CCL15: EQUAL? A,V?WALK /?CND7
EQUAL? WINNER,PLAYER \?CCL23
EQUAL? PRSA,V?WHO,V?WHAT,V?WHERE \?CCL23
ZERO? WHO /?CCL23
SET 'WINNER,WHO
ICALL2 SPOKEN-TO,WHO
JUMP ?CND21
?CCL23: EQUAL? WINNER,PLAYER \?CND21
EQUAL? O,ME \?CND21
EQUAL? PRSA,V?TELL,V?TELL-ABOUT,V?ASK-ABOUT /?CCL27
EQUAL? PRSA,V?ASK-FOR,V?QUESTION,V?REPLY /?CCL27
EQUAL? PRSA,V?THANK,V?YELL,V?HELLO /?CCL27
EQUAL? PRSA,V?GOODBYE,V?SAY,V?ALARM \?CND21
?CCL27: ZERO? WHO \?CND35
ICALL1 TALK-TO-SELF
RETURN 2
?CND35: SET 'WINNER,WHO
ICALL2 SPOKEN-TO,WHO
?CND21: EQUAL? YOU,I,O \?CND39
EQUAL? WINNER,PLAYER \?CCL43
ZERO? WHO \?CCL46
ICALL1 TALK-TO-SELF
RETURN 2
?CCL46: SET 'WINNER,WHO
ICALL2 SPOKEN-TO,WHO
JUMP ?CND41
?CCL43: ICALL2 SEE-CHARACTER,WINNER
SET 'WHO,WINNER
?CND41: EQUAL? I,YOU \?CND49
SET 'I,WHO
?CND49: EQUAL? O,YOU \?CND39
SET 'O,WHO
?CND39: EQUAL? IT,I,O \?CND53
CALL2 ACCESSIBLE?,P-IT-OBJECT
ZERO? STACK \?CND53
ZERO? I \?CCL59
ICALL1 FAKE-ORPHAN
RETURN 2
?CCL59: ICALL2 CANT-SEE-ANY,P-IT-OBJECT
RETURN 2
?CND53: EQUAL? THEM,I,O \?CND62
CALL2 VISIBLE?,P-THEM-OBJECT
ZERO? STACK /?CCL66
EQUAL? THEM,O \?CND67
SET 'O,P-THEM-OBJECT
?CND67: EQUAL? THEM,I \?CND62
SET 'I,P-THEM-OBJECT
?CND62: EQUAL? HER,I,O \?CND76
CALL2 VISIBLE?,P-HER-OBJECT
ZERO? STACK /?CCL80
EQUAL? P-HER-OBJECT,WINNER \?CND81
CALL2 NO-OTHER?,TRUE-VALUE
ZERO? STACK /?CND81
RETURN 2
?CCL66: ZERO? I \?CCL73
ICALL1 FAKE-ORPHAN
RETURN 2
?CCL73: ICALL2 CANT-SEE-ANY,P-THEM-OBJECT
RETURN 2
?CND81: EQUAL? HER,O \?CND87
SET 'O,P-HER-OBJECT
?CND87: EQUAL? HER,I \?CND76
SET 'I,P-HER-OBJECT
?CND76: EQUAL? HIM,I,O \?CND96
CALL2 VISIBLE?,P-HIM-OBJECT
ZERO? STACK /?CCL100
EQUAL? P-HIM-OBJECT,WINNER \?CND101
CALL1 NO-OTHER?
ZERO? STACK /?CND101
RETURN 2
?CCL80: ZERO? I \?CCL93
ICALL1 FAKE-ORPHAN
RETURN 2
?CCL93: ICALL2 CANT-SEE-ANY,P-HER-OBJECT
RETURN 2
?CND101: EQUAL? HIM,O \?CND107
SET 'O,P-HIM-OBJECT
?CND107: EQUAL? HIM,I \?CND96
SET 'I,P-HIM-OBJECT
?CND96: EQUAL? O,IT \?CND116
SET 'O,P-IT-OBJECT
?CND116: EQUAL? I,IT \?CND7
SET 'I,P-IT-OBJECT
?CND7: SET 'PRSI,I
SET 'PRSO,O
SET 'V,FALSE-VALUE
EQUAL? A,V?WALK /?CND120
EQUAL? NOT-HERE-OBJECT,PRSO,PRSI \?CND120
CALL NOT-HERE-OBJECT-F >V
ZERO? V /?CND120
SET 'P-WON,FALSE-VALUE
?CND120: EQUAL? A,V?WALK /?CND126
ICALL2 THIS-IS-IT,PRSI
ICALL2 THIS-IS-IT,PRSO
?CND126: SET 'O,PRSO
SET 'I,PRSI
ZERO? V \?CND128
GETP WINNER,P?ACTION
CALL STACK,M-WINNER >V
?CND128: ZERO? V \?CND130
LOC WINNER
GETP STACK,P?ACTION
CALL STACK,M-BEG >V
?CND130: ZERO? V \?CND132
GET PREACTIONS,A
CALL STACK >V
?CND132: ZERO? V \?CND134
EQUAL? A,V?TELL-ABOUT,V?ASK-ABOUT,V?ASK-FOR /?CND134
SET 'NOW-PRSI?,TRUE-VALUE
ZERO? I /?CND137
EQUAL? A,V?WALK /?CND137
LOC I
ZERO? STACK /?CND137
LOC I
GETP STACK,P?CONTFCN >V
ZERO? V /?CND137
CALL V,M-CONT >V
?CND137: SET 'NOW-PRSI?,FALSE-VALUE
ZERO? V \?CND144
ZERO? O /?CND144
EQUAL? A,V?WALK /?CND144
LOC O
ZERO? STACK /?CND144
LOC O
GETP STACK,P?CONTFCN >V
ZERO? V /?CND144
CALL V,M-CONT >V
?CND144: SET 'NOW-PRSI?,TRUE-VALUE
ZERO? V \?CND134
ZERO? I /?CND134
GETP I,P?ACTION
CALL STACK >V
?CND134: SET 'NOW-PRSI?,FALSE-VALUE
ZERO? V \?CND155
ZERO? O /?CND155
EQUAL? A,V?WALK /?CND155
GETP O,P?ACTION
CALL STACK >V
?CND155: ZERO? V \?CND159
GET ACTIONS,A
CALL STACK >V
?CND159: EQUAL? V,M-FATAL /?CND161
LOC WINNER
GETP STACK,P?ACTION
ICALL STACK,M-END
?CND161: SET 'PRSA,OA
SET 'PRSO,OO
SET 'PRSI,OI
SET 'NOW-PRSI?,ONP
RETURN V
?CCL100: ZERO? I \?CCL113
ICALL1 FAKE-ORPHAN
RETURN 2
?CCL113: ICALL2 CANT-SEE-ANY,P-HIM-OBJECT
RETURN 2
.FUNCT NO-OTHER?,FEMALE?,OBJ
FIRST? HERE >OBJ \?CND1
?PRG3: EQUAL? OBJ,WINNER /?CND5
FSET? OBJ,PERSON \?CND5
ZERO? FEMALE? /?CCL10
FSET? OBJ,FEMALE /?CND1
JUMP ?CND5
?CCL10: FSET? OBJ,FEMALE \?CND1
?CND5: NEXT? OBJ >OBJ /?PRG3
?CND1: ZERO? OBJ \FALSE
ICALL2 PERPLEXED,WINNER
PRINTR "Who are you talking about?"""
.FUNCT BUZZER-WORD?,WORD,TBL,LEN,X
GET Q-BUZZES,0 >LEN
INTBL? WORD,Q-BUZZES+2,LEN >TBL \?CND1
ICALL TO-DO-THING-USE,STR?510,STR?511
RTRUE
?CND1: GET N-BUZZES,0 >LEN
INTBL? WORD,N-BUZZES+2,LEN >TBL \?CND3
ICALL1 NYMPH-APPEARS
PRINT DONT
PRINTI "need to use that "
PRINTD INTNUM
ICALL1 TO-COMPLETE
RTRUE
?CND3: GET SWEAR-WORDS,0 >LEN
INTBL? WORD,SWEAR-WORDS+2,LEN >TBL \?CND5
GET STATS,INTELLIGENCE >WORD
LESS? WORD,1 \?CND7
PRINTR "Such language betrays your low intelligence."
?CND7: PRINTI "You suddenly feel less intelligent."
CRLF
ICALL UPDATE-STAT,-1,INTELLIGENCE,TRUE-VALUE
RTRUE
?CND5: CALL1 SEE-COLOR?
ZERO? STACK \?CND9
GET COLOR-WORDS,0 >LEN
INTBL? WORD,COLOR-WORDS+2,LEN >TBL \?CND9
PRINT DONT
PRINTI "see the color "
PRINTB WORD
PRINTR " here; or any other colors, for that matter."
?CND9: GET MAGIC-WORDS,0 >LEN
?PRG13: GET MAGIC-WORDS,LEN >TBL
GET TBL,0
EQUAL? WORD,STACK \?CND15
GET TBL,2
ZERO? STACK \?CND15
PRINTI "[This story won't recognize the word """
PRINTB WORD
PRINTR ".""]"
?CND15: DLESS? 'LEN,2 \?PRG13
EQUAL? WORD,W?QUIETLY,W?SLOWLY,W?CAREFULLY /?CCL22
EQUAL? WORD,W?CLOSELY,W?QUICKLY,W?RAPIDLY \?CND21
?CCL22: ICALL1 NYMPH-APPEARS
PRINTI "Adverbs (such as """
PRINTB WORD
PRINTI """) aren't needed"
ICALL1 TO-COMPLETE
RTRUE
?CND21: EQUAL? WORD,W?XYZZY,W?PLUGH,W?PLOVER /?CCL26
EQUAL? WORD,W?YOHO,W?ULYSSES,W?ODYSSEUS \FALSE
?CCL26: PRINT STR?512
CRLF
RTRUE
.FUNCT VERB-DIR-ONLY?,WRD
CALL WT?,WRD,128
ZERO? STACK \FALSE
CALL WT?,WRD,32
ZERO? STACK \FALSE
CALL WT?,WRD,16
ZERO? STACK \TRUE
CALL WT?,WRD,64
ZERO? STACK /FALSE
RTRUE
.FUNCT INBUF-ADD,LEN,BEG,SLOT,DBEG,CTR,TMP,?TMP1
GET OOPS-TABLE,O-END >TMP
ZERO? TMP /?CCL3
SET 'DBEG,TMP
JUMP ?CND1
?CCL3: GET OOPS-TABLE,O-LENGTH >TMP
GETB AGAIN-LEXV,TMP >?TMP1
ADD TMP,1
GETB AGAIN-LEXV,STACK
ADD ?TMP1,STACK >DBEG
?CND1: ADD DBEG,LEN
PUT OOPS-TABLE,O-END,STACK
?PRG4: ADD DBEG,CTR >?TMP1
ADD BEG,CTR
GETB P-INBUF,STACK
PUTB OOPS-INBUF,?TMP1,STACK
INC 'CTR
EQUAL? CTR,LEN \?PRG4
PUTB AGAIN-LEXV,SLOT,DBEG
SUB SLOT,1
PUTB AGAIN-LEXV,STACK,LEN
RTRUE
.FUNCT NUMBER?,PTR,SUM,TIM,EXC,CNT,BPTR,CHR,CCTR,TMP,NW,?TMP1
ADD PTR,PTR
ADD P-LEXV,STACK >TMP
GETB TMP,3 >BPTR
GETB TMP,2 >CNT
GRTR? CNT,3 \?PRG3
SET 'CNT,3
?PRG3: DLESS? 'CNT,0 /?REP4
GETB P-INBUF,BPTR >CHR
EQUAL? CHR,58 \?CCL9
ZERO? EXC \FALSE
SET 'TIM,SUM
SET 'SUM,0
JUMP ?CND7
?CCL9: EQUAL? CHR,45 \?CCL13
ZERO? TIM \FALSE
SET 'EXC,SUM
SET 'SUM,0
JUMP ?CND7
?CCL13: GRTR? SUM,9999 /FALSE
GRTR? CHR,47 \FALSE
LESS? CHR,58 \FALSE
MUL SUM,10 >?TMP1
SUB CHR,48
ADD ?TMP1,STACK >SUM
?CND7: INC 'BPTR
JUMP ?PRG3