.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 \?ELS5 JUMP ?REP2 ?ELS5: ZERO? P-OFLAG \?CND8 GET P-ITBL,CNT PUT P-OTBL,CNT,STACK ?CND8: 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 \?CND11 EQUAL? WINNER,PLAYER /?CND11 SET 'WINNER,PLAYER CALL META-LOC,PLAYER >HERE CALL LIT?,HERE >LIT ?CND11: ZERO? RESERVE-PTR /?ELS18 SET 'PTR,RESERVE-PTR CALL STUFF,RESERVE-LEXV,P-LEXV ZERO? SUPER-BRIEF \?CND20 EQUAL? PLAYER,WINNER \?CND20 CRLF ?CND20: SET 'RESERVE-PTR,FALSE-VALUE SET 'P-CONT,FALSE-VALUE JUMP ?CND16 ?ELS18: ZERO? P-CONT /?ELS26 SET 'PTR,P-CONT ZERO? SUPER-BRIEF \?CND28 EQUAL? PLAYER,WINNER \?CND28 EQUAL? PRSA,V?SAY /?CND28 CRLF ?CND28: SET 'P-CONT,FALSE-VALUE JUMP ?CND16 ?ELS26: SET 'WINNER,PLAYER SET 'QUOTE-FLAG,FALSE-VALUE LOC WINNER FSET? STACK,VEHBIT /?CND35 LOC WINNER >HERE ?CND35: CALL LIT?,HERE >LIT ZERO? SUPER-BRIEF \?CND38 CRLF ?CND38: PRINTI ">" READ P-INBUF,P-LEXV ?CND16: GETB P-LEXV,P-LEXWORDS >P-LEN ZERO? P-LEN \?CND43 PRINTI "I beg your pardon?" CRLF RFALSE ?CND43: GET P-LEXV,PTR >WRD EQUAL? WRD,W?OOPS \?ELS50 ADD PTR,P-LEXELEN GET P-LEXV,STACK EQUAL? STACK,W?PERIOD,W?COMMA \?CND51 ADD PTR,P-LEXELEN >PTR DEC 'P-LEN ?CND51: GRTR? P-LEN,1 /?ELS56 PRINTI "I can't help your clumsiness." CRLF RFALSE ?ELS56: GET OOPS-TABLE,O-PTR ZERO? STACK /?ELS60 GRTR? P-LEN,2 \?ELS63 ADD PTR,P-LEXELEN GET P-LEXV,STACK EQUAL? STACK,W?QUOTE \?ELS63 PRINTI "Sorry, you can't correct mistakes in quoted text." CRLF RFALSE ?ELS63: GRTR? P-LEN,2 \?CND61 PRINTI "Warning: only the first word after OOPS is used." CRLF ?CND61: 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 ?CND48 ?ELS60: PUT OOPS-TABLE,O-END,FALSE-VALUE PRINTI "There was no word to replace!" CRLF RFALSE ?ELS50: EQUAL? WRD,W?AGAIN,W?G /?CND78 SET 'P-NUMBER,0 ?CND78: PUT OOPS-TABLE,O-END,FALSE-VALUE ?CND48: GET P-LEXV,PTR EQUAL? STACK,W?AGAIN,W?G \?ELS83 GETB OOPS-INBUF,1 ZERO? STACK \?ELS86 PRINTI "Beg pardon?" CRLF RFALSE ?ELS86: ZERO? P-OFLAG /?ELS90 PRINTI "It's difficult to repeat fragments." CRLF RFALSE ?ELS90: ZERO? P-WON \?ELS95 PRINTI "That would just repeat a mistake." CRLF RFALSE ?ELS95: GRTR? P-LEN,1 \?ELS99 ADD PTR,P-LEXELEN GET P-LEXV,STACK EQUAL? STACK,W?PERIOD,W?COMMA,W?THEN /?THN103 ADD PTR,P-LEXELEN GET P-LEXV,STACK EQUAL? STACK,W?AND \?ELS102 ?THN103: MUL 2,P-LEXELEN ADD PTR,STACK >PTR GETB P-LEXV,P-LEXWORDS SUB STACK,2 PUTB P-LEXV,P-LEXWORDS,STACK JUMP ?CND84 ?ELS102: PRINTI "I couldn't understand that sentence." CRLF RFALSE ?ELS99: ADD PTR,P-LEXELEN >PTR GETB P-LEXV,P-LEXWORDS SUB STACK,1 PUTB P-LEXV,P-LEXWORDS,STACK ?CND84: GETB P-LEXV,P-LEXWORDS GRTR? STACK,0 \?ELS113 CALL STUFF,P-LEXV,RESERVE-LEXV SET 'RESERVE-PTR,PTR JUMP ?CND111 ?ELS113: SET 'RESERVE-PTR,FALSE-VALUE ?CND111: 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 ?PRG116: IGRTR? 'CNT,P-ITBLLEN \?ELS120 JUMP ?CND81 ?ELS120: GET P-OTBL,CNT PUT P-ITBL,CNT,STACK JUMP ?PRG116 ?ELS83: 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 ?PRG125: DLESS? 'P-LEN,0 \?ELS129 SET 'QUOTE-FLAG,FALSE-VALUE JUMP ?CND81 ?ELS129: GET P-LEXV,PTR >WRD ZERO? WRD \?THN132 CALL NUMBER?,PTR >WRD ZERO? WRD /?ELS131 ?THN132: ZERO? P-LEN \?ELS136 SET 'NW,0 JUMP ?CND134 ?ELS136: ADD PTR,P-LEXELEN GET P-LEXV,STACK >NW ?CND134: EQUAL? WRD,W?TO \?ELS141 EQUAL? VERB,ACT?TELL \?ELS141 SET 'WRD,W?QUOTE JUMP ?CND139 ?ELS141: EQUAL? WRD,W?THEN \?CND139 GRTR? P-LEN,0 \?CND139 ZERO? VERB \?CND139 ZERO? QUOTE-FLAG \?CND139 EQUAL? LW,0,W?PERIOD \?ELS150 SET 'WRD,W?THE JUMP ?CND139 ?ELS150: PUT P-ITBL,P-VERB,ACT?TELL PUT P-ITBL,P-VERBN,0 SET 'WRD,W?QUOTE ?CND139: EQUAL? WRD,W?THEN,W?PERIOD,W?QUOTE \?ELS155 EQUAL? WRD,W?QUOTE \?CND156 ZERO? QUOTE-FLAG /?ELS161 SET 'QUOTE-FLAG,FALSE-VALUE JUMP ?CND156 ?ELS161: SET 'QUOTE-FLAG,TRUE-VALUE ?CND156: ZERO? P-LEN /?THN165 ADD PTR,P-LEXELEN >P-CONT ?THN165: PUTB P-LEXV,P-LEXWORDS,P-LEN JUMP ?CND81 ?ELS155: CALL WT?,WRD,PS?DIRECTION,P1?DIRECTION >VAL ZERO? VAL /?ELS168 EQUAL? VERB,FALSE-VALUE,ACT?WALK \?ELS168 EQUAL? LEN,1 /?THN171 EQUAL? LEN,2 \?ELS174 EQUAL? VERB,ACT?WALK /?THN171 ?ELS174: EQUAL? NW,W?THEN,W?PERIOD,W?QUOTE \?ELS176 LESS? LEN,2 \?THN171 ?ELS176: ZERO? QUOTE-FLAG /?ELS178 EQUAL? LEN,2 \?ELS178 EQUAL? NW,W?QUOTE /?THN171 ?ELS178: GRTR? LEN,2 \?ELS168 EQUAL? NW,W?COMMA,W?AND \?ELS168 ?THN171: SET 'DIR,VAL EQUAL? NW,W?COMMA,W?AND \?CND181 ADD PTR,P-LEXELEN PUT P-LEXV,STACK,W?THEN ?CND181: GRTR? LEN,2 /?CND127 SET 'QUOTE-FLAG,FALSE-VALUE JUMP ?CND81 ?ELS168: CALL WT?,WRD,PS?VERB,P1?VERB >VAL ZERO? VAL /?ELS188 ZERO? VERB \?ELS188 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 ?CND127 ?ELS188: CALL WT?,WRD,PS?PREPOSITION,0 >VAL ZERO? VAL \?THN193 EQUAL? WRD,W?ALL,W?ONE /?THN197 CALL WT?,WRD,PS?ADJECTIVE ZERO? STACK \?THN197 CALL WT?,WRD,PS?OBJECT ZERO? STACK /?ELS192 ?THN197: SET 'VAL,0 \?ELS192 ?THN193: GRTR? P-LEN,1 \?ELS201 EQUAL? NW,W?OF \?ELS201 ZERO? VAL \?ELS201 EQUAL? WRD,W?ALL,W?ONE,W?A /?ELS201 SET 'OF-FLAG,TRUE-VALUE JUMP ?CND127 ?ELS201: ZERO? VAL /?ELS205 ZERO? P-LEN /?THN208 EQUAL? NW,W?THEN,W?PERIOD \?ELS205 ?THN208: SET 'P-END-ON-PREP,TRUE-VALUE LESS? P-NCN,2 \?CND127 PUT P-ITBL,P-PREP1,VAL PUT P-ITBL,P-PREP1N,WRD JUMP ?CND127 ?ELS205: EQUAL? P-NCN,2 \?ELS214 PRINTI "There were too many nouns in that sentence." CRLF RFALSE ?ELS214: INC 'P-NCN SET 'P-ACT,VERB CALL CLAUSE,PTR,VAL,WRD >PTR ZERO? PTR /FALSE LESS? PTR,0 \?CND127 SET 'QUOTE-FLAG,FALSE-VALUE JUMP ?CND81 ?ELS192: EQUAL? WRD,W?OF \?ELS225 ZERO? OF-FLAG /?THN229 EQUAL? NW,W?PERIOD,W?THEN \?ELS228 ?THN229: CALL CANT-USE,PTR RFALSE ?ELS228: SET 'OF-FLAG,FALSE-VALUE JUMP ?CND127 ?ELS225: CALL WT?,WRD,PS?BUZZ-WORD ZERO? STACK /?ELS234 JUMP ?CND127 ?ELS234: EQUAL? VERB,ACT?TELL \?ELS236 CALL WT?,WRD,PS?VERB,P1?VERB ZERO? STACK /?ELS236 EQUAL? WINNER,PLAYER \?ELS236 PRINTI "Please consult your manual for the correct way to talk to other people or creatures." CRLF RFALSE ?ELS236: CALL CANT-USE,PTR RFALSE ?ELS131: CALL UNKNOWN-WORD,PTR RFALSE ?CND127: SET 'LW,WRD ADD PTR,P-LEXELEN >PTR JUMP ?PRG125 ?CND81: PUT OOPS-TABLE,O-PTR,FALSE-VALUE ZERO? DIR /?ELS249 SET 'PRSA,V?WALK SET 'PRSO,DIR SET 'P-OFLAG,FALSE-VALUE SET 'P-WALK-DIR,DIR SET 'AGAIN-DIR,DIR RETURN AGAIN-DIR ?ELS249: ZERO? P-OFLAG /?CND253 CALL ORPHAN-MERGE ?CND253: 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 /FALSE RTRUE .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 /?ELS3 SET 'DBEG,TMP JUMP ?CND1 ?ELS3: 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 ?PRG6: ADD DBEG,CTR >?TMP1 ADD BEG,CTR GETB P-INBUF,STACK PUTB OOPS-INBUF,?TMP1,STACK INC 'CTR EQUAL? CTR,LEN \?PRG6 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 /?CND13 INC 'OFFS ?CND13: 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 /?ELS3 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 ?ELS3: INC 'P-LEN ?CND1: ZERO? P-LEN \?CND6 DEC 'P-NCN RETURN -1 ?CND6: 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 \?CND9 GET P-ITBL,NUM ADD STACK,4 PUT P-ITBL,NUM,STACK ?CND9: ?PRG12: DLESS? 'P-LEN,0 \?CND14 ADD NUM,1 >?TMP1 MUL PTR,2 ADD P-LEXV,STACK PUT P-ITBL,?TMP1,STACK RETURN -1 ?CND14: GET P-LEXV,PTR >WRD ZERO? WRD \?THN20 CALL NUMBER?,PTR >WRD ZERO? WRD /?ELS19 ?THN20: ZERO? P-LEN \?ELS24 SET 'NW,0 JUMP ?CND22 ?ELS24: ADD PTR,P-LEXELEN GET P-LEXV,STACK >NW ?CND22: EQUAL? WRD,W?AND,W?COMMA \?ELS29 SET 'ANDFLG,TRUE-VALUE JUMP ?CND17 ?ELS29: EQUAL? WRD,W?ALL,W?ONE \?ELS31 EQUAL? NW,W?OF \?CND17 DEC 'P-LEN ADD PTR,P-LEXELEN >PTR JUMP ?CND17 ?ELS31: EQUAL? WRD,W?THEN,W?PERIOD /?THN37 CALL WT?,WRD,PS?PREPOSITION ZERO? STACK /?ELS36 GET P-ITBL,P-VERB ZERO? STACK /?ELS36 ZERO? FIRST?? \?ELS36 ?THN37: INC 'P-LEN ADD NUM,1 >?TMP1 MUL PTR,2 ADD P-LEXV,STACK PUT P-ITBL,?TMP1,STACK SUB PTR,P-LEXELEN RSTACK ?ELS36: CALL WT?,WRD,PS?OBJECT ZERO? STACK /?ELS42 GRTR? P-LEN,0 \?ELS45 EQUAL? NW,W?OF \?ELS45 EQUAL? WRD,W?ALL,W?ONE /?ELS45 JUMP ?CND17 ?ELS45: CALL WT?,WRD,PS?ADJECTIVE,P1?ADJECTIVE ZERO? STACK /?ELS49 ZERO? NW /?ELS49 CALL WT?,NW,PS?OBJECT ZERO? STACK /?ELS49 JUMP ?CND17 ?ELS49: ZERO? ANDFLG \?ELS53 EQUAL? NW,W?BUT,W?EXCEPT /?ELS53 EQUAL? NW,W?AND,W?COMMA /?ELS53 ADD NUM,1 >?TMP1 ADD PTR,2 MUL STACK,2 ADD P-LEXV,STACK PUT P-ITBL,?TMP1,STACK RETURN PTR ?ELS53: SET 'ANDFLG,FALSE-VALUE JUMP ?CND17 ?ELS42: ZERO? P-MERGED \?THN62 ZERO? P-OFLAG \?THN62 GET P-ITBL,P-VERB ZERO? STACK /?ELS59 ?THN62: CALL WT?,WRD,PS?ADJECTIVE ZERO? STACK \?CND17 CALL WT?,WRD,PS?BUZZ-WORD ZERO? STACK /?ELS59 JUMP ?CND17 ?ELS59: ZERO? ANDFLG /?ELS67 CALL WT?,WRD,PS?DIRECTION ZERO? STACK \?THN70 CALL WT?,WRD,PS?VERB ZERO? STACK /?ELS67 ?THN70: SUB PTR,4 >PTR ADD PTR,2 PUT P-LEXV,STACK,W?THEN ADD P-LEN,2 >P-LEN JUMP ?CND17 ?ELS67: CALL WT?,WRD,PS?PREPOSITION ZERO? STACK /?ELS73 JUMP ?CND17 ?ELS73: CALL CANT-USE,PTR RFALSE ?ELS19: CALL UNKNOWN-WORD,PTR RFALSE ?CND17: SET 'LW,WRD SET 'FIRST??,FALSE-VALUE ADD PTR,P-LEXELEN >PTR JUMP ?PRG12 .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 \?ELS5 JUMP ?REP2 ?ELS5: GETB P-INBUF,BPTR >CHR EQUAL? CHR,58 \?ELS10 SET 'TIM,SUM SET 'SUM,0 JUMP ?CND8 ?ELS10: GRTR? SUM,10000 /FALSE LESS? CHR,58 \FALSE GRTR? CHR,47 \FALSE MUL SUM,10 >?TMP1 SUB CHR,48 ADD ?TMP1,STACK >SUM ?CND8: INC 'BPTR JUMP ?PRG1 ?REP2: PUT P-LEXV,PTR,W?INTNUM GRTR? SUM,1000 /FALSE ZERO? TIM /?CND19 LESS? TIM,8 \?ELS27 ADD TIM,12 >TIM JUMP ?CND25 ?ELS27: GRTR? TIM,23 /FALSE ?CND25: MUL TIM,60 ADD SUM,STACK >SUM ?CND19: 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,PS?VERB,P1?VERB >?TMP1 GET P-OTBL,P-VERB EQUAL? ?TMP1,STACK /?THN4 CALL WT?,WRD,PS?ADJECTIVE ZERO? STACK /?ELS3 ?THN4: SET 'ADJ,TRUE-VALUE JUMP ?CND1 ?ELS3: CALL WT?,WRD,PS?OBJECT,P1?OBJECT 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 /?ELS12 ZERO? ADJ \?ELS12 GET P-OTBL,P-VERB EQUAL? VERB,STACK \FALSE ?ELS12: EQUAL? P-NCN,2 /FALSE GET P-OTBL,P-NC1 EQUAL? STACK,1 \?ELS18 GET P-ITBL,P-PREP1 >TEMP GET P-OTBL,P-PREP1 EQUAL? TEMP,STACK /?THN22 ZERO? TEMP \FALSE ?THN22: ZERO? ADJ /?ELS26 ADD P-LEXV,2 PUT P-OTBL,P-NC1,STACK GET P-ITBL,P-NC1L ZERO? STACK \?CND28 ADD P-LEXV,6 PUT P-ITBL,P-NC1L,STACK ?CND28: ZERO? P-NCN \?CND24 SET 'P-NCN,1 JUMP ?CND24 ?ELS26: GET P-ITBL,P-NC1 PUT P-OTBL,P-NC1,STACK ?CND24: GET P-ITBL,P-NC1L PUT P-OTBL,P-NC1L,STACK JUMP ?CND10 ?ELS18: GET P-OTBL,P-NC2 EQUAL? STACK,1 \?ELS39 GET P-ITBL,P-PREP1 >TEMP GET P-OTBL,P-PREP2 EQUAL? TEMP,STACK /?THN43 ZERO? TEMP \FALSE ?THN43: ZERO? ADJ /?CND45 ADD P-LEXV,2 PUT P-ITBL,P-NC1,STACK GET P-ITBL,P-NC1L ZERO? STACK \?CND45 ADD P-LEXV,6 PUT P-ITBL,P-NC1L,STACK ?CND45: 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 ?CND10 ?ELS39: ZERO? P-ACLAUSE /?CND10 EQUAL? P-NCN,1 /?ELS58 ZERO? ADJ \?ELS58 SET 'P-ACLAUSE,FALSE-VALUE RFALSE ?ELS58: GET P-ITBL,P-NC1 >BEG ZERO? ADJ /?CND63 ADD P-LEXV,2 >BEG SET 'ADJ,FALSE-VALUE ?CND63: GET P-ITBL,P-NC1L >END ?PRG67: GET BEG,0 >WRD EQUAL? BEG,END \?ELS71 ZERO? ADJ /?ELS74 CALL ACLAUSE-WIN,ADJ JUMP ?CND56 ?ELS74: SET 'P-ACLAUSE,FALSE-VALUE RFALSE ?ELS71: ZERO? ADJ \?ELS79 GETB WRD,P-PSOFF BTST STACK,PS?ADJECTIVE /?THN82 EQUAL? WRD,W?ALL,W?ONE \?ELS79 ?THN82: SET 'ADJ,WRD JUMP ?CND69 ?ELS79: EQUAL? WRD,W?ONE \?ELS85 CALL ACLAUSE-WIN,ADJ JUMP ?CND56 ?ELS85: GETB WRD,P-PSOFF BTST STACK,PS?OBJECT \?CND69 EQUAL? WRD,P-ANAM \?ELS90 CALL ACLAUSE-WIN,ADJ JUMP ?CND10 ?ELS90: CALL NCLAUSE-WIN JUMP ?CND10 ?CND69: ADD BEG,P-WORDLEN >BEG ZERO? END \?PRG67 SET 'END,BEG SET 'P-NCN,1 SUB BEG,4 PUT P-ITBL,P-NC1,STACK PUT P-ITBL,P-NC1L,BEG JUMP ?PRG67 ?CND56: ?CND10: 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 ?PRG96: IGRTR? 'CNT,P-ITBLLEN \?ELS100 SET 'P-MERGED,TRUE-VALUE RTRUE ?ELS100: GET P-OTBL,CNT PUT P-ITBL,CNT,STACK JUMP ?PRG96 .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 /?ELS2 SET 'P-NCN,2 ?ELS2: 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 /?ELS2 SET 'P-NCN,2 ?ELS2: 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 \?CND1 PRINTI "Nothing happens." CRLF RFALSE ?CND1: 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 \?CND1 PRINTI "Nothing happens." CRLF RFALSE ?CND1: 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 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 ?PRG6: GETB SYN,P-SBITS BAND STACK,P-SONUMS >NUM GRTR? P-NCN,NUM \?ELS10 JUMP ?CND8 ?ELS10: LESS? NUM,1 /?ELS12 ZERO? P-NCN \?ELS12 GET P-ITBL,P-PREP1 >PREP ZERO? PREP /?THN15 GETB SYN,P-SPREP1 EQUAL? PREP,STACK \?ELS12 ?THN15: SET 'DRIVE1,SYN JUMP ?CND8 ?ELS12: GETB SYN,P-SPREP1 >?TMP1 GET P-ITBL,P-PREP1 EQUAL? ?TMP1,STACK \?CND8 EQUAL? NUM,2 \?ELS21 EQUAL? P-NCN,1 \?ELS21 SET 'DRIVE2,SYN JUMP ?CND8 ?ELS21: GETB SYN,P-SPREP2 >?TMP1 GET P-ITBL,P-PREP2 EQUAL? ?TMP1,STACK \?CND8 CALL SYNTAX-FOUND,SYN RTRUE ?CND8: DLESS? 'LEN,1 \?ELS28 ZERO? DRIVE1 \?REP7 ZERO? DRIVE2 /?ELS31 JUMP ?REP7 ?ELS31: PRINTI "That sentence isn't one I recognize." CRLF RFALSE ?ELS28: ADD SYN,P-SYNLEN >SYN JUMP ?PRG6 ?REP7: ZERO? DRIVE1 /?ELS44 GETB DRIVE1,P-SFWIM1 >?TMP2 GETB DRIVE1,P-SLOC1 >?TMP1 GETB DRIVE1,P-SPREP1 CALL GWIM,?TMP2,?TMP1,STACK >OBJ ZERO? OBJ /?ELS44 PUT P-PRSO,P-MATCHLEN,1 PUT P-PRSO,1,OBJ CALL SYNTAX-FOUND,DRIVE1 RSTACK ?ELS44: ZERO? DRIVE2 /?ELS48 GETB DRIVE2,P-SFWIM2 >?TMP2 GETB DRIVE2,P-SLOC2 >?TMP1 GETB DRIVE2,P-SPREP2 CALL GWIM,?TMP2,?TMP1,STACK >OBJ ZERO? OBJ /?ELS48 PUT P-PRSI,P-MATCHLEN,1 PUT P-PRSI,1,OBJ CALL SYNTAX-FOUND,DRIVE2 RSTACK ?ELS48: EQUAL? VERB,ACT?FIND \?ELS52 PRINTI "That question can't be answered." CRLF RFALSE ?ELS52: EQUAL? WINNER,PLAYER /?ELS56 CALL CANT-ORPHAN RSTACK ?ELS56: CALL ORPHAN,DRIVE1,DRIVE2 PRINTI "What do you want to " GET P-OTBL,P-VERBN >TMP ZERO? TMP \?ELS63 PRINTI "tell" JUMP ?CND61 ?ELS63: GETB P-VTBL,2 ZERO? STACK \?ELS67 GET TMP,0 PRINTB STACK JUMP ?CND61 ?ELS67: GETB TMP,2 >?TMP1 GETB TMP,3 CALL WORD-PRINT,?TMP1,STACK PUTB P-VTBL,2,0 ?CND61: ZERO? DRIVE2 /?CND70 PRINTI " " CALL THING-PRINT,TRUE-VALUE,TRUE-VALUE ?CND70: SET 'P-OFLAG,TRUE-VALUE ZERO? DRIVE1 /?ELS80 GETB DRIVE1,P-SPREP1 JUMP ?CND76 ?ELS80: GETB DRIVE2,P-SPREP2 ?CND76: CALL PREP-PRINT,STACK PRINTI "?" 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 ?PRG4: IGRTR? 'CNT,P-ITBLLEN \?ELS8 JUMP ?REP5 ?ELS8: GET P-ITBL,CNT PUT P-OTBL,CNT,STACK JUMP ?PRG4 ?REP5: EQUAL? P-NCN,2 \?CND11 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 ?CND11: LESS? P-NCN,1 /?CND14 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 ?CND14: ZERO? D1 /?ELS21 GETB D1,P-SPREP1 PUT P-OTBL,P-PREP1,STACK PUT P-OTBL,P-NC1,1 RTRUE ?ELS21: ZERO? D2 /FALSE GETB D2,P-SPREP2 PUT P-OTBL,P-PREP2,STACK PUT P-OTBL,P-NC2,1 RTRUE .FUNCT THING-PRINT,PRSO?,THE?=0,BEG,END ZERO? PRSO? /?ELS3 GET P-ITBL,P-NC1 >BEG GET P-ITBL,P-NC1L >END JUMP ?CND1 ?ELS3: 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 \?ELS10 PRINTI ", " JUMP ?CND8 ?ELS10: ZERO? NOSP /?ELS14 SET 'NOSP,FALSE-VALUE JUMP ?CND8 ?ELS14: PRINTI " " ?CND8: EQUAL? WRD,W?PERIOD,W?COMMA \?ELS22 SET 'NOSP,TRUE-VALUE JUMP ?CND3 ?ELS22: EQUAL? WRD,W?ME \?ELS24 PRINTD ME SET 'PN,TRUE-VALUE JUMP ?CND3 ?ELS24: EQUAL? WRD,W?INTNUM \?ELS26 PRINTN P-NUMBER SET 'PN,TRUE-VALUE JUMP ?CND3 ?ELS26: ZERO? FIRST?? /?CND29 ZERO? PN \?CND29 ZERO? CP /?CND29 PRINTI "the " ?CND29: ZERO? P-OFLAG \?THN39 ZERO? P-MERGED /?ELS38 ?THN39: PRINTB WRD JUMP ?CND36 ?ELS38: EQUAL? WRD,W?IT \?ELS42 CALL ACCESSIBLE?,P-IT-OBJECT ZERO? STACK /?ELS42 PRINTD P-IT-OBJECT JUMP ?CND36 ?ELS42: GETB BEG,2 >?TMP1 GETB BEG,3 CALL WORD-PRINT,?TMP1,STACK ?CND36: SET 'FIRST??,FALSE-VALUE ?CND3: ADD BEG,P-WORDLEN >BEG JUMP ?PRG1 .FUNCT PREP-PRINT,PREP,WRD ZERO? PREP /FALSE PRINTI " " 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 \?ELS5 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 ?ELS5: ZERO? INSRT /?CND8 GET BEG,0 EQUAL? P-ANAM,STACK \?CND8 CALL CLAUSE-ADD,INSRT ?CND8: GET BEG,0 CALL CLAUSE-ADD,STACK ?CND3: 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,RMUNGBIT \?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 /?ELS8 SET 'P-GWIMBIT,0 GET P-MERGE,P-MATCHLEN EQUAL? STACK,1 \FALSE GET P-MERGE,1 >OBJ PRINTI "(" ZERO? PREP /?ELS18 ZERO? P-END-ON-PREP \?ELS18 CALL PREP-FIND,PREP >PREP PRINTB PREP EQUAL? PREP,W?OUT \?CND21 PRINTI " of" ?CND21: PRINTI " " EQUAL? OBJ,HANDS \?ELS30 PRINTI "your hands" JUMP ?CND28 ?ELS30: PRINTI "the " PRINTD OBJ ?CND28: PRINTI ")" CRLF RETURN OBJ ?ELS18: PRINTD OBJ PRINTI ")" CRLF RETURN OBJ ?ELS8: 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 /?CND6 GETB P-SYNTAX,P-SLOC1 >P-SLOCBITS GET P-ITBL,P-NC1L CALL SNARFEM,OPTR,STACK,P-PRSO ZERO? STACK /FALSE ?CND6: GET P-BUTS,P-MATCHLEN ZERO? STACK /TRUE GET P-PRSO,P-MATCHLEN >L ZERO? OPTR /?CND14 CALL BUT-MERGE,P-PRSO >P-PRSO ?CND14: ZERO? IPTR /TRUE ZERO? OPTR /?THN23 GET P-PRSO,P-MATCHLEN EQUAL? L,STACK \TRUE ?THN23: 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 \?ELS5 JUMP ?REP2 ?ELS5: GET TBL,CNT >OBJ CALL ZMEMQ,OBJ,P-BUTS ZERO? STACK /?ELS7 JUMP ?CND3 ?ELS7: 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 ?PRG4: EQUAL? PTR,EPTR \?ELS8 ZERO? BUT /?ORP12 PUSH BUT JUMP ?THN9 ?ORP12: PUSH TBL ?THN9: CALL GET-OBJECT,STACK >WV ZERO? WAS-ALL /?CND13 SET 'P-GETFLAGS,P-ALL ?CND13: RETURN WV ?ELS8: ADD PTR,P-WORDLEN EQUAL? EPTR,STACK \?ELS21 SET 'NW,0 JUMP ?CND19 ?ELS21: GET PTR,P-LEXELEN >NW ?CND19: EQUAL? WRD,W?ALL \?ELS26 SET 'P-GETFLAGS,P-ALL EQUAL? NW,W?OF \?CND24 ADD PTR,P-WORDLEN >PTR JUMP ?CND24 ?ELS26: EQUAL? WRD,W?BUT,W?EXCEPT \?ELS31 ZERO? BUT /?ORP37 PUSH BUT JUMP ?THN34 ?ORP37: PUSH TBL ?THN34: CALL GET-OBJECT,STACK ZERO? STACK /FALSE SET 'BUT,P-BUTS PUT BUT,P-MATCHLEN,0 JUMP ?CND6 ?ELS31: EQUAL? WRD,W?A,W?ONE \?ELS39 ZERO? P-ADJ \?ELS42 SET 'P-GETFLAGS,P-ONE EQUAL? NW,W?OF \?CND6 ADD PTR,P-WORDLEN >PTR JUMP ?CND6 ?ELS42: SET 'P-NAM,P-ONEOBJ ZERO? BUT /?ORP53 PUSH BUT JUMP ?THN50 ?ORP53: PUSH TBL ?THN50: CALL GET-OBJECT,STACK ZERO? STACK /FALSE ZERO? NW /TRUE JUMP ?CND6 ?ELS39: EQUAL? WRD,W?AND,W?COMMA \?ELS57 EQUAL? NW,W?AND,W?COMMA /?ELS57 SET 'P-AND,TRUE-VALUE ZERO? BUT /?ORP65 PUSH BUT JUMP ?THN62 ?ORP65: PUSH TBL ?THN62: CALL GET-OBJECT,STACK ZERO? STACK \?CND24 RFALSE ?ELS57: CALL WT?,WRD,PS?BUZZ-WORD ZERO? STACK /?ELS67 JUMP ?CND6 ?ELS67: EQUAL? WRD,W?AND,W?COMMA \?ELS69 JUMP ?CND6 ?ELS69: EQUAL? WRD,W?OF \?ELS71 ZERO? P-GETFLAGS \?CND24 SET 'P-GETFLAGS,P-INHIBIT JUMP ?CND24 ?ELS71: CALL WT?,WRD,PS?ADJECTIVE,P1?ADJECTIVE >WV ZERO? WV /?ELS76 ZERO? P-ADJ \?ELS76 SET 'P-ADJ,WV SET 'P-ADJN,WRD JUMP ?CND6 ?ELS76: CALL WT?,WRD,PS?OBJECT,P1?OBJECT ZERO? STACK /?CND6 SET 'P-NAM,WRD SET 'P-ONEOBJ,WRD ?CND24: ?CND6: EQUAL? PTR,EPTR /?PRG4 ADD PTR,P-WORDLEN >PTR SET 'WRD,NW JUMP ?PRG4 .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 \?CND4 ZERO? P-ADJ /?CND4 CALL WT?,P-ADJN,PS?OBJECT,P1?OBJECT ZERO? STACK /?ELS11 SET 'P-NAM,P-ADJN SET 'P-ADJ,FALSE-VALUE JUMP ?CND4 ?ELS11: CALL WT?,P-ADJN,PS?DIRECTION,P1?DIRECTION >BITS ZERO? BITS /?CND4 SET 'P-ADJ,FALSE-VALUE PUT TBL,P-MATCHLEN,1 PUT TBL,1,INTDIR SET 'P-DIRECTION,BITS RTRUE ?CND4: ZERO? P-NAM \?CND14 ZERO? P-ADJ \?CND14 EQUAL? P-GETFLAGS,P-ALL /?CND14 ZERO? P-GWIMBIT \?CND14 ZERO? VRB /FALSE PRINTI "There seems to be a noun missing in that sentence!" CRLF RFALSE ?CND14: EQUAL? P-GETFLAGS,P-ALL \?THN28 ZERO? P-SLOCBITS \?CND25 ?THN28: SET 'P-SLOCBITS,-1 ?CND25: SET 'P-TABLE,TBL ?PRG30: ZERO? GCHECK /?ELS34 CALL GLOBAL-CHECK,TBL JUMP ?CND32 ?ELS34: ZERO? LIT /?CND38 FCLEAR PLAYER,TRANSBIT CALL DO-SL,HERE,SOG,SIR FSET PLAYER,TRANSBIT ?CND38: CALL DO-SL,PLAYER,SH,SC ?CND32: GET TBL,P-MATCHLEN SUB STACK,TLEN >LEN BTST P-GETFLAGS,P-ALL \?ELS44 JUMP ?CND42 ?ELS44: BTST P-GETFLAGS,P-ONE \?ELS46 ZERO? LEN /?ELS46 EQUAL? LEN,1 /?CND49 RANDOM LEN GET TBL,STACK PUT TBL,1,STACK PRINTI "(How about the " GET TBL,1 PRINTD STACK PRINTI "?)" CRLF ?CND49: PUT TBL,P-MATCHLEN,1 JUMP ?CND42 ?ELS46: GRTR? LEN,1 /?THN58 ZERO? LEN \?CND42 EQUAL? P-SLOCBITS,-1 /?CND42 ?THN58: EQUAL? P-SLOCBITS,-1 \?ELS64 SET 'P-SLOCBITS,XBITS SET 'OLEN,LEN GET TBL,P-MATCHLEN SUB STACK,LEN PUT TBL,P-MATCHLEN,STACK JUMP ?PRG30 ?ELS64: ZERO? LEN \?CND67 SET 'LEN,OLEN ?CND67: EQUAL? WINNER,PLAYER /?ELS72 CALL CANT-ORPHAN RFALSE ?ELS72: ZERO? VRB /?ELS74 ZERO? P-NAM /?ELS74 CALL WHICH-PRINT,TLEN,LEN,TBL EQUAL? TBL,P-PRSO \?ELS81 PUSH P-NC1 JUMP ?CND77 ?ELS81: PUSH P-NC2 ?CND77: SET 'P-ACLAUSE,STACK SET 'P-AADJ,P-ADJ SET 'P-ANAM,P-NAM CALL ORPHAN,FALSE-VALUE,FALSE-VALUE SET 'P-OFLAG,TRUE-VALUE JUMP ?CND70 ?ELS74: ZERO? VRB /?CND70 PRINTI "There seems to be a noun missing in that sentence!" CRLF ?CND70: SET 'P-NAM,FALSE-VALUE SET 'P-ADJ,FALSE-VALUE RFALSE ?CND42: ZERO? LEN \?ELS91 ZERO? GCHECK /?ELS91 ZERO? VRB /?CND94 SET 'P-SLOCBITS,XBITS ZERO? LIT \?THN101 EQUAL? PRSA,V?TELL \?ELS100 ?THN101: 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 ?ELS100: PRINTI "It's too dark to see!" CRLF ?CND94: SET 'P-NAM,FALSE-VALUE SET 'P-ADJ,FALSE-VALUE RFALSE ?ELS91: ZERO? LEN \?CND89 SET 'GCHECK,TRUE-VALUE JUMP ?PRG30 ?CND89: 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 \?THN6 ZERO? P-MERGED \?THN6 ZERO? P-AND /?ELS5 ?THN6: ZERO? P-NAM /?ELS12 PUSH P-NAM JUMP ?CND8 ?ELS12: ZERO? P-ADJ /?ELS15 PUSH P-ADJN JUMP ?CND8 ?ELS15: PUSH W?ONE ?CND8: PRINTB STACK JUMP ?CND3 ?ELS5: EQUAL? TBL,P-PRSO /?PRD21 PUSH 0 JUMP ?PRD22 ?PRD21: PUSH 1 ?PRD22: CALL THING-PRINT,STACK ?CND3: PRINTI " do you mean, " ?PRG25: INC 'TLEN GET TBL,TLEN >OBJ PRINTI "the " PRINTD OBJ EQUAL? LEN,2 \?ELS31 EQUAL? RLEN,2 /?CND32 PRINTI "," ?CND32: PRINTI " or " JUMP ?CND29 ?ELS31: GRTR? LEN,2 \?CND29 PRINTI ", " ?CND29: DLESS? 'LEN,1 \?PRG25 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 ?PRG4: GETB RMG,CNT >OBJ CALL THIS-IT?,OBJ,TBL ZERO? STACK /?CND6 CALL OBJ-FOUND,OBJ,TBL ?CND6: IGRTR? 'CNT,RMGL \?PRG4 ?CND1: GETPT HERE,P?PSEUDO >RMG ZERO? RMG /?CND12 PTSIZE RMG DIV STACK,4 SUB STACK,1 >RMGL SET 'CNT,0 ?PRG15: MUL CNT,2 GET RMG,STACK EQUAL? P-NAM,STACK \?ELS19 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 ?CND12 ?ELS19: IGRTR? 'CNT,RMGL \?PRG15 ?CND12: 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 \?ELS5 CALL SEARCH-LIST,OBJ,P-TABLE,P-SRCALL RSTACK ?ELS5: BTST P-SLOCBITS,BIT1 \?ELS12 CALL SEARCH-LIST,OBJ,P-TABLE,P-SRCTOP RSTACK ?ELS12: 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 ?PRG6: EQUAL? LVL,P-SRCBOT /?CND8 GETPT OBJ,P?SYNONYM ZERO? STACK /?CND8 CALL THIS-IT?,OBJ,TBL ZERO? STACK /?CND8 CALL OBJ-FOUND,OBJ,TBL ?CND8: EQUAL? LVL,P-SRCTOP \?THN18 FSET? OBJ,SEARCHBIT /?THN18 FSET? OBJ,SURFACEBIT \?CND13 ?THN18: FIRST? OBJ >NOBJ \?CND13 FSET? OBJ,OPENBIT /?THN20 FSET? OBJ,TRANSBIT \?CND13 ?THN20: FSET? OBJ,SURFACEBIT \?ELS26 PUSH P-SRCALL JUMP ?CND22 ?ELS26: FSET? OBJ,SEARCHBIT \?ELS28 PUSH P-SRCALL JUMP ?CND22 ?ELS28: PUSH P-SRCTOP ?CND22: CALL SEARCH-LIST,OBJ,TBL,STACK >FLS ?CND13: NEXT? OBJ >OBJ /?PRG6 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 /?THN8 BTST IBITS,STAKE \TRUE ?THN8: ?PRG10: DLESS? 'PTR,0 /TRUE ADD PTR,1 GET TBL,STACK >OBJ EQUAL? OBJ,IT \?CND17 CALL ACCESSIBLE?,P-IT-OBJECT ZERO? STACK \?ELS22 PRINTI "I don't see what you're referring to." CRLF RFALSE ?ELS22: SET 'OBJ,P-IT-OBJECT ?CND17: CALL HELD?,OBJ ZERO? STACK \?PRG10 EQUAL? OBJ,HANDS,ME /?PRG10 SET 'PRSO,OBJ FSET? OBJ,TRYTAKEBIT \?ELS34 SET 'TAKEN,TRUE-VALUE JUMP ?CND32 ?ELS34: EQUAL? WINNER,ADVENTURER /?ELS36 SET 'TAKEN,FALSE-VALUE JUMP ?CND32 ?ELS36: BTST IBITS,STAKE \?ELS38 CALL ITAKE,FALSE-VALUE EQUAL? STACK,TRUE-VALUE \?ELS38 SET 'TAKEN,FALSE-VALUE JUMP ?CND32 ?ELS38: SET 'TAKEN,TRUE-VALUE ?CND32: ZERO? TAKEN /?ELS45 BTST IBITS,SHAVE \?ELS45 EQUAL? WINNER,ADVENTURER \?ELS45 EQUAL? OBJ,NOT-HERE-OBJECT \?CND48 PRINTI "You don't have that!" CRLF RFALSE ?CND48: PRINTI "You don't have the " PRINTD OBJ PRINTI "." CRLF RFALSE ?ELS45: ZERO? TAKEN \?PRG10 EQUAL? WINNER,ADVENTURER \?PRG10 PRINTI "(Taken)" CRLF JUMP ?PRG10 .FUNCT MANY-CHECK,LOSS=0,TMP,?TMP1 GET P-PRSO,P-MATCHLEN GRTR? STACK,1 \?ELS3 GETB P-SYNTAX,P-SLOC1 BTST STACK,SMANY /?ELS3 SET 'LOSS,1 JUMP ?CND1 ?ELS3: 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 \?CND18 PRINTI "in" ?CND18: PRINTI "direct objects with """ GET P-ITBL,P-VERBN >TMP ZERO? TMP \?ELS27 PRINTI "tell" JUMP ?CND25 ?ELS27: ZERO? P-OFLAG \?THN32 ZERO? P-MERGED /?ELS31 ?THN32: GET TMP,0 PRINTB STACK JUMP ?CND25 ?ELS31: GETB TMP,2 >?TMP1 GETB TMP,3 CALL WORD-PRINT,?TMP1,STACK ?CND25: PRINTI """." CRLF RFALSE .FUNCT ZMEMQ,ITM,TBL,SIZE=-1,CNT=1 ZERO? TBL /FALSE LESS? SIZE,0 /?ELS6 SET 'CNT,0 JUMP ?CND4 ?ELS6: GET TBL,0 >SIZE ?CND4: ?PRG9: GET TBL,CNT EQUAL? ITM,STACK \?ELS13 MUL CNT,2 ADD TBL,STACK RSTACK ?ELS13: IGRTR? 'CNT,SIZE \?PRG9 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,PLAYER /TRUE ?CND1: SET 'P-GWIMBIT,ONBIT SET 'OHERE,HERE SET 'HERE,RM ZERO? RMBIT /?ELS8 FSET? RM,ONBIT \?ELS8 SET 'LIT,TRUE-VALUE JUMP ?CND6 ?ELS8: PUT P-MERGE,P-MATCHLEN,0 SET 'P-TABLE,P-MERGE SET 'P-SLOCBITS,-1 EQUAL? OHERE,RM \?CND13 CALL DO-SL,WINNER,1,1 EQUAL? WINNER,PLAYER /?CND13 IN? PLAYER,RM \?CND13 CALL DO-SL,PLAYER,1,1 ?CND13: CALL DO-SL,RM,1,1 GET P-TABLE,P-MATCHLEN GRTR? STACK,0 \?CND6 SET 'LIT,TRUE-VALUE ?CND6: SET 'HERE,OHERE SET 'P-GWIMBIT,0 RETURN LIT .FUNCT THIS-IT?,OBJ,TBL,SYNS,?TMP1 FSET? OBJ,INVISIBLE /FALSE ZERO? P-NAM /?ELS5 GETPT OBJ,P?SYNONYM >SYNS PTSIZE SYNS DIV STACK,2 SUB STACK,1 CALL ZMEMQ,P-NAM,SYNS,STACK ZERO? STACK /FALSE ?ELS5: ZERO? P-ADJ /?ELS9 GETPT OBJ,P?ADJECTIVE >SYNS ZERO? SYNS /FALSE PTSIZE SYNS SUB STACK,1 CALL ZMEMQB,P-ADJ,SYNS,STACK ZERO? STACK /FALSE ?ELS9: 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 \?ELS11 CALL GLOBAL-IN?,OBJ,HERE ZERO? STACK \TRUE ?ELS11: 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 \?ELS10 RETURN OBJ ?ELS10: LOC OBJ >OBJ JUMP ?PRG1 .ENDI