.SEGMENT "0" .FUNCT INIT-STATUS-LINE:ANY:0:1,PW?,CW,Y,Y1,N,?TMP2,?TMP1 ASSIGNED? 'PW? /?CND1 SET 'PW?,TRUE-VALUE ?CND1: GET 0,18 SUB STACK,GL-FONT-Y >N ZERO? PW? /?CCL5 DIV N,2 ADD 1,STACK ADD STACK,GL-FONT-Y >?TMP1 MUL 27,GL-FONT-X ADD 1,STACK WINPOS 0,?TMP1,STACK ADD N,1 DIV STACK,2 >?TMP1 GET 0,17 >?TMP2 MUL 27,GL-FONT-X SUB ?TMP2,STACK WINSIZE 0,?TMP1,STACK ADD 1,GL-FONT-Y >?TMP1 MUL 27,GL-FONT-X ADD 1,STACK WINPOS 6,?TMP1,STACK DIV N,2 >?TMP1 GET 0,17 >?TMP2 MUL 27,GL-FONT-X SUB ?TMP2,STACK WINSIZE 6,?TMP1,STACK JUMP ?CND3 ?CCL5: ADD 1,GL-FONT-Y >?TMP1 MUL 27,GL-FONT-X ADD 1,STACK WINPOS 0,?TMP1,STACK GET 0,18 SUB STACK,GL-FONT-Y >?TMP1 GET 0,17 >?TMP2 MUL 27,GL-FONT-X SUB ?TMP2,STACK WINSIZE 0,?TMP1,STACK WINPOS 6,1,1 WINSIZE 6,0,0 ?CND3: WINPOS 1,1,1 GET 0,17 WINSIZE 1,GL-FONT-Y,STACK GET 0,18 SUB STACK,GL-FONT-Y ADD STACK,1 WINPOS 2,STACK,1 GET 0,17 WINSIZE 2,GL-FONT-Y,STACK MUL 3,GL-FONT-Y ADD 1,STACK WINPOS 3,STACK,1 GET 0,18 >?TMP2 MUL 3,GL-FONT-Y SUB ?TMP2,STACK >?TMP1 MUL 10,GL-FONT-X WINSIZE 3,?TMP1,STACK MUL 3,GL-FONT-Y ADD 1,STACK >?TMP1 MUL 11,GL-FONT-X ADD 1,STACK WINPOS 4,?TMP1,STACK GET 0,18 >?TMP2 MUL 3,GL-FONT-Y SUB ?TMP2,STACK >?TMP1 MUL 15,GL-FONT-X WINSIZE 4,?TMP1,STACK ADD GL-FONT-Y,1 WINPOS 5,STACK,1 MUL 2,GL-FONT-Y >?TMP1 MUL 27,GL-FONT-X WINSIZE 5,?TMP1,STACK WINPOS 7,1,1 GET 0,18 >?TMP1 GET 0,17 WINSIZE 7,?TMP1,STACK SCREEN 7 HLIGHT K-H-INV WINGET 3,K-W-YPOS >Y WINGET 3,K-W-YSIZE ADD Y,STACK SUB STACK,1 >Y1 ?PRG6: CALL2 C-PIXELS,11 CURSET Y,STACK PRINTC 32 CALL2 C-PIXELS,27 CURSET Y,STACK PRINTC 32 ADD Y,GL-FONT-Y >Y GRTR? Y,Y1 \?PRG6 HLIGHT K-H-NRM SCREEN 5 WINGET 5,K-W-XSIZE DIV STACK,GL-SPACE-WIDTH >N PUTB K-DIROUT-TBL,0,32 ADD K-DIROUT-TBL,1 >?TMP1 SUB 0,N COPYT K-DIROUT-TBL,?TMP1,STACK CURSET 1,1 HLIGHT K-H-INV PRINTT K-DIROUT-TBL,N CURSET 1,1 PRINTI "EXECUTE" ICALL CCURSET,1,13 PRINTI "DELETE" ICALL CCURSET,2,1 PRINTT K-DIROUT-TBL,N ICALL CCURSET,2,1 PRINTI "UP" ICALL CCURSET,2,7 PRINTI "DN" ICALL CCURSET,2,13 PRINTI "UP" ICALL CCURSET,2,24 PRINTI "DN" HLIGHT K-H-NRM SCREEN 1 CURSET 1,1 WINGET 1,K-W-XSIZE DIV STACK,GL-SPACE-WIDTH >N PUTB K-DIROUT-TBL,0,32 ADD K-DIROUT-TBL,1 >?TMP1 SUB 0,N COPYT K-DIROUT-TBL,?TMP1,STACK HLIGHT H-INVERSE PRINTT K-DIROUT-TBL,N HLIGHT H-NORMAL SCREEN 0 SET 'GL-SL-HERE,FALSE-VALUE RTRUE .FUNCT UPDATE-STATUS-LINE:ANY:0:0,C,CW,N,H,M,S,?TMP1 SCREEN 1 HLIGHT K-H-INV EQUAL? HERE,GL-SL-HERE /?CND1 SET 'GL-SL-HERE,HERE CURSET 1,1 WINGET 1,K-W-XSIZE >?TMP1 WINGET 1,K-W-XCURPOS SUB ?TMP1,STACK DIV STACK,GL-SPACE-WIDTH >N PUTB K-DIROUT-TBL,0,32 ADD K-DIROUT-TBL,1 >?TMP1 SUB 0,N COPYT K-DIROUT-TBL,?TMP1,STACK PRINTT K-DIROUT-TBL,N CURSET 1,1 DIROUT K-D-TBL-ON,K-DIROUT-TBL ICALL2 RT-PRINT-DESC,HERE DIROUT K-D-TBL-OFF GETB K-DIROUT-TBL,2 >C LESS? C,97 /?CND3 GRTR? C,122 /?CND3 SUB C,32 PUTB K-DIROUT-TBL,2,STACK ?CND3: ADD K-DIROUT-TBL,2 >?TMP1 GET K-DIROUT-TBL,0 PRINTT ?TMP1,STACK ?CND1: WINGET 1,K-W-XSIZE >?TMP1 MUL 9,GL-FONT-X SUB ?TMP1,STACK ADD STACK,1 CURSET 1,STACK WINGET 1,K-W-XSIZE >?TMP1 WINGET 1,K-W-XCURPOS SUB ?TMP1,STACK DIV STACK,GL-SPACE-WIDTH >N PUTB K-DIROUT-TBL,0,32 ADD K-DIROUT-TBL,1 >?TMP1 SUB 0,N COPYT K-DIROUT-TBL,?TMP1,STACK PRINTT K-DIROUT-TBL,N MOD GL-MOVES,2880 >N DIV N,120 MOD STACK,24 >H DIV N,2 MOD STACK,60 >M MOD N,2 MUL STACK,30 >S DIROUT K-D-TBL-ON,K-DIROUT-TBL LESS? H,10 \?CND7 PRINTC 48 ?CND7: PRINTN H PRINTC 58 LESS? M,10 \?CND9 PRINTC 48 ?CND9: PRINTN M PRINTC 58 LESS? S,10 \?CND11 PRINTC 48 ?CND11: PRINTN S DIROUT K-D-TBL-OFF WINGET 1,K-W-XSIZE >?TMP1 GET 0,24 SUB ?TMP1,STACK ADD STACK,1 CURSET 1,STACK ADD K-DIROUT-TBL,2 >?TMP1 GET K-DIROUT-TBL,0 PRINTT ?TMP1,STACK HLIGHT K-H-NRM SCREEN 0 RTRUE .FUNCT RT-PRINT-MENU:ANY:1:1,MN,N,L,TBL,W ADD 3,MN >W SCREEN W CLEAR W CURSET 1,1 GET K-MENU-TBL,MN >TBL GETB K-FIRST-ENTRY-TBL,MN >N WINGET -3,K-W-YSIZE DIV STACK,GL-FONT-Y ADD N,STACK SUB STACK,1 >L GET TBL,0 LESS? STACK,L \?PRG3 GET TBL,0 >L ?PRG3: GRTR? N,L /TRUE ICALL RT-PRINT-MENU-ENTRY,MN,N CRLF INC 'N JUMP ?PRG3 .FUNCT RT-PRINT-MENU-ENTRY:ANY:2:2,MN,N,L,ITEM,TBL,W,T GET K-MENU-TBL,MN >TBL ZERO? TBL /FALSE GET TBL,N >ITEM ZERO? ITEM /FALSE GETB K-MENU-TBL-TYPE,MN >T EQUAL? T,K-MENU-ONE-WORD \?CCL8 PRINTB ITEM RTRUE ?CCL8: EQUAL? T,K-MENU-MANY-WORD \?CCL10 GET ITEM,0 >L ADD ITEM,2 >ITEM ?PRG11: DLESS? 'L,0 /TRUE GET ITEM,0 >W ZERO? W /?CCL18 PRINTB W JUMP ?CND16 ?CCL18: PRINTC 126 ?CND16: GRTR? L,0 \?CND19 PRINTC 32 ?CND19: ADD ITEM,2 >ITEM JUMP ?PRG11 ?CCL10: EQUAL? T,K-MENU-OBJECT \FALSE ADD LAST-OBJECT,1 EQUAL? ITEM,STACK \?CCL25 PRINTI "all" RTRUE ?CCL25: GETP ITEM,P?MENU >W ZERO? W /?CCL27 PRINT W RTRUE ?CCL27: CALL2 RT-PRINT-DESC,ITEM RSTACK .FUNCT RT-HLIGHT-MENU:ANY:2:3,MN,L,ON?,Y,TBL,N,?TMP1 ASSIGNED? 'ON? /?CND1 SET 'ON?,TRUE-VALUE ?CND1: ADD 3,MN SCREEN STACK GETB K-FIRST-ENTRY-TBL,MN SUB L,STACK ADD STACK,1 >Y CALL2 L-PIXELS,Y CURSET STACK,1 ZERO? ON? /?CND3 HLIGHT K-H-INV ?CND3: ICALL RT-PRINT-MENU-ENTRY,MN,L ZERO? ON? /?CCL7 WINGET -3,K-W-XSIZE >?TMP1 WINGET -3,K-W-XCURPOS SUB ?TMP1,STACK DIV STACK,GL-SPACE-WIDTH >N PUTB K-DIROUT-TBL,0,32 ADD K-DIROUT-TBL,1 >?TMP1 SUB 0,N COPYT K-DIROUT-TBL,?TMP1,STACK PRINTT K-DIROUT-TBL,N HLIGHT K-H-NRM RTRUE ?CCL7: ERASE 1 RTRUE .FUNCT RT-GET-PREPS:ANY:2:3,ACT,TBL,PREP,PTR,L,M,N,P ASSIGNED? 'PREP /?CND1 SET 'PREP,-1 ?CND1: EQUAL? PREP,-1 \?CCL5 SET 'L,1 JUMP ?PRG6 ?CCL5: SET 'L,3 ?PRG6: EQUAL? L,1 \?CCL10 GET ACT,2 >PTR JUMP ?CND8 ?CCL10: GET ACT,3 >PTR ?CND8: ZERO? PTR /?CND11 GET PTR,0 >M ADD PTR,2 >PTR GET TBL,0 >N ?PRG13: DLESS? 'M,0 /?CND11 EQUAL? PREP,-1 \?CCL20 GET PTR,1 >P JUMP ?CND18 ?CCL20: GET PTR,3 >P ?CND18: ZERO? P /?CND21 EQUAL? PREP,-1 /?CCL24 GET PTR,1 EQUAL? PREP,STACK \?CND21 ?CCL24: ADD TBL,2 INTBL? P,STACK,N /?CND21 INC 'N PUT TBL,N,P PUT TBL,0,N ?CND21: EQUAL? L,1 \?CCL31 ADD PTR,6 >PTR JUMP ?PRG13 ?CCL31: ADD PTR,10 >PTR JUMP ?PRG13 ?CND11: EQUAL? L,1 \TRUE SET 'L,3 JUMP ?PRG6 .FUNCT RT-GET-OBJS:ANY:1:3,TBL,CONT,SEARCH,OBJ,N,PTR,ADD? ASSIGNED? 'CONT /?CND1 SET 'CONT,HERE ?CND1: ASSIGNED? 'SEARCH /?CND3 SET 'SEARCH,15 ?CND3: FIRST? CONT >OBJ /?PRG6 ?PRG6: ZERO? OBJ /TRUE FSET? OBJ,FL-INVISIBLE /?CND8 IN? CONT,ROOMS \?CCL14 BAND SEARCH,1 >ADD? JUMP ?CND12 ?CCL14: EQUAL? CONT,CH-PLAYER \?CCL16 BAND SEARCH,4 >ADD? JUMP ?CND12 ?CCL16: SET 'ADD?,TRUE-VALUE ?CND12: ZERO? ADD? /?CND17 GET TBL,0 ADD STACK,1 >N PUT TBL,N,OBJ PUT TBL,0,N ?CND17: IN? CONT,ROOMS \?PRD22 BTST SEARCH,2 /?CCL20 ?PRD22: EQUAL? CONT,CH-PLAYER \?CND8 BTST SEARCH,8 \?CND8 ?CCL20: CALL2 CLOSED?,OBJ ZERO? STACK \?CND8 ICALL RT-GET-OBJS,TBL,OBJ,SEARCH ?CND8: NEXT? OBJ >OBJ /?PRG6 JUMP ?PRG6 .FUNCT RT-DO-OBJECTS:ANY:0:1,SEARCH,PTR,I,N,OBJ,STR ASSIGNED? 'SEARCH /?CND1 SET 'SEARCH,31 ?CND1: BTST SEARCH,16 \?CND3 ADD LAST-OBJECT,1 PUT K-OBJECT-TBL,1,STACK PUT K-OBJECT-TBL,0,1 ?CND3: ICALL RT-GET-OBJS,K-OBJECT-TBL,HERE,SEARCH GETPT HERE,P?GLOBAL >PTR PTSIZE PTR DIV STACK,2 >N ?PRG5: DLESS? 'N,0 /?REP6 GET K-OBJECT-TBL,0 ADD STACK,1 >I GET PTR,0 PUT K-OBJECT-TBL,I,STACK PUT K-OBJECT-TBL,0,I ADD PTR,2 >PTR JUMP ?PRG5 ?REP6: RETURN K-OBJECT-TBL .FUNCT RT-GET-MEM:ANY:1:1,N,PTR SET 'PTR,GL-FREE-PTR ADD N,1 MUL 2,STACK ADD GL-FREE-PTR,STACK >GL-FREE-PTR PUT PTR,0,N RETURN PTR .FUNCT RT-FREE-MEM:ANY:1:4,PTR,N,P,L ASSIGNED? 'N /?CND1 SET 'N,-1 ?CND1: LESS? N,0 \?CND3 GET PTR,0 >N ?CND3: ADD N,1 MUL 2,STACK >L ADD PTR,L >P SUB GL-FREE-PTR,P COPYT P,PTR,STACK SUB GL-FREE-PTR,L >GL-FREE-PTR RETURN GL-FREE-PTR .FUNCT RT-STOP-READ:ANY:0:0 SET 'GL-INPUT-TIMEOUT,TRUE-VALUE RTRUE .FUNCT MOUSE-INPUT?:ANY:0:5,W,X1,Y1,X2,Y2,N GET 0,27 GET STACK,1 >GL-MOUSE-X GET 0,27 GET STACK,2 >GL-MOUSE-Y ASSIGNED? 'W \TRUE ASSIGNED? 'X1 /?CCL5 EQUAL? W,-1 /TRUE WINGET W,K-W-XPOS >X1 WINGET W,K-W-YPOS >Y1 WINGET W,K-W-XSIZE ADD X1,STACK SUB STACK,1 >X2 WINGET W,K-W-YSIZE ADD Y1,STACK SUB STACK,1 >Y2 LESS? GL-MOUSE-X,X1 /FALSE GRTR? GL-MOUSE-X,X2 /FALSE LESS? GL-MOUSE-Y,Y1 /FALSE GRTR? GL-MOUSE-Y,Y2 /FALSE SUB GL-MOUSE-X,X1 ADD STACK,1 >GL-MOUSE-X SUB GL-MOUSE-Y,Y1 ADD STACK,1 >GL-MOUSE-Y RTRUE ?CCL5: EQUAL? W,-1 /?CND16 WINGET W,K-W-XPOS SUB STACK,1 >N ADD X1,N >X1 ADD X2,N >X2 WINGET W,K-W-YPOS SUB STACK,1 >N ADD Y1,N >Y1 ADD Y2,N >Y2 ?CND16: LESS? GL-MOUSE-X,X1 /FALSE GRTR? GL-MOUSE-X,X2 /FALSE LESS? GL-MOUSE-Y,Y1 /FALSE GRTR? GL-MOUSE-Y,Y2 /FALSE SUB GL-MOUSE-X,X1 ADD STACK,1 >GL-MOUSE-X SUB GL-MOUSE-Y,Y1 ADD STACK,1 >GL-MOUSE-Y RTRUE .FUNCT READ-INPUT:ANY:0:0,C,L,M,N,TBL,ACT,S?,Y,X,W,?TMP1 MOUSE-LIMIT -1 SET 'GL-FREE-PTR,K-JUNK-TBL SET 'GL-VERB-TBL,K-DEFAULT-VERB-TBL SET 'GL-PREP-TBL,FALSE-VALUE CALL1 RT-DO-OBJECTS >GL-NOUN-TBL PUTB K-FIRST-ENTRY-TBL,0,1 PUTB K-FIRST-ENTRY-TBL,1,1 PUTB K-MENU-TBL-TYPE,0,K-MENU-MANY-WORD PUTB K-MENU-TBL-TYPE,1,K-MENU-OBJECT PUT K-MENU-TBL,0,GL-VERB-TBL PUT K-MENU-TBL,1,GL-NOUN-TBL SET 'GL-INPUT-WINNER,CH-PLAYER SET 'GL-INPUT-VERB,FALSE-VALUE SET 'GL-INPUT-PREP1,FALSE-VALUE SET 'GL-INPUT-PREP2,FALSE-VALUE SET 'GL-MENU-NUM,0 SET 'GL-ITEM-NUM,0 SET 'GL-INPUT-STATE,0 ICALL2 RT-PRINT-MENU,0 ICALL2 RT-PRINT-MENU,1 GET K-MENU-TBL,GL-MENU-NUM >TBL SET 'L,1 SCREEN 0 WINATTR 0,A-BUFFER,O-CLEAR WINGET 0,K-W-YCURPOS >Y PRINTC 62 PUTB P-INBUF,1,0 ?PRG1: SET 'S?,FALSE-VALUE ICALL RT-HLIGHT-MENU,GL-MENU-NUM,L SCREEN 0 READ P-INBUF,P-LEXV >C GETB P-INBUF,1 >N EQUAL? C,K-CLICK1,K-CLICK2 \?CND3 SET 'W,3 ?PRG5: CALL2 MOUSE-INPUT?,W ZERO? STACK \?REP6 IGRTR? 'W,5 \?PRG5 SET 'W,-1 ?REP6: EQUAL? W,3,4 \?CCL13 SUB W,3 >W SUB GL-MOUSE-Y,1 DIV STACK,GL-FONT-Y >?TMP1 GETB K-FIRST-ENTRY-TBL,W ADD ?TMP1,STACK >M EQUAL? L,M \?CCL15 EQUAL? GL-MENU-NUM,W /?CND14 ?CCL15: GET K-MENU-TBL,W GET STACK,0 GRTR? M,STACK /?CCL20 ICALL RT-HLIGHT-MENU,GL-MENU-NUM,L,FALSE-VALUE ICALL RT-HLIGHT-MENU,W,M ?CND14: SET 'GL-MENU-NUM,W GET K-MENU-TBL,GL-MENU-NUM >TBL SET 'L,M SET 'C,K-F1 JUMP ?CND3 ?CCL20: SOUND S-BEEP JUMP ?PRG1 ?CCL13: EQUAL? W,5 \?CCL22 CALL2 PIXELS-L,GL-MOUSE-Y >Y CALL2 PIXELS-C,GL-MOUSE-X >X EQUAL? Y,1 \?CCL25 LESS? X,13 \?CCL28 SET 'C,CR CRLF JUMP ?CND3 ?CCL28: SET 'C,K-F2 JUMP ?CND3 ?CCL25: LESS? X,4 \?CCL31 SET 'C,K-F3 SET 'W,0 JUMP ?CND29 ?CCL31: LESS? X,7 /?CCL33 LESS? X,10 \?CCL33 SET 'C,K-F4 SET 'W,0 JUMP ?CND29 ?CCL33: LESS? X,13 /?CCL37 LESS? X,16 \?CCL37 SET 'C,K-F3 SET 'W,1 JUMP ?CND29 ?CCL37: LESS? X,24 /?CCL41 LESS? X,27 \?CCL41 SET 'C,K-F4 SET 'W,1 ?CND29: EQUAL? GL-MENU-NUM,W /?CND3 GET K-MENU-TBL,W >M GET M,0 GRTR? STACK,0 \?CCL48 ICALL RT-HLIGHT-MENU,GL-MENU-NUM,L,FALSE-VALUE SET 'TBL,M GETB K-FIRST-ENTRY-TBL,W >L SET 'GL-MENU-NUM,W GET TBL,0 GRTR? L,STACK \?CCL51 GET TBL,0 >L JUMP ?CND3 ?CCL41: SOUND S-BEEP JUMP ?PRG1 ?CCL51: GET TBL,L ZERO? STACK \?CND3 INC 'L ?CND3: SCREEN 0 EQUAL? C,CR,LF /?REP2 EQUAL? C,32 \?CCL57 ADD P-INBUF,2 PUTB STACK,N,32 PRINTC 32 INC 'N PUTB P-INBUF,1,N JUMP ?CND53 ?CCL48: SOUND S-BEEP JUMP ?PRG1 ?CCL22: SOUND S-BEEP JUMP ?PRG1 ?CCL57: EQUAL? C,K-F1 \?CCL59 ZERO? TBL /?CCL62 GET TBL,0 GRTR? STACK,0 \?CCL62 DIROUT K-D-TBL-ON,K-DIROUT-TBL ICALL RT-PRINT-MENU-ENTRY,GL-MENU-NUM,L DIROUT K-D-TBL-OFF GET K-DIROUT-TBL,0 >M SHIFT GL-INPUT-STATE,8 BOR N,STACK PUT K-ITEM-TBL,GL-ITEM-NUM,STACK GRTR? N,0 \?CND65 ADD P-INBUF,2 >?TMP1 SUB N,1 GETB ?TMP1,STACK EQUAL? STACK,32 /?CND65 ADD P-INBUF,2 PUTB STACK,N,32 PRINTC 32 INC 'N ?CND65: ADD K-DIROUT-TBL,2 >?TMP1 ADD 2,N ADD P-INBUF,STACK COPYT ?TMP1,STACK,M ADD K-DIROUT-TBL,2 PRINTT STACK,M ADD N,M >N ZERO? GL-INPUT-STATE \?CCL71 EQUAL? GL-MENU-NUM,1 \?CCL71 ADD P-INBUF,2 PUTB STACK,N,44 PRINTC 44 INC 'N JUMP ?CND69 ?CCL71: EQUAL? GL-INPUT-STATE,0,1 \?CND69 ZERO? GL-MENU-NUM \?CND69 GET TBL,L GET STACK,1 GET STACK,4 BTST STACK,64 \?CND69 ADD P-INBUF,2 PUTB STACK,N,46 PRINTC 46 INC 'N ?CND69: ADD P-INBUF,2 PUTB STACK,N,32 PRINTC 32 INC 'N PUTB P-INBUF,1,N LEX P-INBUF,P-LEXV INC 'GL-ITEM-NUM INPUT 1,1,RT-STOP-READ EQUAL? GL-INPUT-STATE,0,1 \?CCL80 ZERO? GL-MENU-NUM \?CCL80 GET TBL,L GET STACK,1 >GL-INPUT-VERB GET GL-INPUT-VERB,4 BTST STACK,64 \?CCL85 SET 'GL-INPUT-STATE,0 GETB K-FIRST-ENTRY-TBL,0 EQUAL? STACK,1 \?CCL88 ICALL RT-HLIGHT-MENU,GL-MENU-NUM,L,FALSE-VALUE JUMP ?CND86 ?CCL88: PUTB K-FIRST-ENTRY-TBL,1,1 ICALL2 RT-PRINT-MENU,GL-MENU-NUM ?CND86: SET 'L,1 JUMP ?CND53 ?CCL85: SET 'GL-INPUT-STATE,2 GET TBL,L >M GET M,0 GRTR? STACK,1 \?CND89 GET M,2 >GL-INPUT-PREP1 ?CND89: GET GL-INPUT-VERB,3 >ACT ZERO? GL-PREP-TBL /?CND91 ICALL2 RT-FREE-MEM,GL-PREP-TBL ?CND91: SET 'GL-PREP-TBL,GL-FREE-PTR PUT GL-PREP-TBL,0,0 ICALL RT-GET-PREPS,ACT,GL-PREP-TBL GET GL-PREP-TBL,0 ADD STACK,1 MUL STACK,2 ADD GL-FREE-PTR,STACK >GL-FREE-PTR PUT K-MENU-TBL,0,GL-PREP-TBL PUTB K-FIRST-ENTRY-TBL,0,1 PUTB K-MENU-TBL-TYPE,0,K-MENU-ONE-WORD ICALL2 RT-PRINT-MENU,0 SET 'TBL,FALSE-VALUE GET GL-NOUN-TBL,0 GRTR? STACK,0 \?CND53 SET 'S?,TRUE-VALUE JUMP ?CND53 ?CCL80: ZERO? GL-INPUT-STATE \?CCL96 EQUAL? GL-MENU-NUM,1 \?CND53 SET 'GL-INPUT-STATE,1 SET 'S?,TRUE-VALUE JUMP ?CND53 ?CCL96: EQUAL? GL-INPUT-STATE,2 \?CCL100 EQUAL? GL-MENU-NUM,1 /?CCL102 ZERO? GL-MENU-NUM \?CND53 ZERO? GL-INPUT-PREP1 \?CND53 ?CCL102: EQUAL? GL-MENU-NUM,1 \?CCL109 INC 'GL-INPUT-STATE JUMP ?CND107 ?CCL109: GET TBL,L >GL-INPUT-PREP1 GETB K-MENU-TBL-TYPE,GL-MENU-NUM EQUAL? STACK,K-MENU-MANY-WORD \?CND107 GET GL-INPUT-PREP1,1 >GL-INPUT-PREP1 ?CND107: ZERO? GL-PREP-TBL /?CND112 ICALL2 RT-FREE-MEM,GL-PREP-TBL ?CND112: SET 'GL-PREP-TBL,GL-FREE-PTR PUT GL-PREP-TBL,0,0 GET GL-INPUT-VERB,3 ICALL RT-GET-PREPS,STACK,GL-PREP-TBL,GL-INPUT-PREP1 GET GL-PREP-TBL,0 ADD STACK,1 MUL STACK,2 ADD GL-FREE-PTR,STACK >GL-FREE-PTR PUT K-MENU-TBL,0,GL-PREP-TBL PUTB K-FIRST-ENTRY-TBL,0,1 PUTB K-MENU-TBL-TYPE,0,K-MENU-ONE-WORD ICALL2 RT-PRINT-MENU,0 SET 'S?,TRUE-VALUE JUMP ?CND53 ?CCL100: EQUAL? GL-INPUT-STATE,3 \?CND53 ZERO? GL-MENU-NUM \?CND53 INC 'GL-INPUT-STATE SET 'S?,TRUE-VALUE JUMP ?CND53 ?CCL62: SOUND S-BEEP JUMP ?CND53 ?CCL59: EQUAL? C,K-F2 \?CCL118 GRTR? GL-ITEM-NUM,0 \?CCL121 DEC 'GL-ITEM-NUM GET K-ITEM-TBL,GL-ITEM-NUM >N SHIFT N,-8 >M BAND N,255 >N PUTB P-INBUF,1,N CURGET K-WIN-TBL GET K-WIN-TBL,0 CURSET STACK,1 ERASE 1 PRINTC 62 ADD P-INBUF,2 PRINTT STACK,N EQUAL? GL-INPUT-STATE,M /?CND122 EQUAL? M,0,1 \?CCL126 PUTB K-FIRST-ENTRY-TBL,0,1 PUTB K-FIRST-ENTRY-TBL,1,1 PUTB K-MENU-TBL-TYPE,0,K-MENU-MANY-WORD PUTB K-MENU-TBL-TYPE,1,K-MENU-OBJECT PUT K-MENU-TBL,0,GL-VERB-TBL PUT K-MENU-TBL,1,GL-NOUN-TBL SET 'GL-MENU-NUM,0 JUMP ?CND124 ?CCL126: EQUAL? M,2,3,4 \?CND124 ZERO? GL-PREP-TBL /?CND128 ICALL2 RT-FREE-MEM,GL-PREP-TBL ?CND128: SET 'GL-PREP-TBL,GL-FREE-PTR PUT GL-PREP-TBL,0,0 GET GL-INPUT-VERB,3 >ACT EQUAL? M,2 \?CCL132 ICALL RT-GET-PREPS,ACT,GL-PREP-TBL JUMP ?CND130 ?CCL132: ICALL RT-GET-PREPS,ACT,GL-PREP-TBL,GL-INPUT-PREP1 ?CND130: GET GL-PREP-TBL,0 ADD STACK,1 MUL STACK,2 ADD GL-FREE-PTR,STACK >GL-FREE-PTR PUTB K-FIRST-ENTRY-TBL,0,1 PUTB K-FIRST-ENTRY-TBL,1,1 PUTB K-MENU-TBL-TYPE,0,K-MENU-ONE-WORD PUTB K-MENU-TBL-TYPE,1,K-MENU-OBJECT PUT K-MENU-TBL,0,GL-PREP-TBL PUT K-MENU-TBL,1,GL-NOUN-TBL EQUAL? M,3 \?CCL135 SET 'GL-MENU-NUM,0 JUMP ?CND124 ?CCL135: SET 'GL-MENU-NUM,1 ?CND124: ICALL2 RT-PRINT-MENU,0 ICALL2 RT-PRINT-MENU,1 SET 'GL-INPUT-STATE,M ?CND122: GET K-MENU-TBL,GL-MENU-NUM >TBL SET 'L,1 JUMP ?CND53 ?CCL121: SOUND S-BEEP JUMP ?CND53 ?CCL118: EQUAL? C,K-F3 \?CCL137 ADD 3,GL-MENU-NUM SCREEN STACK GETB K-FIRST-ENTRY-TBL,GL-MENU-NUM >M WINGET -3,K-W-YSIZE DIV STACK,GL-FONT-Y >N GRTR? M,1 \?CCL140 SUB M,N LESS? STACK,1 \?CCL143 PUTB K-FIRST-ENTRY-TBL,GL-MENU-NUM,1 GRTR? L,N \?CND141 SUB L,N >L JUMP ?CND141 ?CCL143: SUB M,N PUTB K-FIRST-ENTRY-TBL,GL-MENU-NUM,STACK SUB L,N >L ?CND141: LESS? L,1 \?CCL148 SET 'L,1 JUMP ?CND146 ?CCL148: GET TBL,L ZERO? STACK \?CND146 DEC 'L ?CND146: ICALL2 RT-PRINT-MENU,GL-MENU-NUM JUMP ?CND53 ?CCL140: GRTR? L,1 \?CCL151 ICALL RT-HLIGHT-MENU,GL-MENU-NUM,L,FALSE-VALUE SET 'L,1 JUMP ?CND53 ?CCL151: SOUND S-BEEP JUMP ?CND53 ?CCL137: EQUAL? C,K-F4 \?CCL153 ADD 3,GL-MENU-NUM SCREEN STACK GETB K-FIRST-ENTRY-TBL,GL-MENU-NUM >M WINGET -3,K-W-YSIZE DIV STACK,GL-FONT-Y >N GET TBL,0 LESS? M,STACK \?CCL156 ADD M,N >?TMP1 GET TBL,0 GRTR? ?TMP1,STACK \?CCL159 GET TBL,0 PUTB K-FIRST-ENTRY-TBL,GL-MENU-NUM,STACK GET TBL,0 >L JUMP ?CND157 ?CCL159: ADD M,N PUTB K-FIRST-ENTRY-TBL,GL-MENU-NUM,STACK ADD L,N >L ?CND157: GET TBL,0 GRTR? L,STACK \?CCL162 GET TBL,0 >L JUMP ?CND160 ?CCL162: GET TBL,L ZERO? STACK \?CND160 INC 'L ?CND160: ICALL2 RT-PRINT-MENU,GL-MENU-NUM JUMP ?CND53 ?CCL156: SOUND S-BEEP JUMP ?CND53 ?CCL153: EQUAL? C,K-UP \?CCL165 GRTR? L,1 \?CCL168 ICALL RT-HLIGHT-MENU,GL-MENU-NUM,L,FALSE-VALUE GETB K-FIRST-ENTRY-TBL,GL-MENU-NUM >M WINGET -3,K-W-YSIZE DIV STACK,GL-FONT-Y >N ?PRG169: EQUAL? L,M \?CND171 SUB 0,GL-FONT-Y SCROLL -3,STACK DEC 'M PUTB K-FIRST-ENTRY-TBL,GL-MENU-NUM,M ?CND171: DLESS? 'L,2 /?CND53 GET TBL,L ZERO? STACK /?PRG169 JUMP ?CND53 ?CCL168: SOUND S-BEEP JUMP ?CND53 ?CCL165: EQUAL? C,K-DOWN \?CCL178 GET TBL,0 LESS? L,STACK \?CCL181 ICALL RT-HLIGHT-MENU,GL-MENU-NUM,L,FALSE-VALUE GETB K-FIRST-ENTRY-TBL,GL-MENU-NUM >M WINGET -3,K-W-YSIZE DIV STACK,GL-FONT-Y >N ?PRG182: GET TBL,0 SUB STACK,1 IGRTR? 'L,STACK /?CND53 ADD M,N EQUAL? L,STACK \?CND186 SCROLL -3,GL-FONT-Y INC 'M PUTB K-FIRST-ENTRY-TBL,GL-MENU-NUM,M ?CND186: GET TBL,L ZERO? STACK /?PRG182 JUMP ?CND53 ?CCL181: SOUND S-BEEP JUMP ?CND53 ?CCL178: EQUAL? C,K-LEFT,K-RIGHT \?CND53 ADD GL-MENU-NUM,1 MOD STACK,2 >M GET K-MENU-TBL,M >N GET N,0 GRTR? STACK,0 \?CCL193 ICALL RT-HLIGHT-MENU,GL-MENU-NUM,L,FALSE-VALUE SET 'TBL,N GETB K-FIRST-ENTRY-TBL,GL-MENU-NUM SUB L,STACK >?TMP1 GETB K-FIRST-ENTRY-TBL,M ADD ?TMP1,STACK >L SET 'GL-MENU-NUM,M GET TBL,0 GRTR? L,STACK \?CCL196 GET TBL,0 >L JUMP ?CND53 ?CCL196: GET TBL,L ZERO? STACK \?CND53 INC 'L JUMP ?CND53 ?CCL193: SOUND S-BEEP ?CND53: ZERO? S? /?PRG1 ADD GL-MENU-NUM,1 MOD STACK,2 >M GET K-MENU-TBL,M GET STACK,0 GRTR? STACK,0 \?PRG1 ZERO? TBL /?CND202 ICALL RT-HLIGHT-MENU,GL-MENU-NUM,L,FALSE-VALUE ?CND202: SET 'GL-MENU-NUM,M GETB K-FIRST-ENTRY-TBL,GL-MENU-NUM EQUAL? STACK,1 /?CND204 PUTB K-FIRST-ENTRY-TBL,GL-MENU-NUM,1 ICALL2 RT-PRINT-MENU,GL-MENU-NUM ?CND204: GET K-MENU-TBL,GL-MENU-NUM >TBL SET 'L,1 JUMP ?PRG1 ?REP2: ICALL1 RT-SCRIPT-INBUF SCREEN 0 WINATTR 0,A-BUFFER,O-SET RETURN C .FUNCT SPECIAL-CONTRACTION?:ANY:1:1,PTR RFALSE .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 TELL-THE:ANY:1:1,OBJ,TMP EQUAL? OBJ,PLAYER \?CCL3 PRINTI "you" RTRUE ?CCL3: CALL2 GET-OWNER,OBJ >TMP ZERO? TMP /?CCL6 EQUAL? TMP,PLAYER \?CCL9 PRINTI "your " JUMP ?CND4 ?CCL9: EQUAL? TMP,OBJ /?CND4 ICALL2 TELL-THE,TMP PRINTI "'s " JUMP ?CND4 ?CCL6: FSET? OBJ,NARTICLEBIT /?CND4 PRINTI "the " ?CND4: CALL2 RT-PRINT-DESC,OBJ RSTACK .FUNCT TELL-CTHE:ANY:1:1,OBJ,TMP EQUAL? OBJ,PLAYER \?CCL3 PRINTI "You" RTRUE ?CCL3: CALL2 GET-OWNER,OBJ >TMP ZERO? TMP /?CCL6 EQUAL? TMP,PLAYER \?CCL9 PRINTI "Your " JUMP ?CND4 ?CCL9: EQUAL? TMP,OBJ /?CND4 ICALL2 TELL-CTHE,TMP PRINTI "'s " JUMP ?CND4 ?CCL6: FSET? OBJ,NARTICLEBIT /?CND4 PRINTI "The " ?CND4: CALL2 RT-PRINT-DESC,OBJ RSTACK .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,64 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,32769 BAND STACK,32767 ZERO? STACK /FALSE RETURN LEN .FUNCT PARSER:ANY:0:0,OWINNER,LEN,N,PV,?TMP1 ZERO? P-DBUG /?CND2 PRINTI "[Reset of PMEM: " PRINTN PMEM-WORDS-USED PRINTI " words used.] " ?CND2: ICALL1 PMEM-RESET SET 'ERROR-PRIORITY,255 SET 'ERROR-STRING,FALSE-VALUE SET 'OWINNER,WINNER GRTR? P-CONT,0 \?CCL6 SET 'TLEXV,P-CONT ZERO? VERBOSITY /?CND7 EQUAL? PLAYER,WINNER \?CND7 CRLF ?CND7: SET 'P-CONT,FALSE-VALUE JUMP ?CND4 ?CCL6: SET 'WINNER,PLAYER ZERO? P-OFLAG \?CND11 GET OOPS-TABLE,O-PTR ZERO? STACK \?CND11 PUT OOPS-TABLE,O-END,FALSE-VALUE ?CND11: LOC WINNER IN? STACK,ROOMS \?CND15 LOC WINNER >HERE ?CND15: ZERO? LIT /?CCL18 EQUAL? HERE,LIT /?CND17 IN? LIT,HERE /?CND17 CALL2 VISIBLE?,LIT ZERO? STACK \?CND17 ?CCL18: CALL1 LIT? >LIT ?CND17: GET 0,8 BTST STACK,F-REFRESH \?CND24 ICALL1 V-$REFRESH ?CND24: ZERO? VERBOSITY /?CND26 CRLF ?CND26: ICALL1 UPDATE-STATUS-LINE ICALL1 READ-INPUT GETB P-LEXV,P-LEXWORDS >LEN ZERO? LEN /?CND29 INTBL? W?QUOTE,P-LEXV+2,LEN,132 >N \?CND29 ICALL FIX-QUOTATIONS,LEN,N ?CND29: ICALL1 EXPAND-BE-CONTRACTIONS GETB P-LEXV,P-LEXWORDS >P-LEN SET 'TLEXV,P-LEXV+2 ?CND4: GET TLEXV,0 EQUAL? STACK,W?PERIOD,W?THEN \?CND33 ADD TLEXV,4 >TLEXV DEC 'P-LEN ?CND33: GET TLEXV,0 EQUAL? STACK,W?YOU \?CND35 ICALL1 IGNORE-FIRST-WORD ?CND35: GET TLEXV,0 EQUAL? STACK,W?GO,W?TO \?CND37 ICALL1 IGNORE-FIRST-WORD ?CND37: ZERO? P-LEN \?CND39 ICALL1 BEG-PARDON RFALSE ?CND39: CALL1 NAKED-DIR? >LEN ZERO? LEN /?CCL43 PUT STATE-STACK,0,20 PUT DATA-STACK,0,20 XPUSH LEN,DATA-STACK /?BOGUS44 ?BOGUS44: 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 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,32769 BAND STACK,32767 ZERO? STACK /TRUE SET 'P-WORDS-AGAIN,P-WORD-NUMBER DLESS? 'P-LEN,1 /TRUE ADD TLEXV,4 >P-CONT RTRUE ?CCL43: GET TLEXV,0 EQUAL? STACK,W?OOPS,W?O \?CCL55 CALL2 DO-OOPS,OWINNER ZERO? STACK \?CND41 RFALSE ?CCL55: ZERO? P-OFLAG \?CND41 LESS? P-CONT,1 \?CND41 PUT OOPS-TABLE,O-END,FALSE-VALUE ?CND41: SET 'P-CONT,FALSE-VALUE GET TLEXV,0 EQUAL? STACK,W?AGAIN,W?G \?CCL63 CALL2 DO-AGAIN,OWINNER ZERO? STACK \?CND61 RFALSE ?CCL63: 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 \?CND61 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 ?CND61: SET 'P-WON,FALSE-VALUE SET 'P-WALK-DIR,FALSE-VALUE CALL2 PARSE-IT,FALSE-VALUE >PV ?PRG68: ZERO? PV \?CCL72 CALL1 PRINT-PARSER-FAILURE >PV JUMP ?PRG68 ?CCL72: EQUAL? PV,1 /FALSE PUT OOPS-TABLE,O-PTR,FALSE-VALUE CALL1 GAME-VERB? ZERO? STACK \?CND75 SET 'P-OFLAG,0 ?CND75: GET PV,0 >LEN EQUAL? LEN,W?TWICE,W?THRICE \?CND77 GET OOPS-TABLE,O-START INTBL? LEN,STACK,P-WORDS-AGAIN,132 >N \?CND77 ICALL CHANGE-LEXV,N,W?ONCE EQUAL? LEN,W?THRICE \?CCL83 PUSH 2 JUMP ?CND81 ?CCL83: PUSH 1 ?CND81: ICALL2 DO-IT-AGAIN,STACK CALL2 PARSE-IT,FALSE-VALUE >PV JUMP ?PRG68 ?CND77: GET GWIM-MSG,1 ZERO? STACK /?CND84 ICALL1 TELL-GWIM-MSG PUT GWIM-MSG,1,0 ?CND84: GET GWIM-MSG,2 ZERO? STACK /TRUE PRINTI "[""" GET GWIM-MSG,2 ICALL2 NP-PRINT,STACK PRINTI """ meaning " GET GWIM-MSG,3 ICALL2 TELL-THE,STACK PRINTI "] " PUT GWIM-MSG,2,0 RTRUE .FUNCT GAME-VERB?:ANY:0:0 EQUAL? PRSA,V?COMMAND,V?RECORD,V?UNRECORD /TRUE EQUAL? PRSA,V?QUIT,V?RESTART,V?RESTORE /TRUE EQUAL? PRSA,V?SAVE,V?SCRIPT,V?VERIFY /TRUE EQUAL? PRSA,V?DESC-LEVEL,V?$REFRESH,V?VERSION /TRUE EQUAL? PRSA,V?DIAGNOSE /TRUE RFALSE .FUNCT RED-SD:ANY:0:2,N,TYP,V,SYN,NEW-OBJECT SET 'V,W?WALK PUT PARSE-RESULT,1,V 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 P-P:ANY:1:1,X CALL2 PMEM?,X ZERO? STACK /?CCL3 GETB X,1 EQUAL? STACK,1 \?CCL6 PRINTI "#ADJS[" ICALL2 ADJS-PRINT,X PRINTC 93 RTRUE ?CCL6: GETB X,1 EQUAL? STACK,2 \?CCL8 PRINTI "#NP[" ICALL2 NP-PRINT,X PRINTC 93 RTRUE ?CCL8: GETB X,1 EQUAL? STACK,3 \?CCL10 PRINTI "#NPP[" ?PRG11: GET X,2 ZERO? STACK /?CND13 GET X,2 ICALL2 P-P,STACK PRINTC 32 ?CND13: GET X,3 ZERO? STACK /?CND15 GET X,3 ICALL2 P-P,STACK PRINTC 32 ?CND15: GET X,1 >X ZERO? X \?PRG11 PRINTC 93 RTRUE ?CCL10: GETB X,1 EQUAL? STACK,4 \?CCL20 PRINTI "#NOUN-PHRASE[" ICALL2 NP-PRINT,X PRINTC 93 RTRUE ?CCL20: GETB X,1 EQUAL? STACK,5 /?CTR21 GETB X,1 EQUAL? STACK,6 \?CCL22 ?CTR21: PRINTI "#PP[" PRINTI "W?" GET X,1 PRINTB STACK PRINTC 32 GET X,2 ICALL2 P-P,STACK PRINTC 93 RTRUE ?CCL22: PRINTI "#PMEM[]" RTRUE ?CCL3: EQUAL? X,PARSE-RESULT \?CCL26 PRINTI "RESULT" RTRUE ?CCL26: LESS? VOCAB,PRSTBL \?PRD30 LESS? VOCAB,X \?PRD30 LESS? X,PRSTBL /?CTR27 ?PRD30: LESS? 0,VOCAB \?CCL28 LESS? PRSTBL,0 \?CCL28 LESS? VOCAB,X /?CTR27 LESS? X,PRSTBL \?CCL28 ?CTR27: PRINTI "W?" PRINTB X RTRUE ?CCL28: PRINTN X RTRUE .FUNCT PARSE-IT:ANY:0:1,V,RES,NUM,W,SAV-LEXV,TMP,TV,T2,?TMP1 SET 'SPLITS,0 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 ZERO? P-DBUG /?CND4 PRINTI "[Reset of PMEM: " PRINTN PMEM-WORDS-USED PRINTI " words used.] " ?CND4: ICALL1 PMEM-RESET SET 'P-WORD-NUMBER,0 SET 'TLEXV,SAV-LEXV SET 'P-LEN,P-OLEN SET 'WINNER,W PUT GWIM-MSG,0,0 PUT GWIM-MSG,1,0 PUT GWIM-MSG,2,0 PUT GWIM-MSG,3,0 COPYT PARSE-RESULT,0,PARSE-RESULT-LEN CALL2 PARSE-SENTENCE,PARSE-RESULT >RES EQUAL? RES,PARSER-RESULT-AGAIN \?CCL8 PUT SPLIT-STACK,0,0 SET 'ERROR-PRIORITY,255 SET 'P-OLEN,P-LEN SET 'SAV-LEXV,TLEXV JUMP ?PRG1 ?CCL8: LESS? RES,PARSER-RESULT-WON \?REP2 GET SPLIT-STACK,0 ZERO? STACK /?REP2 ZERO? RES /?REP2 ?PRG14: GET SPLIT-STACK,0 >T2 SUB T2,1 GET SPLIT-STACK,STACK ZERO? STACK \?CCL18 GET SPLIT-STACK,T2 >TMP ZERO? TMP /?CTR20 GET TMP,0 ZERO? STACK \?PRD24 GET TMP,1 ZERO? STACK /?CTR20 ?PRD24: ADD TMP,6 >TV GET TV,0 ZERO? STACK \?CCL21 GET TV,1 ZERO? STACK \?CCL21 ?CTR20: SUB T2,2 PUT SPLIT-STACK,0,STACK JUMP ?CND16 ?CCL21: PUT SPLIT-STACK,T2,TV JUMP ?REP15 ?CCL18: GET SPLIT-STACK,T2 >?TMP1 SUB T2,1 GET SPLIT-STACK,STACK EQUAL? ?TMP1,STACK \?CCL30 SUB T2,2 PUT SPLIT-STACK,0,STACK ?CND16: GET SPLIT-STACK,0 ZERO? STACK \?PRG14 ?REP15: GET SPLIT-STACK,0 ZERO? STACK /?REP2 ZERO? P-DBUG /?PRG1 PRINTI "[Splits left, trying again...] " JUMP ?PRG1 ?CCL30: GET SPLIT-STACK,T2 ADD 1,STACK PUT SPLIT-STACK,T2,STACK JUMP ?REP15 ?REP2: SUB 0,NUM ICALL2 BE-PATIENT,STACK EQUAL? RES,PARSER-RESULT-WON \?CCL39 RETURN PARSER-RESULT ?CCL39: ZERO? RES /TRUE RFALSE .FUNCT PARSE-SENTENCE:ANY:1:1,PR,SPLIT-NUM,RES-WCN,CURRENT-TOKEN,CAV,OFFS,T2,CURRENT-ACTION,REDUCTION,N,?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: ZERO? P-DBUG /?PRG7 PRINTI "[Next token: " PRINTB CURRENT-TOKEN PRINTI "] " ?PRG7: EQUAL? CURRENT-TOKEN,W?S \?CCL11 SUB TLEXV,4 GET STACK,0 EQUAL? STACK,W?APOSTROPHE \?CCL11 SET 'RES-WCN,32 JUMP ?CND9 ?CCL11: GET CURRENT-TOKEN,4 >RES-WCN ?CND9: ZERO? RES-WCN \?CCL16 GET CURRENT-TOKEN,3 ZERO? STACK \?CCL19 CALL BUZZER-WORD?,CURRENT-TOKEN,TLEXV ZERO? STACK /?CND20 MUL P-LEXELEN,P-WORD-NUMBER ADD STACK,P-LEXSTART PUT OOPS-TABLE,O-PTR,STACK RETURN PARSER-RESULT-DEAD ?CND20: SET 'CAV,FALSE-VALUE ?CND14: ZERO? CAV /?PST46 GET CAV,2 >CURRENT-ACTION JUMP ?PRG48 ?CCL19: GET CURRENT-TOKEN,3 >CURRENT-TOKEN JUMP ?PRG7 ?CCL16: BTST RES-WCN,32768 /?CCL24 SET 'OFFS,1 JUMP ?CND22 ?CCL24: SET 'OFFS,0 ?CND22: CALL2 PEEK-PSTACK,STATE-STACK GET ACTION-TABLE,STACK GET STACK,0 CALL GET-TERMINAL-ACTION,RES-WCN,STACK,OFFS >CAV ZERO? CAV /?CND25 BAND RES-WCN,32767 >?TMP1 GET CAV,OFFS BCOM STACK BAND ?TMP1,STACK ZERO? STACK /?CND25 ADD CAV,6 CALL GET-TERMINAL-ACTION,RES-WCN,STACK,OFFS ZERO? STACK /?CND25 ADD SPLIT-NUM,2 >SPLIT-NUM ADD SPLIT-NUM,1 GET SPLIT-STACK,0 >T2 GRTR? STACK,T2 \?CCL32 INC 'SPLITS INC 'T2 LESS? T2,21 /?CND33 ICALL1 P-NO-MEM-ROUTINE ?CND33: PUT SPLIT-STACK,0,T2 PUT SPLIT-STACK,T2,0 INC 'T2 LESS? T2,21 /?CND35 ICALL1 P-NO-MEM-ROUTINE ?CND35: PUT SPLIT-STACK,0,T2 PUT SPLIT-STACK,T2,CAV ZERO? P-DBUG /?CND25 PRINTI "[New split on a" PRINTI " word" PRINTI " (split #" PRINTN SPLITS PRINTI ") at depth " DIV T2,2 PRINTN STACK PRINTI "; word class: " PRINTN RES-WCN PRINTI "; left: " ADD CAV,6 GET STACK,0 PRINTN STACK PRINTI ".] " JUMP ?CND25 ?CCL32: GET SPLIT-STACK+2,SPLIT-NUM >CAV ZERO? CAV /?CND39 CALL GET-TERMINAL-ACTION,RES-WCN,CAV,OFFS >CAV ?CND39: PUT SPLIT-STACK+2,SPLIT-NUM,CAV ?CND25: ZERO? CAV \?CND14 ZERO? P-DBUG /?CND43 PRINTI "[A parse loses.] " ?CND43: RETURN PARSER-RESULT-FAILED ?PST46: SET 'CURRENT-ACTION,0 ?PRG48: ZERO? CAV /?CCL52 BAND CURRENT-ACTION,65280 ZERO? STACK /?CCL52 ADD SPLIT-NUM,2 >SPLIT-NUM ADD SPLIT-NUM,1 GET SPLIT-STACK,0 >T2 GRTR? STACK,T2 \?CCL57 INC 'SPLITS INC 'T2 LESS? T2,21 /?CND58 ICALL1 P-NO-MEM-ROUTINE ?CND58: PUT SPLIT-STACK,0,T2 GETB CURRENT-ACTION,0 PUT SPLIT-STACK,T2,STACK INC 'T2 LESS? T2,21 /?CND60 ICALL1 P-NO-MEM-ROUTINE ?CND60: PUT SPLIT-STACK,0,T2 PUT SPLIT-STACK,T2,1 ZERO? P-DBUG /?CND62 PRINTI "[New split on a" PRINTI "n action" PRINTI " (split #" PRINTN SPLITS PRINTI ") at depth " DIV T2,2 PRINTN STACK PRINTI ", " GETB CURRENT-ACTION,0 PRINTN STACK PRINTI " cases.] " ?CND62: GETB CURRENT-ACTION,1 >CURRENT-ACTION JUMP ?CND55 ?CCL57: GET SPLIT-STACK+2,SPLIT-NUM GETB CURRENT-ACTION,STACK >CURRENT-ACTION ?CND55: ZERO? P-DBUG /?CND50 PRINTI "[Using action " PRINTN CURRENT-ACTION PRINTI ".] " JUMP ?CND50 ?CCL52: ZERO? CAV /?CND50 ZERO? CURRENT-ACTION \?CND50 ZERO? P-DBUG /?CND69 PRINTI "[A parse loses.] " ?CND69: RETURN PARSER-RESULT-FAILED ?CND50: ZERO? CAV /?CTR72 LESS? CURRENT-ACTION,128 \?CCL73 ?CTR72: ZERO? CAV /?CND76 ZERO? P-DBUG /?CND78 PRINTI "[Pushing: " PRINTB CURRENT-TOKEN PRINTI "] " ?CND78: XPUSH CURRENT-TOKEN,DATA-STACK \?CCL82 XPUSH CURRENT-ACTION,STATE-STACK /?CND76 ?CCL82: ICALL1 P-NO-MEM-ROUTINE ?CND76: DLESS? 'P-LEN,1 \?CCL87 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 ?CND85 ?CCL87: INC 'P-WORD-NUMBER ADD TLEXV,4 >TLEXV GET TLEXV,0 >CURRENT-TOKEN GRTR? TLEXV,OTLEXV \?CND85 SET 'OTLEXV,TLEXV ?CND85: ZERO? CURRENT-TOKEN \?CCL92 CALL2 UNKNOWN-WORD,TLEXV >CURRENT-TOKEN ZERO? CURRENT-TOKEN \?CND90 RETURN PARSER-RESULT-DEAD ?CCL92: EQUAL? CURRENT-TOKEN,W?THEN,W?!,W?PERIOD /?CCL95 EQUAL? CURRENT-TOKEN,W?? \?CND90 ?CCL95: SET 'P-WORDS-AGAIN,P-WORD-NUMBER DLESS? 'P-LEN,1 /?CCL100 ADD TLEXV,4 >P-CONT JUMP ?CND90 ?CCL100: SET 'P-CONT,FALSE-VALUE ?CND90: ZERO? P-DBUG /?PRG7 PRINTI "[Next token: " PRINTB CURRENT-TOKEN PRINTI "] " JUMP ?PRG7 ?CCL73: GRTR? CURRENT-ACTION,128 \?CCL104 SUB CURRENT-ACTION,129 GET REDUCTION-TABLE,STACK >REDUCTION ZERO? P-DBUG /?CND107 PRINTI "[Reducing " GET REDUCTION,5 PRINT STACK CRLF PRINTI "Args:" GET REDUCTION,0 >N ?PRG109: DLESS? 'N,0 \?CND111 PRINTI " ..." ?CND107: GET REDUCTION,0 >RES-WCN ZERO? RES-WCN /?CND113 FSTACK RES-WCN,STATE-STACK ?CND113: SET 'CURRENT-REDUCTION,REDUCTION SET 'P-RUNNING,TLEXV GET REDUCTION,1 >?TMP1 GET REDUCTION,0 CALL ?TMP1,STACK >RES-WCN SET 'TLEXV,P-RUNNING GRTR? TLEXV,OTLEXV \?CND115 SET 'OTLEXV,TLEXV ?CND115: LESS? P-LEN,1 \?CCL119 SET 'CURRENT-TOKEN,W?END.OF.INPUT JUMP ?CND117 ?CND111: PRINTC 32 CALL PEEK-PSTACK,DATA-STACK,N ICALL2 P-P,STACK JUMP ?PRG109 ?CCL119: GET TLEXV,0 >CURRENT-TOKEN ?CND117: SET 'CURRENT-REDUCTION,FALSE-VALUE ZERO? RES-WCN \?CTR121 RETURN PARSER-RESULT-FAILED ?CTR121: XPUSH RES-WCN,DATA-STACK /?CND120 ICALL1 P-NO-MEM-ROUTINE ?CND120: CALL2 PEEK-PSTACK,STATE-STACK GET ACTION-TABLE,STACK >?TMP1 GET REDUCTION,4 CALL GET-NONTERMINAL-ACTION,?TMP1,STACK XPUSH STACK,STATE-STACK /?CND125 ICALL1 P-NO-MEM-ROUTINE ?CND125: ZERO? P-DBUG /?PRG7 PRINTI " result: " ICALL2 P-P,RES-WCN PRINTI ", new state " CALL2 PEEK-PSTACK,STATE-STACK PRINTN STACK PRINTI "] " JUMP ?PRG7 ?CCL104: 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 ZERO? P-DBUG /?CND6 PRINTI "[Total: " SUB 0,NUM PRINTN STACK PRINTI " passes.] " ?CND6: SUB 1,LIM LESS? NUM,STACK \FALSE SET 'P-RESPONDED,FALSE-VALUE BUFOUT TRUE-VALUE PRINTR "]" ?CCL5: MOD NUM,LIM ZERO? STACK \FALSE EQUAL? NUM,LIM \?CCL15 SET 'P-RESPONDED,TRUE-VALUE PRINTI "[Please be patient..." JUMP ?CND13 ?CCL15: 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 RT-PRINT-DESC,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 CALL1 COLLECTIVE-VERB? ZERO? STACK /?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: EQUAL? OBJ1,FALSE-VALUE,NOT-HERE-OBJECT \?CCL105 ICALL2 NP-PRINT,NP1 PRINTI ": " ICALL2 NP-CANT-SEE,NP1 JUMP ?PRG90 ?CCL105: GET NP1,3 EQUAL? STACK,NP-QUANT-ALL \?CCL107 CALL VERB-ALL-TEST,OBJ1,OBJ ZERO? STACK /?PRG90 ?CCL107: CALL2 ACCESSIBLE?,OBJ1 ZERO? STACK /?PRG90 EQUAL? OBJ1,PLAYER /?PRG90 EQUAL? OBJ1,IT \?CCL116 ICALL2 RT-PRINT-DESC,P-IT-OBJECT JUMP ?CND114 ?CCL116: EQUAL? OBJ1,PSEUDO-OBJECT \?CCL118 ICALL2 NP-PRINT,NP1 JUMP ?CND114 ?CCL118: ICALL2 RT-PRINT-DESC,OBJ1 ?CND114: PRINTI ": " ?CND99: SET 'TMP,TRUE-VALUE GRTR? ICNT,1 /?CCL121 SET 'PRSO,OBJ1 SET 'PRSO-NP,NP1 SET 'PRSI,OBJ SET 'PRSI-NP,NP JUMP ?CND119 ?CCL121: SET 'PRSO,OBJ SET 'PRSO-NP,NP SET 'PRSI,OBJ1 SET 'PRSI-NP,NP1 ?CND119: EQUAL? IT,PRSI,PRSO,PRSS \?CND122 CALL FIX-HIM-HER-IT,IT,P-IT-OBJECT ZERO? STACK /?PRG90 ?CND122: EQUAL? HER,PRSI,PRSO,PRSS \?CND126 CALL FIX-HIM-HER-IT,HER,P-HER-OBJECT ZERO? STACK /?PRG90 ?CND126: EQUAL? HIM,PRSI,PRSO,PRSS \?CND130 CALL FIX-HIM-HER-IT,HIM,P-HIM-OBJECT ZERO? STACK /?PRG90 ?CND130: EQUAL? THEM,PRSI,PRSO,PRSS \?CND134 CALL FIX-HIM-HER-IT,THEM,P-THEM-OBJECT ZERO? STACK /?PRG90 ?CND134: ICALL2 QCONTEXT-CHECK,PRSO GET PARSE-RESULT,3 GETB STACK,5 >XX ZERO? PRSO /?CND138 BTST XX,128 /?CND138 BTST XX,192 /?CND138 CALL2 META-LOC,PRSO >V ZERO? V /?CND138 IN? V,ROOMS \?CND138 CALL2 META-LOC,WINNER CALL GLOBAL-IN?,PRSO,STACK ZERO? STACK \?CND138 CALL2 META-LOC,WINNER EQUAL? V,STACK /?CND138 ICALL2 NOT-HERE,PRSO JUMP ?PRG90 ?CND138: ZERO? PRSO /?CND147 BAND XX,96 ZERO? STACK /?CND147 BTST XX,128 /?CND147 CALL ITAKE-CHECK,PRSO,XX >V EQUAL? M-FATAL,V /?CND74 ZERO? V \?PRG90 ?CND147: ZERO? PRSI /?CND157 GET PARSE-RESULT,3 GETB STACK,9 >XX BAND 96,XX ZERO? STACK /?CND157 BTST XX,128 /?CND157 CALL ITAKE-CHECK,PRSI,XX >V EQUAL? M-FATAL,V /?CND74 ZERO? V \?PRG90 ?CND157: CALL PERFORM,PRSA,PRSO,PRSI >V EQUAL? M-FATAL,V /?CND74 EQUAL? P-CONT,-1 \?PRG90 ?CND74: SET 'OPRSO,PRSO ZERO? CLOCK-WAIT \?CND171 CALL1 GAME-VERB? ZERO? STACK \?CND171 LOC WINNER >V ZERO? V /?CND175 IN? V,ROOMS /?CND175 GETP V,P?ACTION CALL D-APPLY,STR?1,STACK,M-END >V ?CND175: GETP HERE,P?ACTION CALL D-APPLY,STR?1,STACK,M-END >V EQUAL? M-FATAL,V \?CND179 SET 'P-CONT,-1 ?CND179: SET 'CLOCKER-RUNNING,1 CALL1 CLOCKER >V SET 'CLOCKER-RUNNING,2 EQUAL? M-FATAL,V \?CND171 SET 'P-CONT,-1 ?CND171: 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 \?CCL191 SET 'P-CONT,-1 JUMP ?CND1 ?CCL191: 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 QCONTEXT-CHECK:ANY:1:1,PER,WHO EQUAL? PRSA,V?TELL-ABOUT \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 PRINT-VOCAB-WORD:ANY:1:1,WD,TMP,?TMP1 ADD LONG-WORD-TABLE,2 >?TMP1 GET LONG-WORD-TABLE,0 DIV STACK,2 INTBL? WD,?TMP1,STACK,132 >TMP \?CCL3 GET TMP,1 PRINT STACK RTRUE ?CCL3: EQUAL? WD,W?INT.NUM,W?INT.TIM /FALSE PRINTB WD RTRUE .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 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 >?TMP1 SUB TLEXV,P-LEXV DIV STACK,2 ICALL MAKE-ROOM-FOR-TOKENS,?TMP1,P-LEXV,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 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,N GET P-N-WORDS,0 INTBL? WD,P-N-WORDS+2,STACK \?CCL3 PRINTR "[Use numerals for numbers, for example ""10.""]" ?CCL3: GET P-C-WORDS,0 INTBL? WD,P-C-WORDS+2,STACK \FALSE PRINTC 91 CALL2 PICK-ONE,OFFENDED PRINT STACK PRINTR "]" .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,OBJ GET GWIM-MSG,1 >OBJ EQUAL? OBJ,TH-HANDS /FALSE PRINTC 91 GET GWIM-MSG,0 >WD ZERO? WD /?CND4 ICALL2 PRINT-VOCAB-WORD,WD GET PARSER-RESULT,1 >VB EQUAL? VB,W?SIT,W?LIE \?CCL8 EQUAL? WD,W?DOWN \?CND4 PRINTI " on" JUMP ?CND4 ?CCL8: EQUAL? VB,W?GET \?CND4 EQUAL? WD,W?OUT \?CND4 PRINTI " of" ?CND4: GET GWIM-MSG,1 ICALL RT-PRINT-OBJ,STACK,K-ART-THE PRINTC 93 CRLF RTRUE .FUNCT DO-IT-AGAIN:ANY:0:1,NUM,X,TMP ASSIGNED? 'NUM /?CND1 SET 'NUM,1 ?CND1: SUB TLEXV,P-LEXV DIV STACK,2 >X ZERO? P-CONT \?CND3 ADD X,P-LEXELEN >X ?CND3: GET OOPS-TABLE,O-START >TMP ZERO? TMP /?PRG7 SUB TMP,P-LEXV+2 DIV STACK,4 >TMP GETB G-LEXV,P-LEXWORDS ADD STACK,TMP PUTB G-LEXV,P-LEXWORDS,STACK ?PRG7: ICALL MAKE-ROOM-FOR-TOKENS,2,G-LEXV,X PUT G-LEXV,X,W?PERIOD ADD X,P-LEXELEN PUT G-LEXV,STACK,W?AGAIN DLESS? 'NUM,1 \?PRG7 GETB G-LEXV,P-LEXWORDS SUB STACK,TMP PUTB G-LEXV,P-LEXWORDS,STACK CALL2 COPY-INPUT,TRUE-VALUE RSTACK .ENDSEG .ENDI