witness/parser.zap

1395 lines
29 KiB
Plaintext

.FUNCT THIS-IS-S-HE,PERSON
SET 'P-HIM-HER,PERSON
LOC PERSON >P-HIM-HER-LOC
RETURN P-HIM-HER-LOC
.FUNCT I-PROMPT-1
SET 'P-PROMPT,STR?140
RFALSE
.FUNCT I-PROMPT-2
ZERO? P-PROMPT /FALSE
SET 'P-PROMPT,FALSE-VALUE
CRLF
PRINTI "(Aren't you getting tired of seeing "
ZERO? X-IS-LISTENING /?CND9
PRINTI """(... is listening.)"" and "
?CND9: PRINTI """What next?"" and ""You are now in the ....""? From here on, the prompt will be much shorter.)"
CRLF
EQUAL? PRSA,V?WAIT-UNTIL,V?WAIT-FOR,V?WAIT \?CND17
CRLF
?CND17: CALL INT,I-PROMPT-2
PUT STACK,0,0
RFALSE
.FUNCT PARSER,PTR=P-LEXSTART,WRD,VAL=0,VERB=0,LEN,DIR=0,NW=0,LW=0,NUM,SCNT,CNT=-1
?PRG1: IGRTR? 'CNT,P-ITBLLEN \?ELS5
JUMP ?REP2
?ELS5: PUT P-ITBL,CNT,0
JUMP ?PRG1
?REP2: SET 'P-NAM,FALSE-VALUE
SET 'P-ADJ,FALSE-VALUE
SET 'P-ADVERB,FALSE-VALUE
SET 'P-MERGED,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,PLAYER /?CND8
SET 'WINNER,PLAYER
LOC WINNER
FSET? STACK,VEHBIT /?CND8
LOC WINNER >HERE
?CND8: ZERO? P-CONT /?ELS18
SET 'PTR,P-CONT
SET 'P-CONT,FALSE-VALUE
EQUAL? PRSA,V?TELL /?CND16
CRLF
JUMP ?CND16
?ELS18: SET 'WINNER,PLAYER
SET 'QUOTE-FLAG,FALSE-VALUE
LOC WINNER
FSET? STACK,VEHBIT /?CND25
LOC WINNER >HERE
?CND25: SET 'SCNT,P-SPACE
?PRG28: DLESS? 'SCNT,0 \?ELS32
JUMP ?REP29
?ELS32: CRLF
JUMP ?PRG28
?REP29: ZERO? P-PROMPT /?CND35
ZERO? P-OFLAG \?CND35
ZERO? QCONTEXT /?CND40
SET 'X-IS-LISTENING,TRUE-VALUE
PRINTI "("
PRINTD QCONTEXT
PRINTI " is listening.)"
CRLF
?CND40: PRINT P-PROMPT
CRLF
?CND35: PRINTI ">"
READ P-INBUF,P-LEXV
?CND16: GETB P-LEXV,P-LEXWORDS >P-LEN
ZERO? P-LEN \?ELS52
PRINTI "What?"
CRLF
RFALSE
?ELS52: GET P-LEXV,PTR >WRD
EQUAL? WRD,W?WHY,W?HOW,W?WHEN /?THN57
EQUAL? WRD,W?IS,W?DID,W?ARE \?CND50
?THN57: PRINTI "(Sorry, but this program can't handle questions like that. You should stick to questions like ""WHAT IS ..."" and ""WHERE IS ...."" Maybe you'd like to review your instruction manual.)"
CRLF
RFALSE
?CND50: SET 'LEN,P-LEN
SET 'P-DIR,FALSE-VALUE
SET 'P-NCN,0
SET 'P-GETFLAGS,0
PUT P-ITBL,P-VERBN,0
?PRG61: DLESS? 'P-LEN,0 \?ELS65
SET 'QUOTE-FLAG,FALSE-VALUE
JUMP ?REP62
?ELS65: GET P-LEXV,PTR >WRD
ZERO? WRD \?THN68
CALL NUMBER?,PTR >WRD
ZERO? WRD /?ELS67
?THN68: EQUAL? WRD,W?TO \?ELS72
EQUAL? VERB,ACT?TELL,ACT?ASK \?ELS72
SET 'WRD,W?QUOTE
JUMP ?CND70
?ELS72: EQUAL? WRD,W?THEN \?CND70
ZERO? VERB \?CND70
PUT P-ITBL,P-VERB,ACT?TELL
PUT P-ITBL,P-VERBN,0
SET 'WRD,W?QUOTE
?CND70: EQUAL? WRD,W?PERIOD \?ELS81
EQUAL? LW,W?MRS,W?MR \?ELS81
SET 'LW,0
JUMP ?CND63
?ELS81: EQUAL? WRD,W?THEN,W?PERIOD /?THN86
EQUAL? WRD,W?QUOTE \?ELS85
?THN86: EQUAL? WRD,W?QUOTE \?CND88
ZERO? QUOTE-FLAG /?ELS93
SET 'QUOTE-FLAG,FALSE-VALUE
JUMP ?CND88
?ELS93: SET 'QUOTE-FLAG,TRUE-VALUE
?CND88: ZERO? P-LEN /?THN97
ADD PTR,P-LEXELEN >P-CONT
?THN97: PUTB P-LEXV,P-LEXWORDS,P-LEN
JUMP ?REP62
?ELS85: CALL WT?,WRD,PS?DIRECTION,P1?DIRECTION >VAL
ZERO? VAL /?ELS100
EQUAL? LEN,1 /?THN103
EQUAL? LEN,2 \?ELS106
EQUAL? VERB,ACT?WALK /?THN103
?ELS106: ADD PTR,P-LEXELEN
GET P-LEXV,STACK >NW
EQUAL? NW,W?THEN,W?QUOTE \?ELS108
GRTR? LEN,2 /?THN103
?ELS108: EQUAL? NW,W?PERIOD \?ELS110
GRTR? LEN,1 /?THN103
?ELS110: ZERO? QUOTE-FLAG /?ELS112
EQUAL? LEN,2 \?ELS112
EQUAL? NW,W?QUOTE /?THN103
?ELS112: GRTR? LEN,2 \?ELS100
EQUAL? NW,W?COMMA,W?AND \?ELS100
?THN103: SET 'DIR,VAL
EQUAL? NW,W?COMMA,W?AND \?CND115
ADD PTR,P-LEXELEN
PUT P-LEXV,STACK,W?THEN
?CND115: GRTR? LEN,2 /?CND63
SET 'QUOTE-FLAG,FALSE-VALUE
JUMP ?REP62
?ELS100: CALL WT?,WRD,PS?VERB,P1?VERB >VAL
ZERO? VAL /?ELS122
ZERO? VERB /?THN125
EQUAL? VERB,ACT?WHAT \?ELS122
?THN125: 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 >NUM
GETB P-LEXV,NUM
PUTB P-VTBL,2,STACK
ADD NUM,1
GETB P-LEXV,STACK
PUTB P-VTBL,3,STACK
JUMP ?CND63
?ELS122: CALL WT?,WRD,PS?PREPOSITION,0 >VAL
ZERO? VAL \?THN129
EQUAL? WRD,W?ONE,W?A /?THN133
CALL WT?,WRD,PS?ADJECTIVE
ZERO? STACK \?THN133
CALL WT?,WRD,PS?OBJECT
ZERO? STACK /?ELS128
?THN133: SET 'VAL,0
?THN129: GRTR? P-LEN,0 \?ELS137
ADD PTR,P-LEXELEN
GET P-LEXV,STACK
EQUAL? STACK,W?OF \?ELS137
EQUAL? VERB,ACT?ACCUSE,ACT?MAKE /?ELS137
ZERO? VAL \?ELS137
EQUAL? WRD,W?ONE,W?A /?ELS137
JUMP ?CND63
?ELS137: ZERO? VAL /?ELS141
ZERO? P-LEN /?THN144
ADD PTR,2
GET P-LEXV,STACK
EQUAL? STACK,W?THEN,W?PERIOD \?ELS141
?THN144: LESS? P-NCN,2 \?CND63
PUT P-ITBL,P-PREP1,VAL
PUT P-ITBL,P-PREP1N,WRD
JUMP ?CND63
?ELS141: EQUAL? P-NCN,2 \?ELS150
PRINTI "(I found more than two nouns in that sentence!)"
CRLF
RFALSE
?ELS150: INC 'P-NCN
CALL CLAUSE,PTR,VAL,WRD >PTR
ZERO? PTR /FALSE
LESS? PTR,0 \?CND63
SET 'QUOTE-FLAG,FALSE-VALUE
JUMP ?REP62
?ELS128: EQUAL? WRD,W?CLOSELY \?ELS161
SET 'P-ADVERB,W?CAREFULLY
JUMP ?CND63
?ELS161: EQUAL? WRD,W?CAREFULLY,W?QUIETLY /?THN164
EQUAL? WRD,W?SLOWLY,W?QUICKLY,W?BRIEFLY \?ELS163
?THN164: SET 'P-ADVERB,WRD
JUMP ?CND63
?ELS163: CALL WT?,WRD,PS?BUZZ-WORD
ZERO? STACK /?ELS167
JUMP ?CND63
?ELS167: CALL CANT-USE,PTR
RFALSE
?ELS67: CALL UNKNOWN-WORD,PTR
RFALSE
?CND63: SET 'LW,WRD
ADD PTR,P-LEXELEN >PTR
JUMP ?PRG61
?REP62: ZERO? DIR /?CND172
SET 'PRSA,V?WALK
SET 'PRSO,DIR
RETURN TRUE-VALUE
?CND172: ZERO? P-OFLAG /?CND176
CALL ORPHAN-MERGE
?CND176: GET P-ITBL,P-VERB
ZERO? STACK \?CND180
PUT P-ITBL,P-VERB,ACT?$CALL
?CND180: CALL SYNTAX-CHECK
ZERO? STACK /FALSE
CALL SNARF-OBJECTS
ZERO? STACK /FALSE
CALL TAKE-CHECK
ZERO? STACK /FALSE
CALL MANY-CHECK
ZERO? STACK /FALSE
RTRUE
.FUNCT WT?,PTR,BIT,B1=5,OFFSET=P-P1OFF,TYP
GETB PTR,P-PSOFF >TYP
BTST TYP,BIT \FALSE
GRTR? B1,4 /TRUE
BAND TYP,P-P1BITS >TYP
EQUAL? TYP,B1 /?CND13
INC 'OFFSET
?CND13: GETB PTR,OFFSET
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 /?ELS3
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
?ELS3: INC 'P-LEN
?CND1: ZERO? P-LEN \?CND6
DEC 'P-NCN
RETURN -1
?CND6: 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 \?CND9
GET P-ITBL,NUM
ADD STACK,4
PUT P-ITBL,NUM,STACK
?CND9:
?PRG12: DLESS? 'P-LEN,0 \?CND14
ADD NUM,1 >?TMP1
MUL PTR,2
ADD P-LEXV,STACK
PUT P-ITBL,?TMP1,STACK
RETURN -1
?CND14: GET P-LEXV,PTR >WRD
ZERO? WRD \?THN20
CALL NUMBER?,PTR >WRD
ZERO? WRD /?ELS19
?THN20: ZERO? P-LEN \?ELS24
SET 'NW,0
JUMP ?CND22
?ELS24: ADD PTR,P-LEXELEN
GET P-LEXV,STACK >NW
?CND22: EQUAL? WRD,W?OF \?CND27
GET P-ITBL,P-VERB
EQUAL? STACK,ACT?ACCUSE,ACT?MAKE \?CND27
PUT P-LEXV,PTR,W?WITH
SET 'WRD,W?WITH
?CND27: EQUAL? WRD,W?PERIOD \?ELS34
EQUAL? LW,W?MRS,W?MR \?ELS34
SET 'LW,0
JUMP ?CND17
?ELS34: EQUAL? WRD,W?AND,W?COMMA \?ELS38
SET 'ANDFLG,TRUE-VALUE
JUMP ?CND17
?ELS38: EQUAL? WRD,W?ONE \?ELS40
EQUAL? NW,W?OF \?CND17
DEC 'P-LEN
ADD PTR,P-LEXELEN >PTR
JUMP ?CND17
?ELS40: EQUAL? WRD,W?THEN,W?PERIOD /?THN46
CALL WT?,WRD,PS?PREPOSITION
ZERO? STACK /?ELS45
ZERO? FIRST?? \?ELS45
?THN46: INC 'P-LEN
ADD NUM,1 >?TMP1
MUL PTR,2
ADD P-LEXV,STACK
PUT P-ITBL,?TMP1,STACK
SUB PTR,P-LEXELEN
RETURN STACK
?ELS45: ZERO? ANDFLG /?ELS51
GET P-ITBL,P-VERBN
ZERO? STACK /?THN54
CALL WT?,WRD,PS?DIRECTION
ZERO? STACK \?THN54
CALL WT?,WRD,PS?VERB
ZERO? STACK /?ELS51
?THN54: SUB PTR,4 >PTR
ADD PTR,2
PUT P-LEXV,STACK,W?THEN
ADD P-LEN,2 >P-LEN
JUMP ?CND17
?ELS51: CALL WT?,WRD,PS?OBJECT
ZERO? STACK /?ELS57
CALL WT?,WRD,PS?ADJECTIVE,P1?ADJECTIVE
ZERO? STACK /?ELS60
ZERO? NW /?ELS60
CALL WT?,NW,PS?OBJECT
ZERO? STACK /?ELS60
JUMP ?CND17
?ELS60: ZERO? ANDFLG \?ELS64
EQUAL? NW,W?BUT,W?EXCEPT /?ELS64
EQUAL? NW,W?AND,W?COMMA /?ELS64
ADD NUM,1 >?TMP1
ADD PTR,2
MUL STACK,2
ADD P-LEXV,STACK
PUT P-ITBL,?TMP1,STACK
RETURN PTR
?ELS64: SET 'ANDFLG,FALSE-VALUE
JUMP ?CND17
?ELS57: CALL WT?,WRD,PS?ADJECTIVE
ZERO? STACK \?CND17
CALL WT?,WRD,PS?BUZZ-WORD
ZERO? STACK /?ELS70
JUMP ?CND17
?ELS70: CALL WT?,WRD,PS?PREPOSITION
ZERO? STACK /?ELS74
JUMP ?CND17
?ELS74: CALL CANT-USE,PTR
RFALSE
?ELS19: CALL UNKNOWN-WORD,PTR
RFALSE
?CND17: SET 'LW,WRD
SET 'FIRST??,FALSE-VALUE
ADD PTR,P-LEXELEN >PTR
JUMP ?PRG12
.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 \?ELS5
JUMP ?REP2
?ELS5: GETB P-INBUF,BPTR >CHR
EQUAL? CHR,58 \?ELS10
SET 'TIM,SUM
SET 'SUM,0
JUMP ?CND8
?ELS10: GRTR? SUM,9999 /FALSE
LESS? CHR,58 \FALSE
GRTR? CHR,47 \FALSE
MUL SUM,10 >?TMP1
SUB CHR,48
ADD ?TMP1,STACK >SUM
?CND8: INC 'BPTR
JUMP ?PRG1
?REP2: PUT P-LEXV,PTR,W?INTNUM
GRTR? SUM,9999 /FALSE
ZERO? TIM /?CND19
GRTR? TIM,23 /FALSE
GRTR? TIM,19 \?ELS29
JUMP ?CND25
?ELS29: GRTR? TIM,12 /FALSE
GRTR? TIM,7 \?ELS33
JUMP ?CND25
?ELS33: ADD 12,TIM >TIM
?CND25: MUL TIM,60
ADD SUM,STACK >SUM
?CND19: 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-VERB >VERB
ZERO? VERB /?ELS3
GET P-OTBL,P-VERB
EQUAL? VERB,STACK \FALSE
?ELS3: EQUAL? P-NCN,2 /FALSE
GET P-OTBL,P-NC1
EQUAL? STACK,1 \?ELS9
GET P-ITBL,P-PREP1 >TEMP
GET P-OTBL,P-PREP1
EQUAL? TEMP,STACK /?THN13
ZERO? TEMP \FALSE
?THN13: ZERO? ADJ /?ELS17
ADD P-LEXV,2
PUT P-OTBL,P-NC1,STACK
ADD P-LEXV,6
PUT P-OTBL,P-NC1L,STACK
JUMP ?CND1
?ELS17: GET P-ITBL,P-NC1
PUT P-OTBL,P-NC1,STACK
GET P-ITBL,P-NC1L
PUT P-OTBL,P-NC1L,STACK
JUMP ?CND1
?ELS9: GET P-OTBL,P-NC2
EQUAL? STACK,1 \?ELS24
GET P-ITBL,P-PREP1 >TEMP
GET P-OTBL,P-PREP2
EQUAL? TEMP,STACK /?THN28
ZERO? TEMP \FALSE
?THN28: 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 ?CND1
?ELS24: ZERO? P-ACLAUSE /?CND1
EQUAL? P-NCN,1 /?ELS37
SET 'P-ACLAUSE,FALSE-VALUE
RFALSE
?ELS37: GET P-ITBL,P-NC1 >BEG
GET P-ITBL,P-NC1L >END
?PRG40: EQUAL? BEG,END \?ELS44
ZERO? ADJ /?ELS47
CALL ACLAUSE-WIN,ADJ
JUMP ?CND35
?ELS47: SET 'P-ACLAUSE,FALSE-VALUE
RFALSE
?ELS44: ZERO? ADJ \?ELS52
GET BEG,0 >WRD
GETB WRD,P-PSOFF
BTST STACK,PS?ADJECTIVE \?ELS52
SET 'ADJ,WRD
JUMP ?CND42
?ELS52: GETB WRD,P-PSOFF
BTST STACK,PS?OBJECT /?THN57
EQUAL? WRD,W?ONE \?CND42
?THN57: EQUAL? WRD,P-ANAM,W?ONE \FALSE
CALL ACLAUSE-WIN,ADJ
JUMP ?CND35
?CND42: ADD BEG,P-WORDLEN >BEG
JUMP ?PRG40
?CND35:
?CND1:
?PRG64: IGRTR? 'CNT,P-ITBLLEN \?ELS68
SET 'P-MERGED,TRUE-VALUE
RTRUE
?ELS68: GET P-OTBL,CNT
PUT P-ITBL,CNT,STACK
JUMP ?PRG64
.FUNCT ACLAUSE-WIN,ADJ
SET 'P-CCSRC,P-OTBL
ADD P-ACLAUSE,1
CALL CLAUSE-COPY,P-ACLAUSE,STACK,ADJ
GET P-OTBL,P-NC2
ZERO? STACK /?ELS2
SET 'P-NCN,2
?ELS2: 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,MSG,?TMP1
CALL PICK-ONE,UNKNOWN-MSGS >MSG
GET MSG,0
PRINT STACK
MUL PTR,2 >BUF
ADD P-LEXV,BUF
GETB STACK,2 >?TMP1
ADD P-LEXV,BUF
GETB STACK,3
CALL WORD-PRINT,?TMP1,STACK
GET MSG,1
PRINT STACK
CRLF
SET 'QUOTE-FLAG,FALSE-VALUE
SET 'P-OFLAG,FALSE-VALUE
RETURN P-OFLAG
.FUNCT CANT-USE,PTR,BUF,?TMP1
PRINTI "(Sorry, but you can't use 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 that sense.)"
CRLF
SET 'QUOTE-FLAG,FALSE-VALUE
SET 'P-OFLAG,FALSE-VALUE
RETURN P-OFLAG
.FUNCT SYNTAX-CHECK,SYN,LEN,NUM,OBJ,DRIVE1=0,DRIVE2=0,PREP,VERB,?TMP2,?TMP1
GET P-ITBL,P-VERB >VERB
ZERO? VERB \?CND1
PRINTI "(I couldn't find a verb in that sentence!)"
CRLF
RFALSE
?CND1: SUB 255,VERB
GET VERBS,STACK >SYN
GETB SYN,0 >LEN
ADD 1,SYN >SYN
?PRG6: GETB SYN,P-SBITS
BAND STACK,P-SONUMS >NUM
GRTR? P-NCN,NUM \?ELS10
JUMP ?CND8
?ELS10: LESS? NUM,1 /?ELS12
ZERO? P-NCN \?ELS12
GET P-ITBL,P-PREP1 >PREP
ZERO? PREP /?THN15
GETB SYN,P-SPREP1
EQUAL? PREP,STACK \?ELS12
?THN15: SET 'DRIVE1,SYN
JUMP ?CND8
?ELS12: GETB SYN,P-SPREP1 >?TMP1
GET P-ITBL,P-PREP1
EQUAL? ?TMP1,STACK \?CND8
EQUAL? NUM,2 \?ELS21
EQUAL? P-NCN,1 \?ELS21
SET 'DRIVE2,SYN
JUMP ?CND8
?ELS21: GETB SYN,P-SPREP2 >?TMP1
GET P-ITBL,P-PREP2
EQUAL? ?TMP1,STACK \?CND8
CALL SYNTAX-FOUND,SYN
RTRUE
?CND8: DLESS? 'LEN,1 \?ELS28
ZERO? DRIVE1 \?REP7
ZERO? DRIVE2 /?ELS31
JUMP ?REP7
?ELS31: PRINTI "(Sorry, but English is my second language. Please rephrase that.)"
CRLF
RFALSE
?ELS28: ADD SYN,P-SYNLEN >SYN
JUMP ?PRG6
?REP7: ZERO? DRIVE1 /?ELS44
GETB DRIVE1,P-SFWIM1 >?TMP2
GETB DRIVE1,P-SLOC1 >?TMP1
GETB DRIVE1,P-SPREP1
CALL GWIM,?TMP2,?TMP1,STACK >OBJ
ZERO? OBJ /?ELS44
PUT P-PRSO,P-MATCHLEN,1
PUT P-PRSO,1,OBJ
CALL SYNTAX-FOUND,DRIVE1
RSTACK
?ELS44: ZERO? DRIVE2 /?ELS48
GETB DRIVE2,P-SFWIM2 >?TMP2
GETB DRIVE2,P-SLOC2 >?TMP1
GETB DRIVE2,P-SPREP2
CALL GWIM,?TMP2,?TMP1,STACK >OBJ
ZERO? OBJ /?ELS48
PUT P-PRSI,P-MATCHLEN,1
PUT P-PRSI,1,OBJ
CALL SYNTAX-FOUND,DRIVE2
RSTACK
?ELS48: EQUAL? VERB,ACT?FIND,ACT?WHAT \?ELS52
PRINTI "(Sorry, but I can't answer that question.)"
CRLF
RFALSE
?ELS52: EQUAL? WINNER,PLAYER \?ELS59
CALL ORPHAN,DRIVE1,DRIVE2
PRINTI "(What do you want to "
JUMP ?CND57
?ELS59: PRINTI "(Your request was incomplete. Next time, say what you want "
PRINTD WINNER
PRINTI " to "
?CND57: CALL VERB-PRINT
ZERO? DRIVE2 /?CND66
CALL CLAUSE-PRINT,P-NC1,P-NC1L
?CND66: ZERO? DRIVE1 /?ELS74
GETB DRIVE1,P-SPREP1
JUMP ?CND70
?ELS74: GETB DRIVE2,P-SPREP2
?CND70: CALL PREP-PRINT,STACK
EQUAL? WINNER,PLAYER \?ELS80
SET 'P-OFLAG,TRUE-VALUE
PRINTI "?)"
CRLF
RFALSE
?ELS80: SET 'P-OFLAG,FALSE-VALUE
PRINTI ".)"
CRLF
RFALSE
.FUNCT VERB-PRINT,TMP,?TMP1
GET P-ITBL,P-VERBN >TMP
ZERO? TMP \?ELS5
PRINTI "tell"
RTRUE
?ELS5: GETB P-VTBL,2
ZERO? STACK \?ELS9
GET TMP,0
PRINTB STACK
RTRUE
?ELS9: GETB TMP,2 >?TMP1
GETB TMP,3
CALL WORD-PRINT,?TMP1,STACK
PUTB P-VTBL,2,0
RTRUE
.FUNCT ORPHAN,D1,D2,CNT=-1
PUT P-OCLAUSE,P-MATCHLEN,0
SET 'P-CCSRC,P-ITBL
?PRG1: IGRTR? 'CNT,P-ITBLLEN \?ELS5
JUMP ?REP2
?ELS5: GET P-ITBL,CNT
PUT P-OTBL,CNT,STACK
JUMP ?PRG1
?REP2: EQUAL? P-NCN,2 \?CND8
CALL CLAUSE-COPY,P-NC2,P-NC2L
?CND8: LESS? P-NCN,1 /?CND11
CALL CLAUSE-COPY,P-NC1,P-NC1L
?CND11: ZERO? D1 /?ELS18
GETB D1,P-SPREP1
PUT P-OTBL,P-PREP1,STACK
PUT P-OTBL,P-NC1,1
RTRUE
?ELS18: ZERO? D2 /FALSE
GETB D2,P-SPREP2
PUT P-OTBL,P-PREP2,STACK
PUT P-OTBL,P-NC2,1
RTRUE
.FUNCT CLAUSE-PRINT,BPTR,EPTR,THE?=1,?TMP1
GET P-ITBL,BPTR >?TMP1
GET P-ITBL,EPTR
CALL BUFFER-PRINT,?TMP1,STACK,THE?
RSTACK
.FUNCT BUFFER-PRINT,BEG,END,CP,NOSP=0,WRD,FIRST??=1,PN=0,?TMP1
?PRG1: EQUAL? BEG,END /TRUE
ZERO? NOSP /?ELS10
SET 'NOSP,FALSE-VALUE
JUMP ?CND8
?ELS10: PRINTI " "
?CND8: GET BEG,0 >WRD
EQUAL? WRD,W?PERIOD \?ELS18
SET 'NOSP,TRUE-VALUE
JUMP ?CND3
?ELS18: EQUAL? WRD,W?MRS \?ELS20
PRINTI "Mrs."
SET 'PN,TRUE-VALUE
JUMP ?CND3
?ELS20: EQUAL? WRD,W?MR \?ELS24
PRINTI "Mr."
SET 'PN,TRUE-VALUE
JUMP ?CND3
?ELS24: EQUAL? WRD,W?LINDER,W?MONICA,W?PHONG /?THN29
EQUAL? WRD,W?STILES,W?DUFFY \?ELS28
?THN29: CALL CAPITALIZE,BEG
SET 'PN,TRUE-VALUE
JUMP ?CND3
?ELS28: ZERO? FIRST?? /?CND33
ZERO? PN \?CND33
ZERO? CP /?CND33
PRINTI "the "
?CND33: ZERO? P-OFLAG \?THN43
ZERO? P-MERGED /?ELS42
?THN43: PRINTB WRD
JUMP ?CND40
?ELS42: EQUAL? WRD,W?IT \?ELS46
EQUAL? P-IT-LOC,HERE \?ELS46
PRINTD P-IT-OBJECT
JUMP ?CND40
?ELS46: EQUAL? WRD,W?HIM,W?HER \?ELS50
EQUAL? P-HIM-HER-LOC,HERE \?ELS50
PRINTD P-HIM-HER
JUMP ?CND40
?ELS50: GETB BEG,2 >?TMP1
GETB BEG,3
CALL WORD-PRINT,?TMP1,STACK
?CND40: SET 'FIRST??,FALSE-VALUE
?CND3: ADD BEG,P-WORDLEN >BEG
JUMP ?PRG1
.FUNCT CAPITALIZE,PTR,?TMP1
GETB PTR,3
GETB P-INBUF,STACK
SUB STACK,32
PRINTC STACK
GETB PTR,2
SUB STACK,1 >?TMP1
GETB PTR,3
ADD STACK,1
CALL WORD-PRINT,?TMP1,STACK
RSTACK
.FUNCT PREP-PRINT,PREP,WRD
ZERO? PREP /FALSE
PRINTI " "
CALL PREP-FIND,PREP >WRD
EQUAL? WRD,W?AGAINST \?ELS10
PRINTI "against"
JUMP ?CND8
?ELS10: PRINTB WRD
?CND8: GET P-ITBL,P-VERBN
GET STACK,0
EQUAL? W?SIT,STACK \FALSE
EQUAL? W?DOWN,WRD \FALSE
PRINTI " on"
RTRUE
.FUNCT CLAUSE-COPY,BPTR,EPTR,INSERT=0,BEG,END
GET P-CCSRC,BPTR >BEG
GET P-CCSRC,EPTR >END
GET P-OCLAUSE,P-MATCHLEN
MUL STACK,P-LEXELEN
ADD STACK,2
ADD P-OCLAUSE,STACK
PUT P-OTBL,BPTR,STACK
?PRG1: EQUAL? BEG,END \?ELS5
GET P-OCLAUSE,P-MATCHLEN
MUL STACK,P-LEXELEN
ADD STACK,2
ADD P-OCLAUSE,STACK
PUT P-OTBL,EPTR,STACK
RTRUE
?ELS5: ZERO? INSERT /?CND8
GET BEG,0
EQUAL? P-ANAM,STACK \?CND8
CALL CLAUSE-ADD,INSERT
?CND8: GET BEG,0
CALL CLAUSE-ADD,STACK
?CND3: 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
RETURN STACK
.FUNCT SYNTAX-FOUND,SYN
SET 'P-SYNTAX,SYN
GETB SYN,P-SACTION >PRSA
RETURN PRSA
.FUNCT GWIM,GBIT,LBIT,PREP,OBJ
EQUAL? GBIT,RMUNGBIT \?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 /?ELS8
SET 'P-GWIMBIT,0
GET P-MERGE,P-MATCHLEN
EQUAL? STACK,1 \FALSE
GET P-MERGE,1 >OBJ
PRINTI "("
ZERO? PREP /?CND16
CALL PREP-FIND,PREP
PRINTB STACK
CALL THE?,OBJ
PRINTI " "
?CND16: FSET? OBJ,PERSON \?ELS23
FSET? OBJ,TOUCHBIT /?ELS23
GETP OBJ,P?XDESC
ZERO? STACK /?ELS23
PRINTI "the "
GETP OBJ,P?XDESC
PRINT STACK
PRINTI ")"
CRLF
RETURN OBJ
?ELS23: PRINTD OBJ
PRINTI ")"
CRLF
RETURN OBJ
?ELS8: SET 'P-GWIMBIT,0
RFALSE
.FUNCT SNARF-OBJECTS,PTR
GET P-ITBL,P-NC1 >PTR
ZERO? PTR /?CND1
GETB P-SYNTAX,P-SLOC1 >P-SLOCBITS
GET P-ITBL,P-NC1L
CALL SNARFEM,PTR,STACK,P-PRSO
ZERO? STACK /FALSE
GET P-BUTS,P-MATCHLEN
ZERO? STACK /?CND1
CALL BUT-MERGE,P-PRSO >P-PRSO
?CND1: GET P-ITBL,P-NC2 >PTR
ZERO? PTR /TRUE
GETB P-SYNTAX,P-SLOC2 >P-SLOCBITS
GET P-ITBL,P-NC2L
CALL SNARFEM,PTR,STACK,P-PRSI
ZERO? STACK /FALSE
GET P-BUTS,P-MATCHLEN
ZERO? STACK /TRUE
GET P-PRSI,P-MATCHLEN
EQUAL? STACK,1 \?ELS18
CALL BUT-MERGE,P-PRSO >P-PRSO
RTRUE
?ELS18: 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 \?ELS5
JUMP ?REP2
?ELS5: GET TBL,CNT >OBJ
CALL ZMEMQ,OBJ,P-BUTS
ZERO? STACK /?ELS7
JUMP ?CND3
?ELS7: 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,AND=0,BUT=0,LEN,WV,WRD,NW
SET 'P-GETFLAGS,0
SET 'P-CSPTR,PTR
SET 'P-CEPTR,EPTR
PUT P-BUTS,P-MATCHLEN,0
PUT TBL,P-MATCHLEN,0
GET PTR,0 >WRD
?PRG1: EQUAL? PTR,EPTR \?ELS5
ZERO? BUT /?ORP9
PUSH BUT
JUMP ?THN6
?ORP9: PUSH TBL
?THN6: CALL GET-OBJECT,STACK
RETURN STACK
?ELS5: GET PTR,P-LEXELEN >NW
EQUAL? WRD,W?BUT,W?EXCEPT \?ELS14
ZERO? BUT /?ORP20
PUSH BUT
JUMP ?THN17
?ORP20: PUSH TBL
?THN17: CALL GET-OBJECT,STACK
ZERO? STACK /FALSE
SET 'BUT,P-BUTS
PUT BUT,P-MATCHLEN,0
JUMP ?CND3
?ELS14: EQUAL? WRD,W?A,W?ONE \?ELS22
ZERO? P-ADJ \?ELS25
SET 'P-GETFLAGS,P-ONE
EQUAL? NW,W?OF \?CND3
ADD PTR,P-WORDLEN >PTR
JUMP ?CND3
?ELS25: SET 'P-NAM,P-ONEOBJ
ZERO? BUT /?ORP36
PUSH BUT
JUMP ?THN33
?ORP36: PUSH TBL
?THN33: CALL GET-OBJECT,STACK
ZERO? STACK /FALSE
ZERO? NW /TRUE
JUMP ?CND3
?ELS22: EQUAL? WRD,W?AND,W?COMMA \?ELS40
EQUAL? NW,W?AND,W?COMMA /?ELS40
ZERO? BUT /?ORP48
PUSH BUT
JUMP ?THN45
?ORP48: PUSH TBL
?THN45: CALL GET-OBJECT,STACK
ZERO? STACK \?CND12
RFALSE
?ELS40: CALL WT?,WRD,PS?BUZZ-WORD
ZERO? STACK /?ELS50
JUMP ?CND3
?ELS50: EQUAL? WRD,W?AND,W?COMMA \?ELS52
JUMP ?CND3
?ELS52: EQUAL? WRD,W?OF \?ELS54
ZERO? P-GETFLAGS \?CND12
SET 'P-GETFLAGS,P-INHIBIT
JUMP ?CND12
?ELS54: CALL WT?,WRD,PS?ADJECTIVE,P1?ADJECTIVE >WV
ZERO? WV /?ELS59
ZERO? P-ADJ \?ELS59
SET 'P-ADJ,WV
SET 'P-ADJN,WRD
JUMP ?CND3
?ELS59: CALL WT?,WRD,PS?OBJECT,P1?OBJECT
ZERO? STACK /?CND3
SET 'P-NAM,WRD
SET 'P-ONEOBJ,WRD
?CND12:
?CND3: EQUAL? PTR,EPTR /?PRG1
ADD PTR,P-WORDLEN >PTR
SET 'WRD,NW
JUMP ?PRG1
.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 \?CND4
ZERO? P-ADJ /?CND4
CALL WT?,P-ADJN,PS?OBJECT,P1?OBJECT
ZERO? STACK /?CND4
SET 'P-NAM,P-ADJN
SET 'P-ADJ,FALSE-VALUE
?CND4: ZERO? P-NAM \?CND9
ZERO? P-ADJ \?CND9
EQUAL? P-GETFLAGS,P-ALL /?CND9
ZERO? P-GWIMBIT \?CND9
ZERO? VRB /FALSE
PRINTI "(I couldn't find enough nouns in that sentence!)"
CRLF
RFALSE
?CND9: EQUAL? P-GETFLAGS,P-ALL \?THN23
ZERO? P-SLOCBITS \?CND20
?THN23: SET 'P-SLOCBITS,-1
?CND20: SET 'P-TABLE,TBL
?PRG25: ZERO? GCHECK /?ELS29
CALL GLOBAL-CHECK,TBL
JUMP ?CND27
?ELS29: ZERO? LIT /?CND33
FCLEAR PLAYER,TRANSBIT
CALL DO-SL,HERE,SOG,SIR
FSET PLAYER,TRANSBIT
?CND33: CALL DO-SL,PLAYER,SH,SC
?CND27: GET TBL,P-MATCHLEN
SUB STACK,TLEN >LEN
BTST P-GETFLAGS,P-ALL \?ELS39
JUMP ?CND37
?ELS39: BTST P-GETFLAGS,P-ONE \?ELS41
ZERO? LEN /?ELS41
EQUAL? LEN,1 /?CND44
RANDOM LEN
GET TBL,STACK
PUT TBL,1,STACK
PRINTI "(How about the "
GET TBL,1
PRINTD STACK
PRINTI "?)"
CRLF
?CND44: PUT TBL,P-MATCHLEN,1
JUMP ?CND37
?ELS41: GRTR? LEN,1 /?THN53
ZERO? LEN \?ELS52
EQUAL? P-SLOCBITS,-1 /?ELS52
?THN53: EQUAL? P-SLOCBITS,-1 \?ELS59
SET 'P-SLOCBITS,XBITS
SET 'OLEN,LEN
GET TBL,P-MATCHLEN
SUB STACK,LEN
PUT TBL,P-MATCHLEN,STACK
JUMP ?PRG25
?ELS59: ZERO? LEN \?CND62
SET 'LEN,OLEN
?CND62: ZERO? P-NAM /?ELS67
EQUAL? PRSA,V?DISEMBARK,V?MAKE /?THN70
EQUAL? PRSA,V?SEARCH-OBJECT-FOR,V?SEARCH,V?FIND /?THN70
EQUAL? PRSA,V?TAKE,V?ASK-CONTEXT-FOR,V?ASK-FOR /?THN70
EQUAL? PRSA,V?SGIVE,V?GIVE,V?WHAT /?THN70
EQUAL? PRSA,V?TELL-ME,V?ASK-CONTEXT-ABOUT,V?ASK-ABOUT \?ELS67
?THN70: ADD TLEN,1
GET TBL,STACK >OBJ
ZERO? OBJ /?ELS67
GETP OBJ,P?GENERIC
CALL STACK,OBJ >OBJ
ZERO? OBJ /?ELS67
EQUAL? OBJ,NOT-HERE-OBJECT /FALSE
PUT TBL,1,OBJ
PUT TBL,P-MATCHLEN,1
SET 'P-NAM,FALSE-VALUE
SET 'P-ADJ,FALSE-VALUE
RTRUE
?ELS67: ZERO? VRB /?ELS76
ZERO? P-NAM /?ELS76
CALL WHICH-PRINT,TLEN,LEN,TBL
EQUAL? TBL,P-PRSO \?ELS83
PUSH P-NC1
JUMP ?CND79
?ELS83: PUSH P-NC2
?CND79: SET 'P-ACLAUSE,STACK
SET 'P-AADJ,P-ADJ
SET 'P-ANAM,P-NAM
CALL ORPHAN,FALSE-VALUE,FALSE-VALUE
SET 'P-OFLAG,TRUE-VALUE
JUMP ?CND65
?ELS76: ZERO? VRB /?CND65
PRINTI "(I couldn't find enough nouns in that sentence!)"
CRLF
?CND65: SET 'P-NAM,FALSE-VALUE
SET 'P-ADJ,FALSE-VALUE
RFALSE
?ELS52: ZERO? LEN \?ELS92
ZERO? GCHECK /?ELS92
ZERO? VRB /?CND95
ZERO? LIT /?ELS101
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
?ELS101: PRINTI "(It's too dark to see!)"
CRLF
?CND95: SET 'P-NAM,FALSE-VALUE
SET 'P-ADJ,FALSE-VALUE
RFALSE
?ELS92: ZERO? LEN \?CND37
SET 'GCHECK,TRUE-VALUE
JUMP ?PRG25
?CND37: SET 'P-SLOCBITS,XBITS
SET 'P-NAM,FALSE-VALUE
SET 'P-ADJ,FALSE-VALUE
RTRUE
.FUNCT MOBY-FIND,TBL,FOO,LEN
SET 'P-SLOCBITS,-1
SET 'P-NAM,P-XNAM
SET 'P-ADJ,P-XADJ
PUT TBL,P-MATCHLEN,0
FIRST? ROOMS >FOO /?KLU17
?KLU17:
?PRG1: ZERO? FOO \?ELS5
JUMP ?REP2
?ELS5: CALL SEARCH-LIST,FOO,TBL,P-SRCALL
NEXT? FOO >FOO /?KLU18
?KLU18: JUMP ?PRG1
?REP2: GET TBL,P-MATCHLEN >LEN
ZERO? LEN \?CND8
CALL DO-SL,LOCAL-GLOBALS,1,1
?CND8: GET TBL,P-MATCHLEN >LEN
ZERO? LEN \?CND11
CALL DO-SL,ROOMS,1,1
?CND11: GET TBL,P-MATCHLEN >LEN
EQUAL? LEN,1 \?CND14
GET TBL,1 >P-MOBY-FOUND
RETURN LEN
?CND14: RETURN LEN
.FUNCT WHICH-PRINT,TLEN,LEN,TBL,OBJ,RLEN
SET 'RLEN,LEN
PRINTI "(Which"
ZERO? P-OFLAG \?THN6
ZERO? P-MERGED /?ELS5
?THN6: PRINTI " "
PRINTB P-NAM
JUMP ?CND3
?ELS5: EQUAL? TBL,P-PRSO \?ELS11
CALL CLAUSE-PRINT,P-NC1,P-NC1L,FALSE-VALUE
JUMP ?CND3
?ELS11: CALL CLAUSE-PRINT,P-NC2,P-NC2L,FALSE-VALUE
?CND3: PRINTI " do you mean,"
?PRG16: INC 'TLEN
GET TBL,TLEN >OBJ
CALL THE?,OBJ
PRINTI " "
PRINTD OBJ
EQUAL? LEN,2 \?ELS22
EQUAL? RLEN,2 /?CND23
PRINTI ","
?CND23: PRINTI " or"
JUMP ?CND20
?ELS22: GRTR? LEN,2 \?CND20
PRINTI ","
?CND20: DLESS? 'LEN,1 \?PRG16
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
?PRG4: GETB RMG,CNT >OBJ
CALL THIS-IT?,OBJ,TBL
ZERO? STACK /?CND6
CALL OBJ-FOUND,OBJ,TBL
?CND6: IGRTR? 'CNT,RMGL \?PRG4
?CND1: GETPT HERE,P?PSEUDO >RMG
ZERO? RMG /?CND12
PTSIZE RMG
DIV STACK,4
SUB STACK,1 >RMGL
SET 'CNT,0
?PRG15: MUL CNT,2
GET RMG,STACK
EQUAL? P-NAM,STACK \?ELS19
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 ?CND12
?ELS19: IGRTR? 'CNT,RMGL \?PRG15
?CND12: 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?WALK-TO,V?THROUGH,V?SEARCH-OBJECT-FOR /?THN37
EQUAL? PRSA,V?SEARCH,V?LOOK-INSIDE,V?DROP /?THN37
EQUAL? PRSA,V?FOLLOW,V?FIND,V?EXAMINE \FALSE
?THN37: CALL DO-SL,ROOMS,1,1
RSTACK
.FUNCT DO-SL,OBJ,BIT1,BIT2,BITS
ADD BIT1,BIT2
BTST P-SLOCBITS,STACK \?ELS5
CALL SEARCH-LIST,OBJ,P-TABLE,P-SRCALL
RSTACK
?ELS5: BTST P-SLOCBITS,BIT1 \?ELS12
CALL SEARCH-LIST,OBJ,P-TABLE,P-SRCTOP
RSTACK
?ELS12: BTST P-SLOCBITS,BIT2 \TRUE
CALL SEARCH-LIST,OBJ,P-TABLE,P-SRCBOT
RSTACK
.FUNCT SEARCH-LIST,OBJ,TBL,LVL,FLS
FIRST? OBJ >OBJ \FALSE
?PRG6: EQUAL? LVL,P-SRCBOT /?CND8
GETPT OBJ,P?SYNONYM
ZERO? STACK /?CND8
CALL THIS-IT?,OBJ,TBL
ZERO? STACK /?CND8
CALL OBJ-FOUND,OBJ,TBL
?CND8: EQUAL? LVL,P-SRCTOP \?THN18
FSET? OBJ,SEARCHBIT /?THN18
FSET? OBJ,SURFACEBIT \?CND13
?THN18: FIRST? OBJ \?CND13
EQUAL? OBJ,PLAYER,LOCAL-GLOBALS /?CND13
FSET? OBJ,SURFACEBIT \?ELS24
PUSH P-SRCALL
JUMP ?CND20
?ELS24: FSET? OBJ,SEARCHBIT \?ELS26
PUSH P-SRCALL
JUMP ?CND20
?ELS26: PUSH P-SRCTOP
?CND20: CALL SEARCH-LIST,OBJ,TBL,STACK >FLS
?CND13: NEXT? OBJ >OBJ /?PRG6
RTRUE
.FUNCT THIS-IT?,OBJ,TBL,SYNS,?TMP1
FSET? OBJ,INVISIBLE /FALSE
ZERO? P-NAM /?ELS5
GETPT OBJ,P?SYNONYM >SYNS
PTSIZE SYNS
DIV STACK,2
SUB STACK,1
CALL ZMEMQ,P-NAM,SYNS,STACK
ZERO? STACK /FALSE
?ELS5: ZERO? P-ADJ /?ELS9
GETPT OBJ,P?ADJECTIVE >SYNS
ZERO? SYNS /FALSE
PTSIZE SYNS
SUB STACK,1
CALL ZMEMQB,P-ADJ,SYNS,STACK
ZERO? STACK /FALSE
?ELS9: ZERO? P-GWIMBIT /TRUE
FSET? OBJ,P-GWIMBIT /TRUE
RFALSE
.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
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
RSTACK
.FUNCT ITAKE-CHECK,TBL,BITS,PTR,OBJ,TAKEN
GET TBL,P-MATCHLEN >PTR
ZERO? PTR /TRUE
BTST BITS,SHAVE /?THN8
BTST BITS,STAKE \TRUE
?THN8:
?PRG10: DLESS? 'PTR,0 /TRUE
ADD PTR,1
GET TBL,STACK >OBJ
EQUAL? OBJ,IT \?ELS19
SET 'OBJ,P-IT-OBJECT
JUMP ?CND17
?ELS19: EQUAL? OBJ,HIM-HER \?CND17
SET 'OBJ,P-HIM-HER
?CND17: CALL HELD?,OBJ
ZERO? STACK \?PRG10
SET 'PRSO,OBJ
FSET? OBJ,TRYTAKEBIT \?ELS27
SET 'TAKEN,TRUE-VALUE
JUMP ?CND25
?ELS27: EQUAL? WINNER,PLAYER /?ELS29
SET 'TAKEN,FALSE-VALUE
JUMP ?CND25
?ELS29: BTST BITS,STAKE \?ELS31
CALL ITAKE,FALSE-VALUE
EQUAL? STACK,TRUE-VALUE \?ELS31
SET 'TAKEN,FALSE-VALUE
JUMP ?CND25
?ELS31: SET 'TAKEN,TRUE-VALUE
?CND25: ZERO? TAKEN /?ELS38
BTST BITS,SHAVE \?ELS38
PRINTI "(You don't have"
EQUAL? OBJ,NOT-HERE-OBJECT \?ELS45
PRINTI " that!)"
CRLF
RFALSE
?ELS45: CALL THE?,OBJ
PRINTI " "
PRINTD OBJ
PRINTI "!)"
CRLF
RFALSE
?ELS38: ZERO? TAKEN \?PRG10
EQUAL? WINNER,PLAYER \?PRG10
PRINTI "(taken)"
CRLF
JUMP ?PRG10
.FUNCT MANY-CHECK,LOSS=0,TMP,?TMP1
GET P-PRSO,P-MATCHLEN
GRTR? STACK,1 \?ELS3
GETB P-SYNTAX,P-SLOC1
BTST STACK,SMANY /?ELS3
SET 'LOSS,1
JUMP ?CND1
?ELS3: 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 \?CND18
PRINTI "in"
?CND18: PRINTI "direct objects with """
GET P-ITBL,P-VERBN >TMP
ZERO? TMP \?ELS27
PRINTI "tell"
JUMP ?CND25
?ELS27: ZERO? P-OFLAG /?ELS31
GET TMP,0
PRINTB STACK
JUMP ?CND25
?ELS31: GETB TMP,2 >?TMP1
GETB TMP,3
CALL WORD-PRINT,?TMP1,STACK
?CND25: PRINTI """!)"
CRLF
RFALSE
.FUNCT ZMEMQ,ITM,TBL,SIZE=-1,CNT=1
ZERO? TBL /FALSE
LESS? SIZE,0 /?ELS6
SET 'CNT,0
JUMP ?CND4
?ELS6: GET TBL,0 >SIZE
?CND4:
?PRG9: GET TBL,CNT
EQUAL? ITM,STACK /TRUE
IGRTR? 'CNT,SIZE \?PRG9
RFALSE
.FUNCT ZMEMQB,ITM,TBL,SIZE,CNT=0
?PRG1: GETB TBL,CNT
EQUAL? ITM,STACK /TRUE
IGRTR? 'CNT,SIZE \?PRG1
RFALSE
.FUNCT PRSO-PRINT,PTR
GET P-PRSO,P-MATCHLEN
GRTR? STACK,0 /?THN6
ZERO? P-MERGED \?THN6
GET P-ITBL,P-NC1 >PTR
GET PTR,0
EQUAL? STACK,W?IT \?ELS5
?THN6: PRINTI " "
PRINTD PRSO
RTRUE
?ELS5: GET P-ITBL,P-NC1L
CALL BUFFER-PRINT,PTR,STACK,FALSE-VALUE
RSTACK
.FUNCT THE-PRSO-PRINT
CALL THE?,PRSO
CALL PRSO-PRINT
RSTACK
.FUNCT PRSI-PRINT,PTR
GET P-PRSI,P-MATCHLEN
GRTR? STACK,0 /?THN6
ZERO? P-MERGED \?THN6
GET P-ITBL,P-NC2 >PTR
GET PTR,0
EQUAL? STACK,W?IT \?ELS5
?THN6: PRINTI " "
PRINTD PRSI
RTRUE
?ELS5: GET P-ITBL,P-NC2L
CALL BUFFER-PRINT,PTR,STACK,FALSE-VALUE
RSTACK
.FUNCT THE-PRSI-PRINT
CALL THE?,PRSI
CALL PRSI-PRINT
RSTACK
.ENDI