mirror of
https://github.com/historicalsource/shogun
synced 2024-05-04 10:08:24 +03:00
1211 lines
26 KiB
Plaintext
1211 lines
26 KiB
Plaintext
|
|
||
|
.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
|