.FUNCT MAIN-LOOP,X ?PRG1: CALL1 MAIN-LOOP-1 >X JUMP ?PRG1 .FUNCT MAIN-LOOP-1,ICNT,OCNT,NUM,CNT,OBJ,TBL,V,PTBL,OBJ1,TMP,X,?TMP1 SET 'CNT,0 SET 'OBJ,FALSE-VALUE SET 'PTBL,TRUE-VALUE EQUAL? QCONTEXT-ROOM,HERE /?CND1 SET 'QCONTEXT,FALSE-VALUE ?CND1: CALL1 PARSER ZERO? STACK /?ELS6 SET 'CLOCK-WAIT,FALSE-VALUE GET P-PRSI,P-MATCHLEN >ICNT GET P-PRSO,P-MATCHLEN >OCNT ZERO? P-IT-OBJECT /?CND7 CALL2 ACCESSIBLE?,P-IT-OBJECT ZERO? STACK /?CND7 SET 'TMP,FALSE-VALUE ?PRG12: IGRTR? 'CNT,ICNT \?CND14 JUMP ?REP13 ?CND14: GET P-PRSI,CNT EQUAL? STACK,IT \?PRG12 PUT P-PRSI,CNT,P-IT-OBJECT PRINT I-ASSUME CALL2 PRINTT,P-IT-OBJECT PRINTI ".)" CRLF SET 'TMP,TRUE-VALUE ?REP13: ZERO? TMP \?CND22 SET 'CNT,0 ?PRG25: IGRTR? 'CNT,OCNT \?CND27 JUMP ?CND22 ?CND27: GET P-PRSO,CNT EQUAL? STACK,IT \?PRG25 PUT P-PRSO,CNT,P-IT-OBJECT PRINT I-ASSUME CALL2 PRINTT,P-IT-OBJECT PRINTI ".)" CRLF ?CND22: SET 'CNT,0 ?CND7: ZERO? OCNT \?ELS39 PUSH OCNT JUMP ?CND35 ?ELS39: GRTR? OCNT,1 \?ELS41 SET 'TBL,P-PRSO ZERO? ICNT \?ELS44 SET 'OBJ,FALSE-VALUE JUMP ?CND42 ?ELS44: GET P-PRSI,1 >OBJ ?CND42: PUSH OCNT JUMP ?CND35 ?ELS41: GRTR? ICNT,1 \?ELS48 SET 'PTBL,FALSE-VALUE SET 'TBL,P-PRSI GET P-PRSO,1 >OBJ PUSH ICNT JUMP ?CND35 ?ELS48: PUSH 1 ?CND35: SET 'NUM,STACK ZERO? OBJ \?CND51 EQUAL? ICNT,1 \?CND51 GET P-PRSI,1 >OBJ ?CND51: EQUAL? PRSA,V?WALK,V?FACE \?ELS58 CALL PERFORM,PRSA,PRSO >V JUMP ?CND56 ?ELS58: ZERO? NUM \?ELS60 GETB P-SYNTAX,P-SBITS BAND STACK,P-SONUMS ZERO? STACK \?ELS63 CALL2 PERFORM,PRSA >V SET 'PRSO,FALSE-VALUE JUMP ?CND56 ?ELS63: ZERO? LIT \?ELS65 SET 'QUOTE-FLAG,FALSE-VALUE SET 'P-CONT,FALSE-VALUE CALL1 TOO-DARK JUMP ?CND56 ?ELS65: SET 'QUOTE-FLAG,FALSE-VALUE SET 'P-CONT,FALSE-VALUE PRINTI "(There isn't anything to " GET P-ITBL,P-VERBN >TMP EQUAL? PRSA,V?TELL \?ELS72 PRINTI "talk to" JUMP ?CND70 ?ELS72: ZERO? P-MERGED \?THN77 ZERO? P-OFLAG /?ELS76 ?THN77: GET TMP,0 PRINTB STACK JUMP ?CND70 ?ELS76: GETB TMP,2 >?TMP1 GETB TMP,3 CALL WORD-PRINT,?TMP1,STACK >V ?CND70: PRINTI "!)" CRLF SET 'V,FALSE-VALUE JUMP ?CND56 ?ELS60: SET 'X,0 SET 'TMP,0 ?PRG85: IGRTR? 'CNT,NUM \?ELS89 GRTR? X,0 \?ELS92 PRINTI "The " EQUAL? X,NUM /?CND95 PRINTI "other " ?CND95: PRINTI "object" EQUAL? X,1 /?CND102 PRINTI "s" ?CND102: PRINTI " that you mentioned " EQUAL? X,1 /?ELS111 PRINTI "are" JUMP ?CND109 ?ELS111: PRINTI "is" ?CND109: PRINTI "n't here." CRLF JUMP ?REP86 ?ELS92: ZERO? TMP \?REP86 CALL1 MORE-SPECIFIC JUMP ?REP86 ?ELS89: ZERO? PTBL /?ELS126 GET P-PRSO,CNT >OBJ1 JUMP ?CND124 ?ELS126: GET P-PRSI,CNT >OBJ1 ?CND124: GRTR? NUM,1 /?THN133 GET P-ITBL,P-NC1 GET STACK,0 EQUAL? STACK,W?ALL \?CND130 ?THN133: EQUAL? OBJ1,NOT-HERE-OBJECT \?ELS137 INC 'X JUMP ?PRG85 ?ELS137: EQUAL? P-GETFLAGS,P-ALL \?ELS139 CALL VERB-ALL-TEST,OBJ1,OBJ ZERO? STACK \?ELS139 JUMP ?PRG85 ?ELS139: CALL2 ACCESSIBLE?,OBJ1 ZERO? STACK \?ELS143 JUMP ?PRG85 ?ELS143: EQUAL? OBJ1,PLAYER \?ELS145 JUMP ?PRG85 ?ELS145: EQUAL? OBJ1,IT \?ELS150 PRINTD P-IT-OBJECT JUMP ?CND148 ?ELS150: PRINTD OBJ1 ?CND148: PRINTI ": " ?CND130: SET 'TMP,TRUE-VALUE ZERO? PTBL /?ELS159 PUSH OBJ1 JUMP ?CND155 ?ELS159: PUSH OBJ ?CND155: CALL2 QCONTEXT-CHECK,STACK >V ZERO? PTBL /?ELS167 PUSH OBJ1 JUMP ?CND163 ?ELS167: PUSH OBJ ?CND163: SET 'PRSO,STACK ZERO? PTBL /?ELS175 PUSH OBJ JUMP ?CND171 ?ELS175: PUSH OBJ1 ?CND171: SET 'PRSI,STACK CALL PERFORM,PRSA,PRSO,PRSI >V EQUAL? V,M-FATAL \?PRG85 JUMP ?CND56 ?REP86: ?CND56: EQUAL? V,M-FATAL \?CND4 SET 'P-CONT,FALSE-VALUE JUMP ?CND4 ?ELS6: SET 'CLOCK-WAIT,TRUE-VALUE SET 'P-CONT,FALSE-VALUE ?CND4: ZERO? CLOCK-WAIT \?CND187 EQUAL? PRSA,V?RESTORE,V?SAVE /?THN193 CALL1 GAME-VERB? ZERO? STACK \?CND187 ?THN193: CALL1 CLOCKER >V ?CND187: SET 'PRSA,FALSE-VALUE SET 'PRSO,FALSE-VALUE SET 'PRSI,FALSE-VALUE RETURN PRSI .FUNCT VERB-ALL-TEST,O,I,L LOC O >L EQUAL? PRSA,V?GIVE,V?DROP \?ELS5 EQUAL? O,POCKET /FALSE EQUAL? L,WINNER \FALSE RTRUE ?ELS5: EQUAL? PRSA,V?PUT-IN,V?PUT \?ELS18 EQUAL? O,I,POCKET /FALSE CALL HELD?,O,I ZERO? STACK \FALSE RTRUE ?ELS18: EQUAL? PRSA,V?TAKE \?ELS29 FSET? O,TAKEBIT /?CND30 FSET? O,TRYTAKEBIT \FALSE ?CND30: ZERO? I /?ELS37 EQUAL? L,I \FALSE SET 'L,I JUMP ?CND35 ?ELS37: EQUAL? L,HERE /TRUE ?CND35: FSET? L,SURFACEBIT /TRUE FSET? L,CONTBIT \FALSE FSET? L,OPENBIT \FALSE RTRUE ?ELS29: ZERO? I /TRUE EQUAL? O,I /FALSE RTRUE .FUNCT GAME-VERB?,V=0 ZERO? V \?CND1 SET 'V,PRSA ?CND1: EQUAL? V,V?$ANSWER,V?$GOAL,V?$VERIFY /TRUE EQUAL? V,V?$QUEUE,V?$STATION /TRUE EQUAL? V,V?$FCLEAR,V?$FSET,V?$QFSET /TRUE EQUAL? V,V?$WHERE,V?BRIEF,V?DEBUG /TRUE EQUAL? V,V?QUIT,V?RESTART,V?RESTORE /TRUE EQUAL? V,V?SAVE,V?SCRIPT,V?SUPER-BRIEF /TRUE EQUAL? V,V?TELL,V?TIME,V?UNSCRIPT /TRUE EQUAL? V,V?VERBOSE,V?VERSION,V?$FACE /TRUE RFALSE .FUNCT QCONTEXT-CHECK,PRSO,OTHER,WHO=0,N=0 EQUAL? PRSA,V?WHAT,V?HELP /?THN6 EQUAL? PRSA,V?TELL-ABOUT,V?SHOW \FALSE EQUAL? PRSO,PLAYER \FALSE ?THN6: FIRST? HERE >OTHER /?KLU33 ?KLU33: ?PRG10: ZERO? OTHER \?ELS14 JUMP ?REP11 ?ELS14: FSET? OTHER,PERSONBIT \?CND12 FSET? OTHER,INVISIBLE /?CND12 EQUAL? OTHER,PLAYER /?CND12 INC 'N SET 'WHO,OTHER ?CND12: NEXT? OTHER >OTHER /?KLU34 ?KLU34: JUMP ?PRG10 ?REP11: EQUAL? 1,N \?CND19 ZERO? QCONTEXT \?CND19 CALL2 SAID-TO,WHO ?CND19: CALL1 QCONTEXT-GOOD? ZERO? STACK /FALSE EQUAL? WINNER,PLAYER \FALSE SET 'WINNER,QCONTEXT PRINTI "(said to " PRINTD QCONTEXT PRINTR ")" .FUNCT QCONTEXT-GOOD? ZERO? QCONTEXT /FALSE FSET? QCONTEXT,PERSONBIT \FALSE FSET? QCONTEXT,INVISIBLE /FALSE EQUAL? HERE,QCONTEXT-ROOM \FALSE CALL2 META-LOC,QCONTEXT EQUAL? HERE,STACK /TRUE RFALSE .FUNCT SAID-TO,WHO SET 'QCONTEXT,WHO LOC WHO >QCONTEXT-ROOM RETURN QCONTEXT-ROOM .FUNCT THIS-IS-IT,OBJ EQUAL? OBJ,FALSE-VALUE,NOT-HERE-OBJECT,PLAYER /TRUE EQUAL? OBJ,INTDIR,GLOBAL-HERE /TRUE EQUAL? PRSA,V?FACE,V?WALK-TO,V?WALK \?CND1 EQUAL? OBJ,PRSO /TRUE ?CND1: FSET? OBJ,PERSONBIT /?ELS12 FSET IT,TOUCHBIT SET 'P-IT-OBJECT,OBJ RTRUE ?ELS12: FSET? OBJ,FEMALE \?ELS14 FSET HER,TOUCHBIT SET 'P-HER-OBJECT,OBJ RTRUE ?ELS14: FSET? OBJ,PLURALBIT \?ELS16 FSET THEM,TOUCHBIT SET 'P-THEM-OBJECT,OBJ RTRUE ?ELS16: FSET HIM,TOUCHBIT SET 'P-HIM-OBJECT,OBJ RTRUE .FUNCT NOT-IT,WHO EQUAL? WHO,P-HER-OBJECT \?ELS5 FCLEAR HER,TOUCHBIT RTRUE ?ELS5: EQUAL? WHO,P-HIM-OBJECT \?ELS7 FCLEAR HIM,TOUCHBIT RTRUE ?ELS7: EQUAL? WHO,P-THEM-OBJECT \?ELS9 FCLEAR THEM,TOUCHBIT RTRUE ?ELS9: EQUAL? WHO,P-IT-OBJECT \FALSE FCLEAR IT,TOUCHBIT RTRUE .FUNCT FAKE-ORPHAN,TMP,?TMP1 CALL ORPHAN,P-SYNTAX,FALSE-VALUE PRINTI "(Be specific: what thing do you want to " GET P-OTBL,P-VERBN >TMP ZERO? TMP \?ELS5 PRINTI "tell" JUMP ?CND3 ?ELS5: GETB P-VTBL,2 ZERO? STACK \?ELS9 GET TMP,0 PRINTB STACK JUMP ?CND3 ?ELS9: GETB TMP,2 >?TMP1 GETB TMP,3 CALL WORD-PRINT,?TMP1,STACK PUTB P-VTBL,2,0 ?CND3: SET 'P-OFLAG,TRUE-VALUE SET 'CLOCK-WAIT,TRUE-VALUE PRINTR "?)" .FUNCT TELL-D-LOC,OBJ PRINTD OBJ IN? OBJ,GLOBAL-OBJECTS \?ELS5 PRINTI "(gl)" JUMP ?CND3 ?ELS5: IN? OBJ,LOCAL-GLOBALS \?ELS9 PRINTI "(lg)" JUMP ?CND3 ?ELS9: IN? OBJ,ROOMS \?CND3 PRINTI "(rm)" ?CND3: EQUAL? OBJ,TURN,INTNUM \FALSE PRINTI "(" ZERO? P-DOLLAR-FLAG /?ELS27 PRINTC CURRENCY-SYMBOL PRINTN P-AMOUNT PRINTI ")" RTRUE ?ELS27: PRINTN P-NUMBER PRINTI ")" RTRUE .FUNCT FIX-HIM-HER,HEM-OBJECT,C,P GETP HEM-OBJECT,P?CHARACTER >C CALL2 ACCESSIBLE?,HEM-OBJECT ZERO? STACK \?CND1 ZERO? DEBUG /?CND4 PRINTI "[" PRINTD HEM-OBJECT PRINTI ":NA]" CRLF ?CND4: GET GLOBAL-CHARACTER-TABLE,C >P ZERO? C /FALSE GET CHARACTER-TABLE,C EQUAL? P,STACK /FALSE PRINT I-ASSUME CALL2 PRINTT,P PRINTI ".)" CRLF RETURN P ?CND1: IN? HEM-OBJECT,GLOBAL-OBJECTS \?ELS21 GET CHARACTER-TABLE,C >P JUMP ?CND19 ?ELS21: SET 'P,HEM-OBJECT ?CND19: LOC P EQUAL? HERE,STACK \FALSE ZERO? DEBUG /?CND29 PRINTI "[" PRINTD HEM-OBJECT PRINTI ":LO]" CRLF ?CND29: PRINT I-ASSUME CALL2 PRINTT,P PRINTI ".)" CRLF RETURN P .FUNCT PERFORM,A,O=0,I=0,V,OA,OO,OI ZERO? DEBUG /?CND1 PRINTI "[Perform: " PRINTN A ZERO? O /?CND9 PRINTI "/" EQUAL? A,V?WALK,V?FACE \?ELS17 PRINTN O JUMP ?CND9 ?ELS17: CALL2 TELL-D-LOC,O ?CND9: ZERO? I /?CND22 PRINTI "/" CALL2 TELL-D-LOC,I ?CND22: PRINTI "]" CRLF ?CND1: SET 'OA,PRSA SET 'OO,PRSO SET 'OI,PRSI SET 'PRSA,A EQUAL? A,V?WALK,V?FACE /?CND30 EQUAL? IT,I,O \?CND33 CALL2 ACCESSIBLE?,P-IT-OBJECT ZERO? STACK \?CND33 ZERO? I \?ELS40 CALL1 FAKE-ORPHAN RETURN 2 ?ELS40: CALL2 NOT-HERE,P-IT-OBJECT RETURN 2 ?CND33: EQUAL? THEM,I,O \?CND45 CALL2 FIX-HIM-HER,P-THEM-OBJECT >V ZERO? V /?ELS50 ZERO? DEBUG /?CND51 PRINTI "[them=" PRINTD V PRINTI "]" CRLF ?CND51: EQUAL? THEM,O \?CND57 SET 'O,V ?CND57: EQUAL? THEM,I \?CND48 SET 'I,V JUMP ?CND48 ?ELS50: ZERO? I \?ELS67 CALL1 FAKE-ORPHAN RETURN 2 ?ELS67: CALL2 NOT-HERE,P-THEM-OBJECT RETURN 2 ?CND48: ?CND45: EQUAL? HER,I,O \?CND72 CALL2 FIX-HIM-HER,P-HER-OBJECT >V ZERO? V /?ELS77 ZERO? DEBUG /?CND78 PRINTI "[her=" PRINTD V PRINTI "]" CRLF ?CND78: EQUAL? HER,O \?CND84 SET 'O,V ?CND84: EQUAL? HER,I \?CND75 SET 'I,V JUMP ?CND75 ?ELS77: ZERO? I \?ELS94 CALL1 FAKE-ORPHAN RETURN 2 ?ELS94: CALL2 NOT-HERE,P-HER-OBJECT RETURN 2 ?CND75: ?CND72: EQUAL? HIM,I,O \?CND99 CALL2 FIX-HIM-HER,P-HIM-OBJECT >V ZERO? V /?ELS104 ZERO? DEBUG /?CND105 PRINTI "[him=" PRINTD V PRINTI "]" CRLF ?CND105: EQUAL? HIM,O \?CND111 SET 'O,V ?CND111: EQUAL? HIM,I \?CND102 SET 'I,V JUMP ?CND102 ?ELS104: ZERO? I \?ELS121 CALL1 FAKE-ORPHAN RETURN 2 ?ELS121: CALL2 NOT-HERE,P-HIM-OBJECT RETURN 2 ?CND102: ?CND99: EQUAL? O,IT \?CND126 SET 'O,P-IT-OBJECT PRINT I-ASSUME CALL2 PRINTT,O PRINTI ".)" CRLF ?CND126: EQUAL? I,IT \?CND30 SET 'I,P-IT-OBJECT PRINT I-ASSUME CALL2 PRINTT,I PRINTI ".)" CRLF ?CND30: SET 'PRSI,I SET 'PRSO,O SET 'V,FALSE-VALUE ZERO? NOW-LURCHING /?CND136 EQUAL? TOLD-LURCHING,PRESENT-TIME /?CND136 ZERO? TRAIN-MOVING /?CND136 CALL1 GAME-VERB? ZERO? STACK \?CND136 EQUAL? PRSA,V?MOVE \?THN143 EQUAL? PRSO,STOP-CORD /?CND136 ?THN143: SET 'TOLD-LURCHING,PRESENT-TIME PRINTI "The train lurches a bit." CRLF ?CND136: EQUAL? A,V?WALK,V?FACE /?CND147 EQUAL? NOT-HERE-OBJECT,PRSO,PRSI \?CND147 CALL D-APPLY,STR?155,NOT-HERE-OBJECT-F >V ZERO? V /?CND147 SET 'CLOCK-WAIT,TRUE-VALUE ?CND147: CALL2 THIS-IS-IT,PRSI CALL2 THIS-IS-IT,PRSO SET 'O,PRSO SET 'I,PRSI ZERO? DEBUG /?CND156 PRINTC 91 PRINTD WINNER PRINTI "=]" ?CND156: ZERO? V \?CND160 GETP WINNER,P?ACTION CALL D-APPLY,STR?156,STACK,M-WINNER >V ?CND160: ZERO? V \?CND163 LOC WINNER GETP STACK,P?ACTION CALL D-APPLY,STR?157,STACK,M-BEG >V ?CND163: ZERO? V \?CND166 GET PREACTIONS,A CALL D-APPLY,STR?158,STACK >V ?CND166: SET 'NOW-PRSI,TRUE-VALUE ZERO? V \?CND169 ZERO? I /?CND169 EQUAL? A,V?WALK /?CND169 LOC I ZERO? STACK /?CND169 LOC I GETP STACK,P?CONTFCN >V ZERO? V /?CND169 CALL V,M-CONT >V ?CND169: ZERO? V \?CND178 ZERO? I /?CND178 GETP I,P?ACTION CALL D-APPLY,STR?159,STACK >V ?CND178: SET 'NOW-PRSI,FALSE-VALUE ZERO? V \?CND183 ZERO? O /?CND183 EQUAL? A,V?WALK,V?FACE /?CND183 LOC O ZERO? STACK /?CND183 LOC O GETP STACK,P?CONTFCN >V ZERO? V /?CND183 CALL V,M-CONT >V ?CND183: ZERO? V \?CND192 ZERO? O /?CND192 EQUAL? A,V?WALK,V?FACE /?CND192 GETP O,P?ACTION CALL D-APPLY,STR?160,STACK >V ?CND192: ZERO? V \?CND197 GET ACTIONS,A CALL D-APPLY,FALSE-VALUE,STACK >V ?CND197: EQUAL? V,M-FATAL /?CND200 EQUAL? PRSA,V?RESTORE,V?SAVE /?THN206 CALL1 GAME-VERB? ZERO? STACK \?CND200 ?THN206: LOC WINNER GETP STACK,P?ACTION CALL D-APPLY,STR?161,STACK,M-END >V ?CND200: SET 'PRSA,OA SET 'PRSO,OO SET 'PRSI,OI RETURN V .FUNCT D-APPLY,STR,FCN,FOO=0,RES ZERO? FCN /FALSE ZERO? DEBUG /?CND8 ZERO? STR \?ELS14 PRINTI "[Action:]" CRLF JUMP ?CND8 ?ELS14: PRINTC 91 PRINT STR PRINTI ": " ?CND8: EQUAL? STR,STR?162 \?CND21 SET 'FOO,M-CONT ?CND21: ZERO? FOO /?ELS28 CALL FCN,FOO JUMP ?CND24 ?ELS28: CALL FCN ?CND24: SET 'RES,STACK ZERO? DEBUG /?CND32 ZERO? STR /?CND32 EQUAL? RES,M-FATAL \?ELS39 PRINTI "Fatal]" CRLF RETURN RES ?ELS39: ZERO? RES \?ELS43 PRINTI "Not handled]" CRLF RETURN RES ?ELS43: PRINTI "Handled]" CRLF ?CND32: RETURN RES .FUNCT I-PROMPT,GARG=0 ZERO? IDEBUG \?THN4 EQUAL? GARG,G-DEBUG \?CND1 ?THN4: PRINTI "[I-PROMPT:" EQUAL? GARG,G-DEBUG /FALSE ?CND1: DEC 'P-PROMPT ZERO? IDEBUG /FALSE PRINTI "(0)]" CRLF RFALSE .FUNCT BUZZER-WORD?,WORD CALL2 QUESTION-WORD?,WORD ZERO? STACK \TRUE CALL2 NUMBER-WORD?,WORD ZERO? STACK \TRUE CALL2 NAUGHTY-WORD?,WORD ZERO? STACK \TRUE EQUAL? WORD,W?NW,W?NORTHWEST,W?NE /?THN12 EQUAL? WORD,W?SW,W?SOUTHWEST,W?NORTHEAST /?THN12 EQUAL? WORD,W?SE,W?SOUTHEAST \FALSE ?THN12: PRINTI "(Sorry, but this story has no """ PRINTB WORD PRINTR """ directions.)" .FUNCT QUESTION-WORD?,WORD EQUAL? WORD,W?WHERE \?ELS5 PRINTI "(To locate something, use the command: FIND " PRINTD SOMETHING PRINTR ".)" ?ELS5: EQUAL? WORD,W?WHAT,W?WHAT'S /?THN10 EQUAL? WORD,W?WHO,W?WHO'S \?ELS9 ?THN10: PRINTI "(To ask about something, use the command: TELL ME ABOUT " PRINTD SOMETHING PRINTR ".)" ?ELS9: EQUAL? WORD,W?THAT'S,W?IT'S /?THN16 EQUAL? WORD,W?WHY,W?HOW,W?WHEN /?THN16 EQUAL? WORD,W?IS,W?DID,W?ARE /?THN16 EQUAL? WORD,W?DO,W?HAVE /?THN16 EQUAL? WORD,W?AM,W?I'M,W?WE'RE /?THN16 EQUAL? WORD,W?WILL,W?WAS,W?WERE /?THN16 EQUAL? WORD,W?I'LL,W?CAN,W?WHICH /?THN16 EQUAL? WORD,W?I'VE,W?WON'T,W?HAS /?THN16 EQUAL? WORD,W?YOU'RE,W?HE'S,W?SHE'S /?THN16 EQUAL? WORD,W?SHOULD,W?WOULD,W?WHEN'S /?THN16 EQUAL? WORD,W?THEY'RE,W?COULD,W?SHALL \FALSE ?THN16: PRINTI "(Please use commands" INC 'QUESTION-WORD-COUNT GRTR? QUESTION-WORD-COUNT,4 \?ELS22 SET 'QUESTION-WORD-COUNT,0 PRINTI "! Your commands tell the computer what you want to do in the story. Here are examples of commands: TURN ON THE LAMP LOOK UNDER THE RUG MADAME, GIVE THE BOOK TO HIM CONDUCTOR, HELP ME Now you can try again" JUMP ?CND20 ?ELS22: PRINTI ", not statements or questions" ?CND20: PRINTR ".)" .FUNCT NUMBER-WORD?,WRD EQUAL? WRD,W?ZERO,W?SEVENTY /?THN6 EQUAL? WRD,W?TWO,W?THREE,W?FOUR /?THN6 EQUAL? WRD,W?FIVE,W?SIX,W?SEVEN /?THN6 EQUAL? WRD,W?EIGHT,W?NINE,W?TEN /?THN6 EQUAL? WRD,W?ELEVEN,W?TWELVE,W?THIRTEEN /?THN6 EQUAL? WRD,W?FOURTEEN,W?FIFTEEN,W?SIXTEEN /?THN6 EQUAL? WRD,W?SEVENTEEN,W?EIGHTEEN,W?NINETEEN /?THN6 EQUAL? WRD,W?TWENTY,W?THIRTY,W?FORTY /?THN6 EQUAL? WRD,W?FIFTY,W?SIXTY,W?EIGHTY /?THN6 EQUAL? WRD,W?NINETY,W?HUNDRED,W?THOUSAND /?THN6 EQUAL? WRD,W?MILLION,W?BILLION,W?ONE \FALSE ?THN6: PRINTR "(Use numerals for numbers, for example ""10."")" .FUNCT NAUGHTY-WORD?,WORD EQUAL? WORD,W?CURSE,W?CURSES,W?CUSS /?THN6 EQUAL? WORD,W?DAMN,W?SHIT,W?FUCK /?THN6 EQUAL? WORD,W?CHOMP,W?DARN,W?HELL /?THN6 EQUAL? WORD,W?FUDGE,W?PISS,W?SUCK /?THN6 EQUAL? WORD,W?BASTARD,W?SCREW,W?CRAP /?THN6 EQUAL? WORD,W?FUCKED,W?GODDAMN,W?ASSHOLE /?THN6 EQUAL? WORD,W?CUNT,W?SHITHEAD,W?SUCKS /?THN6 EQUAL? WORD,W?DAMNED,W?PEE,W?COCKSUCKER /?THN6 EQUAL? WORD,W?BITCH \FALSE ?THN6: PRINTC 40 CALL2 PICK-ONE-NEW,OFFENDED PRINT STACK PRINTC 41 CRLF RTRUE .FUNCT PARSER,PTR=P-LEXSTART,WRD,VAL=0,VERB=0,OF-FLAG=0,LEN,DIR=0,NW=0,LW=0,CNT=-1,OMERGED,OWINNER,TMP,?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 'P-NUMBER,-1 SET 'P-NAM,FALSE-VALUE SET 'P-ADJ,FALSE-VALUE SET 'P-ADVERB,FALSE-VALUE SET 'OMERGED,P-MERGED 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 SET 'OWINNER,WINNER ZERO? QUOTE-FLAG \?CND11 EQUAL? WINNER,PLAYER /?CND11 SET 'WINNER,PLAYER LOC WINNER >HERE CALL2 LIT?,HERE >LIT ?CND11: ZERO? RESERVE-PTR /?ELS21 SET 'PTR,RESERVE-PTR CALL STUFF,P-LEXV,RESERVE-LEXV EQUAL? VERBOSE,1,2 \?CND23 EQUAL? PLAYER,WINNER \?CND23 CRLF ?CND23: SET 'RESERVE-PTR,FALSE-VALUE SET 'P-CONT,FALSE-VALUE JUMP ?CND19 ?ELS21: ZERO? P-CONT /?ELS29 SET 'PTR,P-CONT SET 'P-CONT,FALSE-VALUE ZERO? VERBOSE /?CND19 EQUAL? PLAYER,WINNER \?CND19 CRLF JUMP ?CND19 ?ELS29: SET 'WINNER,PLAYER SET 'QUOTE-FLAG,FALSE-VALUE LOC WINNER >HERE CALL2 LIT?,HERE >LIT FCLEAR IT,TOUCHBIT FCLEAR HER,TOUCHBIT FCLEAR HIM,TOUCHBIT FCLEAR THEM,TOUCHBIT ZERO? VERBOSE /?CND40 CRLF ?CND40: ZERO? P-PROMPT /?CND43 ZERO? P-OFLAG \?CND43 EQUAL? P-PROMPT,P-PROMPT-START \?ELS50 PRINTI "Okay, what do you want to do now?" JUMP ?CND48 ?ELS50: DLESS? 'P-PROMPT,1 \?ELS54 PRINTI "(You won't see ""What next?"" any more.) " JUMP ?CND48 ?ELS54: PRINTI "What next?" ?CND48: CRLF ?CND43: PUTB P-LEXV,0,59 CALL1 STATUS-LINE PRINTI ">" READ P-INBUF,P-LEXV ?CND19: GETB P-LEXV,P-LEXWORDS >P-LEN GET P-LEXV,PTR EQUAL? W?QUOTE,STACK \?CND65 CALL1 QCONTEXT-GOOD? ZERO? STACK /?CND65 ADD PTR,P-LEXELEN >PTR DEC 'P-LEN ?CND65: GET P-LEXV,PTR EQUAL? W?THEN,STACK \?CND70 ADD PTR,P-LEXELEN >PTR DEC 'P-LEN ?CND70: LESS? 1,P-LEN \?CND73 GET P-LEXV,PTR EQUAL? W?GO,STACK \?CND73 ADD PTR,P-LEXELEN GET P-LEXV,STACK >NW ZERO? NW /?CND73 CALL WT?,NW,PS?VERB ZERO? STACK /?CND73 ADD PTR,P-LEXELEN >PTR DEC 'P-LEN ?CND73: ZERO? P-LEN \?ELS80 PRINTI "I beg your pardon?" CRLF RFALSE ?ELS80: GET P-LEXV,PTR EQUAL? STACK,W?OOPS \?ELS84 GRTR? P-LEN,1 /?ELS87 PRINTI "I can't help your clumsiness." CRLF RFALSE ?ELS87: GET OOPS-TABLE,O-PTR ZERO? STACK /?ELS91 GET OOPS-TABLE,O-PTR >?TMP1 ADD PTR,P-LEXELEN GET P-LEXV,STACK PUT AGAIN-LEXV,?TMP1,STACK SET 'WINNER,OWINNER MUL PTR,P-LEXELEN ADD STACK,6 GETB P-LEXV,STACK >?TMP2 MUL PTR,P-LEXELEN ADD STACK,7 GETB P-LEXV,STACK >?TMP1 GET OOPS-TABLE,O-PTR MUL STACK,P-LEXELEN ADD STACK,3 CALL INBUF-ADD,?TMP2,?TMP1,STACK CALL STUFF,P-LEXV,AGAIN-LEXV GETB P-LEXV,P-LEXWORDS >P-LEN GET OOPS-TABLE,O-START >PTR CALL INBUF-STUFF,P-INBUF,OOPS-INBUF JUMP ?CND78 ?ELS91: PUT OOPS-TABLE,O-END,FALSE-VALUE PRINTI "There was no word to replace!" CRLF RFALSE ?ELS84: PUT OOPS-TABLE,O-END,FALSE-VALUE ?CND78: GET P-LEXV,PTR EQUAL? STACK,W?AGAIN,W?G \?ELS100 ZERO? P-OFLAG /?ELS103 PRINTI "It's difficult to repeat fragments." CRLF RFALSE ?ELS103: GRTR? P-LEN,1 \?ELS108 ADD PTR,P-LEXELEN GET P-LEXV,STACK EQUAL? STACK,W?PERIOD,W?COMMA,W?THEN /?THN112 ADD PTR,P-LEXELEN GET P-LEXV,STACK EQUAL? STACK,W?AND \?ELS111 ?THN112: MUL 2,P-LEXELEN ADD PTR,STACK >PTR GETB P-LEXV,P-LEXWORDS SUB STACK,2 PUTB P-LEXV,P-LEXWORDS,STACK JUMP ?CND101 ?ELS111: PRINTI "I couldn't understand that sentence." CRLF RFALSE ?ELS108: ADD PTR,P-LEXELEN >PTR GETB P-LEXV,P-LEXWORDS SUB STACK,1 PUTB P-LEXV,P-LEXWORDS,STACK ?CND101: GETB P-LEXV,P-LEXWORDS GRTR? STACK,0 \?ELS122 CALL STUFF,RESERVE-LEXV,P-LEXV SET 'RESERVE-PTR,PTR JUMP ?CND120 ?ELS122: SET 'RESERVE-PTR,FALSE-VALUE ?CND120: SET 'WINNER,OWINNER SET 'P-MERGED,OMERGED CALL INBUF-STUFF,P-INBUF,OOPS-INBUF CALL STUFF,P-LEXV,AGAIN-LEXV SET 'CNT,-1 SET 'DIR,P-WALK-DIR ?PRG125: IGRTR? 'CNT,P-ITBLLEN \?ELS129 JUMP ?CND98 ?ELS129: GET P-OTBL,CNT PUT P-ITBL,CNT,STACK JUMP ?PRG125 ?ELS100: CALL STUFF,AGAIN-LEXV,P-LEXV CALL INBUF-STUFF,OOPS-INBUF,P-INBUF PUT OOPS-TABLE,O-START,PTR MUL 4,P-LEN PUT OOPS-TABLE,O-LENGTH,STACK SET 'RESERVE-PTR,FALSE-VALUE SET 'LEN,P-LEN SET 'P-DIR,FALSE-VALUE SET 'P-NCN,0 SET 'P-GETFLAGS,0 PUT P-ITBL,P-VERBN,0 ?PRG134: DLESS? 'P-LEN,0 \?ELS138 SET 'QUOTE-FLAG,FALSE-VALUE JUMP ?CND98 ?ELS138: GET P-LEXV,PTR >WRD CALL2 BUZZER-WORD?,WRD ZERO? STACK \FALSE ZERO? WRD \?THN143 CALL2 NUMBER?,PTR >WRD ZERO? WRD /?ELS142 ?THN143: EQUAL? WRD,W?TO \?ELS147 EQUAL? VERB,ACT?TELL,ACT?ASK \?ELS147 PUT P-ITBL,P-VERB,ACT?TELL SET 'WRD,W?QUOTE JUMP ?CND145 ?ELS147: EQUAL? WRD,W?THEN \?CND145 ZERO? VERB \?CND145 ZERO? QUOTE-FLAG \?CND145 PUT P-ITBL,P-VERB,ACT?TELL PUT P-ITBL,P-VERBN,0 SET 'WRD,W?QUOTE ?CND145: EQUAL? WRD,W?THEN,W?PERIOD,W?QUOTE \?ELS156 EQUAL? WRD,W?QUOTE \?CND157 ZERO? QUOTE-FLAG /?ELS162 SET 'QUOTE-FLAG,FALSE-VALUE JUMP ?CND157 ?ELS162: SET 'QUOTE-FLAG,TRUE-VALUE ?CND157: ZERO? P-LEN /?THN166 ADD PTR,P-LEXELEN >P-CONT ?THN166: PUTB P-LEXV,P-LEXWORDS,P-LEN JUMP ?CND98 ?ELS156: CALL WT?,WRD,PS?DIRECTION,P1?DIRECTION >VAL ZERO? VAL /?ELS169 EQUAL? VERB,FALSE-VALUE,ACT?WALK,ACT?HEAD \?ELS169 EQUAL? LEN,1 /?THN172 EQUAL? LEN,2 \?ELS175 EQUAL? VERB,ACT?WALK,ACT?HEAD /?THN172 ?ELS175: ADD PTR,P-LEXELEN GET P-LEXV,STACK >NW EQUAL? NW,W?THEN,W?PERIOD,W?QUOTE \?ELS177 GRTR? LEN,1 /?THN172 ?ELS177: ZERO? QUOTE-FLAG /?ELS179 EQUAL? LEN,2 \?ELS179 EQUAL? NW,W?QUOTE /?THN172 ?ELS179: GRTR? LEN,2 \?ELS169 EQUAL? NW,W?COMMA,W?AND \?ELS169 ?THN172: SET 'DIR,VAL EQUAL? NW,W?COMMA,W?AND \?CND182 ADD PTR,P-LEXELEN CALL CHANGE-LEXV,STACK,W?THEN ?CND182: GRTR? LEN,2 /?CND136 SET 'QUOTE-FLAG,FALSE-VALUE JUMP ?CND98 ?ELS169: CALL WT?,WRD,PS?VERB,P1?VERB >VAL ZERO? VAL /?ELS189 ZERO? VERB \?ELS189 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 >TMP GETB P-LEXV,TMP PUTB P-VTBL,2,STACK ADD TMP,1 GETB P-LEXV,STACK PUTB P-VTBL,3,STACK JUMP ?CND136 ?ELS189: CALL WT?,WRD,PS?PREPOSITION,0 >VAL ZERO? VAL \?THN196 EQUAL? WRD,W?ONE,W?A /?THN200 EQUAL? WRD,W?BOTH,W?ALL /?THN200 CALL WT?,WRD,PS?ADJECTIVE ZERO? STACK \?THN200 CALL WT?,WRD,PS?OBJECT ZERO? STACK /?ELS195 ?THN200: SET 'VAL,0 \?ELS195 ?THN196: GRTR? P-LEN,1 \?ELS204 ADD PTR,P-LEXELEN GET P-LEXV,STACK EQUAL? STACK,W?OF \?ELS204 ZERO? VAL \?ELS204 EQUAL? WRD,W?ONE,W?A /?ELS204 EQUAL? WRD,W?ALL,W?BOTH /?ELS204 SET 'OF-FLAG,TRUE-VALUE JUMP ?CND136 ?ELS204: ZERO? VAL /?ELS208 ZERO? P-LEN /?THN211 ADD PTR,2 GET P-LEXV,STACK EQUAL? STACK,W?THEN,W?PERIOD \?ELS208 ?THN211: SET 'P-END-ON-PREP,TRUE-VALUE LESS? P-NCN,2 \?CND136 PUT P-ITBL,P-PREP1,VAL PUT P-ITBL,P-PREP1N,WRD JUMP ?CND136 ?ELS208: EQUAL? P-NCN,2 \?ELS217 PRINTI "(I found too many nouns in that sentence!)" CRLF RFALSE ?ELS217: INC 'P-NCN CALL CLAUSE,PTR,VAL,WRD >PTR ZERO? PTR /FALSE LESS? PTR,0 \?CND136 SET 'QUOTE-FLAG,FALSE-VALUE JUMP ?CND98 ?ELS195: EQUAL? WRD,W?CLOSELY \?ELS228 SET 'P-ADVERB,W?CAREFULLY JUMP ?CND136 ?ELS228: EQUAL? WRD,W?CAREFULLY,W?QUIETLY /?THN231 EQUAL? WRD,W?SLOWLY,W?QUICKLY,W?BRIEFLY \?ELS230 ?THN231: SET 'P-ADVERB,WRD JUMP ?CND136 ?ELS230: EQUAL? WRD,W?OF \?ELS234 ZERO? OF-FLAG /?THN238 ADD PTR,P-LEXELEN GET P-LEXV,STACK EQUAL? STACK,W?PERIOD,W?THEN \?ELS237 ?THN238: CALL2 CANT-USE,PTR RFALSE ?ELS237: SET 'OF-FLAG,FALSE-VALUE JUMP ?CND136 ?ELS234: CALL WT?,WRD,PS?BUZZ-WORD ZERO? STACK /?ELS243 JUMP ?CND136 ?ELS243: EQUAL? VERB,ACT?TELL \?ELS245 CALL WT?,WRD,PS?VERB ZERO? STACK /?ELS245 PRINTI "(Please consult your manual for the correct way to talk to characters.)" CRLF RFALSE ?ELS245: CALL2 CANT-USE,PTR RFALSE ?ELS142: CALL2 UNKNOWN-WORD,PTR RFALSE ?CND136: SET 'LW,WRD ADD PTR,P-LEXELEN >PTR JUMP ?PRG134 ?CND98: PUT OOPS-TABLE,O-PTR,FALSE-VALUE ZERO? DIR /?CND254 EQUAL? VERB,ACT?HEAD \?ELS260 SET 'PRSA,V?FACE JUMP ?CND258 ?ELS260: SET 'PRSA,V?WALK ?CND258: SET 'P-WALK-DIR,DIR SET 'PRSO,DIR SET 'P-OFLAG,FALSE-VALUE RETURN TRUE-VALUE ?CND254: SET 'P-WALK-DIR,FALSE-VALUE ZERO? P-OFLAG /?CND263 CALL1 ORPHAN-MERGE ZERO? STACK /?CND263 SET 'WINNER,OWINNER ?CND263: GET P-ITBL,P-VERB ZERO? STACK \?CND268 PUT P-ITBL,P-VERB,ACT?$CALL ?CND268: CALL1 SYNTAX-CHECK ZERO? STACK /FALSE CALL1 SNARF-OBJECTS ZERO? STACK /FALSE CALL1 MANY-CHECK ZERO? STACK /FALSE CALL1 TAKE-CHECK ZERO? STACK /FALSE RTRUE .FUNCT STUFF,DEST,SRC,MAX=29,PTR=P-LEXSTART,CTR=1,BPTR GETB SRC,0 PUTB DEST,0,STACK GETB SRC,1 PUTB DEST,1,STACK ?PRG1: GET SRC,PTR PUT DEST,PTR,STACK MUL PTR,2 ADD STACK,2 >BPTR GETB SRC,BPTR PUTB DEST,BPTR,STACK MUL PTR,2 ADD STACK,3 >BPTR GETB SRC,BPTR PUTB DEST,BPTR,STACK ADD PTR,P-LEXELEN >PTR IGRTR? 'CTR,MAX \?PRG1 RTRUE .FUNCT INBUF-STUFF,DEST,SRC,CNT=-1 ?PRG1: IGRTR? 'CNT,59 /TRUE GETB SRC,CNT PUTB DEST,CNT,STACK JUMP ?PRG1 .FUNCT INBUF-ADD,LEN,BEG,SLOT,DBEG,CTR=0,TMP,?TMP1 GET OOPS-TABLE,O-END >TMP ZERO? TMP /?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 CHANGE-LEXV,PTR,WRD PUT P-LEXV,PTR,WRD PUT AGAIN-LEXV,PTR,WRD RTRUE .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 CALL2 BUZZER-WORD?,WRD ZERO? STACK \FALSE ZERO? WRD \?THN22 CALL2 NUMBER?,PTR >WRD ZERO? WRD /?ELS21 ?THN22: ZERO? P-LEN \?ELS26 SET 'NW,0 JUMP ?CND24 ?ELS26: ADD PTR,P-LEXELEN GET P-LEXV,STACK >NW ?CND24: EQUAL? WRD,W?AND,W?COMMA \?ELS31 SET 'ANDFLG,TRUE-VALUE JUMP ?CND17 ?ELS31: EQUAL? WRD,W?ALL,W?BOTH,W?ONE \?ELS33 EQUAL? NW,W?OF \?CND17 DEC 'P-LEN ADD PTR,P-LEXELEN >PTR JUMP ?CND17 ?ELS33: EQUAL? WRD,W?THEN,W?PERIOD /?THN39 CALL WT?,WRD,PS?PREPOSITION ZERO? STACK /?ELS38 GET P-ITBL,P-VERB ZERO? STACK /?ELS38 ZERO? FIRST?? \?ELS38 ?THN39: INC 'P-LEN ADD NUM,1 >?TMP1 MUL PTR,2 ADD P-LEXV,STACK PUT P-ITBL,?TMP1,STACK SUB PTR,P-LEXELEN RETURN STACK ?ELS38: ZERO? ANDFLG /?ELS44 GET P-ITBL,P-VERBN ZERO? STACK /?THN47 CALL2 VERB-DIR-ONLY?,WRD ZERO? STACK /?ELS44 ?THN47: SUB PTR,4 >PTR ADD PTR,2 CALL CHANGE-LEXV,STACK,W?THEN ADD P-LEN,2 >P-LEN JUMP ?CND17 ?ELS44: CALL WT?,WRD,PS?OBJECT ZERO? STACK /?ELS50 GRTR? P-LEN,0 \?ELS53 EQUAL? NW,W?OF \?ELS53 EQUAL? WRD,W?ALL,W?ONE /?ELS53 JUMP ?CND17 ?ELS53: CALL WT?,WRD,PS?ADJECTIVE ZERO? STACK /?ELS57 ZERO? NW /?ELS57 CALL WT?,NW,PS?OBJECT ZERO? STACK /?ELS57 JUMP ?CND17 ?ELS57: ZERO? ANDFLG \?ELS61 EQUAL? NW,W?BUT,W?EXCEPT /?ELS61 EQUAL? NW,W?AND,W?COMMA /?ELS61 ADD NUM,1 >?TMP1 ADD PTR,2 MUL STACK,2 ADD P-LEXV,STACK PUT P-ITBL,?TMP1,STACK RETURN PTR ?ELS61: SET 'ANDFLG,FALSE-VALUE JUMP ?CND17 ?ELS50: CALL WT?,WRD,PS?ADJECTIVE ZERO? STACK \?CND17 CALL WT?,WRD,PS?BUZZ-WORD ZERO? STACK /?ELS67 JUMP ?CND17 ?ELS67: ZERO? ANDFLG /?ELS71 GET P-ITBL,P-VERB ZERO? STACK \?ELS71 SUB PTR,4 >PTR ADD PTR,2 CALL CHANGE-LEXV,STACK,W?THEN ADD P-LEN,2 >P-LEN JUMP ?CND17 ?ELS71: CALL WT?,WRD,PS?PREPOSITION ZERO? STACK /?ELS75 JUMP ?CND17 ?ELS75: CALL2 CANT-USE,PTR RFALSE ?ELS21: CALL2 UNKNOWN-WORD,PTR RFALSE ?CND17: SET 'LW,WRD SET 'FIRST??,FALSE-VALUE ADD PTR,P-LEXELEN >PTR JUMP ?PRG12 .FUNCT VERB-DIR-ONLY?,WRD,?ORTMP CALL WT?,WRD,PS?OBJECT ZERO? STACK \FALSE CALL WT?,WRD,PS?ADJECTIVE ZERO? STACK \FALSE CALL WT?,WRD,PS?DIRECTION POP '?ORTMP ZERO? ?ORTMP /?ORP6 RETURN ?ORTMP ?ORP6: CALL WT?,WRD,PS?VERB RSTACK .FUNCT NUMBER?,PTR,CNT,BPTR,CHR,SUM=0,TIM=0,DOLLAR=0,CCTR,TMP,NW,PTT,?TMP1 MUL PTR,2 ADD P-LEXV,STACK >TMP GETB TMP,2 >CNT GETB TMP,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,9999 /FALSE EQUAL? CHR,CURRENCY-SYMBOL \?ELS14 SET 'DOLLAR,TRUE-VALUE JUMP ?CND8 ?ELS14: GRTR? CHR,57 /FALSE LESS? CHR,48 /FALSE MUL SUM,10 >?TMP1 SUB CHR,48 ADD ?TMP1,STACK >SUM ?CND8: INC 'BPTR JUMP ?PRG1 ?REP2: CALL CHANGE-LEXV,PTR,W?NUMBER ADD PTR,P-LEXELEN GET P-LEXV,STACK >NW ZERO? DOLLAR \?CND21 EQUAL? NW,W?PERIOD \?CND21 GRTR? P-LEN,1 \?CND21 MUL P-LEXELEN,2 ADD PTR,STACK CALL2 CENTS-CHECK,STACK >TMP ZERO? TMP /?ELS28 SET 'P-CENT-FLAG,TRUE-VALUE EQUAL? TMP,100 \?CND29 SET 'TMP,0 ?CND29: SET 'TIM,SUM SET 'SUM,TMP SUB P-LEN,2 >CCTR MUL 2,P-LEXELEN >TMP ADD PTR,TMP >PTT ?PRG32: DLESS? 'CCTR,0 \?ELS36 JUMP ?REP33 ?ELS36: ADD PTR,P-LEXELEN >PTR GET P-LEXV,PTT CALL CHANGE-LEXV,PTR,STACK MUL PTR,2 ADD STACK,2 >?TMP1 MUL PTT,2 ADD STACK,2 GETB P-LEXV,STACK PUTB P-LEXV,?TMP1,STACK MUL PTR,2 ADD STACK,3 >?TMP1 MUL PTT,2 ADD STACK,3 GETB P-LEXV,STACK PUTB P-LEXV,?TMP1,STACK JUMP ?PRG32 ?REP33: SUB P-LEN,2 >P-LEN GETB P-LEXV,P-LEXWORDS SUB STACK,2 PUTB P-LEXV,P-LEXWORDS,STACK JUMP ?CND21 ?ELS28: SET 'P-CENT-FLAG,FALSE-VALUE ?CND21: GRTR? SUM,9999 /FALSE ZERO? TIM /?CND41 GRTR? TIM,23 /FALSE MUL TIM,60 ADD SUM,STACK >SUM ?CND41: ZERO? DOLLAR /?ELS54 GRTR? SUM,0 \?ELS54 SET 'P-AMOUNT,SUM SET 'P-DOLLAR-FLAG,TRUE-VALUE RETURN W?MONEY ?ELS54: SET 'P-NUMBER,SUM SET 'P-DOLLAR-FLAG,FALSE-VALUE RETURN W?NUMBER .FUNCT CENTS-CHECK,PTR,CNT,BPTR,CCTR=0,CHR,SUM=0,TMP,?TMP1 MUL PTR,2 ADD P-LEXV,STACK >TMP GETB TMP,2 >CNT GETB TMP,3 >BPTR ?PRG1: DLESS? 'CNT,0 \?ELS5 JUMP ?REP2 ?ELS5: GETB P-INBUF,BPTR >CHR IGRTR? 'CCTR,2 /FALSE GRTR? CHR,53 /FALSE LESS? CHR,48 /FALSE MUL SUM,10 >?TMP1 SUB CHR,48 ADD ?TMP1,STACK >SUM INC 'BPTR JUMP ?PRG1 ?REP2: ZERO? SUM \?ELS21 RETURN 100 ?ELS21: EQUAL? CCTR,1 \?ELS23 MUL 10,SUM RSTACK ?ELS23: RETURN SUM .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?ADJECTIVE ZERO? STACK /?ELS3 SET 'ADJ,TRUE-VALUE JUMP ?CND1 ?ELS3: CALL WT?,WRD,PS?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 /?ELS10 ZERO? ADJ \?ELS10 GET P-OTBL,P-VERB EQUAL? VERB,STACK \FALSE ?ELS10: EQUAL? P-NCN,2 /FALSE GET P-OTBL,P-NC1 EQUAL? STACK,1 \?ELS16 GET P-ITBL,P-PREP1 >TEMP GET P-OTBL,P-PREP1 EQUAL? TEMP,STACK /?THN20 ZERO? TEMP \FALSE ?THN20: ZERO? ADJ /?ELS24 ADD P-LEXV,2 PUT P-OTBL,P-NC1,STACK GET P-ITBL,P-NC1L ZERO? STACK \?CND26 ADD P-LEXV,6 PUT P-ITBL,P-NC1L,STACK ?CND26: ZERO? P-NCN \?CND22 SET 'P-NCN,1 JUMP ?CND22 ?ELS24: GET P-ITBL,P-NC1 PUT P-OTBL,P-NC1,STACK ?CND22: GET P-ITBL,P-NC1L PUT P-OTBL,P-NC1L,STACK JUMP ?CND8 ?ELS16: GET P-OTBL,P-NC2 EQUAL? STACK,1 \?ELS37 GET P-ITBL,P-PREP1 >TEMP GET P-OTBL,P-PREP2 EQUAL? TEMP,STACK /?THN41 ZERO? TEMP \FALSE ?THN41: ZERO? ADJ /?CND43 ADD P-LEXV,2 PUT P-ITBL,P-NC1,STACK GET P-ITBL,P-NC1L ZERO? STACK \?CND43 ADD P-LEXV,6 PUT P-ITBL,P-NC1L,STACK ?CND43: 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 ?CND8 ?ELS37: ZERO? P-ACLAUSE /?CND8 EQUAL? P-NCN,1 /?ELS57 ZERO? ADJ \?ELS57 SET 'P-ACLAUSE,FALSE-VALUE RFALSE ?ELS57: GET P-ITBL,P-NC1 >BEG ZERO? ADJ /?CND62 ADD P-LEXV,2 >BEG SET 'ADJ,FALSE-VALUE ?CND62: GET P-ITBL,P-NC1L >END ?PRG66: GET BEG,0 >WRD EQUAL? BEG,END \?ELS70 ZERO? ADJ /?ELS73 CALL2 ACLAUSE-WIN,ADJ JUMP ?CND55 ?ELS73: SET 'P-ACLAUSE,FALSE-VALUE RFALSE ?ELS70: ZERO? ADJ \?ELS78 GETB WRD,P-PSOFF BTST STACK,PS?ADJECTIVE /?THN81 EQUAL? WRD,W?ALL,W?ONE \?ELS78 ?THN81: SET 'ADJ,WRD JUMP ?CND68 ?ELS78: EQUAL? WRD,W?ONE \?ELS84 CALL2 ACLAUSE-WIN,ADJ JUMP ?CND55 ?ELS84: GETB WRD,P-PSOFF BTST STACK,PS?OBJECT \?CND68 EQUAL? WRD,P-ANAM \?ELS89 CALL2 ACLAUSE-WIN,ADJ JUMP ?CND8 ?ELS89: CALL1 NCLAUSE-WIN JUMP ?CND8 ?CND68: ADD BEG,P-WORDLEN >BEG ZERO? END \?PRG66 SET 'END,BEG SET 'P-NCN,1 SUB BEG,4 PUT P-ITBL,P-NC1,STACK PUT P-ITBL,P-NC1L,BEG JUMP ?PRG66 ?CND55: ?CND8: 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 ?PRG95: IGRTR? 'CNT,P-ITBLLEN \?ELS99 SET 'P-MERGED,TRUE-VALUE RTRUE ?ELS99: GET P-OTBL,CNT PUT P-ITBL,CNT,STACK JUMP ?PRG95 .FUNCT ACLAUSE-WIN,ADJ,X GET P-OTBL,P-VERB PUT P-ITBL,P-VERB,STACK ADD P-ACLAUSE,1 >X CALL CLAUSE-COPY,P-OTBL,P-OTBL,P-ACLAUSE,X,P-ACLAUSE,X,ADJ GET P-OTBL,P-NC2 ZERO? STACK /?ELS2 SET 'P-NCN,2 ?ELS2: SET 'P-ACLAUSE,FALSE-VALUE RTRUE .FUNCT NCLAUSE-WIN ADD P-ACLAUSE,1 CALL CLAUSE-COPY,P-ITBL,P-OTBL,P-NC1,P-NC1L,P-ACLAUSE,STACK 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,MSG,?TMP1 PUT OOPS-TABLE,O-PTR,PTR CALL2 PICK-ONE,UNKNOWN-MSGS >MSG GET MSG,0 PRINT STACK MUL PTR,2 >BUF ADD P-LEXV,BUF GETB STACK,2 >?TMP1 ADD P-LEXV,BUF GETB STACK,3 CALL WORD-PRINT,?TMP1,STACK SET 'QUOTE-FLAG,FALSE-VALUE SET 'P-OFLAG,FALSE-VALUE GET MSG,1 PRINT STACK CRLF RTRUE .FUNCT CANT-USE,PTR,BUF,?TMP1 SET 'QUOTE-FLAG,FALSE-VALUE SET 'P-OFLAG,FALSE-VALUE PRINTI "(Sorry, but I don't understand the word """ MUL PTR,2 >BUF ADD P-LEXV,BUF GETB STACK,2 >?TMP1 ADD P-LEXV,BUF GETB STACK,3 CALL WORD-PRINT,?TMP1,STACK PRINTR """ when you use it that way.)" .FUNCT SYNTAX-CHECK,SYN,LEN,NUM,OBJ,DRIVE1=0,DRIVE2=0,PREP,VERB,?TMP2,?TMP1 GET P-ITBL,P-VERB >VERB ZERO? VERB \?CND1 CALL1 MISSING-VERB RFALSE ?CND1: SUB 255,VERB GET VERBS,STACK >SYN GETB SYN,0 >LEN ADD 1,SYN >SYN ?PRG4: GETB SYN,P-SBITS BAND STACK,P-SONUMS >NUM GRTR? P-NCN,NUM \?ELS8 JUMP ?CND6 ?ELS8: LESS? NUM,1 /?ELS10 ZERO? P-NCN \?ELS10 GET P-ITBL,P-PREP1 >PREP ZERO? PREP /?THN13 GETB SYN,P-SPREP1 EQUAL? PREP,STACK \?ELS10 ?THN13: SET 'DRIVE1,SYN JUMP ?CND6 ?ELS10: GETB SYN,P-SPREP1 >?TMP1 GET P-ITBL,P-PREP1 EQUAL? ?TMP1,STACK \?CND6 EQUAL? NUM,2 \?ELS19 EQUAL? P-NCN,1 \?ELS19 SET 'DRIVE2,SYN JUMP ?CND6 ?ELS19: GETB SYN,P-SPREP2 >?TMP1 GET P-ITBL,P-PREP2 EQUAL? ?TMP1,STACK \?CND6 CALL2 SYNTAX-FOUND,SYN RTRUE ?CND6: DLESS? 'LEN,1 \?ELS26 ZERO? DRIVE1 \?REP5 ZERO? DRIVE2 /?ELS29 JUMP ?REP5 ?ELS29: CALL1 DONT-UNDERSTAND RFALSE ?ELS26: ADD SYN,P-SYNLEN >SYN JUMP ?PRG4 ?REP5: ZERO? DRIVE1 /?ELS40 GETB DRIVE1,P-SFWIM1 >?TMP2 GETB DRIVE1,P-SLOC1 >?TMP1 GETB DRIVE1,P-SPREP1 CALL GWIM,?TMP2,?TMP1,STACK >OBJ ZERO? OBJ /?ELS40 PUT P-PRSO,P-MATCHLEN,1 PUT P-PRSO,1,OBJ CALL2 SYNTAX-FOUND,DRIVE1 RSTACK ?ELS40: ZERO? DRIVE2 /?ELS44 GETB DRIVE2,P-SFWIM2 >?TMP2 GETB DRIVE2,P-SLOC2 >?TMP1 GETB DRIVE2,P-SPREP2 CALL GWIM,?TMP2,?TMP1,STACK >OBJ ZERO? OBJ /?ELS44 PUT P-PRSI,P-MATCHLEN,1 PUT P-PRSI,1,OBJ CALL2 SYNTAX-FOUND,DRIVE2 RSTACK ?ELS44: EQUAL? VERB,ACT?FIND,ACT?NAME \?ELS48 PRINTI "(Sorry, but I can't answer that question.)" CRLF RFALSE ?ELS48: EQUAL? WINNER,PLAYER \?ELS55 CALL ORPHAN,DRIVE1,DRIVE2 PRINTI "(Wh" JUMP ?CND53 ?ELS55: PRINTI "(Your command was not complete. Next time, type wh" ?CND53: EQUAL? VERB,ACT?WALK,ACT?HEAD \?ELS64 PRINTI "ere" JUMP ?CND62 ?ELS64: ZERO? DRIVE1 /?ELS72 GETB DRIVE1,P-SFWIM1 EQUAL? STACK,PERSONBIT /?THN69 ?ELS72: ZERO? DRIVE2 /?ELS68 GETB DRIVE2,P-SFWIM2 EQUAL? STACK,PERSONBIT \?ELS68 ?THN69: PRINTI "om" JUMP ?CND62 ?ELS68: PRINTI "at" ?CND62: EQUAL? WINNER,PLAYER \?ELS83 PRINTI " do you want to " JUMP ?CND81 ?ELS83: PRINTI " you want" CALL2 HIM-HER-IT,WINNER PRINTI " to " ?CND81: CALL1 VERB-PRINT ZERO? DRIVE2 /?CND90 CALL CLAUSE-PRINT,P-NC1,P-NC1L ?CND90: SET 'P-END-ON-PREP,FALSE-VALUE ZERO? DRIVE1 /?ELS98 GETB DRIVE1,P-SPREP1 JUMP ?CND94 ?ELS98: GETB DRIVE2,P-SPREP2 ?CND94: CALL2 PREP-PRINT,STACK EQUAL? WINNER,PLAYER \?ELS104 SET 'P-OFLAG,TRUE-VALUE PRINTI "?)" CRLF RFALSE ?ELS104: SET 'P-OFLAG,FALSE-VALUE PRINTI ".)" CRLF RFALSE .FUNCT DONT-UNDERSTAND PRINTR "(Sorry, but I don't understand. Please reword that or try something else.)" .FUNCT VERB-PRINT,TMP,?TMP1 GET P-ITBL,P-VERBN >TMP ZERO? TMP \?ELS5 PRINTI "tell" RTRUE ?ELS5: GETB P-VTBL,2 ZERO? STACK \?ELS9 GET TMP,0 PRINTB STACK RTRUE ?ELS9: GETB TMP,2 >?TMP1 GETB TMP,3 CALL WORD-PRINT,?TMP1,STACK PUTB P-VTBL,2,0 RTRUE .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 CALL CLAUSE-COPY,P-ITBL,P-OTBL,P-NC2,P-NC2L,P-NC2,P-NC2L ?CND11: LESS? P-NCN,1 /?CND14 CALL CLAUSE-COPY,P-ITBL,P-OTBL,P-NC1,P-NC1L,P-NC1,P-NC1L ?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 CLAUSE-PRINT,BPTR,EPTR,THE?=1,?TMP1 GET P-ITBL,BPTR >?TMP1 GET P-ITBL,EPTR CALL BUFFER-PRINT,?TMP1,STACK,THE? RSTACK .FUNCT BUFFER-PRINT,BEG,END,CP,NOSP=0,WRD,FIRST??=1,PN=0,?TMP1 ?PRG1: EQUAL? BEG,END /TRUE ZERO? NOSP /?ELS10 SET 'NOSP,FALSE-VALUE JUMP ?CND8 ?ELS10: PRINTI " " ?CND8: GET BEG,0 >WRD EQUAL? WRD,W?HIM \?ELS22 CALL2 VISIBLE?,P-HIM-OBJECT ZERO? STACK /?THN19 ?ELS22: EQUAL? WRD,W?HER \?ELS24 CALL2 VISIBLE?,P-HER-OBJECT ZERO? STACK /?THN19 ?ELS24: EQUAL? WRD,W?THEM \?CND16 CALL2 VISIBLE?,P-THEM-OBJECT ZERO? STACK \?CND16 ?THN19: SET 'PN,TRUE-VALUE ?CND16: EQUAL? WRD,W?PERIOD \?ELS29 SET 'NOSP,TRUE-VALUE JUMP ?CND3 ?ELS29: CALL WT?,WRD,PS?BUZZ-WORD ZERO? STACK \?THN34 CALL WT?,WRD,PS?PREPOSITION ZERO? STACK /?ELS31 ?THN34: CALL WT?,WRD,PS?ADJECTIVE ZERO? STACK \?ELS31 CALL WT?,WRD,PS?OBJECT ZERO? STACK \?ELS31 SET 'NOSP,TRUE-VALUE JUMP ?CND3 ?ELS31: EQUAL? WRD,W?ME \?ELS37 PRINTD PLAYER SET 'PN,TRUE-VALUE JUMP ?CND3 ?ELS37: CALL2 CAPITAL-NOUN?,WRD ZERO? STACK /?ELS39 CALL2 CAPITALIZE,BEG SET 'PN,TRUE-VALUE JUMP ?CND3 ?ELS39: ZERO? FIRST?? /?CND42 ZERO? PN \?CND42 ZERO? CP /?CND42 PRINTI "the " ?CND42: ZERO? P-OFLAG \?THN52 ZERO? P-MERGED /?ELS51 ?THN52: PRINTB WRD JUMP ?CND49 ?ELS51: EQUAL? WRD,W?IT \?ELS55 CALL2 VISIBLE?,P-IT-OBJECT ZERO? STACK /?ELS55 PRINTD P-IT-OBJECT JUMP ?CND49 ?ELS55: EQUAL? WRD,W?HER \?ELS59 ZERO? PN \?ELS59 PRINTD P-HER-OBJECT JUMP ?CND49 ?ELS59: EQUAL? WRD,W?THEM \?ELS63 ZERO? PN \?ELS63 PRINTD P-THEM-OBJECT JUMP ?CND49 ?ELS63: EQUAL? WRD,W?HIM \?ELS67 ZERO? PN \?ELS67 PRINTD P-HIM-OBJECT JUMP ?CND49 ?ELS67: GETB BEG,2 >?TMP1 GETB BEG,3 CALL WORD-PRINT,?TMP1,STACK ?CND49: SET 'FIRST??,FALSE-VALUE ?CND3: ADD BEG,P-WORDLEN >BEG JUMP ?PRG1 .FUNCT CAPITAL-NOUN?,WRD EQUAL? WRD,W?FRBZ,W?GRNZ,W?GOLA /TRUE EQUAL? WRD,W?KNUT,W?HRNG,W?WIEN /TRUE RFALSE .FUNCT CAPITALIZE,PTR,?TMP1 ZERO? P-OFLAG \?THN6 ZERO? P-MERGED /?ELS5 ?THN6: GET PTR,0 PRINTB STACK RTRUE ?ELS5: 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,SP?=1,WRD ZERO? PREP /FALSE ZERO? P-END-ON-PREP \FALSE ZERO? SP? /?CND8 PRINTI " " ?CND8: CALL2 PREP-FIND,PREP >WRD PRINTB WRD GET P-ITBL,P-VERBN GET STACK,0 EQUAL? STACK,W?SIT,W?LIE \?CND17 EQUAL? W?DOWN,WRD \?CND17 PRINTI " on" ?CND17: GET P-ITBL,P-VERBN GET STACK,0 EQUAL? W?GET,STACK \TRUE EQUAL? W?OUT,WRD \TRUE PRINTI " of" RTRUE .FUNCT CLAUSE-COPY,SRC,DEST,SRCBEG,SRCEND,DESTBEG,DESTEND,INSRT=0,BEG,END GET SRC,SRCBEG >BEG GET SRC,SRCEND >END GET P-OCLAUSE,P-MATCHLEN MUL STACK,P-LEXELEN ADD STACK,2 ADD P-OCLAUSE,STACK PUT DEST,DESTBEG,STACK ?PRG1: EQUAL? BEG,END \?ELS5 GET P-OCLAUSE,P-MATCHLEN MUL STACK,P-LEXELEN ADD 2,STACK ADD P-OCLAUSE,STACK PUT DEST,DESTEND,STACK RTRUE ?ELS5: ZERO? INSRT /?CND8 GET BEG,0 EQUAL? P-ANAM,STACK \?CND8 CALL2 CLAUSE-ADD,INSRT ?CND8: GET BEG,0 CALL2 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 RETURN STACK .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 "(" CALL PREP-PRINT,PREP,FALSE-VALUE ZERO? STACK /?CND16 CALL2 THE?,OBJ PRINTI " " ?CND16: PRINTD OBJ PRINTI ")" CRLF RETURN OBJ ?ELS8: 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 \?ELS18 CALL2 BUT-MERGE,P-PRSO >P-PRSO RTRUE ?ELS18: CALL2 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,ONEOBJ SET 'P-AND,FALSE-VALUE EQUAL? P-GETFLAGS,P-ALL \?CND1 SET 'WAS-ALL,TRUE-VALUE ?CND1: SET 'P-GETFLAGS,0 PUT P-BUTS,P-MATCHLEN,0 PUT TBL,P-MATCHLEN,0 GET PTR,0 >WRD ?PRG4: EQUAL? PTR,EPTR \?ELS8 ZERO? BUT /?ORP12 PUSH BUT JUMP ?THN9 ?ORP12: PUSH TBL ?THN9: CALL2 GET-OBJECT,STACK >WV ZERO? WAS-ALL /?CND13 SET 'P-GETFLAGS,P-ALL ?CND13: RETURN WV ?ELS8: GET PTR,P-LEXELEN >NW EQUAL? WRD,W?ALL,W?BOTH \?ELS21 SET 'P-GETFLAGS,P-ALL EQUAL? NW,W?OF \?CND19 ADD PTR,P-WORDLEN >PTR JUMP ?CND19 ?ELS21: EQUAL? WRD,W?BUT,W?EXCEPT \?ELS26 ZERO? BUT /?ORP32 PUSH BUT JUMP ?THN29 ?ORP32: PUSH TBL ?THN29: CALL2 GET-OBJECT,STACK ZERO? STACK /FALSE SET 'BUT,P-BUTS PUT BUT,P-MATCHLEN,0 JUMP ?CND6 ?ELS26: CALL2 BUZZER-WORD?,WRD ZERO? STACK \FALSE EQUAL? WRD,W?A,W?ONE \?ELS36 ZERO? P-ADJ \?ELS39 SET 'P-GETFLAGS,P-ONE EQUAL? NW,W?OF \?CND6 ADD PTR,P-WORDLEN >PTR JUMP ?CND6 ?ELS39: SET 'P-NAM,ONEOBJ ZERO? BUT /?ORP50 PUSH BUT JUMP ?THN47 ?ORP50: PUSH TBL ?THN47: CALL2 GET-OBJECT,STACK ZERO? STACK /FALSE ZERO? NW /TRUE JUMP ?CND6 ?ELS36: EQUAL? WRD,W?AND,W?COMMA \?ELS54 EQUAL? NW,W?AND,W?COMMA /?ELS54 SET 'P-AND,TRUE-VALUE ZERO? BUT /?ORP62 PUSH BUT JUMP ?THN59 ?ORP62: PUSH TBL ?THN59: CALL2 GET-OBJECT,STACK ZERO? STACK \?CND19 RFALSE ?ELS54: CALL WT?,WRD,PS?BUZZ-WORD ZERO? STACK /?ELS64 JUMP ?CND6 ?ELS64: EQUAL? WRD,W?AND,W?COMMA \?ELS66 JUMP ?CND6 ?ELS66: EQUAL? WRD,W?OF \?ELS68 ZERO? P-GETFLAGS \?CND19 SET 'P-GETFLAGS,P-INHIBIT JUMP ?CND19 ?ELS68: CALL WT?,WRD,PS?ADJECTIVE ZERO? STACK /?ELS73 ZERO? P-ADJ \?ELS73 SET 'P-ADJ,WRD JUMP ?CND6 ?ELS73: CALL WT?,WRD,PS?OBJECT ZERO? STACK /?CND6 SET 'P-NAM,WRD SET 'ONEOBJ,WRD ?CND19: ?CND6: EQUAL? PTR,EPTR /?PRG4 ADD PTR,P-WORDLEN >PTR SET 'WRD,NW JUMP ?PRG4 .FUNCT GET-OBJECT,TBL,VRB=1,BTS,LEN,XBITS,TLEN,GCHECK=0,OLEN=0,OBJ,ADJ SET 'XBITS,P-SLOCBITS GET TBL,P-MATCHLEN >TLEN BTST P-GETFLAGS,P-INHIBIT /TRUE SET 'ADJ,P-ADJ ZERO? P-NAM \?CND4 ZERO? P-ADJ /?CND4 CALL WT?,P-ADJ,PS?OBJECT ZERO? STACK /?ELS11 SET 'P-NAM,P-ADJ SET 'P-ADJ,FALSE-VALUE JUMP ?CND4 ?ELS11: CALL WT?,P-ADJ,PS?DIRECTION,P1?DIRECTION >BTS ZERO? BTS /?CND4 SET 'P-ADJ,FALSE-VALUE PUT TBL,P-MATCHLEN,1 PUT TBL,1,INTDIR SET 'P-DIRECTION,BTS RTRUE ?CND4: ZERO? P-NAM \?CND14 ZERO? P-ADJ \?CND14 EQUAL? P-GETFLAGS,P-ALL /?CND14 ZERO? P-GWIMBIT \?CND14 ZERO? VRB /FALSE CALL2 MISSING-NOUN,ADJ RFALSE ?CND14: EQUAL? P-GETFLAGS,P-ALL \?THN26 ZERO? P-SLOCBITS \?CND23 ?THN26: SET 'P-SLOCBITS,-1 ?CND23: ?PRG28: ZERO? GCHECK /?ELS32 CALL2 GLOBAL-CHECK,TBL JUMP ?CND30 ?ELS32: ZERO? LIT /?CND36 FCLEAR PLAYER,TRANSBIT CALL DO-SL,HERE,SOG,SIR,TBL FSET PLAYER,TRANSBIT ?CND36: CALL DO-SL,PLAYER,SH,SC,TBL ?CND30: GET TBL,P-MATCHLEN SUB STACK,TLEN >LEN BTST P-GETFLAGS,P-ALL \?ELS42 JUMP ?CND40 ?ELS42: BTST P-GETFLAGS,P-ONE \?ELS44 ZERO? LEN /?ELS44 EQUAL? LEN,1 /?CND47 RANDOM LEN GET TBL,STACK PUT TBL,1,STACK PRINTI "(How about" GET TBL,1 CALL2 PRINTT,STACK PRINTI "?)" CRLF ?CND47: PUT TBL,P-MATCHLEN,1 JUMP ?CND40 ?ELS44: GRTR? LEN,1 /?THN54 ZERO? LEN \?ELS53 EQUAL? P-SLOCBITS,-1 /?ELS53 ?THN54: EQUAL? P-SLOCBITS,-1 \?ELS60 SET 'P-SLOCBITS,XBITS SET 'OLEN,LEN GET TBL,P-MATCHLEN SUB STACK,LEN PUT TBL,P-MATCHLEN,STACK JUMP ?PRG28 ?ELS60: ZERO? LEN \?CND63 SET 'LEN,OLEN ?CND63: ZERO? P-NAM /?ELS68 ADD TLEN,1 GET TBL,STACK >OBJ ZERO? OBJ /?ELS68 GETP OBJ,P?GENERIC CALL STACK,TBL >OBJ ZERO? OBJ /?ELS68 EQUAL? OBJ,NOT-HERE-OBJECT /FALSE PUT TBL,1,OBJ PUT TBL,P-MATCHLEN,1 SET 'P-NAM,FALSE-VALUE SET 'P-ADJ,FALSE-VALUE RTRUE ?ELS68: ZERO? VRB /?ELS75 EQUAL? WINNER,PLAYER /?ELS75 CALL1 CANT-ORPHAN RFALSE ?ELS75: ZERO? VRB /?ELS79 ZERO? P-NAM /?ELS79 CALL WHICH-PRINT,TLEN,LEN,TBL EQUAL? TBL,P-PRSO \?ELS86 PUSH P-NC1 JUMP ?CND82 ?ELS86: PUSH P-NC2 ?CND82: 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 ?CND66 ?ELS79: ZERO? VRB /?CND66 CALL2 MISSING-NOUN,ADJ ?CND66: SET 'P-NAM,FALSE-VALUE SET 'P-ADJ,FALSE-VALUE RFALSE ?ELS53: ZERO? LEN \?ELS93 ZERO? GCHECK /?ELS93 ZERO? VRB /?CND96 SET 'P-SLOCBITS,XBITS ZERO? LIT \?THN103 CALL1 SPEAKING-VERB? ZERO? STACK /?ELS102 ?THN103: CALL OBJ-FOUND,NOT-HERE-OBJECT,TBL SET 'P-XNAM,P-NAM SET 'P-NAM,FALSE-VALUE SET 'P-XADJ,P-ADJ SET 'P-ADJ,FALSE-VALUE RTRUE ?ELS102: CALL1 TOO-DARK ?CND96: SET 'P-NAM,FALSE-VALUE SET 'P-ADJ,FALSE-VALUE RFALSE ?ELS93: ZERO? LEN \?CND40 SET 'GCHECK,TRUE-VALUE JUMP ?PRG28 ?CND40: ZERO? P-ADJ /?CND111 ZERO? P-NAM \?CND111 PRINT I-ASSUME ADD TLEN,1 GET TBL,STACK CALL2 PRINTT,STACK PRINTI ".)" CRLF ?CND111: SET 'P-SLOCBITS,XBITS SET 'P-NAM,FALSE-VALUE SET 'P-ADJ,FALSE-VALUE RTRUE .FUNCT SPEAKING-VERB?,V=0 ZERO? V \?CND1 SET 'V,PRSA ?CND1: EQUAL? V,V?$CALL,V?ASK,V?ASK-ABOUT /TRUE EQUAL? V,V?ASK-FOR,V?GOODBYE,V?HELLO /TRUE EQUAL? V,V?NO,V?TELL,V?TELL-ABOUT /TRUE EQUAL? V,V?YES,V?TALK-ABOUT,V?ANSWER /TRUE EQUAL? V,V?ASK-CONTEXT-ABOUT,V?ASK-CONTEXT-FOR,V?REPLY /TRUE RFALSE .FUNCT CANT-ORPHAN PRINTI "(Please try saying that another way.)" CRLF RFALSE .FUNCT MISSING-NOUN,ADJ PRINTR "(I couldn't find enough nouns in that sentence!)" .FUNCT MISSING-VERB PRINTR "(I couldn't find a verb in that sentence!)" .FUNCT MOBY-FIND,TBL,OBJ=1,LEN,FOO SET 'P-NAM,P-XNAM SET 'P-ADJ,P-XADJ PUT TBL,P-MATCHLEN,0 GETB 0,18 ZERO? STACK /?ELS5 ?PRG6: CALL META-LOC,OBJ,TRUE-VALUE >FOO ZERO? FOO /?CND8 CALL2 THIS-IT?,OBJ >FOO ZERO? FOO /?CND8 CALL OBJ-FOUND,OBJ,TBL >FOO ?CND8: IGRTR? 'OBJ,LAST-OBJECT \?PRG6 GET TBL,P-MATCHLEN >LEN EQUAL? LEN,1 \?CND16 GET TBL,1 >P-MOBY-FOUND ?CND16: RETURN LEN ?ELS5: SET 'P-SLOCBITS,-1 SET 'P-NAM,P-XNAM SET 'P-ADJ,P-XADJ PUT TBL,P-MATCHLEN,0 FIRST? ROOMS >FOO /?KLU37 ?KLU37: ?PRG21: ZERO? FOO \?ELS25 JUMP ?REP22 ?ELS25: CALL SEARCH-LIST,FOO,TBL,P-SRCALL,TRUE-VALUE NEXT? FOO >FOO /?KLU38 ?KLU38: JUMP ?PRG21 ?REP22: CALL DO-SL,LOCAL-GLOBALS,1,1,TBL,TRUE-VALUE CALL SEARCH-LIST,ROOMS,TBL,P-SRCTOP,TRUE-VALUE GET TBL,P-MATCHLEN >LEN EQUAL? LEN,1 \?CND34 GET TBL,1 >P-MOBY-FOUND ?CND34: 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 \?THN6 ZERO? P-MERGED \?THN6 ZERO? P-AND /?ELS5 ?THN6: PRINTI " " PRINTB P-NAM JUMP ?CND3 ?ELS5: EQUAL? TBL,P-PRSO \?ELS11 CALL CLAUSE-PRINT,P-NC1,P-NC1L,FALSE-VALUE JUMP ?CND3 ?ELS11: CALL CLAUSE-PRINT,P-NC2,P-NC2L,FALSE-VALUE ?CND3: PRINTI " do you mean," ?PRG16: INC 'TLEN GET TBL,TLEN >OBJ CALL2 PRINTT,OBJ EQUAL? LEN,2 \?ELS22 EQUAL? RLEN,2 /?CND23 PRINTI "," ?CND23: PRINTI " or" JUMP ?CND20 ?ELS22: GRTR? LEN,2 \?CND20 PRINTI "," ?CND20: DLESS? 'LEN,1 \?PRG16 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 DIV STACK,2 SUB STACK,1 >RMGL ?PRG4: GET RMG,CNT >OBJ FIRST? OBJ \?CND6 CALL SEARCH-LIST,OBJ,TBL,P-SRCALL ?CND6: CALL2 THIS-IT?,OBJ ZERO? STACK /?CND9 CALL OBJ-FOUND,OBJ,TBL ?CND9: IGRTR? 'CNT,RMGL \?PRG4 ?CND1: GET TBL,P-MATCHLEN EQUAL? STACK,LEN \FALSE SET 'P-SLOCBITS,-1 CALL DO-SL,GLOBAL-OBJECTS,1,1,TBL SET 'P-SLOCBITS,OBITS GET TBL,P-MATCHLEN ZERO? STACK \FALSE EQUAL? PRSA,V?WALK-TO /?THN30 EQUAL? PRSA,V?THROUGH,V?SMELL,V?SEARCH-FOR /?THN30 EQUAL? PRSA,V?SEARCH,V?LOOK-INSIDE,V?LEAVE /?THN30 EQUAL? PRSA,V?FOLLOW,V?FIND,V?EXAMINE \FALSE ?THN30: CALL DO-SL,ROOMS,1,1,TBL RSTACK .FUNCT DO-SL,OBJ,BIT1,BIT2,TBL,MOBY-FLAG=0,BTS ADD BIT1,BIT2 BTST P-SLOCBITS,STACK \?ELS5 CALL SEARCH-LIST,OBJ,TBL,P-SRCALL,MOBY-FLAG RSTACK ?ELS5: BTST P-SLOCBITS,BIT1 \?ELS12 CALL SEARCH-LIST,OBJ,TBL,P-SRCTOP,MOBY-FLAG RSTACK ?ELS12: BTST P-SLOCBITS,BIT2 \TRUE CALL SEARCH-LIST,OBJ,TBL,P-SRCBOT,MOBY-FLAG RSTACK .FUNCT SEARCH-LIST,OBJ,TBL,LVL,MOBY-FLAG=0 FIRST? OBJ >OBJ \FALSE ?PRG6: EQUAL? LVL,P-SRCBOT /?CND8 GETPT OBJ,P?SYNONYM ZERO? STACK /?CND8 CALL2 THIS-IT?,OBJ 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 \?CND13 ZERO? MOBY-FLAG \?THN20 CALL2 SEE-INSIDE?,OBJ ZERO? STACK /?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,MOBY-FLAG ?CND13: NEXT? OBJ >OBJ /?PRG6 RTRUE .FUNCT THIS-IT?,OBJ,SYNS FSET? OBJ,INVISIBLE /FALSE ZERO? P-NAM /?ELS5 GETPT OBJ,P?SYNONYM >SYNS ZERO? SYNS /FALSE PTSIZE SYNS DIV STACK,2 SUB STACK,1 CALL ZMEMQ,P-NAM,SYNS,STACK ZERO? STACK /FALSE ?ELS5: ZERO? P-ADJ /?ELS11 GETPT OBJ,P?ADJECTIVE >SYNS ZERO? SYNS /FALSE PTSIZE SYNS DIV STACK,2 SUB STACK,1 CALL ZMEMQ,P-ADJ,SYNS,STACK ZERO? STACK /FALSE ?ELS11: ZERO? P-GWIMBIT /TRUE FSET? OBJ,P-GWIMBIT /TRUE RFALSE .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,BITS,PTR,OBJ,TAKEN GET TBL,P-MATCHLEN >PTR ZERO? PTR /TRUE BTST BITS,SHAVE /?THN8 BTST BITS,STAKE \TRUE ?THN8: ?PRG10: DLESS? 'PTR,0 /TRUE ADD PTR,1 GET TBL,STACK >OBJ EQUAL? OBJ,IT \?ELS17 CALL2 ACCESSIBLE?,P-IT-OBJECT ZERO? STACK \?ELS20 CALL1 MORE-SPECIFIC RFALSE ?ELS20: SET 'OBJ,P-IT-OBJECT JUMP ?CND15 ?ELS17: EQUAL? OBJ,HER \?ELS24 CALL2 ACCESSIBLE?,P-HER-OBJECT ZERO? STACK \?ELS27 CALL1 MORE-SPECIFIC RFALSE ?ELS27: SET 'OBJ,P-HER-OBJECT JUMP ?CND15 ?ELS24: EQUAL? OBJ,HIM \?ELS31 CALL2 ACCESSIBLE?,P-HIM-OBJECT ZERO? STACK \?ELS34 CALL1 MORE-SPECIFIC RFALSE ?ELS34: SET 'OBJ,P-HIM-OBJECT JUMP ?CND15 ?ELS31: EQUAL? OBJ,THEM \?CND15 CALL2 ACCESSIBLE?,P-THEM-OBJECT ZERO? STACK \?ELS41 CALL1 MORE-SPECIFIC RFALSE ?ELS41: SET 'OBJ,P-THEM-OBJECT ?CND15: CALL HELD?,OBJ,WINNER ZERO? STACK \?PRG10 SET 'PRSO,OBJ FSET? OBJ,TRYTAKEBIT \?ELS51 SET 'TAKEN,TRUE-VALUE JUMP ?CND49 ?ELS51: EQUAL? WINNER,PLAYER /?ELS53 SET 'TAKEN,FALSE-VALUE JUMP ?CND49 ?ELS53: BTST BITS,STAKE \?ELS55 CALL2 ITAKE,FALSE-VALUE EQUAL? STACK,TRUE-VALUE \?ELS55 SET 'TAKEN,FALSE-VALUE JUMP ?CND49 ?ELS55: SET 'TAKEN,TRUE-VALUE ?CND49: ZERO? TAKEN /?ELS62 BTST BITS,SHAVE \?ELS62 PRINTI "(" CALL HE-SHE-IT,WINNER,TRUE-VALUE,STR?3 PRINTI "n't seem to be holding" GET TBL,P-MATCHLEN LESS? 1,STACK \?ELS71 PRINTI " those things" JUMP ?CND69 ?ELS71: EQUAL? OBJ,NOT-HERE-OBJECT \?ELS75 PRINTI " that" JUMP ?CND69 ?ELS75: CALL2 PRINTT,OBJ CALL2 THIS-IS-IT,OBJ ?CND69: PRINTI "!)" CRLF RFALSE ?ELS62: ZERO? TAKEN \?PRG10 EQUAL? WINNER,PLAYER \?PRG10 PRINTI "(taking" CALL2 HIM-HER-IT,OBJ ZERO? ITAKE-LOC /?CND90 PRINTI " from" CALL2 HIM-HER-IT,ITAKE-LOC ?CND90: PRINTI " first)" 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 more than one " EQUAL? LOSS,2 \?CND23 PRINTI "in" ?CND23: PRINTI "direct object with """ GET P-ITBL,P-VERBN >TMP ZERO? TMP \?ELS32 PRINTI "tell" JUMP ?CND30 ?ELS32: ZERO? P-OFLAG \?THN37 ZERO? P-MERGED /?ELS36 ?THN37: GET TMP,0 PRINTB STACK JUMP ?CND30 ?ELS36: GETB TMP,2 >?TMP1 GETB TMP,3 CALL WORD-PRINT,?TMP1,STACK ?CND30: 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 ZERO? CNT /TRUE RETURN CNT ?ELS13: IGRTR? 'CNT,SIZE \?PRG9 RFALSE .FUNCT ZMEMZ,ITM,TBL,CNT=0 ZERO? TBL /FALSE ?PRG4: GET TBL,CNT ZERO? STACK /FALSE GET TBL,CNT EQUAL? ITM,STACK \?ELS10 ZERO? CNT /TRUE RETURN CNT ?ELS10: INC 'CNT JUMP ?PRG4 .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-SLOCBITS,-1 EQUAL? OHERE,RM \?CND13 CALL DO-SL,WINNER,1,1,P-MERGE EQUAL? WINNER,PLAYER /?CND13 IN? PLAYER,RM \?CND13 CALL DO-SL,PLAYER,1,1,P-MERGE ?CND13: CALL DO-SL,RM,1,1,P-MERGE GET P-MERGE,P-MATCHLEN GRTR? STACK,0 \?CND6 SET 'LIT,TRUE-VALUE ?CND6: SET 'HERE,OHERE SET 'P-GWIMBIT,0 RETURN LIT .FUNCT NOT-HERE,OBJ SET 'CLOCK-WAIT,TRUE-VALUE PRINTI "(You can't see " FSET? OBJ,NARTICLEBIT /?CND3 PRINTI "any " ?CND3: CALL2 THIS-IS-IT,OBJ ZERO? P-DOLLAR-FLAG /?ELS10 EQUAL? OBJ,INTNUM \?ELS10 PRINTI "money" JUMP ?CND8 ?ELS10: PRINTD OBJ ?CND8: PRINTR " here.)" .ENDI