sherlock/parser.zap

2589 lines
60 KiB
Plaintext

.FUNCT RT-CAPITALIZE,PTR,?TMP1
ZERO? GL-P-ORPH \?CTR2
ZERO? GL-P-MERGED /?CCL3
?CTR2: GET PTR,0
PRINTB STACK
RTRUE
?CCL3: GETB PTR,3
GETB GL-P-PIBUF,STACK
SUB STACK,32
PRINTC STACK
GETB PTR,2
SUB STACK,1 >?TMP1
GETB PTR,3
ADD STACK,1
CALL RT-WORD-PRINT,?TMP1,STACK
RSTACK
.FUNCT RT-WORD-PRINT,CNT,BUF
ADD GL-P-PIBUF,BUF
PRINTT STACK,CNT
RTRUE
.FUNCT RT-VERB-PRINT,TMP,?TMP1
GET GL-P-ITBL,K-P-VERBN >TMP
ZERO? TMP \?CCL3
PRINTI "tell"
RTRUE
?CCL3: GETB GL-P-VTBL,2
ZERO? STACK \?CCL5
GET TMP,0
PRINTB STACK
RTRUE
?CCL5: GETB TMP,2 >?TMP1
GETB TMP,3
ICALL RT-WORD-PRINT,?TMP1,STACK
PUTB GL-P-VTBL,2,0
RTRUE
.FUNCT RT-PREP-PRINT,PREP,SP?,WRD
ASSIGNED? 'SP? /?CND1
SET 'SP?,TRUE-VALUE
?CND1: ZERO? PREP /FALSE
ZERO? GL-P-END-ON-PREP \FALSE
ZERO? SP? /?CND8
PRINTC 32
?CND8: CALL2 RT-PREP-FIND,PREP >WRD
PRINTB WRD
GET GL-P-ITBL,K-P-VERBN
GET STACK,0
EQUAL? W?SIT,STACK \?CND10
EQUAL? W?DOWN,WRD \?CND10
PRINTI " on"
?CND10: GET GL-P-ITBL,K-P-VERBN
GET STACK,0
EQUAL? W?GET,STACK \TRUE
EQUAL? W?OUT,WRD \TRUE
PRINTI " of"
RTRUE
.FUNCT RT-CLAUSE-PRINT,BPTR,EPTR,THE?,?TMP1
ASSIGNED? 'THE? /?CND1
SET 'THE?,TRUE-VALUE
?CND1: GET GL-P-ITBL,BPTR >?TMP1
GET GL-P-ITBL,EPTR
CALL RT-BUFFER-PRINT,?TMP1,STACK,THE?
RSTACK
.FUNCT RT-BUFFER-PRINT,BEG,END,CP,NOSP,WRD,FIRST??,PN,?TMP1
SET 'FIRST??,TRUE-VALUE
?PRG1: EQUAL? BEG,END /TRUE
ZERO? NOSP /?CCL8
SET 'NOSP,FALSE-VALUE
JUMP ?CND6
?CCL8: PRINTC 32
?CND6: GET BEG,0 >WRD
EQUAL? WRD,W?HIM \?PRD12
CALL2 RT-VISIBLE?,GL-P-HIM-OBJECT
ZERO? STACK /?CCL10
?PRD12: EQUAL? WRD,W?HER \?PRD15
CALL2 RT-VISIBLE?,GL-P-HER-OBJECT
ZERO? STACK /?CCL10
?PRD15: EQUAL? WRD,W?THEM \?CND9
CALL2 RT-VISIBLE?,GL-P-THEM-OBJECT
ZERO? STACK \?CND9
?CCL10: SET 'PN,TRUE-VALUE
?CND9: EQUAL? WRD,W?PERIOD \?CCL22
SET 'NOSP,TRUE-VALUE
JUMP ?CND3
?CCL22: EQUAL? WRD,W?ALL,W?OF /?CCL24
GETB WRD,6
BAND STACK,12
ZERO? STACK /?CCL24
GETB WRD,6
BAND STACK,160
ZERO? STACK \?CCL24
SET 'NOSP,TRUE-VALUE
JUMP ?CND3
?CCL24: EQUAL? WRD,W?ME \?CCL29
ICALL2 DPRINT,CH-PLAYER
SET 'PN,TRUE-VALUE
JUMP ?CND3
?CCL29: INTBL? WRD,K-CAPS+2,18 \?CCL31
ICALL2 RT-CAPITALIZE,BEG
SET 'PN,TRUE-VALUE
JUMP ?CND3
?CCL31: ZERO? FIRST?? /?CND32
ZERO? PN \?CND32
ZERO? CP /?CND32
PRINTI "the "
?CND32: ZERO? GL-P-ORPH \?CTR38
ZERO? GL-P-MERGED /?CCL39
?CTR38: PRINTB WRD
JUMP ?CND37
?CCL39: EQUAL? WRD,W?IT \?CCL43
CALL2 RT-VISIBLE?,GL-P-IT-OBJECT
ZERO? STACK /?CCL43
ICALL2 DPRINT,GL-P-IT-OBJECT
JUMP ?CND37
?CCL43: EQUAL? WRD,W?HER \?CCL47
ZERO? PN \?CCL47
ICALL2 DPRINT,GL-P-HER-OBJECT
JUMP ?CND37
?CCL47: EQUAL? WRD,W?THEM \?CCL51
ZERO? PN \?CCL51
ICALL2 DPRINT,GL-P-THEM-OBJECT
JUMP ?CND37
?CCL51: EQUAL? WRD,W?HIM \?CCL55
ZERO? PN \?CCL55
ICALL2 DPRINT,GL-P-HIM-OBJECT
JUMP ?CND37
?CCL55: GETB BEG,2 >?TMP1
GETB BEG,3
ICALL RT-WORD-PRINT,?TMP1,STACK
?CND37: SET 'FIRST??,FALSE-VALUE
?CND3: ADD BEG,K-P-WORDLEN >BEG
JUMP ?PRG1
.FUNCT RT-DONT-KNOW-WORD-MSG,PTR,BUF,MSG,?TMP1
ZERO? GL-LONG-OOPS \?CCL3
PRINTI "[You don't need to use the word """
JUMP ?CND1
?CCL3: DEC 'GL-LONG-OOPS
PRINTI "[You can play the game from start to finish, solve all the puzzles, get all the points, and STILL never need to use the word """
?CND1: MUL PTR,2 >BUF
ADD GL-P-P-LEX,BUF
GETB STACK,2 >?TMP1
ADD GL-P-P-LEX,BUF
GETB STACK,3
ICALL RT-WORD-PRINT,?TMP1,STACK
PRINTI """.]"
CRLF
PUT GL-OOPS-TABLE,K-O-PTR,PTR
SET 'GL-P-QUOT,FALSE-VALUE
SET 'GL-P-ORPH,FALSE-VALUE
RTRUE
.FUNCT RT-DONT-KNOW-WORD-USE-MSG,PTR,BUF,?TMP1
PRINTI "[This story cannot understand the word """
MUL PTR,2 >BUF
ADD GL-P-P-LEX,BUF
GETB STACK,2 >?TMP1
ADD GL-P-P-LEX,BUF
GETB STACK,3
ICALL RT-WORD-PRINT,?TMP1,STACK
PRINTI """ when you use it that way.]"
CRLF
SET 'GL-P-QUOT,FALSE-VALUE
SET 'GL-P-ORPH,FALSE-VALUE
RTRUE
.FUNCT RT-CANT-SEE-ANY-MSG,THING,STRING?,PRSO?,WRD
ASSIGNED? 'PRSO? /?CND1
SET 'PRSO?,TRUE-VALUE
?CND1: ICALL1 RT-CYOU-MSG
PRINTI "cannot "
EQUAL? GL-PRSA,V?LISTEN \?CCL5
PRINTI "hear"
JUMP ?CND3
?CCL5: EQUAL? GL-PRSA,V?SMELL \?CCL7
PRINTI "smell"
JUMP ?CND3
?CCL7: PRINTI "see"
?CND3: ZERO? STRING? /?CCL10
PRINT STRING?
JUMP ?CND8
?CCL10: ZERO? THING /?CCL12
EQUAL? THING,TH-NOT-HERE-OBJECT /?CCL12
PRINTC 32
ICALL RT-THEO-PRINT,THING,FALSE-VALUE,K-DESC-ANY
JUMP ?CND8
?CCL12: ZERO? THING /?CND15
EQUAL? GL-PRSI,TH-NOT-HERE-OBJECT \?CND15
SET 'PRSO?,FALSE-VALUE
?CND15: ZERO? PRSO? /?CCL21
PUSH 0
JUMP ?CND19
?CCL21: PUSH 1
?CND19: GET GL-P-NAMW,STACK >WRD
INTBL? WRD,K-CAPS+2,18 /?CND22
PRINTI " any"
?CND22: ICALL2 RT-NOT-HERE-PRINT,PRSO?
?CND8: PRINTI " here."
CRLF
SET 'GL-P-IT-OBJECT,TH-NOT-HERE-OBJECT
ICALL1 RT-P-CLEAR
RTRUE
.FUNCT RT-TH-NOT-HERE-OBJECT,TBL,PRSO?,OBJ
SET 'PRSO?,TRUE-VALUE
EQUAL? GL-PRSO,TH-NOT-HERE-OBJECT \?CCL3
EQUAL? GL-PRSI,TH-NOT-HERE-OBJECT \?CCL3
PRINTR "Those things aren't here."
?CCL3: EQUAL? GL-PRSO,TH-NOT-HERE-OBJECT \?CCL7
SET 'TBL,GL-P-PRSO
JUMP ?CND1
?CCL7: SET 'TBL,GL-P-PRSI
SET 'PRSO?,FALSE-VALUE
?CND1: ZERO? PRSO? /?CCL10
EQUAL? GL-PRSA,V?FIND,V?WHO,V?WHAT /?CCL12
EQUAL? GL-PRSA,V?WHERE,V?WAIT-FOR,V?WAIT /?CCL12
EQUAL? GL-PRSA,V?SAY,V?DRIVE,V?CALL /?CCL12
EQUAL? GL-PRSA,V?MAKE,V?PASSWORD,V?WALK-TO /?CCL12
EQUAL? GL-PRSA,V?TAKE \?CND8
EQUAL? GL-PLACE-CUR,RM-DIOGENES-CLUB \?PRD21
EQUAL? GL-WINNER,CH-BUTLER /?CCL12
?PRD21: EQUAL? GL-PLACE-CUR,RM-SHERMANS-HOUSE \?CND8
EQUAL? GL-WINNER,CH-SHERMAN \?CND8
?CCL12: CALL RT-FIND-NOT-HERE,TBL,PRSO? >OBJ
ZERO? OBJ /FALSE
EQUAL? OBJ,TH-NOT-HERE-OBJECT /?CND8
RETURN 2
?CCL10: EQUAL? GL-PRSA,V?TELL-ABOUT,V?ASK-ABOUT,V?ASK-FOR \?CND8
CALL RT-FIND-NOT-HERE,TBL,PRSO? >OBJ
ZERO? OBJ /FALSE
EQUAL? OBJ,TH-NOT-HERE-OBJECT /?CND8
RETURN 2
?CND8: PRINTC 91
ICALL1 RT-CYOU-MSG
PRINTI "cannot "
EQUAL? GL-PRSA,V?LISTEN \?CCL40
PRINTI "hear"
JUMP ?CND38
?CCL40: EQUAL? GL-PRSA,V?SMELL \?CCL42
PRINTI "smell"
JUMP ?CND38
?CCL42: PRINTI "see"
?CND38: INTBL? GL-P-XNAM,K-CAPS+2,18 /?CND43
PRINTI " any"
?CND43: ICALL2 RT-NOT-HERE-PRINT,PRSO?
PRINTI " here.]"
CRLF
ICALL1 RT-P-CLEAR
RETURN 2
.FUNCT RT-FAKE-ORPHAN-MSG,TMP,?TMP1
ICALL RT-ORPHAN,GL-P-SYNTAX,FALSE-VALUE
PRINT K-BE-SPECIFIC-MSG
GET GL-P-OTBL,K-P-VERBN >TMP
ZERO? TMP \?CCL3
PRINTI "tell"
JUMP ?CND1
?CCL3: GETB GL-P-VTBL,2
ZERO? STACK \?CCL5
GET TMP,0
PRINTB STACK
JUMP ?CND1
?CCL5: GETB TMP,2 >?TMP1
GETB TMP,3
ICALL RT-WORD-PRINT,?TMP1,STACK
PUTB GL-P-VTBL,2,0
?CND1: PRINTI "?]"
CRLF
SET 'GL-P-ORPH,TRUE-VALUE
SET 'GL-P-GOOD,FALSE-VALUE
RTRUE
.FUNCT RT-TIME-OF-DAY-MSG,WAIT?,TOD
CALL1 RT-TIME-OF-DAY >TOD
FSET? GL-PLACE-CUR,FL-INDOORS /FALSE
EQUAL? GL-LAST-OUT-TOD,TOD /FALSE
ZERO? WAIT? /?CCL9
ICALL2 RT-WAIT-TOD-MSG,TOD
JUMP ?CND7
?CCL9: CRLF
ICALL RT-CYOU-MSG,STR?223,STR?224
PRINTI "that "
EQUAL? TOD,1 \?CCL12
PRINTI "the sky is lighter. Soon it will be sunrise."
CRLF
JUMP ?CND7
?CCL12: EQUAL? TOD,2 \?CCL14
PRINTI "the sun has risen... as much as it ever does in England."
CRLF
JUMP ?CND7
?CCL14: EQUAL? TOD,3 \?CCL16
PRINTI "the setting sun marks the end of another day. Soon it will be dark."
CRLF
JUMP ?CND7
?CCL16: PRINTI "the sun has set and the mists have rolled in."
CRLF
?CND7: SET 'GL-LAST-OUT-TOD,TOD
RETURN GL-LAST-OUT-TOD
.FUNCT RT-TIME-OF-DAY,TOD
CALL RT-CLOCK-CMP,6,30,0
EQUAL? STACK,1 \?CCL3
SET 'TOD,0
RETURN TOD
?CCL3: CALL RT-CLOCK-CMP,7,0,0
EQUAL? STACK,1 \?CCL5
SET 'TOD,1
RETURN TOD
?CCL5: CALL RT-CLOCK-CMP,19,30,0
EQUAL? STACK,1 \?CCL7
SET 'TOD,2
RETURN TOD
?CCL7: CALL RT-CLOCK-CMP,20,0,0
EQUAL? STACK,1 \?CCL9
SET 'TOD,3
RETURN TOD
?CCL9: SET 'TOD,0
RETURN TOD
.FUNCT RT-SPOKEN-TO-MSG,WHO
EQUAL? WHO,GL-P-QCONTEXT-TH \?CCL2
EQUAL? GL-PLACE-CUR,GL-P-QCONTEXT-RM /TRUE
?CCL2: SET 'GL-P-QCONTEXT-TH,WHO
LOC WHO >GL-P-QCONTEXT-RM
ICALL2 RT-THIS-IS-IT,WHO
PRINTI "[spoken to "
ICALL2 RT-THEO-PRINT,WHO
PRINTR "]"
.FUNCT RT-GET-PREP,SYN,WHICH,PREP
EQUAL? WHICH,1 \?CCL3
GETB SYN,K-P-SPREP1 >PREP
JUMP ?CND1
?CCL3: GETB SYN,K-P-SPREP2 >PREP
?CND1: BAND PREP,63 >PREP
ZERO? PREP /FALSE
ADD PREP,192
RSTACK
.FUNCT RT-SYNTAX-CHECK,SYN,LEN,NUM,OBJ,DRIVE1,DRIVE2,PREP,VERB,TPREP,?TMP2,?TMP1
GET GL-P-ITBL,K-P-VERB >VERB
ZERO? VERB \?CND1
ICALL2 RT-NOT-IN-SENTENCE-MSG,STR?225
RFALSE
?CND1: SUB 255,VERB
GET VERBS,STACK >SYN
GETB SYN,0 >LEN
INC 'SYN
?PRG3: GETB SYN,0
SHIFT STACK,-6 >NUM
GRTR? GL-P-NCN,NUM /?CND5
LESS? NUM,1 /?CCL9
ZERO? GL-P-NCN \?CCL9
GET GL-P-ITBL,K-P-PREP1 >PREP
ZERO? PREP /?CTR8
CALL RT-GET-PREP,SYN,1
EQUAL? PREP,STACK \?CCL9
?CTR8: SET 'DRIVE1,SYN
JUMP ?CND5
?CCL9: CALL RT-GET-PREP,SYN,1 >?TMP1
GET GL-P-ITBL,K-P-PREP1
EQUAL? ?TMP1,STACK \?CND5
EQUAL? NUM,2 \?CCL18
EQUAL? GL-P-NCN,1 \?CCL18
SET 'DRIVE2,SYN
JUMP ?CND5
?CCL18: GRTR? NUM,1 /?CCL22
GET GL-P-ITBL,K-P-PREP2
ZERO? STACK \?CND5
?CCL22: GRTR? NUM,1 \?CCL25
CALL RT-GET-PREP,SYN,2 >?TMP1
GET GL-P-ITBL,K-P-PREP2
EQUAL? ?TMP1,STACK \?CND5
?CCL25: ICALL2 RT-SYNTAX-FOUND,SYN
RTRUE
?CND5: DLESS? 'LEN,1 \?CCL30
ZERO? DRIVE1 \?REP4
ZERO? DRIVE2 \?REP4
EQUAL? GL-P-NCN,2 \?CCL37
ZERO? GL-FUNNY-CLAUSE? /?CCL37
SET 'GL-P-NCN,1
SET 'GL-FUNNY-CLAUSE?,FALSE-VALUE
GET GL-P-ITBL,K-P-NC2L
PUT GL-P-ITBL,K-P-NC1L,STACK
CALL1 RT-SYNTAX-CHECK
RSTACK
?CCL37: PRINT K-DONT-UNDERSTAND-MSG
CRLF
RFALSE
?CCL30: ZERO? NUM \?CCL42
ADD SYN,K-P-SLEN-0 >SYN
JUMP ?PRG3
?CCL42: EQUAL? NUM,1 \?CCL44
ADD SYN,K-P-SLEN-1 >SYN
JUMP ?PRG3
?CCL44: ADD SYN,K-P-SLEN-2 >SYN
JUMP ?PRG3
?REP4: ZERO? DRIVE1 /?CCL47
GETB DRIVE1,K-P-SFWIM1 >?TMP2
GETB DRIVE1,K-P-SLOC1 >?TMP1
CALL RT-GET-PREP,DRIVE1,1
CALL RT-GET-WHAT-I-MEAN,?TMP2,?TMP1,STACK >OBJ
ZERO? OBJ /?CCL47
PUT GL-P-PRSO,K-P-MATCHLEN,1
PUT GL-P-PRSO,1,OBJ
ICALL2 RT-SYNTAX-FOUND,DRIVE1
RTRUE
?CCL47: ZERO? DRIVE2 /?CCL51
GETB DRIVE2,K-P-SFWIM2 >?TMP2
GETB DRIVE2,K-P-SLOC2 >?TMP1
CALL RT-GET-PREP,DRIVE2,2
CALL RT-GET-WHAT-I-MEAN,?TMP2,?TMP1,STACK >OBJ
ZERO? OBJ /?CCL51
PUT GL-P-PRSI,K-P-MATCHLEN,1
PUT GL-P-PRSI,1,OBJ
ICALL2 RT-SYNTAX-FOUND,DRIVE2
RTRUE
?CCL51: EQUAL? VERB,ACT?FIND \?CCL55
PRINT K-DO-IT-YOURSELF-MSG
CRLF
RFALSE
?CCL55: EQUAL? GL-WINNER,CH-PLAYER \?CCL58
ICALL RT-ORPHAN,DRIVE1,DRIVE2
PRINTI "[Wh"
JUMP ?CND56
?CCL58: PRINTI "[Your command was not complete. Type wh"
?CND56: EQUAL? VERB,ACT?WALK,ACT?GO \?CCL61
PRINTI "ere"
JUMP ?CND59
?CCL61: ZERO? DRIVE1 /?PRD65
GETB DRIVE1,K-P-SFWIM1
EQUAL? STACK,FL-PERSON /?CTR62
?PRD65: ZERO? DRIVE2 /?CCL63
GETB DRIVE2,K-P-SFWIM2
EQUAL? STACK,FL-PERSON \?CCL63
?CTR62: PRINTI "om"
JUMP ?CND59
?CCL63: PRINTI "at"
?CND59: EQUAL? GL-WINNER,CH-PLAYER \?CCL72
PRINTI " do you want to "
JUMP ?CND70
?CCL72: PRINTI " you want "
ICALL2 RT-THEO-PRINT,GL-WINNER
PRINTI " to "
?CND70: ICALL1 RT-VERB-PRINT
ZERO? DRIVE2 /?CND73
ICALL RT-CLAUSE-PRINT,K-P-NC1,K-P-NC1L
?CND73: SET 'GL-P-END-ON-PREP,FALSE-VALUE
ZERO? DRIVE1 /?CCL77
CALL RT-GET-PREP,DRIVE1,1
JUMP ?CND75
?CCL77: CALL RT-GET-PREP,DRIVE2,2
?CND75: ICALL2 RT-PREP-PRINT,STACK
EQUAL? GL-WINNER,CH-PLAYER \?CCL80
SET 'GL-P-ORPH,TRUE-VALUE
PRINTI "?]"
CRLF
RFALSE
?CCL80: SET 'GL-P-ORPH,FALSE-VALUE
PRINTI ".]"
CRLF
RFALSE
.FUNCT RT-CLAUSE,PTR,VAL,WRD,OFF,NUM,ANDFLG,FIRST??,NW,LW,TPTR,TMP,?TMP1
SET 'FIRST??,TRUE-VALUE
SUB GL-P-NCN,1
MUL STACK,2 >OFF
ZERO? VAL /?CCL3
ADD K-P-PREP1,OFF >NUM
PUT GL-P-ITBL,NUM,VAL
ADD NUM,1
PUT GL-P-ITBL,STACK,WRD
ADD PTR,K-P-LEXELEN >PTR
JUMP ?CND1
?CCL3: INC 'GL-P-LEN
?CND1: ZERO? GL-P-LEN \?CND4
DEC 'GL-P-NCN
RETURN -1
?CND4: ADD K-P-NC1,OFF >NUM
MUL PTR,2
ADD GL-P-P-LEX,STACK
PUT GL-P-ITBL,NUM,STACK
GET GL-P-P-LEX,PTR
EQUAL? STACK,W?THE,W?A,W?AN \?PRG8
GET GL-P-ITBL,NUM
ADD STACK,4
PUT GL-P-ITBL,NUM,STACK
?PRG8: DLESS? 'GL-P-LEN,0 \?CND10
ADD NUM,1 >?TMP1
MUL PTR,2
ADD GL-P-P-LEX,STACK
PUT GL-P-ITBL,?TMP1,STACK
RETURN -1
?CND10: GET GL-P-P-LEX,PTR >WRD
ZERO? WRD \?CTR13
CALL2 RT-NUMBER?,PTR >WRD
ZERO? WRD /?CCL14
?CTR13: ZERO? GL-P-LEN \?CCL19
SET 'NW,0
JUMP ?CND17
?CCL19: ADD PTR,K-P-LEXELEN >TPTR
GET GL-P-P-LEX,TPTR >NW
ZERO? NW \?CND17
EQUAL? WRD,W?INTNUM /?CND17
CALL2 RT-NUMBER?,TPTR >NW
PUT GL-P-P-LEX,TPTR,NW
?CND17: EQUAL? WRD,W?PERIOD \?CCL26
EQUAL? LW,W?MR,W?MRS,W?MISS /?CTR25
EQUAL? LW,W?DR \?CCL26
?CTR25: SET 'LW,0
JUMP ?CND12
?CCL26: EQUAL? WRD,W?AND,W?COMMA \?CCL32
SET 'ANDFLG,TRUE-VALUE
JUMP ?CND12
?CCL32: EQUAL? WRD,W?ALL,W?BOTH,W?EVERYTHING \?CCL34
EQUAL? NW,W?OF \?CND12
DEC 'GL-P-LEN
ADD PTR,K-P-LEXELEN >PTR
JUMP ?CND12
?CCL34: EQUAL? WRD,W?THEN,W?PERIOD /?CTR37
GETB WRD,6
BTST STACK,8 \?CCL38
GET GL-P-ITBL,K-P-VERB
ZERO? STACK /?CCL38
ZERO? FIRST?? \?CCL38
?CTR37: INC 'GL-P-LEN
ADD NUM,1 >?TMP1
MUL PTR,2
ADD GL-P-P-LEX,STACK
PUT GL-P-ITBL,?TMP1,STACK
SUB PTR,K-P-LEXELEN
RSTACK
?CCL38: ZERO? ANDFLG /?CCL45
GET GL-P-ITBL,K-P-VERBN
ZERO? STACK /?CTR44
CALL2 RT-VERB-DIR-ONLY?,WRD
ZERO? STACK /?CCL45
?CTR44: SUB PTR,4 >PTR
ADD PTR,2
ICALL RT-CHANGE-LEXV,STACK,W?THEN
ADD GL-P-LEN,2 >GL-P-LEN
JUMP ?CND12
?CCL45: GETB WRD,6
BTST STACK,128 \?CCL51
GRTR? GL-P-LEN,0 \?CCL54
EQUAL? NW,W?OF \?CCL54
EQUAL? WRD,W?ALL,W?EVERYTHING /?CCL54
SUB GL-P-NCN,1
PUT GL-P-OFW,STACK,WRD
JUMP ?CND12
?CCL54: GETB WRD,6
BTST STACK,32 \?CCL59
ZERO? NW /?CCL59
GETB NW,6
BTST STACK,128 \?CCL59
EQUAL? WRD,W?INTNUM \?CCL65
EQUAL? NW,W?HOUR,W?HOURS,W?MINUTE /?CND12
EQUAL? NW,W?MINUTES /?CND12
?CCL65: EQUAL? NW,W?TOMB /?CND12
EQUAL? WRD,W?BOX \?CCL74
EQUAL? NW,W?INTNUM /?CND72
SET 'TMP,TRUE-VALUE
JUMP ?CND72
?CCL74: EQUAL? WRD,W?TOMB \?CND72
SET 'TMP,TRUE-VALUE
?CND72: ZERO? TMP /?CND12
SET 'GL-FUNNY-CLAUSE?,TRUE-VALUE
INC 'NUM
SET '?TMP1,1
ADD PTR,2
MUL STACK,2
ADD GL-P-P-LEX,STACK
PUT GL-P-ITBL,?TMP1,STACK
RETURN PTR
?CCL59: ZERO? ANDFLG \?CCL81
EQUAL? NW,W?BUT,W?EXCEPT /?CCL81
EQUAL? NW,W?AND,W?COMMA /?CCL81
ADD NUM,1 >?TMP1
ADD PTR,2
MUL STACK,2
ADD GL-P-P-LEX,STACK
PUT GL-P-ITBL,?TMP1,STACK
RETURN PTR
?CCL81: SET 'ANDFLG,FALSE-VALUE
JUMP ?CND12
?CCL51: ZERO? GL-P-MERGED \?PRD87
ZERO? GL-P-ORPH \?PRD87
GET GL-P-ITBL,K-P-VERB
ZERO? STACK /?CCL85
?PRD87: GETB WRD,6
BAND STACK,36
ZERO? STACK \?CND12
?CCL85: ZERO? ANDFLG /?CCL92
GET GL-P-ITBL,K-P-VERB
ZERO? STACK \?CCL92
SUB PTR,4 >PTR
ADD PTR,2
ICALL RT-CHANGE-LEXV,STACK,W?THEN
ADD GL-P-LEN,2 >GL-P-LEN
?CND12: SET 'LW,WRD
SET 'FIRST??,FALSE-VALUE
ADD PTR,K-P-LEXELEN >PTR
JUMP ?PRG8
?CCL92: GETB WRD,6
BTST STACK,8 /?CND12
ICALL2 RT-DONT-KNOW-WORD-USE-MSG,PTR
RFALSE
?CCL14: ICALL2 RT-DONT-KNOW-WORD-MSG,PTR
RFALSE
.FUNCT RT-GET-WHAT-I-MEAN,GBIT,LBIT,PREP,NO-ROOMS?,SILENT?,OBJ
EQUAL? GBIT,FL-LOCATION \?CCL3
RETURN ROOMS
?CCL3: ZERO? GL-P-IT-OBJECT /?CND1
FSET? GL-P-IT-OBJECT,GBIT \?CND1
ZERO? SILENT? /?CCL8
RETURN GL-P-IT-OBJECT
?CCL8: PRINTC 91
ICALL2 RT-THEO-PRINT,GL-P-IT-OBJECT
PRINTC 93
CRLF
RETURN GL-P-IT-OBJECT
?CND1: SET 'INHIBIT-ROOMS,NO-ROOMS?
SET 'GL-P-GWIMBIT,GBIT
SET 'GL-P-SLOCBITS,LBIT
PUT GL-P-MERGE,K-P-MATCHLEN,0
CALL RT-GET-OBJECT,GL-P-MERGE,FALSE-VALUE
ZERO? STACK /?CCL11
SET 'GL-P-GWIMBIT,0
GET GL-P-MERGE,K-P-MATCHLEN
EQUAL? STACK,1 \FALSE
GET GL-P-MERGE,1 >OBJ
EQUAL? GL-WINNER,CH-PLAYER \?CND15
EQUAL? OBJ,TH-HANDS /?CND15
ZERO? SILENT? \?CND15
PRINTC 91
CALL RT-PREP-PRINT,PREP,FALSE-VALUE
ZERO? STACK /?CND20
PRINTC 32
?CND20: ICALL2 RT-THEO-PRINT,OBJ
PRINTC 93
CRLF
?CND15: SET 'INHIBIT-ROOMS,FALSE-VALUE
RETURN OBJ
?CCL11: SET 'GL-P-GWIMBIT,0
SET 'INHIBIT-ROOMS,FALSE-VALUE
RFALSE
.FUNCT RT-P-CLEAR
SET 'GL-P-CONT,FALSE-VALUE
SET 'GL-P-QUOT,FALSE-VALUE
RTRUE
.FUNCT RT-PICK-NEXT,TBL,CNT,STR,NT
GETB TBL,0 >CNT
ADD TBL,1
GET STACK,0 >NT
GET NT,CNT >STR
GET NT,0
IGRTR? 'CNT,STACK \?CND1
SET 'CNT,1
?CND1: PUTB TBL,0,CNT
RETURN STR
.FUNCT RT-QCONTEXT-GOOD?
ZERO? GL-WHERE-TO-ORPH? \FALSE
ZERO? GL-P-QCONTEXT-TH /FALSE
FSET? GL-P-QCONTEXT-TH,FL-PERSON \FALSE
EQUAL? GL-PLACE-CUR,GL-P-QCONTEXT-RM \FALSE
CALL2 RT-VISIBLE?,GL-P-QCONTEXT-TH
ZERO? STACK /FALSE
RTRUE
.FUNCT RT-FIND-PERSON,THING,OBJ,OBJ1,WHO-P,WHO-A
FIRST? THING >OBJ /?PRG2
?PRG2: ZERO? OBJ /?REP3
FSET? OBJ,FL-PERSON \?CCL8
FSET? OBJ,FL-PLURAL /?CND4
EQUAL? OBJ,CH-PLAYER,GL-WINNER /?CND4
FSET? OBJ,FL-ASLEEP /?CND4
EQUAL? OBJ,GL-PUPPY \?REP3
SET 'WHO-P,OBJ
JUMP ?CND4
?CCL8: FSET? OBJ,FL-SURFACE /?CCL17
FSET? OBJ,FL-CONTAINER \?CND4
FSET? OBJ,FL-OPENED \?CND4
?CCL17: SET 'OBJ1,OBJ
CALL2 RT-FIND-PERSON,OBJ >OBJ
ZERO? OBJ /?CND22
FSET? OBJ,FL-ASLEEP /?CND22
EQUAL? OBJ,GL-PUPPY \?REP3
SET 'WHO-P,OBJ
?CND22: SET 'OBJ,OBJ1
?CND4: NEXT? OBJ >OBJ /?PRG2
JUMP ?PRG2
?REP3: ZERO? OBJ /?CCL31
RETURN OBJ
?CCL31: ZERO? WHO-P /FALSE
RETURN WHO-P
.FUNCT RT-ANYONE-HERE?
CALL1 RT-QCONTEXT-GOOD?
ZERO? STACK /?CCL3
RETURN GL-P-QCONTEXT-TH
?CCL3: CALL2 RT-FIND-PERSON,GL-PLACE-CUR
RSTACK
.FUNCT RT-MOVE-ALL,FROM,TO,OBJ,NXT
FIRST? FROM >OBJ /?PRG2
?PRG2: ZERO? OBJ /TRUE
NEXT? OBJ >NXT /?BOGUS6
?BOGUS6: MOVE OBJ,TO
SET 'OBJ,NXT
JUMP ?PRG2
.FUNCT RT-GOT?,OBJ
ZERO? OBJ /FALSE
EQUAL? GL-WINNER,CH-PLAYER \?CCL5
IN? OBJ,TH-POCKET /TRUE
?CCL5: CALL2 RT-HELD?,OBJ
ZERO? STACK /FALSE
RTRUE
.FUNCT RT-HELD?,OBJ,L
ZERO? OBJ /FALSE
FSET? OBJ,FL-TAKEABLE /?CND1
FSET? OBJ,FL-TRYTAKE \FALSE
?CND1: LOC OBJ >L
EQUAL? L,FALSE-VALUE,ROOMS,GLOBAL-OBJECTS /FALSE
EQUAL? L,GL-WINNER /TRUE
EQUAL? GL-WINNER,CH-PLAYER \?CCL13
EQUAL? L,TH-POCKET /FALSE
?CCL13: CALL2 RT-HELD?,L
RSTACK
.FUNCT RT-THIS-IS-IT,OBJ
EQUAL? OBJ,FALSE-VALUE,CH-PLAYER,TH-NOT-HERE-OBJECT /TRUE
EQUAL? OBJ,TH-INTDIR,TH-INTNUM /TRUE
EQUAL? OBJ,TH-LEFT,TH-RIGHT /TRUE
EQUAL? GL-PRSA,V?WALK,V?WALK-TO \?CCL8
EQUAL? OBJ,GL-PRSO /TRUE
?CCL8: FSET? OBJ,FL-PERSON \?CCL12
FSET? OBJ,FL-FEMALE \?CCL12
SET 'GL-P-HER-OBJECT,OBJ
RTRUE
?CCL12: FSET? OBJ,FL-PERSON \?CCL16
FSET? OBJ,FL-FEMALE /?CCL16
SET 'GL-P-HIM-OBJECT,OBJ
RTRUE
?CCL16: FSET? OBJ,FL-COLLECTIVE \?CCL20
SET 'GL-P-THEM-OBJECT,OBJ
SET 'GL-P-IT-OBJECT,OBJ
RTRUE
?CCL20: FSET? OBJ,FL-PLURAL \?CCL22
SET 'GL-P-THEM-OBJECT,OBJ
RTRUE
?CCL22: FSET? OBJ,FL-NEEDS-IDENTITY \?CCL25
GETP OBJ,P?OBJ-NOUN
PUTP TH-IT,P?OBJ-NOUN,STACK
GETP OBJ,P?OBJ-ADJ
PUTP TH-IT,P?OBJ-ADJ,STACK
JUMP ?CND23
?CCL25: PUTP TH-IT,P?OBJ-NOUN,0
PUTP TH-IT,P?OBJ-ADJ,0
?CND23: SET 'GL-P-IT-OBJECT,OBJ
RTRUE
.FUNCT RT-CHANGE-LEXV,PTR,WRD,PTRS?,X,Y,Z
ZERO? PTRS? /?CND1
SUB PTR,K-P-LEXELEN
MUL 2,STACK
ADD 2,STACK >X
GETB GL-P-P-LEX,X >Y
MUL 2,PTR
ADD 2,STACK >Z
PUTB GL-P-P-LEX,Z,Y
PUTB GL-P-S-LEX,Z,Y
ADD 1,X
GETB GL-P-P-LEX,STACK >Y
MUL 2,PTR
ADD 3,STACK >Z
PUTB GL-P-P-LEX,Z,Y
PUTB GL-P-S-LEX,Z,Y
?CND1: PUT GL-P-P-LEX,PTR,WRD
PUT GL-P-S-LEX,PTR,WRD
RTRUE
.FUNCT RT-WT?,PTR,BIT,B1,OFFS,TYP,TBL,?TMP1
ASSIGNED? 'B1 /?CND1
SET 'B1,5
?CND1: SET 'OFFS,K-P-P1OFF
GETB PTR,K-P-PSOFF >TYP
BTST TYP,BIT \FALSE
GRTR? B1,4 /TRUE
EQUAL? BIT,8 \?CCL10
ADD PREPOSITIONS,2 >?TMP1
GET PREPOSITIONS,0
INTBL? PTR,?TMP1,STACK,131 >TBL \FALSE
GETB TBL,2
RSTACK
?CCL10: BAND TYP,K-P-P1BITS >TYP
GETB PTR,OFFS
RSTACK
.FUNCT RT-VERB-DIR-ONLY?,WRD
GETB WRD,6
BAND STACK,160
ZERO? STACK \FALSE
GETB WRD,6
BAND STACK,80
ZERO? STACK /FALSE
RTRUE
.FUNCT RT-STUFF,DEST,SRC,MAX
ASSIGNED? 'MAX /?CND1
SET 'MAX,29
?CND1: MUL MAX,K-P-WORDLEN
ADD K-P-LEXSTART,STACK
COPYT SRC,DEST,STACK
RTRUE
.FUNCT RT-INBUF-ADD,LEN,BEG,SLOT,DBEG,CTR,TMP,?TMP1
GET GL-OOPS-TABLE,K-O-END >TMP
ZERO? TMP /?CCL3
SET 'DBEG,TMP
JUMP ?CND1
?CCL3: GET GL-OOPS-TABLE,K-O-LENGTH >TMP
GETB GL-P-S-LEX,TMP >?TMP1
ADD TMP,1
GETB GL-P-S-LEX,STACK
ADD ?TMP1,STACK >DBEG
?CND1: ADD DBEG,LEN
PUT GL-OOPS-TABLE,K-O-END,STACK
ADD GL-P-PIBUF,BEG >?TMP1
ADD GL-OOPS-INBUF,DBEG
COPYT ?TMP1,STACK,LEN
PUTB GL-P-S-LEX,SLOT,DBEG
SUB SLOT,1
PUTB GL-P-S-LEX,STACK,LEN
RTRUE
.FUNCT RT-ACLAUSE-WIN,ADJ,X
GET GL-P-OTBL,K-P-VERB
PUT GL-P-ITBL,K-P-VERB,STACK
ADD GL-P-ACLAUSE,1 >X
ICALL RT-CLAUSE-COPY,GL-P-OTBL,GL-P-OTBL,GL-P-ACLAUSE,X,GL-P-ACLAUSE,X,ADJ
GET GL-P-OTBL,K-P-NC2
ZERO? STACK /?PEN1
SET 'GL-P-NCN,2
?PEN1: SET 'GL-P-ACLAUSE,FALSE-VALUE
RTRUE
.FUNCT RT-NCLAUSE-WIN
ADD GL-P-ACLAUSE,1
ICALL RT-CLAUSE-COPY,GL-P-ITBL,GL-P-OTBL,K-P-NC1,K-P-NC1L,GL-P-ACLAUSE,STACK
GET GL-P-OTBL,K-P-NC2
ZERO? STACK /?PEN1
SET 'GL-P-NCN,2
?PEN1: SET 'GL-P-ACLAUSE,FALSE-VALUE
RTRUE
.FUNCT RT-ORPHAN-VERB,VERB,PREVERB
PUT GL-P-VTBL,0,VERB
PUT GL-P-OTBL,K-P-VERB,PREVERB
PUT GL-P-OTBL,K-P-VERBN,GL-P-VTBL
PUT GL-P-OTBL,K-P-PREP1,0
PUT GL-P-OTBL,K-P-PREP1N,0
PUT GL-P-OTBL,K-P-PREP2,0
PUT GL-P-OTBL,5,0
PUT GL-P-OTBL,K-P-NC1,1
PUT GL-P-OTBL,K-P-NC1L,0
PUT GL-P-OTBL,K-P-NC2,0
PUT GL-P-OTBL,K-P-NC2L,0
SET 'GL-P-ORPH,TRUE-VALUE
RETURN GL-P-ORPH
.FUNCT RT-ORPHAN,D1,D2,CNT
SET 'CNT,-1
ZERO? GL-P-MERGED \?CND1
PUT GL-P-OCLAUSE,K-P-MATCHLEN,0
?CND1: GET GL-P-VTBL,0
PUT GL-P-OVTBL,0,STACK
GETB GL-P-VTBL,2
PUTB GL-P-OVTBL,2,STACK
GETB GL-P-VTBL,3
PUTB GL-P-OVTBL,3,STACK
COPYT GL-P-ITBL,GL-P-OTBL,20
EQUAL? GL-P-NCN,2 \?CND3
ICALL RT-CLAUSE-COPY,GL-P-ITBL,GL-P-OTBL,K-P-NC2,K-P-NC2L,K-P-NC2,K-P-NC2L
?CND3: LESS? GL-P-NCN,1 /?CND5
ICALL RT-CLAUSE-COPY,GL-P-ITBL,GL-P-OTBL,K-P-NC1,K-P-NC1L,K-P-NC1,K-P-NC1L
?CND5: ZERO? D1 /?CCL9
CALL RT-GET-PREP,D1,1
PUT GL-P-OTBL,K-P-PREP1,STACK
PUT GL-P-OTBL,K-P-NC1,1
RTRUE
?CCL9: ZERO? D2 /FALSE
CALL RT-GET-PREP,D2,2
PUT GL-P-OTBL,K-P-PREP2,STACK
PUT GL-P-OTBL,K-P-NC2,1
RTRUE
.FUNCT RT-ORPHAN-MERGE,CNT,TEMP,VERB,BEG,END,ADJ,WRD,?TMP1
SET 'CNT,-1
SET 'GL-P-ORPH,FALSE-VALUE
GET GL-P-ITBL,K-P-VERBN >WRD
ZERO? WRD /?CND1
GET WRD,0 >WRD
ZERO? WRD /?CND1
GET GL-P-ITBL,K-P-VERBN
GET STACK,0 >WRD
CALL RT-WT?,WRD,64,1 >?TMP1
GET GL-P-OTBL,K-P-VERB
EQUAL? ?TMP1,STACK /?CTR6
GETB WRD,6
BTST STACK,32 \?CCL7
?CTR6: SET 'ADJ,TRUE-VALUE
JUMP ?CND1
?CCL7: GET GL-P-ITBL,K-P-VERBN
GET STACK,0 >WRD
GETB WRD,6
BTST STACK,32 \?CCL11
SET 'ADJ,TRUE-VALUE
JUMP ?CND1
?CCL11: GETB WRD,6
BTST STACK,128 \?CND1
ZERO? GL-P-NCN \?CND1
GET GL-P-ITBL,K-P-VERB >VERB
ZERO? VERB /?CND1
PUT GL-P-ITBL,K-P-VERB,0
PUT GL-P-ITBL,K-P-VERBN,0
PUT GL-P-ITBL,K-P-NC1,T?GL-P-P-LEX+2
PUT GL-P-ITBL,K-P-NC1L,T?GL-P-P-LEX+6
SET 'GL-P-NCN,1
?CND1: GET GL-P-ITBL,K-P-VERB >VERB
ZERO? VERB /?CCL18
ZERO? ADJ \?CCL18
GET GL-P-OTBL,K-P-VERB
EQUAL? VERB,STACK \FALSE
?CCL18: EQUAL? GL-P-NCN,2 \?CCL23
ZERO? GL-FUNNY-CLAUSE? /FALSE
SET 'GL-P-NCN,1
SET 'GL-FUNNY-CLAUSE?,FALSE-VALUE
GET GL-P-ITBL,K-P-NC2L
PUT GL-P-ITBL,K-P-NC1L,STACK
CALL1 RT-ORPHAN-MERGE
RSTACK
?CCL23: GET GL-P-OTBL,K-P-NC1
EQUAL? STACK,1 \?CCL27
GET GL-P-ITBL,K-P-PREP1 >TEMP
GET GL-P-OTBL,K-P-PREP1
EQUAL? TEMP,STACK /?CTR29
ZERO? TEMP \FALSE
?CTR29: ZERO? ADJ /?CCL35
PUT GL-P-OTBL,K-P-NC1,T?GL-P-P-LEX+2
GET GL-P-ITBL,K-P-NC1L
ZERO? STACK \?CND36
PUT GL-P-ITBL,K-P-NC1L,T?GL-P-P-LEX+6
?CND36: ZERO? GL-P-NCN \?CND33
SET 'GL-P-NCN,1
JUMP ?CND33
?CCL35: GET GL-P-ITBL,K-P-NC1
PUT GL-P-OTBL,K-P-NC1,STACK
?CND33: GET GL-P-ITBL,K-P-NC1L
PUT GL-P-OTBL,K-P-NC1L,STACK
JUMP ?CND16
?CCL27: GET GL-P-OTBL,K-P-NC2
EQUAL? STACK,1 \?CCL41
GET GL-P-ITBL,K-P-PREP1 >TEMP
GET GL-P-OTBL,K-P-PREP2
EQUAL? TEMP,STACK /?CTR43
ZERO? TEMP \FALSE
?CTR43: ZERO? ADJ /?CND47
PUT GL-P-ITBL,K-P-NC1,T?GL-P-P-LEX+2
GET GL-P-ITBL,K-P-NC1L
ZERO? STACK \?CND47
PUT GL-P-ITBL,K-P-NC1L,T?GL-P-P-LEX+6
?CND47: GET GL-P-ITBL,K-P-NC1
PUT GL-P-OTBL,K-P-NC2,STACK
GET GL-P-ITBL,K-P-NC1L
PUT GL-P-OTBL,K-P-NC2L,STACK
SET 'GL-P-NCN,2
JUMP ?CND16
?CCL41: ZERO? GL-P-ACLAUSE /?CND16
EQUAL? GL-P-NCN,1 /?CCL54
ZERO? ADJ \?CCL54
SET 'GL-P-ACLAUSE,FALSE-VALUE
RFALSE
?CCL54: GET GL-P-ITBL,K-P-NC1 >BEG
ZERO? ADJ /?CND57
SET 'BEG,T?GL-P-P-LEX+2
SET 'ADJ,FALSE-VALUE
?CND57: GET GL-P-ITBL,K-P-NC1L >END
?PRG59: GET BEG,0 >WRD
EQUAL? BEG,END \?CCL63
ZERO? ADJ /?CCL66
ICALL2 RT-ACLAUSE-WIN,ADJ
JUMP ?CND16
?CCL66: SET 'GL-P-ACLAUSE,FALSE-VALUE
RFALSE
?CCL63: GETB WRD,K-P-PSOFF
BTST STACK,32 \?PRD71
CALL RT-ADJ-CHECK,WRD,ADJ
ZERO? STACK \?CTR67
?PRD71: EQUAL? WRD,W?ALL,W?EVERYTHING \?CCL68
?CTR67: SET 'ADJ,WRD
?CND61: ADD BEG,K-P-WORDLEN >BEG
ZERO? END \?PRG59
SET 'END,BEG
SET 'GL-P-NCN,1
SUB BEG,4
PUT GL-P-ITBL,K-P-NC1,STACK
PUT GL-P-ITBL,K-P-NC1L,BEG
JUMP ?PRG59
?CCL68: GETB WRD,K-P-PSOFF
BTST STACK,128 \?CND61
EQUAL? WRD,GL-P-ANAM \?CCL77
ICALL2 RT-ACLAUSE-WIN,ADJ
JUMP ?CND16
?CCL77: ICALL1 RT-NCLAUSE-WIN
?CND16: GET GL-P-OVTBL,0
PUT GL-P-VTBL,0,STACK
GETB GL-P-OVTBL,2
PUTB GL-P-VTBL,2,STACK
GETB GL-P-OVTBL,3
PUTB GL-P-VTBL,3,STACK
PUT GL-P-OTBL,K-P-VERBN,GL-P-VTBL
PUTB GL-P-VTBL,2,0
COPYT GL-P-OTBL,GL-P-ITBL,20
SET 'GL-P-MERGED,TRUE-VALUE
RTRUE
.FUNCT RT-ADJ-CHECK,WRD,ADJ
EQUAL? WRD,W?BROWN,W?BLUE /TRUE
ZERO? ADJ /TRUE
RFALSE
.FUNCT RT-CLAUSE-COPY,SRC,DEST,SRCBEG,SRCEND,DESTBEG,DESTEND,INSRT,BEG,END
GET SRC,SRCBEG >BEG
GET SRC,SRCEND >END
GET GL-P-OCLAUSE,K-P-MATCHLEN
MUL STACK,K-P-LEXELEN
ADD STACK,2
ADD GL-P-OCLAUSE,STACK
PUT DEST,DESTBEG,STACK
?PRG1: EQUAL? BEG,END \?CCL5
GET GL-P-OCLAUSE,K-P-MATCHLEN
MUL STACK,K-P-LEXELEN
ADD 2,STACK
ADD GL-P-OCLAUSE,STACK
PUT DEST,DESTEND,STACK
RTRUE
?CCL5: ZERO? INSRT /?CND6
GET BEG,0
EQUAL? GL-P-ANAM,STACK \?CND6
ICALL2 RT-CLAUSE-ADD,INSRT
?CND6: GET BEG,0
ICALL2 RT-CLAUSE-ADD,STACK
ADD BEG,K-P-WORDLEN >BEG
JUMP ?PRG1
.FUNCT RT-CLAUSE-ADD,WRD,PTR
GET GL-P-OCLAUSE,K-P-MATCHLEN
ADD STACK,2 >PTR
SUB PTR,1
PUT GL-P-OCLAUSE,STACK,WRD
PUT GL-P-OCLAUSE,PTR,0
PUT GL-P-OCLAUSE,K-P-MATCHLEN,PTR
RTRUE
.FUNCT RT-PREP-FIND,PREP,CNT,SIZE,TBL,?TMP1
ADD PREPOSITIONS,4 >?TMP1
GET PREPOSITIONS,0
INTBL? PREP,?TMP1,STACK,3 >TBL \FALSE
SUB TBL,2
GET STACK,0
RSTACK
.FUNCT RT-SYNTAX-FOUND,SYN
SET 'GL-P-SYNTAX,SYN
GETB SYN,K-P-SACTION >GL-PRSA
RETURN GL-PRSA
.FUNCT RT-BUT-MERGE,TBL,LEN,BUTLEN,CNT,MATCHES,OBJ,NTBL
SET 'CNT,1
GET TBL,K-P-MATCHLEN >LEN
PUT GL-P-MERGE,K-P-MATCHLEN,0
?PRG1: DLESS? 'LEN,0 /?REP2
GET TBL,CNT >OBJ
GET GL-P-BUTS,0
INTBL? OBJ,T?GL-P-BUTS+2,STACK /?CND5
ADD MATCHES,1
PUT GL-P-MERGE,STACK,OBJ
INC 'MATCHES
?CND5: INC 'CNT
JUMP ?PRG1
?REP2: PUT GL-P-MERGE,K-P-MATCHLEN,MATCHES
SET 'NTBL,GL-P-MERGE
SET 'GL-P-MERGE,TBL
RETURN NTBL
.FUNCT RT-SNARF-OBJECTS,PTR,NUM
GETB GL-P-SYNTAX,0
SHIFT STACK,-6 >NUM
GRTR? NUM,0 \?CND1
GET GL-P-ITBL,K-P-NC1 >PTR
ZERO? PTR /?CND1
SET 'GL-P-PHR,0
GETB GL-P-SYNTAX,K-P-SLOC1 >GL-P-SLOCBITS
GET GL-P-ITBL,K-P-NC1L
CALL RT-SNARF,PTR,STACK,GL-P-PRSO
ZERO? STACK /FALSE
GET GL-P-BUTS,K-P-MATCHLEN
ZERO? STACK /?CND1
CALL2 RT-BUT-MERGE,GL-P-PRSO >GL-P-PRSO
?CND1: GRTR? NUM,1 \TRUE
GET GL-P-ITBL,K-P-NC2 >PTR
ZERO? PTR /TRUE
SET 'GL-P-PHR,1
GETB GL-P-SYNTAX,K-P-SLOC2 >GL-P-SLOCBITS
GET GL-P-ITBL,K-P-NC2L
CALL RT-SNARF,PTR,STACK,GL-P-PRSI
ZERO? STACK /FALSE
GET GL-P-BUTS,K-P-MATCHLEN
ZERO? STACK /TRUE
GET GL-P-PRSI,K-P-MATCHLEN
EQUAL? STACK,1 \?CCL19
CALL2 RT-BUT-MERGE,GL-P-PRSO >GL-P-PRSO
RTRUE
?CCL19: CALL2 RT-BUT-MERGE,GL-P-PRSI >GL-P-PRSI
RTRUE
.FUNCT RT-SNARF,PTR,EPTR,TBL,BUT,LEN,WV,WRD,NW,WAS-ALL?,ONEOBJ
SET 'GL-P-AND,FALSE-VALUE
EQUAL? GL-P-GET-FLAGS,K-P-ALL \?CND1
SET 'WAS-ALL?,TRUE-VALUE
?CND1: SET 'GL-P-GET-FLAGS,0
PUT GL-P-BUTS,K-P-MATCHLEN,0
PUT TBL,K-P-MATCHLEN,0
GET PTR,0 >WRD
?PRG3: EQUAL? PTR,EPTR \?CCL7
ZERO? BUT /?PRD10
PUSH BUT
JUMP ?PEN8
?PRD10: PUSH TBL
?PEN8: CALL2 RT-GET-OBJECT,STACK >WV
ZERO? WAS-ALL? /?CND11
SET 'GL-P-GET-FLAGS,K-P-ALL
?CND11: RETURN WV
?CCL7: ADD PTR,K-P-WORDLEN
EQUAL? EPTR,STACK \?CCL15
SET 'NW,0
JUMP ?CND13
?CCL15: GET PTR,K-P-LEXELEN >NW
?CND13: EQUAL? WRD,W?ALL,W?BOTH,W?EVERYTHING \?CCL18
SET 'GL-P-GET-FLAGS,K-P-ALL
EQUAL? NW,W?OF \?CND5
ADD PTR,K-P-WORDLEN >PTR
JUMP ?CND5
?CCL18: EQUAL? WRD,W?BUT,W?EXCEPT \?CCL22
ZERO? BUT /?PRD27
PUSH BUT
JUMP ?PEN25
?PRD27: PUSH TBL
?PEN25: CALL2 RT-GET-OBJECT,STACK
ZERO? STACK /FALSE
SET 'BUT,GL-P-BUTS
PUT BUT,K-P-MATCHLEN,0
JUMP ?CND5
?CCL22: EQUAL? WRD,W?A \?CCL29
ZERO? GL-P-ADJ \?CCL32
SET 'GL-P-GET-FLAGS,K-P-ONE
EQUAL? NW,W?OF \?CND5
ADD PTR,K-P-WORDLEN >PTR
JUMP ?CND5
?CCL32: SET 'GL-P-NAM,ONEOBJ
ZERO? BUT /?PRD39
PUSH BUT
JUMP ?PEN37
?PRD39: PUSH TBL
?PEN37: CALL2 RT-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 'GL-P-AND,TRUE-VALUE
ZERO? BUT /?PRD50
PUSH BUT
JUMP ?PEN48
?PRD50: PUSH TBL
?PEN48: CALL2 RT-GET-OBJECT,STACK
ZERO? STACK \?CND5
RFALSE
?CCL43: GETB WRD,6
BTST STACK,4 /?CND5
EQUAL? WRD,W?AND,W?COMMA /?CND5
EQUAL? WRD,W?OF \?CCL54
ZERO? GL-P-GET-FLAGS \?CND5
SET 'GL-P-GET-FLAGS,K-P-INHIBIT
JUMP ?CND5
?CCL54: GETB WRD,6
BTST STACK,32 \?CCL58
ZERO? GL-P-ADJ \?CCL58
EQUAL? NW,W?OF /?CCL58
SET 'GL-P-ADJ,WRD
JUMP ?CND5
?CCL58: GETB WRD,6
BTST STACK,128 \?CND5
SET 'GL-P-NAM,WRD
SET 'ONEOBJ,WRD
?CND5: EQUAL? PTR,EPTR /?PRG3
ADD PTR,K-P-WORDLEN >PTR
SET 'WRD,NW
JUMP ?PRG3
.FUNCT RT-GET-OBJECT,TBL,VRB,NO-ROOMS?,BTS,LEN,XBITS,TLEN,GCHECK,OLEN,OBJ,ADJ,X
ASSIGNED? 'VRB /?CND1
SET 'VRB,TRUE-VALUE
?CND1: SET 'XBITS,GL-P-SLOCBITS
GET TBL,K-P-MATCHLEN >TLEN
BTST GL-P-GET-FLAGS,K-P-INHIBIT /TRUE
SET 'ADJ,GL-P-ADJ
ZERO? GL-P-NAM \?CND5
ZERO? GL-P-ADJ /?CND5
GETB GL-P-ADJ,6
BTST STACK,128 \?CCL11
SET 'GL-P-NAM,GL-P-ADJ
SET 'GL-P-ADJ,FALSE-VALUE
?CND5: ZERO? GL-P-NAM \?CND13
ZERO? GL-P-ADJ \?CND13
EQUAL? GL-P-GET-FLAGS,K-P-ALL /?CND13
ZERO? GL-P-GWIMBIT \?CND13
ZERO? VRB /FALSE
ICALL2 RT-NOT-IN-SENTENCE-MSG,STR?226
RFALSE
?CCL11: CALL RT-WT?,GL-P-ADJ,16,3 >BTS
ZERO? BTS /?CND5
SET 'GL-P-ADJ,FALSE-VALUE
PUT TBL,K-P-MATCHLEN,1
PUT TBL,1,TH-INTDIR
SET 'GL-P-DIRECTION,BTS
RTRUE
?CND13: EQUAL? GL-P-GET-FLAGS,K-P-ALL \?CCL22
ZERO? GL-P-SLOCBITS \?CND21
?CCL22: SET 'GL-P-SLOCBITS,-1
?CND21: EQUAL? TBL,GL-P-PRSO \?CCL27
GET GL-P-OFW,0 >GL-P-OF
JUMP ?CND25
?CCL27: GET GL-P-OFW,1 >GL-P-OF
?CND25: SET 'GL-P-TABLE,TBL
?PRG28: ZERO? GCHECK /?CCL32
ICALL2 RT-GLOBAL-CHECK,TBL
JUMP ?CND30
?CCL32: ZERO? GL-NOW-LIT? /?CND33
FCLEAR CH-PLAYER,FL-TRANSPARENT
ICALL RT-DO-SL,GL-PLACE-CUR,SOG,SIR
FSET CH-PLAYER,FL-TRANSPARENT
?CND33: ICALL RT-DO-SL,CH-PLAYER,SH,SC
?CND30: GET TBL,K-P-MATCHLEN
SUB STACK,TLEN >LEN
BTST GL-P-GET-FLAGS,K-P-ALL /?CND35
BTST GL-P-GET-FLAGS,K-P-ONE \?CCL38
ZERO? LEN /?CCL38
EQUAL? LEN,1 /?CND41
RANDOM LEN
GET TBL,STACK
PUT TBL,1,STACK
PRINTI "[How about "
GET TBL,1
ICALL2 RT-THEO-PRINT,STACK
PRINTI "?]"
CRLF
?CND41: PUT TBL,K-P-MATCHLEN,1
?CND35: ADD TLEN,1
GET TBL,STACK >X
ZERO? GL-P-ADJ /?CND86
ZERO? GL-P-NAM \?CND86
ZERO? X /?CND86
PRINTC 91
ICALL2 RT-THEO-PRINT,X
PRINTC 93
CRLF
CRLF
?CND86: SET 'GL-P-SLOCBITS,XBITS
PUT GL-P-NAMW,GL-P-PHR,GL-P-NAM
PUT GL-P-ADJW,GL-P-PHR,GL-P-ADJ
SET 'GL-P-NAM,FALSE-VALUE
SET 'GL-P-ADJ,FALSE-VALUE
RTRUE
?CCL38: GRTR? LEN,1 /?CTR43
ZERO? LEN \?CCL44
EQUAL? GL-P-SLOCBITS,-1 /?CCL44
?CTR43: EQUAL? GL-P-SLOCBITS,-1 \?CCL51
SET 'GL-P-SLOCBITS,XBITS
SET 'OLEN,LEN
GET TBL,K-P-MATCHLEN
SUB STACK,LEN
PUT TBL,K-P-MATCHLEN,STACK
JUMP ?PRG28
?CCL51: PUT GL-P-NAMW,GL-P-PHR,GL-P-NAM
PUT GL-P-ADJW,GL-P-PHR,GL-P-ADJ
ZERO? LEN \?CND52
SET 'LEN,OLEN
?CND52: ZERO? GL-P-NAM /?CCL56
ADD TLEN,1
GET TBL,STACK >OBJ
ZERO? OBJ /?CCL56
GETP OBJ,P?GENERIC
CALL STACK,TBL,LEN >OBJ
ZERO? OBJ /?CCL56
EQUAL? OBJ,TH-NOT-HERE-OBJECT /FALSE
PUT TBL,1,OBJ
PUT TBL,K-P-MATCHLEN,1
SET 'GL-P-NAM,FALSE-VALUE
SET 'GL-P-ADJ,FALSE-VALUE
RTRUE
?CCL56: ZERO? VRB /?CCL63
EQUAL? GL-WINNER,CH-PLAYER /?CCL63
PRINT K-DONT-UNDERSTAND-MSG
CRLF
RFALSE
?CCL63: ZERO? VRB /?CCL67
ZERO? GL-P-NAM /?CCL67
ICALL RT-WHICH-PRINT,TLEN,LEN,TBL
EQUAL? TBL,GL-P-PRSO \?CCL72
SET 'GL-P-ACLAUSE,K-P-NC1
JUMP ?CND70
?CCL72: SET 'GL-P-ACLAUSE,K-P-NC2
?CND70: SET 'GL-P-AADJ,GL-P-ADJ
SET 'GL-P-ANAM,GL-P-NAM
ICALL RT-ORPHAN,FALSE-VALUE,FALSE-VALUE
SET 'GL-P-ORPH,TRUE-VALUE
JUMP ?CND54
?CCL67: ZERO? VRB /?CND54
ICALL2 RT-NOT-IN-SENTENCE-MSG,STR?226
?CND54: SET 'GL-P-NAM,FALSE-VALUE
SET 'GL-P-ADJ,FALSE-VALUE
RFALSE
?CCL44: ZERO? LEN \?CCL75
ZERO? GCHECK /?CCL75
PUT GL-P-NAMW,GL-P-PHR,GL-P-NAM
PUT GL-P-ADJW,GL-P-PHR,GL-P-ADJ
ZERO? VRB /?CND78
SET 'GL-P-SLOCBITS,XBITS
ZERO? GL-NOW-LIT? \?CTR81
CALL1 RT-TALK-VERB?
ZERO? STACK /?CCL82
?CTR81: ICALL RT-OBJ-FOUND,TH-NOT-HERE-OBJECT,TBL
SET 'GL-P-XNAM,GL-P-NAM
SET 'GL-P-NAM,FALSE-VALUE
SET 'GL-P-XADJ,GL-P-ADJ
SET 'GL-P-ADJ,FALSE-VALUE
RTRUE
?CCL82: PRINT K-TOO-DARK-MSG
CRLF
?CND78: SET 'GL-P-NAM,FALSE-VALUE
SET 'GL-P-ADJ,FALSE-VALUE
RFALSE
?CCL75: ZERO? LEN \?CND35
SET 'GCHECK,TRUE-VALUE
JUMP ?PRG28
.FUNCT RT-MOBY-FIND,TBL,OBJ,LEN,FOO,NAM,ADJ,TTBL,COBJ-GOOD?,CT,?TMP1
SET 'OBJ,1
SET 'NAM,GL-P-NAM
SET 'ADJ,GL-P-ADJ
SET 'GL-P-NAM,GL-P-XNAM
SET 'GL-P-ADJ,GL-P-XADJ
PUT TBL,K-P-MATCHLEN,0
?PRG1: CALL2 RT-THIS-IT?,OBJ
ZERO? STACK /?CND3
LOC OBJ
ZERO? STACK /?CTR6
LOC OBJ
CALL2 RT-THIS-IT?,STACK
ZERO? STACK \?CCL7
?CTR6: GET TBL,K-P-MATCHLEN >CT
LOC OBJ
ZERO? STACK \?CTR11
FSET? OBJ,FL-PERSON /?CTR11
INTBL? OBJ,FIND-NO-LOCS+2,3 \?CCL12
?CTR11: EQUAL? CT,1 \?CCL18
ZERO? COBJ-GOOD? \?CCL18
SET 'COBJ-GOOD?,TRUE-VALUE
PUT TBL,K-P-MATCHLEN,0
JUMP ?CND16
?CCL18: ZERO? CT \?CND16
SET 'COBJ-GOOD?,TRUE-VALUE
?CND16: ICALL RT-OBJ-FOUND,OBJ,TBL
JUMP ?CND3
?CCL12: ZERO? CT \?CND3
CALL RT-OBJ-FOUND,OBJ,TBL >FOO
JUMP ?CND3
?CCL7: IN? OBJ,ROOMS \?CND3
GET TBL,K-P-MATCHLEN
ZERO? STACK \?CND3
CALL2 RT-MATCH-PSEUDO,OBJ
ZERO? STACK /?CND3
CALL RT-OBJ-FOUND,OBJ,TBL >FOO
?CND3: IGRTR? 'OBJ,LAST-OBJECT \?PRG1
GET TBL,K-P-MATCHLEN >CT
ZERO? CT /?CCL30
ZERO? COBJ-GOOD? /?CCL30
EQUAL? GL-PLACE-CUR,RM-DIOGENES-CLUB \?CND29
ADD TBL,2 >?TMP1
GET TBL,K-P-MATCHLEN
INTBL? CH-HOLMES,?TMP1,STACK >TTBL \?CND29
?CCL30: CALL RT-PARSE-EVENT?,GL-P-NAM,GL-P-ADJ >OBJ
ZERO? OBJ /?CND29
ZERO? TTBL /?CCL40
PUT TTBL,0,OBJ
JUMP ?CND38
?CCL40: ZERO? COBJ-GOOD? \?CND41
GRTR? CT,0 \?CND41
SUB CT,1
PUT TBL,K-P-MATCHLEN,STACK
?CND41: ICALL RT-OBJ-FOUND,OBJ,TBL
?CND38: SET 'COBJ-GOOD?,TRUE-VALUE
?CND29: GET TBL,K-P-MATCHLEN >LEN
EQUAL? LEN,1 \?CND45
ZERO? COBJ-GOOD? \?CCL49
SET 'GL-P-MOBY-FOUND,TH-NOT-HERE-OBJECT
JUMP ?CND45
?CCL49: GET TBL,1 >GL-P-MOBY-FOUND
?CND45: SET 'GL-P-NAM,NAM
SET 'GL-P-ADJ,ADJ
RETURN LEN
.FUNCT RT-MATCH-PSEUDO,OBJ,RMG,RMGL,TTBL,?TMP1
GETP OBJ,P?PSEUDOS >RMG
ZERO? RMG /FALSE
GETB RMG,0 >RMGL
INC 'RMG
?PRG3: GET RMG,1 >TTBL
ZERO? TTBL /?CND5
ADD TTBL,1 >?TMP1
GETB TTBL,0
INTBL? GL-P-NAM,?TMP1,STACK \?CND5
ZERO? GL-P-ADJ \?PRD11
RETURN RMG
?PRD11: GET RMG,0 >TTBL
ZERO? TTBL /?CND5
ADD TTBL,1 >?TMP1
GETB TTBL,0
INTBL? GL-P-ADJ,?TMP1,STACK \?CND5
RETURN RMG
?CND5: ADD RMG,6 >RMG
DLESS? 'RMGL,1 \?PRG3
RFALSE
.FUNCT RT-GLOBAL-CHECK,TBL,LEN,RMG,RMGL,CNT,OBJ,OBITS,FOO
GET TBL,K-P-MATCHLEN >LEN
SET 'OBITS,GL-P-SLOCBITS
CALL2 RT-THIS-IT?,GL-PLACE-CUR
ZERO? STACK /?CND1
ICALL RT-OBJ-FOUND,GL-PLACE-CUR,TBL
?CND1: GETPT GL-PLACE-CUR,P?GLOBAL >RMG
ZERO? RMG /?CND3
PTSIZE RMG >RMGL
DEC 'RMGL
?PRG5: GETB RMG,CNT >OBJ
FIRST? OBJ \?CND7
IN? OBJ,ROOMS /?CND7
ICALL RT-SEARCH-LIST,OBJ,TBL,K-P-SRCALL
?CND7: CALL2 RT-THIS-IT?,OBJ
ZERO? STACK /?CND11
ICALL RT-OBJ-FOUND,OBJ,TBL
?CND11: IGRTR? 'CNT,RMGL \?PRG5
?CND3: GET TBL,K-P-MATCHLEN
ZERO? STACK \?CND15
CALL2 RT-MATCH-PSEUDO,GL-PLACE-CUR >RMG
ZERO? RMG /?CND15
SET 'LAST-PSEUDO-LOC,GL-PLACE-CUR
GET RMG,2
PUTP PSEUDO-OBJECT,P?ACTION,STACK
ICALL RT-OBJ-FOUND,PSEUDO-OBJECT,TBL
?CND15: GET TBL,K-P-MATCHLEN
EQUAL? STACK,LEN \FALSE
SET 'GL-P-SLOCBITS,-1
SET 'GL-P-TABLE,TBL
ICALL RT-DO-SL,GLOBAL-OBJECTS,1,1
SET 'GL-P-SLOCBITS,OBITS
GET TBL,K-P-MATCHLEN
ZERO? STACK \FALSE
EQUAL? GL-PRSA,V?EXAMINE,V?LOOK-ON,V?LOOK-INSIDE /?PRD29
EQUAL? GL-PRSA,V?FIND,V?FOLLOW,V?EXIT /?PRD29
EQUAL? GL-PRSA,V?SEARCH,V?SMELL,V?WALK-TO /?PRD29
EQUAL? GL-PRSA,V?THROUGH,V?WAIT-FOR,V?WAIT \FALSE
?PRD29: ZERO? INHIBIT-ROOMS \FALSE
CALL RT-DO-SL,ROOMS,1,1
RSTACK
.FUNCT RT-DO-SL,OBJ,BIT1,BIT2,BITS
ADD BIT1,BIT2
BTST GL-P-SLOCBITS,STACK \?CCL3
CALL RT-SEARCH-LIST,OBJ,GL-P-TABLE,K-P-SRCALL
RSTACK
?CCL3: BTST GL-P-SLOCBITS,BIT1 \?CCL6
CALL RT-SEARCH-LIST,OBJ,GL-P-TABLE,K-P-SRCTOP
RSTACK
?CCL6: BTST GL-P-SLOCBITS,BIT2 \TRUE
CALL RT-SEARCH-LIST,OBJ,GL-P-TABLE,K-P-SRCBOT
RSTACK
.FUNCT RT-SEARCH-LIST,OBJ,TBL,LVL
FIRST? OBJ >OBJ /?BOGUS1
?BOGUS1: ZERO? OBJ /FALSE
?PRG5: EQUAL? LVL,K-P-SRCBOT /?CND7
GETPT OBJ,P?SYNONYM
ZERO? STACK /?CND7
CALL2 RT-THIS-IT?,OBJ
ZERO? STACK /?CND7
ICALL RT-OBJ-FOUND,OBJ,TBL
?CND7: ZERO? LVL \?PRD15
FSET? OBJ,FL-SURFACE /?PRD15
FSET? OBJ,FL-PERSON \?CND12
?PRD15: FIRST? OBJ \?CND12
CALL2 RT-SEE-INSIDE?,OBJ
ZERO? STACK /?CND12
FSET? OBJ,FL-SURFACE /?CTR21
FSET? OBJ,FL-PERSON \?CCL22
?CTR21: PUSH K-P-SRCALL
JUMP ?CND20
?CCL22: FSET? OBJ,FL-CONTAINER \?CCL26
FSET? OBJ,FL-OPENED /?CTR25
FSET? OBJ,FL-TRANSPARENT \?CCL26
?CTR25: PUSH K-P-SRCALL
JUMP ?CND20
?CCL26: PUSH K-P-SRCTOP
?CND20: ICALL RT-SEARCH-LIST,OBJ,TBL,STACK
?CND12: NEXT? OBJ >OBJ /?BOGUS31
?BOGUS31: ZERO? OBJ \?PRG5
RTRUE
.FUNCT RT-THIS-IT?,OBJ,SYNS,SYNSIZE,ADJS,ADJSIZE
ZERO? GL-P-NAM /?CCL3
GETPT OBJ,P?SYNONYM >SYNS
ZERO? SYNS /FALSE
PTSIZE SYNS
DIV STACK,2 >SYNSIZE
INTBL? GL-P-NAM,SYNS,SYNSIZE \FALSE
?CCL3: ZERO? GL-P-ADJ /?CND1
GETPT OBJ,P?ADJECTIVE >ADJS
ZERO? ADJS /FALSE
PTSIZE ADJS
DIV STACK,2 >ADJSIZE
INTBL? GL-P-ADJ,ADJS,ADJSIZE \FALSE
?CND1: ZERO? INHIBIT-ROOMS /?CCL15
IN? OBJ,ROOMS /FALSE
?CCL15: ZERO? GL-P-OF /?CND13
ZERO? ADJS /?CND19
INTBL? GL-P-OF,ADJS,ADJSIZE /TRUE
?CND19: ZERO? SYNS /FALSE
INTBL? GL-P-OF,SYNS,SYNSIZE /TRUE
RFALSE
?CND13: ZERO? GL-P-GWIMBIT /TRUE
FSET? OBJ,GL-P-GWIMBIT /TRUE
RFALSE
.FUNCT RT-OBJ-FOUND,OBJ,TBL,PTR
GET TBL,K-P-MATCHLEN
ADD STACK,1 >PTR
LESS? PTR,K-P-OBJ-TBL-LEN /?CCL3
SET 'GL-P-OVERFLOW,TRUE-VALUE
RFALSE
?CCL3: LESS? PTR,K-P-OBJ-TBL-LEN \TRUE
SET 'GL-P-OVERFLOW,FALSE-VALUE
PUT TBL,PTR,OBJ
PUT TBL,K-P-MATCHLEN,PTR
FSET? OBJ,FL-NEEDS-IDENTITY \TRUE
PUTP OBJ,P?OBJ-ADJ,GL-P-ADJ
EQUAL? OBJ,TH-EVENT /TRUE
PUTP OBJ,P?OBJ-NOUN,GL-P-NAM
RTRUE
.FUNCT RT-ITAKE,VB,L
ASSIGNED? 'VB /?CND1
SET 'VB,TRUE-VALUE
?CND1: ZERO? GL-PRSO /?CCL4
LOC GL-PRSO
ZERO? STACK \?CND3
?CCL4: ICALL1 RT-CANT-SEE-ANY-MSG
RFALSE
?CND3: LOC GL-PRSO >L
ICALL2 RT-THIS-IS-IT,GL-PRSO
FSET? GL-PRSO,FL-TAKEABLE /?CCL9
ZERO? VB /FALSE
ICALL1 RT-IMPOSSIBLE-MSG
RFALSE
?CCL9: FSET? L,FL-CONTAINER \?CCL13
FSET? L,FL-OPENABLE \?CCL13
FSET? L,FL-OPENED /?CCL13
ZERO? VB /FALSE
ICALL RT-YOUD-HAVE-TO-MSG,STR?227,L
RFALSE
?CCL13: IN? L,GL-WINNER /?CCL20
CALL RT-OBJ-TOO-HEAVY?,GL-PRSO,GL-WINNER
ZERO? STACK /?CCL20
ZERO? VB /FALSE
ICALL1 RT-CTHEO-PRINT
ICALL2 RT-IS-ARE-MSG,GL-PRSO
PRINTI "too heavy."
CRLF
RFALSE
?CCL20: CALL RT-OBJ-TOO-MANY?,GL-PRSO,GL-WINNER
ZERO? STACK /?CCL26
ZERO? VB /FALSE
ICALL RT-CYOU-MSG,STR?228,STR?229
PRINTI "holding too much already."
CRLF
RFALSE
?CCL26: FSET GL-PRSO,FL-SEEN
FSET GL-PRSO,FL-TOUCHED
FCLEAR GL-PRSO,FL-WORN
FCLEAR GL-PRSO,FL-NODESC
FCLEAR GL-PRSO,FL-NOALL
MOVE GL-PRSO,GL-WINNER
RETURN L
.FUNCT RT-ITAKE-CHECK,TBL,BITS,PRSO?,PTR,LEN,OBJ,L,GOT,TRIED-TAKE?,NEED-TAKE?
SET 'PTR,1
GET TBL,K-P-MATCHLEN >LEN
ZERO? LEN /TRUE
BAND BITS,10
ZERO? STACK /TRUE
?PRG5: GET TBL,PTR >OBJ
EQUAL? OBJ,TH-IT \?CCL9
CALL2 RT-ACCESSIBLE?,GL-P-IT-OBJECT
ZERO? STACK \?CND10
PRINT K-BE-MORE-SPECIFIC-MSG
CRLF
RFALSE
?CND10: FSET? OBJ,FL-NEEDS-IDENTITY \?CND12
GETP TH-IT,P?OBJ-NOUN
PUTP OBJ,P?OBJ-NOUN,STACK
GETP TH-IT,P?OBJ-ADJ
PUTP OBJ,P?OBJ-ADJ,STACK
?CND12: SET 'OBJ,GL-P-IT-OBJECT
JUMP ?CND7
?CCL9: EQUAL? OBJ,CH-THEM \?CCL15
CALL2 RT-ACCESSIBLE?,GL-P-THEM-OBJECT
ZERO? STACK \?CND16
PRINT K-BE-MORE-SPECIFIC-MSG
CRLF
RFALSE
?CND16: SET 'OBJ,GL-P-THEM-OBJECT
JUMP ?CND7
?CCL15: EQUAL? OBJ,CH-HER \?CCL19
CALL2 RT-ACCESSIBLE?,GL-P-HER-OBJECT
ZERO? STACK \?CND20
PRINT K-BE-MORE-SPECIFIC-MSG
CRLF
RFALSE
?CND20: SET 'OBJ,GL-P-HER-OBJECT
JUMP ?CND7
?CCL19: EQUAL? OBJ,CH-HIM \?CND7
CALL2 RT-ACCESSIBLE?,GL-P-HIM-OBJECT
ZERO? STACK \?CND23
PRINT K-BE-MORE-SPECIFIC-MSG
CRLF
RFALSE
?CND23: SET 'OBJ,GL-P-HIM-OBJECT
?CND7: EQUAL? OBJ,TH-POCKET,TH-HANDS,TH-FEET /?CND25
EQUAL? OBJ,CH-ME,CH-PLAYER,CH-YOU /?CND25
EQUAL? OBJ,ROOMS,TH-PLAYER-BODY /?CND25
EQUAL? OBJ,TH-INTDIR,TH-RIGHT,TH-LEFT /?CND25
BTST BITS,SC /?CCL34
BTST BITS,SH \?CCL34
IN? OBJ,GL-WINNER /?CND32
SET 'NEED-TAKE?,TRUE-VALUE
JUMP ?CND32
?CCL34: CALL2 RT-HELD?,OBJ
ZERO? STACK \?CND32
ZERO? PRSO? /?PRD46
GET GL-P-NAMW,0
ZERO? STACK /?PRD44
?PRD46: ZERO? PRSO? \?CCL42
GET GL-P-NAMW,1
ZERO? STACK \?CCL42
?PRD44: IN? OBJ,TH-POCKET /?CND32
?CCL42: SET 'NEED-TAKE?,TRUE-VALUE
?CND32: ZERO? NEED-TAKE? /?CND25
SET 'NEED-TAKE?,FALSE-VALUE
SET 'GL-PRSO,OBJ
LOC OBJ >L
ZERO? L \?CCL55
SET 'GOT,FALSE-VALUE
JUMP ?CND53
?CCL55: FSET? OBJ,FL-TRYTAKE \?CCL57
FSET? OBJ,FL-TAKEABLE /?CCL57
SET 'GOT,FALSE-VALUE
JUMP ?CND53
?CCL57: EQUAL? GL-WINNER,CH-PLAYER /?CCL61
SET 'GOT,FALSE-VALUE
JUMP ?CND53
?CCL61: EQUAL? L,GL-WINNER \?CCL63
BTST BITS,SHAVE \?CCL63
SET 'GOT,TRUE-VALUE
JUMP ?CND53
?CCL63: CALL RT-META-IN?,L,GL-WINNER
ZERO? STACK /?CCL67
ZERO? GL-P-MULT? \?CCL67
BTST BITS,STAKE \?CCL67
PRINTI "[taking "
ICALL2 RT-THEO-PRINT,OBJ
ZERO? L /?CND71
FSET? L,FL-CONTAINER \?CCL75
PRINTI " out of "
JUMP ?CND73
?CCL75: FSET? L,FL-SURFACE \?CCL77
PRINTI " off "
JUMP ?CND73
?CCL77: PRINTI " from "
?CND73: ICALL2 RT-THEO-PRINT,L
?CND71: PRINTI " first]."
CRLF
SET 'NEED-TAKE?,TRUE-VALUE
CALL1 RT-ITAKE >GOT
JUMP ?CND53
?CCL67: SET 'GOT,FALSE-VALUE
?CND53: ZERO? GOT \?CND25
BTST BITS,SHAVE \?CND25
ZERO? NEED-TAKE? \FALSE
EQUAL? LEN,PTR \?PRD88
ZERO? GL-P-MULT? \?CCL86
?PRD88: EQUAL? OBJ,TH-NOT-HERE-OBJECT /?CCL86
LOC OBJ
EQUAL? STACK,GLOBAL-OBJECTS,LOCAL-GLOBALS \?CCL86
PRINTI "Don't be silly"
JUMP ?CND84
?CCL86: ICALL1 RT-WINNER-NOT-HOLDING-MSG
EQUAL? LEN,PTR \?CCL94
ZERO? GL-P-MULT? /?CCL94
PRINTI "all of those things"
JUMP ?CND84
?CCL94: EQUAL? OBJ,TH-NOT-HERE-OBJECT \?CCL98
SET 'GL-P-IT-OBJECT,OBJ
ICALL2 DPRINT,OBJ
JUMP ?CND84
?CCL98: ICALL2 RT-THIS-IS-IT,OBJ
FSET? OBJ,FL-PLURAL \?CCL101
PRINTI "any "
ICALL2 DPRINT,OBJ
JUMP ?CND84
?CCL101: ICALL2 RT-A-PRINT,OBJ
?CND84: PRINTC 46
CRLF
RFALSE
?CND25: IGRTR? 'PTR,LEN \?PRG5
RTRUE
.FUNCT RT-MANY-CHECK,LOSS,TMP,?TMP1
GET GL-P-PRSO,K-P-MATCHLEN
GRTR? STACK,1 \?CCL3
GETB GL-P-SYNTAX,K-P-SLOC1
BTST STACK,SMANY /?CCL3
SET 'LOSS,1
JUMP ?CND1
?CCL3: GET GL-P-PRSI,K-P-MATCHLEN
GRTR? STACK,1 \?CND1
GETB GL-P-SYNTAX,K-P-SLOC2
BTST STACK,SMANY /?CND1
SET 'LOSS,2
?CND1: ZERO? LOSS /TRUE
PRINTI "[You cannot refer to more than one object at a time with """
GET GL-P-ITBL,K-P-VERBN >TMP
ZERO? TMP \?CCL14
PRINTI "tell"
JUMP ?CND12
?CCL14: ZERO? GL-P-ORPH \?CTR15
ZERO? GL-P-MERGED /?CCL16
?CTR15: GET TMP,0
PRINTB STACK
JUMP ?CND12
?CCL16: GETB TMP,2 >?TMP1
GETB TMP,3
ICALL RT-WORD-PRINT,?TMP1,STACK
?CND12: PRINTI ".""]"
CRLF
RFALSE
.FUNCT RT-IS-LIT?,RM,RMFLG,OHERE,LIT
ASSIGNED? 'RMFLG /?CND1
SET 'RMFLG,TRUE-VALUE
?CND1: ZERO? RM \?CND3
SET 'RM,GL-PLACE-CUR
?CND3: ZERO? RMFLG /?CCL7
FSET? RM,FL-LIGHTED /TRUE
?CCL7: ZERO? GL-ALW-LIT? /?CND5
EQUAL? GL-WINNER,CH-PLAYER /TRUE
?CND5: FSET? RM,FL-INDOORS /?CND13
CALL1 RT-TIME-OF-DAY
ZERO? STACK \TRUE
?CND13: SET 'GL-P-GWIMBIT,FL-LIGHTED
SET 'OHERE,GL-PLACE-CUR
SET 'GL-PLACE-CUR,RM
PUT GL-P-MERGE,K-P-MATCHLEN,0
SET 'GL-P-TABLE,GL-P-MERGE
SET 'GL-P-SLOCBITS,-1
SET 'GL-P-OF,FALSE-VALUE
EQUAL? OHERE,RM \?CND17
ICALL RT-DO-SL,GL-WINNER,1,1
EQUAL? GL-WINNER,CH-PLAYER /?CND17
IN? CH-PLAYER,RM \?CND17
ICALL RT-DO-SL,CH-PLAYER,1,1
?CND17: ICALL RT-DO-SL,RM,1,1
GET GL-P-TABLE,K-P-MATCHLEN
GRTR? STACK,0 \?CND23
SET 'LIT,TRUE-VALUE
?CND23: SET 'GL-PLACE-CUR,OHERE
SET 'GL-P-GWIMBIT,0
RETURN LIT
.FUNCT RT-PERFORM,A,O,I,W-ROOM,W-LOC,I-LOC,O-LOC,V,OA,OO,OI,ONP,WHO
ZERO? WINNER-IS-WIGGINS /?CND1
EQUAL? GL-WINNER,CH-PLAYER \?CND1
EQUAL? GL-PRSA,V?TELL /?CND1
SET 'GL-WINNER,CH-WIGGINS
ICALL2 RT-SPOKEN-TO-MSG,GL-WINNER
?CND1: SET 'WINNER-IS-WIGGINS,FALSE-VALUE
FSET? GL-WINNER,FL-ALIVE /?CND6
ICALL RT-NOT-LIKELY-MSG,GL-WINNER,STR?230
ICALL1 RT-P-CLEAR
RETURN 2
?CND6: INTBL? A,GL-SEE-VERBS+2,20 \?CND8
ZERO? GL-NOW-LIT? \?CND8
PRINT K-TOO-DARK-MSG
CRLF
RETURN 2
?CND8: SET 'OA,GL-PRSA
SET 'OO,GL-PRSO
SET 'OI,GL-PRSI
SET 'ONP,GL-NOW-PRSI?
CALL1 RT-ANYONE-HERE? >WHO
SET 'V,0
EQUAL? A,V?WALK /?CND12
EQUAL? GL-WINNER,CH-PLAYER \?CCL16
EQUAL? GL-PRSA,V?WHO,V?WHAT,V?WHERE \?CCL16
ZERO? WHO \?CCL21
ICALL1 RT-NOBODY-TO-ASK-MSG
RETURN 2
?CCL21: SET 'GL-WINNER,WHO
ICALL2 RT-SPOKEN-TO-MSG,WHO
JUMP ?CND14
?CCL16: EQUAL? GL-WINNER,CH-PLAYER \?CCL23
EQUAL? GL-PRSA,V?ASK-FOR-1,V?ASK-ABOUT-1 \?CCL23
ZERO? WHO \?CCL28
ICALL1 RT-NOBODY-TO-ASK-MSG
RETURN 2
?CCL28: ICALL2 RT-SPOKEN-TO-MSG,WHO
SET 'GL-PRSI,GL-PRSO
SET 'GL-PRSO,WHO
EQUAL? GL-PRSA,V?ASK-FOR-1 \?CCL31
SET 'GL-PRSA,V?ASK-FOR
JUMP ?CND29
?CCL31: EQUAL? GL-PRSA,V?ASK-ABOUT-1 \?CND29
SET 'GL-PRSA,V?ASK-ABOUT
?CND29: SET 'A,GL-PRSA
SET 'O,GL-PRSO
SET 'I,GL-PRSI
JUMP ?CND14
?CCL23: EQUAL? GL-WINNER,CH-PLAYER \?CND14
EQUAL? O,CH-ME,CH-PLAYER \?CND14
EQUAL? GL-PRSA,V?TELL,V?TELL-ABOUT,V?ASK-ABOUT /?CCL33
EQUAL? GL-PRSA,V?ASK-FOR,V?QUESTION,V?REPLY /?CCL33
EQUAL? GL-PRSA,V?THANK,V?YELL,V?HELLO /?CCL33
EQUAL? GL-PRSA,V?GOODBYE,V?SAY,V?ALARM /?CCL33
EQUAL? GL-PRSA,V?PASSWORD \?CND14
?CCL33: ZERO? WHO \?CCL44
ICALL1 RT-TALK-TO-SELF-MSG
RETURN 2
?CCL44: SET 'GL-WINNER,WHO
ICALL2 RT-SPOKEN-TO-MSG,WHO
?CND14: EQUAL? CH-YOU,I,O \?CND45
EQUAL? GL-WINNER,CH-PLAYER \?CCL49
ZERO? WHO \?CCL52
ICALL1 RT-TALK-TO-SELF-MSG
RETURN 2
?CCL52: SET 'GL-WINNER,WHO
ICALL2 RT-SPOKEN-TO-MSG,WHO
JUMP ?CND47
?CCL49: SET 'GL-P-QCONTEXT-TH,GL-WINNER
SET 'GL-P-QCONTEXT-RM,GL-PLACE-CUR
SET 'WHO,GL-WINNER
?CND47: EQUAL? I,CH-YOU \?CND53
SET 'I,WHO
?CND53: EQUAL? O,CH-YOU \?CND45
SET 'O,WHO
?CND45: EQUAL? TH-IT,I,O \?CND57
CALL2 RT-ACCESSIBLE?,GL-P-IT-OBJECT
ZERO? STACK \?CND57
ZERO? I \?CCL63
ICALL1 RT-FAKE-ORPHAN-MSG
RETURN 2
?CCL63: ICALL2 RT-CANT-SEE-ANY-MSG,GL-P-IT-OBJECT
RETURN 2
?CND57: EQUAL? CH-THEM,I,O \?CND64
CALL2 RT-VISIBLE?,GL-P-THEM-OBJECT
ZERO? STACK /?CCL68
EQUAL? CH-THEM,O \?CND69
SET 'O,GL-P-THEM-OBJECT
?CND69: EQUAL? CH-THEM,I \?CND64
SET 'I,GL-P-THEM-OBJECT
?CND64: EQUAL? CH-HER,I,O \?CND76
CALL2 RT-VISIBLE?,GL-P-HER-OBJECT
ZERO? STACK /?CCL80
EQUAL? GL-P-HER-OBJECT,GL-WINNER \?CND81
CALL2 RT-NO-OTHER?,TRUE-VALUE
ZERO? STACK /?CND81
RETURN 2
?CCL68: ZERO? I \?CCL75
ICALL1 RT-FAKE-ORPHAN-MSG
RETURN 2
?CCL75: ICALL2 RT-CANT-SEE-ANY-MSG,GL-P-THEM-OBJECT
RETURN 2
?CND81: EQUAL? CH-HER,O \?CND85
SET 'O,GL-P-HER-OBJECT
?CND85: EQUAL? CH-HER,I \?CND76
SET 'I,GL-P-HER-OBJECT
?CND76: EQUAL? CH-HIM,I,O \?CND92
CALL2 RT-VISIBLE?,GL-P-HIM-OBJECT
ZERO? STACK /?CCL96
EQUAL? GL-P-HIM-OBJECT,GL-WINNER \?CND97
CALL1 RT-NO-OTHER?
ZERO? STACK /?CND97
RETURN 2
?CCL80: ZERO? I \?CCL91
ICALL1 RT-FAKE-ORPHAN-MSG
RETURN 2
?CCL91: ICALL2 RT-CANT-SEE-ANY-MSG,GL-P-HER-OBJECT
RETURN 2
?CND97: EQUAL? CH-HIM,O \?CND101
SET 'O,GL-P-HIM-OBJECT
?CND101: EQUAL? CH-HIM,I \?CND92
SET 'I,GL-P-HIM-OBJECT
?CND92: EQUAL? O,TH-IT \?CND108
SET 'O,GL-P-IT-OBJECT
?CND108: EQUAL? I,TH-IT \?CND12
SET 'I,GL-P-IT-OBJECT
?CND12: EQUAL? A,V?TAKE \?CND112
ZERO? O /?CND112
ZERO? I \?CND112
LOC O
ZERO? STACK /?CND112
LOC O >I
?CND112: SET 'GL-PRSA,A
SET 'GL-PRSI,I
SET 'GL-PRSO,O
EQUAL? A,V?WALK /?CND118
EQUAL? TH-NOT-HERE-OBJECT,O,I \?CND118
CALL RT-TH-NOT-HERE-OBJECT >V
ZERO? V /?CND118
SET 'GL-P-GOOD,FALSE-VALUE
?CND118: ICALL2 RT-THIS-IS-IT,GL-PRSI
ICALL2 RT-THIS-IS-IT,GL-PRSO
SET 'I,GL-PRSI
SET 'O,GL-PRSO
EQUAL? O,ROOMS \?CND124
SET 'O,FALSE-VALUE
?CND124: LOC GL-WINNER >W-LOC
FSET? W-LOC,FL-VEHICLE /?CTR127
FSET? W-LOC,FL-CONTAINER /?CTR127
FSET? W-LOC,FL-SURFACE \?CCL128
?CTR127: LOC W-LOC >W-ROOM
JUMP ?CND126
?CCL96: ZERO? I \?CCL107
ICALL1 RT-FAKE-ORPHAN-MSG
RETURN 2
?CCL107: ICALL2 RT-CANT-SEE-ANY-MSG,GL-P-HIM-OBJECT
RETURN 2
?CCL128: SET 'W-ROOM,W-LOC
?CND126: ZERO? V \?CND132
GETP GL-WINNER,P?ACTION
CALL STACK,K-M-WINNER >V
?CND132: ZERO? V \?CND134
GETP W-ROOM,P?ACTION
CALL STACK,K-M-BEG >V
?CND134: ZERO? V \?CND136
GET PREACTIONS,A
CALL STACK >V
?CND136: ZERO? V \?CND138
EQUAL? GL-WINNER,CH-PLAYER \?CND138
FSET? W-LOC,FL-VEHICLE /?CCL139
FSET? W-LOC,FL-CONTAINER /?CCL139
FSET? W-LOC,FL-SURFACE \?CND138
?CCL139: GETP W-LOC,P?CONTFCN
CALL STACK,K-M-CANT >V
?CND138: ZERO? V \?CND146
EQUAL? A,V?WALK /?CND146
EQUAL? A,V?TELL-ABOUT,V?ASK-ABOUT,V?ASK-FOR /?CND146
ZERO? I /?CND151
LOC I >I-LOC
ZERO? I-LOC /?CND151
FSET? I-LOC,FL-VEHICLE /?CCL152
FSET? I-LOC,FL-CONTAINER /?CCL152
FSET? I-LOC,FL-SURFACE /?CCL152
FSET? I-LOC,FL-ALIVE \?CND151
?CCL152: SET 'GL-NOW-PRSI?,TRUE-VALUE
GETP I-LOC,P?CONTFCN
CALL STACK,K-M-CONT >V
?CND151: ZERO? O /?CND160
LOC O >O-LOC
ZERO? O-LOC /?CND160
FSET? O-LOC,FL-VEHICLE /?CCL161
FSET? O-LOC,FL-CONTAINER /?CCL161
FSET? O-LOC,FL-SURFACE /?CCL161
FSET? O-LOC,FL-ALIVE \?CND160
?CCL161: SET 'GL-NOW-PRSI?,FALSE-VALUE
GETP O-LOC,P?CONTFCN
CALL STACK,K-M-CONT >V
?CND160: ZERO? I /?CND146
SET 'GL-NOW-PRSI?,TRUE-VALUE
GETP I,P?ACTION
CALL STACK >V
?CND146: ZERO? V \?CND171
ZERO? O /?CND171
EQUAL? A,V?WALK /?CND171
SET 'GL-NOW-PRSI?,FALSE-VALUE
GETP O,P?ACTION
CALL STACK >V
?CND171: ZERO? V \?CND176
GET ACTIONS,A
CALL STACK >V
?CND176: ZERO? V \?CND178
GETP W-LOC,P?ACTION
CALL STACK,K-M-END >V
?CND178: ZERO? GL-PRSI /?CND180
FSET? GL-PRSI,FL-LOSE-IDENTITY \?CND180
PUTP GL-PRSI,P?OBJ-NOUN,FALSE-VALUE
PUTP GL-PRSI,P?OBJ-ADJ,FALSE-VALUE
?CND180: ZERO? GL-PRSO /?CND184
FSET? GL-PRSO,FL-LOSE-IDENTITY \?CND184
PUTP GL-PRSO,P?OBJ-NOUN,FALSE-VALUE
PUTP GL-PRSO,P?OBJ-ADJ,FALSE-VALUE
?CND184: SET 'GL-PRSA,OA
SET 'GL-PRSO,OO
SET 'GL-PRSI,OI
SET 'GL-NOW-PRSI?,ONP
RETURN V
.FUNCT RT-SET-GL-PLACE-CUR
LOC GL-WINNER
FSET? STACK,FL-VEHICLE \?CCL3
LOC GL-WINNER
LOC STACK >GL-PLACE-CUR
RETURN GL-PLACE-CUR
?CCL3: LOC GL-WINNER >GL-PLACE-CUR
RETURN GL-PLACE-CUR
.FUNCT RT-PARSER,PTR,WRD,VAL,VERB,OF-FLAG,LEN,DIR,NW,LW,CNT,OWINNER,OMERGED,TMP1,?TMP2,?TMP1
?FCN: SET 'PTR,K-P-LEXSTART
SET 'GL-FUNNY-CLAUSE?,FALSE-VALUE
ZERO? GL-P-ORPH \?CND1
COPYT GL-P-ITBL,GL-P-OTBL,20
?CND1: COPYT GL-P-ITBL,0,20
SET 'GL-P-NAM,FALSE-VALUE
SET 'GL-P-ADJ,FALSE-VALUE
SET 'GL-P-XNAM,FALSE-VALUE
SET 'GL-P-XADJ,FALSE-VALUE
SET 'GL-P-DIR-WORD,FALSE-VALUE
ZERO? GL-P-ORPH \?CND3
PUT GL-P-NAMW,0,FALSE-VALUE
PUT GL-P-NAMW,1,FALSE-VALUE
PUT GL-P-ADJW,0,FALSE-VALUE
PUT GL-P-ADJW,1,FALSE-VALUE
PUT GL-P-OFW,0,FALSE-VALUE
PUT GL-P-OFW,1,FALSE-VALUE
?CND3: SET 'OMERGED,GL-P-MERGED
SET 'OWINNER,GL-WINNER
SET 'GL-P-MERGED,FALSE-VALUE
SET 'GL-P-END-ON-PREP,FALSE-VALUE
PUT GL-P-PRSO,K-P-MATCHLEN,0
PUT GL-P-PRSI,K-P-MATCHLEN,0
PUT GL-P-BUTS,K-P-MATCHLEN,0
ZERO? GL-P-QUOT \?CND5
EQUAL? GL-WINNER,CH-PLAYER /?CND5
SET 'GL-WINNER,CH-PLAYER
ICALL1 RT-SET-GL-PLACE-CUR
CALL1 RT-IS-LIT? >GL-NOW-LIT?
?CND5: ZERO? GL-RESERVE-PTR /?CCL11
SET 'PTR,GL-RESERVE-PTR
ICALL RT-STUFF,GL-P-P-LEX,GL-P-T-LEX
COPYT GL-P-RIBUF,GL-P-PIBUF,K-P-INBUF-SIZE
ZERO? GL-DESC-LEVEL /?CND12
EQUAL? CH-PLAYER,GL-WINNER \?CND12
CRLF
?CND12: SET 'GL-RESERVE-PTR,FALSE-VALUE
SET 'GL-P-CONT,FALSE-VALUE
JUMP ?CND9
?CCL11: ZERO? GL-P-CONT /?CCL17
SET 'PTR,GL-P-CONT
SET 'GL-P-CONT,FALSE-VALUE
ZERO? GL-DESC-LEVEL /?CND9
EQUAL? CH-PLAYER,GL-WINNER \?CND9
CRLF
JUMP ?CND9
?CCL17: SET 'GL-WINNER,CH-PLAYER
SET 'GL-P-QUOT,FALSE-VALUE
ICALL1 RT-SET-GL-PLACE-CUR
CALL1 RT-IS-LIT? >GL-NOW-LIT?
GET 0,8
BTST STACK,4 \?CND22
GET 0,8
BAND STACK,-5
PUT 0,8,STACK
ICALL1 RT-INIT-SCREEN
?CND22: ICALL1 RT-UPDATE-STATUS-LINE
ZERO? GL-WHERE-TO-PROMPT? /?CND24
CRLF
PRINTI """Where to, guv'nor?"""
CRLF
?CND24: ZERO? GL-WHERE-TO-ORPH? /?CND26
SET 'GL-WINNER,CH-PLAYER
ICALL RT-ORPHAN-VERB,W?DRIVE,ACT?DRIVE
?CND26: CRLF
PRINTC 62
PUTB GL-P-P-LEX,0,59
PUTB GL-P-PIBUF,1,0
READ GL-P-PIBUF,GL-P-P-LEX
?CND9: GETB GL-P-P-LEX,K-P-LEXWORDS >GL-P-LEN
GET GL-P-P-LEX,PTR
EQUAL? STACK,W?QUOTE,W?PERIOD,W?THEN /?CCL29
GET GL-P-P-LEX,PTR
EQUAL? STACK,W?PLEASE,W?SO \?CND28
?CCL29: ADD PTR,K-P-LEXELEN >PTR
DEC 'GL-P-LEN
?CND28: GET GL-P-P-LEX,PTR >TMP1
LESS? 1,GL-P-LEN \?CND32
GET GL-P-P-LEX,PTR
EQUAL? STACK,W?GO \?CND32
ADD PTR,K-P-LEXELEN
GET GL-P-P-LEX,STACK >NW
ZERO? NW /?CND32
GETB NW,6
BTST STACK,64 \?CND32
ADD PTR,K-P-LEXELEN >PTR
DEC 'GL-P-LEN
?CND32: ZERO? GL-P-LEN \?CND38
PRINTI "[What?]"
CRLF
RFALSE
?CND38: GET GL-P-P-LEX,PTR
EQUAL? STACK,W?UNDO \?CCL42
ICALL1 V-UNDO
RFALSE
?CCL42: ISAVE >GL-CAN-UNDO
EQUAL? GL-CAN-UNDO,2 \?CND40
ICALL1 V-REFRESH
SET 'SOUND-QUEUED?,FALSE-VALUE
ZERO? SOUND-ON? /?CND45
ICALL1 CHECK-LOOPING
?CND45: PRINTI "[UNDO completed.]"
CRLF
JUMP ?FCN
?CND40: GET GL-P-P-LEX,PTR
EQUAL? STACK,W?OOPS,W?O \?CCL49
ADD PTR,K-P-LEXELEN
GET GL-P-P-LEX,STACK
EQUAL? STACK,W?PERIOD,W?COMMA \?CND50
ADD PTR,K-P-LEXELEN >PTR
DEC 'GL-P-LEN
?CND50: GRTR? GL-P-LEN,1 /?CCL54
PRINTI "[You cannot use OOPS that way.]"
CRLF
RFALSE
?CCL54: GET GL-OOPS-TABLE,K-O-PTR
ZERO? STACK /?CCL56
GRTR? GL-P-LEN,2 \?CND57
PRINTI "[Only the first word after OOPS is used.]"
CRLF
?CND57: GET GL-OOPS-TABLE,K-O-PTR >?TMP1
ADD PTR,K-P-LEXELEN
GET GL-P-P-LEX,STACK
PUT GL-P-S-LEX,?TMP1,STACK
SET 'GL-WINNER,OWINNER
MUL PTR,K-P-LEXELEN
ADD STACK,6
GETB GL-P-P-LEX,STACK >?TMP2
MUL PTR,K-P-LEXELEN
ADD STACK,7
GETB GL-P-P-LEX,STACK >?TMP1
GET GL-OOPS-TABLE,K-O-PTR
MUL STACK,K-P-LEXELEN
ADD STACK,3
ICALL RT-INBUF-ADD,?TMP2,?TMP1,STACK
ICALL RT-STUFF,GL-P-P-LEX,GL-P-S-LEX
GETB GL-P-P-LEX,K-P-LEXWORDS >GL-P-LEN
GET GL-OOPS-TABLE,K-O-START >PTR
COPYT GL-OOPS-INBUF,GL-P-PIBUF,K-P-INBUF-SIZE
JUMP ?CND47
?CCL56: PUT GL-OOPS-TABLE,K-O-END,FALSE-VALUE
PRINTI "[There was no word to replace in that sentence.]"
CRLF
RFALSE
?CCL49: PUT GL-OOPS-TABLE,K-O-END,FALSE-VALUE
?CND47: GET GL-P-P-LEX,PTR
EQUAL? STACK,W?AGAIN,W?G \?CCL61
ZERO? GL-P-ORPH \?CTR63
ZERO? GL-P-GOOD /?CTR63
GETB GL-OOPS-INBUF,1
ZERO? STACK \?CCL64
?CTR63: PRINTI "[You cannot use AGAIN that way.]"
CRLF
RFALSE
?CCL64: GRTR? GL-P-LEN,1 \?CCL69
ADD PTR,K-P-LEXELEN
GET GL-P-P-LEX,STACK
EQUAL? STACK,W?PERIOD,W?COMMA,W?THEN /?CTR71
ADD PTR,K-P-LEXELEN
GET GL-P-P-LEX,STACK
EQUAL? STACK,W?AND \?CCL72
?CTR71: ADD PTR,4 >PTR
GETB GL-P-P-LEX,K-P-LEXWORDS
SUB STACK,2
PUTB GL-P-P-LEX,K-P-LEXWORDS,STACK
JUMP ?CND62
?CCL72: PRINT K-DONT-UNDERSTAND-MSG
CRLF
RFALSE
?CCL69: ADD PTR,K-P-LEXELEN >PTR
GETB GL-P-P-LEX,K-P-LEXWORDS
SUB STACK,1
PUTB GL-P-P-LEX,K-P-LEXWORDS,STACK
?CND62: GETB GL-P-P-LEX,K-P-LEXWORDS
GRTR? STACK,0 \?CCL77
ICALL RT-STUFF,GL-P-T-LEX,GL-P-P-LEX
COPYT GL-P-PIBUF,GL-P-RIBUF,K-P-INBUF-SIZE
SET 'GL-RESERVE-PTR,PTR
JUMP ?CND75
?CCL77: SET 'GL-RESERVE-PTR,FALSE-VALUE
?CND75: CALL2 RT-VISIBLE?,OWINNER
ZERO? STACK /?CCL80
SET 'GL-WINNER,OWINNER
SET 'GL-P-MERGED,OMERGED
COPYT GL-OOPS-INBUF,GL-P-PIBUF,K-P-INBUF-SIZE
ICALL RT-STUFF,GL-P-P-LEX,GL-P-S-LEX
SET 'CNT,-1
SET 'DIR,GL-AGAIN-DIR
COPYT GL-P-OTBL,GL-P-ITBL,20
JUMP ?CND59
?CCL80: ICALL2 RT-CTHEO-PRINT,OWINNER
ICALL2 RT-ISNT-ARENT-MSG,OWINNER
PRINTI "here anymore."
CRLF
RFALSE
?CCL61: ZERO? GL-P-ORPH \?CND81
SET 'GL-P-NUMBER,-1
?CND81: ICALL RT-STUFF,GL-P-S-LEX,GL-P-P-LEX
COPYT GL-P-PIBUF,GL-OOPS-INBUF,K-P-INBUF-SIZE
PUT GL-OOPS-TABLE,K-O-START,PTR
MUL 4,GL-P-LEN
PUT GL-OOPS-TABLE,K-O-LENGTH,STACK
GETB GL-P-P-LEX,K-P-LEXWORDS
MUL K-P-LEXELEN,STACK
ADD PTR,STACK
MUL 2,STACK >LEN
SUB LEN,1
GETB GL-P-P-LEX,STACK >?TMP1
SUB LEN,2
GETB GL-P-P-LEX,STACK
ADD ?TMP1,STACK
PUT GL-OOPS-TABLE,K-O-END,STACK
SET 'GL-RESERVE-PTR,FALSE-VALUE
SET 'LEN,GL-P-LEN
SET 'GL-P-DIR,FALSE-VALUE
SET 'GL-P-NCN,0
SET 'GL-P-GET-FLAGS,0
PUT GL-P-ITBL,K-P-VERBN,0
?PRG83: DLESS? 'GL-P-LEN,0 \?CCL87
SET 'GL-P-QUOT,FALSE-VALUE
JUMP ?CND59
?CCL87: GET GL-P-P-LEX,PTR >WRD
ZERO? WRD \?CTR88
CALL2 RT-NUMBER?,PTR >WRD
ZERO? WRD /?CCL89
?CTR88: ZERO? GL-P-LEN \?CCL94
SET 'NW,0
JUMP ?CND92
?CCL94: ADD PTR,K-P-LEXELEN
GET GL-P-P-LEX,STACK >NW
?CND92: EQUAL? WRD,W?TO \?CCL97
EQUAL? VERB,ACT?TELL,ACT?ASK \?CCL97
PUT GL-P-ITBL,K-P-VERB,ACT?TELL
SET 'WRD,W?QUOTE
JUMP ?CND95
?CCL97: EQUAL? WRD,W?THEN \?CCL101
GRTR? GL-P-LEN,0 \?CCL101
ZERO? VERB \?CCL101
ZERO? GL-P-QUOT \?CCL101
PUT GL-P-ITBL,K-P-VERB,ACT?TELL
PUT GL-P-ITBL,K-P-VERBN,0
SET 'WRD,W?QUOTE
SET 'GL-P-ORPH,FALSE-VALUE
JUMP ?CND95
?CCL101: EQUAL? WRD,W?PERIOD \?CND95
EQUAL? LW,W?MR,W?MRS,W?MISS /?CCL106
EQUAL? LW,W?DR \?CND95
?CCL106: DEC 'GL-P-NCN
ICALL RT-CHANGE-LEXV,PTR,LW,TRUE-VALUE
SET 'WRD,LW
SET 'LW,0
?CND95: EQUAL? WRD,W?THEN,W?PERIOD,W?QUOTE \?CCL113
EQUAL? WRD,W?QUOTE \?CND114
ZERO? GL-P-QUOT /?CCL118
SET 'GL-P-QUOT,FALSE-VALUE
JUMP ?CND114
?CCL118: SET 'GL-P-QUOT,TRUE-VALUE
?CND114: ZERO? GL-P-LEN /?PEN119
ADD PTR,K-P-LEXELEN >GL-P-CONT
?PEN119: PUTB GL-P-P-LEX,K-P-LEXWORDS,GL-P-LEN
JUMP ?CND59
?CCL113: CALL RT-WT?,WRD,16,3 >VAL
ZERO? VAL /?CCL122
EQUAL? VERB,FALSE-VALUE,ACT?WALK,ACT?GO \?CCL122
EQUAL? LEN,1 /?CTR121
EQUAL? LEN,2 \?PRD128
EQUAL? VERB,ACT?WALK,ACT?GO /?CTR121
?PRD128: EQUAL? NW,W?THEN,W?PERIOD,W?QUOTE \?PRD131
GRTR? LEN,1 /?CTR121
?PRD131: ZERO? GL-P-QUOT /?PRD134
EQUAL? LEN,2 \?PRD134
EQUAL? NW,W?QUOTE /?CTR121
?PRD134: GRTR? LEN,2 \?CCL122
EQUAL? NW,W?COMMA,W?AND \?CCL122
?CTR121: SET 'DIR,VAL
SET 'GL-P-DIR-WORD,WRD
EQUAL? NW,W?COMMA,W?AND \?CND140
ADD PTR,K-P-LEXELEN
ICALL RT-CHANGE-LEXV,STACK,W?THEN
?CND140: GRTR? LEN,2 /?CND85
SET 'GL-P-QUOT,FALSE-VALUE
JUMP ?CND59
?CCL122: CALL RT-WT?,WRD,64,1 >VAL
ZERO? VAL /?CCL145
ZERO? VERB \?CCL145
SET 'GL-P-PRSA-WORD,WRD
SET 'VERB,VAL
PUT GL-P-ITBL,K-P-VERB,VAL
PUT GL-P-ITBL,K-P-VERBN,GL-P-VTBL
PUT GL-P-VTBL,0,WRD
MUL PTR,2
ADD STACK,2 >TMP1
GETB GL-P-P-LEX,TMP1
PUTB GL-P-VTBL,2,STACK
ADD TMP1,1
GETB GL-P-P-LEX,STACK
PUTB GL-P-VTBL,3,STACK
JUMP ?CND85
?CCL145: CALL RT-WT?,WRD,8,0 >VAL
ZERO? VAL \?CTR148
EQUAL? WRD,W?A,W?EVERYTHING /?CTR148
EQUAL? WRD,W?BOTH,W?ALL /?CTR148
GETB WRD,6
BAND STACK,160
ZERO? STACK /?CCL149
?CTR148: GRTR? GL-P-LEN,1 \?CCL156
EQUAL? NW,W?OF \?CCL156
EQUAL? VERB,ACT?TAKE /?CCL156
ZERO? VAL \?CCL156
EQUAL? WRD,W?A /?CCL156
EQUAL? WRD,W?ALL,W?BOTH,W?EVERYTHING /?CCL156
PUT GL-P-OFW,GL-P-NCN,WRD
SET 'OF-FLAG,TRUE-VALUE
JUMP ?CND85
?CCL156: ZERO? VAL /?CCL164
ZERO? GL-P-LEN /?CTR163
EQUAL? NW,W?THEN,W?PERIOD \?CCL164
?CTR163: SET 'GL-P-END-ON-PREP,TRUE-VALUE
LESS? GL-P-NCN,2 \?CND85
PUT GL-P-ITBL,K-P-PREP1,VAL
PUT GL-P-ITBL,K-P-PREP1N,WRD
JUMP ?CND85
?CCL164: EQUAL? GL-P-NCN,2 \?CCL172
PRINTI "[There are too many nouns in that sentence.]"
CRLF
RFALSE
?CCL172: INC 'GL-P-NCN
CALL RT-CLAUSE,PTR,VAL,WRD >PTR
ZERO? PTR /FALSE
LESS? PTR,0 \?CND85
SET 'GL-P-QUOT,FALSE-VALUE
?CND59: PUT GL-OOPS-TABLE,K-O-PTR,FALSE-VALUE
ZERO? DIR /?CND191
SET 'GL-PRSA,V?WALK
SET 'GL-P-WALK-DIR,DIR
SET 'GL-AGAIN-DIR,DIR
SET 'GL-PRSO,DIR
SET 'GL-P-ORPH,FALSE-VALUE
RTRUE
?CCL149: EQUAL? WRD,W?OF \?CCL178
ZERO? OF-FLAG /?CTR180
EQUAL? NW,W?PERIOD,W?THEN \?CCL181
?CTR180: ICALL2 RT-DONT-KNOW-WORD-USE-MSG,PTR
RFALSE
?CCL181: SET 'OF-FLAG,FALSE-VALUE
JUMP ?CND85
?CCL178: GETB WRD,6
BTST STACK,4 /?CND85
EQUAL? WRD,W?MARX /?CND85
EQUAL? VERB,ACT?TELL \?CCL188
GETB WRD,6
BTST STACK,64 \?CCL188
ICALL1 RT-WAY-TO-TALK-MSG
RFALSE
?CCL188: ICALL2 RT-DONT-KNOW-WORD-USE-MSG,PTR
RFALSE
?CCL89: ICALL2 RT-DONT-KNOW-WORD-MSG,PTR
RFALSE
?CND85: SET 'LW,WRD
ADD PTR,K-P-LEXELEN >PTR
JUMP ?PRG83
?CND191: SET 'GL-P-WALK-DIR,FALSE-VALUE
SET 'GL-AGAIN-DIR,FALSE-VALUE
ZERO? GL-P-ORPH /?CND193
CALL1 RT-ORPHAN-MERGE
ZERO? STACK /?CND193
ZERO? GL-WHERE-TO-ORPH? \?CND193
SET 'GL-WINNER,OWINNER
?CND193: CALL1 RT-SYNTAX-CHECK
ZERO? STACK /FALSE
CALL1 RT-SNARF-OBJECTS
ZERO? STACK /FALSE
CALL1 RT-MANY-CHECK
ZERO? STACK /FALSE
GETB GL-P-SYNTAX,0
SHIFT STACK,-6 >TMP1
GRTR? TMP1,0 \TRUE
GETB GL-P-SYNTAX,K-P-SLOC1
CALL RT-ITAKE-CHECK,GL-P-PRSO,STACK,TRUE-VALUE
ZERO? STACK /FALSE
GRTR? TMP1,1 \TRUE
GETB GL-P-SYNTAX,K-P-SLOC2
CALL RT-ITAKE-CHECK,GL-P-PRSI,STACK
RSTACK
.FUNCT RT-WHICH-PRINT,TLEN,LEN,TBL,OBJ,RLEN
SET 'RLEN,LEN
PRINTI "Which"
ZERO? GL-P-ORPH \?CTR2
ZERO? GL-P-MERGED \?CTR2
ZERO? GL-P-AND /?CCL3
?CTR2: PRINTC 32
PRINTB GL-P-NAM
JUMP ?CND1
?CCL3: EQUAL? TBL,GL-P-PRSO \?CCL8
ICALL RT-CLAUSE-PRINT,K-P-NC1,K-P-NC1L,FALSE-VALUE
JUMP ?CND1
?CCL8: ICALL RT-CLAUSE-PRINT,K-P-NC2,K-P-NC2L,FALSE-VALUE
?CND1: PRINTI " do you mean,"
?PRG9: INC 'TLEN
GET TBL,TLEN >OBJ
PRINTC 32
ICALL2 RT-THEO-PRINT,OBJ
EQUAL? LEN,2 \?CCL13
EQUAL? RLEN,2 /?CND14
PRINTC 44
?CND14: PRINTI " or"
JUMP ?CND11
?CCL13: GRTR? LEN,2 \?CND11
PRINTC 44
?CND11: DLESS? 'LEN,1 \?PRG9
PRINTR "?"
.FUNCT RT-FIND-NOT-HERE,TBL,PRSO?,M-F,OBJ
CALL2 RT-MOBY-FIND,TBL >M-F
ZERO? M-F \?CCL3
PRINTI "[There is no"
ICALL2 RT-NOT-HERE-PRINT,PRSO?
PRINTR " in this story.]"
?CCL3: EQUAL? M-F,1 \?CCL5
ZERO? PRSO? /?CCL8
SET 'GL-PRSO,GL-P-MOBY-FOUND
RFALSE
?CCL8: SET 'GL-PRSI,GL-P-MOBY-FOUND
RFALSE
?CCL5: GRTR? M-F,1 \?CCL10
GET TBL,1 >OBJ
GETP OBJ,P?GENERIC
CALL STACK,TBL >OBJ
ZERO? OBJ /?CCL10
EQUAL? OBJ,TH-NOT-HERE-OBJECT /TRUE
ZERO? PRSO? /?CCL17
SET 'GL-PRSO,OBJ
RFALSE
?CCL17: SET 'GL-PRSI,OBJ
RFALSE
?CCL10: EQUAL? GL-PRSA,V?ASK-ABOUT,V?TELL-ABOUT,V?ASK-FOR /FALSE
EQUAL? GL-PRSA,V?SAY,V?DRIVE,V?CALL /FALSE
EQUAL? GL-PRSA,V?MAKE,V?WHO,V?WHAT /FALSE
EQUAL? GL-PRSA,V?WHERE,V?FIND,V?FOLLOW /FALSE
EQUAL? GL-PRSA,V?TELL,V?PASSWORD /FALSE
ZERO? PRSO? \?CCL26
ICALL1 RT-CYOU-MSG
PRINTI "would not find any"
ICALL2 RT-NOT-HERE-PRINT,PRSO?
PRINTR " there."
?CCL26: RETURN TH-NOT-HERE-OBJECT
.FUNCT RT-NOT-HERE-PRINT,PRSO?,?TMP1
ZERO? GL-P-ORPH \?CTR2
ZERO? GL-P-MERGED /?CCL3
?CTR2: ZERO? GL-P-XADJ /?CND6
PRINTC 32
PRINTB GL-P-XADJ
?CND6: ZERO? GL-P-XNAM /FALSE
PRINTC 32
PRINTB GL-P-XNAM
RTRUE
?CCL3: ZERO? PRSO? /?CCL12
GET GL-P-ITBL,K-P-NC1 >?TMP1
GET GL-P-ITBL,K-P-NC1L
CALL RT-BUFFER-PRINT,?TMP1,STACK,FALSE-VALUE
RSTACK
?CCL12: GET GL-P-ITBL,K-P-NC2 >?TMP1
GET GL-P-ITBL,K-P-NC2L
CALL RT-BUFFER-PRINT,?TMP1,STACK,FALSE-VALUE
RSTACK
.ENDI