1046 lines
22 KiB
Plaintext
1046 lines
22 KiB
Plaintext
|
|
.SEGMENT "0"
|
|
|
|
|
|
.FUNCT BEG-PARDON
|
|
PRINTR "[I beg your pardon?]"
|
|
|
|
|
|
.FUNCT UNKNOWN-WORD,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
|
|
ICALL2 COUNT-ERRORS,1
|
|
THROW PARSER-RESULT-DEAD,PARSE-SENTENCE-ACTIVATION
|
|
RTRUE
|
|
|
|
|
|
.FUNCT WORD-PRINT,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,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 MOBY-FIND?,SEARCH
|
|
BTST SEARCH,128 /TRUE
|
|
EQUAL? WINNER,EXECUTIONER /TRUE
|
|
RFALSE
|
|
|
|
|
|
.FUNCT NP-SAVE,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,STR,CLASS,OTHER,OTHER2,RP
|
|
ZERO? CURRENT-REDUCTION /FALSE
|
|
GET CURRENT-REDUCTION,2 >RP
|
|
GRTR? ERROR-PRIORITY,RP /?CCL3
|
|
EQUAL? ERROR-PRIORITY,RP \FALSE
|
|
EQUAL? CLASS,PARSER-ERROR-NOUND /?PRD9
|
|
GET ERROR-ARGS,1
|
|
EQUAL? STACK,PARSER-ERROR-NOUND /?CCL3
|
|
?PRD9: EQUAL? CLASS,PARSER-ERROR-ORPH-NP /?CCL3
|
|
EQUAL? CLASS,PARSER-ERROR-NOOBJ,PARSER-ERROR-ORPH-S \FALSE
|
|
GET ERROR-ARGS,1
|
|
EQUAL? STACK,PARSER-ERROR-NOUND \FALSE
|
|
?CCL3: SET 'ERROR-PRIORITY,RP
|
|
SET 'ERROR-STRING,STR
|
|
ZERO? CLASS /?CCL17
|
|
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 \?CND20
|
|
GET OTHER,4 >OTHER
|
|
?CND20: GETB OTHER,1
|
|
EQUAL? STACK,2 \FALSE
|
|
CALL2 NP-SAVE,OTHER
|
|
PUT ERROR-ARGS,2,STACK
|
|
RFALSE
|
|
?CCL17: PUT ERROR-ARGS,0,0
|
|
RFALSE
|
|
|
|
|
|
.FUNCT TELL-THE,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 DPRINT,OBJ
|
|
RSTACK
|
|
|
|
|
|
.FUNCT TELL-CTHE,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 DPRINT,OBJ
|
|
RSTACK
|
|
|
|
|
|
.FUNCT WORD-TYPE?,WD,TYP,TYP2,GC,WCN
|
|
GETB WD,8
|
|
BTST STACK,128 /?CCL3
|
|
GETB WD,8 >WCN
|
|
JUMP ?CND1
|
|
?CCL3: GETB WD,8
|
|
BAND STACK,127
|
|
SHIFT STACK,7 >WCN
|
|
?CND1: ZERO? WCN \?CND4
|
|
GET WD,3 >WD
|
|
GETB WD,8
|
|
BTST STACK,128 /?CCL8
|
|
GETB WD,8 >WCN
|
|
JUMP ?CND4
|
|
?CCL8: GETB WD,8
|
|
BAND STACK,127
|
|
SHIFT STACK,7 >WCN
|
|
?CND4: ASSIGNED? 'TYP2 \?CND9
|
|
CALL WORD-TYPE?,WD,TYP2
|
|
ZERO? STACK /?CND9
|
|
RETURN WD
|
|
?CND9: EQUAL? TYP,P-COMMA-CODE \?CCL15
|
|
EQUAL? WD,W?COMMA,W?AND \?CCL15
|
|
RETURN WD
|
|
?CCL15: EQUAL? TYP,P-ADJ-CODE \?CCL19
|
|
SET 'GC,4
|
|
JUMP ?CND13
|
|
?CCL19: EQUAL? TYP,P-DIR-CODE \?CCL21
|
|
SET 'GC,8
|
|
JUMP ?CND13
|
|
?CCL21: EQUAL? TYP,P-EOI-CODE \?CCL23
|
|
SET 'GC,8192
|
|
JUMP ?CND13
|
|
?CCL23: EQUAL? TYP,P-NOUN-CODE \?CCL25
|
|
SET 'GC,2
|
|
JUMP ?CND13
|
|
?CCL25: EQUAL? TYP,P-PARTICLE-CODE \?CCL27
|
|
SET 'GC,16
|
|
JUMP ?CND13
|
|
?CCL27: EQUAL? TYP,P-PREP-CODE \?CCL29
|
|
SET 'GC,32
|
|
JUMP ?CND13
|
|
?CCL29: EQUAL? TYP,P-QUANT-CODE \?CCL31
|
|
SET 'GC,2048
|
|
JUMP ?CND13
|
|
?CCL31: EQUAL? TYP,P-QW1-CODE \?CCL33
|
|
SET 'GC,0
|
|
JUMP ?CND13
|
|
?CCL33: EQUAL? TYP,P-VERB-CODE \?CND13
|
|
SET 'GC,1
|
|
?CND13: BAND WCN,GC
|
|
ZERO? STACK /FALSE
|
|
RETURN WD
|
|
|
|
|
|
.FUNCT IGNORE-FIRST-WORD,WD1,WD2,NW
|
|
ASSIGNED? 'WD2 /?CND1
|
|
SET 'WD2,1
|
|
?CND1: GET TLEXV,0
|
|
EQUAL? STACK,WD1,WD2 \FALSE
|
|
LESS? 1,P-LEN \FALSE
|
|
GET TLEXV,P-LEXELEN >NW
|
|
ZERO? NW /FALSE
|
|
GETB NW,8
|
|
BTST STACK,128 /?CCL12
|
|
GETB NW,8
|
|
JUMP ?CND10
|
|
?CCL12: GETB NW,8
|
|
BAND STACK,127
|
|
SHIFT STACK,7
|
|
?CND10: BTST STACK,1 \FALSE
|
|
ADD TLEXV,4 >TLEXV
|
|
DEC 'P-LEN
|
|
RTRUE
|
|
|
|
|
|
.FUNCT FIX-TITLE-ABBRS,LEN,PTR,N,L
|
|
GETB P-LEXV,P-LEXWORDS >LEN
|
|
SET 'PTR,P-LEXV+2
|
|
SET 'L,LEN
|
|
?PRG1: DLESS? 'L,0 /TRUE
|
|
GET PTR,0
|
|
EQUAL? STACK,W?ST,W?D,W?J /?PRD8
|
|
GET PTR,0
|
|
EQUAL? STACK,W?A \?CND3
|
|
?PRD8: GET PTR,2
|
|
EQUAL? W?PERIOD,STACK \?CND3
|
|
GET PTR,4
|
|
CALL2 CAPITAL-NOUN?,STACK
|
|
ZERO? STACK /?CND3
|
|
PUT PTR,2,W?NO.WORD
|
|
?CND3: ADD PTR,4 >PTR
|
|
JUMP ?PRG1
|
|
|
|
|
|
.FUNCT FIX-QUOTATIONS,X,QFLAG,LEN,PTR
|
|
SET 'QFLAG,FALSE-VALUE
|
|
GETB P-LEXV,P-LEXWORDS >LEN
|
|
SET 'PTR,P-LEXV+2
|
|
?PRG1: ZERO? LEN /TRUE
|
|
INTBL? W?QUOTE,PTR,LEN,132 >PTR \TRUE
|
|
ZERO? QFLAG \?CCL10
|
|
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 ?CND8
|
|
?CCL10: SET 'QFLAG,FALSE-VALUE
|
|
?CND8: ADD PTR,4 >PTR
|
|
SUB PTR,P-LEXV
|
|
DIV STACK,4 >X
|
|
GETB P-LEXV,P-LEXWORDS
|
|
SUB STACK,X >LEN
|
|
JUMP ?PRG1
|
|
|
|
|
|
.FUNCT PARSER,OWINNER,LEN,N,PTR,VAL,?PR-LEN,CNT,?TMP1
|
|
SET 'PTR,P-LEXSTART
|
|
ICALL1 PMEM-RESET
|
|
SET 'ERROR-PRIORITY,255
|
|
SET 'ERROR-STRING,FALSE-VALUE
|
|
SET 'OWINNER,WINNER
|
|
ZERO? M-PTR /?CCL4
|
|
COPYT M-LEXV,P-LEXV,LEXV-LENGTH-BYTES
|
|
COPYT M-INBUF,P-INBUF,61
|
|
SET 'P-LEN,M-LEN
|
|
ZERO? VERBOSITY /?CND5
|
|
EQUAL? PLAYER,WINNER \?CND5
|
|
CRLF
|
|
?CND5: SET 'TLEXV,M-PTR
|
|
SET 'M-PTR,FALSE-VALUE
|
|
SET 'P-CONT,FALSE-VALUE
|
|
JUMP ?CND2
|
|
?CCL4: GRTR? P-CONT,0 \?CCL10
|
|
SET 'TLEXV,P-CONT
|
|
ZERO? VERBOSITY /?CND11
|
|
EQUAL? PLAYER,WINNER \?CND11
|
|
CRLF
|
|
?CND11: SET 'P-CONT,FALSE-VALUE
|
|
JUMP ?CND2
|
|
?CCL10: SET 'WINNER,PLAYER
|
|
ZERO? P-OFLAG \?CND15
|
|
GET OOPS-TABLE,O-PTR
|
|
ZERO? STACK \?CND15
|
|
PUT OOPS-TABLE,O-END,FALSE-VALUE
|
|
?CND15: LOC WINNER
|
|
IN? STACK,ROOMS \?CND19
|
|
LOC WINNER >HERE
|
|
?CND19: ZERO? LIT /?CCL22
|
|
EQUAL? HERE,LIT /?CND21
|
|
CALL2 VISIBLE?,LIT
|
|
ZERO? STACK \?CND21
|
|
?CCL22: CALL1 LIT? >LIT
|
|
?CND21: FCLEAR IT,TOUCHBIT
|
|
FCLEAR HER,TOUCHBIT
|
|
FCLEAR HIM,TOUCHBIT
|
|
GET 0,8
|
|
BTST STACK,4 \?CND27
|
|
ICALL1 V-$REFRESH
|
|
?CND27: ZERO? VERBOSITY /?CND29
|
|
CRLF
|
|
?CND29: ICALL1 UPDATE-STATUS-LINE
|
|
PRINTC 62
|
|
ICALL1 READ-INPUT
|
|
ICALL1 FIX-QUOTATIONS
|
|
ICALL1 FIX-TITLE-ABBRS
|
|
GETB P-LEXV,P-LEXWORDS >P-LEN
|
|
SET 'TLEXV,P-LEXV+2
|
|
?CND2: GET TLEXV,0
|
|
EQUAL? STACK,W?PERIOD,W?THEN \?CND32
|
|
ADD TLEXV,4 >TLEXV
|
|
DEC 'P-LEN
|
|
?CND32: ICALL2 IGNORE-FIRST-WORD,W?YOU
|
|
ICALL IGNORE-FIRST-WORD,W?GO,W?TO
|
|
ZERO? P-LEN \?CND34
|
|
ICALL1 BEG-PARDON
|
|
RFALSE
|
|
?CND34: GET TLEXV,0
|
|
CALL WORD-TYPE?,STACK,P-DIR-CODE >LEN
|
|
ZERO? LEN /?CCL38
|
|
EQUAL? P-LEN,1 /?CTR37
|
|
SUB TLEXV,P-LEXV
|
|
LESS? STACK,234 \?CTR37
|
|
GET TLEXV,P-LEXELEN
|
|
CALL WORD-TYPE?,STACK,P-EOI-CODE,P-COMMA-CODE
|
|
ZERO? STACK /?CCL38
|
|
?CTR37: 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
|
|
SET 'M-PTR,FALSE-VALUE
|
|
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
|
|
GETB LEN,8
|
|
BTST STACK,128 /?CCL52
|
|
GETB LEN,8
|
|
JUMP ?CND50
|
|
?CCL52: GETB LEN,8
|
|
BAND STACK,127
|
|
SHIFT STACK,7
|
|
?CND50: BTST STACK,8192 \TRUE
|
|
SET 'P-WORDS-AGAIN,P-WORD-NUMBER
|
|
DLESS? 'P-LEN,1 /TRUE
|
|
ADD TLEXV,4 >P-CONT
|
|
RTRUE
|
|
?CCL38: GET TLEXV,0
|
|
EQUAL? STACK,W?OOPS,W?O \?CCL56
|
|
GET TLEXV,P-LEXELEN
|
|
EQUAL? STACK,W?PERIOD,W?COMMA \?CND59
|
|
ADD PTR,P-LEXELEN >PTR
|
|
DEC 'P-LEN
|
|
?CND59: GRTR? P-LEN,1 /?CCL63
|
|
ICALL1 NAKED-OOPS
|
|
RFALSE
|
|
?CCL63: CALL2 META-LOC,OWINNER
|
|
EQUAL? HERE,STACK /?CCL65
|
|
ICALL2 NOT-HERE,OWINNER
|
|
RFALSE
|
|
?CCL65: GET OOPS-TABLE,O-PTR >VAL
|
|
ZERO? VAL /?CCL67
|
|
SUB P-LEN,1
|
|
ICALL REPLACE-ONE-TOKEN,STACK,P-LEXV,PTR,G-LEXV,VAL
|
|
SET 'WINNER,OWINNER
|
|
ICALL2 COPY-INPUT,TRUE-VALUE
|
|
JUMP ?CND36
|
|
?CCL67: PUT OOPS-TABLE,O-END,FALSE-VALUE
|
|
ICALL1 CANT-OOPS
|
|
RFALSE
|
|
?CCL56: ZERO? P-OFLAG \?CND36
|
|
LESS? P-CONT,1 \?CND36
|
|
PUT OOPS-TABLE,O-END,FALSE-VALUE
|
|
?CND36: SET 'P-CONT,FALSE-VALUE
|
|
GET TLEXV,0
|
|
EQUAL? STACK,W?AGAIN,W?G \?CCL73
|
|
ZERO? P-OFLAG \?CTR75
|
|
ZERO? P-WON /?CTR75
|
|
GETB G-INBUF,2
|
|
ZERO? STACK \?CCL76
|
|
?CTR75: ICALL1 CANT-AGAIN
|
|
RFALSE
|
|
?CCL76: GRTR? P-LEN,1 \?CND74
|
|
SUB TLEXV,P-LEXV
|
|
LESS? STACK,234 \?CND74
|
|
GET TLEXV,P-LEXELEN >N
|
|
EQUAL? N,W?PERIOD,W?COMMA,W?THEN /?CTR84
|
|
EQUAL? N,W?AND \?CCL85
|
|
?CTR84: ADD TLEXV,4 >TLEXV
|
|
DEC 'P-LEN
|
|
?CND74: DEC 'P-LEN
|
|
ADD TLEXV,4 >TLEXV
|
|
GRTR? P-LEN,0 \?CCL90
|
|
COPYT P-LEXV,M-LEXV,LEXV-LENGTH-BYTES
|
|
COPYT P-INBUF,M-INBUF,61
|
|
SET 'M-LEN,P-LEN
|
|
SET 'M-PTR,TLEXV
|
|
SET 'P-CONT,M-PTR
|
|
JUMP ?CND88
|
|
?CCL85: ICALL1 DONT-UNDERSTAND
|
|
RFALSE
|
|
?CCL90: SET 'M-PTR,FALSE-VALUE
|
|
?CND88: CALL2 META-LOC,OWINNER
|
|
EQUAL? HERE,STACK /?CND91
|
|
ICALL2 NOT-HERE,OWINNER
|
|
RFALSE
|
|
?CND91: SET 'WINNER,OWINNER
|
|
COPYT G-INBUF,P-INBUF,61
|
|
COPYT G-LEXV,P-LEXV,LEXV-LENGTH-BYTES
|
|
SET 'P-LEN,P-WORDS-AGAIN
|
|
GET OOPS-TABLE,O-START >TLEXV
|
|
JUMP ?CND71
|
|
?CCL73: SET 'M-PTR,FALSE-VALUE
|
|
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 \?CND71
|
|
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
|
|
?CND71: SET 'P-WALK-DIR,FALSE-VALUE
|
|
CALL2 PARSE-IT,FALSE-VALUE >CNT
|
|
?PRG95: ZERO? CNT \?CCL99
|
|
CALL1 PRINT-PARSER-FAILURE >CNT
|
|
JUMP ?PRG95
|
|
?CCL99: EQUAL? CNT,1 /FALSE
|
|
PUT OOPS-TABLE,O-PTR,FALSE-VALUE
|
|
CALL1 GAME-VERB?
|
|
ZERO? STACK \?CND102
|
|
SET 'P-OFLAG,0
|
|
?CND102: GET CNT,0 >LEN
|
|
EQUAL? LEN,W?TWICE,W?THRICE \?CND104
|
|
GET OOPS-TABLE,O-START
|
|
INTBL? LEN,STACK,P-WORDS-AGAIN,132 >N \?CND104
|
|
ICALL CHANGE-LEXV,N,W?ONCE
|
|
EQUAL? LEN,W?THRICE \?CCL110
|
|
PUSH 2
|
|
JUMP ?CND108
|
|
?CCL110: PUSH 1
|
|
?CND108: ICALL2 DO-IT-AGAIN,STACK
|
|
CALL2 PARSE-IT,FALSE-VALUE >CNT
|
|
JUMP ?PRG95
|
|
?CND104: EQUAL? LEN,W?DON'T \?CND111
|
|
EQUAL? WINNER,EXECUTIONER \?CCL115
|
|
PRINTI """Tell me what you want me to do, not what you don't."""
|
|
CRLF
|
|
RFALSE
|
|
?CCL115: PRINTI "[Not done.]"
|
|
CRLF
|
|
RFALSE
|
|
?CND111: GET GWIM-MSG,1
|
|
ZERO? STACK /TRUE
|
|
ICALL1 TELL-GWIM-MSG
|
|
PUT GWIM-MSG,1,0
|
|
RTRUE
|
|
|
|
|
|
.FUNCT TELL-GWIM-MSG,WD,VB
|
|
PRINTC 91
|
|
GET GWIM-MSG,0 >WD
|
|
ZERO? WD /?CND1
|
|
ICALL2 PRINT-VOCAB-WORD,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 PARSE-IT,V,RES,NUM,SAV-LEXV,OLD-OBJECT,TV,T2,?TMP1
|
|
SET 'SAV-LEXV,TLEXV
|
|
PUT SPLIT-STACK,0,0
|
|
SET 'ERROR-PRIORITY,255
|
|
PUT ERROR-ARGS,1,0
|
|
SET 'P-OLEN,P-LEN
|
|
SET 'OTLEXV,TLEXV
|
|
?PRG1: INC 'NUM
|
|
ICALL2 BE-PATIENT,NUM
|
|
PUT STATE-STACK,0,20
|
|
XPUSH 1,STATE-STACK /?BOGUS3
|
|
?BOGUS3: PUT DATA-STACK,0,20
|
|
ICALL2 PMEM-RESET,FALSE-VALUE
|
|
SET 'P-WORD-NUMBER,0
|
|
SET 'TLEXV,SAV-LEXV
|
|
SET 'P-LEN,P-OLEN
|
|
PUT GWIM-MSG,0,0
|
|
PUT GWIM-MSG,1,0
|
|
SET 'OLD-OBJECT,PARSE-RESULT
|
|
PUT OLD-OBJECT,0,FALSE-VALUE
|
|
ZERO? V \?CCL6
|
|
PUSH 0
|
|
JUMP ?CND4
|
|
?CCL6: GET V,1
|
|
?CND4: PUT OLD-OBJECT,1,STACK
|
|
PUT OLD-OBJECT,2,FALSE-VALUE
|
|
PUT OLD-OBJECT,3,FALSE-VALUE
|
|
PUT OLD-OBJECT,4,FALSE-VALUE
|
|
ZERO? V \?CCL9
|
|
PUSH 0
|
|
JUMP ?CND7
|
|
?CCL9: GET V,5
|
|
?CND7: PUT OLD-OBJECT,5,STACK
|
|
PUT OLD-OBJECT,6,FALSE-VALUE
|
|
PUT OLD-OBJECT,7,FALSE-VALUE
|
|
PUT OLD-OBJECT,8,FALSE-VALUE
|
|
ZERO? V \?CCL12
|
|
PUSH 0
|
|
JUMP ?CND10
|
|
?CCL12: GET V,9
|
|
?CND10: PUT OLD-OBJECT,9,STACK
|
|
ZERO? V \?CCL15
|
|
PUSH 0
|
|
JUMP ?CND13
|
|
?CCL15: GET V,10
|
|
?CND13: PUT OLD-OBJECT,10,STACK
|
|
ZERO? V \?CCL18
|
|
PUSH 0
|
|
JUMP ?CND16
|
|
?CCL18: GET V,11
|
|
?CND16: PUT OLD-OBJECT,11,STACK
|
|
PUT OLD-OBJECT,12,FALSE-VALUE
|
|
ZERO? V \?CCL21
|
|
PUSH 0
|
|
JUMP ?CND19
|
|
?CCL21: GET V,13
|
|
?CND19: PUT OLD-OBJECT,13,STACK
|
|
ZERO? V \?CCL24
|
|
PUSH 0
|
|
JUMP ?CND22
|
|
?CCL24: GET V,14
|
|
?CND22: PUT OLD-OBJECT,14,STACK
|
|
PUT OLD-OBJECT,15,FALSE-VALUE
|
|
PUT OLD-OBJECT,16,0
|
|
CALL2 PARSE-SENTENCE,PARSE-RESULT >RES
|
|
EQUAL? RES,PARSER-RESULT-AGAIN \?CCL27
|
|
PUT SPLIT-STACK,0,0
|
|
SET 'ERROR-PRIORITY,255
|
|
SET 'P-OLEN,P-LEN
|
|
SET 'SAV-LEXV,TLEXV
|
|
JUMP ?PRG1
|
|
?CCL27: LESS? RES,PARSER-RESULT-WON \?REP2
|
|
GET SPLIT-STACK,0
|
|
ZERO? STACK /?REP2
|
|
ZERO? RES /?REP2
|
|
?PRG33: GET SPLIT-STACK,0 >T2
|
|
SUB T2,1
|
|
GET SPLIT-STACK,STACK
|
|
ZERO? STACK \?CCL37
|
|
GET SPLIT-STACK,T2 >OLD-OBJECT
|
|
ZERO? OLD-OBJECT /?CTR39
|
|
GET OLD-OBJECT,0
|
|
ZERO? STACK /?CTR39
|
|
ADD OLD-OBJECT,4 >TV
|
|
GET TV,0
|
|
ZERO? STACK \?CCL40
|
|
?CTR39: SUB T2,2
|
|
PUT SPLIT-STACK,0,STACK
|
|
JUMP ?CND35
|
|
?CCL40: PUT SPLIT-STACK,T2,TV
|
|
JUMP ?REP34
|
|
?CCL37: GET SPLIT-STACK,T2 >?TMP1
|
|
SUB T2,1
|
|
GET SPLIT-STACK,STACK
|
|
EQUAL? ?TMP1,STACK \?CCL45
|
|
SUB T2,2
|
|
PUT SPLIT-STACK,0,STACK
|
|
?CND35: GET SPLIT-STACK,0
|
|
ZERO? STACK \?PRG33
|
|
?REP34: GET SPLIT-STACK,0
|
|
ZERO? STACK \?PRG1
|
|
?REP2: SUB 0,NUM
|
|
ICALL2 BE-PATIENT,STACK
|
|
EQUAL? RES,PARSER-RESULT-WON \?CCL52
|
|
RETURN PARSER-RESULT
|
|
?CCL45: GET SPLIT-STACK,T2
|
|
ADD 1,STACK
|
|
PUT SPLIT-STACK,T2,STACK
|
|
JUMP ?REP34
|
|
?CCL52: ZERO? RES /TRUE
|
|
RFALSE
|
|
|
|
|
|
.FUNCT BUZZER-WORD?,WD,PTR,N,?TMP1
|
|
ADD 3,P-ERRS >P-ERRS
|
|
EQUAL? WD,W?(SOMETHI,W?SOMETHING \?CCL3
|
|
PRINTI "[Type a real word instead of"
|
|
PRINT P-SOMETHING
|
|
RTRUE
|
|
?CCL3: GET P-W-WORDS,0
|
|
INTBL? WD,P-W-WORDS+2,STACK \?CCL5
|
|
ICALL2 W-WORD-REPLY,WD
|
|
RTRUE
|
|
?CCL5: ADD P-Q-WORDS,2 >?TMP1
|
|
GET P-Q-WORDS,0
|
|
INTBL? WD,?TMP1,STACK /?CCL6
|
|
GET P-Q-WORDS1,0
|
|
INTBL? WD,P-Q-WORDS1+2,STACK \?CND1
|
|
?CCL6: ICALL1 TELL-PLEASE-USE-COMMANDS
|
|
RTRUE
|
|
?CND1: GET P-N-WORDS,0
|
|
INTBL? WD,P-N-WORDS+2,STACK \?CCL11
|
|
PRINTR "[Use numerals for numbers, for example ""10.""]"
|
|
?CCL11: GET P-C-WORDS,0
|
|
INTBL? WD,P-C-WORDS+2,STACK \FALSE
|
|
PRINTC 91
|
|
CALL2 PICK-ONE,OFFENDED
|
|
PRINT STACK
|
|
PRINTR "]"
|
|
|
|
|
|
.FUNCT W-WORD-REPLY,WD
|
|
EQUAL? WD,W?WHAT,W?WHO \?CTR2
|
|
EQUAL? WINNER,PLAYER /?CCL3
|
|
?CTR2: EQUAL? WD,W?WHERE \?CCL8
|
|
ICALL TO-DO-X-USE-Y,STR?7,STR?8
|
|
RTRUE
|
|
?CCL8: ICALL TO-DO-X-USE-Y,STR?9,STR?10
|
|
RTRUE
|
|
?CCL3: PRINTI "[Maybe you could "
|
|
FSET? LIBRARY,TOUCHBIT \?CCL11
|
|
PRINTI "look that up in the"
|
|
JUMP ?CND9
|
|
?CCL11: PRINTI "find an"
|
|
?CND9: PRINTR " encyclopedia.]"
|
|
|
|
|
|
.FUNCT TO-DO-X-USE-Y,STR1,STR2
|
|
PRINTI "[To "
|
|
PRINT STR1
|
|
PRINTI " something, use the command: "
|
|
PRINT STR2
|
|
PRINT P-SOMETHING
|
|
RTRUE
|
|
|
|
|
|
.FUNCT TELL-PLEASE-USE-COMMANDS,THRESH
|
|
FSET? GREAT-HALL,TOUCHBIT \?CCL3
|
|
SET 'THRESH,10
|
|
JUMP ?CND1
|
|
?CCL3: SET 'THRESH,2
|
|
?CND1: PRINTC 91
|
|
LESS? P-ERRS,THRESH \?CCL6
|
|
PRINT STR?12
|
|
PRINTI ", not statements or questions"
|
|
PRINTR ".]"
|
|
?CCL6: CALL1 TELL-SAMPLE-COMMANDS
|
|
RSTACK
|
|
|
|
|
|
.FUNCT NUMBER?,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,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 PARSE-SENTENCE,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 \?PRG5
|
|
CALL2 UNKNOWN-WORD,TLEXV >CURRENT-TOKEN
|
|
ZERO? CURRENT-TOKEN \?PRG5
|
|
RETURN PARSER-RESULT-DEAD
|
|
?PRG5: GETB CURRENT-TOKEN,8
|
|
BTST STACK,128 /?CCL10
|
|
GETB CURRENT-TOKEN,8 >RES-WCN
|
|
JUMP ?CND7
|
|
?CCL10: GETB CURRENT-TOKEN,8
|
|
BAND STACK,127
|
|
SHIFT STACK,7 >RES-WCN
|
|
?CND7: ZERO? RES-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
|
|
?CND11: ZERO? CAV /?PST36
|
|
GET CAV,1 >CURRENT-ACTION
|
|
JUMP ?PRG38
|
|
?CCL16: GET CURRENT-TOKEN,3 >CURRENT-TOKEN
|
|
JUMP ?PRG5
|
|
?CCL13: SET 'OFFS,0
|
|
CALL2 PEEK-PSTACK,STATE-STACK
|
|
GET ACTION-TABLE,STACK
|
|
GET STACK,0
|
|
CALL GET-TERMINAL-ACTION,RES-WCN,STACK,OFFS >CAV
|
|
ZERO? CAV /?CND19
|
|
BAND RES-WCN,32767 >?TMP1
|
|
GET CAV,OFFS
|
|
BCOM STACK
|
|
BAND ?TMP1,STACK
|
|
ZERO? STACK /?CND19
|
|
ADD CAV,4
|
|
CALL GET-TERMINAL-ACTION,RES-WCN,STACK,OFFS
|
|
ZERO? STACK /?CND19
|
|
ADD SPLIT-NUM,2 >SPLIT-NUM
|
|
ADD SPLIT-NUM,1
|
|
GET SPLIT-STACK,0 >T2
|
|
GRTR? STACK,T2 \?CCL26
|
|
INC 'T2
|
|
LESS? T2,21 /?CND27
|
|
ICALL1 P-NO-MEM-ROUTINE
|
|
?CND27: PUT SPLIT-STACK,0,T2
|
|
PUT SPLIT-STACK,T2,0
|
|
INC 'T2
|
|
LESS? T2,21 /?CND29
|
|
ICALL1 P-NO-MEM-ROUTINE
|
|
?CND29: PUT SPLIT-STACK,0,T2
|
|
PUT SPLIT-STACK,T2,CAV
|
|
JUMP ?CND19
|
|
?CCL26: GET SPLIT-STACK+2,SPLIT-NUM >CAV
|
|
ZERO? CAV /?CND31
|
|
CALL GET-TERMINAL-ACTION,RES-WCN,CAV,OFFS >CAV
|
|
?CND31: PUT SPLIT-STACK+2,SPLIT-NUM,CAV
|
|
?CND19: ZERO? CAV \?CND11
|
|
RETURN PARSER-RESULT-FAILED
|
|
?PST36: SET 'CURRENT-ACTION,0
|
|
?PRG38: ZERO? CAV /?CCL42
|
|
BAND CURRENT-ACTION,65280
|
|
ZERO? STACK /?CCL42
|
|
ADD SPLIT-NUM,2 >SPLIT-NUM
|
|
ADD SPLIT-NUM,1
|
|
GET SPLIT-STACK,0 >T2
|
|
GRTR? STACK,T2 \?CCL47
|
|
INC 'T2
|
|
LESS? T2,21 /?CND48
|
|
ICALL1 P-NO-MEM-ROUTINE
|
|
?CND48: PUT SPLIT-STACK,0,T2
|
|
GETB CURRENT-ACTION,0
|
|
PUT SPLIT-STACK,T2,STACK
|
|
INC 'T2
|
|
LESS? T2,21 /?CND50
|
|
ICALL1 P-NO-MEM-ROUTINE
|
|
?CND50: PUT SPLIT-STACK,0,T2
|
|
PUT SPLIT-STACK,T2,1
|
|
GETB CURRENT-ACTION,1 >CURRENT-ACTION
|
|
JUMP ?CND40
|
|
?CCL47: GET SPLIT-STACK+2,SPLIT-NUM
|
|
GETB CURRENT-ACTION,STACK >CURRENT-ACTION
|
|
JUMP ?CND40
|
|
?CCL42: ZERO? CAV /?CND40
|
|
ZERO? CURRENT-ACTION \?CND40
|
|
RETURN PARSER-RESULT-FAILED
|
|
?CND40: ZERO? CAV /?CTR56
|
|
LESS? CURRENT-ACTION,128 \?CCL57
|
|
?CTR56: ZERO? CAV /?CND60
|
|
XPUSH CURRENT-TOKEN,DATA-STACK \?CCL64
|
|
XPUSH CURRENT-ACTION,STATE-STACK /?CND60
|
|
?CCL64: ICALL1 P-NO-MEM-ROUTINE
|
|
?CND60: DLESS? 'P-LEN,1 \?CCL69
|
|
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 ?CND67
|
|
?CCL69: INC 'P-WORD-NUMBER
|
|
ADD TLEXV,4 >TLEXV
|
|
GET TLEXV,0 >CURRENT-TOKEN
|
|
GRTR? TLEXV,OTLEXV \?CND67
|
|
SET 'OTLEXV,TLEXV
|
|
?CND67: ZERO? CURRENT-TOKEN \?CCL74
|
|
CALL2 UNKNOWN-WORD,TLEXV >CURRENT-TOKEN
|
|
ZERO? CURRENT-TOKEN \?PRG5
|
|
RETURN PARSER-RESULT-DEAD
|
|
?CCL74: EQUAL? CURRENT-TOKEN,W?THEN,W?!,W?PERIOD /?CCL77
|
|
EQUAL? CURRENT-TOKEN,W?? \?PRG5
|
|
?CCL77: SET 'P-WORDS-AGAIN,P-WORD-NUMBER
|
|
DLESS? 'P-LEN,1 /?CCL82
|
|
ADD TLEXV,4 >P-CONT
|
|
JUMP ?PRG5
|
|
?CCL82: SET 'P-CONT,FALSE-VALUE
|
|
JUMP ?PRG5
|
|
?CCL57: GRTR? CURRENT-ACTION,128 \?CCL84
|
|
SUB CURRENT-ACTION,129
|
|
GET REDUCTION-TABLE,STACK >REDUCTION
|
|
GET REDUCTION,0 >RES-WCN
|
|
ZERO? RES-WCN /?CND87
|
|
SET 'N,RES-WCN
|
|
?PRG89: DLESS? 'N,0 /?CND87
|
|
POP STATE-STACK
|
|
JUMP ?PRG89
|
|
?CND87: 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 \?CND93
|
|
SET 'OTLEXV,TLEXV
|
|
?CND93: LESS? P-LEN,1 \?CCL97
|
|
SET 'CURRENT-TOKEN,W?END.OF.INPUT
|
|
JUMP ?CND95
|
|
?CCL97: GET TLEXV,0 >CURRENT-TOKEN
|
|
?CND95: SET 'CURRENT-REDUCTION,FALSE-VALUE
|
|
ZERO? RES-WCN \?CTR99
|
|
RETURN PARSER-RESULT-FAILED
|
|
?CTR99: XPUSH RES-WCN,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
|
|
?CCL84: POP DATA-STACK >PARSER-RESULT
|
|
RETURN PARSER-RESULT-WON
|
|
|
|
|
|
.FUNCT GET-TERMINAL-ACTION,TYPE,STATE,OFFS,V
|
|
ZERO? STATE /FALSE
|
|
SET 'V,STATE
|
|
?PRG4: GET V,0
|
|
ZERO? STACK /FALSE
|
|
GET V,OFFS
|
|
BAND TYPE,STACK
|
|
ZERO? STACK /?CND8
|
|
RETURN V
|
|
?CND8: ADD V,4 >V
|
|
JUMP ?PRG4
|
|
|
|
|
|
.FUNCT GET-NONTERMINAL-ACTION,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,NUM
|
|
LESS? NUM,0 \?CCL3
|
|
LESS? NUM,-15 \FALSE
|
|
BUFOUT TRUE-VALUE
|
|
PRINTR "]"
|
|
?CCL3: MOD NUM,16
|
|
ZERO? STACK \FALSE
|
|
EQUAL? NUM,16 \?CCL11
|
|
BUFOUT FALSE-VALUE
|
|
PRINTI "[Please be patient..."
|
|
RTRUE
|
|
?CCL11: PRINTC 46
|
|
RTRUE
|
|
|
|
|
|
.FUNCT P-NO-MEM-ROUTINE,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 DO-IT-AGAIN,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
|
|
|
|
|
|
.FUNCT INVALID-OBJECT?,OBJ
|
|
CALL1 EVERYWHERE-VERB?
|
|
ZERO? STACK \FALSE
|
|
EQUAL? OBJ,CEILING \?CCL5
|
|
FSET? HERE,OUTSIDEBIT \?CCL5
|
|
EQUAL? HERE,ROOF,PARAPET \TRUE
|
|
?CCL5: EQUAL? OBJ,LOCK-OBJECT \?CCL10
|
|
CALL NOUN-USED?,LOCK-OBJECT,W?KEYHOLE
|
|
ZERO? STACK /?CCL10
|
|
EQUAL? HERE,LOWEST-HALL /TRUE
|
|
?CCL10: EQUAL? OBJ,WALL \FALSE
|
|
FSET? HERE,OUTSIDEBIT \FALSE
|
|
GET FINDER,6
|
|
EQUAL? W?ONE,STACK /FALSE
|
|
EQUAL? HERE,PERIMETER-WALL /FALSE
|
|
RTRUE
|
|
|
|
|
|
.FUNCT TEST-THINGS,RM,F,CT,RMG,RMGL,TTBL,NOUN,V,?TMP2,?TMP1
|
|
GETP RM,P?THINGS >RMG
|
|
GET RMG,0 >RMGL
|
|
ADD RMG,2 >RMG
|
|
GET F,5 >CT
|
|
ZERO? CT /?CND1
|
|
GET CT,4 >CT
|
|
?CND1: GET F,6 >NOUN
|
|
GET F,5
|
|
ADD STACK,10 >V
|
|
?PRG3: GET RMG,1 >TTBL
|
|
ZERO? TTBL /?CND5
|
|
EQUAL? NOUN,W?ONE /?PRD9
|
|
ADD TTBL,2 >?TMP1
|
|
GET TTBL,0
|
|
INTBL? NOUN,?TMP1,STACK \?CND5
|
|
?PRD9: ZERO? CT /?PRD12
|
|
GET RMG,0 >TTBL
|
|
ZERO? TTBL /?CND5
|
|
GET V,0 >?TMP2
|
|
ADD TTBL,2 >?TMP1
|
|
GET TTBL,0
|
|
INTBL? ?TMP2,?TMP1,STACK \?CND5
|
|
?PRD12: GET F,7
|
|
ZERO? STACK /?CCL6
|
|
GET OWNER-SR-HERE,1
|
|
EQUAL? 1,STACK \?CND5
|
|
GET OWNER-SR-HERE,4
|
|
EQUAL? PSEUDO-OBJECT,STACK \?CND5
|
|
EQUAL? LAST-PSEUDO-LOC,RM \?CND5
|
|
GETP PSEUDO-OBJECT,P?ACTION >?TMP1
|
|
GET RMG,2
|
|
EQUAL? ?TMP1,STACK \?CND5
|
|
?CCL6: SET 'LAST-PSEUDO-LOC,RM
|
|
GET RMG,2
|
|
PUTP PSEUDO-OBJECT,P?ACTION,STACK
|
|
GETPT PSEUDO-OBJECT,P?ACTION
|
|
SUB STACK,7 >V
|
|
COPYT NOUN,V,6
|
|
ICALL ADD-OBJECT,PSEUDO-OBJECT,F
|
|
RFALSE
|
|
?CND5: ADD RMG,6 >RMG
|
|
DLESS? 'RMGL,1 \?PRG3
|
|
RTRUE
|
|
|
|
.ENDSEG
|
|
|
|
.ENDI
|