.FUNCT PARSER,PTR,WRD,VAL,VERB,DONT,OMERGED,OWINNER,LEN,DIR,NW,LW,CNT,?TMP2,?TMP1 SET 'PTR,P-LEXSTART SET 'CNT,-1 ?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 'IN-FRONT-FLAG,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,PLAYER /?CND8 SET 'WINNER,PLAYER LOC WINNER FSET? STACK,VEHBIT /?CND12 LOC WINNER >HERE ?CND12: CALL2 LIT?,HERE >LIT ?CND8: ZERO? RESERVE-PTR /?CCL16 SET 'PTR,RESERVE-PTR ICALL STUFF,P-LEXV,RESERVE-LEXV ICALL 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 EQUAL? VERBOSITY,1,2 \?CND23 EQUAL? PLAYER,WINNER \?CND23 CRLF ?CND23: SET 'P-CONT,FALSE-VALUE JUMP ?CND14 ?CCL22: SET 'WINNER,PLAYER SET 'QUOTE-FLAG,FALSE-VALUE LOC WINNER FSET? STACK,VEHBIT /?CND27 LOC WINNER >HERE ?CND27: CALL2 LIT?,HERE >LIT ZERO? VERBOSITY /?PRG31 CRLF ?PRG31: ICALL1 UPDATE-STATUS-LINE PRINTC 62 GET OOPS-TABLE,O-PTR ZERO? STACK \?CND35 PUT OOPS-TABLE,O-END,FALSE-VALUE ?CND35: PUTB P-INBUF,1,0 READ P-INBUF,P-LEXV GETB P-LEXV,P-LEXWORDS >P-INPUT-WORDS ?CND14: GETB P-LEXV,P-LEXWORDS >P-LEN ZERO? P-LEN \?CCL39 PRINTI "I beg your pardon?" CRLF RFALSE ?CCL39: GET P-LEXV,PTR EQUAL? STACK,W?OOPS,W?O \?CCL43 ADD PTR,P-LEXELEN GET P-LEXV,STACK EQUAL? STACK,W?PERIOD,W?COMMA \?CND44 ADD PTR,P-LEXELEN >PTR DEC 'P-LEN ?CND44: GRTR? P-LEN,1 /?CCL48 ICALL2 CANT-USE,STR?25 RFALSE ?CCL48: GET OOPS-TABLE,O-PTR ZERO? STACK /?CCL50 GRTR? P-LEN,2 \?CND51 PRINTI "[Warning: Only the first word after OOPS is used.]" CRLF ?CND51: 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 ICALL INBUF-ADD,?TMP2,?TMP1,STACK ICALL STUFF,P-LEXV,AGAIN-LEXV GETB P-LEXV,P-LEXWORDS >P-LEN GET OOPS-TABLE,O-START >PTR ICALL INBUF-STUFF,P-INBUF,OOPS-INBUF JUMP ?CND37 ?CCL50: PUT OOPS-TABLE,O-END,FALSE-VALUE PRINTI "[There was no word to replace!]" CRLF RFALSE ?CCL43: ZERO? P-CONT \?CND37 PUT OOPS-TABLE,O-END,FALSE-VALUE ?CND37: SET 'P-CONT,FALSE-VALUE GET P-LEXV,PTR EQUAL? STACK,W?AGAIN,W?G \?CCL60 GETB OOPS-INBUF,1 ZERO? STACK \?CCL63 PRINTI "[What do you want to do again?]" CRLF RFALSE ?CCL63: ZERO? P-OFLAG /?CCL67 PRINTI "Sorry, the Galactic Compendium on Interactive Fiction prohibits the use of AGAIN after your previous action." CRLF RFALSE ?CCL67: ZERO? P-WON \?CCL71 PRINTI "[That would just repeat a mistake!]" CRLF RFALSE ?CCL71: EQUAL? OWINNER,PROTAGONIST /?CCL75 CALL2 VISIBLE?,OWINNER ZERO? STACK \?CCL75 PRINTI "[You can't see " PRINTD OWINNER PRINTI " any more.]" CRLF RFALSE ?CCL75: GRTR? P-LEN,1 \?CCL81 ADD PTR,P-LEXELEN GET P-LEXV,STACK EQUAL? STACK,W?PERIOD,W?COMMA,W?THEN /?CTR83 ADD PTR,P-LEXELEN GET P-LEXV,STACK EQUAL? STACK,W?AND \?CCL84 ?CTR83: ADD PTR,4 >PTR GETB P-LEXV,P-LEXWORDS SUB STACK,2 PUTB P-LEXV,P-LEXWORDS,STACK JUMP ?CND61 ?CCL84: ICALL1 V-TELL-TIME RFALSE ?CCL81: ADD PTR,P-LEXELEN >PTR GETB P-LEXV,P-LEXWORDS SUB STACK,1 PUTB P-LEXV,P-LEXWORDS,STACK ?CND61: GETB P-LEXV,P-LEXWORDS GRTR? STACK,0 \?CCL89 ICALL STUFF,RESERVE-LEXV,P-LEXV ICALL INBUF-STUFF,RESERVE-INBUF,P-INBUF SET 'RESERVE-PTR,PTR JUMP ?CND87 ?CCL89: SET 'RESERVE-PTR,FALSE-VALUE ?CND87: SET 'WINNER,OWINNER SET 'P-MERGED,OMERGED ICALL INBUF-STUFF,P-INBUF,OOPS-INBUF ICALL STUFF,P-LEXV,AGAIN-LEXV SET 'CNT,-1 SET 'DIR,AGAIN-DIR ?PRG90: IGRTR? 'CNT,P-ITBLLEN /?CND58 GET P-OTBL,CNT PUT P-ITBL,CNT,STACK JUMP ?PRG90 ?CCL60: ICALL STUFF,AGAIN-LEXV,P-LEXV ICALL 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 \?CND95 SUB LEN,1 GETB P-LEXV,STACK >?TMP1 SUB LEN,2 GETB P-LEXV,STACK ADD ?TMP1,STACK PUT OOPS-TABLE,O-END,STACK ?CND95: SET 'RESERVE-PTR,FALSE-VALUE SET 'LEN,P-LEN SET 'P-NCN,0 SET 'P-GETFLAGS,0 ?PRG97: DLESS? 'P-LEN,0 \?CCL101 SET 'QUOTE-FLAG,FALSE-VALUE JUMP ?CND58 ?CCL101: GET P-LEXV,PTR >WRD ZERO? WRD \?CTR102 CALL2 NUMBER?,PTR >WRD ZERO? WRD /?CCL103 ?CTR102: CALL2 NEXT-WORD,PTR >NW EQUAL? WRD,W?TO \?CCL108 EQUAL? VERB,ACT?TELL,ACT?ASK \?CCL108 CALL WT?,NW,64,1 ZERO? STACK /?CCL108 PUT P-ITBL,P-VERB,ACT?TELL SET 'WRD,W?QUOTE JUMP ?CND106 ?CCL108: EQUAL? WRD,W?THEN \?CCL113 GRTR? P-LEN,0 \?CCL113 ZERO? VERB \?CCL113 ZERO? QUOTE-FLAG \?CCL113 PUT P-ITBL,P-VERB,ACT?TELL PUT P-ITBL,P-VERBN,0 SET 'WRD,W?QUOTE JUMP ?CND106 ?CCL113: EQUAL? WRD,W?PERIOD \?CND106 EQUAL? LW,W?MR \?CND106 DEC 'P-NCN ICALL CHANGE-LEXV,PTR,LW,TRUE-VALUE SET 'WRD,LW SET 'LW,0 ?CND106: EQUAL? WRD,W?THEN,W?PERIOD /?CTR122 EQUAL? WRD,W?QUOTE \?CCL123 ?CTR122: EQUAL? WRD,W?QUOTE \?CND126 EQUAL? VERB,ACT?CARVE,ACT?MY \?CCL130 PUT P-LEXV,PTR,W?THE INC 'P-LEN JUMP ?PRG97 ?CCL130: ZERO? QUOTE-FLAG /?CCL132 SET 'QUOTE-FLAG,FALSE-VALUE JUMP ?CND126 ?CCL132: SET 'QUOTE-FLAG,TRUE-VALUE ?CND126: ZERO? P-LEN /?PEN133 ADD PTR,P-LEXELEN >P-CONT ?PEN133: PUTB P-LEXV,P-LEXWORDS,P-LEN JUMP ?CND58 ?CCL123: CALL WT?,WRD,16,3 >VAL ZERO? VAL /?CCL136 EQUAL? VERB,FALSE-VALUE,ACT?WALK \?CCL136 EQUAL? LEN,1 /?CTR135 EQUAL? LEN,2 \?PRD142 EQUAL? VERB,ACT?WALK /?CTR135 ?PRD142: EQUAL? NW,W?THEN,W?PERIOD,W?QUOTE \?PRD145 LESS? LEN,2 \?CTR135 ?PRD145: ZERO? QUOTE-FLAG /?PRD148 EQUAL? LEN,2 \?PRD148 EQUAL? NW,W?QUOTE /?CTR135 ?PRD148: GRTR? LEN,2 \?CCL136 EQUAL? NW,W?COMMA,W?AND \?CCL136 ?CTR135: SET 'DIR,VAL EQUAL? NW,W?COMMA,W?AND \?CND154 ADD PTR,P-LEXELEN ICALL CHANGE-LEXV,STACK,W?THEN ?CND154: GRTR? LEN,2 /?CND99 SET 'QUOTE-FLAG,FALSE-VALUE JUMP ?CND58 ?CCL136: CALL WT?,WRD,64,1 >VAL ZERO? VAL /?CCL159 ZERO? VERB \?CCL159 ZERO? P-OFLAG \?CND162 SET 'P-PRSA-WORD,WRD ?CND162: 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 ?CND99 ?CCL159: CALL WT?,WRD,8,0 >VAL ZERO? VAL \?CTR164 EQUAL? WRD,W?ALL,W?ONE,W?BOTH /?CTR164 CALL WT?,WRD,32 ZERO? STACK \?CTR164 CALL WT?,WRD,128 ZERO? STACK /?CCL165 ?CTR164: GRTR? P-LEN,0 \?CCL171 EQUAL? NW,W?OF \?CCL171 ZERO? VAL \?CCL171 EQUAL? WRD,W?ALL,W?ONE /?CCL171 EQUAL? WRD,W?A,W?BOTH \?CND99 ?CCL171: ZERO? VAL /?CCL178 ZERO? P-LEN /?CTR177 EQUAL? NW,W?THEN,W?PERIOD \?CCL178 ?CTR177: SET 'P-END-ON-PREP,TRUE-VALUE LESS? P-NCN,2 \?CND99 PUT P-ITBL,P-PREP1,VAL PUT P-ITBL,P-PREP1N,WRD JUMP ?CND99 ?CCL178: EQUAL? P-NCN,2 \?CCL186 PRINTI "[There were too many nouns in that sentence.]" CRLF RFALSE ?CCL186: INC 'P-NCN EQUAL? VAL,PR?IN \?CCL191 ADD PTR,2 GET P-LEXV,STACK EQUAL? STACK,W?FRONT \?CCL191 SET 'IN-FRONT-FLAG,TRUE-VALUE JUMP ?CND189 ?CCL191: EQUAL? VAL,PR?DOWN \?CND189 ADD PTR,2 GET P-LEXV,STACK EQUAL? STACK,W?IN \?CND189 ADD PTR,4 GET P-LEXV,STACK EQUAL? STACK,W?FRONT \?CND189 SET 'IN-FRONT-FLAG,TRUE-VALUE ?CND189: CALL CLAUSE,PTR,VAL,WRD >PTR ZERO? PTR /FALSE LESS? PTR,0 \?CND99 SET 'QUOTE-FLAG,FALSE-VALUE ?CND58: PUT OOPS-TABLE,O-PTR,FALSE-VALUE ZERO? DIR /?CND214 SET 'PRSA,V?WALK SET 'PRSO,DIR SET 'P-OFLAG,FALSE-VALUE SET 'P-WALK-DIR,DIR SET 'AGAIN-DIR,DIR SET 'DONT-FLAG,DONT RTRUE ?CCL165: ZERO? VERB \?CCL203 EQUAL? WRD,W?DON'T,W?DONT \?CCL203 SET 'DONT,TRUE-VALUE ?CND99: SET 'LW,WRD ADD PTR,P-LEXELEN >PTR JUMP ?PRG97 ?CCL203: CALL WT?,WRD,4 ZERO? STACK \?CND99 EQUAL? VERB,ACT?TELL \?CCL208 CALL WT?,WRD,64,1 ZERO? STACK /?CCL208 EQUAL? WINNER,PROTAGONIST \?CCL208 PRINTI "Please consult your manual for the correct way to talk to characters." CRLF RFALSE ?CCL208: ICALL2 CANT-USE,PTR RFALSE ?CCL103: ICALL2 UNKNOWN-WORD,PTR RFALSE ?CND214: SET 'P-WALK-DIR,FALSE-VALUE SET 'AGAIN-DIR,FALSE-VALUE ZERO? P-OFLAG /?CCL217 CALL1 ORPHAN-MERGE ZERO? STACK \?CND216 ?CCL217: SET 'DONT-FLAG,DONT ?CND216: CALL1 SYNTAX-CHECK ZERO? STACK /FALSE CALL1 SNARF-OBJECTS ZERO? STACK /FALSE CALL1 MANY-CHECK ZERO? STACK /FALSE CALL1 TAKE-CHECK ZERO? STACK \TRUE RFALSE .FUNCT NEXT-WORD,PTR ZERO? P-LEN /FALSE ADD PTR,P-LEXELEN GET P-LEXV,STACK RSTACK .FUNCT CHANGE-LEXV,PTR,WRD,PTRS?,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,PTR,CTR,BPTR ASSIGNED? 'MAX /?CND1 SET 'MAX,29 ?CND1: SET 'PTR,P-LEXSTART SET 'CTR,1 GETB SRC,0 PUTB DEST,0,STACK GETB SRC,1 PUTB DEST,1,STACK ?PRG3: 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 \?PRG3 RTRUE .FUNCT INBUF-STUFF,DEST,SRC,CNT SET '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,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,OFFS,TYP ASSIGNED? 'B1 /?CND1 SET 'B1,5 ?CND1: SET 'OFFS,P-P1OFF GETB PTR,P-PSOFF >TYP BTST TYP,BIT \FALSE GRTR? B1,4 /TRUE BAND TYP,P-P1BITS >TYP EQUAL? TYP,B1 /?CND9 INC 'OFFS ?CND9: GETB PTR,OFFS RSTACK .FUNCT CLAUSE,PTR,VAL,WRD,OFF,NUM,ANDFLG,FIRST??,NW,LW,?TMP1 SET 'FIRST??,TRUE-VALUE SUB P-NCN,1 MUL STACK,2 >OFF ZERO? VAL /?CCL3 ADD P-PREP1,OFF >NUM PUT P-ITBL,NUM,VAL ADD NUM,1 PUT P-ITBL,STACK,WRD ADD PTR,P-LEXELEN >PTR JUMP ?CND1 ?CCL3: INC 'P-LEN ?CND1: ZERO? P-LEN \?CND4 DEC 'P-NCN RETURN -1 ?CND4: ADD P-NC1,OFF >NUM MUL PTR,2 ADD P-LEXV,STACK PUT P-ITBL,NUM,STACK GET P-LEXV,PTR EQUAL? STACK,W?THE,W?A,W?AN \?PRG8 GET P-ITBL,NUM ADD STACK,4 PUT P-ITBL,NUM,STACK ?PRG8: DLESS? 'P-LEN,0 \?CND10 ADD NUM,1 >?TMP1 MUL PTR,2 ADD P-LEXV,STACK PUT P-ITBL,?TMP1,STACK RETURN -1 ?CND10: GET P-LEXV,PTR >WRD ZERO? WRD \?CTR13 CALL2 NUMBER?,PTR >WRD ZERO? WRD /?CCL14 ?CTR13: ZERO? P-LEN \?CCL19 SET 'NW,0 JUMP ?CND17 ?CCL19: ADD PTR,P-LEXELEN GET P-LEXV,STACK >NW ?CND17: EQUAL? WRD,W?PERIOD \?CCL22 EQUAL? LW,W?MR \?CCL22 SET 'LW,0 JUMP ?CND12 ?CCL22: EQUAL? WRD,W?AND,W?COMMA \?CCL26 SET 'ANDFLG,TRUE-VALUE JUMP ?CND12 ?CCL26: EQUAL? WRD,W?ALL,W?ONE,W?BOTH \?CCL28 EQUAL? NW,W?OF \?CND12 DEC 'P-LEN ADD PTR,P-LEXELEN >PTR JUMP ?CND12 ?CCL28: EQUAL? WRD,W?THEN,W?PERIOD /?CTR31 CALL WT?,WRD,8 ZERO? STACK /?CCL32 GET P-ITBL,P-VERB ZERO? STACK /?CCL32 ZERO? FIRST?? \?CCL32 ?CTR31: INC 'P-LEN ADD NUM,1 >?TMP1 MUL PTR,2 ADD P-LEXV,STACK PUT P-ITBL,?TMP1,STACK SUB PTR,P-LEXELEN RSTACK ?CCL32: ZERO? ANDFLG /?CCL39 GET P-ITBL,P-VERB ZERO? STACK \?CCL39 SUB PTR,4 >PTR ADD PTR,2 PUT P-LEXV,STACK,W?THEN ADD P-LEN,2 >P-LEN JUMP ?CND12 ?CCL39: CALL WT?,WRD,128 ZERO? STACK /?CCL43 GRTR? P-LEN,0 \?CCL46 EQUAL? NW,W?OF \?CCL46 EQUAL? WRD,W?ALL,W?ONE \?CND12 ?CCL46: CALL WT?,WRD,32 ZERO? STACK /?CCL50 ZERO? NW /?CCL50 CALL WT?,NW,128 ZERO? STACK \?CND12 CALL WT?,NW,32 ZERO? STACK \?CND12 ?CCL50: ZERO? ANDFLG \?CCL57 EQUAL? NW,W?BUT,W?EXCEPT /?CCL57 EQUAL? NW,W?AND,W?COMMA /?CCL57 ADD NUM,1 >?TMP1 ADD PTR,2 MUL STACK,2 ADD P-LEXV,STACK PUT P-ITBL,?TMP1,STACK RETURN PTR ?CCL57: SET 'ANDFLG,FALSE-VALUE JUMP ?CND12 ?CCL43: CALL WT?,WRD,32 ZERO? STACK \?CND12 CALL WT?,WRD,4 ZERO? STACK \?CND12 CALL WT?,WRD,8 ZERO? STACK \?CND12 ICALL2 CANT-USE,PTR RFALSE ?CCL14: ICALL2 UNKNOWN-WORD,PTR RFALSE ?CND12: SET 'LW,WRD SET 'FIRST??,FALSE-VALUE ADD PTR,P-LEXELEN >PTR JUMP ?PRG8 .FUNCT NUMBER?,PTR,CNT,BPTR,CHR,SUM,TIM,?TMP1 MUL PTR,2 ADD P-LEXV,STACK GETB STACK,2 >CNT MUL PTR,2 ADD P-LEXV,STACK GETB STACK,3 >BPTR ?PRG1: DLESS? 'CNT,0 /?REP2 GETB P-INBUF,BPTR >CHR EQUAL? CHR,58 \?CCL8 SET 'TIM,SUM SET 'SUM,0 JUMP ?CND6 ?CCL8: GRTR? SUM,10000 /FALSE LESS? CHR,58 \FALSE GRTR? CHR,47 \FALSE MUL SUM,10 >?TMP1 SUB CHR,48 ADD ?TMP1,STACK >SUM ?CND6: INC 'BPTR JUMP ?PRG1 ?REP2: PUT P-LEXV,PTR,W?INTNUM GRTR? SUM,1000 /FALSE ZERO? TIM /?CND15 LESS? TIM,8 \?CCL21 ADD TIM,12 >TIM JUMP ?CND19 ?CCL21: GRTR? TIM,23 /FALSE ?CND19: MUL TIM,60 ADD SUM,STACK >SUM ?CND15: SET 'P-NUMBER,SUM RETURN W?INTNUM .FUNCT ORPHAN-MERGE,CNT,TEMP,VERB,BEG,END,ADJ,WRD,?TMP1 SET 'CNT,-1 SET 'P-OFLAG,FALSE-VALUE GET P-ITBL,P-VERBN GET STACK,0 >WRD CALL WT?,WRD,32 ZERO? STACK /?CCL3 SET 'ADJ,TRUE-VALUE JUMP ?CND1 ?CCL3: CALL WT?,WRD,128 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 /?CCL9 ZERO? ADJ \?CCL9 GET P-OTBL,P-VERB EQUAL? VERB,STACK \FALSE ?CCL9: EQUAL? P-NCN,2 /FALSE GET P-OTBL,P-NC1 EQUAL? STACK,1 \?CCL16 GET P-ITBL,P-PREP1 >TEMP GET P-OTBL,P-PREP1 EQUAL? TEMP,STACK /?CTR18 ZERO? TEMP \FALSE ?CTR18: ZERO? ADJ /?CCL24 ADD P-LEXV,2 PUT P-OTBL,P-NC1,STACK GET P-ITBL,P-NC1L ZERO? STACK \?CND25 ADD P-LEXV,6 PUT P-ITBL,P-NC1L,STACK ?CND25: ZERO? P-NCN \?CND22 SET 'P-NCN,1 JUMP ?CND22 ?CCL24: GET P-ITBL,P-NC1 PUT P-OTBL,P-NC1,STACK ?CND22: GET P-ITBL,P-NC1L PUT P-OTBL,P-NC1L,STACK JUMP ?CND7 ?CCL16: GET P-OTBL,P-NC2 EQUAL? STACK,1 \?CCL30 GET P-ITBL,P-PREP1 >TEMP GET P-OTBL,P-PREP2 EQUAL? TEMP,STACK /?CTR32 ZERO? TEMP \FALSE ?CTR32: ZERO? ADJ /?CND36 ADD P-LEXV,2 PUT P-ITBL,P-NC1,STACK GET P-ITBL,P-NC1L ZERO? STACK \?CND36 ADD P-LEXV,6 PUT P-ITBL,P-NC1L,STACK ?CND36: 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 ?CND7 ?CCL30: ZERO? P-ACLAUSE /?CND7 EQUAL? P-NCN,1 /?CCL43 ZERO? ADJ \?CCL43 SET 'P-ACLAUSE,FALSE-VALUE RFALSE ?CCL43: GET P-ITBL,P-NC1 >BEG ZERO? ADJ /?CND46 ADD P-LEXV,2 >BEG SET 'ADJ,FALSE-VALUE ?CND46: GET P-ITBL,P-NC1L >END ?PRG48: GET BEG,0 >WRD EQUAL? BEG,END \?CCL52 ZERO? ADJ /?CCL55 ICALL2 ACLAUSE-WIN,ADJ JUMP ?CND7 ?CCL55: SET 'P-ACLAUSE,FALSE-VALUE RFALSE ?CCL52: ZERO? ADJ \?CCL57 GETB WRD,P-PSOFF BTST STACK,32 /?CTR56 EQUAL? WRD,W?ALL,W?ONE \?CCL57 ?CTR56: SET 'ADJ,WRD ?CND50: ADD BEG,P-WORDLEN >BEG ZERO? END \?PRG48 SET 'END,BEG SET 'P-NCN,1 SUB BEG,4 PUT P-ITBL,P-NC1,STACK PUT P-ITBL,P-NC1L,BEG JUMP ?PRG48 ?CCL57: EQUAL? WRD,W?ONE \?CCL63 ICALL2 ACLAUSE-WIN,ADJ JUMP ?CND7 ?CCL63: GETB WRD,P-PSOFF BTST STACK,128 \?CND50 EQUAL? WRD,P-ANAM \?CCL67 ICALL2 ACLAUSE-WIN,ADJ JUMP ?CND7 ?CCL67: ICALL1 NCLAUSE-WIN ?CND7: 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 ?PRG70: IGRTR? 'CNT,P-ITBLLEN \?CCL74 SET 'P-MERGED,TRUE-VALUE RTRUE ?CCL74: GET P-OTBL,CNT PUT P-ITBL,CNT,STACK JUMP ?PRG70 .FUNCT ACLAUSE-WIN,ADJ GET P-OTBL,P-VERB PUT P-ITBL,P-VERB,STACK EQUAL? ADJ,W?TEA \?CCL3 ICALL1 NCLAUSE-WIN JUMP ?CND1 ?CCL3: PUT P-CCTBL,CC-SBPTR,P-ACLAUSE ADD P-ACLAUSE,1 PUT P-CCTBL,CC-SEPTR,STACK PUT P-CCTBL,CC-DBPTR,P-ACLAUSE ADD P-ACLAUSE,1 PUT P-CCTBL,CC-DEPTR,STACK ICALL CLAUSE-COPY,P-OTBL,P-OTBL,ADJ ?CND1: GET P-OTBL,P-NC2 ZERO? STACK /?PEN4 SET 'P-NCN,2 ?PEN4: SET 'P-ACLAUSE,FALSE-VALUE RTRUE .FUNCT NCLAUSE-WIN PUT P-CCTBL,CC-SBPTR,P-NC1 PUT P-CCTBL,CC-SEPTR,P-NC1L PUT P-CCTBL,CC-DBPTR,P-ACLAUSE ADD P-ACLAUSE,1 PUT P-CCTBL,CC-DEPTR,STACK ICALL CLAUSE-COPY,P-ITBL,P-OTBL GET P-OTBL,P-NC2 ZERO? STACK /?PEN1 SET 'P-NCN,2 ?PEN1: SET 'P-ACLAUSE,FALSE-VALUE RTRUE .FUNCT WORD-PRINT,CNT,BUF ?PRG1: DLESS? 'CNT,0 /TRUE GETB P-INBUF,BUF PRINTC STACK INC 'BUF JUMP ?PRG1 .FUNCT UNKNOWN-WORD,PTR,BUF,?TMP1 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 ICALL 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 ICALL WORD-PRINT,?TMP1,STACK PRINTI """ in a way that I don't understand." CRLF SET 'QUOTE-FLAG,FALSE-VALUE SET 'P-OFLAG,FALSE-VALUE RETURN P-OFLAG .FUNCT SYNTAX-CHECK,SYN,LEN,NUM,OBJ,DRIVE1,DRIVE2,PREP,VERB,TMP,?TMP2,?TMP1 GET P-ITBL,P-VERB >VERB ZERO? VERB \?CND1 PRINTI "There was no verb in that sentence!" CRLF RFALSE ?CND1: SUB 255,VERB GET VERBS,STACK >SYN GETB SYN,0 >LEN INC 'SYN ?PRG5: GETB SYN,P-SBITS BAND STACK,P-SONUMS >NUM GRTR? P-NCN,NUM /?CND7 LESS? NUM,1 /?CCL11 ZERO? P-NCN \?CCL11 GET P-ITBL,P-PREP1 >PREP ZERO? PREP /?CTR10 GETB SYN,P-SPREP1 EQUAL? PREP,STACK \?CCL11 ?CTR10: SET 'DRIVE1,SYN JUMP ?CND7 ?CCL11: GETB SYN,P-SPREP1 >?TMP1 GET P-ITBL,P-PREP1 EQUAL? ?TMP1,STACK \?CND7 EQUAL? NUM,2 \?CCL20 EQUAL? P-NCN,1 \?CCL20 SET 'DRIVE2,SYN ?CND7: DLESS? 'LEN,1 \?CCL26 ZERO? DRIVE1 \?REP6 ZERO? DRIVE2 \?REP6 ICALL1 V-TELL-TIME RFALSE ?CCL20: GETB SYN,P-SPREP2 >?TMP1 GET P-ITBL,P-PREP2 EQUAL? ?TMP1,STACK \?CND7 ICALL2 SYNTAX-FOUND,SYN RTRUE ?CCL26: ADD SYN,P-SYNLEN >SYN JUMP ?PRG5 ?REP6: ZERO? DRIVE1 /?CCL34 GETB DRIVE1,P-SFWIM1 >?TMP2 GETB DRIVE1,P-SLOC1 >?TMP1 GETB DRIVE1,P-SPREP1 CALL GWIM,?TMP2,?TMP1,STACK >OBJ ZERO? OBJ /?CCL34 PUT P-PRSO,P-MATCHLEN,1 PUT P-PRSO,1,OBJ CALL2 SYNTAX-FOUND,DRIVE1 RSTACK ?CCL34: ZERO? DRIVE2 /?CCL38 GETB DRIVE2,P-SFWIM2 >?TMP2 GETB DRIVE2,P-SLOC2 >?TMP1 GETB DRIVE2,P-SPREP2 CALL GWIM,?TMP2,?TMP1,STACK >OBJ ZERO? OBJ /?CCL38 PUT P-PRSI,P-MATCHLEN,1 PUT P-PRSI,1,OBJ CALL2 SYNTAX-FOUND,DRIVE2 RSTACK ?CCL38: EQUAL? VERB,ACT?FIND \?CCL42 PRINTI "I can't answer that question." CRLF RFALSE ?CCL42: EQUAL? WINNER,PROTAGONIST /?CCL46 CALL1 CANT-ORPHAN RSTACK ?CCL46: ICALL ORPHAN,DRIVE1,DRIVE2 PRINTI "What do" ZERO? DONT-FLAG /?PRG53 PRINTI "n't" ?PRG53: PRINTI " you want to " GET P-OTBL,P-VERBN >TMP ZERO? TMP \?CCL57 PRINTI "tell" JUMP ?CND55 ?CCL57: GETB P-VTBL,2 ZERO? STACK \?CCL61 GET TMP,0 PRINTB STACK JUMP ?CND55 ?CCL61: GETB TMP,2 >?TMP1 GETB TMP,3 ICALL WORD-PRINT,?TMP1,STACK PUTB P-VTBL,2,0 ?CND55: ZERO? DRIVE2 /?CND62 ICALL CLAUSE-PRINT,P-NC1,P-NC1L ?CND62: SET 'P-OFLAG,TRUE-VALUE ZERO? DRIVE1 /?CCL66 GETB DRIVE1,P-SPREP1 JUMP ?CND64 ?CCL66: GETB DRIVE2,P-SPREP2 ?CND64: ICALL2 PREP-PRINT,STACK PRINTC 63 CRLF RFALSE .FUNCT CANT-ORPHAN EQUAL? WINNER,GUARDS \?PRG8 EQUAL? HERE,DAIS \?PRG8 PRINTI """We" JUMP ?PRG10 ?PRG8: PRINTI """I" ?PRG10: PRINTI " don't understand! What are you referring to?""" CRLF RFALSE .FUNCT ORPHAN,D1,D2,CNT SET 'CNT,-1 ZERO? P-MERGED \?CND1 PUT P-OCLAUSE,P-MATCHLEN,0 ?CND1: GET P-VTBL,0 PUT P-OVTBL,0,STACK GETB P-VTBL,2 PUTB P-OVTBL,2,STACK GETB P-VTBL,3 PUTB P-OVTBL,3,STACK ?PRG3: IGRTR? 'CNT,P-ITBLLEN /?REP4 GET P-ITBL,CNT PUT P-OTBL,CNT,STACK JUMP ?PRG3 ?REP4: EQUAL? P-NCN,2 \?CND8 PUT P-CCTBL,CC-SBPTR,P-NC2 PUT P-CCTBL,CC-SEPTR,P-NC2L PUT P-CCTBL,CC-DBPTR,P-NC2 PUT P-CCTBL,CC-DEPTR,P-NC2L ICALL CLAUSE-COPY,P-ITBL,P-OTBL ?CND8: LESS? P-NCN,1 /?CND10 PUT P-CCTBL,CC-SBPTR,P-NC1 PUT P-CCTBL,CC-SEPTR,P-NC1L PUT P-CCTBL,CC-DBPTR,P-NC1 PUT P-CCTBL,CC-DEPTR,P-NC1L ICALL 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?,?TMP1 ASSIGNED? 'THE? /?CND1 SET 'THE?,TRUE-VALUE ?CND1: GET P-ITBL,BPTR >?TMP1 GET P-ITBL,EPTR CALL BUFFER-PRINT,?TMP1,STACK,THE? RSTACK .FUNCT BUFFER-PRINT,BEG,END,CP,NOSP,WRD,FIRST??,PN,?TMP1 SET 'FIRST??,TRUE-VALUE ?PRG1: EQUAL? BEG,END /TRUE ZERO? NOSP /?PRG9 SET 'NOSP,FALSE-VALUE JUMP ?CND6 ?PRG9: PRINTC 32 ?CND6: GET BEG,0 >WRD EQUAL? WRD,W?PERIOD \?CCL13 SET 'NOSP,TRUE-VALUE JUMP ?CND3 ?CCL13: EQUAL? WRD,W?ME \?CCL15 PRINTD ME SET 'PN,TRUE-VALUE JUMP ?CND3 ?CCL15: CALL2 NAME?,WRD ZERO? STACK /?CCL17 ICALL2 CAPITALIZE,BEG SET 'PN,TRUE-VALUE JUMP ?CND3 ?CCL17: ZERO? FIRST?? /?CND18 ZERO? PN \?CND18 ZERO? CP /?CND18 PRINTI "the " ?CND18: ZERO? P-OFLAG \?CTR26 ZERO? P-MERGED /?CCL27 ?CTR26: PRINTB WRD JUMP ?CND25 ?CCL27: EQUAL? WRD,W?IT \?CCL31 CALL2 ACCESSIBLE?,P-IT-OBJECT ZERO? STACK /?CCL31 PRINTD P-IT-OBJECT JUMP ?CND25 ?CCL31: GETB BEG,2 >?TMP1 GETB BEG,3 ICALL WORD-PRINT,?TMP1,STACK ?CND25: SET 'FIRST??,FALSE-VALUE ?CND3: ADD BEG,P-WORDLEN >BEG JUMP ?PRG1 .FUNCT NAME?,WRD EQUAL? WRD,W?FORD,W?ZAPHOD,W?BEEBLEBRO /TRUE EQUAL? WRD,W?TRILLIAN,W?TRICIA,W?MCMILLAN /TRUE EQUAL? WRD,W?PROSSER,W?MARVIN,W?ARTHUR /TRUE EQUAL? WRD,W?DENT,W?PREFECT,W?PHIL /TRUE EQUAL? WRD,W?EDDIE,W?MARV,W?ED /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 \?CCL8 PRINTI "through" RTRUE ?CCL8: CALL2 PREP-FIND,PREP >WRD PRINTB WRD RTRUE .FUNCT CLAUSE-COPY,SRC,DEST,INSRT,BEG,END,?TMP1 GET P-CCTBL,CC-SBPTR GET SRC,STACK >BEG GET P-CCTBL,CC-SEPTR GET SRC,STACK >END GET P-CCTBL,CC-DBPTR >?TMP1 GET P-OCLAUSE,P-MATCHLEN MUL STACK,P-LEXELEN ADD STACK,2 ADD P-OCLAUSE,STACK PUT DEST,?TMP1,STACK ?PRG1: EQUAL? BEG,END \?CCL5 GET P-CCTBL,CC-DEPTR >?TMP1 GET P-OCLAUSE,P-MATCHLEN MUL STACK,P-LEXELEN ADD STACK,2 ADD P-OCLAUSE,STACK PUT DEST,?TMP1,STACK RTRUE ?CCL5: ZERO? INSRT /?CND6 GET BEG,0 EQUAL? P-ANAM,STACK \?CND6 ICALL2 CLAUSE-ADD,INSRT ?CND6: GET BEG,0 ICALL2 CLAUSE-ADD,STACK ADD BEG,P-WORDLEN >BEG JUMP ?PRG1 .FUNCT CLAUSE-ADD,WRD,PTR GET P-OCLAUSE,P-MATCHLEN ADD STACK,2 >PTR SUB PTR,1 PUT P-OCLAUSE,STACK,WRD PUT P-OCLAUSE,PTR,0 PUT P-OCLAUSE,P-MATCHLEN,PTR RTRUE .FUNCT PREP-FIND,PREP,CNT,SIZE GET PREPOSITIONS,0 MUL STACK,2 >SIZE ?PRG1: IGRTR? 'CNT,SIZE /FALSE GET PREPOSITIONS,CNT EQUAL? STACK,PREP \?PRG1 SUB CNT,1 GET PREPOSITIONS,STACK RSTACK .FUNCT SYNTAX-FOUND,SYN SET 'P-SYNTAX,SYN GETB SYN,P-SACTION >PRSA RETURN PRSA .FUNCT GWIM,GBIT,LBIT,PREP,OBJ EQUAL? GBIT,RLANDBIT \?CND1 RETURN ROOMS ?CND1: SET 'P-GWIMBIT,GBIT SET 'P-SLOCBITS,LBIT PUT P-MERGE,P-MATCHLEN,0 CALL GET-OBJECT,P-MERGE,FALSE-VALUE ZERO? STACK /?CCL5 SET 'P-GWIMBIT,0 GET P-MERGE,P-MATCHLEN EQUAL? STACK,1 \FALSE GET P-MERGE,1 >OBJ PRINTC 40 ZERO? PREP /?PRG26 ZERO? P-END-ON-PREP \?PRG26 CALL2 PREP-FIND,PREP >PREP PRINTB PREP EQUAL? PREP,W?OUT \?CND15 PRINTI " of" ?CND15: FSET? OBJ,NARTICLEBIT /?PRG24 PRINTI " the " JUMP ?PRG26 ?PRG24: PRINTC 32 ?PRG26: PRINTD OBJ PRINTC 41 CRLF RETURN OBJ ?CCL5: SET 'P-GWIMBIT,0 RFALSE .FUNCT SNARF-OBJECTS,PTR GET P-ITBL,P-NC1 >PTR ZERO? PTR /?CND1 GETB P-SYNTAX,P-SLOC1 >P-SLOCBITS GET P-ITBL,P-NC1L CALL SNARFEM,PTR,STACK,P-PRSO ZERO? STACK /FALSE GET P-BUTS,P-MATCHLEN ZERO? STACK /?CND1 CALL2 BUT-MERGE,P-PRSO >P-PRSO ?CND1: GET P-ITBL,P-NC2 >PTR ZERO? PTR /TRUE GETB P-SYNTAX,P-SLOC2 >P-SLOCBITS GET P-ITBL,P-NC2L CALL SNARFEM,PTR,STACK,P-PRSI ZERO? STACK /FALSE GET P-BUTS,P-MATCHLEN ZERO? STACK /TRUE GET P-PRSI,P-MATCHLEN EQUAL? STACK,1 \?CCL15 CALL2 BUT-MERGE,P-PRSO >P-PRSO RTRUE ?CCL15: CALL2 BUT-MERGE,P-PRSI >P-PRSI RTRUE .FUNCT BUT-MERGE,TBL,LEN,BUTLEN,CNT,MATCHES,OBJ,NTBL,?TMP1,?TMP2 SET 'CNT,1 GET TBL,P-MATCHLEN >LEN PUT P-MERGE,P-MATCHLEN,0 ?PRG1: DLESS? 'LEN,0 /?REP2 GET TBL,CNT >OBJ ADD P-BUTS,2 >?TMP1 GET P-BUTS,0 INTBL? OBJ,?TMP1,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,LEN,WV,WRD,NW,WAS-ALL SET 'P-AND,FALSE-VALUE EQUAL? P-GETFLAGS,P-ALL \?CND1 SET 'WAS-ALL,TRUE-VALUE ?CND1: SET 'P-GETFLAGS,0 SET 'P-CSPTR,PTR SET 'P-CEPTR,EPTR PUT P-BUTS,P-MATCHLEN,0 PUT TBL,P-MATCHLEN,0 GET PTR,0 >WRD ?PRG3: EQUAL? PTR,EPTR \?CCL7 ZERO? BUT /?PRD10 PUSH BUT JUMP ?PEN8 ?PRD10: PUSH TBL ?PEN8: CALL2 GET-OBJECT,STACK >WV ZERO? WAS-ALL \?CCL12 RETURN WV ?CCL12: SET 'P-GETFLAGS,P-ALL RETURN WV ?CCL7: GET PTR,P-LEXELEN >NW EQUAL? WRD,W?ALL,W?BOTH \?CCL15 SET 'P-GETFLAGS,P-ALL EQUAL? NW,W?OF \?CND5 ADD PTR,P-WORDLEN >PTR JUMP ?CND5 ?CCL15: EQUAL? WRD,W?BUT,W?EXCEPT \?CCL19 ZERO? BUT /?PRD24 PUSH BUT JUMP ?PEN22 ?PRD24: PUSH TBL ?PEN22: CALL2 GET-OBJECT,STACK ZERO? STACK /FALSE SET 'BUT,P-BUTS PUT BUT,P-MATCHLEN,0 JUMP ?CND5 ?CCL19: EQUAL? WRD,W?A,W?ONE \?CCL26 ZERO? P-ADJ \?CCL29 SET 'P-GETFLAGS,P-ONE EQUAL? NW,W?OF \?CND5 ADD PTR,P-WORDLEN >PTR JUMP ?CND5 ?CCL29: SET 'P-NAM,P-ONEOBJ ZERO? BUT /?PRD36 PUSH BUT JUMP ?PEN34 ?PRD36: PUSH TBL ?PEN34: CALL2 GET-OBJECT,STACK ZERO? STACK /FALSE ZERO? NW \?CND5 RTRUE ?CCL26: EQUAL? WRD,W?AND,W?COMMA \?CCL40 EQUAL? NW,W?AND,W?COMMA /?CCL40 SET 'P-AND,TRUE-VALUE ZERO? BUT /?PRD47 PUSH BUT JUMP ?PEN45 ?PRD47: PUSH TBL ?PEN45: CALL2 GET-OBJECT,STACK ZERO? STACK \?CND5 RFALSE ?CCL40: CALL WT?,WRD,4 ZERO? STACK \?CND5 EQUAL? WRD,W?AND,W?COMMA /?CND5 EQUAL? WRD,W?OF \?CCL51 ZERO? P-GETFLAGS \?CND5 SET 'P-GETFLAGS,P-INHIBIT JUMP ?CND5 ?CCL51: CALL WT?,WRD,32 ZERO? STACK /?CCL55 CALL2 ADJ-CHECK,WRD ZERO? STACK /?CCL55 EQUAL? WRD,W?TEA \?CTR54 EQUAL? P-NAM,W?CUP /?CCL55 ?CTR54: SET 'P-ADJ,WRD JUMP ?CND5 ?CCL55: CALL WT?,WRD,128 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 ADJ-CHECK,WRD ZERO? P-ADJ /TRUE EQUAL? WRD,W?INNER,W?OUTER /TRUE RFALSE .FUNCT GET-OBJECT,TBL,VRB,GEN,BITS,LEN,XBITS,TLEN,GCHECK,OLEN,OBJ ASSIGNED? 'VRB /?CND1 SET 'VRB,TRUE-VALUE ?CND1: SET 'XBITS,P-SLOCBITS GET TBL,P-MATCHLEN >TLEN BTST P-GETFLAGS,P-INHIBIT /TRUE ZERO? P-NAM \?CND5 ZERO? P-ADJ /?CND5 CALL WT?,P-ADJ,128 ZERO? STACK /?CND5 SET 'P-NAM,P-ADJ SET 'P-ADJ,FALSE-VALUE ?CND5: ZERO? P-NAM \?CND10 ZERO? P-ADJ \?CND10 EQUAL? P-GETFLAGS,P-ALL /?CND10 ZERO? P-GWIMBIT \?CND10 ZERO? VRB /FALSE PRINT NOUN-MISSING CRLF RFALSE ?CND10: EQUAL? P-GETFLAGS,P-ALL \?CCL21 ZERO? P-SLOCBITS \?CND20 ?CCL21: SET 'P-SLOCBITS,-1 ?CND20: SET 'P-TABLE,TBL ?PRG24: ZERO? GCHECK /?CCL28 ICALL2 GLOBAL-CHECK,TBL JUMP ?CND26 ?CCL28: ZERO? LIT /?CND29 FCLEAR PLAYER,TRANSBIT ICALL DO-SL,HERE,SOG,SIR FSET PLAYER,TRANSBIT ?CND29: ICALL DO-SL,PLAYER,SH,SC ?CND26: GET TBL,P-MATCHLEN SUB STACK,TLEN >LEN BTST P-GETFLAGS,P-ALL /?CND31 BTST P-GETFLAGS,P-ONE \?CCL34 ZERO? LEN /?CCL34 EQUAL? LEN,1 /?CND37 RANDOM LEN GET TBL,STACK PUT TBL,1,STACK PRINTI "(How about the " GET TBL,1 PRINTD STACK PRINTI "?)" CRLF ?CND37: PUT TBL,P-MATCHLEN,1 ?CND31: SET 'P-SLOCBITS,XBITS SET 'P-NAM,FALSE-VALUE SET 'P-ADJ,FALSE-VALUE RTRUE ?CCL34: GRTR? LEN,1 /?CTR43 ZERO? LEN \?CCL44 EQUAL? P-SLOCBITS,-1 /?CCL44 ?CTR43: EQUAL? P-SLOCBITS,-1 \?CCL51 SET 'P-SLOCBITS,XBITS SET 'OLEN,LEN GET TBL,P-MATCHLEN SUB STACK,LEN PUT TBL,P-MATCHLEN,STACK JUMP ?PRG24 ?CCL51: ZERO? LEN \?CND52 SET 'LEN,OLEN ?CND52: GRTR? LEN,1 \?CCL56 EQUAL? PRSA,V?WHAT,V?ASK-ABOUT \?CCL56 EQUAL? P-NAM,W?FLUFF,W?DRIVE \?PRD61 ZERO? P-ADJ /?CTR55 ?PRD61: EQUAL? P-NAM,W?TOOLS,W?TOOL \?PRD64 EQUAL? P-ADJ,W?PROPER /?CTR55 ?PRD64: EQUAL? P-NAM,W?DRIVE \?CCL56 EQUAL? P-ADJ,W?IMPROBABI \?CCL56 ?CTR55: GET TBL,LEN GETP STACK,P?GENERIC >GEN ADD TLEN,1 >LEN PUT TBL,P-MATCHLEN,LEN PUT TBL,LEN,GEN SET 'P-XNAM,P-NAM SET 'P-XADJ,P-ADJ SET 'P-NAM,FALSE-VALUE SET 'P-ADJ,FALSE-VALUE RTRUE ?CCL56: ZERO? VRB /?CCL70 EQUAL? WINNER,PROTAGONIST /?CCL70 ICALL1 CANT-ORPHAN SET 'P-NAM,FALSE-VALUE SET 'P-ADJ,FALSE-VALUE RFALSE ?CCL70: ZERO? VRB /?CCL74 ZERO? P-NAM /?CCL74 ICALL WHICH-PRINT,TLEN,LEN,TBL EQUAL? TBL,P-PRSO \?CCL79 SET 'P-ACLAUSE,P-NC1 JUMP ?CND77 ?CCL79: SET 'P-ACLAUSE,P-NC2 ?CND77: SET 'P-AADJ,P-ADJ SET 'P-ANAM,P-NAM ICALL ORPHAN,FALSE-VALUE,FALSE-VALUE SET 'P-OFLAG,TRUE-VALUE JUMP ?CND54 ?CCL74: ZERO? VRB /?CND54 PRINT NOUN-MISSING CRLF ?CND54: SET 'P-NAM,FALSE-VALUE SET 'P-ADJ,FALSE-VALUE RFALSE ?CCL44: ZERO? LEN \?CCL84 ZERO? GCHECK /?CCL84 ZERO? VRB /?CND87 SET 'P-SLOCBITS,XBITS ZERO? LIT \?CTR90 EQUAL? PRSA,V?TELL /?CTR90 EQUAL? PRSA,V?WHERE,V?WHAT,V?WHO \?PRG95 ?CTR90: ICALL OBJ-FOUND,NOT-HERE-OBJECT,TBL SET 'P-XNAM,P-NAM SET 'P-XADJ,P-ADJ SET 'P-NAM,FALSE-VALUE SET 'P-ADJ,FALSE-VALUE RTRUE ?PRG95: PRINT TOO-DARK CRLF ?CND87: SET 'P-NAM,FALSE-VALUE SET 'P-ADJ,FALSE-VALUE RFALSE ?CCL84: ZERO? LEN \?CND31 SET 'GCHECK,TRUE-VALUE JUMP ?PRG24 .FUNCT MOBY-FIND,TBL,FOO,LEN SET 'P-MOBY-FLAG,TRUE-VALUE SET 'P-SLOCBITS,-1 SET 'P-TABLE,TBL SET 'P-NAM,P-XNAM SET 'P-ADJ,P-XADJ PUT TBL,P-MATCHLEN,0 FIRST? ROOMS >FOO /?PRG2 ?PRG2: ZERO? FOO /?REP3 ICALL SEARCH-LIST,FOO,TBL,P-SRCALL NEXT? FOO >FOO /?PRG2 JUMP ?PRG2 ?REP3: ICALL DO-SL,LOCAL-GLOBALS,1,1 ICALL SEARCH-LIST,ROOMS,TBL,P-SRCTOP GET TBL,P-MATCHLEN >LEN EQUAL? LEN,1 \?CND8 GET TBL,1 >P-MOBY-FOUND ?CND8: SET 'P-MOBY-FLAG,FALSE-VALUE SET 'P-NAM,FALSE-VALUE SET 'P-ADJ,FALSE-VALUE RETURN LEN .FUNCT WHICH-PRINT,TLEN,LEN,TBL,OBJ,RLEN SET 'RLEN,LEN PRINTI "Which" ZERO? P-OFLAG \?PRG9 ZERO? P-MERGED \?PRG9 ZERO? P-AND /?CCL5 ?PRG9: PRINTC 32 PRINTB P-NAM JUMP ?PRG13 ?CCL5: EQUAL? TBL,P-PRSO \?CCL12 ICALL CLAUSE-PRINT,P-NC1,P-NC1L,FALSE-VALUE JUMP ?PRG13 ?CCL12: ICALL CLAUSE-PRINT,P-NC2,P-NC2L,FALSE-VALUE ?PRG13: PRINTI " do you mean, " ?PRG15: INC 'TLEN GET TBL,TLEN >OBJ FSET? OBJ,NARTICLEBIT /?PRG21 PRINTI "the " ?PRG21: PRINTD OBJ EQUAL? LEN,2 \?CCL25 EQUAL? RLEN,2 /?PRG30 PRINTC 44 ?PRG30: PRINTI " or " JUMP ?CND23 ?CCL25: GRTR? LEN,2 \?CND23 PRINTI ", " ?CND23: DLESS? 'LEN,1 \?PRG15 PRINTR "?" .FUNCT GLOBAL-CHECK,TBL,LEN,RMG,RMGL,CNT,OBJ,OBITS,FOO GET TBL,P-MATCHLEN >LEN SET 'OBITS,P-SLOCBITS GETPT HERE,P?GLOBAL >RMG ZERO? RMG /?CND1 PTSIZE RMG DIV STACK,2 >RMGL ?PRG3: GET RMG,CNT >OBJ CALL THIS-IT?,OBJ,TBL ZERO? STACK /?CND5 ICALL OBJ-FOUND,OBJ,TBL ?CND5: IGRTR? 'CNT,RMGL \?PRG3 ?CND1: GET TBL,P-MATCHLEN EQUAL? STACK,LEN \FALSE SET 'P-SLOCBITS,-1 SET 'P-TABLE,TBL ICALL 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,TBL ZERO? STACK /?CND6 ICALL OBJ-FOUND,OBJ,TBL ?CND6: ZERO? LVL \?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 \?CND13 CALL2 ACCESSIBLE?,P-IT-OBJECT ZERO? STACK \?CCL17 PRINT REFERRING CRLF RFALSE ?CCL17: SET 'OBJ,P-IT-OBJECT ?CND13: CALL2 HELD?,OBJ ZERO? STACK \?PRG8 EQUAL? OBJ,HANDS,SLEEVES,SPEECH /?PRG8 EQUAL? OBJ,NO-TEA \?PRD26 ZERO? HOLDING-NO-TEA \?PRG8 ?PRD26: EQUAL? OBJ,GUARANTEE \?CCL22 EQUAL? PRSA,V?SHOW /?PRG8 ?CCL22: SET 'PRSO,OBJ FSET? OBJ,TRYTAKEBIT \?CCL33 SET 'TAKEN,TRUE-VALUE JUMP ?CND31 ?CCL33: EQUAL? WINNER,PROTAGONIST /?CCL35 SET 'TAKEN,FALSE-VALUE JUMP ?CND31 ?CCL35: BTST IBITS,STAKE \?CCL37 CALL2 ITAKE,FALSE-VALUE EQUAL? STACK,TRUE-VALUE \?CCL37 SET 'TAKEN,FALSE-VALUE JUMP ?CND31 ?CCL37: SET 'TAKEN,TRUE-VALUE ?CND31: ZERO? TAKEN /?CCL42 BTST IBITS,SHAVE \?CCL42 GET TBL,P-MATCHLEN LESS? 1,STACK \?CCL47 PRINT NOT-HOLDING PRINTI " all those things!" CRLF RFALSE ?CCL47: EQUAL? OBJ,NOT-HERE-OBJECT \?CND45 PRINTI "You can't see that here!" CRLF RFALSE ?CND45: EQUAL? WINNER,PROTAGONIST \?PRG58 PRINT NOT-HOLDING JUMP ?CND53 ?PRG58: PRINTI "It doesn't look like" ICALL ARTICLE,WINNER,TRUE-VALUE PRINTI " is holding" ?CND53: ICALL ARTICLE,OBJ,TRUE-VALUE SET 'P-IT-OBJECT,OBJ PRINTC 46 CRLF RFALSE ?CCL42: ZERO? TAKEN \?PRG8 EQUAL? WINNER,PROTAGONIST \?PRG8 PRINTI "(Taking" ICALL ARTICLE,OBJ,TRUE-VALUE PRINTI " first)" CRLF JUMP ?PRG8 .FUNCT MANY-CHECK,LOSS,TMP,?TMP1 GET P-PRSO,P-MATCHLEN GRTR? STACK,1 \?CCL3 GETB P-SYNTAX,P-SLOC1 BTST STACK,SMANY /?CCL3 SET 'LOSS,1 JUMP ?CND1 ?CCL3: GET P-PRSI,P-MATCHLEN GRTR? STACK,1 \?CND1 GETB P-SYNTAX,P-SLOC2 BTST STACK,SMANY /?CND1 SET 'LOSS,2 ?CND1: ZERO? LOSS /TRUE PRINTI "You can't use multiple " EQUAL? LOSS,2 \?PRG18 PRINTI "in" ?PRG18: PRINTI "direct objects with """ GET P-ITBL,P-VERBN >TMP ZERO? TMP \?CCL22 PRINTI "tell" JUMP ?PRG29 ?CCL22: ZERO? P-OFLAG \?CTR25 ZERO? P-MERGED /?CCL26 ?CTR25: GET TMP,0 PRINTB STACK JUMP ?PRG29 ?CCL26: GETB TMP,2 >?TMP1 GETB TMP,3 ICALL WORD-PRINT,?TMP1,STACK ?PRG29: PRINTI """." CRLF RFALSE .FUNCT LIT?,RM,RMBIT,OHERE,LIT ASSIGNED? 'RMBIT /?CND1 SET 'RMBIT,TRUE-VALUE ?CND1: SET 'P-GWIMBIT,ONBIT SET 'OHERE,HERE SET 'HERE,RM ZERO? RMBIT /?CCL5 FSET? RM,ONBIT \?CCL5 SET 'LIT,TRUE-VALUE JUMP ?CND3 ?CCL5: PUT P-MERGE,P-MATCHLEN,0 SET 'P-TABLE,P-MERGE SET 'P-SLOCBITS,-1 EQUAL? OHERE,RM \?CND8 ICALL DO-SL,WINNER,1,1 EQUAL? WINNER,PLAYER /?CND8 IN? PLAYER,RM \?CND8 ICALL DO-SL,PLAYER,1,1 ?CND8: ICALL DO-SL,RM,1,1 GET P-TABLE,P-MATCHLEN GRTR? STACK,0 \?CND3 SET 'LIT,TRUE-VALUE ?CND3: SET 'HERE,OHERE SET 'P-GWIMBIT,0 RETURN LIT .FUNCT PRSO-PRINT,PTR ZERO? P-MERGED \?PRG6 GET P-ITBL,P-NC1 >PTR GET PTR,0 EQUAL? STACK,W?IT \?CCL3 ?PRG6: 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 \?PRG6 GET P-ITBL,P-NC2 >PTR GET PTR,0 EQUAL? STACK,W?IT \?CCL3 ?PRG6: PRINTC 32 PRINTD PRSO RTRUE ?CCL3: GET P-ITBL,P-NC2L CALL BUFFER-PRINT,PTR,STACK,FALSE-VALUE RSTACK .FUNCT THIS-IT?,OBJ,TBL,SYNS,?TMP1 FSET? OBJ,INVISIBLE /FALSE ZERO? P-NAM /?CCL5 GETPT OBJ,P?SYNONYM >SYNS PTSIZE SYNS DIV STACK,2 INTBL? P-NAM,SYNS,STACK \FALSE ?CCL5: ZERO? P-ADJ /?CCL9 GETPT OBJ,P?ADJECTIVE >SYNS ZERO? SYNS /FALSE PTSIZE SYNS DIV STACK,2 INTBL? P-ADJ,SYNS,STACK \FALSE ?CCL9: ZERO? P-GWIMBIT /TRUE FSET? OBJ,P-GWIMBIT /TRUE RFALSE .ENDI