.FUNCT PARSER,PTR=P-LEXSTART,WRD,VAL=0,VERB=0,OF-FLAG=0,OWINNER,OMERGED,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 'OWINNER,WINNER SET 'OMERGED,P-MERGED 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,ADVENTURER /?CND8 SET 'WINNER,ADVENTURER CALL META-LOC,ADVENTURER >HERE CALL LIT?,HERE >LIT ?CND8: ZERO? RESERVE-PTR /?CCL14 SET 'PTR,RESERVE-PTR CALL STUFF,RESERVE-LEXV,P-LEXV GRTR? VERBOSITY,0 \?CND15 EQUAL? ADVENTURER,WINNER \?CND15 CRLF ?CND15: SET 'RESERVE-PTR,FALSE-VALUE SET 'P-CONT,FALSE-VALUE JUMP ?CND12 ?CCL14: ZERO? P-CONT /?CCL20 SET 'PTR,P-CONT GRTR? VERBOSITY,0 \?CND21 EQUAL? ADVENTURER,WINNER \?CND21 EQUAL? PRSA,V?SAY /?CND21 CRLF ?CND21: SET 'P-CONT,FALSE-VALUE JUMP ?CND12 ?CCL20: SET 'WINNER,ADVENTURER SET 'QUOTE-FLAG,FALSE-VALUE LOC WINNER FSET? STACK,VEHBIT /?CND26 LOC WINNER >HERE ?CND26: CALL LIT?,HERE >LIT GRTR? VERBOSITY,0 \?PRG30 CRLF ?PRG30: PRINTC 62 READ P-INBUF,P-LEXV ?CND12: GETB P-LEXV,P-LEXWORDS >P-LEN ZERO? P-LEN \?CND32 PRINTI "I beg your pardon?" CRLF RFALSE ?CND32: GET P-LEXV,PTR >WRD EQUAL? WRD,W?OOPS \?CCL38 ADD PTR,P-LEXELEN GET P-LEXV,STACK EQUAL? STACK,W?PERIOD,W?COMMA \?CND39 ADD PTR,P-LEXELEN >PTR DEC 'P-LEN ?CND39: GRTR? P-LEN,1 /?CCL43 PRINTI "I can't help your clumsiness." CRLF RFALSE ?CCL43: GET OOPS-TABLE,O-PTR ZERO? STACK /?CCL47 GRTR? P-LEN,2 \?CCL50 ADD PTR,P-LEXELEN GET P-LEXV,STACK EQUAL? STACK,W?QUOTE \?CCL50 PRINTI "Sorry, you can't correct mistakes in quoted text." CRLF RFALSE ?CCL50: GRTR? P-LEN,2 \?CND48 PRINTI "Warning: only the first word after OOPS is used." CRLF ?CND48: 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,AGAIN-LEXV,P-LEXV GETB P-LEXV,P-LEXWORDS >P-LEN GET OOPS-TABLE,O-START >PTR CALL INBUF-STUFF,OOPS-INBUF,P-INBUF JUMP ?CND36 ?CCL47: PUT OOPS-TABLE,O-END,FALSE-VALUE PRINTI "There was no word to replace!" CRLF RFALSE ?CCL38: EQUAL? WRD,W?AGAIN,W?G /?CND60 SET 'P-NUMBER,0 ?CND60: PUT OOPS-TABLE,O-END,FALSE-VALUE ?CND36: GET P-LEXV,PTR EQUAL? STACK,W?AGAIN,W?G \?CCL64 GETB OOPS-INBUF,1 ZERO? STACK \?CCL67 PRINTI "Beg pardon?" CRLF RFALSE ?CCL67: ZERO? P-OFLAG /?CCL71 PRINTI "It's difficult to repeat fragments." CRLF RFALSE ?CCL71: ZERO? P-WON \?CCL75 PRINTI "That would just repeat a mistake." CRLF RFALSE ?CCL75: GRTR? P-LEN,1 \?CCL79 ADD PTR,P-LEXELEN GET P-LEXV,STACK EQUAL? STACK,W?PERIOD,W?COMMA,W?THEN /?CTR81 ADD PTR,P-LEXELEN GET P-LEXV,STACK EQUAL? STACK,W?AND \?PRG85 ?CTR81: ADD PTR,4 >PTR GETB P-LEXV,P-LEXWORDS SUB STACK,2 PUTB P-LEXV,P-LEXWORDS,STACK JUMP ?CND65 ?PRG85: PRINTI "I couldn't understand that sentence." CRLF RFALSE ?CCL79: ADD PTR,P-LEXELEN >PTR GETB P-LEXV,P-LEXWORDS SUB STACK,1 PUTB P-LEXV,P-LEXWORDS,STACK ?CND65: GETB P-LEXV,P-LEXWORDS GRTR? STACK,0 \?CCL89 CALL STUFF,P-LEXV,RESERVE-LEXV SET 'RESERVE-PTR,PTR JUMP ?CND87 ?CCL89: SET 'RESERVE-PTR,FALSE-VALUE ?CND87: SET 'WINNER,OWINNER SET 'P-MERGED,OMERGED CALL INBUF-STUFF,OOPS-INBUF,P-INBUF CALL STUFF,AGAIN-LEXV,P-LEXV SET 'CNT,-1 SET 'DIR,AGAIN-DIR ?PRG90: IGRTR? 'CNT,P-ITBLLEN /?CND62 GET P-OTBL,CNT PUT P-ITBL,CNT,STACK JUMP ?PRG90 ?CCL64: CALL STUFF,P-LEXV,AGAIN-LEXV CALL INBUF-STUFF,P-INBUF,OOPS-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 SUB LEN,1 GETB P-LEXV,STACK >?TMP1 SUB LEN,2 GETB P-LEXV,STACK ADD ?TMP1,STACK PUT OOPS-TABLE,O-END,STACK SET 'RESERVE-PTR,FALSE-VALUE SET 'LEN,P-LEN SET 'P-DIR,FALSE-VALUE SET 'P-NCN,0 SET 'P-GETFLAGS,0 ?PRG95: DLESS? 'P-LEN,0 \?CCL99 SET 'QUOTE-FLAG,FALSE-VALUE JUMP ?CND62 ?CCL99: GET P-LEXV,PTR >WRD ZERO? WRD \?CTR100 CALL NUMBER?,PTR >WRD ZERO? WRD /?CCL101 ?CTR100: ZERO? P-LEN \?CCL106 SET 'NW,0 JUMP ?CND104 ?CCL106: ADD PTR,P-LEXELEN GET P-LEXV,STACK >NW ?CND104: EQUAL? WRD,W?TO \?CCL109 EQUAL? VERB,ACT?TELL \?CCL109 SET 'WRD,W?QUOTE JUMP ?CND107 ?CCL109: EQUAL? WRD,W?THEN \?CND107 GRTR? P-LEN,0 \?CND107 ZERO? VERB \?CND107 ZERO? QUOTE-FLAG \?CND107 EQUAL? LW,0,W?PERIOD \?CCL119 SET 'WRD,W?THE JUMP ?CND107 ?CCL119: PUT P-ITBL,P-VERB,ACT?TELL PUT P-ITBL,P-VERBN,0 SET 'WRD,W?QUOTE ?CND107: EQUAL? WRD,W?THEN,W?PERIOD,W?QUOTE \?CCL122 EQUAL? WRD,W?QUOTE \?CND123 ZERO? QUOTE-FLAG /?CCL127 SET 'QUOTE-FLAG,FALSE-VALUE JUMP ?CND123 ?CCL127: SET 'QUOTE-FLAG,TRUE-VALUE ?CND123: ZERO? P-LEN /?PEN128 ADD PTR,P-LEXELEN >P-CONT ?PEN128: PUTB P-LEXV,P-LEXWORDS,P-LEN JUMP ?CND62 ?CCL122: CALL WT?,WRD,16,3 >VAL ZERO? VAL /?CCL131 EQUAL? VERB,FALSE-VALUE,ACT?WALK \?CCL131 EQUAL? LEN,1 /?CTR130 EQUAL? LEN,2 \?PRD137 EQUAL? VERB,ACT?WALK /?CTR130 ?PRD137: EQUAL? NW,W?THEN,W?PERIOD,W?QUOTE \?PRD140 LESS? LEN,2 \?CTR130 ?PRD140: ZERO? QUOTE-FLAG /?PRD143 EQUAL? LEN,2 \?PRD143 EQUAL? NW,W?QUOTE /?CTR130 ?PRD143: GRTR? LEN,2 \?CCL131 EQUAL? NW,W?COMMA,W?AND \?CCL131 ?CTR130: SET 'DIR,VAL EQUAL? NW,W?COMMA,W?AND \?CND149 ADD PTR,P-LEXELEN PUT P-LEXV,STACK,W?THEN ?CND149: GRTR? LEN,2 /?CND97 SET 'QUOTE-FLAG,FALSE-VALUE JUMP ?CND62 ?CCL131: CALL WT?,WRD,64,1 >VAL ZERO? VAL /?CCL154 ZERO? VERB \?CCL154 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 ?CND97 ?CCL154: CALL WT?,WRD,8,0 >VAL ZERO? VAL \?CTR157 EQUAL? WRD,W?ALL,W?ONE /?CTR157 CALL WT?,WRD,32 ZERO? STACK \?CTR157 CALL WT?,WRD,128 ZERO? STACK /?CCL158 ?CTR157: GRTR? P-LEN,1 \?CCL165 EQUAL? NW,W?OF \?CCL165 ZERO? VAL \?CCL165 EQUAL? WRD,W?ALL,W?ONE,W?A /?CCL165 SET 'OF-FLAG,TRUE-VALUE JUMP ?CND97 ?CCL165: ZERO? VAL /?CCL171 ZERO? P-LEN /?CTR170 EQUAL? NW,W?THEN,W?PERIOD \?CCL171 ?CTR170: SET 'P-END-ON-PREP,TRUE-VALUE LESS? P-NCN,2 \?CND97 PUT P-ITBL,P-PREP1,VAL PUT P-ITBL,P-PREP1N,WRD JUMP ?CND97 ?CCL171: EQUAL? P-NCN,2 \?CCL179 PRINTI "There were too many nouns in that sentence." CRLF RFALSE ?CCL179: INC 'P-NCN SET 'P-ACT,VERB CALL CLAUSE,PTR,VAL,WRD >PTR ZERO? PTR /FALSE LESS? PTR,0 \?CND97 SET 'QUOTE-FLAG,FALSE-VALUE ?CND62: PUT OOPS-TABLE,O-PTR,FALSE-VALUE ZERO? DIR /?CCL203 SET 'PRSA,V?WALK SET 'PRSO,DIR SET 'P-OFLAG,FALSE-VALUE SET 'P-WALK-DIR,DIR SET 'AGAIN-DIR,DIR RETURN AGAIN-DIR ?CCL158: EQUAL? WRD,W?OF \?CCL187 ZERO? OF-FLAG /?CTR189 EQUAL? NW,W?PERIOD,W?THEN \?CCL190 ?CTR189: CALL CANT-USE,PTR RFALSE ?CCL190: SET 'OF-FLAG,FALSE-VALUE ?CND97: SET 'LW,WRD ADD PTR,P-LEXELEN >PTR JUMP ?PRG95 ?CCL187: CALL WT?,WRD,4 ZERO? STACK \?CND97 EQUAL? VERB,ACT?TELL \?CCL195 CALL WT?,WRD,64,1 ZERO? STACK /?CCL195 EQUAL? WINNER,ADVENTURER \?CCL195 PRINTI "Please consult your manual for the correct way to talk to other people or creatures." CRLF RFALSE ?CCL195: CALL CANT-USE,PTR RFALSE ?CCL101: CALL UNKNOWN-WORD,PTR RFALSE ?CCL203: ZERO? P-OFLAG /?CND204 CALL ORPHAN-MERGE ?CND204: SET 'P-WALK-DIR,FALSE-VALUE SET 'AGAIN-DIR,FALSE-VALUE 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 STUFF,SRC,DEST,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,SRC,DEST,CNT GETB SRC,0 SUB STACK,1 >CNT ?PRG1: GETB SRC,CNT PUTB DEST,CNT,STACK DLESS? 'CNT,0 \?PRG1 RTRUE .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 BAND TYP,P-P1BITS >TYP EQUAL? TYP,B1 /?CND7 INC 'OFFS ?CND7: GETB PTR,OFFS 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 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 CALL 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?AND,W?COMMA \?CCL22 SET 'ANDFLG,TRUE-VALUE JUMP ?CND12 ?CCL22: EQUAL? WRD,W?ALL,W?ONE \?CCL24 EQUAL? NW,W?OF \?CND12 DEC 'P-LEN ADD PTR,P-LEXELEN >PTR JUMP ?CND12 ?CCL24: EQUAL? WRD,W?THEN,W?PERIOD /?CTR27 CALL WT?,WRD,8 ZERO? STACK /?CCL28 GET P-ITBL,P-VERB ZERO? STACK /?CCL28 ZERO? FIRST?? \?CCL28 ?CTR27: INC 'P-LEN ADD NUM,1 >?TMP1 MUL PTR,2 ADD P-LEXV,STACK PUT P-ITBL,?TMP1,STACK SUB PTR,P-LEXELEN RSTACK ?CCL28: CALL WT?,WRD,128 ZERO? STACK /?CCL35 GRTR? P-LEN,0 \?CCL38 EQUAL? NW,W?OF \?CCL38 EQUAL? WRD,W?ALL,W?ONE \?CND12 ?CCL38: CALL WT?,WRD,32,2 ZERO? STACK /?CCL42 ZERO? NW /?CCL42 CALL WT?,NW,128 ZERO? STACK \?CND12 ?CCL42: ZERO? ANDFLG \?CCL47 EQUAL? NW,W?BUT,W?EXCEPT /?CCL47 EQUAL? NW,W?AND,W?COMMA /?CCL47 ADD NUM,1 >?TMP1 ADD PTR,2 MUL STACK,2 ADD P-LEXV,STACK PUT P-ITBL,?TMP1,STACK RETURN PTR ?CCL47: SET 'ANDFLG,FALSE-VALUE JUMP ?CND12 ?CCL35: ZERO? P-MERGED \?PRD53 ZERO? P-OFLAG \?PRD53 GET P-ITBL,P-VERB ZERO? STACK /?CCL51 ?PRD53: CALL WT?,WRD,32 ZERO? STACK \?CND12 CALL WT?,WRD,4 ZERO? STACK \?CND12 ?CCL51: ZERO? ANDFLG /?CCL60 CALL WT?,WRD,16 ZERO? STACK \?CTR59 CALL WT?,WRD,64 ZERO? STACK /?CCL60 ?CTR59: SUB PTR,4 >PTR ADD PTR,2 PUT P-LEXV,STACK,W?THEN ADD P-LEN,2 >P-LEN ?CND12: SET 'LW,WRD SET 'FIRST??,FALSE-VALUE ADD PTR,P-LEXELEN >PTR JUMP ?PRG8 ?CCL60: CALL WT?,WRD,8 ZERO? STACK \?CND12 CALL CANT-USE,PTR RFALSE ?CCL14: CALL UNKNOWN-WORD,PTR RFALSE .FUNCT NUMBER?,PTR,CNT,BPTR,CHR,SUM=0,TIM=0,?TMP1 MUL PTR,2 ADD P-LEXV,STACK GETB STACK,2 >CNT MUL PTR,2 ADD P-LEXV,STACK GETB STACK,3 >BPTR ?PRG1: DLESS? 'CNT,0 /?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=-1,TEMP,VERB,BEG,END,ADJ=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 'ADJ,TRUE-VALUE JUMP ?CND1 ?CCL3: 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 /?CCL11 ZERO? ADJ \?CCL11 GET P-OTBL,P-VERB EQUAL? VERB,STACK \FALSE ?CCL11: EQUAL? P-NCN,2 /FALSE GET P-OTBL,P-NC1 EQUAL? STACK,1 \?CCL18 GET P-ITBL,P-PREP1 >TEMP GET P-OTBL,P-PREP1 EQUAL? TEMP,STACK /?CTR20 ZERO? TEMP \FALSE ?CTR20: ZERO? ADJ /?CCL26 ADD P-LEXV,2 PUT P-OTBL,P-NC1,STACK GET P-ITBL,P-NC1L ZERO? STACK \?CND27 ADD P-LEXV,6 PUT P-ITBL,P-NC1L,STACK ?CND27: ZERO? P-NCN \?CND24 SET 'P-NCN,1 JUMP ?CND24 ?CCL26: GET P-ITBL,P-NC1 PUT P-OTBL,P-NC1,STACK ?CND24: GET P-ITBL,P-NC1L PUT P-OTBL,P-NC1L,STACK JUMP ?CND9 ?CCL18: GET P-OTBL,P-NC2 EQUAL? STACK,1 \?CCL32 GET P-ITBL,P-PREP1 >TEMP GET P-OTBL,P-PREP2 EQUAL? TEMP,STACK /?CTR34 ZERO? TEMP \FALSE ?CTR34: ZERO? ADJ /?CND38 ADD P-LEXV,2 PUT P-ITBL,P-NC1,STACK GET P-ITBL,P-NC1L ZERO? STACK \?CND38 ADD P-LEXV,6 PUT P-ITBL,P-NC1L,STACK ?CND38: 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 ?CND9 ?CCL32: ZERO? P-ACLAUSE /?CND9 EQUAL? P-NCN,1 /?CCL45 ZERO? ADJ \?CCL45 SET 'P-ACLAUSE,FALSE-VALUE RFALSE ?CCL45: GET P-ITBL,P-NC1 >BEG ZERO? ADJ /?CND48 ADD P-LEXV,2 >BEG SET 'ADJ,FALSE-VALUE ?CND48: GET P-ITBL,P-NC1L >END ?PRG50: GET BEG,0 >WRD EQUAL? BEG,END \?CCL54 ZERO? ADJ /?CCL57 CALL ACLAUSE-WIN,ADJ JUMP ?CND9 ?CCL57: SET 'P-ACLAUSE,FALSE-VALUE RFALSE ?CCL54: ZERO? ADJ \?CCL59 GETB WRD,P-PSOFF BTST STACK,32 /?CTR58 EQUAL? WRD,W?ALL,W?ONE \?CCL59 ?CTR58: SET 'ADJ,WRD ?CND52: ADD BEG,P-WORDLEN >BEG ZERO? END \?PRG50 SET 'END,BEG SET 'P-NCN,1 SUB BEG,4 PUT P-ITBL,P-NC1,STACK PUT P-ITBL,P-NC1L,BEG JUMP ?PRG50 ?CCL59: EQUAL? WRD,W?ONE \?CCL65 CALL ACLAUSE-WIN,ADJ JUMP ?CND9 ?CCL65: GETB WRD,P-PSOFF BTST STACK,128 \?CND52 EQUAL? WRD,P-ANAM \?CCL69 CALL ACLAUSE-WIN,ADJ JUMP ?CND9 ?CCL69: CALL NCLAUSE-WIN ?CND9: 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 ?PRG72: IGRTR? 'CNT,P-ITBLLEN \?CCL76 SET 'P-MERGED,TRUE-VALUE RTRUE ?CCL76: GET P-OTBL,CNT PUT P-ITBL,CNT,STACK JUMP ?PRG72 .FUNCT ACLAUSE-WIN,ADJ GET P-OTBL,P-VERB PUT P-ITBL,P-VERB,STACK 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 CALL CLAUSE-COPY,P-OTBL,P-OTBL,ADJ GET P-OTBL,P-NC2 ZERO? STACK /?PEN1 SET 'P-NCN,2 ?PEN1: 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 CALL 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 PUT OOPS-TABLE,O-PTR,PTR EQUAL? PRSA,V?SAY \?PRG5 PRINTI "Nothing happens." CRLF RFALSE ?PRG5: 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 EQUAL? PRSA,V?SAY \?PRG5 PRINTI "Nothing happens." CRLF RFALSE ?PRG5: 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 PRINTI """ in a way that I don't understand." CRLF SET 'QUOTE-FLAG,FALSE-VALUE SET 'P-OFLAG,FALSE-VALUE RETURN P-OFLAG .FUNCT GET-PREP,SYN,WHICH,PREP EQUAL? WHICH,1 \?CCL3 GETB SYN,P-SPREP1 >PREP JUMP ?CND1 ?CCL3: GETB SYN,P-SPREP2 >PREP ?CND1: BAND PREP,63 >PREP ZERO? PREP /FALSE ADD PREP,192 RSTACK .FUNCT SYNTAX-CHECK,SYN,LEN,NUM,OBJ,DRIVE1=0,DRIVE2=0,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-SPREP1 DIV STACK,64 >NUM GRTR? P-NCN,NUM /?CND7 LESS? NUM,1 /?CCL11 ZERO? P-NCN \?CCL11 GET P-ITBL,P-PREP1 >PREP ZERO? PREP /?CTR10 CALL GET-PREP,SYN,1 EQUAL? PREP,STACK \?CCL11 ?CTR10: SET 'DRIVE1,SYN JUMP ?CND7 ?CCL11: CALL GET-PREP,SYN,1 >?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 \?CCL28 ZERO? DRIVE1 \?REP6 ZERO? DRIVE2 \?REP6 PRINTI "That sentence isn't one I recognize." CRLF RFALSE ?CCL20: GRTR? NUM,1 \?CCL23 CALL GET-PREP,SYN,2 >?TMP1 GET P-ITBL,P-PREP2 EQUAL? ?TMP1,STACK \?CND7 ?CCL23: CALL SYNTAX-FOUND,SYN RTRUE ?CCL28: ZERO? NUM \?CCL38 ADD SYN,P-SYNLEN-0 >SYN JUMP ?PRG5 ?CCL38: EQUAL? NUM,1 \?CCL40 ADD SYN,P-SYNLEN-1 >SYN JUMP ?PRG5 ?CCL40: ADD SYN,P-SYNLEN-2 >SYN JUMP ?PRG5 ?REP6: ZERO? DRIVE1 /?CCL43 GETB DRIVE1,P-SFWIM1 >?TMP2 GETB DRIVE1,P-SLOC1 >?TMP1 CALL GET-PREP,DRIVE1,1 CALL GWIM,?TMP2,?TMP1,STACK >OBJ ZERO? OBJ /?CCL43 PUT P-PRSO,P-MATCHLEN,1 PUT P-PRSO,1,OBJ CALL SYNTAX-FOUND,DRIVE1 RSTACK ?CCL43: ZERO? DRIVE2 /?CCL47 GETB DRIVE2,P-SFWIM2 >?TMP2 GETB DRIVE2,P-SLOC2 >?TMP1 CALL GET-PREP,DRIVE2,2 CALL GWIM,?TMP2,?TMP1,STACK >OBJ ZERO? OBJ /?CCL47 PUT P-PRSI,P-MATCHLEN,1 PUT P-PRSI,1,OBJ CALL SYNTAX-FOUND,DRIVE2 RSTACK ?CCL47: EQUAL? VERB,ACT?FIND \?CCL51 PRINTI "That question can't be answered." CRLF RFALSE ?CCL51: EQUAL? WINNER,ADVENTURER /?CCL55 CALL CANT-ORPHAN RSTACK ?CCL55: CALL ORPHAN,DRIVE1,DRIVE2 PRINTI "What do you want to " GET P-OTBL,P-VERBN >TMP ZERO? TMP \?CCL60 PRINTI "tell" JUMP ?CND58 ?CCL60: GETB P-VTBL,2 ZERO? STACK \?CCL64 GET TMP,0 PRINTB STACK JUMP ?CND58 ?CCL64: GETB TMP,2 >?TMP1 GETB TMP,3 CALL WORD-PRINT,?TMP1,STACK PUTB P-VTBL,2,0 ?CND58: ZERO? DRIVE2 /?CND65 PRINTC 32 CALL THING-PRINT,TRUE-VALUE,TRUE-VALUE ?CND65: SET 'P-OFLAG,TRUE-VALUE ZERO? DRIVE1 /?CCL71 CALL GET-PREP,DRIVE1,1 JUMP ?CND69 ?CCL71: CALL GET-PREP,DRIVE2,2 ?CND69: CALL PREP-PRINT,STACK PRINTC 63 CRLF RFALSE .FUNCT CANT-ORPHAN PRINTI """I don't understand! What are you referring to?""" CRLF RFALSE .FUNCT ORPHAN,D1,D2,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 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-DBPTR,P-NC1 PUT P-CCTBL,CC-DEPTR,P-NC1L CALL CLAUSE-COPY,P-ITBL,P-OTBL ?CND10: ZERO? D1 /?CCL14 CALL GET-PREP,D1,1 PUT P-OTBL,P-PREP1,STACK PUT P-OTBL,P-NC1,1 RTRUE ?CCL14: ZERO? D2 /FALSE CALL GET-PREP,D2,2 PUT P-OTBL,P-PREP2,STACK PUT P-OTBL,P-NC2,1 RTRUE .FUNCT THING-PRINT,PRSO?,THE?=0,BEG,END ZERO? PRSO? /?CCL3 GET P-ITBL,P-NC1 >BEG GET P-ITBL,P-NC1L >END JUMP ?CND1 ?CCL3: GET P-ITBL,P-NC2 >BEG GET P-ITBL,P-NC2L >END ?CND1: CALL BUFFER-PRINT,BEG,END,THE? RSTACK .FUNCT BUFFER-PRINT,BEG,END,CP,NOSP=1,WRD,FIRST??=1,PN=0,Q?=0,?TMP1 ?PRG1: EQUAL? BEG,END /TRUE GET BEG,0 >WRD EQUAL? WRD,W?COMMA \?CCL8 PRINTI ", " JUMP ?CND6 ?CCL8: ZERO? NOSP /?PRG13 SET 'NOSP,FALSE-VALUE JUMP ?CND6 ?PRG13: PRINTC 32 ?CND6: EQUAL? WRD,W?PERIOD,W?COMMA \?CCL17 SET 'NOSP,TRUE-VALUE JUMP ?CND3 ?CCL17: EQUAL? WRD,W?ME \?CCL19 PRINTD ME SET 'PN,TRUE-VALUE JUMP ?CND3 ?CCL19: EQUAL? WRD,W?INTNUM \?CCL21 PRINTN P-NUMBER SET 'PN,TRUE-VALUE JUMP ?CND3 ?CCL21: ZERO? FIRST?? /?CND22 ZERO? PN \?CND22 ZERO? CP /?CND22 PRINTI "the " ?CND22: ZERO? P-OFLAG \?CTR30 ZERO? P-MERGED /?CCL31 ?CTR30: PRINTB WRD JUMP ?CND29 ?CCL31: EQUAL? WRD,W?IT \?CCL35 CALL ACCESSIBLE?,P-IT-OBJECT ZERO? STACK /?CCL35 PRINTD P-IT-OBJECT JUMP ?CND29 ?CCL35: GETB BEG,2 >?TMP1 GETB BEG,3 CALL WORD-PRINT,?TMP1,STACK ?CND29: SET 'FIRST??,FALSE-VALUE ?CND3: ADD BEG,P-WORDLEN >BEG JUMP ?PRG1 .FUNCT PREP-PRINT,PREP,WRD ZERO? PREP /FALSE PRINTC 32 CALL PREP-FIND,PREP >WRD PRINTB WRD RTRUE .FUNCT CLAUSE-COPY,SRC,DEST,INSRT=0,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 CALL CLAUSE-ADD,INSRT ?CND6: GET BEG,0 CALL 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=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 40 ZERO? PREP /?PRG31 ZERO? P-END-ON-PREP \?PRG31 CALL PREP-FIND,PREP >PREP PRINTB PREP EQUAL? PREP,W?OUT \?PRG20 PRINTI " of" ?PRG20: PRINTC 32 EQUAL? OBJ,HANDS \?PRG27 PRINTI "your hands" JUMP ?PRG29 ?PRG27: PRINTI "the " PRINTD OBJ ?PRG29: PRINTC 41 CRLF RETURN OBJ ?PRG31: PRINTD OBJ PRINTC 41 CRLF RETURN OBJ ?CCL5: SET 'P-GWIMBIT,0 RFALSE .FUNCT SNARF-OBJECTS,OPTR,IPTR,L PUT P-BUTS,P-MATCHLEN,0 GET P-ITBL,P-NC2 >IPTR ZERO? IPTR /?CND1 GETB P-SYNTAX,P-SLOC2 >P-SLOCBITS GET P-ITBL,P-NC2L CALL SNARFEM,IPTR,STACK,P-PRSI ZERO? STACK /FALSE ?CND1: GET P-ITBL,P-NC1 >OPTR ZERO? OPTR /?CND5 GETB P-SYNTAX,P-SLOC1 >P-SLOCBITS GET P-ITBL,P-NC1L CALL SNARFEM,OPTR,STACK,P-PRSO ZERO? STACK /FALSE ?CND5: GET P-BUTS,P-MATCHLEN ZERO? STACK /TRUE GET P-PRSO,P-MATCHLEN >L ZERO? OPTR /?CND11 CALL BUT-MERGE,P-PRSO >P-PRSO ?CND11: ZERO? IPTR /TRUE ZERO? OPTR /?CCL14 GET P-PRSO,P-MATCHLEN EQUAL? L,STACK \TRUE ?CCL14: 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 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 \?CCL18 SET 'P-GETFLAGS,P-ALL EQUAL? NW,W?OF \?CND5 ADD PTR,P-WORDLEN >PTR JUMP ?CND5 ?CCL18: EQUAL? WRD,W?BUT,W?EXCEPT \?CCL22 ZERO? BUT /?PRD27 PUSH BUT JUMP ?PEN25 ?PRD27: PUSH TBL ?PEN25: CALL GET-OBJECT,STACK ZERO? STACK /FALSE SET 'BUT,P-BUTS PUT BUT,P-MATCHLEN,0 JUMP ?CND5 ?CCL22: EQUAL? WRD,W?A,W?ONE \?CCL29 ZERO? P-ADJ \?CCL32 SET 'P-GETFLAGS,P-ONE EQUAL? NW,W?OF \?CND5 ADD PTR,P-WORDLEN >PTR JUMP ?CND5 ?CCL32: SET 'P-NAM,P-ONEOBJ ZERO? BUT /?PRD39 PUSH BUT JUMP ?PEN37 ?PRD39: PUSH TBL ?PEN37: CALL GET-OBJECT,STACK ZERO? STACK /FALSE ZERO? NW \?CND5 RTRUE ?CCL29: EQUAL? WRD,W?AND,W?COMMA \?CCL43 EQUAL? NW,W?AND,W?COMMA /?CCL43 SET 'P-AND,TRUE-VALUE ZERO? BUT /?PRD50 PUSH BUT JUMP ?PEN48 ?PRD50: PUSH TBL ?PEN48: CALL GET-OBJECT,STACK ZERO? STACK \?CND5 RFALSE ?CCL43: CALL WT?,WRD,4 ZERO? STACK \?CND5 EQUAL? WRD,W?AND,W?COMMA /?CND5 EQUAL? WRD,W?OF \?CCL54 ZERO? P-GETFLAGS \?CND5 SET 'P-GETFLAGS,P-INHIBIT JUMP ?CND5 ?CCL54: CALL WT?,WRD,32,2 >WV ZERO? WV /?CCL58 ZERO? P-ADJ \?CCL58 SET 'P-ADJ,WV SET 'P-ADJN,WRD JUMP ?CND5 ?CCL58: 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 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 /?CND3 SET 'P-NAM,P-ADJN SET 'P-ADJ,FALSE-VALUE ?CND3: ZERO? P-NAM \?CND9 ZERO? P-ADJ \?CND9 EQUAL? P-GETFLAGS,P-ALL /?CND9 ZERO? P-GWIMBIT \?CND9 ZERO? VRB /FALSE PRINTI "There seems to be a noun missing in that sentence!" CRLF RFALSE ?CND9: 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 /?CND28 FCLEAR ADVENTURER,TRANSBIT CALL DO-SL,HERE,SOG,SIR FSET ADVENTURER,TRANSBIT ?CND28: CALL DO-SL,ADVENTURER,SH,SC ?CND25: GET TBL,P-MATCHLEN SUB STACK,TLEN >LEN BTST P-GETFLAGS,P-ALL /?CND30 BTST P-GETFLAGS,P-ONE \?CCL33 ZERO? LEN /?CCL33 EQUAL? LEN,1 /?CND36 RANDOM LEN GET TBL,STACK PUT TBL,1,STACK PRINTI "(How about the " GET TBL,1 PRINTD STACK PRINTI "?)" CRLF ?CND36: PUT TBL,P-MATCHLEN,1 JUMP ?CND30 ?CCL33: GRTR? LEN,1 /?CCL42 ZERO? LEN \?CND30 EQUAL? P-SLOCBITS,-1 /?CND30 ?CCL42: EQUAL? P-SLOCBITS,-1 \?CCL49 SET 'P-SLOCBITS,XBITS SET 'OLEN,LEN GET TBL,P-MATCHLEN SUB STACK,LEN PUT TBL,P-MATCHLEN,STACK JUMP ?PRG23 ?CCL49: ZERO? LEN \?CND50 SET 'LEN,OLEN ?CND50: EQUAL? WINNER,ADVENTURER /?CCL54 CALL CANT-ORPHAN RFALSE ?CCL54: ZERO? VRB /?CCL56 ZERO? P-NAM /?CCL56 CALL WHICH-PRINT,TLEN,LEN,TBL EQUAL? TBL,P-PRSO \?CCL61 SET 'P-ACLAUSE,P-NC1 JUMP ?CND59 ?CCL61: SET 'P-ACLAUSE,P-NC2 ?CND59: SET 'P-AADJ,P-ADJ SET 'P-ANAM,P-NAM CALL ORPHAN,FALSE-VALUE,FALSE-VALUE SET 'P-OFLAG,TRUE-VALUE JUMP ?CND52 ?CCL56: ZERO? VRB /?CND52 PRINTI "There seems to be a noun missing in that sentence!" CRLF ?CND52: SET 'P-NAM,FALSE-VALUE SET 'P-ADJ,FALSE-VALUE RFALSE ?CND30: ZERO? LEN \?CCL67 ZERO? GCHECK /?CCL67 ZERO? VRB /?CND70 SET 'P-SLOCBITS,XBITS ZERO? LIT \?CTR73 EQUAL? PRSA,V?TELL \?PRG77 ?CTR73: 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 ?PRG77: PRINT TOO-DARK CRLF ?CND70: SET 'P-NAM,FALSE-VALUE SET 'P-ADJ,FALSE-VALUE RFALSE ?CCL67: ZERO? LEN \?CND65 SET 'GCHECK,TRUE-VALUE JUMP ?PRG23 ?CND65: SET 'P-SLOCBITS,XBITS SET 'P-NAM,FALSE-VALUE SET 'P-ADJ,FALSE-VALUE RTRUE .FUNCT WHICH-PRINT,TLEN,LEN,TBL,OBJ,RLEN SET 'RLEN,LEN PRINTI "Which " ZERO? P-OFLAG \?CTR4 ZERO? P-MERGED \?CTR4 ZERO? P-AND /?CCL5 ?CTR4: ZERO? P-NAM /?CCL11 PUSH P-NAM JUMP ?CND9 ?CCL11: ZERO? P-ADJ /?CCL13 PUSH P-ADJN JUMP ?CND9 ?CCL13: PUSH W?ONE ?CND9: PRINTB STACK JUMP ?PRG16 ?CCL5: EQUAL? TBL,P-PRSO /?PRD14 PUSH 0 JUMP ?PRD15 ?PRD14: PUSH 1 ?PRD15: CALL THING-PRINT,STACK ?PRG16: PRINTI " do you mean, " ?PRG18: INC 'TLEN GET TBL,TLEN >OBJ PRINTI "the " PRINTD OBJ EQUAL? LEN,2 \?CCL24 EQUAL? RLEN,2 /?PRG29 PRINTC 44 ?PRG29: PRINTI " or " JUMP ?CND22 ?CCL24: GRTR? LEN,2 \?CND22 PRINTI ", " ?CND22: DLESS? 'LEN,1 \?PRG18 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,TBL ZERO? STACK /?CND5 CALL OBJ-FOUND,OBJ,TBL ?CND5: IGRTR? 'CNT,RMGL \?PRG3 ?CND1: GETPT HERE,P?PSEUDO >RMG ZERO? RMG /?CND9 PTSIZE RMG DIV STACK,4 SUB STACK,1 >RMGL SET 'CNT,0 ?PRG11: MUL CNT,2 GET RMG,STACK EQUAL? P-NAM,STACK \?CCL15 MUL CNT,2 ADD STACK,1 GET RMG,STACK PUTP PSEUDO-OBJECT,P?ACTION,STACK GETPT PSEUDO-OBJECT,P?ACTION SUB STACK,5 >FOO GET P-NAM,0 PUT FOO,0,STACK GET P-NAM,1 PUT FOO,1,STACK CALL OBJ-FOUND,PSEUDO-OBJECT,TBL JUMP ?CND9 ?CCL15: IGRTR? '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 GET TBL,P-MATCHLEN ZERO? STACK \FALSE EQUAL? PRSA,V?LOOK-INSIDE,V?SEARCH,V?EXAMINE \FALSE CALL DO-SL,ROOMS,1,1 RSTACK .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 CALL OBJ-FOUND,OBJ,TBL ?CND6: ZERO? LVL \?PRD14 FSET? OBJ,SEARCHBIT /?PRD14 FSET? OBJ,SURFACEBIT \?CND11 ?PRD14: FIRST? OBJ >NOBJ \?CND11 FSET? OBJ,OPENBIT /?CCL12 FSET? OBJ,TRANSBIT \?CND11 ?CCL12: FSET? OBJ,SURFACEBIT \?CCL23 PUSH P-SRCALL JUMP ?CND21 ?CCL23: FSET? OBJ,SEARCHBIT \?CCL25 PUSH P-SRCALL JUMP ?CND21 ?CCL25: PUSH P-SRCTOP ?CND21: 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,N GETB P-SYNTAX,P-SPREP1 DIV STACK,64 >N GRTR? N,0 \TRUE GETB P-SYNTAX,P-SLOC1 CALL ITAKE-CHECK,P-PRSO,STACK ZERO? STACK /FALSE GRTR? N,1 \TRUE 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 CALL ACCESSIBLE?,P-IT-OBJECT ZERO? STACK \?CCL17 PRINT REFERRING RFALSE ?CCL17: SET 'OBJ,P-IT-OBJECT ?CND13: CALL HELD?,OBJ ZERO? STACK \?PRG8 EQUAL? OBJ,HANDS,ME /?PRG8 SET 'PRSO,OBJ FSET? OBJ,TRYTAKEBIT \?CCL26 SET 'TAKEN,TRUE-VALUE JUMP ?CND24 ?CCL26: EQUAL? WINNER,ADVENTURER /?CCL28 SET 'TAKEN,FALSE-VALUE JUMP ?CND24 ?CCL28: BTST IBITS,STAKE \?CCL30 CALL ITAKE,FALSE-VALUE EQUAL? STACK,TRUE-VALUE \?CCL30 SET 'TAKEN,FALSE-VALUE JUMP ?CND24 ?CCL30: SET 'TAKEN,TRUE-VALUE ?CND24: ZERO? TAKEN /?CCL35 BTST IBITS,SHAVE \?CCL35 EQUAL? WINNER,ADVENTURER \?CCL35 EQUAL? OBJ,NOT-HERE-OBJECT \?PRG43 PRINTI "You don't have that!" CRLF RFALSE ?PRG43: PRINTI "You don't have the " PRINTD OBJ PRINT PERIOD-CR RFALSE ?CCL35: ZERO? TAKEN \?PRG8 EQUAL? WINNER,ADVENTURER \?PRG8 PRINTI "(Taken)" CRLF JUMP ?PRG8 .FUNCT MANY-CHECK,LOSS=0,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 CALL WORD-PRINT,?TMP1,STACK ?PRG29: 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 \?CCL10 MUL CNT,2 ADD TBL,STACK RSTACK ?CCL10: 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 ZERO? ALWAYS-LIT /?CND1 EQUAL? WINNER,ADVENTURER /TRUE ?CND1: SET 'P-GWIMBIT,ONBIT SET 'OHERE,HERE SET 'HERE,RM ZERO? RMBIT /?CCL7 FSET? RM,ONBIT \?CCL7 SET 'LIT,TRUE-VALUE JUMP ?CND5 ?CCL7: PUT P-MERGE,P-MATCHLEN,0 SET 'P-TABLE,P-MERGE SET 'P-SLOCBITS,-1 EQUAL? OHERE,RM \?CND10 CALL DO-SL,WINNER,1,1 EQUAL? WINNER,ADVENTURER /?CND10 IN? ADVENTURER,RM \?CND10 CALL DO-SL,ADVENTURER,1,1 ?CND10: CALL DO-SL,RM,1,1 GET P-TABLE,P-MATCHLEN GRTR? STACK,0 \?CND5 SET 'LIT,TRUE-VALUE ?CND5: SET 'HERE,OHERE SET 'P-GWIMBIT,0 RETURN LIT .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 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 .FUNCT ACCESSIBLE?,OBJ,L,?TMP1 LOC OBJ >L FSET? OBJ,INVISIBLE /FALSE ZERO? L /FALSE EQUAL? L,GLOBAL-OBJECTS /TRUE EQUAL? L,LOCAL-GLOBALS \?CCL9 CALL GLOBAL-IN?,OBJ,HERE ZERO? STACK \TRUE ?CCL9: CALL META-LOC,OBJ >?TMP1 LOC WINNER EQUAL? ?TMP1,HERE,STACK \FALSE LOC WINNER EQUAL? L,WINNER,HERE,STACK /TRUE FSET? L,OPENBIT \FALSE CALL ACCESSIBLE?,L ZERO? STACK /FALSE RTRUE .FUNCT META-LOC,OBJ ?PRG1: ZERO? OBJ /FALSE IN? OBJ,GLOBAL-OBJECTS \?CND3 RETURN GLOBAL-OBJECTS ?CND3: IN? OBJ,ROOMS \?CCL9 RETURN OBJ ?CCL9: LOC OBJ >OBJ JUMP ?PRG1 .ENDI