stationfall/parser.zap
historicalsource 43e39b2ba0 Revision 107
2019-04-14 16:11:30 -04:00

1869 lines
39 KiB
Plaintext

.FUNCT THIS-IS-IT,OBJ
ZERO? OBJ /TRUE
EQUAL? PRSA,V?WALK \?PRD6
EQUAL? PRSO,OBJ /TRUE
?PRD6: EQUAL? OBJ,PROTAGONIST /TRUE
EQUAL? OBJ,NOT-HERE-OBJECT,ME,GLOBAL-ROOM /TRUE
FSET? OBJ,ACTORBIT /?CTR10
EQUAL? OBJ,OLIVER \?CCL11
?CTR10: SET 'P-HIM-OBJECT,OBJ
RETURN P-HIM-OBJECT
?CCL11: SET 'P-IT-OBJECT,OBJ
RETURN P-IT-OBJECT
.FUNCT PARSER,PTR=P-LEXSTART,WRD,VAL=0,VERB=0,OMERGED,OWINNER,OLEN,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 'OMERGED,P-MERGED
SET 'OWINNER,WINNER
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,PROTAGONIST /?CND8
SET 'WINNER,PROTAGONIST
LOC WINNER
FSET? STACK,VEHBIT /?CND12
LOC WINNER >HERE
?CND12: CALL LIT?,HERE >LIT
?CND8: ZERO? RESERVE-PTR /?CCL16
SET 'PTR,RESERVE-PTR
CALL STUFF,P-LEXV,RESERVE-LEXV
CALL INBUF-STUFF,P-INBUF,RESERVE-INBUF
ZERO? VERBOSITY /?CND17
EQUAL? PROTAGONIST,WINNER \?CND17
CRLF
?CND17: SET 'RESERVE-PTR,FALSE-VALUE
JUMP ?CND14
?CCL16: ZERO? P-CONT /?CCL22
SET 'PTR,P-CONT
ZERO? VERBOSITY /?CND23
ZERO? ELIMINATE-CR \?CND23
CRLF
?CND23: SET 'ELIMINATE-CR,FALSE-VALUE
JUMP ?CND14
?CCL22: SET 'WINNER,PROTAGONIST
SET 'QUOTE-FLAG,FALSE-VALUE
LOC WINNER
FSET? STACK,VEHBIT /?CND27
LOC WINNER >HERE
?CND27: CALL LIT?,HERE >LIT
ZERO? VERBOSITY /?CND29
CRLF
?CND29: PRINTC 62
GET OOPS-TABLE,O-PTR
ZERO? STACK \?CND31
PUT OOPS-TABLE,O-END,FALSE-VALUE
?CND31: READ P-INBUF,P-LEXV
GETB P-LEXV,P-LEXWORDS >OLEN
?CND14: GETB P-LEXV,P-LEXWORDS >P-LEN
ZERO? P-LEN \?CCL35
PRINTI "[I beg your pardon?]"
CRLF
RFALSE
?CCL35: GET P-LEXV,PTR
EQUAL? STACK,W?OOPS \?CCL37
ADD PTR,P-LEXELEN
GET P-LEXV,STACK
EQUAL? STACK,W?PERIOD,W?COMMA \?CND38
ADD PTR,P-LEXELEN >PTR
DEC 'P-LEN
?CND38: GRTR? P-LEN,1 /?CCL42
CALL CANT-USE-THAT-WAY,STR?6
RFALSE
?CCL42: GET OOPS-TABLE,O-PTR
ZERO? STACK /?CCL44
GRTR? P-LEN,2 \?CND45
PRINTI "[Warning: Only the first word after OOPS is used.]"
CRLF
?CND45: 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,P-LEXV,AGAIN-LEXV
GETB P-LEXV,P-LEXWORDS >P-LEN
GET OOPS-TABLE,O-START >PTR
CALL INBUF-STUFF,P-INBUF,OOPS-INBUF
JUMP ?CND33
?CCL44: PUT OOPS-TABLE,O-END,FALSE-VALUE
PRINTI "[There was no word to replace!]"
CRLF
RFALSE
?CCL37: ZERO? P-CONT \?CND33
PUT OOPS-TABLE,O-END,FALSE-VALUE
?CND33: SET 'P-CONT,FALSE-VALUE
GET P-LEXV,PTR
EQUAL? STACK,W?AGAIN,W?G \?CCL50
GETB OOPS-INBUF,1
ZERO? STACK \?CCL53
PRINTI "[What do you want to do again?]"
CRLF
RFALSE
?CCL53: ZERO? P-OFLAG /?CCL55
CALL CANT-USE-THAT-WAY,STR?7
RFALSE
?CCL55: ZERO? P-WON \?CCL57
PRINTI "[That would just repeat a mistake!]"
CRLF
RFALSE
?CCL57: EQUAL? OWINNER,PROTAGONIST /?CCL59
CALL VISIBLE?,OWINNER
ZERO? STACK \?CCL59
PRINTI "[You can't see "
PRINTD OWINNER
PRINTI " any more.]"
CRLF
RFALSE
?CCL59: GRTR? P-LEN,1 \?CCL63
ADD PTR,P-LEXELEN
GET P-LEXV,STACK
EQUAL? STACK,W?PERIOD,W?COMMA,W?THEN /?CTR65
ADD PTR,P-LEXELEN
GET P-LEXV,STACK
EQUAL? STACK,W?AND \?CCL66
?CTR65: ADD PTR,4 >PTR
GETB P-LEXV,P-LEXWORDS
SUB STACK,2
PUTB P-LEXV,P-LEXWORDS,STACK
JUMP ?CND51
?CCL66: CALL RECOGNIZE
RFALSE
?CCL63: ADD PTR,P-LEXELEN >PTR
GETB P-LEXV,P-LEXWORDS
SUB STACK,1
PUTB P-LEXV,P-LEXWORDS,STACK
?CND51: GETB P-LEXV,P-LEXWORDS
GRTR? STACK,0 \?CCL71
CALL STUFF,RESERVE-LEXV,P-LEXV
CALL INBUF-STUFF,RESERVE-INBUF,P-INBUF
SET 'RESERVE-PTR,PTR
JUMP ?CND69
?CCL71: SET 'RESERVE-PTR,FALSE-VALUE
?CND69: SET 'WINNER,OWINNER
SET 'P-MERGED,OMERGED
CALL INBUF-STUFF,P-INBUF,OOPS-INBUF
CALL STUFF,P-LEXV,AGAIN-LEXV
SET 'CNT,-1
SET 'DIR,AGAIN-DIR
?PRG72: IGRTR? 'CNT,P-ITBLLEN /?CND48
GET P-OTBL,CNT
PUT P-ITBL,CNT,STACK
JUMP ?PRG72
?CCL50: CALL STUFF,AGAIN-LEXV,P-LEXV
CALL INBUF-STUFF,OOPS-INBUF,P-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
GET OOPS-TABLE,O-END
ZERO? STACK \?CND77
SUB LEN,1
GETB P-LEXV,STACK >?TMP1
SUB LEN,2
GETB P-LEXV,STACK
ADD ?TMP1,STACK
PUT OOPS-TABLE,O-END,STACK
?CND77: SET 'RESERVE-PTR,FALSE-VALUE
SET 'LEN,P-LEN
SET 'P-NCN,0
SET 'P-GETFLAGS,0
?PRG79: DLESS? 'P-LEN,0 \?CCL83
SET 'QUOTE-FLAG,FALSE-VALUE
JUMP ?CND48
?CCL83: GET P-LEXV,PTR >WRD
CALL NAUGHTY-WORD?,WRD
ZERO? STACK \FALSE
GET P-LEXV,PTR >WRD
ZERO? WRD \?CTR86
CALL NUMBER?,PTR >WRD
ZERO? WRD /?CCL87
?CTR86: CALL NEXT-WORD,PTR >NW
EQUAL? WRD,W?TO \?CCL92
EQUAL? VERB,ACT?TELL,ACT?ASK \?CCL92
CALL WT?,NW,64,1
ZERO? STACK /?CCL92
PUT P-ITBL,P-VERB,ACT?TELL
SET 'WRD,W?QUOTE
JUMP ?CND90
?CCL92: EQUAL? WRD,W?THEN \?CND90
GRTR? P-LEN,0 \?CND90
ZERO? VERB \?CND90
ZERO? QUOTE-FLAG \?CND90
PUT P-ITBL,P-VERB,ACT?TELL
PUT P-ITBL,P-VERBN,0
SET 'WRD,W?QUOTE
?CND90: EQUAL? WRD,W?THEN,W?PERIOD /?CTR102
EQUAL? WRD,W?QUOTE \?CCL103
?CTR102: EQUAL? WRD,W?QUOTE \?CND106
ZERO? QUOTE-FLAG /?CCL110
SET 'QUOTE-FLAG,FALSE-VALUE
JUMP ?CND106
?CCL110: SET 'QUOTE-FLAG,TRUE-VALUE
?CND106: ZERO? P-LEN /?PEN111
ADD PTR,P-LEXELEN >P-CONT
?PEN111: PUTB P-LEXV,P-LEXWORDS,P-LEN
JUMP ?CND48
?CCL103: CALL WT?,WRD,16,3 >VAL
ZERO? VAL /?CCL114
EQUAL? VERB,FALSE-VALUE,ACT?WALK,ACT?GO \?CCL114
EQUAL? LEN,1 /?CTR113
EQUAL? LEN,2 \?PRD120
EQUAL? VERB,ACT?WALK,ACT?GO /?CTR113
?PRD120: EQUAL? NW,W?THEN,W?PERIOD,W?QUOTE \?PRD123
LESS? LEN,2 \?CTR113
?PRD123: ZERO? QUOTE-FLAG /?PRD126
EQUAL? LEN,2 \?PRD126
EQUAL? NW,W?QUOTE /?CTR113
?PRD126: GRTR? LEN,2 \?CCL114
EQUAL? NW,W?COMMA,W?AND \?CCL114
?CTR113: SET 'DIR,VAL
EQUAL? NW,W?COMMA,W?AND \?CND132
ADD PTR,P-LEXELEN
CALL CHANGE-LEXV,STACK,W?THEN
?CND132: GRTR? LEN,2 /?CND81
SET 'QUOTE-FLAG,FALSE-VALUE
JUMP ?CND48
?CCL114: CALL WT?,WRD,64,1 >VAL
ZERO? VAL /?CCL137
ZERO? VERB \?CCL137
ZERO? P-OFLAG \?CND140
SET 'P-PRSA-WORD,WRD
?CND140: 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 ?CND81
?CCL137: CALL WT?,WRD,8,0 >VAL
ZERO? VAL \?CTR142
EQUAL? WRD,W?ALL,W?ONE,W?BOTH /?CTR142
EQUAL? WRD,W?EVERYT /?CTR142
CALL WT?,WRD,32
ZERO? STACK \?CTR142
CALL WT?,WRD,128
ZERO? STACK /?CCL143
?CTR142: ZERO? VAL /?CND149
EQUAL? WRD,W?BACK \?CND149
EQUAL? VERB,ACT?HAND /?CND149
SET 'VAL,0
?CND149: GRTR? P-LEN,0 \?CCL155
EQUAL? NW,W?OF \?CCL155
ZERO? VAL \?CCL155
EQUAL? WRD,W?ALL,W?ONE,W?A /?CCL155
EQUAL? WRD,W?BOTH,W?EVERYT \?CND81
?CCL155: ZERO? VAL /?CCL162
ZERO? P-LEN /?CTR161
EQUAL? NW,W?THEN,W?PERIOD \?CCL162
?CTR161: SET 'P-END-ON-PREP,TRUE-VALUE
LESS? P-NCN,2 \?CND81
PUT P-ITBL,P-PREP1,VAL
PUT P-ITBL,P-PREP1N,WRD
JUMP ?CND81
?CCL162: EQUAL? P-NCN,2 \?CCL170
PRINTI "[There were too many nouns in that sentence.]"
CRLF
RFALSE
?CCL170: INC 'P-NCN
CALL CLAUSE,PTR,VAL,WRD >PTR
ZERO? PTR /FALSE
LESS? PTR,0 \?CND81
SET 'QUOTE-FLAG,FALSE-VALUE
?CND48: PUT OOPS-TABLE,O-PTR,FALSE-VALUE
ZERO? DIR /?CND181
SET 'PRSA,V?WALK
SET 'PRSO,DIR
SET 'P-OFLAG,FALSE-VALUE
SET 'P-WALK-DIR,DIR
SET 'AGAIN-DIR,DIR
RTRUE
?CCL143: CALL WT?,WRD,4
ZERO? STACK \?CND81
EQUAL? VERB,ACT?TELL \?CCL177
CALL WT?,WRD,64,1
ZERO? STACK /?CCL177
EQUAL? WINNER,PROTAGONIST \?CCL177
PRINTI "[The way to speak to other characters is described in the instruction manual section entitled ""Communicating With Infocom's Interactive Fiction.""]"
CRLF
RFALSE
?CCL177: CALL CANT-USE,PTR
RFALSE
?CCL87: CALL UNKNOWN-WORD,PTR
RFALSE
?CND81: SET 'LW,WRD
ADD PTR,P-LEXELEN >PTR
JUMP ?PRG79
?CND181: SET 'P-WALK-DIR,FALSE-VALUE
SET 'AGAIN-DIR,FALSE-VALUE
ZERO? P-OFLAG /?CND183
CALL ORPHAN-MERGE
?CND183: 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 CHANGE-LEXV,PTR,WRD,PTRS?=0,X,Y,Z
ZERO? PTRS? /?CND1
SUB PTR,P-LEXELEN
MUL 2,STACK
ADD 2,STACK >X
GETB P-LEXV,X >Y
MUL 2,PTR
ADD 2,STACK >Z
PUTB P-LEXV,Z,Y
PUTB AGAIN-LEXV,Z,Y
ADD 1,X
GETB P-LEXV,STACK >Y
MUL 2,PTR
ADD 3,STACK >Z
PUTB P-LEXV,Z,Y
PUTB AGAIN-LEXV,Z,Y
?CND1: PUT P-LEXV,PTR,WRD
PUT AGAIN-LEXV,PTR,WRD
RTRUE
.FUNCT STUFF,DEST,SRC,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,DEST,SRC,CNT=-1
?PRG1: IGRTR? 'CNT,P-INBUF-LENGTH /TRUE
GETB SRC,CNT
PUTB DEST,CNT,STACK
JUMP ?PRG1
.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
EQUAL? BIT,128 /TRUE
BAND TYP,P-P1BITS >TYP
EQUAL? TYP,B1 /?CND9
INC 'OFFS
?CND9: GETB PTR,OFFS
RSTACK
.FUNCT NEXT-WORD,PTR
ZERO? P-LEN /FALSE
ADD PTR,P-LEXELEN
GET P-LEXV,STACK
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
?PRG6: DLESS? 'P-LEN,0 \?CND8
ADD NUM,1 >?TMP1
MUL PTR,2
ADD P-LEXV,STACK
PUT P-ITBL,?TMP1,STACK
RETURN -1
?CND8: GET P-LEXV,PTR >WRD
CALL NAUGHTY-WORD?,WRD
ZERO? STACK \FALSE
ZERO? WRD \?CTR13
CALL NUMBER?,PTR >WRD
ZERO? WRD /?CCL14
?CTR13: CALL NEXT-WORD,PTR >NW
ZERO? FIRST?? /?CCL19
EQUAL? WRD,W?THE,W?A,W?AN /?CTR18
ZERO? VAL /?CCL19
CALL WT?,WRD,8
ZERO? STACK /?CCL19
CALL WT?,WRD,32
ZERO? STACK \?CCL19
?CTR18: GET P-ITBL,NUM
ADD STACK,4
PUT P-ITBL,NUM,STACK
JUMP ?CND10
?CCL19: EQUAL? WRD,W?AND,W?COMMA \?CCL28
SET 'ANDFLG,TRUE-VALUE
JUMP ?CND10
?CCL28: EQUAL? WRD,W?ALL,W?ONE,W?BOTH /?CTR29
EQUAL? WRD,W?EVERYT \?CCL30
?CTR29: EQUAL? NW,W?OF \?CND10
DEC 'P-LEN
ADD PTR,P-LEXELEN >PTR
JUMP ?CND10
?CCL30: EQUAL? WRD,W?THEN,W?PERIOD /?CTR35
CALL WT?,WRD,8
ZERO? STACK /?CCL36
GET P-ITBL,P-VERB
ZERO? STACK /?CCL36
ZERO? FIRST?? \?CCL36
?CTR35: INC 'P-LEN
ADD NUM,1 >?TMP1
MUL PTR,2
ADD P-LEXV,STACK
PUT P-ITBL,?TMP1,STACK
SUB PTR,P-LEXELEN
RSTACK
?CCL36: ZERO? ANDFLG /?CCL43
GET P-ITBL,P-VERB
ZERO? STACK \?CCL43
SUB PTR,4 >PTR
ADD PTR,2
CALL CHANGE-LEXV,STACK,W?THEN
ADD P-LEN,2 >P-LEN
JUMP ?CND10
?CCL43: CALL WT?,WRD,128
ZERO? STACK /?CCL47
GRTR? P-LEN,0 \?CCL50
EQUAL? NW,W?OF \?CCL50
EQUAL? WRD,W?ALL,W?EVERYT /?CCL50
EQUAL? WRD,W?ONE,W?BOTH \?CND10
?CCL50: CALL WT?,WRD,32,2
ZERO? STACK /?CCL55
ZERO? NW /?CCL55
EQUAL? NW,W?MY /?CCL55
CALL WT?,NW,128
ZERO? STACK \?PRD60
CALL WT?,NW,32
ZERO? STACK /?CCL55
?PRD60: GET P-ITBL,P-VERB
EQUAL? STACK,ACT?SHOW,ACT?HAND,ACT?FEED \?CND10
?CCL55: ZERO? ANDFLG \?CCL64
EQUAL? NW,W?BUT,W?EXCEPT /?CCL64
EQUAL? NW,W?AND,W?COMMA /?CCL64
ADD NUM,1 >?TMP1
ADD PTR,2
MUL STACK,2
ADD P-LEXV,STACK
PUT P-ITBL,?TMP1,STACK
RETURN PTR
?CCL64: SET 'ANDFLG,FALSE-VALUE
JUMP ?CND10
?CCL47: CALL WT?,WRD,32
ZERO? STACK \?CND10
CALL WT?,WRD,4
ZERO? STACK \?CND10
CALL WT?,WRD,8
ZERO? STACK \?CND10
CALL CANT-USE,PTR
RFALSE
?CCL14: CALL UNKNOWN-WORD,PTR
RFALSE
?CND10: SET 'LW,WRD
SET 'FIRST??,FALSE-VALUE
ADD PTR,P-LEXELEN >PTR
JUMP ?PRG6
.FUNCT NUMBER?,PTR,CNT,BPTR,CHR,SUM=0,CCTR,TMP,XPTR,?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
GRTR? SUM,6553 /FALSE
GETB P-INBUF,BPTR >CHR
LESS? CHR,58 \?CCL10
GRTR? CHR,47 \?CCL10
MUL SUM,10 >?TMP1
SUB CHR,48
ADD ?TMP1,STACK >SUM
JUMP ?CND8
?CCL10: EQUAL? CHR,35 \FALSE
?CND8: INC 'BPTR
JUMP ?PRG1
?REP2: CALL CHANGE-LEXV,PTR,W?NUMBER
ADD PTR,P-LEXELEN
GET P-LEXV,STACK
EQUAL? STACK,W?COMMA \?CND14
GRTR? P-LEN,1 \?CND14
ADD PTR,4 >XPTR
CALL AFTER-COMMA-CHECK,XPTR >TMP
ZERO? TMP /?CND14
MUL PTR,2
ADD STACK,2
GETB P-LEXV,STACK >CCTR
MUL XPTR,2
ADD STACK,2
GETB P-LEXV,STACK
ADD CCTR,STACK >CCTR
INC 'CCTR
MUL PTR,2
ADD STACK,2
PUTB P-LEXV,STACK,CCTR
EQUAL? TMP,1000 \?CND20
SET 'TMP,0
?CND20: MUL 1000,SUM
ADD STACK,TMP >SUM
SUB P-LEN,2 >CCTR
?PRG22: DLESS? 'CCTR,0 /?REP23
ADD PTR,P-LEXELEN >PTR
ADD PTR,4 >XPTR
GET P-LEXV,XPTR
CALL CHANGE-LEXV,PTR,STACK
MUL PTR,2
ADD STACK,2 >?TMP1
MUL XPTR,2
ADD STACK,2
GETB P-LEXV,STACK
PUTB P-LEXV,?TMP1,STACK
MUL PTR,2
ADD STACK,3 >?TMP1
MUL XPTR,2
ADD STACK,3
GETB P-LEXV,STACK
PUTB P-LEXV,?TMP1,STACK
JUMP ?PRG22
?REP23: SUB P-LEN,2 >P-LEN
GETB P-LEXV,P-LEXWORDS
SUB STACK,2
PUTB P-LEXV,P-LEXWORDS,STACK
?CND14: GRTR? SUM,10000 /FALSE
SET 'P-NUMBER,SUM
RETURN W?NUMBER
.FUNCT AFTER-COMMA-CHECK,PTR,CNT,BPTR,CCTR=0,CHR,SUM=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
IGRTR? 'CCTR,3 /?REP2
LESS? CHR,58 \FALSE
GRTR? CHR,47 \FALSE
MUL SUM,10 >?TMP1
SUB CHR,48
ADD ?TMP1,STACK >SUM
INC 'BPTR
JUMP ?PRG1
?REP2: EQUAL? CCTR,3 \FALSE
ZERO? SUM /?CTR16
RETURN SUM
?CTR16: RETURN 1000
.FUNCT ORPHAN-MERGE,CNT=-1,TEMP,VERB,BEG,END,ADJ=0,VRB=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 'VRB,TRUE-VALUE
SET 'ADJ,TRUE-VALUE
JUMP ?CND1
?CCL3: CALL WT?,WRD,32
ZERO? STACK /?CCL7
SET 'ADJ,TRUE-VALUE
JUMP ?CND1
?CCL7: 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 /?CCL13
ZERO? ADJ \?CCL13
GET P-OTBL,P-VERB
EQUAL? VERB,STACK \FALSE
?CCL13: EQUAL? P-NCN,2 /FALSE
GET P-OTBL,P-NC1
EQUAL? STACK,1 \?CCL20
GET P-ITBL,P-PREP1 >TEMP
GET P-OTBL,P-PREP1
EQUAL? TEMP,STACK /?CTR22
ZERO? TEMP \FALSE
?CTR22: ZERO? ADJ /?CCL28
ZERO? VRB \?CCL28
ADD P-LEXV,2
PUT P-OTBL,P-NC1,STACK
GET P-ITBL,P-NC1L
ZERO? STACK \?CND31
ADD P-LEXV,6
PUT P-ITBL,P-NC1L,STACK
?CND31: ZERO? P-NCN \?CND26
SET 'P-NCN,1
JUMP ?CND26
?CCL28: GET P-ITBL,P-NC1
PUT P-OTBL,P-NC1,STACK
?CND26: GET P-ITBL,P-NC1L
PUT P-OTBL,P-NC1L,STACK
JUMP ?CND11
?CCL20: GET P-OTBL,P-NC2
EQUAL? STACK,1 \?CCL36
GET P-ITBL,P-PREP1 >TEMP
GET P-OTBL,P-PREP2
EQUAL? TEMP,STACK /?CTR38
ZERO? TEMP \FALSE
?CTR38: ZERO? ADJ /?CND42
ZERO? VRB \?CND42
ADD P-LEXV,2
PUT P-ITBL,P-NC1,STACK
GET P-ITBL,P-NC1L
ZERO? STACK \?CND42
ADD P-LEXV,6
PUT P-ITBL,P-NC1L,STACK
?CND42: 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 ?CND11
?CCL36: ZERO? P-ACLAUSE /?CND11
EQUAL? P-NCN,1 /?CCL51
ZERO? ADJ \?CCL51
SET 'P-ACLAUSE,FALSE-VALUE
RFALSE
?CCL51: GET P-ITBL,P-NC1 >BEG
ZERO? ADJ /?CND54
ADD P-LEXV,2 >BEG
SET 'ADJ,FALSE-VALUE
?CND54: GET P-ITBL,P-NC1L >END
?PRG56: GET BEG,0 >WRD
EQUAL? BEG,END \?CCL60
ZERO? ADJ /?CCL63
CALL CLAUSE-WIN,ADJ
JUMP ?CND11
?CCL63: SET 'P-ACLAUSE,FALSE-VALUE
RFALSE
?CCL60: EQUAL? WRD,W?ALL,W?EVERYT,W?ONE /?CTR64
EQUAL? WRD,W?BOTH /?CTR64
GETB WRD,P-PSOFF
BTST STACK,32 \?CCL65
CALL ADJ-CHECK,WRD,ADJ,ADJ
ZERO? STACK /?CCL65
?CTR64: SET 'ADJ,WRD
?CND58: ADD BEG,P-WORDLEN >BEG
ZERO? END \?PRG56
SET 'END,BEG
SET 'P-NCN,1
SUB BEG,4
PUT P-ITBL,P-NC1,STACK
PUT P-ITBL,P-NC1L,BEG
JUMP ?PRG56
?CCL65: EQUAL? WRD,W?ONE \?CCL72
CALL CLAUSE-WIN,ADJ
JUMP ?CND11
?CCL72: GETB WRD,P-PSOFF
BTST STACK,128 \?CND58
EQUAL? WRD,P-ANAM \?CCL76
CALL CLAUSE-WIN,ADJ
JUMP ?CND11
?CCL76: CALL CLAUSE-WIN
?CND11: 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
?PRG79: IGRTR? 'CNT,P-ITBLLEN \?CCL83
SET 'P-MERGED,TRUE-VALUE
RTRUE
?CCL83: GET P-OTBL,CNT
PUT P-ITBL,CNT,STACK
JUMP ?PRG79
.FUNCT CLAUSE-WIN,ADJ=0
ZERO? ADJ /?CCL3
GET P-OTBL,P-VERB
PUT P-ITBL,P-VERB,STACK
JUMP ?CND1
?CCL3: SET 'ADJ,TRUE-VALUE
?CND1: PUT P-CCTBL,CC-SBPTR,P-ACLAUSE
ADD P-ACLAUSE,1
PUT P-CCTBL,CC-SEPTR,STACK
EQUAL? P-ACLAUSE,P-NC1 \?CCL6
PUT P-CCTBL,CC-OCLAUSE,P-OCL1
JUMP ?CND4
?CCL6: PUT P-CCTBL,CC-OCLAUSE,P-OCL2
?CND4: CALL CLAUSE-COPY,P-OTBL,P-OTBL,ADJ
GET P-OTBL,P-NC2
ZERO? STACK /?PEN7
SET 'P-NCN,2
?PEN7: 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
ZERO? P-OFLAG /?CND1
PUT OOPS-TABLE,O-END,0
?CND1: PUT OOPS-TABLE,O-PTR,PTR
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
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
PRINTR """ in a way that I don't understand.]"
.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 "[There was no verb in that sentence!]"
CRLF
RFALSE
?CND1: SUB 255,VERB
GET VERBS,STACK >SYN
GETB SYN,0 >LEN
INC 'SYN
?PRG3: GETB SYN,P-SBITS
BAND STACK,P-SONUMS >NUM
GRTR? P-NCN,NUM /?CND5
LESS? NUM,1 /?CCL9
ZERO? P-NCN \?CCL9
GET P-ITBL,P-PREP1 >PREP
ZERO? PREP /?CTR8
GETB SYN,P-SPREP1
EQUAL? PREP,STACK \?CCL9
?CTR8: SET 'DRIVE1,SYN
JUMP ?CND5
?CCL9: GETB SYN,P-SPREP1 >?TMP1
GET P-ITBL,P-PREP1
EQUAL? ?TMP1,STACK \?CND5
EQUAL? NUM,2 \?CCL18
EQUAL? P-NCN,1 \?CCL18
SET 'DRIVE2,SYN
?CND5: DLESS? 'LEN,1 \?CCL24
ZERO? DRIVE1 \?REP4
ZERO? DRIVE2 \?REP4
CALL RECOGNIZE
RFALSE
?CCL18: GETB SYN,P-SPREP2 >?TMP1
GET P-ITBL,P-PREP2
EQUAL? ?TMP1,STACK \?CND5
CALL SYNTAX-FOUND,SYN
RTRUE
?CCL24: ADD SYN,P-SYNLEN >SYN
JUMP ?PRG3
?REP4: ZERO? DRIVE1 /?CCL32
GETB DRIVE1,P-SFWIM1 >?TMP2
GETB DRIVE1,P-SLOC1 >?TMP1
GETB DRIVE1,P-SPREP1
CALL GWIM,?TMP2,?TMP1,STACK >OBJ
ZERO? OBJ /?CCL32
PUT P-PRSO,P-MATCHLEN,1
PUT P-PRSO,1,OBJ
CALL SYNTAX-FOUND,DRIVE1
RSTACK
?CCL32: ZERO? DRIVE2 /?CCL36
GETB DRIVE2,P-SFWIM2 >?TMP2
GETB DRIVE2,P-SLOC2 >?TMP1
GETB DRIVE2,P-SPREP2
CALL GWIM,?TMP2,?TMP1,STACK >OBJ
ZERO? OBJ /?CCL36
PUT P-PRSI,P-MATCHLEN,1
PUT P-PRSI,1,OBJ
CALL SYNTAX-FOUND,DRIVE2
RSTACK
?CCL36: EQUAL? WINNER,PROTAGONIST \?CCL41
CALL ORPHAN,DRIVE1,DRIVE2
PRINTI "[Wh"
JUMP ?CND39
?CCL41: PRINTI "[Your command was not complete. Next time, type wh"
?CND39: EQUAL? VERB,ACT?WALK,ACT?GO \?CCL44
PRINTI "ere"
JUMP ?CND42
?CCL44: ZERO? DRIVE1 /?PRD48
GETB DRIVE1,P-SFWIM1
EQUAL? STACK,ACTORBIT /?CTR45
?PRD48: ZERO? DRIVE2 /?CCL46
GETB DRIVE2,P-SFWIM2
EQUAL? STACK,ACTORBIT \?CCL46
?CTR45: PRINTI "om"
JUMP ?CND42
?CCL46: PRINTI "at"
?CND42: EQUAL? WINNER,PROTAGONIST \?CCL55
PRINTI " do you want to "
JUMP ?CND53
?CCL55: PRINTI " you want"
CALL TPRINT,WINNER
PRINTI " to "
?CND53: CALL VERB-PRINT
SET 'P-OFLAG,FALSE-VALUE
ZERO? DRIVE2 /?CND56
SET 'PREP,P-MERGED
SET 'P-MERGED,FALSE-VALUE
CALL CLAUSE-PRINT,P-NC1,P-NC1L
SET 'P-MERGED,PREP
?CND56: ZERO? DRIVE1 /?CCL60
GETB DRIVE1,P-SPREP1
JUMP ?CND58
?CCL60: GETB DRIVE2,P-SPREP2
?CND58: CALL PREP-PRINT,STACK
EQUAL? WINNER,PROTAGONIST \?CCL63
SET 'P-OFLAG,TRUE-VALUE
PRINTI "?]"
CRLF
RFALSE
?CCL63: SET 'P-OFLAG,FALSE-VALUE
PRINTI ".]"
CRLF
RFALSE
.FUNCT VERB-PRINT,TMP,?TMP1
GET P-ITBL,P-VERBN >TMP
ZERO? TMP \?CCL3
PRINTI "tell"
RTRUE
?CCL3: EQUAL? TMP,W?ZZMGCK \?CCL5
PRINTI "answer"
RTRUE
?CCL5: GETB TMP,2
ZERO? STACK \?CCL7
GET TMP,0
PRINTB STACK
RTRUE
?CCL7: GETB TMP,2 >?TMP1
GETB TMP,3
CALL WORD-PRINT,?TMP1,STACK
PUTB TMP,2,0
RTRUE
.FUNCT ORPHAN,D1,D2,CNT=-1
ZERO? P-MERGED \?CND1
PUT P-OCL1,P-MATCHLEN,0
PUT P-OCL2,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-OCLAUSE,P-OCL2
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-OCLAUSE,P-OCL1
CALL CLAUSE-COPY,P-ITBL,P-OTBL
?CND10: ZERO? D1 /?CCL14
GETB D1,P-SPREP1
PUT P-OTBL,P-PREP1,STACK
PUT P-OTBL,P-NC1,1
RTRUE
?CCL14: 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 /?CCL8
SET 'NOSP,FALSE-VALUE
JUMP ?CND6
?CCL8: PRINTC 32
?CND6: GET BEG,0 >WRD
EQUAL? WRD,W?PERIOD \?CCL11
SET 'NOSP,TRUE-VALUE
JUMP ?CND3
?CCL11: EQUAL? WRD,W?ME,W?MYSELF \?CCL13
PRINTD ME
SET 'PN,TRUE-VALUE
JUMP ?CND3
?CCL13: CALL NAME?,WRD
ZERO? STACK \?CTR14
EQUAL? WRD,W?THERMOS \?CCL15
?CTR14: CALL CAPITALIZE,BEG
SET 'PN,TRUE-VALUE
JUMP ?CND3
?CCL15: ZERO? FIRST?? /?CND18
ZERO? PN \?CND18
ZERO? CP /?CND18
EQUAL? WRD,W?MY /?CND18
PRINTI "the "
?CND18: ZERO? P-OFLAG \?CTR25
ZERO? P-MERGED /?CCL26
?CTR25: PRINTB WRD
JUMP ?CND24
?CCL26: EQUAL? WRD,W?IT,W?THEM \?CCL30
CALL ACCESSIBLE?,P-IT-OBJECT
ZERO? STACK /?CCL30
PRINTD P-IT-OBJECT
JUMP ?CND24
?CCL30: EQUAL? WRD,W?HIM,W?HIMSELF,W?HER /?PRD36
EQUAL? WRD,W?HERSELF \?CCL34
?PRD36: CALL ACCESSIBLE?,P-HIM-OBJECT
ZERO? STACK /?CCL34
PRINTD P-HIM-OBJECT
JUMP ?CND24
?CCL34: GETB BEG,2 >?TMP1
GETB BEG,3
CALL WORD-PRINT,?TMP1,STACK
?CND24: SET 'FIRST??,FALSE-VALUE
?CND3: ADD BEG,P-WORDLEN >BEG
JUMP ?PRG1
.FUNCT NAME?,WRD
EQUAL? WRD,W?FLOYD,W?PLATO,W?OLIVER /TRUE
RFALSE
.FUNCT CAPITALIZE,PTR,?TMP1
ZERO? P-OFLAG \?CTR2
ZERO? P-MERGED /?CCL3
?CTR2: GET PTR,0
PRINTB STACK
RTRUE
?CCL3: 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
PRINTC 32
EQUAL? PREP,PR?THROUGH \?CCL6
PRINTI "through"
RTRUE
?CCL6: CALL PREP-FIND,PREP >WRD
PRINTB WRD
RTRUE
.FUNCT CLAUSE-COPY,SRC,DEST,INSRT=0,OCL,BEG,END,BB,EE,OBEG,CNT,B,E
GET P-CCTBL,CC-SBPTR >BB
GET P-CCTBL,CC-SEPTR >EE
GET P-CCTBL,CC-OCLAUSE >OCL
GET SRC,BB >BEG
GET SRC,EE >END
GET OCL,P-MATCHLEN >OBEG
?PRG1: EQUAL? BEG,END /?REP2
ZERO? INSRT /?CCL7
GET BEG,0
EQUAL? P-ANAM,STACK \?CCL7
EQUAL? INSRT,TRUE-VALUE \?CCL12
GET P-ITBL,P-NC1 >B
GET P-ITBL,P-NC1L >E
?PRG13: EQUAL? B,E /?CND5
GET B,0
CALL CLAUSE-ADD,STACK
ADD B,P-WORDLEN >B
JUMP ?PRG13
?CCL12: GET OCL,1
EQUAL? INSRT,STACK /?CND5
CALL CLAUSE-ADD,INSRT
GET BEG,0
CALL CLAUSE-ADD,STACK
JUMP ?CND5
?CCL7: GET BEG,0
CALL CLAUSE-ADD,STACK
?CND5: ADD BEG,P-WORDLEN >BEG
JUMP ?PRG1
?REP2: EQUAL? SRC,DEST \?CND18
GRTR? OBEG,0 \?CND18
GET OCL,P-MATCHLEN
SUB STACK,OBEG >CNT
GRTR? CNT,0 \?CND18
PUT OCL,P-MATCHLEN,0
INC 'OBEG
?PRG23: GET OCL,OBEG
CALL CLAUSE-ADD,STACK
SUB CNT,2 >CNT
ZERO? CNT /?REP24
ADD OBEG,2 >OBEG
JUMP ?PRG23
?REP24: SET 'OBEG,0
?CND18: MUL OBEG,P-LEXELEN
ADD STACK,2
ADD OCL,STACK
PUT DEST,BB,STACK
GET OCL,P-MATCHLEN
MUL STACK,P-LEXELEN
ADD STACK,2
ADD OCL,STACK
PUT DEST,EE,STACK
RTRUE
.FUNCT CLAUSE-ADD,WRD,OCL,PTR
GET P-CCTBL,CC-OCLAUSE >OCL
GET OCL,P-MATCHLEN
ADD STACK,2 >PTR
SUB PTR,1
PUT OCL,STACK,WRD
PUT OCL,PTR,0
PUT OCL,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 91
ZERO? PREP /?CND9
ZERO? P-END-ON-PREP \?CND9
CALL PREP-FIND,PREP >PREP
PRINTB PREP
EQUAL? PREP,W?OUT \?CND13
PRINTI " of"
?CND13: FSET? OBJ,NARTICLEBIT /?CCL17
PRINTI " the "
JUMP ?CND9
?CCL17: PRINTC 32
?CND9: PRINTD OBJ
PRINTC 93
CRLF
RETURN OBJ
?CCL5: SET 'P-GWIMBIT,0
RFALSE
.FUNCT SNARF-OBJECTS,PTR
GET P-ITBL,P-NC1 >PTR
ZERO? PTR /?CND1
SET 'P-PHR,0
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
SET 'P-PHR,1
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 \?CCL15
CALL BUT-MERGE,P-PRSO >P-PRSO
RTRUE
?CCL15: 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 P-BUTS,P-MATCHLEN,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,W?BOTH,W?EVERYT \?CCL18
CALL MANY-CHECK,P-PHR
ZERO? STACK /FALSE
SET 'P-GETFLAGS,P-ALL
EQUAL? NW,W?OF \?CND5
ADD PTR,P-WORDLEN >PTR
JUMP ?CND5
?CCL18: CALL NAUGHTY-WORD?,WRD
ZERO? STACK \FALSE
EQUAL? WRD,W?BUT,W?EXCEPT \?CCL26
ZERO? BUT /?PRD31
PUSH BUT
JUMP ?PEN29
?PRD31: PUSH TBL
?PEN29: CALL GET-OBJECT,STACK
ZERO? STACK /FALSE
SET 'BUT,P-BUTS
PUT BUT,P-MATCHLEN,0
JUMP ?CND5
?CCL26: EQUAL? WRD,W?A,W?ONE \?CCL33
ZERO? P-ADJ \?CCL36
SET 'P-GETFLAGS,P-ONE
EQUAL? NW,W?OF \?CND5
ADD PTR,P-WORDLEN >PTR
JUMP ?CND5
?CCL36: SET 'P-NAM,P-ONEOBJ
ZERO? BUT /?PRD43
PUSH BUT
JUMP ?PEN41
?PRD43: PUSH TBL
?PEN41: CALL GET-OBJECT,STACK
ZERO? STACK /FALSE
ZERO? NW \?CND5
RTRUE
?CCL33: EQUAL? WRD,W?AND,W?COMMA \?CCL47
EQUAL? NW,W?AND,W?COMMA /?CCL47
SET 'P-AND,TRUE-VALUE
ZERO? BUT /?PRD54
PUSH BUT
JUMP ?PEN52
?PRD54: PUSH TBL
?PEN52: CALL GET-OBJECT,STACK
ZERO? STACK \?CND5
RFALSE
?CCL47: CALL WT?,WRD,4
ZERO? STACK \?CND5
EQUAL? WRD,W?AND,W?COMMA /?CND5
EQUAL? WRD,W?OF \?CCL58
ZERO? P-GETFLAGS \?CND5
SET 'P-GETFLAGS,P-INHIBIT
JUMP ?CND5
?CCL58: CALL WT?,WRD,32,2 >WV
ZERO? WV /?CCL62
CALL ADJ-CHECK,WRD,P-ADJ,P-ADJN
ZERO? STACK /?CCL62
EQUAL? NW,W?OF /?CCL62
SET 'P-ADJ,WV
SET 'P-ADJN,WRD
JUMP ?CND5
?CCL62: 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 NAUGHTY-WORD?,WORD
EQUAL? WORD,W?ASS,W?ASSHOLE,W?BITCH /?CTR2
EQUAL? WORD,W?BASTARD,W?COCK,W?COCKSU /?CTR2
EQUAL? WORD,W?CUNT,W?DAMN,W?DAMNED /?CTR2
EQUAL? WORD,W?FUCK,W?FUCKED,W?FUCKING /?CTR2
EQUAL? WORD,W?SHIT,W?SHITHEAD,W?SHITTY /?CTR2
EQUAL? WORD,W?TROT,W?KRIP,W?MEGAKRIP /?CTR2
EQUAL? WORD,W?TROTTING \FALSE
?CTR2: PRINTR "Such language from a Lieutenant in the Stellar Patrol!"
.FUNCT ADJ-CHECK,WRD,ADJ,ADJN
ZERO? ADJ /TRUE
EQUAL? WRD,W?INNER,W?OUTER,W?LARGE /TRUE
EQUAL? WRD,W?SMALL,W?MEDIUM,W?TWELVE /TRUE
EQUAL? WRD,W?TWENTY,W?PROCESSING,W?DISPEN /TRUE
RFALSE
.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 /?CCL9
SET 'P-NAM,P-ADJN
SET 'P-ADJ,FALSE-VALUE
SET 'P-ADJN,FALSE-VALUE
JUMP ?CND3
?CCL9: CALL WT?,P-ADJN,16,3 >BITS
ZERO? BITS /?CND3
SET 'P-DIRECTION,BITS
?CND3: ZERO? P-NAM \?CND11
ZERO? P-ADJ \?CND11
EQUAL? P-GETFLAGS,P-ALL /?CND11
ZERO? P-GWIMBIT \?CND11
ZERO? VRB /FALSE
PRINT NOUN-MISSING
RFALSE
?CND11: 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 \?CTR29
EQUAL? PRSA,V?TELL \?CCL30
?CTR29: FCLEAR WINNER,OPENBIT
CALL DO-SL,HERE,SOG,SIR
FSET WINNER,OPENBIT
JUMP ?CND28
?CCL30: LOC WINNER
FSET? STACK,VEHBIT \?CND28
LOC WINNER
CALL THIS-IT?,STACK
ZERO? STACK /?CND28
LOC WINNER
CALL OBJ-FOUND,STACK,TBL
?CND28: CALL DO-SL,WINNER,SH,SC
?CND25: GET TBL,P-MATCHLEN
SUB STACK,TLEN >LEN
BTST P-GETFLAGS,P-ALL /?CND36
EQUAL? P-GETFLAGS,P-ALL /?CCL39
GRTR? LEN,1 /?CTR38
ZERO? LEN \?CCL39
EQUAL? P-SLOCBITS,-1 /?CCL39
?CTR38: EQUAL? P-SLOCBITS,-1 \?CCL48
SET 'P-SLOCBITS,XBITS
SET 'OLEN,LEN
GET TBL,P-MATCHLEN
SUB STACK,LEN
PUT TBL,P-MATCHLEN,STACK
JUMP ?PRG23
?CCL48: CALL PUT-ADJ-NAM
ZERO? LEN \?CND49
SET 'LEN,OLEN
?CND49: ZERO? P-NAM /?CCL53
ADD TLEN,1
GET TBL,STACK >OBJ
ZERO? OBJ /?CCL53
GETP OBJ,P?GENERIC
CALL STACK >OBJ
ZERO? OBJ /?CCL53
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
?CCL53: ZERO? VRB /?CCL60
EQUAL? WINNER,PROTAGONIST /?CCL60
CALL WHICH-PRINT,TLEN,LEN,TBL
SET 'P-NAM,FALSE-VALUE
SET 'P-ADJ,FALSE-VALUE
RFALSE
?CCL60: ZERO? VRB /?CCL64
ZERO? P-NAM /?CCL64
CALL WHICH-PRINT,TLEN,LEN,TBL
EQUAL? TBL,P-PRSO \?CCL69
SET 'P-ACLAUSE,P-NC1
JUMP ?CND67
?CCL69: SET 'P-ACLAUSE,P-NC2
?CND67: SET 'P-AADJ,P-ADJ
SET 'P-ANAM,P-NAM
CALL ORPHAN,FALSE-VALUE,FALSE-VALUE
SET 'P-OFLAG,TRUE-VALUE
JUMP ?CND51
?CCL64: ZERO? VRB /?CND51
PRINT NOUN-MISSING
?CND51: SET 'P-NAM,FALSE-VALUE
SET 'P-ADJ,FALSE-VALUE
RFALSE
?CCL39: ZERO? LEN \?CCL72
ZERO? GCHECK /?CCL72
CALL PUT-ADJ-NAM
ZERO? VRB /?CND75
SET 'P-SLOCBITS,XBITS
ZERO? LIT \?CTR78
EQUAL? PRSA,V?TELL,V?WHERE,V?WHAT \?CCL79
?CTR78: 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
?CCL79: PRINT TOO-DARK
CRLF
?CND75: SET 'P-NAM,FALSE-VALUE
SET 'P-ADJ,FALSE-VALUE
RFALSE
?CCL72: ZERO? LEN \?CND36
SET 'GCHECK,TRUE-VALUE
JUMP ?PRG23
?CND36: SET 'P-SLOCBITS,XBITS
CALL PUT-ADJ-NAM
SET 'P-NAM,FALSE-VALUE
SET 'P-ADJ,FALSE-VALUE
RTRUE
.FUNCT PUT-ADJ-NAM
EQUAL? P-NAM,W?IT /FALSE
PUT P-NAMW,P-PHR,P-NAM
PUT P-ADJW,P-PHR,P-ADJ
RTRUE
.FUNCT MOBY-FIND,TBL,OBJ=1,LEN,FOO,NAM,ADJ
SET 'NAM,P-NAM
SET 'ADJ,P-ADJ
SET 'P-NAM,P-XNAM
SET 'P-ADJ,P-XADJ
PUT TBL,P-MATCHLEN,0
?PRG3: IN? OBJ,ROOMS /?CND5
CALL THIS-IT?,OBJ >FOO
ZERO? FOO /?CND5
CALL OBJ-FOUND,OBJ,TBL >FOO
?CND5: IGRTR? 'OBJ,LAST-OBJECT \?PRG3
GET TBL,P-MATCHLEN >LEN
EQUAL? LEN,1 \?CND11
GET TBL,1 >P-MOBY-FOUND
?CND11: SET 'P-NAM,NAM
SET 'P-ADJ,ADJ
RETURN LEN
.FUNCT WHICH-PRINT,TLEN,LEN,TBL,OBJ,RLEN
ZERO? LEN \?CND1
CALL REFERRING
RTRUE
?CND1: SET 'RLEN,LEN
EQUAL? WINNER,PROTAGONIST /?CCL5
PRINTI """I don't understand wh"
EQUAL? P-ADJ,A?YOUR,A?MY,A?PURPOS \?CCL8
PRINTR "at you mean!"""
?CCL8: PRINTI "ether you mean "
JUMP ?PRG22
?CCL5: PRINTI "[Which"
ZERO? P-OFLAG \?CTR10
ZERO? P-MERGED \?CTR10
ZERO? P-AND /?CCL11
?CTR10: PRINTC 32
PRINTB P-NAM
JUMP ?CND9
?CCL11: EQUAL? TBL,P-PRSO \?CCL16
CALL CLAUSE-PRINT,P-NC1,P-NC1L,FALSE-VALUE
JUMP ?CND9
?CCL16: CALL CLAUSE-PRINT,P-NC2,P-NC2L,FALSE-VALUE
?CND9: PRINTI " do you mean"
EQUAL? HERE,ROBOT-POOL \?CCL19
EQUAL? P-NAM,W?ROBOT \?CCL19
PRINTR "?]"
?CCL19: PRINTI ", "
?PRG22: INC 'TLEN
GET TBL,TLEN >OBJ
FSET? OBJ,NARTICLEBIT /?CND24
PRINTI "the "
?CND24: PRINTD OBJ
EQUAL? LEN,2 \?CCL28
EQUAL? RLEN,2 /?CND29
PRINTC 44
?CND29: PRINTI " or "
JUMP ?CND26
?CCL28: GRTR? LEN,2 \?CND26
PRINTI ", "
?CND26: DLESS? 'LEN,1 \?PRG22
EQUAL? WINNER,PROTAGONIST /?CCL36
PRINTR "."""
?CCL36: 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
ZERO? STACK /?CND5
CALL OBJ-FOUND,OBJ,TBL
?CND5: IGRTR? 'CNT,RMGL \?PRG3
?CND1: GETP HERE,P?THINGS >RMG
ZERO? RMG /?CND9
GET RMG,0 >RMGL
SET 'CNT,0
?PRG11: ZERO? P-NAM /?CCL14
ADD CNT,1
GET RMG,STACK
EQUAL? P-NAM,STACK \?CND13
?CCL14: ZERO? P-ADJ /?CCL17
ADD CNT,2
GET RMG,STACK
CALL WT?,STACK,32,2
EQUAL? P-ADJ,STACK \?CND13
?CCL17: ZERO? P-NAM \?CCL20
ZERO? P-ADJ /?CND13
?CCL20: SET 'LAST-PSEUDO-LOC,HERE
ADD CNT,3
GET RMG,STACK
PUTP PSEUDO-OBJECT,P?ACTION,STACK
GETPT PSEUDO-OBJECT,P?ACTION
SUB STACK,5 >FOO
ADD CNT,1
GET RMG,STACK >RMG
GET RMG,0
PUT FOO,0,STACK
GET RMG,1
PUT FOO,1,STACK
CALL OBJ-FOUND,PSEUDO-OBJECT,TBL
JUMP ?CND9
?CND13: ADD CNT,3 >CNT
LESS? 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
RETURN P-SLOCBITS
.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
ZERO? STACK /?CND6
CALL OBJ-FOUND,OBJ,TBL
?CND6: EQUAL? LVL,P-SRCTOP \?PRD14
FSET? OBJ,SEARCHBIT /?PRD14
FSET? OBJ,SURFACEBIT \?CND11
?PRD14: FIRST? OBJ >NOBJ \?CND11
FSET? OBJ,OPENBIT /?CCL19
FSET? OBJ,TRANSBIT /?CCL19
ZERO? P-MOBY-FLAG /?CND11
?CCL19: FSET? OBJ,SURFACEBIT \?CCL25
PUSH P-SRCALL
JUMP ?CND23
?CCL25: FSET? OBJ,SEARCHBIT \?CCL27
PUSH P-SRCALL
JUMP ?CND23
?CCL27: PUSH P-SRCTOP
?CND23: 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
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,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 \?CCL15
CALL VISIBLE?,P-IT-OBJECT
ZERO? STACK \?CCL18
CALL REFERRING
RFALSE
?CCL18: SET 'OBJ,P-IT-OBJECT
JUMP ?CND13
?CCL15: EQUAL? OBJ,HIM \?CND13
CALL VISIBLE?,P-HIM-OBJECT
ZERO? STACK \?CCL22
CALL REFERRING,TRUE-VALUE
RFALSE
?CCL22: SET 'OBJ,P-HIM-OBJECT
?CND13: CALL ULTIMATELY-IN?,OBJ
ZERO? STACK \?PRG8
EQUAL? OBJ,INTNUM,HANDS /?PRG8
EQUAL? OBJ,LEASH \?CCL29
ZERO? HANGING-IN-AIR \?PRG8
?CCL29: SET 'PRSO,OBJ
FSET? OBJ,TRYTAKEBIT /?CTR33
CALL UNTOUCHABLE?,OBJ
ZERO? STACK \?CTR33
ZERO? STUNNED /?CCL34
?CTR33: SET 'TAKEN,TRUE-VALUE
JUMP ?CND32
?CCL34: EQUAL? WINNER,PROTAGONIST /?CCL39
SET 'TAKEN,FALSE-VALUE
JUMP ?CND32
?CCL39: BTST IBITS,STAKE \?CCL41
CALL ITAKE,FALSE-VALUE
EQUAL? STACK,TRUE-VALUE \?CCL41
SET 'TAKEN,FALSE-VALUE
JUMP ?CND32
?CCL41: SET 'TAKEN,TRUE-VALUE
?CND32: ZERO? TAKEN /?CCL46
BTST IBITS,SHAVE \?CCL46
GET TBL,P-MATCHLEN
LESS? 1,STACK \?CCL51
PRINT YNH
PRINTI " all those things!"
CRLF
RFALSE
?CCL51: EQUAL? OBJ,NOT-HERE-OBJECT \?CND49
PRINT YOU-CANT
PRINTI "see that here!"
CRLF
RFALSE
?CND49: EQUAL? WINNER,PROTAGONIST \?CCL55
PRINT YNH
JUMP ?CND53
?CCL55: PRINTI "It doesn't look like"
CALL TPRINT,WINNER
PRINTI " has"
?CND53: CALL THIS-IS-IT,OBJ
CALL TRPRINT,OBJ
RFALSE
?CCL46: ZERO? TAKEN \?PRG8
IN? PROTAGONIST,OBJ /?PRG8
EQUAL? WINNER,PROTAGONIST \?PRG8
PRINTI "[taking"
CALL TPRINT,OBJ
PRINTI " first]"
CRLF
JUMP ?PRG8
.FUNCT MANY-CHECK,PHR=2,LOSS=0,TMP,?TMP1
ZERO? PHR \?CCL3
GETB P-SYNTAX,P-SLOC1
BTST STACK,SMANY /?CCL3
SET 'LOSS,1
JUMP ?CND1
?CCL3: EQUAL? PHR,1 \?CCL7
GETB P-SYNTAX,P-SLOC2
BTST STACK,SMANY /?CCL7
SET 'LOSS,2
JUMP ?CND1
?CCL7: EQUAL? PHR,2 \?CCL11
GET P-PRSO,P-MATCHLEN
GRTR? STACK,1 \?CCL11
GETB P-SYNTAX,P-SLOC1
BTST STACK,SMANY /?CCL11
SET 'LOSS,1
JUMP ?CND1
?CCL11: EQUAL? PHR,2 \?CND1
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
PRINTC 91
PRINT YOU-CANT
PRINTI "use multiple "
EQUAL? LOSS,2 \?CND22
PRINTI "in"
?CND22: PRINTI "direct objects with """
GET P-ITBL,P-VERBN >TMP
ZERO? TMP \?CCL26
PRINTI "tell"
JUMP ?CND24
?CCL26: ZERO? P-OFLAG \?CTR27
ZERO? P-MERGED /?CCL28
?CTR27: GET TMP,0
PRINTB STACK
JUMP ?CND24
?CCL28: GETB TMP,2 >?TMP1
GETB TMP,3
CALL WORD-PRINT,?TMP1,STACK
?CND24: 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 /TRUE
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
SET 'P-GWIMBIT,ONBIT
SET 'OHERE,HERE
SET 'HERE,RM
ZERO? RMBIT /?CCL3
FSET? RM,ONBIT \?CCL3
SET 'LIT,TRUE-VALUE
JUMP ?CND1
?CCL3: PUT P-MERGE,P-MATCHLEN,0
SET 'P-TABLE,P-MERGE
SET 'P-SLOCBITS,-1
EQUAL? OHERE,RM \?CND6
CALL DO-SL,WINNER,1,1
EQUAL? WINNER,PROTAGONIST /?CND6
IN? PROTAGONIST,RM \?CND6
CALL DO-SL,PROTAGONIST,1,1
?CND6: CALL DO-SL,RM,1,1
GET P-TABLE,P-MATCHLEN
GRTR? STACK,0 \?CND1
SET 'LIT,TRUE-VALUE
?CND1: SET 'HERE,OHERE
SET 'P-GWIMBIT,0
RETURN LIT
.FUNCT PRSO-PRINT,PTR
ZERO? P-MERGED \?CTR2
GET P-ITBL,P-NC1 >PTR
GET PTR,0
EQUAL? STACK,W?IT \?CCL3
?CTR2: PRINTC 32
PRINTD PRSO
RTRUE
?CCL3: GET P-ITBL,P-NC1L
CALL BUFFER-PRINT,PTR,STACK,FALSE-VALUE
RSTACK
.FUNCT PRSI-PRINT,PTR
ZERO? P-MERGED \?CTR2
GET P-ITBL,P-NC2 >PTR
GET PTR,0
EQUAL? STACK,W?IT \?CCL3
?CTR2: PRINTC 32
PRINTD PRSI
RTRUE
?CCL3: GET P-ITBL,P-NC2L
CALL BUFFER-PRINT,PTR,STACK,FALSE-VALUE
RSTACK
.FUNCT THIS-IT?,OBJ,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
.ENDI