historicalsource/minizork2-1988
1
0
Fork 0
mirror of https://github.com/historicalsource/minizork2-1988 synced 2024-04-26 05:59:42 +03:00
Code Issues Releases Wiki Activity
minizork2-1988/parser.zap
historicalsource a24d33a0ad Final Revision
2019-04-13 21:54:32 -04:00

1601 lines
33 KiB
Plaintext
Raw Permalink Blame History

.FUNCT PARSER,PTR=P-LEXSTART,WRD,VAL=0,VERB=0,OF-FLAG=0,OWINNER,OMERGED,LEN,DIR=0,NW=0,LW=0,CNT=-1,?TMP2,?TMP1
?PRG1: IGRTR? 'CNT,P-ITBLLEN /?REP2
ZERO? P-OFLAG \?CND6
GET P-ITBL,CNT
PUT P-OTBL,CNT,STACK
?CND6: PUT P-ITBL,CNT,0
JUMP ?PRG1
?REP2: SET 'OWINNER,WINNER
SET 'OMERGED,P-MERGED
SET 'P-ADVERB,FALSE-VALUE
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
ZERO? QUOTE-FLAG \?CND8
EQUAL? WINNER,ADVENTURER /?CND8
SET 'WINNER,ADVENTURER
CALL META-LOC,ADVENTURER >HERE
CALL LIT?,HERE >LIT
?CND8: ZERO? RESERVE-PTR /?CCL14
SET 'PTR,RESERVE-PTR
CALL STUFF,RESERVE-LEXV,P-LEXV
GRTR? VERBOSITY,0 \?CND15
EQUAL? ADVENTURER,WINNER \?CND15
CRLF
?CND15: SET 'RESERVE-PTR,FALSE-VALUE
SET 'P-CONT,FALSE-VALUE
JUMP ?CND12
?CCL14: ZERO? P-CONT /?CCL20
SET 'PTR,P-CONT
GRTR? VERBOSITY,0 \?CND21
EQUAL? ADVENTURER,WINNER \?CND21
EQUAL? PRSA,V?SAY /?CND21
CRLF
?CND21: SET 'P-CONT,FALSE-VALUE
JUMP ?CND12
?CCL20: SET 'WINNER,ADVENTURER
SET 'QUOTE-FLAG,FALSE-VALUE
LOC WINNER
FSET? STACK,VEHBIT /?CND26
LOC WINNER >HERE
?CND26: CALL LIT?,HERE >LIT
GRTR? VERBOSITY,0 \?PRG30
CRLF
?PRG30: PRINTC 62
READ P-INBUF,P-LEXV
?CND12: GETB P-LEXV,P-LEXWORDS >P-LEN
ZERO? P-LEN \?CND32
PRINTI "I beg your pardon?"
CRLF
RFALSE
?CND32: GET P-LEXV,PTR >WRD
EQUAL? WRD,W?OOPS \?CCL38
ADD PTR,P-LEXELEN
GET P-LEXV,STACK
EQUAL? STACK,W?PERIOD,W?COMMA \?CND39
ADD PTR,P-LEXELEN >PTR
DEC 'P-LEN
?CND39: GRTR? P-LEN,1 /?CCL43
PRINTI "I can't help your clumsiness."
CRLF
RFALSE
?CCL43: GET OOPS-TABLE,O-PTR
ZERO? STACK /?CCL47
GRTR? P-LEN,2 \?CCL50
ADD PTR,P-LEXELEN
GET P-LEXV,STACK
EQUAL? STACK,W?QUOTE \?CCL50
PRINTI "Sorry, you can't correct mistakes in quoted text."
CRLF
RFALSE
?CCL50: GRTR? P-LEN,2 \?CND48
PRINTI "Warning: only the first word after OOPS is used."
CRLF
?CND48: 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
CALL INBUF-ADD,?TMP2,?TMP1,STACK
CALL STUFF,AGAIN-LEXV,P-LEXV
GETB P-LEXV,P-LEXWORDS >P-LEN
GET OOPS-TABLE,O-START >PTR
CALL INBUF-STUFF,OOPS-INBUF,P-INBUF
JUMP ?CND36
?CCL47: PUT OOPS-TABLE,O-END,FALSE-VALUE
PRINTI "There was no word to replace!"
CRLF
RFALSE
?CCL38: EQUAL? WRD,W?AGAIN,W?G /?CND60
SET 'P-NUMBER,0
?CND60: PUT OOPS-TABLE,O-END,FALSE-VALUE
?CND36: GET P-LEXV,PTR
EQUAL? STACK,W?AGAIN,W?G \?CCL64
GETB OOPS-INBUF,1
ZERO? STACK \?CCL67
PRINTI "Beg pardon?"
CRLF
RFALSE
?CCL67: ZERO? P-OFLAG /?CCL71
PRINTI "It's difficult to repeat fragments."
CRLF
RFALSE
?CCL71: ZERO? P-WON \?CCL75
PRINTI "That would just repeat a mistake."
CRLF
RFALSE
?CCL75: GRTR? P-LEN,1 \?CCL79
ADD PTR,P-LEXELEN
GET P-LEXV,STACK
EQUAL? STACK,W?PERIOD,W?COMMA,W?THEN /?CTR81
ADD PTR,P-LEXELEN
GET P-LEXV,STACK
EQUAL? STACK,W?AND \?PRG85
?CTR81: ADD PTR,4 >PTR
GETB P-LEXV,P-LEXWORDS
SUB STACK,2
PUTB P-LEXV,P-LEXWORDS,STACK
JUMP ?CND65
?PRG85: PRINTI "I couldn't understand that sentence."
CRLF
RFALSE
?CCL79: ADD PTR,P-LEXELEN >PTR
GETB P-LEXV,P-LEXWORDS
SUB STACK,1
PUTB P-LEXV,P-LEXWORDS,STACK
?CND65: GETB P-LEXV,P-LEXWORDS
GRTR? STACK,0 \?CCL89
CALL STUFF,P-LEXV,RESERVE-LEXV
SET 'RESERVE-PTR,PTR
JUMP ?CND87
?CCL89: SET 'RESERVE-PTR,FALSE-VALUE
?CND87: SET 'WINNER,OWINNER
SET 'P-MERGED,OMERGED
CALL INBUF-STUFF,OOPS-INBUF,P-INBUF
CALL STUFF,AGAIN-LEXV,P-LEXV
SET 'CNT,-1
SET 'DIR,AGAIN-DIR
?PRG90: IGRTR? 'CNT,P-ITBLLEN /?CND62
GET P-OTBL,CNT
PUT P-ITBL,CNT,STACK
JUMP ?PRG90
?CCL64: CALL STUFF,P-LEXV,AGAIN-LEXV
CALL INBUF-STUFF,P-INBUF,OOPS-INBUF
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
?PRG95: DLESS? 'P-LEN,0 \?CCL99
SET 'QUOTE-FLAG,FALSE-VALUE
JUMP ?CND62
?CCL99: GET P-LEXV,PTR >WRD
ZERO? WRD \?CTR100
CALL NUMBER?,PTR >WRD
ZERO? WRD /?CCL101
?CTR100: ZERO? P-LEN \?CCL106
SET 'NW,0
JUMP ?CND104
?CCL106: ADD PTR,P-LEXELEN
GET P-LEXV,STACK >NW
?CND104: EQUAL? WRD,W?TO \?CCL109
EQUAL? VERB,ACT?TELL \?CCL109
SET 'WRD,W?QUOTE
JUMP ?CND107
?CCL109: EQUAL? WRD,W?THEN \?CND107
GRTR? P-LEN,0 \?CND107
ZERO? VERB \?CND107
ZERO? QUOTE-FLAG \?CND107
EQUAL? LW,0,W?PERIOD \?CCL119
SET 'WRD,W?THE
JUMP ?CND107
?CCL119: PUT P-ITBL,P-VERB,ACT?TELL
PUT P-ITBL,P-VERBN,0
SET 'WRD,W?QUOTE
?CND107: EQUAL? WRD,W?THEN,W?PERIOD,W?QUOTE \?CCL122
EQUAL? WRD,W?QUOTE \?CND123
ZERO? QUOTE-FLAG /?CCL127
SET 'QUOTE-FLAG,FALSE-VALUE
JUMP ?CND123
?CCL127: SET 'QUOTE-FLAG,TRUE-VALUE
?CND123: ZERO? P-LEN /?PEN128
ADD PTR,P-LEXELEN >P-CONT
?PEN128: PUTB P-LEXV,P-LEXWORDS,P-LEN
JUMP ?CND62
?CCL122: CALL WT?,WRD,16,3 >VAL
ZERO? VAL /?CCL131
EQUAL? VERB,FALSE-VALUE,ACT?WALK \?CCL131
EQUAL? LEN,1 /?CTR130
EQUAL? LEN,2 \?PRD137
EQUAL? VERB,ACT?WALK /?CTR130
?PRD137: EQUAL? NW,W?THEN,W?PERIOD,W?QUOTE \?PRD140
LESS? LEN,2 \?CTR130
?PRD140: ZERO? QUOTE-FLAG /?PRD143
EQUAL? LEN,2 \?PRD143
EQUAL? NW,W?QUOTE /?CTR130
?PRD143: GRTR? LEN,2 \?CCL131
EQUAL? NW,W?COMMA,W?AND \?CCL131
?CTR130: SET 'DIR,VAL
EQUAL? NW,W?COMMA,W?AND \?CND149
ADD PTR,P-LEXELEN
PUT P-LEXV,STACK,W?THEN
?CND149: GRTR? LEN,2 /?CND97
SET 'QUOTE-FLAG,FALSE-VALUE
JUMP ?CND62
?CCL131: CALL WT?,WRD,64,1 >VAL
ZERO? VAL /?CCL154
ZERO? VERB \?CCL154
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 >CNT
GETB P-LEXV,CNT
PUTB P-VTBL,2,STACK
ADD CNT,1
GETB P-LEXV,STACK
PUTB P-VTBL,3,STACK
JUMP ?CND97
?CCL154: CALL WT?,WRD,8,0 >VAL
ZERO? VAL \?CTR157
EQUAL? WRD,W?ALL,W?ONE /?CTR157
CALL WT?,WRD,32
ZERO? STACK \?CTR157
CALL WT?,WRD,128
ZERO? STACK /?CCL158
?CTR157: GRTR? P-LEN,1 \?CCL165
EQUAL? NW,W?OF \?CCL165
ZERO? VAL \?CCL165
EQUAL? WRD,W?ALL,W?ONE,W?A /?CCL165
SET 'OF-FLAG,TRUE-VALUE
JUMP ?CND97
?CCL165: ZERO? VAL /?CCL171
ZERO? P-LEN /?CTR170
EQUAL? NW,W?THEN,W?PERIOD \?CCL171
?CTR170: SET 'P-END-ON-PREP,TRUE-VALUE
LESS? P-NCN,2 \?CND97
PUT P-ITBL,P-PREP1,VAL
PUT P-ITBL,P-PREP1N,WRD
JUMP ?CND97
?CCL171: EQUAL? P-NCN,2 \?CCL179
PRINTI "There were too many nouns in that sentence."
CRLF
RFALSE
?CCL179: INC 'P-NCN
SET 'P-ACT,VERB
CALL CLAUSE,PTR,VAL,WRD >PTR
ZERO? PTR /FALSE
LESS? PTR,0 \?CND97
SET 'QUOTE-FLAG,FALSE-VALUE
?CND62: PUT OOPS-TABLE,O-PTR,FALSE-VALUE
ZERO? DIR /?CCL203
SET 'PRSA,V?WALK
SET 'PRSO,DIR
SET 'P-OFLAG,FALSE-VALUE
SET 'P-WALK-DIR,DIR
SET 'AGAIN-DIR,DIR
RETURN AGAIN-DIR
?CCL158: EQUAL? WRD,W?OF \?CCL187
ZERO? OF-FLAG /?CTR189
EQUAL? NW,W?PERIOD,W?THEN \?CCL190
?CTR189: CALL CANT-USE,PTR
RFALSE
?CCL190: SET 'OF-FLAG,FALSE-VALUE
?CND97: SET 'LW,WRD
ADD PTR,P-LEXELEN >PTR
JUMP ?PRG95
?CCL187: CALL WT?,WRD,4
ZERO? STACK \?CND97
EQUAL? VERB,ACT?TELL \?CCL195
CALL WT?,WRD,64,1
ZERO? STACK /?CCL195
EQUAL? WINNER,ADVENTURER \?CCL195
PRINTI "Please consult your manual for the correct way to talk to other people or creatures."
CRLF
RFALSE
?CCL195: CALL CANT-USE,PTR
RFALSE
?CCL101: CALL UNKNOWN-WORD,PTR
RFALSE
?CCL203: ZERO? P-OFLAG /?CND204
CALL ORPHAN-MERGE
?CND204: SET 'P-WALK-DIR,FALSE-VALUE
SET 'AGAIN-DIR,FALSE-VALUE
CALL SYNTAX-CHECK
ZERO? STACK /FALSE
CALL SNARF-OBJECTS
ZERO? STACK /FALSE
CALL MANY-CHECK
ZERO? STACK /FALSE
CALL TAKE-CHECK
ZERO? STACK \TRUE
RFALSE
.FUNCT STUFF,SRC,DEST,MAX=29,PTR=P-LEXSTART,CTR=1,BPTR
GETB SRC,0
PUTB DEST,0,STACK
GETB SRC,1
PUTB DEST,1,STACK
?PRG1: GET SRC,PTR
PUT DEST,PTR,STACK
MUL PTR,2
ADD STACK,2 >BPTR
GETB SRC,BPTR
PUTB DEST,BPTR,STACK
MUL PTR,2
ADD STACK,3 >BPTR
GETB SRC,BPTR
PUTB DEST,BPTR,STACK
ADD PTR,P-LEXELEN >PTR
IGRTR? 'CTR,MAX \?PRG1
RTRUE
.FUNCT INBUF-STUFF,SRC,DEST,CNT
GETB SRC,0
SUB STACK,1 >CNT
?PRG1: GETB SRC,CNT
PUTB DEST,CNT,STACK
DLESS? 'CNT,0 \?PRG1
RTRUE
.FUNCT INBUF-ADD,LEN,BEG,SLOT,DBEG,CTR=0,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 WT?,PTR,BIT,B1=5,OFFS=P-P1OFF,TYP
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,OFF,NUM,ANDFLG=0,FIRST??=1,NW,LW=0,?TMP1
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 \?PRG8
GET P-ITBL,NUM
ADD STACK,4
PUT P-ITBL,NUM,STACK
?PRG8: DLESS? 'P-LEN,0 \?CND10
ADD NUM,1 >?TMP1
MUL PTR,2
ADD P-LEXV,STACK
PUT P-ITBL,?TMP1,STACK
RETURN -1
?CND10: GET P-LEXV,PTR >WRD
ZERO? WRD \?CTR13
CALL NUMBER?,PTR >WRD
ZERO? WRD /?CCL14
?CTR13: ZERO? P-LEN \?CCL19
SET 'NW,0
JUMP ?CND17
?CCL19: ADD PTR,P-LEXELEN
GET P-LEXV,STACK >NW
?CND17: EQUAL? WRD,W?AND,W?COMMA \?CCL22
SET 'ANDFLG,TRUE-VALUE
JUMP ?CND12
?CCL22: EQUAL? WRD,W?ALL,W?ONE \?CCL24
EQUAL? NW,W?OF \?CND12
DEC 'P-LEN
ADD PTR,P-LEXELEN >PTR
JUMP ?CND12
?CCL24: EQUAL? WRD,W?THEN,W?PERIOD /?CTR27
CALL WT?,WRD,8
ZERO? STACK /?CCL28
GET P-ITBL,P-VERB
ZERO? STACK /?CCL28
ZERO? FIRST?? \?CCL28
?CTR27: INC 'P-LEN
ADD NUM,1 >?TMP1
MUL PTR,2
ADD P-LEXV,STACK
PUT P-ITBL,?TMP1,STACK
SUB PTR,P-LEXELEN
RSTACK
?CCL28: CALL WT?,WRD,128
ZERO? STACK /?CCL35
GRTR? P-LEN,0 \?CCL38
EQUAL? NW,W?OF \?CCL38
EQUAL? WRD,W?ALL,W?ONE \?CND12
?CCL38: CALL WT?,WRD,32,2
ZERO? STACK /?CCL42
ZERO? NW /?CCL42
CALL WT?,NW,128
ZERO? STACK \?CND12
?CCL42: ZERO? ANDFLG \?CCL47
EQUAL? NW,W?BUT,W?EXCEPT /?CCL47
EQUAL? NW,W?AND,W?COMMA /?CCL47
ADD NUM,1 >?TMP1
ADD PTR,2
MUL STACK,2
ADD P-LEXV,STACK
PUT P-ITBL,?TMP1,STACK
RETURN PTR
?CCL47: SET 'ANDFLG,FALSE-VALUE
JUMP ?CND12
?CCL35: ZERO? P-MERGED \?PRD53
ZERO? P-OFLAG \?PRD53
GET P-ITBL,P-VERB
ZERO? STACK /?CCL51
?PRD53: CALL WT?,WRD,32
ZERO? STACK \?CND12
CALL WT?,WRD,4
ZERO? STACK \?CND12
?CCL51: ZERO? ANDFLG /?CCL60
CALL WT?,WRD,16
ZERO? STACK \?CTR59
CALL WT?,WRD,64
ZERO? STACK /?CCL60
?CTR59: SUB PTR,4 >PTR
ADD PTR,2
PUT P-LEXV,STACK,W?THEN
ADD P-LEN,2 >P-LEN
?CND12: SET 'LW,WRD
SET 'FIRST??,FALSE-VALUE
ADD PTR,P-LEXELEN >PTR
JUMP ?PRG8
?CCL60: CALL WT?,WRD,8
ZERO? STACK \?CND12
CALL CANT-USE,PTR
RFALSE
?CCL14: CALL UNKNOWN-WORD,PTR
RFALSE
.FUNCT NUMBER?,PTR,CNT,BPTR,CHR,SUM=0,TIM=0,?TMP1
MUL PTR,2
ADD P-LEXV,STACK
GETB STACK,2 >CNT
MUL PTR,2
ADD P-LEXV,STACK
GETB STACK,3 >BPTR
?PRG1: DLESS? 'CNT,0 /?REP2
GETB P-INBUF,BPTR >CHR
EQUAL? CHR,58 \?CCL8
SET 'TIM,SUM
SET 'SUM,0
JUMP ?CND6
?CCL8: GRTR? SUM,10000 /FALSE
LESS? CHR,58 \FALSE
GRTR? CHR,47 \FALSE
MUL SUM,10 >?TMP1
SUB CHR,48
ADD ?TMP1,STACK >SUM
?CND6: INC 'BPTR
JUMP ?PRG1
?REP2: PUT P-LEXV,PTR,W?INTNUM
GRTR? SUM,1000 /FALSE
ZERO? TIM /?CND15
LESS? TIM,8 \?CCL21
ADD TIM,12 >TIM
JUMP ?CND19
?CCL21: GRTR? TIM,23 /FALSE
?CND19: MUL TIM,60
ADD SUM,STACK >SUM
?CND15: SET 'P-NUMBER,SUM
RETURN W?INTNUM
.FUNCT ORPHAN-MERGE,CNT=-1,TEMP,VERB,BEG,END,ADJ=0,WRD,?TMP1
SET 'P-OFLAG,FALSE-VALUE
GET P-ITBL,P-VERBN
GET STACK,0 >WRD
CALL WT?,WRD,64,1 >?TMP1
GET P-OTBL,P-VERB
EQUAL? ?TMP1,STACK /?CTR2
CALL WT?,WRD,32
ZERO? STACK /?CCL3
?CTR2: SET 'ADJ,TRUE-VALUE
JUMP ?CND1
?CCL3: CALL WT?,WRD,128,0
ZERO? STACK /?CND1
ZERO? P-NCN \?CND1
PUT P-ITBL,P-VERB,0
PUT P-ITBL,P-VERBN,0
ADD P-LEXV,2
PUT P-ITBL,P-NC1,STACK
ADD P-LEXV,6
PUT P-ITBL,P-NC1L,STACK
SET 'P-NCN,1
?CND1: GET P-ITBL,P-VERB >VERB
ZERO? VERB /?CCL11
ZERO? ADJ \?CCL11
GET P-OTBL,P-VERB
EQUAL? VERB,STACK \FALSE
?CCL11: EQUAL? P-NCN,2 /FALSE
GET P-OTBL,P-NC1
EQUAL? STACK,1 \?CCL18
GET P-ITBL,P-PREP1 >TEMP
GET P-OTBL,P-PREP1
EQUAL? TEMP,STACK /?CTR20
ZERO? TEMP \FALSE
?CTR20: ZERO? ADJ /?CCL26
ADD P-LEXV,2
PUT P-OTBL,P-NC1,STACK
GET P-ITBL,P-NC1L
ZERO? STACK \?CND27
ADD P-LEXV,6
PUT P-ITBL,P-NC1L,STACK
?CND27: ZERO? P-NCN \?CND24
SET 'P-NCN,1
JUMP ?CND24
?CCL26: GET P-ITBL,P-NC1
PUT P-OTBL,P-NC1,STACK
?CND24: GET P-ITBL,P-NC1L
PUT P-OTBL,P-NC1L,STACK
JUMP ?CND9
?CCL18: GET P-OTBL,P-NC2
EQUAL? STACK,1 \?CCL32
GET P-ITBL,P-PREP1 >TEMP
GET P-OTBL,P-PREP2
EQUAL? TEMP,STACK /?CTR34
ZERO? TEMP \FALSE
?CTR34: ZERO? ADJ /?CND38
ADD P-LEXV,2
PUT P-ITBL,P-NC1,STACK
GET P-ITBL,P-NC1L
ZERO? STACK \?CND38
ADD P-LEXV,6
PUT P-ITBL,P-NC1L,STACK
?CND38: GET P-ITBL,P-NC1
PUT P-OTBL,P-NC2,STACK
GET P-ITBL,P-NC1L
PUT P-OTBL,P-NC2L,STACK
SET 'P-NCN,2
JUMP ?CND9
?CCL32: ZERO? P-ACLAUSE /?CND9
EQUAL? P-NCN,1 /?CCL45
ZERO? ADJ \?CCL45
SET 'P-ACLAUSE,FALSE-VALUE
RFALSE
?CCL45: GET P-ITBL,P-NC1 >BEG
ZERO? ADJ /?CND48
ADD P-LEXV,2 >BEG
SET 'ADJ,FALSE-VALUE
?CND48: GET P-ITBL,P-NC1L >END
?PRG50: GET BEG,0 >WRD
EQUAL? BEG,END \?CCL54
ZERO? ADJ /?CCL57
CALL ACLAUSE-WIN,ADJ
JUMP ?CND9
?CCL57: SET 'P-ACLAUSE,FALSE-VALUE
RFALSE
?CCL54: ZERO? ADJ \?CCL59
GETB WRD,P-PSOFF
BTST STACK,32 /?CTR58
EQUAL? WRD,W?ALL,W?ONE \?CCL59
?CTR58: SET 'ADJ,WRD
?CND52: ADD BEG,P-WORDLEN >BEG
ZERO? END \?PRG50
SET 'END,BEG
SET 'P-NCN,1
SUB BEG,4
PUT P-ITBL,P-NC1,STACK
PUT P-ITBL,P-NC1L,BEG
JUMP ?PRG50
?CCL59: EQUAL? WRD,W?ONE \?CCL65
CALL ACLAUSE-WIN,ADJ
JUMP ?CND9
?CCL65: GETB WRD,P-PSOFF
BTST STACK,128 \?CND52
EQUAL? WRD,P-ANAM \?CCL69
CALL ACLAUSE-WIN,ADJ
JUMP ?CND9
?CCL69: CALL NCLAUSE-WIN
?CND9: GET P-OVTBL,0
PUT P-VTBL,0,STACK
GETB P-OVTBL,2
PUTB P-VTBL,2,STACK
GETB P-OVTBL,3
PUTB P-VTBL,3,STACK
PUT P-OTBL,P-VERBN,P-VTBL
PUTB P-VTBL,2,0
?PRG72: IGRTR? 'CNT,P-ITBLLEN \?CCL76
SET 'P-MERGED,TRUE-VALUE
RTRUE
?CCL76: GET P-OTBL,CNT
PUT P-ITBL,CNT,STACK
JUMP ?PRG72
.FUNCT ACLAUSE-WIN,ADJ
GET P-OTBL,P-VERB
PUT P-ITBL,P-VERB,STACK
PUT P-CCTBL,CC-SBPTR,P-ACLAUSE
ADD P-ACLAUSE,1
PUT P-CCTBL,CC-SEPTR,STACK
PUT P-CCTBL,CC-DBPTR,P-ACLAUSE
ADD P-ACLAUSE,1
PUT P-CCTBL,CC-DEPTR,STACK
CALL CLAUSE-COPY,P-OTBL,P-OTBL,ADJ
GET P-OTBL,P-NC2
ZERO? STACK /?PEN1
SET 'P-NCN,2
?PEN1: SET 'P-ACLAUSE,FALSE-VALUE
RTRUE
.FUNCT NCLAUSE-WIN
PUT P-CCTBL,CC-SBPTR,P-NC1
PUT P-CCTBL,CC-SEPTR,P-NC1L
PUT P-CCTBL,CC-DBPTR,P-ACLAUSE
ADD P-ACLAUSE,1
PUT P-CCTBL,CC-DEPTR,STACK
CALL CLAUSE-COPY,P-ITBL,P-OTBL
GET P-OTBL,P-NC2
ZERO? STACK /?PEN1
SET 'P-NCN,2
?PEN1: SET 'P-ACLAUSE,FALSE-VALUE
RTRUE
.FUNCT WORD-PRINT,CNT,BUF
?PRG1: DLESS? 'CNT,0 /TRUE
GETB P-INBUF,BUF
PRINTC STACK
INC 'BUF
JUMP ?PRG1
.FUNCT UNKNOWN-WORD,PTR,BUF,?TMP1
PUT OOPS-TABLE,O-PTR,PTR
EQUAL? PRSA,V?SAY \?PRG5
PRINTI "Nothing happens."
CRLF
RFALSE
?PRG5: PRINTI "I don't know the word """
MUL PTR,2 >BUF
ADD P-LEXV,BUF
GETB STACK,2 >?TMP1
ADD P-LEXV,BUF
GETB STACK,3
CALL WORD-PRINT,?TMP1,STACK
PRINTI """."
CRLF
SET 'QUOTE-FLAG,FALSE-VALUE
SET 'P-OFLAG,FALSE-VALUE
RETURN P-OFLAG
.FUNCT CANT-USE,PTR,BUF,?TMP1
EQUAL? PRSA,V?SAY \?PRG5
PRINTI "Nothing happens."
CRLF
RFALSE
?PRG5: PRINTI "You used the word """
MUL PTR,2 >BUF
ADD P-LEXV,BUF
GETB STACK,2 >?TMP1
ADD P-LEXV,BUF
GETB STACK,3
CALL WORD-PRINT,?TMP1,STACK
PRINTI """ in a way that I don't understand."
CRLF
SET 'QUOTE-FLAG,FALSE-VALUE
SET 'P-OFLAG,FALSE-VALUE
RETURN P-OFLAG
.FUNCT GET-PREP,SYN,WHICH,PREP
EQUAL? WHICH,1 \?CCL3
GETB SYN,P-SPREP1 >PREP
JUMP ?CND1
?CCL3: GETB SYN,P-SPREP2 >PREP
?CND1: BAND PREP,63 >PREP
ZERO? PREP /FALSE
ADD PREP,192
RSTACK
.FUNCT SYNTAX-CHECK,SYN,LEN,NUM,OBJ,DRIVE1=0,DRIVE2=0,PREP,VERB,TMP,?TMP2,?TMP1
GET P-ITBL,P-VERB >VERB
ZERO? VERB \?CND1
PRINTI "There was no verb in that sentence!"
CRLF
RFALSE
?CND1: SUB 255,VERB
GET VERBS,STACK >SYN
GETB SYN,0 >LEN
INC 'SYN
?PRG5: GETB SYN,P-SPREP1
DIV STACK,64 >NUM
GRTR? P-NCN,NUM /?CND7
LESS? NUM,1 /?CCL11
ZERO? P-NCN \?CCL11
GET P-ITBL,P-PREP1 >PREP
ZERO? PREP /?CTR10
CALL GET-PREP,SYN,1
EQUAL? PREP,STACK \?CCL11
?CTR10: SET 'DRIVE1,SYN
JUMP ?CND7
?CCL11: CALL GET-PREP,SYN,1 >?TMP1
GET P-ITBL,P-PREP1
EQUAL? ?TMP1,STACK \?CND7
EQUAL? NUM,2 \?CCL20
EQUAL? P-NCN,1 \?CCL20
SET 'DRIVE2,SYN
?CND7: DLESS? 'LEN,1 \?CCL28
ZERO? DRIVE1 \?REP6
ZERO? DRIVE2 \?REP6
PRINTI "That sentence isn't one I recognize."
CRLF
RFALSE
?CCL20: GRTR? NUM,1 \?CCL23
CALL GET-PREP,SYN,2 >?TMP1
GET P-ITBL,P-PREP2
EQUAL? ?TMP1,STACK \?CND7
?CCL23: CALL SYNTAX-FOUND,SYN
RTRUE
?CCL28: ZERO? NUM \?CCL38
ADD SYN,P-SYNLEN-0 >SYN
JUMP ?PRG5
?CCL38: EQUAL? NUM,1 \?CCL40
ADD SYN,P-SYNLEN-1 >SYN
JUMP ?PRG5
?CCL40: ADD SYN,P-SYNLEN-2 >SYN
JUMP ?PRG5
?REP6: ZERO? DRIVE1 /?CCL43
GETB DRIVE1,P-SFWIM1 >?TMP2
GETB DRIVE1,P-SLOC1 >?TMP1
CALL GET-PREP,DRIVE1,1
CALL GWIM,?TMP2,?TMP1,STACK >OBJ
ZERO? OBJ /?CCL43
PUT P-PRSO,P-MATCHLEN,1
PUT P-PRSO,1,OBJ
CALL SYNTAX-FOUND,DRIVE1
RSTACK
?CCL43: ZERO? DRIVE2 /?CCL47
GETB DRIVE2,P-SFWIM2 >?TMP2
GETB DRIVE2,P-SLOC2 >?TMP1
CALL GET-PREP,DRIVE2,2
CALL GWIM,?TMP2,?TMP1,STACK >OBJ
ZERO? OBJ /?CCL47
PUT P-PRSI,P-MATCHLEN,1
PUT P-PRSI,1,OBJ
CALL SYNTAX-FOUND,DRIVE2
RSTACK
?CCL47: EQUAL? VERB,ACT?FIND \?CCL51
PRINTI "That question can't be answered."
CRLF
RFALSE
?CCL51: EQUAL? WINNER,ADVENTURER /?CCL55
CALL CANT-ORPHAN
RSTACK
?CCL55: CALL ORPHAN,DRIVE1,DRIVE2
PRINTI "What do you want to "
GET P-OTBL,P-VERBN >TMP
ZERO? TMP \?CCL60
PRINTI "tell"
JUMP ?CND58
?CCL60: GETB P-VTBL,2
ZERO? STACK \?CCL64
GET TMP,0
PRINTB STACK
JUMP ?CND58
?CCL64: GETB TMP,2 >?TMP1
GETB TMP,3
CALL WORD-PRINT,?TMP1,STACK
PUTB P-VTBL,2,0
?CND58: ZERO? DRIVE2 /?CND65
PRINTC 32
CALL THING-PRINT,TRUE-VALUE,TRUE-VALUE
?CND65: SET 'P-OFLAG,TRUE-VALUE
ZERO? DRIVE1 /?CCL71
CALL GET-PREP,DRIVE1,1
JUMP ?CND69
?CCL71: CALL GET-PREP,DRIVE2,2
?CND69: CALL PREP-PRINT,STACK
PRINTC 63
CRLF
RFALSE
.FUNCT CANT-ORPHAN
PRINTI """I don't understand! What are you referring to?"""
CRLF
RFALSE
.FUNCT ORPHAN,D1,D2,CNT=-1
ZERO? P-MERGED \?CND1
PUT P-OCLAUSE,P-MATCHLEN,0
?CND1: GET P-VTBL,0
PUT P-OVTBL,0,STACK
GETB P-VTBL,2
PUTB P-OVTBL,2,STACK
GETB P-VTBL,3
PUTB P-OVTBL,3,STACK
?PRG3: IGRTR? 'CNT,P-ITBLLEN /?REP4
GET P-ITBL,CNT
PUT P-OTBL,CNT,STACK
JUMP ?PRG3
?REP4: EQUAL? P-NCN,2 \?CND8
PUT P-CCTBL,CC-SBPTR,P-NC2
PUT P-CCTBL,CC-SEPTR,P-NC2L
PUT P-CCTBL,CC-DBPTR,P-NC2
PUT P-CCTBL,CC-DEPTR,P-NC2L
CALL CLAUSE-COPY,P-ITBL,P-OTBL
?CND8: LESS? P-NCN,1 /?CND10
PUT P-CCTBL,CC-SBPTR,P-NC1
PUT P-CCTBL,CC-SEPTR,P-NC1L
PUT P-CCTBL,CC-DBPTR,P-NC1
PUT P-CCTBL,CC-DEPTR,P-NC1L
CALL CLAUSE-COPY,P-ITBL,P-OTBL
?CND10: ZERO? D1 /?CCL14
CALL GET-PREP,D1,1
PUT P-OTBL,P-PREP1,STACK
PUT P-OTBL,P-NC1,1
RTRUE
?CCL14: ZERO? D2 /FALSE
CALL GET-PREP,D2,2
PUT P-OTBL,P-PREP2,STACK
PUT P-OTBL,P-NC2,1
RTRUE
.FUNCT THING-PRINT,PRSO?,THE?=0,BEG,END
ZERO? PRSO? /?CCL3
GET P-ITBL,P-NC1 >BEG
GET P-ITBL,P-NC1L >END
JUMP ?CND1
?CCL3: GET P-ITBL,P-NC2 >BEG
GET P-ITBL,P-NC2L >END
?CND1: CALL BUFFER-PRINT,BEG,END,THE?
RSTACK
.FUNCT BUFFER-PRINT,BEG,END,CP,NOSP=1,WRD,FIRST??=1,PN=0,Q?=0,?TMP1
?PRG1: EQUAL? BEG,END /TRUE
GET BEG,0 >WRD
EQUAL? WRD,W?COMMA \?CCL8
PRINTI ", "
JUMP ?CND6
?CCL8: ZERO? NOSP /?PRG13
SET 'NOSP,FALSE-VALUE
JUMP ?CND6
?PRG13: PRINTC 32
?CND6: EQUAL? WRD,W?PERIOD,W?COMMA \?CCL17
SET 'NOSP,TRUE-VALUE
JUMP ?CND3
?CCL17: EQUAL? WRD,W?ME \?CCL19
PRINTD ME
SET 'PN,TRUE-VALUE
JUMP ?CND3
?CCL19: EQUAL? WRD,W?INTNUM \?CCL21
PRINTN P-NUMBER
SET 'PN,TRUE-VALUE
JUMP ?CND3
?CCL21: ZERO? FIRST?? /?CND22
ZERO? PN \?CND22
ZERO? CP /?CND22
PRINTI "the "
?CND22: ZERO? P-OFLAG \?CTR30
ZERO? P-MERGED /?CCL31
?CTR30: PRINTB WRD
JUMP ?CND29
?CCL31: EQUAL? WRD,W?IT \?CCL35
CALL ACCESSIBLE?,P-IT-OBJECT
ZERO? STACK /?CCL35
PRINTD P-IT-OBJECT
JUMP ?CND29
?CCL35: GETB BEG,2 >?TMP1
GETB BEG,3
CALL WORD-PRINT,?TMP1,STACK
?CND29: SET 'FIRST??,FALSE-VALUE
?CND3: ADD BEG,P-WORDLEN >BEG
JUMP ?PRG1
.FUNCT PREP-PRINT,PREP,WRD
ZERO? PREP /FALSE
PRINTC 32
CALL PREP-FIND,PREP >WRD
PRINTB WRD
RTRUE
.FUNCT CLAUSE-COPY,SRC,DEST,INSRT=0,BEG,END,?TMP1
GET P-CCTBL,CC-SBPTR
GET SRC,STACK >BEG
GET P-CCTBL,CC-SEPTR
GET SRC,STACK >END
GET P-CCTBL,CC-DBPTR >?TMP1
GET P-OCLAUSE,P-MATCHLEN
MUL STACK,P-LEXELEN
ADD STACK,2
ADD P-OCLAUSE,STACK
PUT DEST,?TMP1,STACK
?PRG1: EQUAL? BEG,END \?CCL5
GET P-CCTBL,CC-DEPTR >?TMP1
GET P-OCLAUSE,P-MATCHLEN
MUL STACK,P-LEXELEN
ADD STACK,2
ADD P-OCLAUSE,STACK
PUT DEST,?TMP1,STACK
RTRUE
?CCL5: ZERO? INSRT /?CND6
GET BEG,0
EQUAL? P-ANAM,STACK \?CND6
CALL CLAUSE-ADD,INSRT
?CND6: GET BEG,0
CALL CLAUSE-ADD,STACK
ADD BEG,P-WORDLEN >BEG
JUMP ?PRG1
.FUNCT CLAUSE-ADD,WRD,PTR
GET P-OCLAUSE,P-MATCHLEN
ADD STACK,2 >PTR
SUB PTR,1
PUT P-OCLAUSE,STACK,WRD
PUT P-OCLAUSE,PTR,0
PUT P-OCLAUSE,P-MATCHLEN,PTR
RTRUE
.FUNCT PREP-FIND,PREP,CNT=0,SIZE
GET PREPOSITIONS,0
MUL STACK,2 >SIZE
?PRG1: IGRTR? 'CNT,SIZE /FALSE
GET PREPOSITIONS,CNT
EQUAL? STACK,PREP \?PRG1
SUB CNT,1
GET PREPOSITIONS,STACK
RSTACK
.FUNCT SYNTAX-FOUND,SYN
SET 'P-SYNTAX,SYN
GETB SYN,P-SACTION >PRSA
RETURN PRSA
.FUNCT GWIM,GBIT,LBIT,PREP,OBJ
EQUAL? GBIT,RLANDBIT \?CND1
RETURN ROOMS
?CND1: SET 'P-GWIMBIT,GBIT
SET 'P-SLOCBITS,LBIT
PUT P-MERGE,P-MATCHLEN,0
CALL GET-OBJECT,P-MERGE,FALSE-VALUE
ZERO? STACK /?CCL5
SET 'P-GWIMBIT,0
GET P-MERGE,P-MATCHLEN
EQUAL? STACK,1 \FALSE
GET P-MERGE,1 >OBJ
PRINTC 40
ZERO? PREP /?PRG31
ZERO? P-END-ON-PREP \?PRG31
CALL PREP-FIND,PREP >PREP
PRINTB PREP
EQUAL? PREP,W?OUT \?PRG20
PRINTI " of"
?PRG20: PRINTC 32
EQUAL? OBJ,HANDS \?PRG27
PRINTI "your hands"
JUMP ?PRG29
?PRG27: PRINTI "the "
PRINTD OBJ
?PRG29: PRINTC 41
CRLF
RETURN OBJ
?PRG31: PRINTD OBJ
PRINTC 41
CRLF
RETURN OBJ
?CCL5: SET 'P-GWIMBIT,0
RFALSE
.FUNCT SNARF-OBJECTS,OPTR,IPTR,L
PUT P-BUTS,P-MATCHLEN,0
GET P-ITBL,P-NC2 >IPTR
ZERO? IPTR /?CND1
GETB P-SYNTAX,P-SLOC2 >P-SLOCBITS
GET P-ITBL,P-NC2L
CALL SNARFEM,IPTR,STACK,P-PRSI
ZERO? STACK /FALSE
?CND1: GET P-ITBL,P-NC1 >OPTR
ZERO? OPTR /?CND5
GETB P-SYNTAX,P-SLOC1 >P-SLOCBITS
GET P-ITBL,P-NC1L
CALL SNARFEM,OPTR,STACK,P-PRSO
ZERO? STACK /FALSE
?CND5: GET P-BUTS,P-MATCHLEN
ZERO? STACK /TRUE
GET P-PRSO,P-MATCHLEN >L
ZERO? OPTR /?CND11
CALL BUT-MERGE,P-PRSO >P-PRSO
?CND11: ZERO? IPTR /TRUE
ZERO? OPTR /?CCL14
GET P-PRSO,P-MATCHLEN
EQUAL? L,STACK \TRUE
?CCL14: CALL BUT-MERGE,P-PRSI >P-PRSI
RTRUE
.FUNCT BUT-MERGE,TBL,LEN,BUTLEN,CNT=1,MATCHES=0,OBJ,NTBL
GET TBL,P-MATCHLEN >LEN
PUT P-MERGE,P-MATCHLEN,0
?PRG1: DLESS? 'LEN,0 /?REP2
GET TBL,CNT >OBJ
CALL ZMEMQ,OBJ,P-BUTS
ZERO? STACK \?CND3
ADD MATCHES,1
PUT P-MERGE,STACK,OBJ
INC 'MATCHES
?CND3: INC 'CNT
JUMP ?PRG1
?REP2: PUT P-MERGE,P-MATCHLEN,MATCHES
SET 'NTBL,P-MERGE
SET 'P-MERGE,TBL
RETURN NTBL
.FUNCT SNARFEM,PTR,EPTR,TBL,BUT=0,LEN,WV,WRD,NW,WAS-ALL=0
SET 'P-AND,FALSE-VALUE
EQUAL? P-GETFLAGS,P-ALL \?CND1
SET 'WAS-ALL,TRUE-VALUE
?CND1: SET 'P-GETFLAGS,0
PUT TBL,P-MATCHLEN,0
GET PTR,0 >WRD
?PRG3: EQUAL? PTR,EPTR \?CCL7
ZERO? BUT /?PRD10
PUSH BUT
JUMP ?PEN8
?PRD10: PUSH TBL
?PEN8: CALL GET-OBJECT,STACK >WV
ZERO? WAS-ALL \?CCL12
RETURN WV
?CCL12: SET 'P-GETFLAGS,P-ALL
RETURN WV
?CCL7: ADD PTR,P-WORDLEN
EQUAL? EPTR,STACK \?CCL15
SET 'NW,0
JUMP ?CND13
?CCL15: GET PTR,P-LEXELEN >NW
?CND13: EQUAL? WRD,W?ALL \?CCL18
SET 'P-GETFLAGS,P-ALL
EQUAL? NW,W?OF \?CND5
ADD PTR,P-WORDLEN >PTR
JUMP ?CND5
?CCL18: EQUAL? WRD,W?BUT,W?EXCEPT \?CCL22
ZERO? BUT /?PRD27
PUSH BUT
JUMP ?PEN25
?PRD27: PUSH TBL
?PEN25: CALL GET-OBJECT,STACK
ZERO? STACK /FALSE
SET 'BUT,P-BUTS
PUT BUT,P-MATCHLEN,0
JUMP ?CND5
?CCL22: EQUAL? WRD,W?A,W?ONE \?CCL29
ZERO? P-ADJ \?CCL32
SET 'P-GETFLAGS,P-ONE
EQUAL? NW,W?OF \?CND5
ADD PTR,P-WORDLEN >PTR
JUMP ?CND5
?CCL32: SET 'P-NAM,P-ONEOBJ
ZERO? BUT /?PRD39
PUSH BUT
JUMP ?PEN37
?PRD39: PUSH TBL
?PEN37: CALL GET-OBJECT,STACK
ZERO? STACK /FALSE
ZERO? NW \?CND5
RTRUE
?CCL29: EQUAL? WRD,W?AND,W?COMMA \?CCL43
EQUAL? NW,W?AND,W?COMMA /?CCL43
SET 'P-AND,TRUE-VALUE
ZERO? BUT /?PRD50
PUSH BUT
JUMP ?PEN48
?PRD50: PUSH TBL
?PEN48: CALL GET-OBJECT,STACK
ZERO? STACK \?CND5
RFALSE
?CCL43: CALL WT?,WRD,4
ZERO? STACK \?CND5
EQUAL? WRD,W?AND,W?COMMA /?CND5
EQUAL? WRD,W?OF \?CCL54
ZERO? P-GETFLAGS \?CND5
SET 'P-GETFLAGS,P-INHIBIT
JUMP ?CND5
?CCL54: CALL WT?,WRD,32,2 >WV
ZERO? WV /?CCL58
ZERO? P-ADJ \?CCL58
SET 'P-ADJ,WV
SET 'P-ADJN,WRD
JUMP ?CND5
?CCL58: CALL WT?,WRD,128,0
ZERO? STACK /?CND5
SET 'P-NAM,WRD
SET 'P-ONEOBJ,WRD
?CND5: EQUAL? PTR,EPTR /?PRG3
ADD PTR,P-WORDLEN >PTR
SET 'WRD,NW
JUMP ?PRG3
.FUNCT GET-OBJECT,TBL,VRB=1,BITS,LEN,XBITS,TLEN,GCHECK=0,OLEN=0,OBJ
SET 'XBITS,P-SLOCBITS
GET TBL,P-MATCHLEN >TLEN
BTST P-GETFLAGS,P-INHIBIT /TRUE
ZERO? P-NAM \?CND3
ZERO? P-ADJ /?CND3
CALL WT?,P-ADJN,128,0
ZERO? STACK /?CND3
SET 'P-NAM,P-ADJN
SET 'P-ADJ,FALSE-VALUE
?CND3: ZERO? P-NAM \?CND9
ZERO? P-ADJ \?CND9
EQUAL? P-GETFLAGS,P-ALL /?CND9
ZERO? P-GWIMBIT \?CND9
ZERO? VRB /FALSE
PRINTI "There seems to be a noun missing in that sentence!"
CRLF
RFALSE
?CND9: EQUAL? P-GETFLAGS,P-ALL \?CCL20
ZERO? P-SLOCBITS \?CND19
?CCL20: SET 'P-SLOCBITS,-1
?CND19: SET 'P-TABLE,TBL
?PRG23: ZERO? GCHECK /?CCL27
CALL GLOBAL-CHECK,TBL
JUMP ?CND25
?CCL27: ZERO? LIT /?CND28
FCLEAR ADVENTURER,TRANSBIT
CALL DO-SL,HERE,SOG,SIR
FSET ADVENTURER,TRANSBIT
?CND28: CALL DO-SL,ADVENTURER,SH,SC
?CND25: GET TBL,P-MATCHLEN
SUB STACK,TLEN >LEN
BTST P-GETFLAGS,P-ALL /?CND30
BTST P-GETFLAGS,P-ONE \?CCL33
ZERO? LEN /?CCL33
EQUAL? LEN,1 /?CND36
RANDOM LEN
GET TBL,STACK
PUT TBL,1,STACK
PRINTI "(How about the "
GET TBL,1
PRINTD STACK
PRINTI "?)"
CRLF
?CND36: PUT TBL,P-MATCHLEN,1
JUMP ?CND30
?CCL33: GRTR? LEN,1 /?CCL42
ZERO? LEN \?CND30
EQUAL? P-SLOCBITS,-1 /?CND30
?CCL42: EQUAL? P-SLOCBITS,-1 \?CCL49
SET 'P-SLOCBITS,XBITS
SET 'OLEN,LEN
GET TBL,P-MATCHLEN
SUB STACK,LEN
PUT TBL,P-MATCHLEN,STACK
JUMP ?PRG23
?CCL49: ZERO? LEN \?CND50
SET 'LEN,OLEN
?CND50: EQUAL? WINNER,ADVENTURER /?CCL54
CALL CANT-ORPHAN
RFALSE
?CCL54: ZERO? VRB /?CCL56
ZERO? P-NAM /?CCL56
CALL WHICH-PRINT,TLEN,LEN,TBL
EQUAL? TBL,P-PRSO \?CCL61
SET 'P-ACLAUSE,P-NC1
JUMP ?CND59
?CCL61: SET 'P-ACLAUSE,P-NC2
?CND59: SET 'P-AADJ,P-ADJ
SET 'P-ANAM,P-NAM
CALL ORPHAN,FALSE-VALUE,FALSE-VALUE
SET 'P-OFLAG,TRUE-VALUE
JUMP ?CND52
?CCL56: ZERO? VRB /?CND52
PRINTI "There seems to be a noun missing in that sentence!"
CRLF
?CND52: SET 'P-NAM,FALSE-VALUE
SET 'P-ADJ,FALSE-VALUE
RFALSE
?CND30: ZERO? LEN \?CCL67
ZERO? GCHECK /?CCL67
ZERO? VRB /?CND70
SET 'P-SLOCBITS,XBITS
ZERO? LIT \?CTR73
EQUAL? PRSA,V?TELL \?PRG77
?CTR73: CALL OBJ-FOUND,NOT-HERE-OBJECT,TBL
SET 'P-XNAM,P-NAM
SET 'P-XADJ,P-ADJ
SET 'P-XADJN,P-ADJN
SET 'P-NAM,FALSE-VALUE
SET 'P-ADJ,FALSE-VALUE
SET 'P-ADJN,FALSE-VALUE
RTRUE
?PRG77: PRINT TOO-DARK
CRLF
?CND70: SET 'P-NAM,FALSE-VALUE
SET 'P-ADJ,FALSE-VALUE
RFALSE
?CCL67: ZERO? LEN \?CND65
SET 'GCHECK,TRUE-VALUE
JUMP ?PRG23
?CND65: SET 'P-SLOCBITS,XBITS
SET 'P-NAM,FALSE-VALUE
SET 'P-ADJ,FALSE-VALUE
RTRUE
.FUNCT WHICH-PRINT,TLEN,LEN,TBL,OBJ,RLEN
SET 'RLEN,LEN
PRINTI "Which "
ZERO? P-OFLAG \?CTR4
ZERO? P-MERGED \?CTR4
ZERO? P-AND /?CCL5
?CTR4: ZERO? P-NAM /?CCL11
PUSH P-NAM
JUMP ?CND9
?CCL11: ZERO? P-ADJ /?CCL13
PUSH P-ADJN
JUMP ?CND9
?CCL13: PUSH W?ONE
?CND9: PRINTB STACK
JUMP ?PRG16
?CCL5: EQUAL? TBL,P-PRSO /?PRD14
PUSH 0
JUMP ?PRD15
?PRD14: PUSH 1
?PRD15: CALL THING-PRINT,STACK
?PRG16: PRINTI " do you mean, "
?PRG18: INC 'TLEN
GET TBL,TLEN >OBJ
PRINTI "the "
PRINTD OBJ
EQUAL? LEN,2 \?CCL24
EQUAL? RLEN,2 /?PRG29
PRINTC 44
?PRG29: PRINTI " or "
JUMP ?CND22
?CCL24: GRTR? LEN,2 \?CND22
PRINTI ", "
?CND22: DLESS? 'LEN,1 \?PRG18
PRINTR "?"
.FUNCT GLOBAL-CHECK,TBL,LEN,RMG,RMGL,CNT=0,OBJ,OBITS,FOO
GET TBL,P-MATCHLEN >LEN
SET 'OBITS,P-SLOCBITS
GETPT HERE,P?GLOBAL >RMG
ZERO? RMG /?CND1
PTSIZE RMG
SUB STACK,1 >RMGL
?PRG3: GETB RMG,CNT >OBJ
CALL THIS-IT?,OBJ,TBL
ZERO? STACK /?CND5
CALL OBJ-FOUND,OBJ,TBL
?CND5: IGRTR? 'CNT,RMGL \?PRG3
?CND1: GETPT HERE,P?PSEUDO >RMG
ZERO? RMG /?CND9
PTSIZE RMG
DIV STACK,4
SUB STACK,1 >RMGL
SET 'CNT,0
?PRG11: MUL CNT,2
GET RMG,STACK
EQUAL? P-NAM,STACK \?CCL15
MUL CNT,2
ADD STACK,1
GET RMG,STACK
PUTP PSEUDO-OBJECT,P?ACTION,STACK
GETPT PSEUDO-OBJECT,P?ACTION
SUB STACK,5 >FOO
GET P-NAM,0
PUT FOO,0,STACK
GET P-NAM,1
PUT FOO,1,STACK
CALL OBJ-FOUND,PSEUDO-OBJECT,TBL
JUMP ?CND9
?CCL15: IGRTR? 'CNT,RMGL \?PRG11
?CND9: GET TBL,P-MATCHLEN
EQUAL? STACK,LEN \FALSE
SET 'P-SLOCBITS,-1
SET 'P-TABLE,TBL
CALL DO-SL,GLOBAL-OBJECTS,1,1
SET 'P-SLOCBITS,OBITS
GET TBL,P-MATCHLEN
ZERO? STACK \FALSE
EQUAL? PRSA,V?LOOK-INSIDE,V?SEARCH,V?EXAMINE \FALSE
CALL DO-SL,ROOMS,1,1
RSTACK
.FUNCT DO-SL,OBJ,BIT1,BIT2,BTS
ADD BIT1,BIT2
BTST P-SLOCBITS,STACK \?CCL3
CALL SEARCH-LIST,OBJ,P-TABLE,P-SRCALL
RSTACK
?CCL3: BTST P-SLOCBITS,BIT1 \?CCL6
CALL SEARCH-LIST,OBJ,P-TABLE,P-SRCTOP
RSTACK
?CCL6: BTST P-SLOCBITS,BIT2 \TRUE
CALL SEARCH-LIST,OBJ,P-TABLE,P-SRCBOT
RSTACK
.FUNCT SEARCH-LIST,OBJ,TBL,LVL,FLS,NOBJ
FIRST? OBJ >OBJ \FALSE
?PRG4: EQUAL? LVL,P-SRCBOT /?CND6
GETPT OBJ,P?SYNONYM
ZERO? STACK /?CND6
CALL THIS-IT?,OBJ,TBL
ZERO? STACK /?CND6
CALL OBJ-FOUND,OBJ,TBL
?CND6: ZERO? LVL \?PRD14
FSET? OBJ,SEARCHBIT /?PRD14
FSET? OBJ,SURFACEBIT \?CND11
?PRD14: FIRST? OBJ >NOBJ \?CND11
FSET? OBJ,OPENBIT /?CCL12
FSET? OBJ,TRANSBIT \?CND11
?CCL12: FSET? OBJ,SURFACEBIT \?CCL23
PUSH P-SRCALL
JUMP ?CND21
?CCL23: FSET? OBJ,SEARCHBIT \?CCL25
PUSH P-SRCALL
JUMP ?CND21
?CCL25: PUSH P-SRCTOP
?CND21: CALL SEARCH-LIST,OBJ,TBL,STACK >FLS
?CND11: NEXT? OBJ >OBJ /?PRG4
RTRUE
.FUNCT OBJ-FOUND,OBJ,TBL,PTR
GET TBL,P-MATCHLEN >PTR
ADD PTR,1
PUT TBL,STACK,OBJ
ADD PTR,1
PUT TBL,P-MATCHLEN,STACK
RTRUE
.FUNCT TAKE-CHECK,N
GETB P-SYNTAX,P-SPREP1
DIV STACK,64 >N
GRTR? N,0 \TRUE
GETB P-SYNTAX,P-SLOC1
CALL ITAKE-CHECK,P-PRSO,STACK
ZERO? STACK /FALSE
GRTR? N,1 \TRUE
GETB P-SYNTAX,P-SLOC2
CALL ITAKE-CHECK,P-PRSI,STACK
RSTACK
.FUNCT ITAKE-CHECK,TBL,IBITS,PTR,OBJ,TAKEN
GET TBL,P-MATCHLEN >PTR
ZERO? PTR /TRUE
BTST IBITS,SHAVE /?PRG8
BTST IBITS,STAKE \TRUE
?PRG8: DLESS? 'PTR,0 /TRUE
ADD PTR,1
GET TBL,STACK >OBJ
EQUAL? OBJ,IT \?CND13
CALL ACCESSIBLE?,P-IT-OBJECT
ZERO? STACK \?CCL17
PRINT REFERRING
RFALSE
?CCL17: SET 'OBJ,P-IT-OBJECT
?CND13: CALL HELD?,OBJ
ZERO? STACK \?PRG8
EQUAL? OBJ,HANDS,ME /?PRG8
SET 'PRSO,OBJ
FSET? OBJ,TRYTAKEBIT \?CCL26
SET 'TAKEN,TRUE-VALUE
JUMP ?CND24
?CCL26: EQUAL? WINNER,ADVENTURER /?CCL28
SET 'TAKEN,FALSE-VALUE
JUMP ?CND24
?CCL28: BTST IBITS,STAKE \?CCL30
CALL ITAKE,FALSE-VALUE
EQUAL? STACK,TRUE-VALUE \?CCL30
SET 'TAKEN,FALSE-VALUE
JUMP ?CND24
?CCL30: SET 'TAKEN,TRUE-VALUE
?CND24: ZERO? TAKEN /?CCL35
BTST IBITS,SHAVE \?CCL35
EQUAL? WINNER,ADVENTURER \?CCL35
EQUAL? OBJ,NOT-HERE-OBJECT \?PRG43
PRINTI "You don't have that!"
CRLF
RFALSE
?PRG43: PRINTI "You don't have the "
PRINTD OBJ
PRINT PERIOD-CR
RFALSE
?CCL35: ZERO? TAKEN \?PRG8
EQUAL? WINNER,ADVENTURER \?PRG8
PRINTI "(Taken)"
CRLF
JUMP ?PRG8
.FUNCT MANY-CHECK,LOSS=0,TMP,?TMP1
GET P-PRSO,P-MATCHLEN
GRTR? STACK,1 \?CCL3
GETB P-SYNTAX,P-SLOC1
BTST STACK,SMANY /?CCL3
SET 'LOSS,1
JUMP ?CND1
?CCL3: GET P-PRSI,P-MATCHLEN
GRTR? STACK,1 \?CND1
GETB P-SYNTAX,P-SLOC2
BTST STACK,SMANY /?CND1
SET 'LOSS,2
?CND1: ZERO? LOSS /TRUE
PRINTI "You can't use multiple "
EQUAL? LOSS,2 \?PRG18
PRINTI "in"
?PRG18: PRINTI "direct objects with """
GET P-ITBL,P-VERBN >TMP
ZERO? TMP \?CCL22
PRINTI "tell"
JUMP ?PRG29
?CCL22: ZERO? P-OFLAG \?CTR25
ZERO? P-MERGED /?CCL26
?CTR25: GET TMP,0
PRINTB STACK
JUMP ?PRG29
?CCL26: GETB TMP,2 >?TMP1
GETB TMP,3
CALL WORD-PRINT,?TMP1,STACK
?PRG29: PRINTI """."
CRLF
RFALSE
.FUNCT ZMEMQ,ITM,TBL,SIZE=-1,CNT=1
ZERO? TBL /FALSE
LESS? SIZE,0 /?CCL5
SET 'CNT,0
JUMP ?PRG6
?CCL5: GET TBL,0 >SIZE
?PRG6: GET TBL,CNT
EQUAL? ITM,STACK \?CCL10
MUL CNT,2
ADD TBL,STACK
RSTACK
?CCL10: IGRTR? 'CNT,SIZE \?PRG6
RFALSE
.FUNCT ZMEMQB,ITM,TBL,SIZE,CNT=0
?PRG1: GETB TBL,CNT
EQUAL? ITM,STACK /TRUE
IGRTR? 'CNT,SIZE \?PRG1
RFALSE
.FUNCT LIT?,RM,RMBIT=1,OHERE,LIT=0
ZERO? ALWAYS-LIT /?CND1
EQUAL? WINNER,ADVENTURER /TRUE
?CND1: SET 'P-GWIMBIT,ONBIT
SET 'OHERE,HERE
SET 'HERE,RM
ZERO? RMBIT /?CCL7
FSET? RM,ONBIT \?CCL7
SET 'LIT,TRUE-VALUE
JUMP ?CND5
?CCL7: PUT P-MERGE,P-MATCHLEN,0
SET 'P-TABLE,P-MERGE
SET 'P-SLOCBITS,-1
EQUAL? OHERE,RM \?CND10
CALL DO-SL,WINNER,1,1
EQUAL? WINNER,ADVENTURER /?CND10
IN? ADVENTURER,RM \?CND10
CALL DO-SL,ADVENTURER,1,1
?CND10: CALL DO-SL,RM,1,1
GET P-TABLE,P-MATCHLEN
GRTR? STACK,0 \?CND5
SET 'LIT,TRUE-VALUE
?CND5: SET 'HERE,OHERE
SET 'P-GWIMBIT,0
RETURN LIT
.FUNCT THIS-IT?,OBJ,TBL,SYNS,?TMP1
FSET? OBJ,INVISIBLE /FALSE
ZERO? P-NAM /?CCL5
GETPT OBJ,P?SYNONYM >SYNS
PTSIZE SYNS
DIV STACK,2
SUB STACK,1
CALL ZMEMQ,P-NAM,SYNS,STACK
ZERO? STACK /FALSE
?CCL5: ZERO? P-ADJ /?CCL9
GETPT OBJ,P?ADJECTIVE >SYNS
ZERO? SYNS /FALSE
PTSIZE SYNS
SUB STACK,1
CALL ZMEMQB,P-ADJ,SYNS,STACK
ZERO? STACK /FALSE
?CCL9: ZERO? P-GWIMBIT /TRUE
FSET? OBJ,P-GWIMBIT /TRUE
RFALSE
.FUNCT ACCESSIBLE?,OBJ,L,?TMP1
LOC OBJ >L
FSET? OBJ,INVISIBLE /FALSE
ZERO? L /FALSE
EQUAL? L,GLOBAL-OBJECTS /TRUE
EQUAL? L,LOCAL-GLOBALS \?CCL9
CALL GLOBAL-IN?,OBJ,HERE
ZERO? STACK \TRUE
?CCL9: CALL META-LOC,OBJ >?TMP1
LOC WINNER
EQUAL? ?TMP1,HERE,STACK \FALSE
LOC WINNER
EQUAL? L,WINNER,HERE,STACK /TRUE
FSET? L,OPENBIT \FALSE
CALL ACCESSIBLE?,L
ZERO? STACK /FALSE
RTRUE
.FUNCT META-LOC,OBJ
?PRG1: ZERO? OBJ /FALSE
IN? OBJ,GLOBAL-OBJECTS \?CND3
RETURN GLOBAL-OBJECTS
?CND3: IN? OBJ,ROOMS \?CCL9
RETURN OBJ
?CCL9: LOC OBJ >OBJ
JUMP ?PRG1
.ENDI
Reference in a new issue View git blame Copy permalink