.SEGMENT "0" .FUNCT SPECIAL-CONTRACTION?:ANY:1:1,PTR GET PTR,0 EQUAL? STACK,W?FO \?CCL3 GET PTR,P-LEXELEN EQUAL? STACK,W?APOSTROPHE \?CCL3 GET PTR,4 EQUAL? STACK,W?C \?CCL3 RETURN W?FOC ?CCL3: GET PTR,0 EQUAL? STACK,W?FOC \FALSE GET PTR,P-LEXELEN EQUAL? STACK,W?APOSTROPHE \FALSE GET PTR,4 EQUAL? STACK,W?SLE \FALSE RETURN W?FOCSLE .FUNCT EXPAND-BE-CONTRACTIONS:ANY:0:0,LEN,PTR,OPTR,N,WD,SPWD,L,?TMP1 GETB P-LEXV,P-LEXWORDS >LEN SET 'PTR,P-LEXV+2 SET 'OPTR,PTR SET 'L,LEN ?PRG1: SET 'SPWD,FALSE-VALUE DLESS? 'L,0 \?CCL5 PUTB P-LEXV,P-LEXWORDS,LEN RTRUE ?CCL5: GET PTR,0 >WD ZERO? WD /?CCL7 GET PTR,P-LEXELEN EQUAL? STACK,W?APOSTROPHE \?CCL7 GET P-QA-WORDS1,0 INTBL? WD,P-QA-WORDS1+2,STACK >N \?PRD12 SUB N,P-QA-WORDS1 DIV STACK,2 >N GET P-QA-WORDS2,N >?TMP1 GET PTR,4 EQUAL? ?TMP1,STACK /?CTR6 ?PRD12: CALL2 SPECIAL-CONTRACTION?,PTR >SPWD ZERO? SPWD /?CCL7 ?CTR6: ZERO? SPWD /?CCL17 PUSH 8 JUMP ?CND15 ?CCL17: PUSH 4 ?CND15: ADD PTR,STACK >?TMP1 MUL L,4 COPYT ?TMP1,PTR,STACK ZERO? SPWD /?CCL20 PUT PTR,0,SPWD DEC 'L DEC 'LEN JUMP ?CND18 ?CCL20: GET P-QB-WORDS-1,N >WD PUT PTR,0,WD GET P-QB-WORDS-2,N >WD PUT PTR,P-LEXELEN,WD ?CND18: DEC 'L DEC 'LEN JUMP ?PRG1 ?CCL7: EQUAL? WD,W?APOSTROPHE \?CCL22 GET PTR,P-LEXELEN EQUAL? STACK,W?S /?CCL22 EQUAL? OPTR,PTR /?CCL22 SUB PTR,4 >WD ZERO? WD /?CCL22 GETB WD,2 ADD -1,STACK >?TMP1 GETB WD,3 ADD ?TMP1,STACK GETB P-INBUF,STACK EQUAL? STACK,115,122 \?CCL22 SUB PTR,P-LEXV DIV STACK,2 ADD P-LEXELEN,STACK ICALL MAKE-ROOM-FOR-TOKENS,1,P-LEXV,STACK PUT PTR,P-LEXELEN,W?S INC 'L INC 'LEN JUMP ?PRG1 ?CCL22: ADD PTR,4 >PTR JUMP ?PRG1 .FUNCT NAKED-DIR?:ANY:0:0,WCNUM,LEN GET TLEXV,0 >LEN ZERO? LEN /FALSE GET LEN,4 >WCNUM ZERO? WCNUM \?CND3 GET LEN,3 >LEN GET LEN,4 >WCNUM ?CND3: BTST WCNUM,32768 /FALSE BAND WCNUM,32 BAND STACK,32767 ZERO? STACK /FALSE EQUAL? P-LEN,1 \?CCL11 RETURN LEN ?CCL11: SUB TLEXV,P-LEXV LESS? STACK,234 /?CND9 RETURN LEN ?CND9: GET TLEXV,P-LEXELEN >WCNUM EQUAL? WCNUM,W?COMMA,W?AND \?CND13 RETURN LEN ?CND13: GET WCNUM,4 >WCNUM BAND WCNUM,32768 EQUAL? STACK,-32768 \FALSE BAND WCNUM,32776 BAND STACK,32767 ZERO? STACK /FALSE RETURN LEN .FUNCT PARSER:ANY:0:0,OWINNER,LEN,N,PV,?TMP1 ICALL1 PMEM-RESET SET 'ERROR-PRIORITY,255 SET 'ERROR-STRING,FALSE-VALUE SET 'OWINNER,WINNER GRTR? P-CONT,0 \?CCL4 SET 'TLEXV,P-CONT ZERO? VERBOSITY /?CND5 EQUAL? PLAYER,WINNER \?CND5 CRLF ?CND5: SET 'P-CONT,FALSE-VALUE JUMP ?CND2 ?CCL4: SET 'WINNER,PLAYER ZERO? P-OFLAG \?CND9 GET OOPS-TABLE,O-PTR ZERO? STACK \?CND9 PUT OOPS-TABLE,O-END,FALSE-VALUE ?CND9: LOC WINNER IN? STACK,ROOMS \?CND13 LOC WINNER >HERE ?CND13: ZERO? LIT /?CCL16 EQUAL? HERE,LIT /?CND15 IN? LIT,HERE /?CND15 CALL2 VISIBLE?,LIT ZERO? STACK \?CND15 ?CCL16: CALL1 LIT? >LIT ?CND15: GET 0,8 BTST STACK,F-REFRESH \?CND22 ICALL1 V-$REFRESH ?CND22: ZERO? VERBOSITY /?CND24 CRLF ?CND24: ICALL1 UPDATE-STATUS-LINE ICALL1 READ-INPUT GETB P-LEXV,P-LEXWORDS >LEN ZERO? LEN /?CND27 INTBL? W?QUOTE,P-LEXV+2,LEN,132 >N \?CND27 ICALL FIX-QUOTATIONS,LEN,N ?CND27: ICALL1 EXPAND-BE-CONTRACTIONS GETB P-LEXV,P-LEXWORDS >P-LEN SET 'TLEXV,P-LEXV+2 ?CND2: GET TLEXV,0 EQUAL? STACK,W?PERIOD,W?THEN \?CND31 ADD TLEXV,4 >TLEXV DEC 'P-LEN ?CND31: GET TLEXV,0 EQUAL? STACK,W?YOU \?CND33 ICALL1 IGNORE-FIRST-WORD ?CND33: GET TLEXV,0 EQUAL? STACK,W?GO,W?TO \?CND35 ICALL1 IGNORE-FIRST-WORD ?CND35: ZERO? P-LEN \?CND37 ICALL1 BEG-PARDON RFALSE ?CND37: CALL1 NAKED-DIR? >LEN ZERO? LEN /?CCL41 PUT STATE-STACK,0,20 PUT DATA-STACK,0,20 XPUSH LEN,DATA-STACK /?BOGUS42 ?BOGUS42: ICALL2 RED-SD,1 SET 'P-CONT,FALSE-VALUE SET 'P-OFLAG,0 SET 'P-WORDS-AGAIN,1 PUT OOPS-TABLE,O-END,FALSE-VALUE PUT OOPS-TABLE,O-START,TLEXV PUTB P-LEXV,P-LEXWORDS,P-LEN COPYT P-LEXV,G-LEXV,LEXV-LENGTH-BYTES COPYT P-INBUF,G-INBUF,61 PUT PARSE-RESULT,13,0 PUT PARSE-RESULT,1,W?WALK DEC 'P-LEN LESS? 0,P-LEN \TRUE ADD TLEXV,4 >TLEXV GET TLEXV,0 >LEN ZERO? LEN /TRUE GET LEN,4 >LEN ZERO? LEN /TRUE BAND LEN,32768 EQUAL? STACK,-32768 \TRUE BAND LEN,32776 BAND STACK,32767 ZERO? STACK /TRUE DLESS? 'P-LEN,1 /TRUE ADD TLEXV,4 >P-CONT RTRUE ?CCL41: GET TLEXV,0 EQUAL? STACK,W?OOPS,W?O \?CCL53 CALL2 DO-OOPS,OWINNER ZERO? STACK \?CND39 RFALSE ?CCL53: ZERO? P-OFLAG \?CND39 LESS? P-CONT,1 \?CND39 PUT OOPS-TABLE,O-END,FALSE-VALUE ?CND39: SET 'P-CONT,FALSE-VALUE GET TLEXV,0 EQUAL? STACK,W?AGAIN,W?G \?CCL61 CALL2 DO-AGAIN,OWINNER ZERO? STACK \?CND59 RFALSE ?CCL61: PUTB P-LEXV,P-LEXWORDS,P-LEN COPYT P-LEXV,G-LEXV,LEXV-LENGTH-BYTES COPYT P-INBUF,G-INBUF,61 PUT OOPS-TABLE,O-START,TLEXV PUT OOPS-TABLE,O-LENGTH,P-LEN GET OOPS-TABLE,O-END ZERO? STACK \?CND59 GETB P-LEXV,P-LEXWORDS MUL 4,STACK >LEN DEC 'LEN GETB TLEXV,LEN >?TMP1 DEC 'LEN GETB TLEXV,LEN ADD ?TMP1,STACK PUT OOPS-TABLE,O-END,STACK ?CND59: SET 'P-WON,FALSE-VALUE SET 'P-WALK-DIR,FALSE-VALUE CALL2 PARSE-IT,FALSE-VALUE >PV ?PRG66: ZERO? PV \?CCL70 CALL1 PRINT-PARSER-FAILURE >PV JUMP ?PRG66 ?CCL70: EQUAL? PV,1 /FALSE PUT OOPS-TABLE,O-PTR,FALSE-VALUE GET PV,4 >PRSA CALL1 GAME-VERB? ZERO? STACK \?CND73 SET 'P-OFLAG,0 ?CND73: GET GWIM-MSG,1 ZERO? STACK /?CND75 ICALL1 TELL-GWIM-MSG PUT GWIM-MSG,1,0 ?CND75: GET GWIM-MSG,2 ZERO? STACK /TRUE PRINTI "[""" GET GWIM-MSG,2 ICALL2 NP-PRINT,STACK PRINTI """ meaning " GET GWIM-MSG,3 ICALL2 THE-PRINT,STACK PRINTI "] " PUT GWIM-MSG,2,0 RTRUE .FUNCT RED-SD:ANY:0:2,N,TYP,V,SYN,NEW-OBJECT GET PARSE-RESULT,1 >V GET W?WALK,3 >SYN ZERO? V /?CCL2 GET V,3 EQUAL? SYN,STACK /?CND1 ?CCL2: SET 'V,W?WALK PUT PARSE-RESULT,1,V ?CND1: GET V,3 GET STACK,2 ADD STACK,2 >SYN PUT PARSE-RESULT,3,SYN GET SYN,0 PUT PARSE-RESULT,4,STACK PUT PARSE-RESULT,7,FALSE-VALUE POP DATA-STACK GETB STACK,6 >P-WALK-DIR CALL DO-PMEM-ALLOC,4,NOUN-PHRASE-MIN-LENGTH >NEW-OBJECT PUT NEW-OBJECT,1,1 PUT NEW-OBJECT,3,P-WALK-DIR PUT PARSE-RESULT,5,NEW-OBJECT RTRUE .FUNCT PARSE-IT:ANY:0:1,V,RES,NUM,W,SAV-LEXV,TMP,TV,T2,?TMP1 PUT SPLIT-STACK,0,0 SET 'ERROR-PRIORITY,255 PUT ERROR-ARGS,1,0 SET 'P-OLEN,P-LEN SET 'OTLEXV,TLEXV SET 'W,WINNER SET 'SAV-LEXV,TLEXV ?PRG1: INC 'NUM ICALL2 BE-PATIENT,NUM PUT STATE-STACK,0,20 XPUSH 1,STATE-STACK /?BOGUS3 ?BOGUS3: PUT DATA-STACK,0,20 ICALL1 PMEM-RESET SET 'P-WORD-NUMBER,0 SET 'TLEXV,SAV-LEXV SET 'P-LEN,P-OLEN SET 'WINNER,W COPYT GWIM-MSG,0,8 COPYT PARSE-RESULT,0,PARSE-RESULT-LEN CALL2 PARSE-SENTENCE,PARSE-RESULT >RES EQUAL? RES,PARSER-RESULT-AGAIN \?CCL6 PUT SPLIT-STACK,0,0 SET 'ERROR-PRIORITY,255 SET 'P-OLEN,P-LEN SET 'SAV-LEXV,TLEXV JUMP ?PRG1 ?CCL6: LESS? RES,PARSER-RESULT-WON \?REP2 GET SPLIT-STACK,0 ZERO? STACK /?REP2 ZERO? RES /?REP2 ?PRG12: GET SPLIT-STACK,0 >T2 SUB T2,1 GET SPLIT-STACK,STACK >TV BAND TV,65280 ZERO? STACK /?CCL16 GET SPLIT-STACK,T2 >TMP BTST TMP,32768 /?CCL19 ADD TV,6 CALL GET-TERMINAL-ACTION,TMP,STACK,1 >TV JUMP ?CND17 ?CCL19: BAND TMP,32767 >?TMP1 ADD TV,6 CALL GET-TERMINAL-ACTION,?TMP1,STACK,0 >TV ?CND17: ZERO? TV \?CCL22 SUB T2,2 >T2 PUT SPLIT-STACK,0,T2 JUMP ?CND14 ?CCL22: SUB T2,1 PUT SPLIT-STACK,STACK,TV JUMP ?REP13 ?CCL16: GET SPLIT-STACK,T2 >TMP EQUAL? TMP,TV \?CCL24 SUB T2,2 >T2 PUT SPLIT-STACK,0,T2 ?CND14: ZERO? T2 \?PRG12 ?REP13: GET SPLIT-STACK,0 ZERO? STACK \?PRG1 ?REP2: ZERO? P-RESPONDED /?CND29 SUB 0,NUM ICALL2 BE-PATIENT,STACK ?CND29: EQUAL? RES,PARSER-RESULT-WON \?CCL33 RETURN PARSER-RESULT ?CCL24: ADD 1,TMP PUT SPLIT-STACK,T2,STACK JUMP ?REP13 ?CCL33: ZERO? RES /TRUE RFALSE .FUNCT PARSE-SENTENCE:ANY:1:1,PR,SPLIT-NUM,RES,WCN,CURRENT-TOKEN,OLD-WCN,CAV,OFFS,T2,CURRENT-ACTION,REDUCTION,?TMP1 SET 'SPLIT-NUM,-1 GET TLEXV,0 >CURRENT-TOKEN CATCH >PARSE-SENTENCE-ACTIVATION ZERO? CURRENT-TOKEN \?CND1 CALL2 UNKNOWN-WORD,TLEXV >CURRENT-TOKEN ZERO? CURRENT-TOKEN \?CND1 RETURN PARSER-RESULT-DEAD ?CND1: GET CURRENT-TOKEN,4 >WCN SET 'OLD-WCN,WCN ?PRG5: EQUAL? CURRENT-TOKEN,W?S \?CND7 SUB TLEXV,4 GET STACK,0 EQUAL? STACK,W?APOSTROPHE \?CND7 SET 'OLD-WCN,16 SET 'WCN,OLD-WCN ?CND7: ZERO? WCN \?CCL13 GET CURRENT-TOKEN,3 ZERO? STACK \?CCL16 CALL BUZZER-WORD?,CURRENT-TOKEN,TLEXV ZERO? STACK /?CND17 MUL P-LEXELEN,P-WORD-NUMBER ADD STACK,P-LEXSTART PUT OOPS-TABLE,O-PTR,STACK RETURN PARSER-RESULT-DEAD ?CND17: SET 'CAV,FALSE-VALUE JUMP ?CND11 ?CCL16: GET CURRENT-TOKEN,3 >CURRENT-TOKEN GET CURRENT-TOKEN,4 >OLD-WCN SET 'WCN,OLD-WCN JUMP ?PRG5 ?CCL13: BTST OLD-WCN,32768 /?CCL21 SET 'OFFS,1 JUMP ?CND19 ?CCL21: SET 'OFFS,0 ?CND19: CALL2 PEEK-PSTACK,STATE-STACK GET ACTION-TABLE,STACK GET STACK,0 CALL GET-TERMINAL-ACTION,WCN,STACK,OFFS >CAV ZERO? CAV /?CND22 BAND WCN,32767 >?TMP1 GET CAV,OFFS BCOM STACK BAND ?TMP1,STACK ZERO? STACK /?CND22 ADD CAV,6 CALL GET-TERMINAL-ACTION,WCN,STACK,OFFS ZERO? STACK /?CND22 ADD SPLIT-NUM,2 >SPLIT-NUM ADD SPLIT-NUM,1 GET SPLIT-STACK,0 >T2 GRTR? STACK,T2 \?CCL29 INC 'T2 LESS? T2,21 /?CND30 ICALL1 P-NO-MEM-ROUTINE ?CND30: PUT SPLIT-STACK,0,T2 PUT SPLIT-STACK,T2,CAV INC 'T2 LESS? T2,21 /?CND32 ICALL1 P-NO-MEM-ROUTINE ?CND32: PUT SPLIT-STACK,0,T2 BAND OLD-WCN,32768 BOR STACK,WCN PUT SPLIT-STACK,T2,STACK JUMP ?CND22 ?CCL29: SUB SPLIT-NUM,1 GET SPLIT-STACK+2,STACK >CAV ZERO? CAV /?CND22 ?CND22: ZERO? CAV \?CND36 RETURN PARSER-RESULT-FAILED ?CND36: GET CAV,OFFS BAND WCN,STACK >WCN ?CND11: ZERO? CAV /?PST39 GET CAV,2 >CURRENT-ACTION JUMP ?PRG41 ?PST39: SET 'CURRENT-ACTION,0 ?PRG41: ZERO? CAV /?CCL45 BAND CURRENT-ACTION,65280 ZERO? STACK /?CCL45 ADD SPLIT-NUM,2 >SPLIT-NUM ADD SPLIT-NUM,1 GET SPLIT-STACK,0 >T2 GRTR? STACK,T2 \?CCL50 INC 'T2 LESS? T2,21 /?CND51 ICALL1 P-NO-MEM-ROUTINE ?CND51: PUT SPLIT-STACK,0,T2 GETB CURRENT-ACTION,0 PUT SPLIT-STACK,T2,STACK INC 'T2 LESS? T2,21 /?CND53 ICALL1 P-NO-MEM-ROUTINE ?CND53: PUT SPLIT-STACK,0,T2 PUT SPLIT-STACK,T2,1 GETB CURRENT-ACTION,1 >CURRENT-ACTION JUMP ?CND43 ?CCL50: GET SPLIT-STACK+2,SPLIT-NUM GETB CURRENT-ACTION,STACK >CURRENT-ACTION JUMP ?CND43 ?CCL45: ZERO? CAV /?CND43 ZERO? CURRENT-ACTION \?CND43 RETURN PARSER-RESULT-FAILED ?CND43: ZERO? CAV /?CTR59 LESS? CURRENT-ACTION,128 \?CCL60 ?CTR59: ZERO? CAV /?CND63 XPUSH CURRENT-TOKEN,DATA-STACK \?CCL67 XPUSH CURRENT-ACTION,STATE-STACK /?CND63 ?CCL67: ICALL1 P-NO-MEM-ROUTINE ?CND63: DLESS? 'P-LEN,1 \?CCL72 SET 'CURRENT-TOKEN,W?END.OF.INPUT ADD 1,P-WORD-NUMBER >P-WORDS-AGAIN SET 'P-CONT,FALSE-VALUE SET 'P-LEN,0 JUMP ?CND70 ?CCL72: INC 'P-WORD-NUMBER ADD TLEXV,4 >TLEXV GET TLEXV,0 >CURRENT-TOKEN GRTR? TLEXV,OTLEXV \?CND70 SET 'OTLEXV,TLEXV ?CND70: ZERO? CURRENT-TOKEN \?CCL77 CALL2 UNKNOWN-WORD,TLEXV >CURRENT-TOKEN ZERO? CURRENT-TOKEN \?CND75 RETURN PARSER-RESULT-DEAD ?CCL77: EQUAL? CURRENT-TOKEN,W?THEN,W?!,W?PERIOD /?CCL80 EQUAL? CURRENT-TOKEN,W?? \?CND75 ?CCL80: SET 'P-WORDS-AGAIN,P-WORD-NUMBER DLESS? 'P-LEN,1 /?CCL85 ADD TLEXV,4 >P-CONT JUMP ?CND75 ?CCL85: SET 'P-CONT,FALSE-VALUE ?CND75: GET CURRENT-TOKEN,4 >OLD-WCN SET 'WCN,OLD-WCN JUMP ?PRG5 ?CCL60: GRTR? CURRENT-ACTION,128 \?CCL87 SUB CURRENT-ACTION,129 GET REDUCTION-TABLE,STACK >REDUCTION GET REDUCTION,0 >RES ZERO? RES /?CND90 FSTACK RES,STATE-STACK ?CND90: SET 'CURRENT-REDUCTION,REDUCTION SET 'P-RUNNING,TLEXV GET REDUCTION,1 >?TMP1 GET REDUCTION,0 CALL ?TMP1,STACK >RES SET 'TLEXV,P-RUNNING GRTR? TLEXV,OTLEXV \?CND92 SET 'OTLEXV,TLEXV ?CND92: LESS? P-LEN,1 \?CCL96 SET 'CURRENT-TOKEN,W?END.OF.INPUT GET CURRENT-TOKEN,4 >OLD-WCN SET 'WCN,OLD-WCN JUMP ?CND94 ?CCL96: GET TLEXV,0 EQUAL? CURRENT-TOKEN,STACK /?CND94 GET TLEXV,0 >CURRENT-TOKEN GET CURRENT-TOKEN,4 >OLD-WCN SET 'WCN,OLD-WCN ?CND94: SET 'CURRENT-REDUCTION,FALSE-VALUE ZERO? RES \?CTR99 RETURN PARSER-RESULT-FAILED ?CTR99: XPUSH RES,DATA-STACK /?CND98 ICALL1 P-NO-MEM-ROUTINE ?CND98: CALL2 PEEK-PSTACK,STATE-STACK GET ACTION-TABLE,STACK >?TMP1 GET REDUCTION,4 CALL GET-NONTERMINAL-ACTION,?TMP1,STACK XPUSH STACK,STATE-STACK /?PRG5 ICALL1 P-NO-MEM-ROUTINE JUMP ?PRG5 ?CCL87: POP DATA-STACK >PARSER-RESULT RETURN PARSER-RESULT-WON .FUNCT GET-TERMINAL-ACTION:ANY:3:3,TYPE,STATE,OFFS,V ZERO? STATE /FALSE BAND TYPE,32767 >TYPE SET 'V,STATE ?PRG4: GET V,0 ZERO? STACK \?CND6 GET V,1 ZERO? STACK /FALSE ?CND6: GET V,OFFS BAND TYPE,STACK ZERO? STACK /?CND10 RETURN V ?CND10: ADD V,6 >V JUMP ?PRG4 .FUNCT GET-NONTERMINAL-ACTION:ANY:2:2,STATE,TYPE,V GET STATE,1 ZERO? STACK /FALSE GET STATE,1 >V ?PRG4: GETB V,0 ZERO? STACK /FALSE GETB V,0 EQUAL? STACK,TYPE \?CND6 GETB V,1 RSTACK ?CND6: ADD V,2 >V JUMP ?PRG4 .FUNCT BE-PATIENT:ANY:1:1,NUM,LIM SET 'LIM,16 GETB 0,30 EQUAL? STACK,APPLE-2E,APPLE-2C,APPLE-2GS \?CND1 SET 'LIM,4 ?CND1: LESS? NUM,0 \?CCL5 SUB 1,LIM LESS? NUM,STACK \FALSE ZERO? P-RESPONDED /FALSE SET 'P-RESPONDED,0 BUFOUT TRUE-VALUE PRINTR "]" ?CCL5: MOD NUM,LIM ZERO? STACK \FALSE EQUAL? NUM,LIM \?CCL15 SET 'P-RESPONDED,LIM PRINTI "[Please be patient..." JUMP ?CND13 ?CCL15: ZERO? P-RESPONDED /?CND13 PRINTC 46 ?CND13: BUFOUT FALSE-VALUE RTRUE .FUNCT MAIN-LOOP:ANY:0:0,X ?PRG1: CALL1 MAIN-LOOP-1 >X JUMP ?PRG1 .FUNCT MAIN-LOOP-1:ANY:0:0,ICNT,OCNT,NUM,OBJ,V,OBJ1,NP,NP1,XX,CNT,TMP CALL1 PARSER >P-WON ZERO? P-WON /?CCL3 ?PRG4: GET PARSE-RESULT,4 >PRSA EQUAL? PRSA,V?UNDO \?CCL8 SET 'PRSS,FALSE-VALUE SET 'PRSQ,FALSE-VALUE CALL2 PERFORM,PRSA RSTACK ?CCL8: ISAVE >P-CAN-UNDO EQUAL? P-CAN-UNDO,2 \?CND6 EQUAL? PRSA,V?SAVE \?CCL13 ICALL1 CANT-UNDO RFALSE ?CCL13: SET 'P-CONT,-1 ICALL1 V-$REFRESH RFALSE ?CND6: GET PARSE-RESULT,5 >P-PRSO GET PARSE-RESULT,6 >P-PRSI ZERO? P-PRSO /?CCL17 GET P-PRSO,3 EQUAL? INTDIR,STACK \?CCL17 GET P-PRSO,4 GET STACK,2 GETB STACK,6 >P-DIRECTION JUMP ?CND15 ?CCL17: ZERO? P-PRSI /?CND15 GET P-PRSI,3 EQUAL? INTDIR,STACK \?CND15 GET P-PRSI,4 GET STACK,2 GETB STACK,6 >P-DIRECTION ?CND15: GET PARSE-RESULT,1 >P-PRSA-WORD SET 'CLOCK-WAIT,FALSE-VALUE SET 'ICNT,0 SET 'OCNT,0 ZERO? P-PRSI /?CND23 GET P-PRSI,1 >ICNT ZERO? ICNT /?CND23 SET 'P-MULT,ICNT ?CND23: ZERO? P-PRSO /?CND27 GET P-PRSO,1 >OCNT ZERO? OCNT /?CND27 SET 'P-MULT,OCNT ?CND27: ZERO? OCNT \?CCL33 ZERO? ICNT /?CND31 ?CCL33: EQUAL? PRSA,V?WALK /?CND31 ZERO? P-IT-OBJECT /?CND31 ZERO? ICNT /?CND39 ICALL MAIN-LOOP-IT,ICNT,P-PRSI ?CND39: ZERO? OCNT /?CND31 ICALL MAIN-LOOP-IT,OCNT,P-PRSO ?CND31: ZERO? OCNT \?CCL45 SET 'NUM,OCNT JUMP ?CND43 ?CCL45: GRTR? OCNT,1 \?CCL47 ZERO? ICNT \?CCL50 SET 'OBJ,FALSE-VALUE JUMP ?CND48 ?CCL50: GET P-PRSI,3 >OBJ GET P-PRSI,4 >NP ?CND48: SET 'NUM,OCNT JUMP ?CND43 ?CCL47: GRTR? ICNT,1 \?CCL54 GET P-PRSO,3 >OBJ GET P-PRSI,4 >NP SET 'NUM,ICNT JUMP ?CND43 ?CCL54: SET 'NUM,1 ?CND43: ZERO? OBJ \?CND57 EQUAL? ICNT,1 \?CND57 GET P-PRSI,3 >OBJ GET P-PRSI,4 >NP ?CND57: GET PARSE-RESULT,12 >V ZERO? V /?CND63 GET V,1 LESS? 1,STACK \?CND63 GET V,2 ZERO? STACK \?CND63 PUT V,2,1 GET V,3 ICALL2 DPRINT,STACK PRINTI ": " ?CND63: GET PARSE-RESULT,15 >V ZERO? V /?CCL70 GET V,0 >PRSQ JUMP ?CND68 ?CCL70: SET 'PRSQ,FALSE-VALUE ?CND68: GET PARSE-RESULT,13 >XX ZERO? XX /?CCL73 GET XX,3 >PRSS JUMP ?CND71 ?CCL73: SET 'PRSS,FALSE-VALUE ?CND71: ZERO? LIT \?CCL76 CALL1 SEE-VERB? ZERO? STACK /?CCL76 ICALL1 TELL-TOO-DARK SET 'P-CONT,-1 JUMP ?CND74 ?CCL76: EQUAL? PRSA,V?WALK \?CCL80 ZERO? P-WALK-DIR /?PRD83 PUSH P-WALK-DIR JUMP ?PEN81 ?PRD83: GET P-PRSO,3 ?PEN81: CALL PERFORM,PRSA,STACK >V JUMP ?CND74 ?CCL80: ZERO? NUM \?CCL85 CALL2 PERFORM,PRSA >V SET 'PRSO,FALSE-VALUE SET 'PRSO-NP,FALSE-VALUE JUMP ?CND74 ?CCL85: GRTR? OCNT,1 \?CCL87 EQUAL? PRSA,V?COUNT \?CCL87 CALL PERFORM,PRSA,ROOMS >V JUMP ?CND74 ?CCL87: SET 'CNT,-1 SET 'TMP,0 ?PRG90: INC 'CNT LESS? CNT,NUM /?CND92 ZERO? TMP \?CND74 ICALL1 MORE-SPECIFIC JUMP ?CND74 ?CND92: MUL CNT,2 ADD NOUN-PHRASE-HEADER-LEN,STACK >XX GRTR? ICNT,1 /?CCL98 GET P-PRSO,XX >OBJ1 ADD 1,XX GET P-PRSO,STACK >NP1 JUMP ?CND96 ?CCL98: GET P-PRSI,XX >OBJ1 ADD 1,XX GET P-PRSI,STACK >NP1 ?CND96: GRTR? NUM,1 /?CCL100 GET NP1,3 EQUAL? STACK,NP-QUANT-ALL \?CND99 ?CCL100: CALL PERF-MANY,OBJ1,OBJ,NP1,STR?1 ZERO? STACK /?PRG90 ?CND99: SET 'TMP,TRUE-VALUE GRTR? ICNT,1 /?CCL107 SET 'PRSO,OBJ1 SET 'PRSO-NP,NP1 SET 'PRSI,OBJ SET 'PRSI-NP,NP JUMP ?CND105 ?CCL107: SET 'PRSO,OBJ SET 'PRSO-NP,NP SET 'PRSI,OBJ1 SET 'PRSI-NP,NP1 ?CND105: EQUAL? IT,PRSI,PRSO,PRSS \?CND108 CALL FIX-HIM-HER-IT,IT,P-IT-OBJECT ZERO? STACK /?PRG90 ?CND108: EQUAL? HER,PRSI,PRSO,PRSS \?CND112 CALL FIX-HIM-HER-IT,HER,P-HER-OBJECT ZERO? STACK /?PRG90 ?CND112: EQUAL? HIM,PRSI,PRSO,PRSS \?CND116 CALL FIX-HIM-HER-IT,HIM,P-HIM-OBJECT ZERO? STACK /?PRG90 ?CND116: EQUAL? THEM,PRSI,PRSO,PRSS \?CND120 CALL FIX-HIM-HER-IT,THEM,P-THEM-OBJECT ZERO? STACK /?PRG90 ?CND120: ICALL2 QCONTEXT-CHECK,PRSO ZERO? PRSO /?CND124 GET PARSE-RESULT,3 GETB STACK,5 >XX CALL TEST-ADJACENT,PRSO,XX ZERO? STACK /?CND126 ICALL2 NOT-HERE,PRSO JUMP ?PRG90 ?CND126: BAND XX,96 ZERO? STACK /?CND124 BTST XX,128 /?CND124 CALL ITAKE-CHECK,PRSO,XX >V EQUAL? M-FATAL,V /?CND74 ZERO? V \?PRG90 ?CND124: ZERO? PRSI /?CND137 GET PARSE-RESULT,3 GETB STACK,9 >XX CALL TEST-ADJACENT,PRSI,XX ZERO? STACK /?CND139 ICALL2 NOT-HERE,PRSI JUMP ?PRG90 ?CND139: BAND XX,96 ZERO? STACK /?CND137 BTST XX,128 /?CND137 CALL ITAKE-CHECK,PRSI,XX >V EQUAL? M-FATAL,V /?CND74 ZERO? V \?PRG90 ?CND137: CALL PERFORM,PRSA,PRSO,PRSI >V EQUAL? M-FATAL,V /?CND74 EQUAL? P-CONT,-1 \?PRG90 ?CND74: SET 'OPRSO,PRSO ZERO? CLOCK-WAIT \?CND154 CALL1 GAME-VERB? ZERO? STACK \?CND154 LOC WINNER >V ZERO? V /?CND158 IN? V,ROOMS /?CND158 GETP V,P?ACTION CALL STACK,M-END >V ?CND158: GETP HERE,P?ACTION CALL STACK,M-END >V EQUAL? M-FATAL,V \?CND162 SET 'P-CONT,-1 ?CND162: SET 'CLOCKER-RUNNING,1 CALL1 CLOCKER >V SET 'CLOCKER-RUNNING,2 EQUAL? M-FATAL,V \?CND154 SET 'P-CONT,-1 ?CND154: GET PARSE-RESULT,12 >V ZERO? V /?CND1 GET V,1 LESS? 1,STACK \?CND1 EQUAL? P-CONT,-1 /?CND1 CALL2 HACK-TELL-1,V >V EQUAL? M-FATAL,V \?CCL174 SET 'P-CONT,-1 JUMP ?CND1 ?CCL174: ZERO? V /?CND1 JUMP ?PRG4 ?CCL3: SET 'CLOCK-WAIT,TRUE-VALUE SET 'P-CONT,FALSE-VALUE ?CND1: SET 'PRSA,FALSE-VALUE SET 'PRSO,FALSE-VALUE SET 'PRSO-NP,FALSE-VALUE SET 'PRSI,FALSE-VALUE RETURN PRSI .FUNCT PERF-MANY:ANY:4:4,OBJ1,OBJ,NP1,STR EQUAL? OBJ1,FALSE-VALUE,NOT-HERE-OBJECT \?CCL3 ICALL2 NP-PRINT,NP1 PRINT STR ICALL2 NP-CANT-SEE,NP1 RFALSE ?CCL3: GET NP1,3 EQUAL? STACK,NP-QUANT-ALL \?CCL5 CALL VERB-ALL-TEST,OBJ1,OBJ ZERO? STACK /FALSE ?CCL5: CALL2 ACCESSIBLE?,OBJ1 ZERO? STACK /FALSE EQUAL? OBJ1,PLAYER /FALSE EQUAL? OBJ1,IT \?CCL14 ICALL2 DPRINT,P-IT-OBJECT JUMP ?CND12 ?CCL14: EQUAL? OBJ1,PSEUDO-OBJECT \?CCL16 ICALL2 NP-PRINT,NP1 JUMP ?CND12 ?CCL16: ICALL2 DPRINT,OBJ1 ?CND12: PRINT STR RTRUE .FUNCT TEST-ADJACENT:ANY:2:2,OBJ,XX,LO,LW ZERO? OBJ /FALSE BTST XX,128 /FALSE BTST XX,192 /FALSE CALL2 META-LOC,OBJ >LO ZERO? LO /FALSE IN? LO,ROOMS \FALSE FSET? LO,TOUCHBIT \FALSE CALL2 META-LOC,WINNER >LW CALL GLOBAL-IN?,OBJ,LW ZERO? STACK \FALSE EQUAL? LO,LW /FALSE RTRUE .FUNCT QCONTEXT-CHECK:ANY:1:1,PER,WHO EQUAL? PRSA,V?TELL-ABOUT,V?SHOW \FALSE EQUAL? PER,PLAYER \FALSE CALL2 FIND-A-WINNER,HERE >WHO ZERO? WHO /?CND7 SET 'QCONTEXT,WHO ?CND7: CALL1 QCONTEXT-GOOD? ZERO? STACK /FALSE EQUAL? WINNER,PLAYER \FALSE SET 'WINNER,QCONTEXT ICALL2 TELL-SAID-TO,QCONTEXT RTRUE .FUNCT LIT?:ANY:0:2,RM,RMBIT,OHERE,LT ASSIGNED? 'RM /?CND1 SET 'RM,HERE ?CND1: ASSIGNED? 'RMBIT /?CND3 SET 'RMBIT,TRUE-VALUE ?CND3: SET 'OHERE,HERE SET 'HERE,RM ZERO? RMBIT /?CCL7 FSET? RM,ONBIT \?CCL7 SET 'LT,HERE JUMP ?CND5 ?CCL7: FSET? WINNER,ONBIT \?CCL11 CALL HELD?,WINNER,RM ZERO? STACK /?CCL11 SET 'LT,WINNER JUMP ?CND5 ?CCL11: PUT SEARCH-RES,1,0 PUT SEARCH-RES,2,FALSE-VALUE PUT FINDER,0,ONBIT PUT FINDER,1,FIND-FLAGS-GWIM EQUAL? OHERE,RM \?CND14 ICALL FIND-DESCENDANTS,WINNER,7 EQUAL? WINNER,PLAYER /?CND14 IN? PLAYER,RM \?CND14 ICALL FIND-DESCENDANTS,PLAYER,7 ?CND14: GET SEARCH-RES,1 ZERO? STACK \?CND20 LOC WINNER IN? STACK,ROOMS /?CND22 LOC WINNER FSET? STACK,OPENBIT /?CND22 LOC WINNER ICALL FIND-DESCENDANTS,STACK,7 ?CND22: ICALL FIND-DESCENDANTS,RM,7 ?CND20: GET SEARCH-RES,1 LESS? 0,STACK \?CND5 GET SEARCH-RES,4 >LT ?CND5: SET 'HERE,OHERE RETURN LT .FUNCT IGNORE-FIRST-WORD:ANY:0:0,NW LESS? 1,P-LEN \FALSE GET TLEXV,P-LEXELEN >NW ZERO? NW /FALSE GET NW,4 >NW ZERO? NW /FALSE BTST NW,32768 /FALSE BAND NW,1 BAND STACK,32767 ZERO? STACK /FALSE ADD TLEXV,4 >TLEXV DEC 'P-LEN RTRUE .FUNCT FIX-QUOTATIONS:ANY:2:2,LEN,PTR,X,QFLAG SET 'QFLAG,FALSE-VALUE ?PRG1: ZERO? QFLAG \?CCL5 SET 'QFLAG,TRUE-VALUE SUB PTR,P-LEXV DIV STACK,2 ADD 2,STACK >X ICALL MAKE-ROOM-FOR-TOKENS,1,P-LEXV,X PUT P-LEXV,X,W?NO.WORD JUMP ?CND3 ?CCL5: SET 'QFLAG,FALSE-VALUE ?CND3: ADD PTR,4 >PTR SUB PTR,P-LEXV DIV STACK,4 >X GETB P-LEXV,P-LEXWORDS SUB STACK,X >LEN ZERO? LEN /TRUE INTBL? W?QUOTE,PTR,LEN,132 >PTR /?PRG1 RTRUE .FUNCT MAIN-LOOP-IT:ANY:2:2,ICNT,PRS,CNT,TOFF ?PRG1: MUL CNT,2 ADD NOUN-PHRASE-HEADER-LEN,STACK >TOFF GET PRS,TOFF EQUAL? IT,STACK \?CCL5 CALL2 ACCESSIBLE?,P-IT-OBJECT ZERO? STACK /?CCL5 PUT PRS,TOFF,P-IT-OBJECT ICALL TELL-PRONOUN,P-IT-OBJECT,IT RTRUE ?CCL5: IGRTR? 'CNT,ICNT \?PRG1 RTRUE .FUNCT P-NO-MEM-ROUTINE:ANY:0:1,TYP PRINTI "[Sorry, but that" EQUAL? TYP,7 \?CCL3 PRINTI "'s too many objects" JUMP ?CND1 ?CCL3: PRINTI " sentence is too complicated" ?CND1: PRINTI ".] " THROW PARSER-RESULT-DEAD,PARSE-SENTENCE-ACTIVATION RTRUE .FUNCT BEG-PARDON:ANY:0:0 PRINTR "[I beg your pardon?]" .FUNCT UNKNOWN-WORD:ANY:1:1,RLEXV,X CALL2 NUMBER?,RLEXV >X ZERO? X /?CCL3 RETURN X ?CCL3: PRINTI "[I don't know the word """ SUB RLEXV,P-LEXV DIV STACK,2 PUT OOPS-TABLE,O-PTR,STACK ICALL2 WORD-PRINT,RLEXV PRINTI ".""]" CRLF THROW PARSER-RESULT-DEAD,PARSE-SENTENCE-ACTIVATION RTRUE .FUNCT WORD-PRINT:ANY:1:3,PTR,LEN,OFFS ASSIGNED? 'LEN /?CND1 GETB PTR,2 >LEN ?CND1: ASSIGNED? 'OFFS /?PRG5 GETB PTR,3 >OFFS ?PRG5: DLESS? 'LEN,0 /TRUE GETB P-INBUF,OFFS PRINTC STACK INC 'OFFS JUMP ?PRG5 .FUNCT DO-OOPS:ANY:1:1,OWINNER,PTR,VAL SET 'PTR,P-LEXSTART GET TLEXV,P-LEXELEN EQUAL? STACK,W?PERIOD,W?COMMA \?CND1 ADD PTR,P-LEXELEN >PTR DEC 'P-LEN ?CND1: GRTR? P-LEN,1 /?CCL5 ICALL1 NAKED-OOPS RFALSE ?CCL5: CALL2 META-LOC,OWINNER EQUAL? HERE,STACK /?CCL7 ICALL2 NOT-HERE,OWINNER RFALSE ?CCL7: GET OOPS-TABLE,O-PTR >VAL ZERO? VAL /?CCL9 SUB P-LEN,1 ICALL REPLACE-ONE-TOKEN,STACK,P-LEXV,PTR,G-LEXV,VAL SET 'WINNER,OWINNER ICALL2 COPY-INPUT,TRUE-VALUE RTRUE ?CCL9: PUT OOPS-TABLE,O-END,FALSE-VALUE ICALL1 CANT-OOPS RFALSE .FUNCT DO-AGAIN:ANY:1:1,OWINNER,N,?TMP1,?TMP2 CALL2 META-LOC,OWINNER EQUAL? HERE,STACK /?CCL3 ICALL2 NOT-HERE,OWINNER RFALSE ?CCL3: LESS? 0,P-OFLAG /?CTR4 ZERO? P-WON /?CTR4 GETB G-INBUF,2 ZERO? STACK \?CCL5 ?CTR4: ICALL1 CANT-AGAIN RFALSE ?CCL5: GRTR? P-LEN,1 \?CND1 SUB TLEXV,P-LEXV LESS? STACK,234 \?CND1 GET TLEXV,P-LEXELEN >N EQUAL? N,W?PERIOD,W?COMMA,W?THEN /?CND1 EQUAL? N,W?AND /?CND1 ICALL1 DONT-UNDERSTAND RFALSE ?CND1: SET 'N,P-WORDS-AGAIN SET 'WINNER,OWINNER EQUAL? N,1 /?CND16 SUB N,1 ADD P-LEN,STACK >P-LEN SUB N,1 >?TMP2 SUB TLEXV,P-LEXV DIV STACK,2 >?TMP1 GET OOPS-TABLE,O-START SUB STACK,P-LEXV DIV STACK,2 ICALL MAKE-ROOM-FOR-TOKENS,?TMP2,P-LEXV,?TMP1,STACK ZERO? P-CONT /?CND16 SUB N,1 MUL STACK,4 ADD P-CONT,STACK >P-CONT ?CND16: GET OOPS-TABLE,O-START SUB STACK,P-LEXV ADD G-LEXV,STACK >?TMP1 MUL N,4 COPYT ?TMP1,TLEXV,STACK RTRUE .FUNCT NP-SAVE:ANY:1:1,ROBJ,TMP COPYT SEARCH-RES,ORPHAN-SR,20 COPYT ROBJ,ORPHAN-NP,20 GET ROBJ,5 >TMP ZERO? TMP /?CCL3 GET TMP,2 COPYT STACK,ORPHAN-NP2,10 PUT ORPHAN-NP,5,ORPHAN-NP2 JUMP ?CND1 ?CCL3: GET ROBJ,4 >TMP ZERO? TMP /?CCL5 COPYT TMP,ORPHAN-NP2,20 PUT ORPHAN-NP,4,ORPHAN-NP2 JUMP ?CND1 ?CCL5: GET ROBJ,6 >TMP ZERO? TMP /?CND1 COPYT TMP,ORPHAN-NP2,20 PUT ORPHAN-NP,6,ORPHAN-NP2 ?CND1: GET ROBJ,1 >TMP ZERO? TMP /?CCL9 COPYT TMP,ORPHAN-ADJS,18 PUT ORPHAN-NP,1,ORPHAN-ADJS GET TMP,2 >TMP GRTR? 0,TMP /?CCL12 GRTR? TMP,LAST-OBJECT /?CCL12 PUT ORPHAN-ADJS,2,TMP RETURN ORPHAN-NP ?CCL12: COPYT TMP,ORPHAN-NP2,20 GET ORPHAN-NP2,1 CALL2 PMEM?,STACK ZERO? STACK /?CND15 PUT ORPHAN-NP2,1,FALSE-VALUE ?CND15: PUT ORPHAN-ADJS,2,ORPHAN-NP2 RETURN ORPHAN-NP ?CCL9: PUT ORPHAN-NP,1,0 RETURN ORPHAN-NP .FUNCT PARSER-ERROR:ANY:0:5,STR,CLASS,OTHER,OTHER2,OTHER3,RP ZERO? CURRENT-REDUCTION /FALSE GET CURRENT-REDUCTION,2 >RP GRTR? ERROR-PRIORITY,RP /?CCL3 EQUAL? ERROR-PRIORITY,RP \FALSE EQUAL? CLASS,PARSER-ERROR-ORPH-NP /?CCL3 EQUAL? CLASS,PARSER-ERROR-NOUND /FALSE GET ERROR-ARGS,1 EQUAL? STACK,PARSER-ERROR-NOUND \FALSE ?CCL3: SET 'ERROR-PRIORITY,RP SET 'ERROR-STRING,STR ZERO? CLASS /?CCL14 PUT ERROR-ARGS,0,3 PUT ERROR-ARGS,1,CLASS PUT ERROR-ARGS,2,OTHER PUT ERROR-ARGS,3,OTHER2 CALL2 PMEM?,OTHER ZERO? STACK /FALSE GETB OTHER,1 EQUAL? STACK,4 \?CND17 GET OTHER,4 >OTHER ?CND17: GETB OTHER,1 EQUAL? STACK,2 \FALSE CALL2 NP-SAVE,OTHER PUT ERROR-ARGS,2,STACK EQUAL? CLASS,PARSER-ERROR-NOOBJ \FALSE GET OTHER,3 ZERO? STACK \FALSE PUT ERROR-ARGS,3,OTHER3 RFALSE ?CCL14: PUT ERROR-ARGS,0,0 RFALSE .FUNCT BUZZER-WORD?:ANY:2:2,WD,PTR RFALSE .FUNCT NUMBER?:ANY:1:1,RLEXV,BPTR,SUM,TIM,NEG,CHR,CNT,?TMP1 GETB RLEXV,3 >BPTR GETB RLEXV,2 >CNT ?PRG1: DLESS? 'CNT,0 /?REP2 GETB P-INBUF,BPTR >CHR EQUAL? CHR,58 \?CCL8 SET 'TIM,SUM SET 'SUM,0 JUMP ?CND6 ?CCL8: EQUAL? CHR,45 \?CCL10 ZERO? NEG \FALSE SET 'NEG,TRUE-VALUE JUMP ?CND6 ?CCL10: GRTR? CHR,57 /FALSE LESS? CHR,48 /FALSE GRTR? SUM,3276 /FALSE MUL SUM,10 >?TMP1 SUB CHR,48 ADD ?TMP1,STACK >SUM ?CND6: INC 'BPTR JUMP ?PRG1 ?REP2: ZERO? TIM /?CCL22 GRTR? TIM,23 /FALSE ZERO? NEG \FALSE MUL TIM,60 ADD SUM,STACK >SUM ICALL CHANGE-LEXV,RLEXV,W?INT.TIM,BPTR,SUM RETURN W?INT.TIM ?CCL22: ZERO? NEG /?CND27 SUB 0,SUM >SUM ?CND27: ICALL CHANGE-LEXV,RLEXV,W?INT.NUM,BPTR,SUM RETURN W?INT.NUM .FUNCT CHANGE-LEXV:ANY:2:4,PTR,WRD,BPTR,SUM,X PUT PTR,0,WRD SUB PTR,P-LEXV ADD G-LEXV,STACK >X PUT X,0,WRD ASSIGNED? 'BPTR \FALSE PUT PTR,1,SUM PUT X,1,SUM SET 'P-NUMBER,SUM RETURN P-NUMBER .FUNCT TELL-GWIM-MSG:ANY:0:0,WD,VB PRINTC 91 GET GWIM-MSG,0 >WD ZERO? WD /?CND1 PRINTB WD PRINTC 32 GET PARSER-RESULT,1 >VB EQUAL? VB,W?SIT,W?LIE \?CCL5 EQUAL? WD,W?DOWN \?CND1 PRINTI "on " JUMP ?CND1 ?CCL5: EQUAL? VB,W?GET \?CND1 EQUAL? WD,W?OUT \?CND1 PRINTI "of " ?CND1: GET GWIM-MSG,1 ICALL2 THE-PRINT,STACK PRINTR "]" .ENDSEG .ENDI