.FUNCT MAIN-LOOP,X ?PRG1: CALL MAIN-LOOP-1 >X JUMP ?PRG1 .FUNCT MAIN-LOOP-1,ICNT,OCNT,NUM,CNT,OBJ,V,PTBL,OBJ1,TMP,X,GW,?TMP1 SET 'CNT,0 SET 'OBJ,FALSE-VALUE SET 'PTBL,TRUE-VALUE CALL PARSER >P-WON ZERO? P-WON /?CCL3 SET 'CLOCK-WAIT,FALSE-VALUE GETB P-PRSI,P-MATCHLEN >ICNT GETB P-PRSO,P-MATCHLEN >OCNT ZERO? OCNT \?CCL6 ZERO? ICNT /?CND4 ?CCL6: ZERO? P-IT-OBJECT /?CND4 CALL ACCESSIBLE?,P-IT-OBJECT ZERO? STACK /?CND4 SET 'TMP,FALSE-VALUE ?PRG12: IGRTR? 'CNT,ICNT /?REP13 GETB P-PRSI,CNT EQUAL? STACK,IT \?PRG12 PUTB P-PRSI,CNT,P-IT-OBJECT CALL TELL-I-ASSUME,P-IT-OBJECT SET 'TMP,TRUE-VALUE ?REP13: SET 'CNT,0 ?PRG19: IGRTR? 'CNT,OCNT /?REP20 GETB P-PRSO,CNT EQUAL? STACK,IT \?PRG19 PUTB P-PRSO,CNT,P-IT-OBJECT CALL TELL-I-ASSUME,P-IT-OBJECT ?REP20: SET 'CNT,0 ?CND4: ZERO? OCNT \?CCL27 SET 'NUM,OCNT JUMP ?CND25 ?CCL27: GRTR? OCNT,1 \?CCL29 ZERO? ICNT \?CCL32 SET 'OBJ,FALSE-VALUE JUMP ?CND30 ?CCL32: GETB P-PRSI,1 >OBJ ?CND30: SET 'NUM,OCNT JUMP ?CND25 ?CCL29: GRTR? ICNT,1 \?CCL34 SET 'PTBL,FALSE-VALUE GETB P-PRSO,1 >OBJ SET 'NUM,ICNT JUMP ?CND25 ?CCL34: SET 'NUM,1 ?CND25: ZERO? OBJ \?CND35 EQUAL? ICNT,1 \?CND35 GETB P-PRSI,1 >OBJ ?CND35: EQUAL? PRSA,V?WALK \?CCL41 CALL PERFORM,PRSA,PRSO >V JUMP ?CND39 ?CCL41: ZERO? NUM \?CCL44 GETB P-SYNTAX,P-SBITS BAND STACK,P-SONUMS ZERO? STACK \?CCL47 CALL PERFORM,PRSA >V SET 'PRSO,FALSE-VALUE JUMP ?CND39 ?CCL47: ZERO? LIT \?CCL49 CALL SEE-VERB? ZERO? STACK /?CCL49 SET 'QUOTE-FLAG,FALSE-VALUE SET 'P-CONT,FALSE-VALUE CALL TOO-DARK JUMP ?CND39 ?CCL49: SET 'QUOTE-FLAG,FALSE-VALUE SET 'P-CONT,FALSE-VALUE PRINTI "(There isn't any" ZERO? PTBL /?PRD58 GETB P-SYNTAX,P-SFWIM1 EQUAL? STACK,PERSONBIT /?PRG63 ?PRD58: ZERO? PTBL \?PRG65 GETB P-SYNTAX,P-SFWIM2 EQUAL? STACK,PERSONBIT \?PRG65 ?PRG63: PRINTI "one" JUMP ?PRG67 ?PRG65: PRINTI "thing" ?PRG67: PRINTI " to " GET P-ITBL,P-VERBN >TMP EQUAL? PRSA,V?TELL \?CCL71 PRINTI "talk to" JUMP ?PRG78 ?CCL71: ZERO? P-MERGED \?CTR74 ZERO? P-OFLAG /?CCL75 ?CTR74: GET TMP,0 PRINTB STACK JUMP ?PRG78 ?CCL75: GETB TMP,2 >?TMP1 GETB TMP,3 CALL WORD-PRINT,?TMP1,STACK >V ?PRG78: PRINTI "!)" CRLF SET 'V,FALSE-VALUE JUMP ?CND39 ?CCL44: ZERO? PTBL /?CCL81 GRTR? NUM,1 \?CCL81 EQUAL? PRSA,V?COMPARE \?CCL81 CALL PERFORM,PRSA,OBJECT-PAIR >V JUMP ?CND39 ?CCL81: SET 'X,0 SET 'TMP,0 SET 'GW,FALSE-VALUE ?PRG85: IGRTR? 'CNT,NUM \?CCL89 GRTR? X,0 \?CCL92 PRINTI "The " EQUAL? X,NUM /?PRG99 PRINTI "other " ?PRG99: PRINTI "object" EQUAL? X,1 /?PRG105 PRINTC 115 ?PRG105: PRINTI " that you mentioned " EQUAL? X,1 /?PRG112 PRINTI "are" JUMP ?PRG114 ?PRG112: PRINTI "is" ?PRG114: PRINTI "n't here." CRLF JUMP ?CND39 ?CCL92: ZERO? TMP \?CND39 CALL MORE-SPECIFIC JUMP ?CND39 ?CCL89: ZERO? PTBL /?CCL119 GETB P-PRSO,CNT >OBJ1 JUMP ?CND117 ?CCL119: GETB P-PRSI,CNT >OBJ1 ?CND117: GRTR? NUM,1 /?CCL121 GET P-ITBL,P-NC1 GET STACK,0 EQUAL? STACK,W?ALL \?CND120 ?CCL121: EQUAL? OBJ1,NOT-HERE-OBJECT \?CCL126 INC 'X JUMP ?PRG85 ?CCL126: EQUAL? P-GETFLAGS,P-ALL \?CCL128 CALL VERB-ALL-TEST,OBJ1,OBJ ZERO? STACK /?PRG85 ?CCL128: CALL ACCESSIBLE?,OBJ1 ZERO? STACK /?PRG85 EQUAL? OBJ1,PLAYER /?PRG85 EQUAL? OBJ1,COSTUME \?CND135 ZERO? GW \?PRG85 SET 'GW,TRUE-VALUE ?CND135: EQUAL? OBJ1,IT \?CCL142 PRINTD P-IT-OBJECT JUMP ?PRG143 ?CCL142: PRINTD OBJ1 ?PRG143: PRINTI ": " ?CND120: SET 'TMP,TRUE-VALUE ZERO? PTBL /?CCL147 PUSH OBJ1 JUMP ?CND145 ?CCL147: PUSH OBJ ?CND145: CALL QCONTEXT-CHECK,STACK >V ZERO? PTBL /?CCL150 SET 'PRSO,OBJ1 SET 'PRSI,OBJ JUMP ?CND148 ?CCL150: SET 'PRSO,OBJ SET 'PRSI,OBJ1 ?CND148: CALL PERFORM,PRSA,PRSO,PRSI >V EQUAL? V,M-FATAL \?PRG85 ?CND39: SET 'OPRSO,PRSO EQUAL? V,M-FATAL \?CND1 SET 'P-CONT,FALSE-VALUE JUMP ?CND1 ?CCL3: SET 'CLOCK-WAIT,TRUE-VALUE SET 'P-CONT,FALSE-VALUE ?CND1: ZERO? CLOCK-WAIT \?CND155 ZERO? P-WON /?CND155 CALL GAME-VERB? ZERO? STACK \?CND155 SET 'CLOCKER-RUNNING,1 CALL CLOCKER >V SET 'CLOCKER-RUNNING,2 ?CND155: SET 'PRSA,FALSE-VALUE SET 'PRSO,FALSE-VALUE SET 'PRSI,FALSE-VALUE RETURN PRSI .FUNCT TELL-I-ASSUME,OBJ,STR=0 ZERO? STR \?PRG8 EQUAL? OPRSO,OBJ /FALSE FSET? OBJ,SECRETBIT /FALSE ?PRG8: PRINT I-ASSUME ZERO? STR /?PRG14 PRINT STR ?PRG14: CALL PRINTT,OBJ PRINTR ".]" .FUNCT VERB-ALL-TEST,O,I,L LOC O >L EQUAL? O,PAINT /FALSE EQUAL? PRSA,V?GIVE,V?DROP \?CCL5 EQUAL? O,NOW-WEARING /FALSE EQUAL? L,WINNER /TRUE RFALSE ?CCL5: EQUAL? PRSA,V?PUT-IN,V?PUT \?CCL13 EQUAL? O,I,NOW-WEARING /FALSE IN? O,I /FALSE RTRUE ?CCL13: EQUAL? PRSA,V?TAKE \?CCL20 FSET? O,SECRETBIT /FALSE FSET? O,TAKEBIT /?CND21 FSET? O,TRYTAKEBIT \FALSE ?CND21: ZERO? I /?CCL29 EQUAL? L,I /?CND27 RFALSE ?CCL29: EQUAL? L,HERE \?CND27 EQUAL? O,CANDLE \TRUE EQUAL? P-PRSA-WORD,W?RAISE,W?LIFT /TRUE RFALSE ?CND27: FSET? L,PERSONBIT /TRUE FSET? L,SURFACEBIT /TRUE FSET? L,CONTBIT \FALSE FSET? L,OPENBIT /TRUE RFALSE ?CCL20: ZERO? I /TRUE EQUAL? O,I /FALSE RTRUE .FUNCT GAME-VERB? EQUAL? PRSA,V?$VERIFY,V?VERSION /TRUE EQUAL? PRSA,V?VERBOSE,V?UNSCRIPT,V?TIME /TRUE EQUAL? PRSA,V?TELL,V?SUPER-BRIEF,V?SCRIPT /TRUE EQUAL? PRSA,V?SCORE,V?SAVE,V?RESTORE /TRUE EQUAL? PRSA,V?RESTART,V?QUIT,V?BRIEF /TRUE RFALSE .FUNCT QCONTEXT-CHECK,PER,OTHER,WHO=0,N=0 EQUAL? PRSA,V?HELP /?CCL3 EQUAL? PRSA,V?TELL-ABOUT,V?SHOW \FALSE EQUAL? PER,PLAYER \FALSE ?CCL3: FIRST? HERE >OTHER /?PRG9 ?PRG9: ZERO? OTHER /?REP10 FSET? OTHER,PERSONBIT \?CND11 FSET? OTHER,INVISIBLE /?CND11 EQUAL? OTHER,PLAYER /?CND11 INC 'N SET 'WHO,OTHER ?CND11: NEXT? OTHER >OTHER /?PRG9 JUMP ?PRG9 ?REP10: EQUAL? 1,N \?CND19 ZERO? QCONTEXT \?CND19 SET 'QCONTEXT,WHO ?CND19: CALL 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,MUNGBIT /FALSE CALL META-LOC,QCONTEXT EQUAL? HERE,STACK \FALSE RETURN QCONTEXT .FUNCT NOT-IT,WHO EQUAL? WHO,P-HER-OBJECT \?CCL3 FCLEAR HER,TOUCHBIT RTRUE ?CCL3: EQUAL? WHO,P-HIM-OBJECT \?CCL5 FCLEAR HIM,TOUCHBIT RTRUE ?CCL5: EQUAL? WHO,P-IT-OBJECT \FALSE FCLEAR IT,TOUCHBIT RTRUE .FUNCT NOT-HERE-OBJECT-F,TBL,PRSO?=0,OBJ=0 EQUAL? PRSO,NOT-HERE-OBJECT \?CCL3 EQUAL? PRSI,NOT-HERE-OBJECT \?CCL3 PRINTI "(Those things aren't here!)" CRLF RETURN 2 ?CCL3: EQUAL? PRSO,NOT-HERE-OBJECT \?CCL11 SET 'TBL,P-PRSO SET 'PRSO?,TRUE-VALUE JUMP ?CND1 ?CCL11: SET 'TBL,P-PRSI ?CND1: EQUAL? P-XADJ,A?MY \?CND12 EQUAL? P-XNAM,W?EYE,W?EYES \?CCL16 SET 'OBJ,EYE JUMP ?CND14 ?CCL16: EQUAL? P-XNAM,W?HANDS,W?HAND \?CCL18 SET 'OBJ,HANDS JUMP ?CND14 ?CCL18: EQUAL? P-XNAM,W?HEAD \?CND14 SET 'OBJ,HEAD ?CND14: ZERO? OBJ /?CND12 ZERO? PRSO? /?CCL24 SET 'PRSO,OBJ RFALSE ?CCL24: SET 'PRSI,OBJ RFALSE ?CND12: EQUAL? P-ADJN,W?YOUR,W?HER,W?HIS \?CND25 ZERO? P-NAM /?CND25 CALL RESOLVE-YOUR-HER-HIS ?CND25: ZERO? PRSO? /?PRD32 CALL PRSO-VERB? ZERO? STACK \?CCL30 ?PRD32: ZERO? PRSO? \?PRG44 CALL PRSI-VERB? ZERO? STACK /?PRG44 ?CCL30: CALL FIND-NOT-HERE,TBL,PRSO? >OBJ ZERO? OBJ /FALSE EQUAL? OBJ,NOT-HERE-OBJECT /?PRG44 RETURN 2 ?PRG44: PRINTC 40 CALL HE-SHE-IT,WINNER,TRUE-VALUE PRINTI " can't " EQUAL? PRSA,V?LISTEN \?PRG51 PRINTI "hear" JUMP ?CND46 ?PRG51: PRINTI "see" ?CND46: CALL CAPITAL-NOUN?,P-XNAM ZERO? STACK \?CND53 PRINTI " any" ?CND53: CALL NOT-HERE-PRINT PRINTI " right here!)" CRLF RETURN 2 .FUNCT PRSO-VERB? EQUAL? PRSA,V?WALK-TO,V?WAIT-FOR /TRUE EQUAL? PRSA,V?USE,V?THROUGH,V?TELL /TRUE EQUAL? PRSA,V?TALK-ABOUT,V?LEAVE,V?FOLLOW /TRUE EQUAL? PRSA,V?FIND,V?DESCRIBE,V?DRESS /TRUE EQUAL? PRSA,V?DISEMBARK,V?CLIMB-UP,V?CLIMB-DOWN /TRUE EQUAL? PRSA,V?BOARD,V?ASK-CONTEXT-FOR,V?ASK-CONTEXT-ABOUT /TRUE EQUAL? WINNER,PLAYER /FALSE EQUAL? PRSA,V?SSHOW,V?TAKE,V?GIVE /TRUE RFALSE .FUNCT PRSI-VERB? EQUAL? PRSA,V?TELL-ABOUT,V?TAKE-TO /TRUE EQUAL? PRSA,V?SEARCH-FOR,V?ASK-FOR,V?ASK-ABOUT /TRUE EQUAL? WINNER,PLAYER /FALSE EQUAL? PRSA,V?SHOW,V?SGIVE /TRUE EQUAL? PRSA,V?SSHOW /TRUE RFALSE .FUNCT GEN-TEST,OBJ CALL VISIBLE?,OBJ ZERO? STACK \TRUE CALL CORRIDOR-LOOK,OBJ ZERO? STACK \TRUE EQUAL? PRSA,V?FOLLOW /?PRD9 CALL REMOTE-VERB? ZERO? STACK /FALSE ?PRD9: FSET? OBJ,PERSONBIT \FALSE FSET? OBJ,SEENBIT /TRUE RFALSE .FUNCT NOT-SECRET-TEST,OBJ FSET? OBJ,SECRETBIT \TRUE FSET? OBJ,SEENBIT /TRUE RFALSE .FUNCT PRUNE,TBL,LEN,FCN,CNT=1,OBJ ?PRG1: GETB TBL,CNT >OBJ CALL FCN,OBJ ZERO? STACK \?CND3 DEC 'LEN CALL ELIMINATE,TBL,CNT,LEN GRTR? CNT,LEN \?PRG1 ?CND3: IGRTR? 'CNT,LEN \?PRG1 PUTB TBL,P-MATCHLEN,LEN RETURN LEN .FUNCT ELIMINATE,TBL,CNT,N ?PRG1: ADD 1,CNT GETB TBL,STACK PUTB TBL,CNT,STACK IGRTR? 'CNT,N \?PRG1 RTRUE .FUNCT MOBY-FIND,TBL,OBJ=1,LEN,FOO SET 'P-NAM,P-XNAM SET 'P-ADJ,P-XADJ PUTB TBL,P-MATCHLEN,0 ?PRG3: CALL META-LOC,OBJ,TRUE-VALUE >FOO ZERO? FOO /?CND5 CALL THIS-IT?,OBJ >FOO ZERO? FOO /?CND5 CALL OBJ-FOUND,OBJ,TBL >FOO ?CND5: IGRTR? 'OBJ,LAST-OBJECT \?PRG3 SET 'P-NAM,FALSE-VALUE SET 'P-ADJ,FALSE-VALUE GETB TBL,P-MATCHLEN >LEN EQUAL? LEN,1 /?CCL12 RETURN LEN ?CCL12: GETB TBL,1 >P-MOBY-FOUND RETURN LEN .FUNCT FIND-NOT-HERE,TBL,PRSO?,M-F,OBJ,LEN,CNT,LOCAL=0 CALL MOBY-FIND,TBL >M-F GRTR? M-F,1 \?CND1 SET 'CNT,0 ?PRG3: IGRTR? 'CNT,M-F /?REP4 GETB TBL,CNT >OBJ CALL GEN-TEST,OBJ ZERO? STACK /?PRG3 IGRTR? 'LOCAL,1 /?REP4 SET 'P-MOBY-FOUND,OBJ JUMP ?PRG3 ?REP4: EQUAL? LOCAL,1 \?CND1 SET 'M-F,1 ?CND1: EQUAL? 1,M-F \?CCL16 CALL REMOTE-VERB? ZERO? STACK \?CCL19 FSET? P-MOBY-FOUND,SECRETBIT \?CCL19 CALL NOT-FOUND,P-MOBY-FOUND RTRUE ?CCL19: CALL REMOTE-VERB? ZERO? STACK \?CCL23 EQUAL? PRSA,V?$CALL /?CCL23 CALL VISIBLE?,P-MOBY-FOUND ZERO? STACK \?CCL23 CALL NOT-HERE,P-MOBY-FOUND RTRUE ?CCL23: ZERO? PRSO? /?CCL28 SET 'PRSO,P-MOBY-FOUND RFALSE ?CCL28: SET 'PRSI,P-MOBY-FOUND RFALSE ?CCL16: LESS? 1,M-F \?CCL30 GETB TBL,1 >OBJ FSET? OBJ,PERSONBIT \?CCL30 GETB TBL,P-MATCHLEN CALL PRUNE,TBL,STACK,GEN-TEST >LEN ZERO? LEN \?CCL35 RETURN NOT-HERE-OBJECT ?CCL35: EQUAL? LEN,1 /?CND33 CALL WHICH-PRINT,0,LEN,TBL EQUAL? TBL,P-PRSO \?CCL39 SET 'P-ACLAUSE,P-NC1 JUMP ?CND37 ?CCL39: SET 'P-ACLAUSE,P-NC2 ?CND37: SET 'P-AADJ,P-ADJ SET 'P-ANAM,P-NAM CALL ORPHAN,FALSE-VALUE,FALSE-VALUE SET 'P-OFLAG,TRUE-VALUE RTRUE ?CND33: FSET? OBJ,SECRETBIT \?CCL42 CALL NOT-FOUND,OBJ RTRUE ?CCL42: ZERO? PRSO? /?CCL44 SET 'PRSO,OBJ RFALSE ?CCL44: SET 'PRSI,OBJ RFALSE ?CCL30: LESS? 1,M-F \?CCL46 GETB TBL,1 >OBJ GETP OBJ,P?GENERIC CALL STACK,TBL,M-F >OBJ ZERO? OBJ /?CCL46 EQUAL? OBJ,NOT-HERE-OBJECT /TRUE FSET? OBJ,SECRETBIT \?CCL53 CALL NOT-FOUND,OBJ RTRUE ?CCL53: ZERO? PRSO? /?CCL55 SET 'PRSO,OBJ RFALSE ?CCL55: SET 'PRSI,OBJ RFALSE ?CCL46: ZERO? PRSO? \?PRD59 IN? PRSO,HERE \?PRD59 EQUAL? PRSA,V?TELL-ABOUT,V?ASK-FOR,V?ASK-ABOUT /?CTR56 ?PRD59: ZERO? PRSO? /?PRD63 CALL QCONTEXT-GOOD? ZERO? STACK /?PRD63 EQUAL? PRSA,V?ASK-CONTEXT-FOR,V?ASK-CONTEXT-ABOUT /?CTR56 ?PRD63: EQUAL? WINNER,PLAYER /?CCL57 EQUAL? PRSA,V?SGIVE,V?GIVE,V?FIND \?CCL57 ?CTR56: SET 'LEN,FALSE-VALUE EQUAL? WINNER,PLAYER /?CCL71 SET 'LEN,WINNER JUMP ?CND69 ?CCL71: EQUAL? PRSA,V?TELL-ABOUT,V?ASK-FOR,V?ASK-ABOUT \?CCL73 SET 'LEN,PRSO JUMP ?CND69 ?CCL73: CALL QCONTEXT-GOOD? ZERO? STACK /?CND69 SET 'LEN,QCONTEXT ?CND69: EQUAL? LEN,0,PLAYER /?PRG79 CALL START-SENTENCE,LEN PRINTI " looks confused. " ?PRG79: PRINTI """I don't know wh" ZERO? M-F \?PRG86 PRINTI "at you mean by" CALL NOT-HERE-PRINT JUMP ?PRG90 ?PRG86: PRINTI "ich" CALL NOT-HERE-PRINT PRINTI " you mean" ?PRG90: PRINTR "!""" ?CCL57: ZERO? PRSO? \?CCL93 CALL HE-SHE-IT,WINNER,TRUE-VALUE PRINTI " wouldn't find" CALL CAPITAL-NOUN?,P-XNAM ZERO? STACK \?CND96 PRINTI " any" ?CND96: CALL NOT-HERE-PRINT PRINTR " there." ?CCL93: RETURN NOT-HERE-OBJECT .FUNCT NOT-HERE-PRINT ZERO? P-OFLAG \?CTR2 ZERO? P-MERGED /?CCL3 ?CTR2: ZERO? P-XADJ /?CND6 PRINTC 32 PRINTB P-XADJN ?CND6: ZERO? P-XNAM /FALSE PRINTC 32 PRINTB P-XNAM RTRUE ?CCL3: EQUAL? PRSO,NOT-HERE-OBJECT \?CCL16 CALL CLAUSE-PRINT,P-NC1,P-NC1L,FALSE-VALUE RSTACK ?CCL16: CALL CLAUSE-PRINT,P-NC2,P-NC2L,FALSE-VALUE RSTACK .FUNCT SEE-VERB? EQUAL? PRSA,V?SSEARCH-FOR,V?SEARCH-FOR,V?SEARCH /TRUE EQUAL? PRSA,V?READ,V?LOOK-UP,V?LOOK-UNDER /TRUE EQUAL? PRSA,V?LOOK-THROUGH,V?LOOK-OUTSIDE,V?LOOK-ON /TRUE EQUAL? PRSA,V?LOOK-INSIDE,V?LOOK-DOWN,V?LOOK-BEHIND /TRUE EQUAL? PRSA,V?LOOK,V?FIND,V?EXAMINE /TRUE EQUAL? PRSA,V?CHASTISE,V?SANALYZE,V?ANALYZE /TRUE RFALSE .FUNCT FIX-HIM-HER-IT,PRON,OBJ ZERO? OBJ /?CTR2 CALL ACCESSIBLE?,OBJ ZERO? STACK \?CCL3 EQUAL? PRON,PRSI \?PRD9 CALL PRSI-VERB? ZERO? STACK /?CTR2 ?PRD9: EQUAL? PRON,PRSO \?CCL3 CALL PRSO-VERB? ZERO? STACK \?CCL3 ?CTR2: EQUAL? 0,OBJ,PRSI \?CCL16 CALL FAKE-ORPHAN RFALSE ?CCL16: CALL NOT-HERE,OBJ RFALSE ?CCL3: EQUAL? PRSO,PRON \?CND17 EQUAL? PRON,IT \?CND19 GET P-IT-WORDS,0 PUT P-ADJW,0,STACK GET P-IT-WORDS,1 PUT P-NAMW,0,STACK ?CND19: SET 'PRSO,OBJ CALL TELL-I-ASSUME,OBJ ?CND17: EQUAL? PRSI,PRON \TRUE EQUAL? PRON,IT \?CND23 GET P-IT-WORDS,0 PUT P-ADJW,1,STACK GET P-IT-WORDS,1 PUT P-NAMW,1,STACK ?CND23: SET 'PRSI,OBJ CALL TELL-I-ASSUME,OBJ RTRUE .FUNCT FAKE-ORPHAN,TMP CALL ORPHAN,P-SYNTAX,FALSE-VALUE PRINTI "[Please be specific: wh" GETB P-SYNTAX,P-SFWIM1 EQUAL? STACK,PERSONBIT \?PRG8 PRINTI "om" JUMP ?PRG10 ?PRG8: PRINTI "at" ?PRG10: PRINTI " do you want to " CALL VERB-PRINT SET 'P-OFLAG,TRUE-VALUE SET 'P-WON,FALSE-VALUE PRINTR "?]" .FUNCT PERFORM,A,O=0,I=0,V,OA,OO,OI,X SET 'OA,PRSA SET 'OO,PRSO SET 'OI,PRSI SET 'PRSA,A SET 'PRSI,I SET 'PRSO,O ZERO? LIT \?CCL3 CALL SEE-VERB? ZERO? STACK /?CCL3 CALL TOO-DARK RETURN 2 ?CCL3: EQUAL? PRSA,V?WALK /?CND1 EQUAL? IT,PRSI,PRSO \?CND9 CALL FIX-HIM-HER-IT,IT,P-IT-OBJECT ZERO? STACK \?CND9 RETURN 2 ?CND9: EQUAL? HER,PRSI,PRSO \?CND15 CALL FIX-HIM-HER-IT,HER,P-HER-OBJECT ZERO? STACK \?CND15 RETURN 2 ?CND15: EQUAL? HIM,PRSI,PRSO \?CND1 CALL FIX-HIM-HER-IT,HIM,P-HIM-OBJECT ZERO? STACK \?CND1 RETURN 2 ?CND1: SET 'V,FALSE-VALUE EQUAL? A,V?WALK /?CND27 EQUAL? NOT-HERE-OBJECT,PRSO,PRSI \?CND27 CALL D-APPLY,STR?9,NOT-HERE-OBJECT-F >V ZERO? V /?CND27 SET 'P-WON,FALSE-VALUE ?CND27: CALL THIS-IS-IT,PRSI CALL THIS-IS-IT,PRSO EQUAL? WINNER,PLAYER /?CND33 CALL THIS-IS-IT,WINNER ?CND33: SET 'O,PRSO SET 'I,PRSI ZERO? V \?CND35 GETP WINNER,P?ACTION CALL D-APPLY,STR?10,STACK,M-WINNER >V ?CND35: ZERO? V \?CND37 IN? WINNER,CAR \?CCL41 PUSH CAR JUMP ?CND39 ?CCL41: PUSH HERE ?CND39: GETP STACK,P?ACTION CALL D-APPLY,STR?11,STACK,M-BEG >V ?CND37: ZERO? V \?CND42 GET PREACTIONS,A CALL D-APPLY,STR?12,STACK >V ?CND42: SET 'NOW-PRSI,1 ZERO? V \?CND44 ZERO? I /?CND44 GETP I,P?ACTION CALL D-APPLY,STR?13,STACK >V ?CND44: SET 'NOW-PRSI,0 ZERO? V \?CND48 ZERO? O /?CND48 EQUAL? A,V?WALK /?CND48 GETP O,P?ACTION CALL D-APPLY,STR?14,STACK >V ?CND48: ZERO? V \?CND53 GET ACTIONS,A CALL D-APPLY,FALSE-VALUE,STACK >V ?CND53: SET 'PRSA,OA SET 'PRSO,OO SET 'PRSI,OI RETURN V .FUNCT D-APPLY,STR,FCN,FOO=0,RES ZERO? FCN /FALSE EQUAL? STR,STR?15 \?CND4 SET 'FOO,M-CONT ?CND4: ZERO? FOO /?CCL8 CALL FCN,FOO >RES RETURN RES ?CCL8: CALL FCN >RES RETURN RES .FUNCT I-PROMPT,GARG=0 DEC 'P-PROMPT RFALSE .FUNCT BUZZER-WORD?,WRD,PTR CALL QUESTION-WORD?,WRD ZERO? STACK \?CCL3 CALL NAUGHTY-WORD?,WRD ZERO? STACK \?CCL3 CALL NUMBER-WORD?,WRD ZERO? STACK /FALSE ?CCL3: PUT OOPS-TABLE,O-PTR,PTR RTRUE .FUNCT QUESTION-WORD?,WORD,DO-IT=0 EQUAL? WORD,W?(SOME \?CCL3 PRINTI "[Type a real word instead of" PRINT SOMETHING RTRUE ?CCL3: EQUAL? WORD,W?WHERE \?CCL7 CALL TO-DO-X-USE-Y,STR?17,STR?18 RTRUE ?CCL7: EQUAL? WORD,W?WHAT,W?WHO,W?WHEN /?CTR8 EQUAL? WORD,W?WHY \?CCL9 ?CTR8: CALL TO-DO-X-USE-Y,STR?19,STR?20 RTRUE ?CCL9: ZERO? DO-IT \?PRG16 CALL ZMEMQ,WORD,QUESTION-WORD-TABLE ZERO? STACK /FALSE ?PRG16: PRINTI "[Please use commands" INC 'QUESTION-WORD-COUNT MOD QUESTION-WORD-COUNT,4 ZERO? STACK \?PRG23 PRINTI " to tell the computer what you want to do in the story. Here are some commands: GO TO MY ROOM LOOK UNDER THE RUG MADAM, DESCRIBE THE GHOST Now you can try again" JUMP ?PRG25 ?PRG23: PRINTI ", not statements or questions" ?PRG25: PRINTR ".]" .FUNCT TO-DO-X-USE-Y,STR1,STR2 PRINTI "[To " PRINT STR1 PRINTI " something, use the command: " PRINT STR2 PRINT SOMETHING RTRUE .FUNCT NUMBER-WORD?,WRD CALL ZMEMQ,WRD,NUMBER-WORD-TABLE ZERO? STACK /FALSE PRINTR "[Use numerals for numbers, for example ""10.""]" .FUNCT NAUGHTY-WORD?,WORD CALL ZMEMQ,WORD,NAUGHTY-WORD-TABLE ZERO? STACK /FALSE PRINTC 91 CALL PICK-ONE-NEW,OFFENDED PRINT STACK PRINTC 93 CRLF RTRUE .FUNCT NOT-THAT-WAY,STR PRINTI "[You can't use " PRINT STR PRINTR " that way.]" .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,?TMP1,?TMP2 ?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 'P-NAM,FALSE-VALUE SET 'P-ADJ,FALSE-VALUE SET 'P-ADJN,FALSE-VALUE SET 'P-XNAM,FALSE-VALUE SET 'P-XADJ,FALSE-VALUE SET 'P-XADJN,FALSE-VALUE ZERO? P-OFLAG \?CND8 PUT P-NAMW,0,FALSE-VALUE PUT P-NAMW,1,FALSE-VALUE PUT P-ADJW,0,FALSE-VALUE PUT P-ADJW,1,FALSE-VALUE PUT P-OFW,0,FALSE-VALUE PUT P-OFW,1,FALSE-VALUE ?CND8: SET 'P-PRSA-WORD,FALSE-VALUE SET 'OMERGED,P-MERGED SET 'P-MERGED,FALSE-VALUE SET 'P-END-ON-PREP,FALSE-VALUE PUTB P-PRSO,P-MATCHLEN,0 PUTB P-PRSI,P-MATCHLEN,0 PUTB P-BUTS,P-MATCHLEN,0 SET 'OWINNER,WINNER ZERO? QUOTE-FLAG \?CND10 EQUAL? WINNER,PLAYER /?CND10 SET 'WINNER,PLAYER LOC WINNER FSET? STACK,VEHBIT /?CND14 LOC WINNER >HERE ?CND14: CALL LIT? >LIT ?CND10: ZERO? RESERVE-PTR /?CCL18 SET 'PTR,RESERVE-PTR CALL STUFF,P-LEXV,RESERVE-LEXV CALL INBUF-STUFF,P-INBUF,RESERVE-INBUF ZERO? VERBOSITY /?CND19 EQUAL? PLAYER,WINNER \?CND19 CRLF ?CND19: SET 'RESERVE-PTR,FALSE-VALUE JUMP ?CND16 ?CCL18: ZERO? P-CONT /?CCL24 SET 'PTR,P-CONT ZERO? VERBOSITY /?CND16 EQUAL? PLAYER,WINNER \?CND16 CRLF JUMP ?CND16 ?CCL24: SET 'WINNER,PLAYER SET 'QUOTE-FLAG,FALSE-VALUE GET OOPS-TABLE,O-PTR ZERO? STACK \?CND29 PUT OOPS-TABLE,O-END,FALSE-VALUE ?CND29: LOC WINNER FSET? STACK,VEHBIT /?CND31 LOC WINNER >HERE ?CND31: CALL LIT? >LIT FCLEAR IT,TOUCHBIT FCLEAR HER,TOUCHBIT FCLEAR HIM,TOUCHBIT ZERO? VERBOSITY /?CND33 CRLF ?CND33: ZERO? P-PROMPT /?PRG51 ZERO? P-OFLAG \?PRG51 ZERO? AWAITING-REPLY \?PRG51 EQUAL? P-PROMPT,P-PROMPT-START \?CCL42 PRINTI "What would you like to do?" JUMP ?CND40 ?CCL42: DLESS? 'P-PROMPT,1 \?PRG49 PRINTI "[You won't see ""What next?"" any more.] " JUMP ?CND40 ?PRG49: PRINTI "What next?" ?CND40: CRLF ?PRG51: PRINTC 62 READ P-INBUF,P-LEXV ?CND16: GETB P-LEXV,P-LEXWORDS >P-LEN GET P-LEXV,PTR EQUAL? W?QUOTE,STACK \?CND53 CALL QCONTEXT-GOOD? ZERO? STACK /?CND53 ADD PTR,P-LEXELEN >PTR DEC 'P-LEN ?CND53: GET P-LEXV,PTR EQUAL? W?THEN,STACK \?CND57 ADD PTR,P-LEXELEN >PTR DEC 'P-LEN ?CND57: LESS? 1,P-LEN \?CND59 GET P-LEXV,PTR EQUAL? STACK,W?YOU \?CND59 ADD PTR,P-LEXELEN GET P-LEXV,STACK >NW ZERO? NW /?CND59 CALL WT?,NW,64 ZERO? STACK /?CND59 ADD PTR,P-LEXELEN >PTR DEC 'P-LEN ?CND59: LESS? 1,P-LEN \?CND65 GET P-LEXV,PTR EQUAL? STACK,W?GO,W?TO \?CND65 ADD PTR,P-LEXELEN GET P-LEXV,STACK >NW ZERO? NW /?CND65 CALL WT?,NW,64 ZERO? STACK /?CND65 ADD PTR,P-LEXELEN >PTR DEC 'P-LEN ?CND65: ZERO? P-LEN \?CCL73 PRINTC 91 PRINT BEG-PARDON PRINTC 93 CRLF RFALSE ?CCL73: GET P-LEXV,PTR EQUAL? STACK,W?OOPS \?CCL77 ADD PTR,P-LEXELEN GET P-LEXV,STACK EQUAL? STACK,W?PERIOD,W?COMMA,W?! \?CND78 ADD PTR,P-LEXELEN >PTR DEC 'P-LEN ?CND78: GRTR? P-LEN,1 /?CCL82 CALL NOT-THAT-WAY,STR?28 RFALSE ?CCL82: GET OOPS-TABLE,O-PTR >VAL ZERO? VAL /?CCL84 GRTR? P-LEN,2 \?CND85 PRINTI "[Warning: only the first word after OOPS is used.]" CRLF ?CND85: ADD PTR,P-LEXELEN GET P-LEXV,STACK PUT AGAIN-LEXV,VAL,STACK SET 'WINNER,OWINNER MUL PTR,P-LEXELEN ADD STACK,6 >PTR GETB P-LEXV,PTR >?TMP2 ADD PTR,1 GETB P-LEXV,STACK >?TMP1 MUL VAL,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 SET 'OOPS-PRINT,TRUE-VALUE CALL PRINT-LEXV,PTR SET 'OOPS-PRINT,FALSE-VALUE JUMP ?CND71 ?CCL84: PUT OOPS-TABLE,O-END,FALSE-VALUE PRINTI "[There was no word to replace!]" CRLF RFALSE ?CCL77: ZERO? P-CONT \?CND71 PUT OOPS-TABLE,O-END,FALSE-VALUE ?CND71: SET 'P-CONT,FALSE-VALUE GET P-LEXV,PTR EQUAL? STACK,W?AGAIN,W?G \?CCL95 GETB OOPS-INBUF,1 ZERO? STACK \?CCL98 PRINTI "[What do you want to do again?]" CRLF RFALSE ?CCL98: ZERO? P-OFLAG /?CCL102 CALL NOT-THAT-WAY,STR?29 RFALSE ?CCL102: ZERO? P-WON \?CCL104 PRINTI "[That would just repeat a mistake!]" CRLF RFALSE ?CCL104: GRTR? P-LEN,1 \?CCL108 ADD PTR,P-LEXELEN GET P-LEXV,STACK >CNT EQUAL? CNT,W?PERIOD,W?COMMA,W?THEN /?CTR110 EQUAL? CNT,W?AND,W?!,W?? \?CCL111 ?CTR110: ADD PTR,4 >PTR GETB P-LEXV,P-LEXWORDS SUB STACK,2 PUTB P-LEXV,P-LEXWORDS,STACK JUMP ?CND96 ?CCL111: CALL DONT-UNDERSTAND RFALSE ?CCL108: ADD PTR,P-LEXELEN >PTR GETB P-LEXV,P-LEXWORDS SUB STACK,1 PUTB P-LEXV,P-LEXWORDS,STACK ?CND96: GETB P-LEXV,P-LEXWORDS GRTR? STACK,0 \?CCL116 CALL STUFF,RESERVE-LEXV,P-LEXV CALL INBUF-STUFF,RESERVE-INBUF,P-INBUF SET 'RESERVE-PTR,PTR JUMP ?CND114 ?CCL116: SET 'RESERVE-PTR,FALSE-VALUE ?CND114: SET 'WINNER,OWINNER SET 'P-MERGED,OMERGED CALL INBUF-STUFF,P-INBUF,OOPS-INBUF CALL STUFF,P-LEXV,AGAIN-LEXV SET 'CNT,-1 SET 'DIR,AGAIN-DIR ?PRG117: IGRTR? 'CNT,P-ITBLLEN /?CND93 GET P-OTBL,CNT PUT P-ITBL,CNT,STACK JUMP ?PRG117 ?CCL95: SET 'P-NUMBER,-1 GETB P-LEXV,P-LEXWORDS MUL P-LEXELEN,STACK ADD PTR,STACK >LEN CALL FIX-POSSESSIVES,PTR,LEN EQUAL? TRUE-VALUE,STACK /FALSE 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 GET OOPS-TABLE,O-END ZERO? STACK \?CND124 MUL 2,LEN >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 ?CND124: SET 'RESERVE-PTR,FALSE-VALUE SET 'LEN,P-LEN SET 'P-DIRECTION,FALSE-VALUE SET 'P-NCN,0 SET 'P-GETFLAGS,0 PUT P-ITBL,P-VERBN,0 ?PRG126: DLESS? 'P-LEN,0 \?CCL130 SET 'QUOTE-FLAG,FALSE-VALUE JUMP ?CND93 ?CCL130: GET P-LEXV,PTR >WRD ZERO? WRD \?CTR131 CALL NUMBER?,PTR >WRD ZERO? WRD \?CTR131 CALL NAME?,PTR >WRD ZERO? WRD /?CCL132 ?CTR131: ZERO? P-LEN \?CCL138 SET 'NW,0 JUMP ?CND136 ?CCL138: ADD PTR,P-LEXELEN GET P-LEXV,STACK >NW ?CND136: EQUAL? WRD,W?TO \?CCL141 EQUAL? VERB,ACT?TELL,ACT?ASK \?CCL141 PUT P-ITBL,P-VERB,ACT?TELL SET 'WRD,W?QUOTE JUMP ?CND139 ?CCL141: EQUAL? WRD,W?THEN \?CND139 GRTR? P-LEN,0 \?CND139 ZERO? VERB \?CND139 ZERO? QUOTE-FLAG \?CND139 PUT P-ITBL,P-VERB,ACT?TELL PUT P-ITBL,P-VERBN,0 SET 'WRD,W?QUOTE ?CND139: EQUAL? WRD,W?PERIOD \?CCL151 EQUAL? LW,W?MRS,W?MR,W?MS /?CTR150 EQUAL? LW,W?DR \?CCL151 ?CTR150: SET 'LW,0 JUMP ?CND128 ?CCL151: EQUAL? WRD,W?THEN,W?PERIOD,W?QUOTE /?CTR156 EQUAL? WRD,W?!,W?? \?CCL157 ?CTR156: EQUAL? WRD,W?QUOTE \?CND160 ZERO? QUOTE-FLAG /?CCL164 SET 'QUOTE-FLAG,FALSE-VALUE JUMP ?CND160 ?CCL164: SET 'QUOTE-FLAG,TRUE-VALUE ?CND160: ZERO? P-LEN /?PEN165 ADD PTR,P-LEXELEN >P-CONT ?PEN165: PUTB P-LEXV,P-LEXWORDS,P-LEN JUMP ?CND93 ?CCL157: CALL WT?,WRD,16,3 >VAL ZERO? VAL /?CCL168 EQUAL? VERB,FALSE-VALUE,ACT?HEAD \?CCL168 EQUAL? LEN,1 /?CTR167 EQUAL? LEN,2 \?PRD174 EQUAL? VERB,ACT?HEAD /?CTR167 ?PRD174: EQUAL? NW,W?THEN,W?PERIOD,W?QUOTE \?PRD177 GRTR? LEN,1 /?CTR167 ?PRD177: EQUAL? NW,W?!,W?? \?PRD180 GRTR? LEN,1 /?CTR167 ?PRD180: ZERO? QUOTE-FLAG /?PRD183 EQUAL? LEN,2 \?PRD183 EQUAL? NW,W?QUOTE /?CTR167 ?PRD183: GRTR? LEN,2 \?CCL168 EQUAL? NW,W?COMMA,W?AND \?CCL168 ?CTR167: SET 'DIR,VAL EQUAL? NW,W?COMMA,W?AND \?CND189 ADD PTR,P-LEXELEN CALL CHANGE-LEXV,STACK,W?THEN ?CND189: GRTR? LEN,2 /?CND128 SET 'QUOTE-FLAG,FALSE-VALUE JUMP ?CND93 ?CCL168: CALL WT?,WRD,64,1 >VAL ZERO? VAL /?CCL194 ZERO? VERB \?CCL194 ZERO? P-OFLAG \?CND197 SET 'P-PRSA-WORD,WRD ?CND197: 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 ?CND128 ?CCL194: CALL WT?,WRD,8,0 >VAL ZERO? VAL \?CTR199 EQUAL? WRD,W?ALL,W?ONE,W?A /?CTR199 CALL WT?,WRD,32 ZERO? STACK \?CTR199 CALL WT?,WRD,128 ZERO? STACK /?CCL200 ?CTR199: GRTR? P-LEN,1 \?CCL209 EQUAL? NW,W?OF \?CCL209 ZERO? VAL \?CCL209 EQUAL? WRD,W?ALL,W?ONE,W?A /?CCL209 PUT P-OFW,P-NCN,WRD SET 'OF-FLAG,TRUE-VALUE JUMP ?CND128 ?CCL209: ZERO? VAL /?CCL215 ZERO? P-LEN /?CTR214 EQUAL? NW,W?THEN,W?PERIOD /?CTR214 EQUAL? NW,W?!,W?? \?CCL215 ?CTR214: SET 'P-END-ON-PREP,TRUE-VALUE LESS? P-NCN,2 \?CND128 PUT P-ITBL,P-PREP1,VAL PUT P-ITBL,P-PREP1N,WRD JUMP ?CND128 ?CCL215: EQUAL? P-NCN,2 \?CCL224 PRINTI "[I found too many nouns in that sentence!]" CRLF RFALSE ?CCL224: INC 'P-NCN CALL CLAUSE,PTR,VAL,WRD >PTR ZERO? PTR /FALSE LESS? PTR,0 \?CND128 SET 'QUOTE-FLAG,FALSE-VALUE ?CND93: PUT OOPS-TABLE,O-PTR,FALSE-VALUE ZERO? DIR /?CND249 SET 'PRSA,V?WALK SET 'P-WALK-DIR,DIR SET 'AGAIN-DIR,DIR SET 'PRSO,DIR SET 'P-OFLAG,FALSE-VALUE RTRUE ?CCL200: EQUAL? WRD,W?OF \?CCL232 ZERO? OF-FLAG /?CTR234 EQUAL? NW,W?PERIOD,W?THEN /?CTR234 EQUAL? NW,W?!,W?? \?CCL235 ?CTR234: CALL CANT-USE,PTR RFALSE ?CCL235: SET 'OF-FLAG,FALSE-VALUE ?CND128: SET 'LW,WRD ADD PTR,P-LEXELEN >PTR JUMP ?PRG126 ?CCL232: CALL WT?,WRD,4 ZERO? STACK /?CCL240 CALL BUZZER-WORD?,WRD,PTR ZERO? STACK /?CND128 RFALSE ?CCL240: EQUAL? VERB,ACT?TELL \?CCL244 CALL WT?,WRD,64 ZERO? STACK /?CCL244 PRINTI "[Please consult your manual on how to talk to people.]" CRLF RFALSE ?CCL244: CALL CANT-USE,PTR RFALSE ?CCL132: CALL UNKNOWN-WORD,PTR RFALSE ?CND249: SET 'P-WALK-DIR,FALSE-VALUE SET 'AGAIN-DIR,FALSE-VALUE ZERO? P-OFLAG /?CND251 CALL ORPHAN-MERGE ZERO? STACK /?CND251 SET 'WINNER,OWINNER ?CND251: GET P-ITBL,P-VERB ZERO? STACK \?CND255 SUB PTR,P-LEXELEN >PTR SET 'TMP,FALSE-VALUE GRTR? PTR,0 \?CND257 GET P-LEXV,PTR >TMP ?CND257: EQUAL? TMP,W?PLEASE \?CCL261 PUT P-ITBL,P-VERB,ACT?YES JUMP ?CND255 ?CCL261: EQUAL? TMP,W?PERIOD \?CCL263 CALL MISSING,STR?30 RFALSE ?CCL263: PUT P-ITBL,P-VERB,ACT?$CALL ?CND255: CALL SYNTAX-CHECK ZERO? STACK /FALSE CALL SNARF-OBJECTS ZERO? STACK /FALSE CALL MANY-CHECK ZERO? STACK /FALSE CALL TAKE-CHECK ZERO? STACK \TRUE RFALSE .FUNCT CHANGE-LEXV,PTR,WRD PUT P-LEXV,PTR,WRD PUT AGAIN-LEXV,PTR,WRD RTRUE .FUNCT PRINT-LEXV,PTR,X PRINT I-ASSUME MUL 2,PTR ADD P-LEXV,STACK >X MUL P-WORDLEN,P-LEN ADD X,STACK CALL BUFFER-PRINT,X,STACK,FALSE-VALUE PRINTR "]" .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=80 ?PRG1: DLESS? 'CNT,0 /TRUE GETB SRC,CNT PUTB DEST,CNT,STACK JUMP ?PRG1 .FUNCT INBUF-ADD,LEN,BEG,SLOT,DBEG,CTR=0,TMP,?TMP1 GET OOPS-TABLE,O-END >TMP ZERO? TMP /?CCL3 SET 'DBEG,TMP JUMP ?CND1 ?CCL3: GET OOPS-TABLE,O-LENGTH >TMP GETB AGAIN-LEXV,TMP >?TMP1 ADD TMP,1 GETB AGAIN-LEXV,STACK ADD ?TMP1,STACK >DBEG ?CND1: ADD DBEG,LEN PUT OOPS-TABLE,O-END,STACK ?PRG4: ADD DBEG,CTR >?TMP1 ADD BEG,CTR GETB P-INBUF,STACK PUTB OOPS-INBUF,?TMP1,STACK INC 'CTR EQUAL? CTR,LEN \?PRG4 PUTB AGAIN-LEXV,SLOT,DBEG SUB SLOT,1 PUTB AGAIN-LEXV,STACK,LEN RTRUE .FUNCT FIX-POSSESSIVES,START,END,WHERE=0,PTR,N,PNAM,PADJ,VAL=0,X SET 'PNAM,P-NAM SET 'PADJ,P-ADJ SET 'P-ADJ,FALSE-VALUE SET 'PTR,END ?PRG1: SUB PTR,P-LEXELEN >PTR EQUAL? PTR,START /?REP2 GET P-LEXV,PTR EQUAL? STACK,W?APOSTROPHE \?PRG1 SUB PTR,P-LEXELEN GET P-LEXV,STACK >P-NAM SET 'N,RHINO-HEAD-C ?PRG7: ZERO? P-NAM /?CCL11 GET CHARACTER-TABLE,N CALL THIS-IT?,STACK ZERO? STACK /?CCL11 GET CHARACTER-TABLE,N CALL THIS-IS-IT,STACK ADD 1,N GET CHAR-POSS-TABLE,STACK >VAL SUB PTR,WHERE CALL CHANGE-LEXV,STACK,VAL JUMP ?REP8 ?CCL11: DLESS? 'N,0 \?PRG7 ?REP8: LESS? N,0 \?PRG1 SUB PTR,P-LEXELEN CALL NAME?,STACK ZERO? STACK /?CND17 SUB PTR,WHERE CALL CHANGE-LEXV,STACK,W?MY JUMP ?PRG1 ?CND17: GET QWP1-TABLE,0 >N ADD PTR,P-LEXELEN GET P-LEXV,STACK >X ?PRG19: GET QWP1-TABLE,N EQUAL? STACK,P-NAM \?CCL23 GET QWP2-TABLE,N EQUAL? STACK,X \?CCL23 CALL QUESTION-WORD?,P-NAM,TRUE-VALUE RTRUE ?CCL23: DLESS? 'N,1 /?PRG1 JUMP ?PRG19 ?REP2: SET 'P-NAM,PNAM SET 'P-ADJ,PADJ RETURN VAL .FUNCT NAME?,PTR,?TMP1 CALL XNAME?,PTR,FIRST-NAME >?TMP1 ZERO? ?TMP1 /?PRD3 RETURN ?TMP1 ?PRD3: CALL XNAME?,PTR,LAST-NAME >?TMP1 ZERO? ?TMP1 /?PRD4 RETURN ?TMP1 ?PRD4: CALL XNAME?,PTR,FAVE-COLOR RSTACK .FUNCT XNAME?,PTR,TBL,MAX,CNT,BPTR,CHR,N?=1,NCNT=0 MUL PTR,2 ADD P-LEXV,STACK >BPTR GETB BPTR,2 >CNT GRTR? CNT,6 \?CND1 SET 'CNT,6 ?CND1: GETB BPTR,3 >BPTR GETB TBL,0 >MAX LESS? MAX,7 /?PRG5 SET 'MAX,6 ?PRG5: IGRTR? 'NCNT,MAX \?CCL9 ZERO? CNT /?REP6 SET 'N?,FALSE-VALUE JUMP ?REP6 ?CCL9: DLESS? 'CNT,0 \?CCL13 SET 'N?,FALSE-VALUE ?REP6: ZERO? N? /FALSE EQUAL? TBL,FIRST-NAME \?CCL23 CALL CHANGE-LEXV,PTR,W?F.N RETURN W?F.N ?CCL13: GETB P-INBUF,BPTR >CHR EQUAL? CHR,45,39,38 /?CND14 MOD CHR,32 ADD 96,STACK >CHR ?CND14: GETB TBL,NCNT EQUAL? CHR,STACK /?CND16 SET 'N?,FALSE-VALUE ?CND16: INC 'BPTR JUMP ?PRG5 ?CCL23: EQUAL? TBL,FAVE-COLOR \?CCL25 CALL CHANGE-LEXV,PTR,W?F.C RETURN W?F.C ?CCL25: CALL CHANGE-LEXV,PTR,W?L.N RETURN W?L.N .FUNCT WT?,PTR,BIT,B1=5,OFFS=P-P1OFF,TYP GETB PTR,P-PSOFF >TYP BTST TYP,BIT \FALSE GRTR? B1,4 /TRUE EQUAL? BIT,128 /TRUE BAND TYP,P-P1BITS >TYP EQUAL? TYP,B1 /?CND9 INC 'OFFS ?CND9: GETB PTR,OFFS RSTACK .FUNCT 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 \?CTR13 CALL NAME?,PTR >WRD ZERO? WRD /?CCL14 ?CTR13: ZERO? P-LEN \?CCL20 SET 'NW,0 JUMP ?CND18 ?CCL20: ADD PTR,P-LEXELEN GET P-LEXV,STACK >NW ZERO? NW \?CND18 ADD PTR,P-LEXELEN CALL NUMBER?,STACK >NW ?CND18: EQUAL? WRD,W?PERIOD \?CCL25 EQUAL? LW,W?MRS,W?MR,W?MS /?CTR24 EQUAL? LW,W?DR \?CCL25 ?CTR24: SET 'LW,0 JUMP ?CND12 ?CCL25: EQUAL? WRD,W?AND,W?COMMA \?CCL31 SET 'ANDFLG,TRUE-VALUE JUMP ?CND12 ?CCL31: EQUAL? WRD,W?ALL,W?ONE \?CCL33 EQUAL? NW,W?OF \?CND12 DEC 'P-LEN ADD PTR,P-LEXELEN >PTR JUMP ?CND12 ?CCL33: EQUAL? WRD,W?THEN,W?PERIOD /?CTR36 EQUAL? WRD,W?!,W?? /?CTR36 CALL WT?,WRD,8 ZERO? STACK /?CCL37 GET P-ITBL,P-VERB ZERO? STACK /?CCL37 ZERO? FIRST?? \?CCL37 ?CTR36: INC 'P-LEN ADD NUM,1 >?TMP1 MUL PTR,2 ADD P-LEXV,STACK PUT P-ITBL,?TMP1,STACK SUB PTR,P-LEXELEN RSTACK ?CCL37: ZERO? ANDFLG /?CCL45 GET P-ITBL,P-VERBN ZERO? STACK /?CTR44 CALL VERB-DIR-ONLY?,WRD ZERO? STACK /?CCL45 ?CTR44: SUB PTR,4 >PTR ADD PTR,2 CALL CHANGE-LEXV,STACK,W?THEN ADD P-LEN,2 >P-LEN JUMP ?CND12 ?CCL45: CALL WT?,WRD,128 ZERO? STACK /?CCL51 GRTR? P-LEN,0 \?CCL54 EQUAL? NW,W?OF \?CCL54 EQUAL? WRD,W?ALL,W?ONE /?CCL54 SUB P-NCN,1 PUT P-OFW,STACK,WRD JUMP ?CND12 ?CCL54: CALL WT?,WRD,32 ZERO? STACK /?CCL58 ZERO? NW /?CCL58 CALL WT?,NW,16 ZERO? STACK \?CCL58 CALL WT?,NW,128 ZERO? STACK \?CND12 CALL WT?,NW,32 ZERO? STACK \?CND12 ?CCL58: ZERO? ANDFLG \?CCL66 EQUAL? NW,W?BUT,W?EXCEPT /?CCL66 EQUAL? NW,W?AND,W?COMMA /?CCL66 ADD NUM,1 >?TMP1 ADD PTR,2 MUL STACK,2 ADD P-LEXV,STACK PUT P-ITBL,?TMP1,STACK RETURN PTR ?CCL66: SET 'ANDFLG,FALSE-VALUE JUMP ?CND12 ?CCL51: CALL WT?,WRD,32 ZERO? STACK \?CND12 CALL WT?,WRD,4 ZERO? STACK /?CCL72 CALL BUZZER-WORD?,WRD,PTR ZERO? STACK /?CND12 RFALSE ?CCL72: ZERO? ANDFLG /?CCL76 GET P-ITBL,P-VERB ZERO? STACK \?CCL76 SUB PTR,4 >PTR ADD PTR,2 CALL CHANGE-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 ?CCL76: CALL WT?,WRD,8 ZERO? STACK \?CND12 CALL CANT-USE,PTR RFALSE ?CCL14: CALL UNKNOWN-WORD,PTR RFALSE .FUNCT VERB-DIR-ONLY?,WRD,?TMP1 CALL WT?,WRD,128 ZERO? STACK \FALSE CALL WT?,WRD,32 ZERO? STACK \FALSE CALL WT?,WRD,16 >?TMP1 ZERO? ?TMP1 /?PRD7 RETURN ?TMP1 ?PRD7: CALL WT?,WRD,64 RSTACK .FUNCT NUMBER?,PTR,CNT,BPTR,CHR,SUM=0,TIM=0,TMP,?TMP1 MUL PTR,2 ADD P-LEXV,STACK >TMP GETB TMP,2 >CNT GETB TMP,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,29999 /FALSE GRTR? CHR,57 /FALSE LESS? CHR,48 /FALSE MUL SUM,10 >?TMP1 SUB CHR,48 ADD ?TMP1,STACK >SUM ?CND6: INC 'BPTR JUMP ?PRG1 ?REP2: CALL CHANGE-LEXV,PTR,W?INT.NUM GRTR? SUM,9999 /FALSE ZERO? TIM /?CND15 GRTR? TIM,23 /FALSE MUL TIM,60 ADD SUM,STACK >SUM ?CND15: SET 'P-TIME,TIM SET 'P-NUMBER,SUM RETURN W?INT.NUM .FUNCT ORPHAN-MERGE,CNT=-1,TEMP,VERB,BEG,END,ADJ=0,ADJB=0,VRB=0,NOUN=0,ADJE,WRD,?TMP1 SET 'P-OFLAG,FALSE-VALUE GET P-ITBL,P-VERBN >WRD ZERO? WRD /?CND1 GET WRD,0 >WRD ZERO? WRD /?CND1 CALL WT?,WRD,64,1 >?TMP1 GET P-OTBL,P-VERB EQUAL? ?TMP1,STACK \?CND5 SET 'VRB,TRUE-VALUE ?CND5: CALL WT?,WRD,32 ZERO? STACK /?CND7 SET 'ADJ,TRUE-VALUE ?CND7: CALL WT?,WRD,128 ZERO? STACK /?CND1 SET 'NOUN,TRUE-VALUE ?CND1: ZERO? VRB \?CND11 ZERO? ADJ \?CND11 CALL WT?,WRD,128,0 ZERO? STACK /?CND11 ZERO? P-NCN \?CND11 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 ?CND11: GET P-ITBL,P-VERB >VERB ZERO? VERB /?CCL19 ZERO? ADJ \?CCL19 ZERO? VRB \?CCL19 GET P-OTBL,P-VERB EQUAL? VERB,STACK \FALSE ?CCL19: EQUAL? P-NCN,2 /FALSE GET P-OTBL,P-NC1 EQUAL? STACK,1 \?CCL27 GET P-ITBL,P-PREP1 >?TMP1 GET P-OTBL,P-PREP1 EQUAL? ?TMP1,0,STACK \FALSE ZERO? ADJ /?CND31 ADD P-LEXV,2 PUT P-ITBL,P-NC1,STACK GET P-ITBL,P-NC1L ZERO? STACK \?CND33 ADD P-LEXV,6 PUT P-ITBL,P-NC1L,STACK ?CND33: ZERO? P-NCN \?CND31 SET 'P-NCN,1 ?CND31: GET P-ITBL,P-NC1 PUT P-OTBL,P-NC1,STACK GET P-ITBL,P-NC1L PUT P-OTBL,P-NC1L,STACK JUMP ?CND17 ?CCL27: GET P-OTBL,P-NC2 EQUAL? STACK,1 \?CCL38 GET P-ITBL,P-PREP1 >?TMP1 GET P-OTBL,P-PREP2 EQUAL? ?TMP1,FALSE-VALUE,STACK \FALSE ZERO? ADJ \?CCL43 ZERO? P-NCN \?CND42 ZERO? NOUN /?CND42 ?CCL43: ADD P-LEXV,2 PUT P-ITBL,P-NC1,STACK GET P-ITBL,P-NC1L ZERO? STACK \?CND42 ADD P-LEXV,6 PUT P-ITBL,P-NC1L,STACK ?CND42: GET P-ITBL,P-NC1 PUT P-OTBL,P-NC2,STACK GET P-ITBL,P-NC1L PUT P-OTBL,P-NC2L,STACK SET 'P-NCN,2 JUMP ?CND17 ?CCL38: ZERO? P-ACLAUSE /?CND17 EQUAL? P-NCN,1 /?CCL53 ZERO? ADJ \?CCL53 SET 'P-ACLAUSE,FALSE-VALUE RFALSE ?CCL53: GET P-ITBL,P-NC1 >BEG ZERO? ADJ /?CND56 ADD P-LEXV,2 >BEG PUT P-ITBL,P-NC1,BEG SET 'ADJ,FALSE-VALUE ?CND56: GET P-ITBL,P-NC1L >END ?PRG58: EQUAL? BEG,END \?CND60 ZERO? ADJB /?CCL64 CALL CLAUSE-WIN,ADJB,ADJE ?CND17: 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 ?PRG83: IGRTR? 'CNT,P-ITBLLEN \?CCL87 SET 'P-MERGED,TRUE-VALUE RTRUE ?CCL64: SET 'P-ACLAUSE,FALSE-VALUE RFALSE ?CND60: GET BEG,0 >WRD EQUAL? WRD,W?ALL,W?ONE /?CTR66 GETB WRD,P-PSOFF BTST STACK,32 \?CCL67 CALL ADJ-CHECK,WRD,ADJ,ADJ ZERO? STACK /?CCL67 ?CTR66: ZERO? ADJB \?CND72 SET 'ADJB,BEG ?CND72: SET 'ADJ,WRD ADD BEG,P-WORDLEN >ADJE JUMP ?CND65 ?CCL67: GETB WRD,P-PSOFF BTST STACK,128 \?CND65 ADD BEG,P-WORDLEN EQUAL? STACK,END \?CND65 ZERO? P-ANAM /?CND65 EQUAL? WRD,P-ANAM /?CND65 SET 'P-ANAM,FALSE-VALUE GET P-ITBL,P-NC1 >ADJB SET 'ADJE,END ?CND65: ADD BEG,P-WORDLEN >BEG ZERO? END \?PRG58 SET 'END,BEG SET 'P-NCN,1 SUB BEG,P-WORDLEN PUT P-ITBL,P-NC1,STACK PUT P-ITBL,P-NC1L,BEG JUMP ?PRG58 ?CCL87: GET P-OTBL,CNT PUT P-ITBL,CNT,STACK JUMP ?PRG83 .FUNCT CLAUSE-WIN,ADJB=0,ADJE=0 ZERO? ADJB /?CND1 GET P-OTBL,P-VERB PUT P-ITBL,P-VERB,STACK ?CND1: PUT P-CCTBL,CC-BEG,P-ACLAUSE ADD P-ACLAUSE,1 PUT P-CCTBL,CC-END,STACK PUT P-CCTBL,CC-IBEG,ADJB PUT P-CCTBL,CC-IEND,ADJE EQUAL? P-ACLAUSE,P-NC1 \?CCL5 PUT P-CCTBL,CC-CLAUSE,P-OCL1 JUMP ?CND3 ?CCL5: PUT P-CCTBL,CC-CLAUSE,P-OCL2 ?CND3: CALL CLAUSE-COPY,P-OTBL,P-OTBL GET P-OTBL,P-NC2 ZERO? STACK /?PEN6 SET 'P-NCN,2 ?PEN6: SET 'P-ACLAUSE,FALSE-VALUE RTRUE .FUNCT WORD-PRINT,CNT,BUF,TBL=0 ZERO? TBL \?PRG3 SET 'TBL,P-INBUF ?PRG3: DLESS? 'CNT,0 /TRUE GETB TBL,BUF PRINTC STACK INC 'BUF JUMP ?PRG3 .FUNCT UNKNOWN-WORD,PTR,BUF,?TMP1 PUT OOPS-TABLE,O-PTR,PTR ZERO? P-OFLAG /?PRG4 PUT OOPS-TABLE,O-END,0 ?PRG4: PRINTC 91 PRINTI "I don't know the word " PRINTC 34 MUL 2,PTR >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 PRINTR ".""]" .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 CALL MISSING,STR?30 RFALSE ?CND1: SUB 255,VERB GET VERBS,STACK >SYN GETB SYN,0 >LEN INC 'SYN ?PRG3: GETB SYN,P-SBITS BAND STACK,P-SONUMS >NUM GRTR? P-NCN,NUM /?CND5 LESS? NUM,1 /?CCL9 ZERO? P-NCN \?CCL9 GET P-ITBL,P-PREP1 >PREP ZERO? PREP /?CTR8 GETB SYN,P-SPREP1 EQUAL? PREP,STACK \?CCL9 ?CTR8: SET 'DRIVE1,SYN JUMP ?CND5 ?CCL9: GETB SYN,P-SPREP1 >?TMP1 GET P-ITBL,P-PREP1 EQUAL? ?TMP1,STACK \?CND5 EQUAL? NUM,2 \?CCL18 EQUAL? P-NCN,1 \?CCL18 SET 'DRIVE2,SYN ?CND5: DLESS? 'LEN,1 \?CCL24 ZERO? DRIVE1 \?REP4 ZERO? DRIVE2 \?REP4 CALL DONT-UNDERSTAND RFALSE ?CCL18: GETB SYN,P-SPREP2 >?TMP1 GET P-ITBL,P-PREP2 EQUAL? ?TMP1,STACK \?CND5 CALL SYNTAX-FOUND,SYN RTRUE ?CCL24: ADD SYN,P-SYNLEN >SYN JUMP ?PRG3 ?REP4: ZERO? DRIVE1 /?CCL32 GETB DRIVE1,P-SFWIM1 >?TMP2 GETB DRIVE1,P-SLOC1 >?TMP1 GETB DRIVE1,P-SPREP1 CALL GWIM,?TMP2,?TMP1,STACK >OBJ ZERO? OBJ /?CCL32 PUTB P-PRSO,P-MATCHLEN,1 PUTB P-PRSO,1,OBJ CALL SYNTAX-FOUND,DRIVE1 RSTACK ?CCL32: ZERO? DRIVE2 /?CCL36 GETB DRIVE2,P-SFWIM2 >?TMP2 GETB DRIVE2,P-SLOC2 >?TMP1 GETB DRIVE2,P-SPREP2 CALL GWIM,?TMP2,?TMP1,STACK >OBJ ZERO? OBJ /?CCL36 PUTB P-PRSI,P-MATCHLEN,1 PUTB P-PRSI,1,OBJ CALL SYNTAX-FOUND,DRIVE2 RSTACK ?CCL36: SET 'OBJ,FALSE-VALUE EQUAL? WINNER,PLAYER \?PRG46 EQUAL? P-PRSA-WORD,W?DRIVE,W?PROCEED,W?STEER /?PRG46 CALL ORPHAN,DRIVE1,DRIVE2 SET 'OBJ,TRUE-VALUE PRINTI "[Wh" JUMP ?CND39 ?PRG46: PRINTI "[Your command was not complete. Next time, type wh" ?CND39: EQUAL? VERB,ACT?HEAD \?CCL50 PRINTI "ere" JUMP ?CND48 ?CCL50: ZERO? DRIVE1 /?PRD56 GETB DRIVE1,P-SFWIM1 EQUAL? STACK,PERSONBIT /?PRG61 ?PRD56: ZERO? DRIVE2 /?PRG63 GETB DRIVE2,P-SFWIM2 EQUAL? STACK,PERSONBIT \?PRG63 ?PRG61: PRINTI "om" JUMP ?CND48 ?PRG63: PRINTI "at" ?CND48: ZERO? OBJ /?PRG70 PRINTI " do you want to " JUMP ?CND65 ?PRG70: PRINTI " you want" CALL HIM-HER-IT,WINNER PRINTI " to " ?CND65: CALL VERB-PRINT ZERO? DRIVE2 /?CND72 SET 'PREP,P-MERGED SET 'P-MERGED,FALSE-VALUE SET 'P-OFLAG,FALSE-VALUE CALL CLAUSE-PRINT,P-NC1,P-NC1L SET 'P-MERGED,PREP ?CND72: SET 'P-END-ON-PREP,FALSE-VALUE ZERO? DRIVE1 /?CCL76 GETB DRIVE1,P-SPREP1 JUMP ?CND74 ?CCL76: GETB DRIVE2,P-SPREP2 ?CND74: CALL PREP-PRINT,STACK ZERO? OBJ /?PRG82 SET 'P-OFLAG,TRUE-VALUE PRINTI "?]" CRLF RFALSE ?PRG82: PRINTI ".]" CRLF RFALSE .FUNCT DONT-UNDERSTAND SET 'CLOCK-WAIT,TRUE-VALUE PRINTR "[Sorry, but I don't understand. Please say that another way, or try something else.]" .FUNCT VERB-PRINT,GERUND=0,TMP,?TMP1 GET P-ITBL,P-VERBN >TMP ZERO? TMP \?CCL3 ZERO? GERUND \?PRG9 PRINTI "tell" RTRUE ?PRG9: PRINTI "walk" JUMP ?CND1 ?CCL3: ZERO? GERUND \?CTR11 GETB P-VTBL,2 ZERO? STACK \?CCL12 ?CTR11: GET TMP,0 >TMP EQUAL? TMP,W?L \?CCL17 PRINTB W?LOOK JUMP ?CND1 ?CCL17: EQUAL? TMP,W?X \?CCL19 PRINTB W?EXAMINE JUMP ?CND1 ?CCL19: EQUAL? TMP,W?Z \?CCL21 PRINTB W?WAIT JUMP ?CND1 ?CCL21: ZERO? GERUND /?CCL23 EQUAL? TMP,W?BATHE \?CCL26 PRINTB W?BATH JUMP ?CND1 ?CCL26: EQUAL? TMP,W?DIG \?CCL28 PRINTI "digg" JUMP ?CND1 ?CCL28: EQUAL? TMP,W?GET \?CCL30 PRINTI "gett" JUMP ?CND1 ?CCL30: PRINTB TMP JUMP ?CND1 ?CCL23: PRINTB TMP JUMP ?CND1 ?CCL12: GETB TMP,2 >?TMP1 GETB TMP,3 CALL WORD-PRINT,?TMP1,STACK PUTB P-VTBL,2,0 ?CND1: ZERO? GERUND /FALSE PRINTI "ing?" RTRUE .FUNCT ORPHAN,D1,D2,CNT=-1 ZERO? P-MERGED \?CND1 PUT P-OCL1,P-MATCHLEN,0 PUT P-OCL2,P-MATCHLEN,0 ?CND1: GET P-VTBL,0 PUT P-OVTBL,0,STACK GETB P-VTBL,2 PUTB P-OVTBL,2,STACK GETB P-VTBL,3 PUTB P-OVTBL,3,STACK ?PRG3: IGRTR? 'CNT,P-ITBLLEN /?REP4 GET P-ITBL,CNT PUT P-OTBL,CNT,STACK JUMP ?PRG3 ?REP4: EQUAL? P-NCN,2 \?CND8 PUT P-CCTBL,CC-BEG,P-NC2 PUT P-CCTBL,CC-END,P-NC2L PUT P-CCTBL,CC-CLAUSE,P-OCL2 PUT P-CCTBL,CC-IBEG,FALSE-VALUE PUT P-CCTBL,CC-IEND,FALSE-VALUE CALL CLAUSE-COPY,P-ITBL,P-OTBL ?CND8: LESS? P-NCN,1 /?CND10 PUT P-CCTBL,CC-BEG,P-NC1 PUT P-CCTBL,CC-END,P-NC1L PUT P-CCTBL,CC-CLAUSE,P-OCL1 PUT P-CCTBL,CC-IBEG,FALSE-VALUE PUT P-CCTBL,CC-IEND,FALSE-VALUE CALL CLAUSE-COPY,P-ITBL,P-OTBL ?CND10: ZERO? D1 /?CCL14 GETB D1,P-SPREP1 PUT P-OTBL,P-PREP1,STACK PUT P-OTBL,P-NC1,1 RTRUE ?CCL14: ZERO? D2 /FALSE GETB D2,P-SPREP2 PUT P-OTBL,P-PREP2,STACK PUT P-OTBL,P-NC2,1 RTRUE .FUNCT CLAUSE-PRINT,BPTR,EPTR,THE?=1,?TMP1 GET P-ITBL,BPTR >?TMP1 GET P-ITBL,EPTR CALL BUFFER-PRINT,?TMP1,STACK,THE? RSTACK .FUNCT BUFFER-PRINT,BEG,END,CP,NOSP=0,WRD,NW,FIRST??=1,PN=0,?TMP1 ?PRG1: EQUAL? BEG,END /TRUE ZERO? NOSP \?CTR6 EQUAL? WRD,W?APOSTROPHE /?CTR6 EQUAL? NW,W?PERIOD,W?COMMA,W?APOSTROPHE \?PRG11 ?CTR6: SET 'NOSP,FALSE-VALUE JUMP ?CND5 ?PRG11: PRINTC 32 ?CND5: GET BEG,0 >WRD ADD BEG,P-WORDLEN EQUAL? END,STACK \?CCL15 SET 'NW,0 JUMP ?CND13 ?CCL15: GET BEG,P-LEXELEN >NW ?CND13: EQUAL? WRD,W?MY /?CCL18 CALL ZMEMQ,WRD,CHAR-POSS-TABLE ZERO? STACK /?CCL18 SET 'NOSP,TRUE-VALUE JUMP ?CND16 ?CCL18: EQUAL? NW,W?MY /?CCL22 CALL ZMEMQ,NW,CHAR-POSS-TABLE ZERO? STACK /?CCL22 SET 'NOSP,TRUE-VALUE JUMP ?CND16 ?CCL22: ZERO? OOPS-PRINT /?CND16 EQUAL? WRD,W?HIM \?PRD29 CALL VISIBLE?,P-HIM-OBJECT ZERO? STACK /?CCL25 ?PRD29: EQUAL? WRD,W?HER \?CND16 CALL VISIBLE?,P-HER-OBJECT ZERO? STACK \?CND16 ?CCL25: SET 'PN,TRUE-VALUE ?CND16: EQUAL? WRD,W?MY \?CCL36 ZERO? OOPS-PRINT \?CCL39 PRINTB W?YOUR JUMP ?CND34 ?CCL39: PRINTB W?MY JUMP ?CND34 ?CCL36: CALL ZMEMQ,WRD,CHAR-POSS-TABLE ZERO? STACK /?CCL41 PRINTC 39 JUMP ?CND34 ?CCL41: ZERO? OOPS-PRINT \?CCL45 EQUAL? WRD,W?ALL,W?PERIOD,W?APOSTROPHE /?CCL45 CALL WT?,WRD,4 ZERO? STACK \?PRD49 CALL WT?,WRD,8 ZERO? STACK /?CCL45 ?PRD49: CALL WT?,WRD,32 ZERO? STACK \?CCL45 CALL WT?,WRD,128 ZERO? STACK \?CCL45 SET 'NOSP,TRUE-VALUE JUMP ?CND34 ?CCL45: EQUAL? WRD,W?ME \?CCL54 ZERO? OOPS-PRINT \?CCL54 PRINTD PLAYER SET 'PN,TRUE-VALUE JUMP ?CND34 ?CCL54: CALL CAPITAL-NOUN?,WRD ZERO? STACK /?CCL58 CALL CAPITALIZE,BEG SET 'PN,TRUE-VALUE JUMP ?CND34 ?CCL58: ZERO? FIRST?? /?CND59 ZERO? PN \?CND59 ZERO? CP /?CND59 EQUAL? WRD,W?HER,W?HIM,W?YOUR /?CND59 PRINTI "the " ?CND59: ZERO? P-OFLAG \?CTR69 ZERO? P-MERGED /?CCL70 ?CTR69: PRINTB WRD JUMP ?CND68 ?CCL70: EQUAL? WRD,W?IT \?CCL74 CALL VISIBLE?,P-IT-OBJECT ZERO? STACK /?CCL74 PRINTD P-IT-OBJECT JUMP ?CND68 ?CCL74: EQUAL? WRD,W?HER \?CCL78 ZERO? PN \?CCL78 PRINTD P-HER-OBJECT JUMP ?CND68 ?CCL78: EQUAL? WRD,W?HIM \?CCL82 ZERO? PN \?CCL82 PRINTD P-HIM-OBJECT JUMP ?CND68 ?CCL82: GETB BEG,2 >?TMP1 GETB BEG,3 CALL WORD-PRINT,?TMP1,STACK ?CND68: SET 'FIRST??,FALSE-VALUE ?CND34: ADD BEG,P-WORDLEN >BEG JUMP ?PRG1 .FUNCT TITLE-NOUN?,WRD EQUAL? WRD,W?MR,W?MRS,W?MS /TRUE EQUAL? WRD,W?MISTER,W?MISS,W?SIR /TRUE EQUAL? WRD,W?LADY,W?DAME,W?LORD /TRUE EQUAL? WRD,W?DR,W?DOCTOR,W?DETECT /TRUE EQUAL? WRD,W?MADAME,W?MADAM,W?MASTER /TRUE RFALSE .FUNCT CAPITAL-NOUN?,WRD,?TMP1 CALL TITLE-NOUN?,WRD >?TMP1 ZERO? ?TMP1 /?PRD3 RETURN ?TMP1 ?PRD3: EQUAL? WRD,W?BOLITHO,W?DEE /TRUE EQUAL? WRD,W?DEIRDRE,W?FORDYCE,W?HALLAM /TRUE EQUAL? WRD,W?HYDE,W?IAN,W?INDIAN /TRUE EQUAL? WRD,W?IRIS,W?JACK,W?LIONEL /TRUE EQUAL? WRD,W?LYND,W?MONTAGUE,W?MOONMIST /TRUE EQUAL? WRD,W?NICHOLAS,W?PENTREATH,W?TAMARA /TRUE EQUAL? WRD,W?TAMMY,W?TRESYLLIAN,W?VIV /TRUE EQUAL? WRD,W?VIVIEN,W?WENDISH /TRUE RFALSE .FUNCT CAPITALIZE,PTR,?TMP1 ZERO? P-OFLAG \?CTR2 ZERO? P-MERGED /?CCL3 ?CTR2: GET PTR,0 PRINTB STACK RTRUE ?CCL3: GETB PTR,3 GETB P-INBUF,STACK SUB STACK,32 PRINTC STACK GETB PTR,2 SUB STACK,1 >?TMP1 GETB PTR,3 ADD STACK,1 CALL WORD-PRINT,?TMP1,STACK RSTACK .FUNCT PREP-PRINT,PREP,SP?=1,WRD,VRB ZERO? PREP /FALSE GET P-ITBL,P-VERBN GET STACK,0 >VRB ZERO? P-END-ON-PREP /?CCL5 EQUAL? VRB,W?LIE,W?SIT \FALSE EQUAL? PREP,PR?DOWN \FALSE ?CCL5: ZERO? SP? /?CND10 PRINTC 32 ?CND10: CALL PREP-FIND,PREP >WRD EQUAL? WRD,W?AGAINST \?CCL16 PRINTI "against" JUMP ?CND14 ?CCL16: EQUAL? WRD,W?THROUGH \?CCL20 PRINTI "through" JUMP ?CND14 ?CCL20: PRINTB WRD ?CND14: EQUAL? VRB,W?SIT,W?LIE \?CND23 EQUAL? WRD,W?DOWN \?CND23 PRINTI " on" ?CND23: EQUAL? VRB,W?GET \TRUE EQUAL? WRD,W?OUT \TRUE PRINTI " of" RTRUE .FUNCT CLAUSE-COPY,SRC,DEST,IBEG=0,IEND,OCL,BEG,END,BB,EE,OBEG,CNT,B,E GET P-CCTBL,CC-BEG >BB GET P-CCTBL,CC-END >EE GET P-CCTBL,CC-CLAUSE >OCL GET P-CCTBL,CC-IBEG >IBEG GET P-CCTBL,CC-IEND >IEND GET SRC,BB >BEG GET SRC,EE >END GET OCL,P-MATCHLEN >OBEG ?PRG1: EQUAL? BEG,END \?CND3 ZERO? IBEG /?REP2 ZERO? P-ANAM \?REP2 CALL CLAUSE-SUBSTRUC,IBEG,IEND ?REP2: GRTR? OBEG,0 \?CND13 GET OCL,P-MATCHLEN SUB STACK,OBEG >CNT GRTR? CNT,0 \?CND13 PUT OCL,P-MATCHLEN,0 INC 'OBEG ?PRG17: GET OCL,OBEG CALL CLAUSE-ADD,STACK,TRUE-VALUE SUB CNT,2 >CNT ZERO? CNT /?REP18 ADD OBEG,2 >OBEG JUMP ?PRG17 ?CND3: ZERO? IBEG /?CND9 GET BEG,0 EQUAL? P-ANAM,STACK \?CND9 CALL CLAUSE-SUBSTRUC,IBEG,IEND ?CND9: GET BEG,0 CALL CLAUSE-ADD,STACK ADD BEG,P-WORDLEN >BEG JUMP ?PRG1 ?REP18: SET 'OBEG,0 ?CND13: MUL OBEG,P-LEXELEN ADD STACK,2 ADD OCL,STACK PUT DEST,BB,STACK GET OCL,P-MATCHLEN MUL STACK,P-LEXELEN ADD STACK,2 ADD OCL,STACK PUT DEST,EE,STACK RTRUE .FUNCT CLAUSE-SUBSTRUC,B,E ?PRG1: EQUAL? B,E /TRUE GET B,0 CALL CLAUSE-ADD,STACK ADD B,P-WORDLEN >B JUMP ?PRG1 .FUNCT CLAUSE-ADD,WRD,CHECK?=0,OCL,PTR GET P-CCTBL,CC-CLAUSE >OCL GET OCL,P-MATCHLEN >PTR ZERO? CHECK? /?CCL3 ZERO? PTR /?CCL3 CALL ZMEMQ,WRD,OCL ZERO? STACK \FALSE ?CCL3: ADD PTR,2 >PTR SUB PTR,1 PUT OCL,STACK,WRD PUT OCL,PTR,0 PUT OCL,P-MATCHLEN,PTR RTRUE .FUNCT PREP-FIND,PREP,CNT=0,SIZE GET PREPOSITIONS,0 MUL STACK,2 >SIZE ?PRG1: IGRTR? 'CNT,SIZE /FALSE GET PREPOSITIONS,CNT EQUAL? STACK,PREP \?PRG1 SUB CNT,1 GET PREPOSITIONS,STACK RSTACK .FUNCT SYNTAX-FOUND,SYN SET 'P-SYNTAX,SYN GETB SYN,P-SACTION >PRSA RETURN PRSA .FUNCT GWIM,GBIT,LBIT,PREP,OBJ EQUAL? GBIT,RMUNGBIT \?CND1 RETURN ROOMS ?CND1: SET 'P-GWIMBIT,GBIT SET 'P-SLOCBITS,LBIT PUTB P-MERGE,P-MATCHLEN,0 CALL GET-OBJECT,P-MERGE,FALSE-VALUE ZERO? STACK /?CCL5 SET 'P-GWIMBIT,0 GETB P-MERGE,P-MATCHLEN EQUAL? STACK,1 \FALSE GETB P-MERGE,1 >OBJ PRINTC 40 CALL PREP-PRINT,PREP,FALSE-VALUE ZERO? STACK /?PRG15 CALL THE?,OBJ PRINTC 32 ?PRG15: PRINTD OBJ PRINTC 41 CRLF RETURN OBJ ?CCL5: SET 'P-GWIMBIT,0 RFALSE .FUNCT SNARF-OBJECTS,PTR GET P-ITBL,P-NC1 >PTR ZERO? PTR /?CND1 SET 'P-PHR,0 GETB P-SYNTAX,P-SLOC1 >P-SLOCBITS GET P-ITBL,P-NC1L CALL SNARFEM,PTR,STACK,P-PRSO ZERO? STACK /FALSE GETB P-BUTS,P-MATCHLEN ZERO? STACK /?CND1 CALL BUT-MERGE,P-PRSO >P-PRSO ?CND1: GET P-ITBL,P-NC2 >PTR ZERO? PTR /TRUE SET 'P-PHR,1 GETB P-SYNTAX,P-SLOC2 >P-SLOCBITS GET P-ITBL,P-NC2L CALL SNARFEM,PTR,STACK,P-PRSI ZERO? STACK /FALSE GETB P-BUTS,P-MATCHLEN ZERO? STACK /TRUE GETB P-PRSI,P-MATCHLEN EQUAL? STACK,1 \?CCL15 CALL BUT-MERGE,P-PRSO >P-PRSO RTRUE ?CCL15: CALL BUT-MERGE,P-PRSI >P-PRSI RTRUE .FUNCT BUT-MERGE,TBL,LEN,BUTLEN,CNT=1,MATCHES=0,OBJ,NTBL GETB TBL,P-MATCHLEN >LEN PUTB P-MERGE,P-MATCHLEN,0 ?PRG1: DLESS? 'LEN,0 /?REP2 GETB TBL,CNT >OBJ CALL ZMEMQB,OBJ,P-BUTS ZERO? STACK \?CND3 INC 'MATCHES PUTB P-MERGE,MATCHES,OBJ ?CND3: INC 'CNT JUMP ?PRG1 ?REP2: PUTB P-MERGE,P-MATCHLEN,MATCHES SET 'NTBL,P-MERGE SET 'P-MERGE,TBL RETURN NTBL .FUNCT ADJ-CHECK,WRD,ADJ,NW=0 ZERO? ADJ /TRUE EQUAL? WRD,W?RHINO,W?BUFFALO /TRUE EQUAL? WRD,W?BLOND,W?BLONDE /TRUE EQUAL? WRD,W?FIRST,W?SECOND /TRUE EQUAL? NW,W?OUTFIT /TRUE CALL ZMEMQ,WRD,CHAR-POSS-TABLE ZERO? STACK \TRUE RFALSE .FUNCT SNARFEM,PTR,EPTR,TBL,BUT=0,LEN,WV,WRD,NW,WAS-ALL=0,ONEOBJ SET 'P-NAM,FALSE-VALUE SET 'P-ADJ,FALSE-VALUE SET 'P-ADJN,FALSE-VALUE SET 'P-AND,FALSE-VALUE EQUAL? P-GETFLAGS,P-ALL \?CND1 SET 'WAS-ALL,TRUE-VALUE ?CND1: SET 'P-GETFLAGS,0 PUTB P-BUTS,P-MATCHLEN,0 PUTB 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 PUTB 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,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 /?CCL52 CALL BUZZER-WORD?,WRD,PTR ZERO? STACK /?CND5 RFALSE ?CCL52: EQUAL? WRD,W?AND,W?COMMA /?CND5 EQUAL? WRD,W?OF \?CCL57 ZERO? P-GETFLAGS \?CND5 SET 'P-GETFLAGS,P-INHIBIT JUMP ?CND5 ?CCL57: CALL WT?,WRD,32,2 >WV ZERO? WV /?CCL61 CALL ADJ-CHECK,WRD,P-ADJ,NW ZERO? STACK /?CCL61 EQUAL? NW,W?OF /?CCL61 SET 'P-ADJ,WV SET 'P-ADJN,WRD JUMP ?CND5 ?CCL61: CALL WT?,WRD,128 ZERO? STACK /?CND5 SET 'P-NAM,WRD SET 'ONEOBJ,WRD ?CND5: EQUAL? PTR,EPTR /?PRG3 ADD PTR,P-WORDLEN >PTR SET 'WRD,NW JUMP ?PRG3 .FUNCT RESOLVE-YOUR-HER-HIS,OBJ=0 EQUAL? P-ADJN,W?YOUR \?CCL3 EQUAL? WINNER,PLAYER /?CND1 SET 'OBJ,WINNER JUMP ?CND1 ?CCL3: EQUAL? P-ADJN,W?HER \?CCL7 SET 'OBJ,P-HER-OBJECT JUMP ?CND1 ?CCL7: EQUAL? P-ADJN,W?HIS \?CND1 SET 'OBJ,P-HIM-OBJECT ?CND1: ZERO? OBJ /FALSE GETP OBJ,P?CHARACTER ADD 1,STACK GET CHAR-POSS-TABLE,STACK >P-ADJN CALL WT?,P-ADJN,32,2 >P-ADJ RETURN P-ADJ .FUNCT GET-OBJECT,TBL,VRB=1,BTS,LEN,XBITS,TLEN,GCHECK=0,OLEN=0,OBJ=0,ADJ=0 SET 'XBITS,P-SLOCBITS GETB TBL,P-MATCHLEN >TLEN BTST P-GETFLAGS,P-INHIBIT /TRUE EQUAL? P-ADJN,W?YOUR,W?HER,W?HIS \?CND3 ZERO? P-NAM /?CND3 CALL RESOLVE-YOUR-HER-HIS ?CND3: SET 'ADJ,P-ADJN ZERO? P-NAM \?CND7 ZERO? P-ADJ /?CND7 CALL WT?,P-ADJN,128 ZERO? STACK /?CCL13 SET 'P-NAM,P-ADJN SET 'P-ADJ,FALSE-VALUE SET 'P-ADJN,FALSE-VALUE ?CND7: ZERO? P-NAM \?CND15 ZERO? P-ADJ \?CND15 EQUAL? P-GETFLAGS,P-ALL /?CND15 ZERO? P-GWIMBIT \?CND15 ZERO? VRB /FALSE CALL MISSING,STR?31,ADJ RFALSE ?CCL13: CALL WT?,P-ADJN,16,3 >BTS ZERO? BTS /?CND7 SET 'P-ADJ,FALSE-VALUE SET 'P-ADJN,FALSE-VALUE PUTB TBL,P-MATCHLEN,1 PUTB TBL,1,INTDIR SET 'P-DIRECTION,BTS RTRUE ?CND15: EQUAL? P-GETFLAGS,P-ALL \?CCL24 ZERO? P-SLOCBITS \?CND23 ?CCL24: SET 'P-SLOCBITS,-1 ?CND23: SET 'P-TABLE,TBL ?PRG27: ZERO? GCHECK /?CCL31 CALL GLOBAL-CHECK,TBL JUMP ?CND29 ?CCL31: ZERO? LIT /?CND32 FCLEAR WINNER,OPENBIT CALL DO-SL,HERE,SOG,SIR FSET WINNER,OPENBIT ?CND32: CALL DO-SL,WINNER,SH,SC ?CND29: GETB TBL,P-MATCHLEN SUB STACK,TLEN >LEN BTST P-GETFLAGS,P-ALL /?CND34 BTST P-GETFLAGS,P-ONE \?CCL37 ZERO? LEN /?CCL37 EQUAL? LEN,1 /?CND40 RANDOM LEN GETB TBL,STACK PUTB TBL,1,STACK GETB TBL,1 CALL TELL-I-ASSUME,STACK ?CND40: PUTB TBL,P-MATCHLEN,1 JUMP ?CND34 ?CCL37: EQUAL? P-GETFLAGS,P-ALL /?CND34 GRTR? LEN,1 /?CCL42 ZERO? LEN \?CND34 EQUAL? P-SLOCBITS,-1 /?CND34 ?CCL42: EQUAL? P-SLOCBITS,-1 \?CCL51 SET 'P-SLOCBITS,XBITS SET 'OLEN,LEN GETB TBL,P-MATCHLEN SUB STACK,LEN PUTB TBL,P-MATCHLEN,STACK JUMP ?PRG27 ?CCL51: CALL PUT-ADJ-NAM ZERO? LEN \?CND52 SET 'LEN,OLEN ?CND52: GRTR? LEN,1 \?CCL56 GETB TBL,LEN >OBJ ZERO? OBJ /?CCL56 GETP OBJ,P?GENERIC CALL STACK,TBL,LEN >OBJ ZERO? OBJ /?CCL56 EQUAL? OBJ,NOT-HERE-OBJECT /FALSE EQUAL? OBJ,ROOMS \?CCL64 GETB TBL,P-MATCHLEN >LEN JUMP ?CND54 ?CCL64: ADD TLEN,1 >LEN PUTB TBL,P-MATCHLEN,LEN PUTB TBL,LEN,OBJ SET 'P-NAM,FALSE-VALUE SET 'P-ADJ,FALSE-VALUE SET 'P-ADJN,FALSE-VALUE RTRUE ?CCL56: ZERO? VRB /?CND54 EQUAL? WINNER,PLAYER /?CND54 CALL MORE-SPECIFIC RFALSE ?CND54: ZERO? VRB /?CCL70 ZERO? P-NAM /?CCL70 CALL WHICH-PRINT,TLEN,LEN,TBL ZERO? STACK /?CND68 EQUAL? TBL,P-PRSO \?CCL78 SET 'P-ACLAUSE,P-NC1 JUMP ?CND76 ?CCL78: SET 'P-ACLAUSE,P-NC2 ?CND76: SET 'P-AADJ,P-ADJ SET 'P-ANAM,P-NAM CALL ORPHAN,FALSE-VALUE,FALSE-VALUE SET 'P-OFLAG,TRUE-VALUE JUMP ?CND68 ?CCL70: ZERO? VRB /?CND68 CALL MISSING,STR?31,ADJ ?CND68: SET 'P-NAM,FALSE-VALUE SET 'P-ADJ,FALSE-VALUE SET 'P-ADJN,FALSE-VALUE RFALSE ?CND34: ZERO? LEN \?CCL82 ZERO? GCHECK /?CCL82 CALL PUT-ADJ-NAM ZERO? VRB /?CND85 SET 'P-SLOCBITS,XBITS ZERO? LIT \?CTR88 CALL SEE-VERB? ZERO? STACK \?CCL89 ?CTR88: CALL OBJ-FOUND,NOT-HERE-OBJECT,TBL SET 'P-XNAM,P-NAM SET 'P-NAM,FALSE-VALUE SET 'P-XADJ,P-ADJ SET 'P-XADJN,P-ADJN RTRUE ?CCL89: CALL TOO-DARK ?CND85: SET 'P-NAM,FALSE-VALUE SET 'P-ADJ,FALSE-VALUE SET 'P-ADJN,FALSE-VALUE RFALSE ?CCL82: ZERO? LEN \?CND80 SET 'GCHECK,TRUE-VALUE JUMP ?PRG27 ?CND80: ZERO? P-ADJ /?CND93 ZERO? P-NAM \?CND93 ADD TLEN,1 GETB TBL,STACK >OBJ CALL TELL-I-ASSUME,OBJ CALL THIS-IS-IT,OBJ ?CND93: SET 'P-SLOCBITS,XBITS CALL PUT-ADJ-NAM SET 'P-NAM,FALSE-VALUE SET 'P-ADJ,FALSE-VALUE SET 'P-ADJN,FALSE-VALUE RTRUE .FUNCT GENERIC-CLUE-FCN,TBL,LEN=0 EQUAL? PRSA,V?SEARCH-FOR,V?FIND \?CCL3 RETURN GENERIC-CLUE ?CCL3: ZERO? LEN \?CND4 GETB TBL,0 >LEN ?CND4: CALL PRUNE,TBL,LEN,CLUE-TEST >LEN EQUAL? LEN,1 /?CTR7 RETURN ROOMS ?CTR7: GETB TBL,1 RSTACK .FUNCT CLUE-TEST,OBJ IN? OBJ,WINNER /TRUE ZERO? PRSI /?CCL6 IN? OBJ,PRSI /TRUE ?CCL6: EQUAL? OBJ,P-IT-OBJECT /TRUE RFALSE .FUNCT GENERIC-STAIRS,X,Y EQUAL? PRSA,V?CLIMB-UP,V?CLIMB-DOWN,V?BOARD \?CCL3 RETURN STAIRS ?CCL3: RETURN BACKSTAIRS .FUNCT GENERIC-CLOTHES,X,Y EQUAL? PRSA,V?TAKE-OFF,V?REMOVE,V?CHANGE \FALSE RETURN NOW-WEARING .FUNCT GENERIC-CLOSET,TBL,LEN=0,N CALL ZMEMQ,HERE,CHAR-ROOM-TABLE,CHARACTER-MAX >N ZERO? N /?CCL3 GET CHAR-CLOSET-TABLE,N RSTACK ?CCL3: ZERO? TBL /FALSE CALL ZMEMQB,HERE,TBL ZERO? STACK /?CND5 RETURN HERE ?CND5: ZERO? LEN \?CND7 GETB TBL,0 >LEN ?CND7: CALL PRUNE,TBL,LEN,NOT-SECRET-TEST >LEN ZERO? LEN \?CCL11 PRINTI "(You haven't found a secret entrance yet!)" CRLF RETURN NOT-HERE-OBJECT ?CCL11: EQUAL? LEN,1 /?CTR14 RETURN ROOMS ?CTR14: GETB TBL,1 RSTACK .FUNCT GENERIC-DINNER,X,Y CALL REMOTE-VERB? ZERO? STACK \?CTR2 EQUAL? PRSA,V?EXAMINE \?CCL3 ?CTR2: RETURN DINNER ?CCL3: EQUAL? P-ADJ,FALSE-VALUE,A?MY \?CCL7 EQUAL? P-XADJ,FALSE-VALUE,A?MY \?CCL7 RETURN DINNER ?CCL7: SET 'CLOCK-WAIT,TRUE-VALUE PRINTI "(That wouldn't be polite!)" CRLF RETURN NOT-HERE-OBJECT .FUNCT GENERIC-BEDROOM,TBL,N=0,RM ZERO? N \?CND1 GETB TBL,P-MATCHLEN >N ?CND1: CALL ZMEMQ,HERE,CHAR-CLOSET-TABLE >RM ZERO? RM /?CCL5 EQUAL? W?DOOR,P-NAM,P-XNAM \?CCL8 CALL FIND-FLAG-LG,HERE,DOORBIT RSTACK ?CCL8: GET CHAR-ROOM-TABLE,RM RSTACK ?CCL5: EQUAL? A?JACK'S,P-ADJ,P-XADJ \?CCL10 EQUAL? W?DOOR,P-NAM,P-XNAM \?CCL10 RETURN JACK-ROOM ?CCL10: CALL ZMEMQB,P-IT-OBJECT,TBL ZERO? STACK /?CCL14 RETURN P-IT-OBJECT ?CCL14: CALL ZMEMQB,HERE,TBL ZERO? STACK /?CCL16 RETURN HERE ?CCL16: CALL REMOTE-VERB? ZERO? STACK /?CCL18 EQUAL? A?BATH,P-ADJ,P-XADJ \?CCL21 RETURN YOUR-BATHROOM ?CCL21: EQUAL? W?ROOM,P-NAM,P-XNAM \?CCL23 RETURN YOUR-ROOM ?CCL23: SET 'RM,FALSE-VALUE JUMP ?CND3 ?CCL18: EQUAL? HERE,GALLERY,YOUR-BATHROOM \?CCL25 RETURN YOUR-ROOM ?CCL25: CALL ZMEMQ,HERE,CHAR-ROOM-TABLE ZERO? STACK /?CCL27 RETURN HERE ?CCL27: EQUAL? PRSA,V?WALK-TO,V?CLIMB-UP,V?CLIMB-DOWN \?PRG30 RETURN YOUR-ROOM ?PRG30: GETB TBL,N >RM GETP RM,P?STATION EQUAL? HERE,STACK /?CND3 DLESS? 'N,1 \?PRG30 SET 'RM,FALSE-VALUE ?CND3: ZERO? RM /?CCL38 RETURN RM ?CCL38: EQUAL? WINNER,FRIEND,LORD \FALSE RETURN YOUR-ROOM .FUNCT GENERIC-GREAT-HALL,X,Y EQUAL? W?ROOM,P-NAM,P-XNAM \?CCL3 RETURN HERE ?CCL3: FSET? HERE,WEARBIT \?CCL5 RETURN GREAT-HALL ?CCL5: RETURN OLD-GREAT-HALL .FUNCT GENERIC-LENS,X,Y CALL REMOTE-VERB? ZERO? STACK /?CCL3 RETURN LENS ?CCL3: FSET? LENS-2,SEENBIT /FALSE RETURN LENS-1 .FUNCT GENERIC-RECORDER,X,Y FSET? JACK-TAPE,SEENBIT /FALSE RETURN RECORDER .FUNCT GENERIC-BOX,X,Y FSET? LENS-BOX,SECRETBIT \FALSE RETURN VIVIEN-BOX .FUNCT GENERIC-BOOK,X,Y EQUAL? HERE,LIBRARY \FALSE RETURN BOOKS-GLOBAL .FUNCT GENERIC-WELL,X,Y EQUAL? HERE,BASEMENT /FALSE RETURN WELL .FUNCT GENERIC-SKELETON,X,Y FSET? SKELETON,SEENBIT \FALSE RETURN SKELETON .FUNCT GENERIC-ROOM,X,Y RETURN GLOBAL-HERE .FUNCT GENERIC-EYE,X,Y EQUAL? W?EYE,P-NAM,P-XNAM \FALSE RETURN GLASS-EYE .FUNCT GENERIC-BELL,X,Y CALL REMOTE-VERB? ZERO? STACK /FALSE RETURN BELL .FUNCT GENERIC-WINE,X,Y EQUAL? PRSA,V?TAKE \FALSE RETURN BOTTLE .FUNCT SPEAKING-VERB?,PER=0 EQUAL? PRSA,V?$CALL /?CTR2 EQUAL? PRSA,V?YES,V?TELL-ABOUT,V?TELL /?CTR2 EQUAL? PRSA,V?SORRY,V?REPLY,V?NO /?CTR2 EQUAL? PRSA,V?HELLO,V?FORGIVE,V?ASK-FOR /?CTR2 EQUAL? PRSA,V?ASK-ABOUT,V?ASK,V?ANSWER \?CCL3 ?CTR2: EQUAL? PER,0,PRSO /TRUE RFALSE ?CCL3: EQUAL? PRSA,V?TALK-ABOUT,V?ASK-CONTEXT-FOR,V?ASK-CONTEXT-ABOUT \FALSE ZERO? PER /TRUE RFALSE .FUNCT MISSING,NV,ADJ PRINTI "[I think there's a " PRINT NV PRINTR " missing in that sentence!]" .FUNCT WHICH-PRINT,TLEN,LEN,TBL,OBJ,RLEN ZERO? LEN \?CND1 CALL MORE-SPECIFIC RFALSE ?CND1: SET 'RLEN,LEN EQUAL? WINNER,PLAYER /?PRG17 PRINTI """I don't understand " EQUAL? P-NAM,W?DOOR \?PRG13 PRINTI "which door" JUMP ?PRG15 ?PRG13: PRINTI "if" ?PRG15: PRINTI " you mean" JUMP ?CND3 ?PRG17: PRINTI "[Which" ZERO? P-OFLAG \?CTR20 ZERO? P-MERGED \?CTR20 ZERO? P-AND /?CCL21 ?CTR20: ZERO? P-NAM /?PRG31 PRINTC 32 PRINTB P-NAM JUMP ?PRG31 ?CCL21: EQUAL? TBL,P-PRSO \?CCL30 CALL CLAUSE-PRINT,P-NC1,P-NC1L,FALSE-VALUE JUMP ?PRG31 ?CCL30: CALL CLAUSE-PRINT,P-NC2,P-NC2L,FALSE-VALUE ?PRG31: PRINTI " do you mean" EQUAL? P-NAM,W?DOOR /?CND3 PRINTC 44 ?CND3: EQUAL? P-NAM,W?DOOR /?CND37 ?PRG39: INC 'TLEN GETB TBL,TLEN >OBJ CALL PRINTT,OBJ EQUAL? LEN,2 \?CCL45 EQUAL? RLEN,2 /?PRG50 PRINTC 44 ?PRG50: PRINTI " or" JUMP ?CND43 ?CCL45: GRTR? LEN,2 \?CND43 PRINTC 44 ?CND43: DLESS? 'LEN,1 \?PRG39 ?CND37: EQUAL? WINNER,PLAYER /?PRG62 PRINTR ".""" ?PRG62: PRINTR "?]" .FUNCT GLOBAL-SEARCH,TBL,RMG,CNT,OBJ PTSIZE RMG SUB STACK,1 >CNT ?PRG1: GETB RMG,CNT >OBJ CALL THIS-IT?,OBJ ZERO? STACK /?CND3 CALL OBJ-FOUND,OBJ,TBL ?CND3: DLESS? 'CNT,0 \?PRG1 RTRUE .FUNCT GLOBAL-CHECK,TBL,LEN,RMG,RMGL,CNT=0,OBITS,FOO GETB TBL,P-MATCHLEN >LEN SET 'OBITS,P-SLOCBITS GETPT HERE,P?GLOBAL >RMG ZERO? RMG /?CND1 CALL GLOBAL-SEARCH,TBL,RMG ?CND1: EQUAL? P-NAM,W?DOOR /?CND3 CALL THIS-IT?,HERE ZERO? STACK /?CND5 CALL ZMEMQB,HERE,TBL ZERO? STACK \?CND5 CALL OBJ-FOUND,HERE,TBL ?CND5: EQUAL? PRSA,V?THROUGH,V?LOOK-INSIDE,V?EXAMINE /?CCL10 EQUAL? PRSA,V?CLIMB-UP,V?CLIMB-DOWN,V?BOARD \?CND3 ?CCL10: CALL ROOM-SEARCH,TBL ?CND3: GETP HERE,P?THINGS >RMG ZERO? RMG /?CND13 GET RMG,0 >RMGL SET 'CNT,0 ?PRG15: ADD CNT,1 GET RMG,STACK EQUAL? P-NAM,STACK \?CND17 ZERO? P-ADJ /?CCL18 ADD CNT,2 GET RMG,STACK EQUAL? P-ADJN,STACK \?CND17 ?CCL18: SET 'LAST-PSEUDO-LOC,HERE ADD CNT,3 GET RMG,STACK PUTP PSEUDO-OBJECT,P?ACTION,STACK GETPT PSEUDO-OBJECT,P?ACTION SUB STACK,5 >FOO GET P-NAM,0 PUT FOO,0,STACK GET P-NAM,1 PUT FOO,1,STACK CALL OBJ-FOUND,PSEUDO-OBJECT,TBL JUMP ?CND13 ?CND17: ADD CNT,3 >CNT LESS? CNT,RMGL /?PRG15 ?CND13: GETB 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 GETB TBL,P-MATCHLEN ZERO? STACK \FALSE EQUAL? PRSA,V?WALK-TO,V?THROUGH /?CCL33 EQUAL? PRSA,V?TAKE-TO,V?SSHOW,V?SHOW /?CCL33 EQUAL? PRSA,V?FIND,V?CLIMB-UP,V?CLIMB-DOWN \FALSE ?CCL33: CALL SEARCH-LIST,ROOMS,P-TABLE,P-SRCTOP RSTACK .FUNCT DO-SL,OBJ,BIT1,BIT2,BITS 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 FIRST? OBJ >OBJ \FALSE ?PRG4: EQUAL? LVL,P-SRCBOT /?CND6 CALL THIS-IT?,OBJ ZERO? STACK /?CND6 CALL OBJ-FOUND,OBJ,TBL ?CND6: ZERO? LVL \?PRD13 FSET? OBJ,SEARCHBIT /?PRD13 FSET? OBJ,SURFACEBIT \?CND10 ?PRD13: FIRST? OBJ \?CND10 FSET? OBJ,OPENBIT /?CCL11 FSET? OBJ,TRANSBIT /?CCL11 ZERO? P-MOBY-FLAG \?CCL11 FSET? OBJ,PERSONBIT \?CND10 EQUAL? OBJ,WINNER /?CND10 ?CCL11: FSET? OBJ,SURFACEBIT \?CCL26 PUSH P-SRCALL JUMP ?CND24 ?CCL26: FSET? OBJ,SEARCHBIT \?CCL28 PUSH P-SRCALL JUMP ?CND24 ?CCL28: PUSH P-SRCTOP ?CND24: CALL SEARCH-LIST,OBJ,TBL,STACK ?CND10: NEXT? OBJ >OBJ /?PRG4 RTRUE .FUNCT ROOM-SEARCH,TTBL,P=0,L,TBL,O CALL CORRIDOR-LOOK,ROOMS >O ZERO? O /?PRG3 CALL OBJ-FOUND,O,TTBL ?PRG3: NEXTP HERE,P >P ZERO? P /FALSE LESS? P,LOW-DIRECTION /FALSE GETPT HERE,P >TBL PTSIZE TBL >L GETB TBL,REXIT >O CALL ZMEMQB,O,TTBL ZERO? STACK \?PRG3 EQUAL? L,UEXIT \?CCL13 CALL THIS-IT?,O ZERO? STACK /?PRG3 CALL OBJ-FOUND,O,TTBL JUMP ?PRG3 ?CCL13: EQUAL? L,DEXIT \?CCL17 GETB TBL,DEXITOBJ FSET? STACK,OPENBIT \?PRG3 CALL THIS-IT?,O ZERO? STACK /?PRG3 CALL OBJ-FOUND,O,TTBL JUMP ?PRG3 ?CCL17: EQUAL? L,CEXIT \?PRG3 GETB TBL,CEXITFLAG VALUE STACK ZERO? STACK /?PRG3 CALL THIS-IT?,O ZERO? STACK /?PRG3 CALL OBJ-FOUND,O,TTBL JUMP ?PRG3 .FUNCT THIS-IT?,OBJ,SYNS FSET? OBJ,INVISIBLE /FALSE ZERO? P-NAM /?CCL5 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 ?CCL5: ZERO? P-ADJ /?CCL11 GETPT OBJ,P?ADJECTIVE >SYNS ZERO? SYNS /FALSE PTSIZE SYNS SUB STACK,1 CALL ZMEMQB,P-ADJ,SYNS,STACK ZERO? STACK /FALSE ?CCL11: ZERO? P-GWIMBIT /TRUE FSET? OBJ,P-GWIMBIT /TRUE RFALSE .FUNCT OBJ-FOUND,OBJ,TBL,PTR EQUAL? OBJ,NOT-HERE-OBJECT /?CND1 CALL ZMEMQB,OBJ,TBL ZERO? STACK \FALSE ?CND1: GETB TBL,P-MATCHLEN >PTR INC 'PTR PUTB TBL,PTR,OBJ PUTB TBL,P-MATCHLEN,PTR 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 GETB TBL,P-MATCHLEN >PTR ZERO? PTR /TRUE BTST BITS,SHAVE /?PRG8 BTST BITS,STAKE \TRUE ?PRG8: DLESS? 'PTR,0 /TRUE ADD PTR,1 GETB TBL,STACK >OBJ EQUAL? OBJ,IT \?CCL14 CALL ACCESSIBLE?,P-IT-OBJECT ZERO? STACK \?CCL17 CALL MORE-SPECIFIC RFALSE ?CCL17: SET 'OBJ,P-IT-OBJECT JUMP ?CND12 ?CCL14: EQUAL? OBJ,HER \?CCL19 CALL ACCESSIBLE?,P-HER-OBJECT ZERO? STACK \?CCL22 CALL MORE-SPECIFIC RFALSE ?CCL22: SET 'OBJ,P-HER-OBJECT JUMP ?CND12 ?CCL19: EQUAL? OBJ,HIM \?CND12 CALL ACCESSIBLE?,P-HIM-OBJECT ZERO? STACK \?CCL26 CALL MORE-SPECIFIC RFALSE ?CCL26: SET 'OBJ,P-HIM-OBJECT ?CND12: CALL HELD?,OBJ,WINNER ZERO? STACK \?PRG8 EQUAL? OBJ,HANDS,ROOMS /?PRG8 SET 'PRSO,OBJ FSET? OBJ,TRYTAKEBIT \?CCL33 SET 'TAKEN,TRUE-VALUE JUMP ?CND31 ?CCL33: EQUAL? WINNER,PLAYER /?CCL35 SET 'TAKEN,FALSE-VALUE JUMP ?CND31 ?CCL35: BTST BITS,STAKE \?CCL37 CALL ITAKE,FALSE-VALUE EQUAL? STACK,TRUE-VALUE \?CCL37 SET 'TAKEN,FALSE-VALUE JUMP ?CND31 ?CCL37: SET 'TAKEN,TRUE-VALUE ?CND31: ZERO? TAKEN /?PRG8 BTST BITS,SHAVE \?PRG8 PRINTC 40 CALL HE-SHE-IT,WINNER,TRUE-VALUE,STR?1 PRINTI "n't holding" GETB TBL,P-MATCHLEN LESS? 1,STACK \?CCL50 PRINTI " those things" JUMP ?PRG59 ?CCL50: EQUAL? OBJ,NOT-HERE-OBJECT \?PRG57 PRINTI " that" JUMP ?PRG59 ?PRG57: CALL PRINTT,OBJ CALL THIS-IS-IT,OBJ ?PRG59: PRINTI "!)" CRLF RFALSE .FUNCT MANY-CHECK,LOSS=0,TMP,?TMP1 GETB P-PRSO,P-MATCHLEN GRTR? STACK,1 \?CCL3 GETB P-SYNTAX,P-SLOC1 BTST STACK,SMANY /?CCL3 SET 'LOSS,1 JUMP ?CND1 ?CCL3: GETB 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 \?PRG19 PRINTI "in" ?PRG19: PRINTI "direct object with """ GET P-ITBL,P-VERBN >TMP ZERO? TMP \?CCL23 PRINTI "tell" JUMP ?PRG30 ?CCL23: ZERO? P-OFLAG \?CTR26 ZERO? P-MERGED /?CCL27 ?CTR26: GET TMP,0 PRINTB STACK JUMP ?PRG30 ?CCL27: GETB TMP,2 >?TMP1 GETB TMP,3 CALL WORD-PRINT,?TMP1,STACK ?PRG30: PRINTI """!]" CRLF RFALSE .FUNCT ZMEMQ,ITM,TBL,SIZE=-1,CNT=1 ZERO? TBL /FALSE LESS? SIZE,0 /?CCL5 SET 'CNT,0 JUMP ?PRG8 ?CCL5: GET TBL,0 >SIZE GRTR? SIZE,0 \FALSE ?PRG8: GET TBL,CNT EQUAL? ITM,STACK \?CCL12 ZERO? CNT /TRUE RETURN CNT ?CCL12: IGRTR? 'CNT,SIZE \?PRG8 RFALSE .FUNCT ZMEMQB,ITM,TBL,SIZE=-1,CNT=1 ZERO? TBL /FALSE LESS? SIZE,0 /?CCL5 SET 'CNT,0 JUMP ?PRG8 ?CCL5: GETB TBL,0 >SIZE GRTR? SIZE,0 \FALSE ?PRG8: GETB TBL,CNT EQUAL? ITM,STACK \?CCL12 ZERO? CNT /TRUE RETURN CNT ?CCL12: IGRTR? 'CNT,SIZE \?PRG8 RFALSE .FUNCT LIT?,RM=0,RMBIT=0,OHERE,LIT=0,P=0,TBL,L ZERO? RM \?CND1 SET 'RM,HERE ?CND1: ZERO? RMBIT /?CND3 FSET? RM,ONBIT \FALSE RETURN RM ?CND3: FSET? RM,ONBIT \?CCL10 SET 'LIT,RM JUMP ?CND8 ?CCL10: SET 'P-GWIMBIT,ONBIT SET 'OHERE,HERE SET 'HERE,RM PUTB P-MERGE,P-MATCHLEN,0 SET 'P-TABLE,P-MERGE SET 'P-SLOCBITS,-1 CALL SEARCH-LIST,RM,P-TABLE,P-SRCALL GETB P-MERGE,P-MATCHLEN ZERO? STACK /?CND11 GETB P-MERGE,1 >LIT ?CND11: SET 'HERE,OHERE SET 'P-GWIMBIT,0 ?CND8: ZERO? LIT /?CCL15 RETURN LIT ?CCL15: EQUAL? RM,GALLERY-CORNER \?PRG20 FSET? GALLERY,ONBIT \?PRG20 RETURN GALLERY ?PRG20: NEXTP RM,P >P ZERO? P /FALSE EQUAL? P,P?UP,P?DOWN /?PRG20 LESS? P,LOW-DIRECTION /?PRG20 GETPT RM,P >TBL PTSIZE TBL >L GETB TBL,REXIT >OHERE EQUAL? L,UEXIT \?CCL30 CALL LIT?,OHERE,TRUE-VALUE ZERO? STACK /?CCL30 RETURN OHERE ?CCL30: EQUAL? L,DEXIT \?CCL34 GETB TBL,DEXITOBJ FSET? STACK,OPENBIT \?CCL34 CALL LIT?,OHERE,TRUE-VALUE ZERO? STACK /?CCL34 RETURN OHERE ?CCL34: EQUAL? L,CEXIT \?PRG20 GETB TBL,CEXITFLAG VALUE STACK ZERO? STACK /?PRG20 CALL LIT?,OHERE,TRUE-VALUE ZERO? STACK /?PRG20 RETURN OHERE .FUNCT NOT-HERE,OBJ,CLOCK=0 ZERO? CLOCK \?PRG5 SET 'CLOCK-WAIT,TRUE-VALUE PRINTC 40 ?PRG5: CALL START-SENTENCE,OBJ PRINTI " isn't " CALL VISIBLE?,OBJ ZERO? STACK /?PRG18 PRINTI "close enough" CALL SPEAKING-VERB? ZERO? STACK /?PRG16 PRINTI " to hear you" ?PRG16: PRINTC 46 JUMP ?CND7 ?PRG18: PRINTI "here!" ?CND7: CALL THIS-IS-IT,OBJ ZERO? CLOCK \?CND20 PRINTC 41 ?CND20: CRLF RTRUE .FUNCT PUT-ADJ-NAM EQUAL? P-NAM,W?IT,W?HIM,W?HER /FALSE PUT P-NAMW,P-PHR,P-NAM PUT P-ADJW,P-PHR,P-ADJN RTRUE .FUNCT NOUN-USED?,WORD1,WORD2=1,WORD3=1 ZERO? NOW-PRSI \?CCL3 GET P-NAMW,0 EQUAL? STACK,WORD1,WORD2,WORD3 /TRUE GET P-OFW,0 EQUAL? STACK,WORD1,WORD2,WORD3 /TRUE RFALSE ?CCL3: GET P-NAMW,1 EQUAL? STACK,WORD1,WORD2,WORD3 /TRUE GET P-OFW,1 EQUAL? STACK,WORD1,WORD2,WORD3 /TRUE RFALSE .FUNCT ADJ-USED?,WORD1=1,WORD2=1,WORD3=1 ZERO? NOW-PRSI \?CCL3 EQUAL? WORD1,1 \?CCL6 GET P-ADJW,0 RSTACK ?CCL6: GET P-ADJW,0 EQUAL? STACK,WORD1,WORD2,WORD3 /TRUE RFALSE ?CCL3: EQUAL? WORD1,1 \?CCL11 GET P-ADJW,1 RSTACK ?CCL11: GET P-ADJW,1 EQUAL? STACK,WORD1,WORD2,WORD3 /TRUE RFALSE .ENDI