.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