1564 lines
32 KiB
Plaintext
1564 lines
32 KiB
Plaintext
|
|
.SEGMENT "0"
|
|
|
|
|
|
.FUNCT INIT-STATUS-LINE:ANY:0:0
|
|
SPLIT 1
|
|
SCREEN S-WINDOW
|
|
CURSET 1,1
|
|
HLIGHT H-INVERSE
|
|
ERASE 1
|
|
HLIGHT H-NORMAL
|
|
SCREEN S-TEXT
|
|
RTRUE
|
|
|
|
|
|
.FUNCT UPDATE-STATUS-LINE:ANY:0:0,?TMP2,?TMP1
|
|
SCREEN S-WINDOW
|
|
HLIGHT H-INVERSE
|
|
EQUAL? HERE,OLD-HERE /?CND1
|
|
SET 'OLD-HERE,HERE
|
|
CURSET 1,1
|
|
ERASE 1
|
|
CURSET 1,1
|
|
PRINTD HERE
|
|
?CND1: GETB 0,33 >?TMP1
|
|
CALL2 DIGITS,SCORE >?TMP2
|
|
CALL2 DIGITS,MOVES
|
|
ADD ?TMP2,STACK
|
|
SUB ?TMP1,STACK
|
|
CURSET 1,STACK
|
|
PRINTN SCORE
|
|
PRINTC 47
|
|
PRINTN MOVES
|
|
HLIGHT H-NORMAL
|
|
SCREEN S-TEXT
|
|
RTRUE
|
|
|
|
|
|
.FUNCT DIGITS:ANY:1:1,N,D
|
|
SET 'D,1
|
|
LESS? N,0 \?PRG3
|
|
INC 'D
|
|
SUB 0,N >N
|
|
?PRG3: DIV N,10 >N
|
|
ZERO? N /?REP4
|
|
INC 'D
|
|
JUMP ?PRG3
|
|
?REP4: RETURN D
|
|
|
|
|
|
.FUNCT READ-INPUT:ANY:0:0
|
|
PRINTC 62
|
|
PUTB P-INBUF,1,0
|
|
ZERO? DEMO-VERSION? /?CCL4
|
|
ICALL READ-DEMO,P-INBUF,P-LEXV
|
|
JUMP ?CND2
|
|
?CCL4: READ P-INBUF,P-LEXV
|
|
?CND2: CALL1 SCRIPT-INBUF
|
|
RSTACK
|
|
|
|
|
|
.FUNCT SCRIPT-INBUF:ANY:0:0,BUF,CNT,N,CHR
|
|
GETB P-INBUF,1 >N
|
|
DIROUT D-SCREEN-OFF
|
|
ADD 1,P-INBUF >BUF
|
|
?PRG1: IGRTR? 'CNT,N /?REP2
|
|
GETB BUF,CNT >CHR
|
|
LESS? CHR,97 /?CCL8
|
|
GRTR? CHR,122 /?CCL8
|
|
SUB CHR,32
|
|
PRINTC STACK
|
|
JUMP ?PRG1
|
|
?CCL8: PRINTC CHR
|
|
JUMP ?PRG1
|
|
?REP2: CRLF
|
|
DIROUT D-SCREEN-ON
|
|
RTRUE
|
|
|
|
|
|
.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: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.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: PRINTD OBJ
|
|
RTRUE
|
|
|
|
|
|
.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,32776
|
|
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,32776
|
|
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
|
|
GET PV,4 >PRSA
|
|
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
|
|
GET GAME-VERB-TABLE,0
|
|
INTBL? PRSA,GAME-VERB-TABLE+2,STACK /TRUE
|
|
EQUAL? PRSA,V?$UNRECORD /TRUE
|
|
EQUAL? PRSA,V?$RECORD,V?$COMMAND,V?$RANDOM /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
|
|
ZERO? P-DBUG /?CND3
|
|
PRINTI "[PASS "
|
|
PRINTN NUM
|
|
PRINTI "]
|
|
"
|
|
?CND3: ICALL2 BE-PATIENT,NUM
|
|
PUT STATE-STACK,0,20
|
|
XPUSH 1,STATE-STACK /?BOGUS5
|
|
?BOGUS5: PUT DATA-STACK,0,20
|
|
ZERO? P-DBUG /?CND6
|
|
PRINTI "[Reset of PMEM: "
|
|
PRINTN PMEM-WORDS-USED
|
|
PRINTI " words used.]
|
|
"
|
|
?CND6: 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 \?CCL10
|
|
PUT SPLIT-STACK,0,0
|
|
SET 'ERROR-PRIORITY,255
|
|
SET 'P-OLEN,P-LEN
|
|
SET 'SAV-LEXV,TLEXV
|
|
JUMP ?PRG1
|
|
?CCL10: LESS? RES,PARSER-RESULT-WON \?REP2
|
|
GET SPLIT-STACK,0
|
|
ZERO? STACK /?REP2
|
|
ZERO? RES /?REP2
|
|
?PRG16: GET SPLIT-STACK,0 >T2
|
|
SUB T2,1
|
|
GET SPLIT-STACK,STACK >TV
|
|
BAND TV,65280
|
|
ZERO? STACK /?CCL20
|
|
GET SPLIT-STACK,T2 >TMP
|
|
BTST TMP,32768 /?CCL23
|
|
ADD TV,6
|
|
CALL GET-TERMINAL-ACTION,TMP,STACK,1 >TV
|
|
JUMP ?CND21
|
|
?CCL23: BAND TMP,32767 >?TMP1
|
|
ADD TV,6
|
|
CALL GET-TERMINAL-ACTION,?TMP1,STACK,0 >TV
|
|
?CND21: ZERO? TV \?CCL26
|
|
SUB T2,2 >T2
|
|
PUT SPLIT-STACK,0,T2
|
|
JUMP ?CND18
|
|
?CCL26: SUB T2,1
|
|
PUT SPLIT-STACK,STACK,TV
|
|
JUMP ?REP17
|
|
?CCL20: GET SPLIT-STACK,T2 >TMP
|
|
EQUAL? TMP,TV \?CCL28
|
|
SUB T2,2 >T2
|
|
PUT SPLIT-STACK,0,T2
|
|
?CND18: ZERO? T2 \?PRG16
|
|
?REP17: GET SPLIT-STACK,0
|
|
ZERO? STACK /?REP2
|
|
ZERO? P-DBUG /?PRG1
|
|
PRINTI "[Splits left (SPLIT ptr = "
|
|
GET SPLIT-STACK,0
|
|
PRINTN STACK
|
|
PRINTI "), trying again...]
|
|
"
|
|
JUMP ?PRG1
|
|
?CCL28: ADD 1,TMP
|
|
PUT SPLIT-STACK,T2,STACK
|
|
JUMP ?REP17
|
|
?REP2: ZERO? P-RESPONDED /?CND35
|
|
SUB 0,NUM
|
|
ICALL2 BE-PATIENT,STACK
|
|
?CND35: 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,OLD-WCN,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 /?CND5
|
|
PRINTI "[Next token: "
|
|
PRINTB CURRENT-TOKEN
|
|
PRINTI "; WCN "
|
|
GET CURRENT-TOKEN,4
|
|
PRINTN STACK
|
|
PRINTI "]
|
|
"
|
|
?CND5: GET CURRENT-TOKEN,4 >WCN
|
|
SET 'OLD-WCN,WCN
|
|
?PRG7: EQUAL? CURRENT-TOKEN,W?S \?CND9
|
|
SUB TLEXV,4
|
|
GET STACK,0
|
|
EQUAL? STACK,W?APOSTROPHE \?CND9
|
|
SET 'OLD-WCN,32
|
|
SET 'WCN,OLD-WCN
|
|
?CND9: ZERO? WCN \?CCL15
|
|
GET CURRENT-TOKEN,3
|
|
ZERO? STACK \?CCL18
|
|
CALL BUZZER-WORD?,CURRENT-TOKEN,TLEXV
|
|
ZERO? STACK /?CND19
|
|
MUL P-LEXELEN,P-WORD-NUMBER
|
|
ADD STACK,P-LEXSTART
|
|
PUT OOPS-TABLE,O-PTR,STACK
|
|
RETURN PARSER-RESULT-DEAD
|
|
?CND19: SET 'CAV,FALSE-VALUE
|
|
JUMP ?CND13
|
|
?CCL18: GET CURRENT-TOKEN,3 >CURRENT-TOKEN
|
|
GET CURRENT-TOKEN,4 >OLD-WCN
|
|
SET 'WCN,OLD-WCN
|
|
JUMP ?PRG7
|
|
?CCL15: BTST OLD-WCN,32768 /?CCL23
|
|
SET 'OFFS,1
|
|
JUMP ?CND21
|
|
?CCL23: SET 'OFFS,0
|
|
?CND21: CALL2 PEEK-PSTACK,STATE-STACK
|
|
GET ACTION-TABLE,STACK
|
|
GET STACK,0
|
|
CALL GET-TERMINAL-ACTION,WCN,STACK,OFFS >CAV
|
|
ZERO? CAV /?CND24
|
|
BAND WCN,32767 >?TMP1
|
|
GET CAV,OFFS
|
|
BCOM STACK
|
|
BAND ?TMP1,STACK
|
|
ZERO? STACK /?CND24
|
|
ADD CAV,6
|
|
CALL GET-TERMINAL-ACTION,WCN,STACK,OFFS
|
|
ZERO? STACK /?CND24
|
|
ADD SPLIT-NUM,2 >SPLIT-NUM
|
|
ADD SPLIT-NUM,1
|
|
GET SPLIT-STACK,0 >T2
|
|
GRTR? STACK,T2 \?CCL31
|
|
INC 'SPLITS
|
|
INC 'T2
|
|
LESS? T2,21 /?CND32
|
|
ICALL1 P-NO-MEM-ROUTINE
|
|
?CND32: PUT SPLIT-STACK,0,T2
|
|
PUT SPLIT-STACK,T2,CAV
|
|
INC 'T2
|
|
LESS? T2,21 /?CND34
|
|
ICALL1 P-NO-MEM-ROUTINE
|
|
?CND34: PUT SPLIT-STACK,0,T2
|
|
BAND OLD-WCN,32768
|
|
BOR STACK,WCN
|
|
PUT SPLIT-STACK,T2,STACK
|
|
ZERO? P-DBUG /?CND24
|
|
PRINTI "[New split on a"
|
|
PRINTI " word"
|
|
PRINTI " (split #"
|
|
PRINTN SPLITS
|
|
PRINTI ") at depth "
|
|
DIV T2,2
|
|
PRINTN STACK
|
|
PRINTI "; word class: "
|
|
PRINTN WCN
|
|
PRINTI "; left: "
|
|
BAND WCN,32767 >?TMP1
|
|
GET CAV,OFFS
|
|
BCOM STACK
|
|
BAND ?TMP1,STACK
|
|
PRINTN STACK
|
|
PRINTI ".]
|
|
"
|
|
JUMP ?CND24
|
|
?CCL31: SUB SPLIT-NUM,1
|
|
GET SPLIT-STACK+2,STACK >CAV
|
|
ZERO? CAV /?CND24
|
|
ZERO? P-DBUG /?CND40
|
|
PRINTI "[Old split on a word (split #"
|
|
PRINTN SPLITS
|
|
PRINTI ") at depth "
|
|
DIV T2,2
|
|
PRINTN STACK
|
|
PRINTI "; word class: "
|
|
PRINTN WCN
|
|
PRINTI "; using: "
|
|
?CND40: ZERO? P-DBUG /?CND24
|
|
ZERO? CAV /?CCL46
|
|
BAND WCN,32767 >?TMP1
|
|
GET CAV,OFFS
|
|
BAND ?TMP1,STACK
|
|
PRINTN STACK
|
|
JUMP ?CND44
|
|
?CCL46: PRINTN 0
|
|
?CND44: PRINTI "]
|
|
"
|
|
?CND24: ZERO? CAV \?CND47
|
|
ZERO? P-DBUG /?CND49
|
|
PRINTI "[A parse loses.]
|
|
"
|
|
?CND49: RETURN PARSER-RESULT-FAILED
|
|
?CND47: ZERO? P-DBUG /?CND51
|
|
BAND WCN,32767 >?TMP1
|
|
GET CAV,OFFS
|
|
BCOM STACK
|
|
BAND ?TMP1,STACK
|
|
ZERO? STACK /?CND51
|
|
PRINTI "[Current WCN is "
|
|
GET CAV,OFFS
|
|
BAND WCN,STACK
|
|
PRINTN STACK
|
|
PRINTC 93
|
|
CRLF
|
|
?CND51: GET CAV,OFFS
|
|
BAND WCN,STACK >WCN
|
|
?CND13: ZERO? CAV /?PST56
|
|
GET CAV,2 >CURRENT-ACTION
|
|
JUMP ?PRG58
|
|
?PST56: SET 'CURRENT-ACTION,0
|
|
?PRG58: ZERO? CAV /?CCL62
|
|
BAND CURRENT-ACTION,65280
|
|
ZERO? STACK /?CCL62
|
|
ADD SPLIT-NUM,2 >SPLIT-NUM
|
|
ADD SPLIT-NUM,1
|
|
GET SPLIT-STACK,0 >T2
|
|
GRTR? STACK,T2 \?CCL67
|
|
INC 'SPLITS
|
|
INC 'T2
|
|
LESS? T2,21 /?CND68
|
|
ICALL1 P-NO-MEM-ROUTINE
|
|
?CND68: PUT SPLIT-STACK,0,T2
|
|
GETB CURRENT-ACTION,0
|
|
PUT SPLIT-STACK,T2,STACK
|
|
INC 'T2
|
|
LESS? T2,21 /?CND70
|
|
ICALL1 P-NO-MEM-ROUTINE
|
|
?CND70: PUT SPLIT-STACK,0,T2
|
|
PUT SPLIT-STACK,T2,1
|
|
ZERO? P-DBUG /?CND72
|
|
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.]
|
|
"
|
|
?CND72: GETB CURRENT-ACTION,1 >CURRENT-ACTION
|
|
JUMP ?CND65
|
|
?CCL67: GET SPLIT-STACK+2,SPLIT-NUM
|
|
GETB CURRENT-ACTION,STACK >CURRENT-ACTION
|
|
?CND65: ZERO? P-DBUG /?CND60
|
|
PRINTI "[Using action "
|
|
PRINTN CURRENT-ACTION
|
|
PRINTI ".]
|
|
"
|
|
JUMP ?CND60
|
|
?CCL62: ZERO? CAV /?CND60
|
|
ZERO? CURRENT-ACTION \?CND60
|
|
ZERO? P-DBUG /?CND79
|
|
PRINTI "[A parse loses.]
|
|
"
|
|
?CND79: RETURN PARSER-RESULT-FAILED
|
|
?CND60: ZERO? CAV /?CTR82
|
|
LESS? CURRENT-ACTION,128 \?CCL83
|
|
?CTR82: ZERO? CAV /?CND86
|
|
ZERO? P-DBUG /?CND88
|
|
PRINTI "[Pushing: "
|
|
PRINTB CURRENT-TOKEN
|
|
PRINTI "; new state "
|
|
PRINTN CURRENT-ACTION
|
|
PRINTI "]
|
|
"
|
|
?CND88: XPUSH CURRENT-TOKEN,DATA-STACK \?CCL92
|
|
XPUSH CURRENT-ACTION,STATE-STACK /?CND86
|
|
?CCL92: ICALL1 P-NO-MEM-ROUTINE
|
|
?CND86: DLESS? 'P-LEN,1 \?CCL97
|
|
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 ?CND95
|
|
?CCL97: INC 'P-WORD-NUMBER
|
|
ADD TLEXV,4 >TLEXV
|
|
GET TLEXV,0 >CURRENT-TOKEN
|
|
GRTR? TLEXV,OTLEXV \?CND95
|
|
SET 'OTLEXV,TLEXV
|
|
?CND95: ZERO? CURRENT-TOKEN \?CCL102
|
|
CALL2 UNKNOWN-WORD,TLEXV >CURRENT-TOKEN
|
|
ZERO? CURRENT-TOKEN \?CND100
|
|
RETURN PARSER-RESULT-DEAD
|
|
?CCL102: EQUAL? CURRENT-TOKEN,W?THEN,W?!,W?PERIOD /?CCL105
|
|
EQUAL? CURRENT-TOKEN,W?? \?CND100
|
|
?CCL105: SET 'P-WORDS-AGAIN,P-WORD-NUMBER
|
|
DLESS? 'P-LEN,1 /?CCL110
|
|
ADD TLEXV,4 >P-CONT
|
|
JUMP ?CND100
|
|
?CCL110: SET 'P-CONT,FALSE-VALUE
|
|
?CND100: GET CURRENT-TOKEN,4 >OLD-WCN
|
|
SET 'WCN,OLD-WCN
|
|
ZERO? P-DBUG /?PRG7
|
|
PRINTI "[Next token: "
|
|
PRINTB CURRENT-TOKEN
|
|
PRINTI "; WCN "
|
|
PRINTN WCN
|
|
PRINTI "]
|
|
"
|
|
JUMP ?PRG7
|
|
?CCL83: GRTR? CURRENT-ACTION,128 \?CCL114
|
|
SUB CURRENT-ACTION,129
|
|
GET REDUCTION-TABLE,STACK >REDUCTION
|
|
ZERO? P-DBUG /?CND117
|
|
PRINTI "[Reducing "
|
|
GET REDUCTION,5
|
|
PRINT STACK
|
|
CRLF
|
|
PRINTI "Args:"
|
|
GET REDUCTION,0 >N
|
|
?PRG119: DLESS? 'N,0 \?CND121
|
|
PRINTI " ..."
|
|
?CND117: GET REDUCTION,0 >RES
|
|
ZERO? RES /?CND123
|
|
FSTACK RES,STATE-STACK
|
|
?CND123: 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 \?CND125
|
|
SET 'OTLEXV,TLEXV
|
|
?CND125: LESS? P-LEN,1 \?CCL129
|
|
SET 'CURRENT-TOKEN,W?END.OF.INPUT
|
|
GET CURRENT-TOKEN,4 >OLD-WCN
|
|
SET 'WCN,OLD-WCN
|
|
JUMP ?CND127
|
|
?CND121: PRINTC 32
|
|
CALL PEEK-PSTACK,DATA-STACK,N
|
|
ICALL2 P-P,STACK
|
|
JUMP ?PRG119
|
|
?CCL129: GET TLEXV,0
|
|
EQUAL? CURRENT-TOKEN,STACK /?CND127
|
|
GET TLEXV,0 >CURRENT-TOKEN
|
|
GET CURRENT-TOKEN,4 >OLD-WCN
|
|
SET 'WCN,OLD-WCN
|
|
?CND127: SET 'CURRENT-REDUCTION,FALSE-VALUE
|
|
ZERO? RES \?CTR132
|
|
RETURN PARSER-RESULT-FAILED
|
|
?CTR132: XPUSH RES,DATA-STACK /?CND131
|
|
ICALL1 P-NO-MEM-ROUTINE
|
|
?CND131: CALL2 PEEK-PSTACK,STATE-STACK
|
|
GET ACTION-TABLE,STACK >?TMP1
|
|
GET REDUCTION,4
|
|
CALL GET-NONTERMINAL-ACTION,?TMP1,STACK
|
|
XPUSH STACK,STATE-STACK /?CND136
|
|
ICALL1 P-NO-MEM-ROUTINE
|
|
?CND136: ZERO? P-DBUG /?PRG7
|
|
PRINTI " result: "
|
|
ICALL2 P-P,RES
|
|
PRINTI ", new state "
|
|
CALL2 PEEK-PSTACK,STATE-STACK
|
|
PRINTN STACK
|
|
PRINTI "]
|
|
"
|
|
JUMP ?PRG7
|
|
?CCL114: 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
|
|
ZERO? P-RESPONDED /FALSE
|
|
SET 'P-RESPONDED,0
|
|
BUFOUT TRUE-VALUE
|
|
PRINTR "]"
|
|
?CCL5: MOD NUM,LIM
|
|
ZERO? STACK \FALSE
|
|
EQUAL? NUM,LIM \?CCL17
|
|
SET 'P-RESPONDED,LIM
|
|
PRINTI "[Please be patient..."
|
|
JUMP ?CND15
|
|
?CCL17: ZERO? P-RESPONDED /?CND15
|
|
PRINTC 46
|
|
?CND15: 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
|
|
PRINTD 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?220
|
|
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
|
|
GET PARSE-RESULT,3
|
|
GETB STACK,5 >XX
|
|
ZERO? PRSO /?CND124
|
|
BTST XX,128 /?CND124
|
|
BTST XX,192 /?CND124
|
|
CALL2 META-LOC,PRSO >V
|
|
ZERO? V /?CND124
|
|
IN? V,ROOMS \?CND124
|
|
CALL2 META-LOC,WINNER
|
|
CALL GLOBAL-IN?,PRSO,STACK
|
|
ZERO? STACK \?CND124
|
|
CALL2 META-LOC,WINNER
|
|
EQUAL? V,STACK /?CND124
|
|
ICALL2 NOT-HERE,PRSO
|
|
JUMP ?PRG90
|
|
?CND124: ZERO? PRSO /?CND133
|
|
BAND XX,96
|
|
ZERO? STACK /?CND133
|
|
BTST XX,128 /?CND133
|
|
CALL ITAKE-CHECK,PRSO,XX >V
|
|
EQUAL? M-FATAL,V /?CND74
|
|
ZERO? V \?PRG90
|
|
?CND133: ZERO? PRSI /?CND143
|
|
GET PARSE-RESULT,3
|
|
GETB STACK,9 >XX
|
|
BAND 96,XX
|
|
ZERO? STACK /?CND143
|
|
BTST XX,128 /?CND143
|
|
CALL ITAKE-CHECK,PRSI,XX >V
|
|
EQUAL? M-FATAL,V /?CND74
|
|
ZERO? V \?PRG90
|
|
?CND143: CALL PERFORM,PRSA,PRSO,PRSI >V
|
|
EQUAL? M-FATAL,V /?CND74
|
|
EQUAL? P-CONT,-1 \?PRG90
|
|
?CND74: SET 'OPRSO,PRSO
|
|
ZERO? CLOCK-WAIT \?CND157
|
|
CALL1 GAME-VERB?
|
|
ZERO? STACK \?CND157
|
|
LOC WINNER >V
|
|
ZERO? V /?CND161
|
|
IN? V,ROOMS /?CND161
|
|
GETP V,P?ACTION
|
|
CALL D-APPLY,STR?1,STACK,M-END >V
|
|
?CND161: GETP HERE,P?ACTION
|
|
CALL D-APPLY,STR?1,STACK,M-END >V
|
|
EQUAL? M-FATAL,V \?CND165
|
|
SET 'P-CONT,-1
|
|
?CND165: SET 'CLOCKER-RUNNING,1
|
|
CALL1 CLOCKER >V
|
|
SET 'CLOCKER-RUNNING,2
|
|
EQUAL? M-FATAL,V \?CND157
|
|
SET 'P-CONT,-1
|
|
?CND157: 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 \?CCL177
|
|
SET 'P-CONT,-1
|
|
JUMP ?CND1
|
|
?CCL177: 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
|
|
PRINTD P-IT-OBJECT
|
|
JUMP ?CND12
|
|
?CCL14: EQUAL? OBJ1,PSEUDO-OBJECT \?CCL16
|
|
ICALL2 NP-PRINT,NP1
|
|
JUMP ?CND12
|
|
?CCL16: PRINTD OBJ1
|
|
?CND12: PRINT STR
|
|
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
|
|
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
|
|
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 TELL-THE,STACK
|
|
PRINTR "]"
|
|
|
|
|
|
.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
|
|
ICALL2 COPY-INPUT,TRUE-VALUE
|
|
SET 'P-OFLAG,0
|
|
RTRUE
|
|
|
|
.ENDSEG
|
|
|
|
.ENDI
|