abyss/reds.zap

1678 lines
34 KiB
Plaintext

.SEGMENT "0"
.FUNCT NOT-HERE-VERB?:ANY:1:1,V
RFALSE
.FUNCT RED-FCN:ANY:0:2,N,TYP
ZERO? N /TRUE
EQUAL? N,1 \FALSE
POP DATA-STACK
RSTACK
.FUNCT RED-PART:ANY:0:2,N,TYP,WD,?TMP1
ZERO? N /TRUE
POP DATA-STACK >WD
EQUAL? WD,TRUE-VALUE,W?OF /?CCL5
GET WD,4 >?TMP1
ZERO? ?TMP1 /?PRD12
PUSH ?TMP1
JUMP ?PEN10
?PRD12: GET WD,3
GET STACK,4
?PEN10: BTST STACK,32768 /FALSE
GET WD,4 >?TMP1
ZERO? ?TMP1 /?PRD15
PUSH ?TMP1
JUMP ?PEN13
?PRD15: GET WD,3
GET STACK,4
?PEN13: BAND STACK,2048
BAND STACK,32767
ZERO? STACK /FALSE
?CCL5: EQUAL? N,1 \?CCL17
RETURN WD
?CCL17: POP DATA-STACK
RSTACK
.FUNCT GET-SYNTAX:ANY:2:4,VA,NUM,PREP,GWIM,LEN,CT,S2,P2,GWIM-NOW,SYN
EQUAL? PREP,1 \?CND1
SET 'PREP,0
?CND1: EQUAL? NUM,1 \?CCL5
SET 'LEN,6
JUMP ?CND3
?CCL5: SET 'LEN,10
?CND3: GET VA,0 >CT
GET PARSE-RESULT,8 >P2
SET 'GWIM-NOW,FALSE-VALUE
ADD VA,2 >SYN
?PRG6: GET SYN,1
EQUAL? PREP,STACK \?CCL10
EQUAL? NUM,1 /?CTR9
GET SYN,3 >S2
EQUAL? P2,S2 /?CTR9
ZERO? S2 \?PRD16
EQUAL? P2,1 /?CTR9
?PRD16: ZERO? GWIM-NOW /?CCL10
EQUAL? NUM,1 \?CND22
SET 'S2,PREP
?CND22: ZERO? S2 /?CCL10
PUT GWIM-MSG,0,S2
?CTR9: PUT PARSE-RESULT,3,SYN
GET SYN,0
PUT PARSE-RESULT,4,STACK
PUT PARSE-RESULT,7,PREP
RETURN SYN
?CCL10: DLESS? 'CT,1 \?CCL26
ZERO? GWIM /FALSE
ZERO? GWIM-NOW \FALSE
GET VA,0 >CT
SET 'GWIM-NOW,TRUE-VALUE
ADD VA,2 >SYN
JUMP ?PRG6
?CCL26: ADD SYN,LEN >SYN
JUMP ?PRG6
.FUNCT RED-SV:ANY:0:2,N,TYP,SYN,VERB,PART,DATA,OBJ
POP DATA-STACK >PART
POP DATA-STACK
GET PARSE-RESULT,1
CALL2 ROOT-VERB,STACK >VERB
ZERO? VERB /FALSE
GET VERB,3 >DATA
ZERO? DATA /FALSE
EQUAL? PART,1 \?CCL8
GET DATA,0
GRTR? 0,STACK /?CCL8
GET DATA,0
PUT PARSE-RESULT,4,STACK
RTRUE
?CCL8: GET DATA,2 >SYN
ZERO? SYN /?CCL12
CALL GET-SYNTAX,SYN,1,PART,TRUE-VALUE >SYN
ZERO? SYN /?CCL12
CALL DETERMINE-OBJ,FALSE-VALUE,1 >OBJ
ZERO? OBJ /?CCL12
PUT PARSE-RESULT,5,OBJ
RTRUE
?CCL12: GET DATA,3 >SYN
ZERO? SYN /FALSE
CALL GET-SYNTAX,SYN,2,PART,TRUE-VALUE >SYN
ZERO? SYN /FALSE
CALL DETERMINE-OBJ,FALSE-VALUE,1 >OBJ
ZERO? OBJ /FALSE
PUT PARSE-RESULT,5,OBJ
GET OBJ,3
PUT ORPHAN-S,O-OBJECT,STACK
CALL DETERMINE-OBJ,FALSE-VALUE,2 >OBJ
ZERO? OBJ /FALSE
PUT PARSE-RESULT,6,OBJ
RTRUE
.FUNCT ROOT-VERB:ANY:1:1,VERB,DATA,X,?TMP1
ADD WORD-FLAG-TABLE,2 >?TMP1
GET WORD-FLAG-TABLE,0
INTBL? VERB,?TMP1,STACK,132 >X \?CCL7
GET X,1
JUMP ?CND5
?CCL7: PUSH FALSE-VALUE
?CND5: BTST STACK,512 /?PRD4
RETURN VERB
?PRD4: GET VERB,3 >DATA
ZERO? DATA /?CND1
SET 'VERB,DATA
?CND1: RETURN VERB
.FUNCT RED-SVN:ANY:0:2,N,TYP,SYN1,SYN2,VERB,PART,DATA,OBJ,OBJ1,OBJ2
POP DATA-STACK >OBJ
POP DATA-STACK >PART
POP DATA-STACK
GET PARSE-RESULT,1
CALL2 ROOT-VERB,STACK >VERB
ZERO? VERB /FALSE
GET VERB,3 >DATA
ZERO? DATA /FALSE
GET PARSE-RESULT,8
ZERO? STACK \?CCL8
GET DATA,2 >SYN1
ZERO? SYN1 /?CCL8
CALL GET-SYNTAX,SYN1,1,PART >SYN1
ZERO? SYN1 /?CCL8
CALL DETERMINE-OBJ,OBJ,1 >OBJ1
ZERO? OBJ1 \?CCL14
GETB SYN1,5
CALL PARSER-ERROR,0,PARSER-ERROR-NOOBJ,OBJ,PART,STACK
RSTACK
?CCL14: GET OBJ1,3
EQUAL? INTDIR,STACK \?CCL16
GET PARSE-RESULT,1
EQUAL? STACK,W?WALK,W?GO,W?RUN \?CCL16
GET OBJ,2
XPUSH STACK,DATA-STACK \?CCL16
CALL RED-SD,1,TYP
RSTACK
?CCL16: PUT PARSE-RESULT,5,OBJ1
RETURN PARSE-RESULT
?CCL8: GET DATA,3 >SYN2
ZERO? SYN2 /FALSE
CALL GET-SYNTAX,SYN2,2,PART,TRUE-VALUE >SYN2
ZERO? SYN2 /FALSE
CALL DETERMINE-OBJ,OBJ,1 >OBJ1
ZERO? OBJ1 \?CCL26
GETB SYN2,5
CALL PARSER-ERROR,0,PARSER-ERROR-NOOBJ,OBJ,PART,STACK
RSTACK
?CCL26: PUT PARSE-RESULT,5,OBJ1
GET OBJ1,3
PUT ORPHAN-S,O-OBJECT,STACK
CALL DETERMINE-OBJ,FALSE-VALUE,2 >OBJ2
ZERO? OBJ2 /FALSE
PUT PARSE-RESULT,6,OBJ2
RETURN PARSE-RESULT
.FUNCT RED-SVNP:ANY:0:2,N,TYP,PART,OBJ
POP DATA-STACK >PART
POP DATA-STACK >OBJ
XPUSH PART,DATA-STACK /?BOGUS1
?BOGUS1: XPUSH OBJ,DATA-STACK /?BOGUS2
?BOGUS2: CALL RED-SVN,N,TYP
ZERO? STACK \TRUE
GET PARSE-RESULT,1
XPUSH STACK,DATA-STACK /?BOGUS6
?BOGUS6: XPUSH TRUE-VALUE,DATA-STACK /?BOGUS7
?BOGUS7: PUT PARSE-RESULT,8,PART
XPUSH OBJ,DATA-STACK /?BOGUS8
?BOGUS8: CALL RED-SVN,N,TYP
RSTACK
.FUNCT RED-SVNPN:ANY:0:2,N,TYP,OBJ2,OBJ1
POP DATA-STACK >OBJ2
POP DATA-STACK
PUT PARSE-RESULT,8,STACK
POP DATA-STACK >OBJ1
XPUSH OBJ1,DATA-STACK /?BOGUS1
?BOGUS1: XPUSH OBJ2,DATA-STACK /?BOGUS2
?BOGUS2: DEC 'N
CALL RED-SVPNN,N,TYP
RSTACK
.FUNCT RED-SVPNN:ANY:0:2,N,TYP,N1,N2,PART,OBJ1,OBJ2,SYN,?TMP1
POP DATA-STACK >N2
GET PARSE-RESULT,8
ZERO? STACK \?CND1
GET GWIM-MSG,0 >?TMP1
ZERO? ?TMP1 /?PRD5
PUSH ?TMP1
JUMP ?PEN3
?PRD5: PUSH 1
?PEN3: PUT PARSE-RESULT,8,STACK
?CND1: POP DATA-STACK >N1
EQUAL? N,4 \?CND6
POP DATA-STACK >PART
?CND6: GET PARSE-RESULT,1
CALL2 ROOT-VERB,STACK >SYN
ZERO? SYN \?CCL10
CALL PARSER-ERROR,0,PARSER-ERROR-NOUND
RSTACK
?CCL10: GET SYN,3 >SYN
ZERO? SYN /FALSE
GET SYN,3 >SYN
ZERO? SYN \?CCL14
CALL PARSER-ERROR,0,PARSER-ERROR-TMNOUN
RSTACK
?CCL14: CALL GET-SYNTAX,SYN,2,PART >SYN
ZERO? SYN \?CCL16
CALL PARSER-ERROR,0,PARSER-ERROR-NOUND
RSTACK
?CCL16: CALL DETERMINE-OBJ,N1,1 >OBJ1
ZERO? OBJ1 \?CCL18
GETB SYN,5
CALL PARSER-ERROR,0,PARSER-ERROR-NOOBJ,N1,PART,STACK
RSTACK
?CCL18: CALL DETERMINE-OBJ,N2,2 >OBJ2
ZERO? OBJ2 \?CCL20
GETB SYN,9
CALL PARSER-ERROR,0,PARSER-ERROR-NOOBJ,N2,PART,STACK
RSTACK
?CCL20: CALL2 DIR-VERB-PRSI?,OBJ2
ZERO? STACK /?CCL22
CALL PARSER-ERROR,0,PARSER-ERROR-NOUND
RSTACK
?CCL22: POP DATA-STACK
PUT PARSE-RESULT,5,OBJ1
PUT PARSE-RESULT,6,OBJ2
RTRUE
.FUNCT RED-SVPNPN:ANY:0:2,N,TYP,N2
POP DATA-STACK >N2
POP DATA-STACK
PUT PARSE-RESULT,8,STACK
XPUSH N2,DATA-STACK /?BOGUS1
?BOGUS1: SUB N,1
CALL RED-SVPNN,STACK,TYP
RSTACK
.FUNCT RED-SVD:ANY:0:2,N,TYP,DIR
POP DATA-STACK >DIR
GET PARSE-RESULT,1
EQUAL? STACK,W?WALK,W?GO,W?RUN \FALSE
POP DATA-STACK
XPUSH DIR,DATA-STACK /?BOGUS4
?BOGUS4: SUB N,1
CALL RED-SD,STACK,TYP
RSTACK
.FUNCT RED-SP:ANY:0:2,N,TYP,A,?TMP1
POP DATA-STACK >A
DEC 'N
EQUAL? N,2 \?CND1
EQUAL? TRUE-VALUE,A /?CND1
GET A,3 >?TMP1
ZERO? ?TMP1 /?PRD7
PUSH ?TMP1
JUMP ?PEN5
?PRD7: PUSH A
?PEN5: PUT PARSE-RESULT,0,STACK
?CND1: FSTACK N,DATA-STACK
RETURN PARSE-RESULT
.FUNCT IREDUCE-EXCEPTION:ANY:2:2,ENP,NP
GET ENP,2
EQUAL? STACK,W?ONE \?CND1
GET NP,2
PUT ENP,2,STACK
?CND1: GET ENP,3
ZERO? STACK \?CND3
PUT ENP,3,NP-QUANT-ALL
?CND3: SET 'SEARCH-FLAGS,31
CALL DETERMINE-NP,0,0,ENP
RSTACK
.FUNCT REDUCE-EXCEPT-IT:ANY:2:2,PHR,NP
GET PHR,1
EQUAL? 1,STACK \FALSE
GET PHR,3
EQUAL? IT,STACK \FALSE
ZERO? P-IT-OBJECT \?CCL8
CALL PARSER-ERROR,0,PARSER-ERROR-NOOBJ,NP
RSTACK
?CCL8: PUT PHR,3,P-IT-OBJECT
RTRUE
.FUNCT REDUCE-EXCEPTION:ANY:2:2,PP,NP,ENP,NOUN-PHRASE,NEW-OBJECT,NNP,GOOD,BAD
GET PP,2 >ENP
GETB ENP,1
EQUAL? STACK,2 \?CCL3
CALL IREDUCE-EXCEPTION,ENP,NP >NOUN-PHRASE
ZERO? NOUN-PHRASE /FALSE
ICALL REDUCE-EXCEPT-IT,NOUN-PHRASE,ENP
CALL DO-PMEM-ALLOC,3,3 >NEW-OBJECT
PUT NEW-OBJECT,2,ENP
PUT NEW-OBJECT,3,NOUN-PHRASE
PUT NP,6,NEW-OBJECT
RETURN NP
?CCL3: SET 'NNP,ENP
SET 'GOOD,FALSE-VALUE
?PRG7: GET NNP,2 >BAD
CALL IREDUCE-EXCEPTION,BAD,NP >NEW-OBJECT
ZERO? NEW-OBJECT /?CND9
SET 'GOOD,TRUE-VALUE
ICALL REDUCE-EXCEPT-IT,NEW-OBJECT,BAD
PUT NNP,3,NEW-OBJECT
?CND9: GET NNP,1 >NNP
ZERO? NNP \?PRG7
ZERO? GOOD /?CCL15
PUT NP,6,ENP
RETURN NP
?CCL15: CALL PARSER-ERROR,0,PARSER-ERROR-NOOBJ,BAD
RSTACK
.FUNCT REDUCE-LOCATION:TABLE:1:3,PP,SYN,WHICH,SEARCH,TEST,PREP,NP,RLOC,BIT,MSG,OLD-OBJECT,NEW-OBJECT
ZERO? SYN \?CCL3
SET 'SEARCH,0
JUMP ?CND1
?CCL3: EQUAL? WHICH,1 \?CCL6
GETB SYN,5 >SEARCH
JUMP ?CND1
?CCL6: GETB SYN,9 >SEARCH
?CND1: ZERO? SYN \?CCL9
SET 'TEST,0
JUMP ?CND7
?CCL9: EQUAL? WHICH,1 \?CCL12
GETB SYN,4 >TEST
JUMP ?CND7
?CCL12: GETB SYN,8 >TEST
?CND7: GET PP,1 >PREP
GET PP,2 >NP
ZERO? SEARCH \?CND13
SET 'SEARCH,5
?CND13: COPYT PREP-BIT,0,6
EQUAL? PREP,W?BUT,W?EXCEPT /FALSE
EQUAL? PREP,W?IN,W?INSIDE \?CCL19
SET 'BIT,CONTBIT
SET 'MSG,P-NO-INSIDE
JUMP ?CND15
?CCL19: EQUAL? PREP,W?ON,W?OFF \?CCL21
SET 'BIT,SURFACEBIT
SET 'MSG,P-NO-SURFACE
JUMP ?CND15
?CCL21: EQUAL? PREP,W?FROM \FALSE
SET 'BIT,SURFACEBIT
PUT PREP-BIT,1,PERSONBIT
PUT PREP-BIT,2,CONTBIT
SET 'MSG,P-NOTHING
?CND15: PUT PREP-BIT,0,BIT
GETB NP,1
EQUAL? STACK,2 \FALSE
GET NP,5 >RLOC
ZERO? RLOC /?CND27
GET RLOC,2
GET STACK,3 >RLOC
?CND27: SET 'OLD-OBJECT,FINDER
PUT OLD-OBJECT,0,TEST
PUT OLD-OBJECT,1,0
PUT OLD-OBJECT,2,FALSE-VALUE
PUT OLD-OBJECT,3,FALSE-VALUE
PUT OLD-OBJECT,4,0
GET NP,1
PUT OLD-OBJECT,5,STACK
GET NP,2
PUT OLD-OBJECT,6,STACK
PUT OLD-OBJECT,7,FALSE-VALUE
PUT OLD-OBJECT,8,FALSE-VALUE
PUT OLD-OBJECT,9,SEARCH-RES
CALL2 NUMERIC-ADJ?,NP
PUT OLD-OBJECT,10,STACK
ZERO? RLOC \?CCL31
PUSH SEARCH
JUMP ?CND29
?CCL31: PUSH 0
?CND29: CALL FIND-OBJECTS,STACK,RLOC >SEARCH
ZERO? SEARCH /?CCL34
CALL DO-PMEM-ALLOC,4,NOUN-PHRASE-MIN-LENGTH >OLD-OBJECT
PUT OLD-OBJECT,1,1
GET SEARCH-RES,4
PUT OLD-OBJECT,3,STACK
PUT OLD-OBJECT,4,NP
SET 'RLOC,OLD-OBJECT
CALL DO-PMEM-ALLOC,6,2 >NEW-OBJECT
PUT NEW-OBJECT,1,PREP
PUT NEW-OBJECT,2,RLOC
RETURN NEW-OBJECT
?CCL34: GET SEARCH-RES,1
ZERO? STACK \?CCL36
CALL PARSER-ERROR,0,PARSER-ERROR-NOOBJ,NP,PREP
RSTACK
?CCL36: CALL2 READY-TO-DISAMBIGUATE?,NP
ZERO? STACK /FALSE
GET PARSE-RESULT,1
CALL PARSER-ERROR,0,PARSER-ERROR-ORPH-NP,NP,STACK
RSTACK
.FUNCT DETERMINE-OBJ:ANY:1:3,OBJ,NUM,PICK,VAL,RES,COUNT,SYN,S-FLAGS,SEARCH-ACT,OLD-OBJECT,NO,CT,PTR,CNT,TMP
ZERO? NUM \?CCL3
SET 'SYN,0
JUMP ?CND1
?CCL3: GET PARSE-RESULT,3 >SYN
?CND1: ZERO? NUM \?CCL6
SET 'S-FLAGS,128
JUMP ?CND4
?CCL6: EQUAL? NUM,1 \?CCL8
GETB SYN,5 >S-FLAGS
JUMP ?CND4
?CCL8: GETB SYN,9 >S-FLAGS
?CND4: ZERO? NUM \?CCL11
SET 'SEARCH-ACT,0
JUMP ?CND9
?CCL11: EQUAL? NUM,1 \?CCL13
GETB SYN,4 >SEARCH-ACT
JUMP ?CND9
?CCL13: GETB SYN,8 >SEARCH-ACT
?CND9: ZERO? OBJ \?CCL16
SET 'OLD-OBJECT,FINDER
PUT OLD-OBJECT,0,SEARCH-ACT
PUT OLD-OBJECT,1,FIND-FLAGS-GWIM
PUT OLD-OBJECT,2,FALSE-VALUE
PUT OLD-OBJECT,3,SYN
PUT OLD-OBJECT,4,NUM
PUT OLD-OBJECT,5,FALSE-VALUE
PUT OLD-OBJECT,6,FALSE-VALUE
PUT OLD-OBJECT,7,FALSE-VALUE
PUT OLD-OBJECT,8,FALSE-VALUE
PUT OLD-OBJECT,9,SEARCH-RES
PUT OLD-OBJECT,10,0
ZERO? PICK /?CND17
PUT FINDER,2,NP-QUANT-ALL
?CND17: EQUAL? SEARCH-ACT,ROOMSBIT \?PRD23
PUT SEARCH-RES,4,ROOMS
JUMP ?CTR20
?PRD23: ZERO? S-FLAGS /?CCL21
CALL2 FIND-OBJECTS,S-FLAGS
ZERO? STACK \?PRD28
ZERO? PICK /?CCL21
GET SEARCH-RES,1
ZERO? STACK /?CCL21
?PRD28: EQUAL? NUM,1 \?CCL36
GET SYN,1
JUMP ?CND34
?CCL36: GET SYN,3
?CND34: PUT GWIM-MSG,0,STACK
GET SEARCH-RES,4
PUT GWIM-MSG,1,STACK
?CTR20: CALL DO-PMEM-ALLOC,4,NOUN-PHRASE-MIN-LENGTH >OLD-OBJECT
PUT OLD-OBJECT,1,1
GET SEARCH-RES,4
PUT OLD-OBJECT,3,STACK
SET 'RES,OLD-OBJECT
RETURN RES
?CCL21: GET PARSE-RESULT,1
PUT ORPHAN-S,O-VERB,STACK
ZERO? P-LEN \?CCL39
ADD TLEXV,4
JUMP ?CND37
?CCL39: PUSH TLEXV
?CND37: PUT ORPHAN-S,O-LEXPTR,STACK
GET PARSE-RESULT,3
PUT ORPHAN-S,O-SYNTAX,STACK
PUT ORPHAN-S,O-WHICH,NUM
GET PARSE-RESULT,7
PUT ORPHAN-S,O-PART,STACK
GET PARSE-RESULT,5
GET STACK,3
PUT ORPHAN-S,O-OBJECT,STACK
GET PARSE-RESULT,12 >VAL
ZERO? VAL /?CND40
GET VAL,3 >VAL
?CND40: PUT ORPHAN-S,O-SUBJECT,VAL
GET PARSE-RESULT,5
CALL PARSER-ERROR,0,PARSER-ERROR-ORPH-S,STACK
RSTACK
?CCL16: GETB OBJ,1
EQUAL? STACK,4 \?CCL43
RETURN OBJ
?CCL43: GETB OBJ,1
EQUAL? STACK,2 \?CCL45
SET 'SEARCH-FLAGS,S-FLAGS
CALL DETERMINE-NP,0,NUM,OBJ
RSTACK
?CCL45: BTST S-FLAGS,16 /?CCL47
GET PARSE-RESULT,1
CALL PARSER-ERROR,0,PARSER-ERROR-NOMULT,NUM,STACK
RSTACK
?CCL47: SET 'SEARCH-FLAGS,S-FLAGS
SET 'NO,OBJ
SET 'CT,FALSE-VALUE
?PRG48: CALL DETERMINE-NP,0,NUM,NO,TRUE-VALUE >PTR
ZERO? PTR /FALSE
GET NO,3
GET STACK,1
ADD COUNT,STACK >COUNT
ZERO? CT \?CND53
ADD PTR,6 >PTR
SET 'CNT,COUNT
?PRG55: DLESS? 'CNT,0 /?CND53
GET PTR,0
EQUAL? NOT-HERE-OBJECT,STACK /?CCL61
SET 'CT,TRUE-VALUE
?CND53: GET NO,1 >NO
ZERO? NO \?PRG48
ZERO? CT /FALSE
MUL COUNT,2
ADD STACK,2
CALL DO-PMEM-ALLOC,4,STACK >CNT
PUT CNT,1,COUNT
SET 'RES,CNT
SET 'NO,OBJ
ADD RES,6 >PTR
?PRG66: GET NO,3 >CT
GET CT,1
MUL 4,STACK >TMP
ADD CT,6
COPYT STACK,PTR,TMP
ADD PTR,TMP >PTR
GET NO,1 >NO
ZERO? NO \?PRG66
RETURN RES
?CCL61: ADD PTR,4 >PTR
JUMP ?PRG55
.FUNCT CHECK-DIR-ADJS:ANY:1:1,ADJS,AV,CT,ADJ,PT,?TMP1
ADD ADJS,10 >AV
GET ADJS,4 >CT
?PRG1: DLESS? 'CT,0 /FALSE
GET AV,CT >ADJ
ZERO? ADJ /?PRG1
GET ADJ,4 >?TMP1
ZERO? ?TMP1 /?PRD12
PUSH ?TMP1
JUMP ?PEN10
?PRD12: GET ADJ,3
GET STACK,4
?PEN10: BTST STACK,32768 /?PRG1
GET ADJ,4 >?TMP1
ZERO? ?TMP1 /?PRD16
PUSH ?TMP1
JUMP ?PEN14
?PRD16: GET ADJ,3
GET STACK,4
?PEN14: BAND STACK,64
BAND STACK,32767
ZERO? STACK /?PRG1
GETB ADJ,6
GETPT HERE,STACK >PT
ZERO? PT /?PRG1
PTSIZE PT
EQUAL? STACK,DEXIT \?PRG1
PUT AV,CT,W?NO.WORD
GET PT,DEXITOBJ
CALL MATCH-OBJECT,STACK,FINDER,TRUE-VALUE
ZERO? STACK \?CND18
PUT AV,CT,ADJ
RTRUE
?CND18: PUT AV,CT,ADJ
JUMP ?PRG1
.FUNCT NUMERIC-ADJ?:ANY:1:1,NP,ADJS,VAL,AV,CT,ADJ,VV
GET NP,1 >ADJS
ZERO? ADJS /FALSE
ADD ADJS,10 >AV
GET ADJS,4 >CT
?PRG4: DLESS? 'CT,0 /?REP5
GET AV,CT >ADJ
EQUAL? ADJ,W?INT.NUM \?PRG4
GET NP,8 >VV
?PRG10: GET VV,0
EQUAL? ADJ,STACK \?CCL14
GET VV,1 >VAL
JUMP ?PRG4
?CCL14: SUB VV,P-LEXELEN >VV
GRTR? P-LEXV,VV /?PRG4
JUMP ?PRG10
?REP5: RETURN VAL
.FUNCT DETERMINE-NP:ANY:3:4,SEARCH-ACT,WHICH,OBJ,MULTI,SYN,ROBJ,RLOC,QUANT,OWNER,RES,COUNT,TMP,OLD-OBJECT,NEW-OBJECT,?TMP1
?FCN: ZERO? WHICH \?CCL3
SET 'SYN,FALSE-VALUE
JUMP ?CND1
?CCL3: GET PARSE-RESULT,3 >SYN
?CND1: SET 'ROBJ,OBJ
GETB OBJ,1
EQUAL? STACK,3 \?CND4
GET OBJ,2 >ROBJ
?CND4: GET ROBJ,5 >RLOC
ZERO? RLOC /?CND6
GET RLOC,2 >RLOC
GET RLOC,3 >RLOC
?CND6: GET ROBJ,3 >QUANT
ZERO? QUANT /?CND8
GRTR? QUANT,NP-QUANT-A \?CND8
BTST SEARCH-FLAGS,16 /?CND8
GET PARSE-RESULT,1
CALL PARSER-ERROR,0,PARSER-ERROR-NOMULT,WHICH,STACK
RSTACK
?CND8: GET ROBJ,4 >OWNER
ZERO? OWNER \?PRD16
GET ROBJ,1 >OWNER
ZERO? OWNER /?CND13
GET OWNER,2 >OWNER
ZERO? OWNER /?CND13
?PRD16: CALL2 PMEM?,OWNER
ZERO? STACK /?CND13
PUT SEARCH-RES,2,FALSE-VALUE
GET OWNER,2
EQUAL? W?IT,STACK \?CCL23
PUT SEARCH-RES,1,1
PUT SEARCH-RES,4,P-IT-OBJECT
CALL2 VISIBLE?,P-IT-OBJECT
ZERO? STACK /?CCL26
COPYT SEARCH-RES,OWNER-SR-HERE,20
JUMP ?CND13
?CCL26: COPYT SEARCH-RES,OWNER-SR-THERE,20
JUMP ?CND13
?CCL23: SET 'OLD-OBJECT,FINDER
PUT OLD-OBJECT,0,SEARCH-ACT
PUT OLD-OBJECT,1,0
PUT OLD-OBJECT,2,FALSE-VALUE
PUT OLD-OBJECT,3,SYN
PUT OLD-OBJECT,4,WHICH
GET OWNER,1
PUT OLD-OBJECT,5,STACK
GET OWNER,2
PUT OLD-OBJECT,6,STACK
GET OWNER,4
PUT OLD-OBJECT,7,STACK
PUT OLD-OBJECT,8,FALSE-VALUE
PUT OLD-OBJECT,9,SEARCH-RES
CALL2 NUMERIC-ADJ?,OWNER
PUT OLD-OBJECT,10,STACK
PUT SEARCH-RES,1,0
ICALL2 FIND-OBJECTS,15
COPYT SEARCH-RES,OWNER-SR-HERE,20
PUT SEARCH-RES,1,0
PUT SEARCH-RES,2,FALSE-VALUE
ICALL2 FIND-OWNERS,OWNERS
COPYT SEARCH-RES,OWNER-SR-THERE,20
?CND13: SET 'RES,FALSE-VALUE
GET ROBJ,2
EQUAL? STACK,W?HIMSELF \?CND27
EQUAL? 2,WHICH \?CCL31
GET PARSE-RESULT,5 >COUNT
ZERO? COUNT /?CCL31
GET COUNT,3 >COUNT
ZERO? COUNT /?CCL31
FSET? COUNT,PERSONBIT \?CCL31
SET 'RES,COUNT
FSET? COUNT,FEMALE \?CND27
SET 'RES,P-HIM-OBJECT
JUMP ?CND27
?CCL31: SET 'RES,P-HIM-OBJECT
?CND27: GET ROBJ,2
EQUAL? STACK,W?HERSELF \?CND38
EQUAL? 2,WHICH \?CCL42
GET PARSE-RESULT,5 >COUNT
ZERO? COUNT /?CCL42
GET COUNT,3 >COUNT
ZERO? COUNT /?CCL42
FSET? COUNT,PERSONBIT \?CCL42
FSET? COUNT,FEMALE \?CCL42
SET 'RES,COUNT
JUMP ?CND38
?CCL42: SET 'RES,P-HER-OBJECT
?CND38: ZERO? RES /?CND48
CALL DO-PMEM-ALLOC,4,NOUN-PHRASE-MIN-LENGTH >OLD-OBJECT
PUT OLD-OBJECT,1,1
PUT OLD-OBJECT,3,RES
PUT OLD-OBJECT,4,ROBJ
RETURN OLD-OBJECT
?CND48: SET 'OLD-OBJECT,FINDER
PUT OLD-OBJECT,0,SEARCH-ACT
PUT OLD-OBJECT,1,0
PUT OLD-OBJECT,2,QUANT
PUT OLD-OBJECT,3,SYN
PUT OLD-OBJECT,4,WHICH
GET ROBJ,1
PUT OLD-OBJECT,5,STACK
GET ROBJ,2
PUT OLD-OBJECT,6,STACK
GET ROBJ,4
PUT OLD-OBJECT,7,STACK
GET ROBJ,6
PUT OLD-OBJECT,8,STACK
PUT OLD-OBJECT,9,SEARCH-RES
CALL2 NUMERIC-ADJ?,ROBJ
PUT OLD-OBJECT,10,STACK
ICALL FIND-OBJECTS,SEARCH-FLAGS,RLOC
GET SEARCH-RES,1
ZERO? STACK \?CND52
GET ROBJ,1
ZERO? STACK /?CND52
GET ROBJ,1
CALL2 CHECK-DIR-ADJS,STACK
ZERO? STACK /?CND52
PUT GWIM-MSG,2,ROBJ
GET SEARCH-RES,4
PUT GWIM-MSG,3,STACK
?CND52: GET SEARCH-RES,1 >COUNT
ZERO? COUNT \?CCL60
GET ROBJ,2 >TMP
ZERO? TMP /?CCL60
ADD WORD-FLAG-TABLE,2 >?TMP1
GET WORD-FLAG-TABLE,0
INTBL? TMP,?TMP1,STACK,132 >OLD-OBJECT \?CCL66
GET OLD-OBJECT,1
JUMP ?CND64
?CCL66: PUSH FALSE-VALUE
?CND64: BTST STACK,16 \?CCL60
PUT ROBJ,3,NP-QUANT-ALL
GET TMP,3
PUT ROBJ,2,STACK
JUMP ?FCN
?CCL60: ZERO? COUNT \?CCL68
ZERO? RLOC \?CND58
ZERO? MULTI \?CCL70
CALL1 DET-NP-NOT-HERE?
ZERO? STACK /?CND58
?CCL70: CALL DO-PMEM-ALLOC,4,NOUN-PHRASE-MIN-LENGTH >NEW-OBJECT
PUT NEW-OBJECT,1,1
PUT NEW-OBJECT,3,NOT-HERE-OBJECT
PUT NEW-OBJECT,4,ROBJ
SET 'RES,NEW-OBJECT
JUMP ?CND58
?CCL68: EQUAL? COUNT,1 /?CTR75
ZERO? QUANT \?CTR75
GET SEARCH-RES,4
GETP STACK,P?GENERIC
CALL STACK,SEARCH-RES,FINDER >RES
ZERO? RES \?CTR75
CALL1 DET-NP-OWNEE? >RES
ZERO? RES /?CCL76
?CTR75: EQUAL? RES,NOT-HERE-OBJECT \?CCL83
CALL PARSER-ERROR,0,PARSER-ERROR-NOOBJ,OBJ
RSTACK
?CCL83: ZERO? RES /?CND81
SET 'COUNT,1
PUT SEARCH-RES,1,1
PUT SEARCH-RES,2,FALSE-VALUE
EQUAL? RES,HERE \?CCL87
PUSH GLOBAL-HERE
JUMP ?CND85
?CCL87: PUSH RES
?CND85: PUT SEARCH-RES,4,STACK
?CND81: MUL COUNT,2
ADD STACK,2
CALL DO-PMEM-ALLOC,4,STACK >NEW-OBJECT
PUT NEW-OBJECT,1,COUNT
SET 'RES,NEW-OBJECT
GET ROBJ,4 >SYN
ZERO? SYN \?CCL89
GET ROBJ,1 >SYN
ZERO? SYN /?CND88
GET SYN,2 >SYN
ZERO? SYN /?CND88
?CCL89: LESS? 0,SYN \?CCL95
GRTR? SYN,LAST-OBJECT \?CND88
?CCL95: GET SEARCH-RES,3 >SYN
GET ROBJ,4
ZERO? STACK /?CCL100
PUT ROBJ,4,SYN
JUMP ?CND88
?CCL100: GET ROBJ,1
PUT STACK,2,SYN
?CND88: ADD RES,6
CALL DETERMINE-NP-XFER,COUNT,ROBJ,SEARCH-RES,STACK >SYN
ZERO? SYN /?CND58
SUB COUNT,SYN
PUT RES,1,STACK
?CND58: ZERO? RES \?PRD107
RETURN RES
?CCL76: CALL2 READY-TO-DISAMBIGUATE?,ROBJ
ZERO? STACK /?CND58
GET PARSE-RESULT,1
CALL PARSER-ERROR,0,PARSER-ERROR-ORPH-NP,ROBJ,STACK
RSTACK
?PRD107: GETB OBJ,1
EQUAL? STACK,3 /?CCL105
RETURN RES
?CCL105: PUT OBJ,3,RES
RETURN RES
.FUNCT DET-NP-NOT-HERE?:ANY:0:0,X,?TMP1,?TMP2
GET PARSE-RESULT,1 >?TMP2
ADD WORD-FLAG-TABLE,2 >?TMP1
GET WORD-FLAG-TABLE,0
INTBL? ?TMP2,?TMP1,STACK,132 >X \?CCL8
GET X,1
JUMP ?CND6
?CCL8: PUSH FALSE-VALUE
?CND6: BTST STACK,512 /TRUE
GET PARSE-RESULT,4
CALL2 NOT-HERE-VERB?,STACK
ZERO? STACK \TRUE
RFALSE
.FUNCT DET-NP-OWNEE?:ANY:0:0,ADJS,OBJ,OBJ1,LEN,PTR
GET FINDER,5 >ADJS
ZERO? ADJS /?CND1
GET ADJS,2 >ADJS
?CND1: ZERO? ADJS /FALSE
SET 'OBJ,FALSE-VALUE
GET SEARCH-RES,1 >LEN
SET 'PTR,SEARCH-RES+8
?PRG5: DLESS? 'LEN,0 \?CCL9
RETURN OBJ
?CCL9: GET PTR,0 >OBJ1
GETP OBJ1,P?OWNER
EQUAL? ADJS,STACK \?CND7
ZERO? OBJ \FALSE
SET 'OBJ,OBJ1
?CND7: ADD PTR,2 >PTR
JUMP ?PRG5
.FUNCT FIND-OWNERS:ANY:1:1,TBL,OOBJ,LEN
GET TBL,0 >LEN
?PRG1: LESS? LEN,1 /TRUE
GET TBL,LEN >OOBJ
LESS? 0,OOBJ \?CCL7
GET TBL,LEN >OOBJ
GRTR? OOBJ,LAST-OBJECT /?CCL7
CALL MATCH-OBJECT,OOBJ,FINDER,TRUE-VALUE
ZERO? STACK \?CND3
RTRUE
?CCL7: ICALL2 FIND-OWNERS,OOBJ
?CND3: DEC 'LEN
JUMP ?PRG1
.FUNCT READY-TO-DISAMBIGUATE?:ANY:1:1,NP,PTR,NOUN
GET NP,8 >PTR
ZERO? PTR /FALSE
GET NP,2 >NOUN
ZERO? NOUN /FALSE
?PRG6: GET PTR,0
EQUAL? NOUN,STACK \?CCL10
RETURN PTR
?CCL10: SUB PTR,4 >PTR
GRTR? P-LEXV,PTR \?PRG6
RFALSE
.FUNCT DETERMINE-NP-XFER:ANY:4:4,COUNT,ROBJ,SRES,DV,CT,V,TMP,NUM
GET SRES,0 >CT
ADD SRES,8 >V
GRTR? CT,COUNT \?CND3
SET 'CT,COUNT
?CND3: SUB COUNT,CT >COUNT
SET 'NUM,0
?PRG5: GET V,0 >TMP
ZERO? TMP /?CCL9
PUT DV,0,TMP
PUT DV,1,ROBJ
JUMP ?CND7
?CCL9: INC 'NUM
?CND7: ADD DV,4 >DV
ADD V,2 >V
DLESS? 'CT,1 \?PRG5
GET SRES,2 >SRES
ZERO? SRES \?CND12
RETURN NUM
?CND12: SET 'CT,FIND-RES-MAXOBJ
ADD SRES,8 >V
GRTR? CT,COUNT \?CND14
SET 'CT,COUNT
?CND14: SUB COUNT,CT >COUNT
JUMP ?PRG5
.FUNCT DO-ORPHAN-TEST:ANY:0:2,N,TYP
RETURN P-OFLAG
.FUNCT RED-O-ADJ:ANY:0:2,N,TYP
ZERO? P-OFLAG /FALSE
COPYT O-LEXV,G-LEXV,LEXV-LENGTH-BYTES
COPYT O-INBUF,G-INBUF,61
GET OOPS-TABLE,O-AGAIN
PUT OOPS-TABLE,O-START,STACK
POP DATA-STACK
ICALL2 INSERT-ADJS,STACK
ICALL2 COPY-INPUT,TRUE-VALUE
THROW PARSER-RESULT-AGAIN,PARSE-SENTENCE-ACTIVATION
RTRUE
.FUNCT RED-O-PP:ANY:0:2,N,TYP,PP,A,PREP
LESS? P-OFLAG,0 \?CCL8
SUB 0,P-OFLAG >PP
JUMP ?CND6
?CCL8: SET 'PP,P-OFLAG
?CND6: ZERO? PP /FALSE
GET O-LEXV,PP
EQUAL? W?NO.WORD,STACK \FALSE
SUB PP,P-LEXELEN
GET O-LEXV,STACK >A
ZERO? A /FALSE
POP DATA-STACK >PP
ZERO? PP /FALSE
EQUAL? N,2 /?CCL3
POP DATA-STACK >PREP
ZERO? PREP /FALSE
?CCL3: COPYT O-LEXV,G-LEXV,LEXV-LENGTH-BYTES
COPYT O-INBUF,G-INBUF,61
GET OOPS-TABLE,O-AGAIN
PUT OOPS-TABLE,O-START,STACK
EQUAL? A,PREP \?CCL18
PUSH 1
JUMP ?CND16
?CCL18: PUSH 0
?CND16: ICALL2 INSERT-NP,STACK
ICALL2 COPY-INPUT,TRUE-VALUE
THROW PARSER-RESULT-AGAIN,PARSE-SENTENCE-ACTIVATION
RTRUE
.FUNCT INSERT-NP:ANY:0:2,NUM,NP,GPTR,PPTR,TMP,?TMP1
LESS? P-OFLAG,0 \?CCL3
SUB 0,P-OFLAG >GPTR
JUMP ?CND1
?CCL3: SET 'GPTR,P-OFLAG
?CND1: GET PARSE-RESULT,2 >TMP
ZERO? TMP /?CCL6
MUL NUM,4
ADD TMP,STACK >PPTR
SUB TLEXV,TMP
DIV STACK,4
ADD 1,STACK >TMP
JUMP ?CND4
?CCL6: GET OOPS-TABLE,O-START >PPTR
GET OOPS-TABLE,O-LENGTH >TMP
MUL NUM,4
ADD PPTR,STACK >PPTR
?CND4: SUB TMP,NUM >NUM
ADD -1,NUM
ICALL MAKE-ROOM-FOR-TOKENS,STACK,G-LEXV,GPTR
?PRG8: DLESS? 'NUM,0 /TRUE
GETB PPTR,2 >?TMP1
GETB PPTR,3
MUL GPTR,2
ADD 3,STACK >TMP
ICALL INBUF-ADD,?TMP1,STACK,TMP
GET PPTR,0 >TMP
PUT G-LEXV,GPTR,TMP
EQUAL? TMP,W?INT.NUM,W?INT.TIM \?CND12
ADD 1,GPTR >?TMP1
GET PPTR,1
PUT G-LEXV,?TMP1,STACK
?CND12: ADD GPTR,2 >GPTR
ADD PPTR,4 >PPTR
JUMP ?PRG8
.FUNCT TEST-SR:ANY:1:1,NP,A,CT,LEN,NEW-OBJECT,SZ,REM,?TMP1
GET ORPHAN-SR,1 >LEN
ZERO? LEN /FALSE
GET NP,2 >A
GET A,4 >?TMP1
ZERO? ?TMP1 /?PRD9
PUSH ?TMP1
JUMP ?PEN7
?PRD9: GET NP,2 >A
GET A,3
GET STACK,4
?PEN7: BTST STACK,32768 /?CND3
GET NP,2 >A
GET A,4 >?TMP1
ZERO? ?TMP1 /?PRD12
PUSH ?TMP1
JUMP ?PEN10
?PRD12: GET NP,2 >A
GET A,3
GET STACK,4
?PEN10: BAND STACK,16
BAND STACK,32767
ZERO? STACK /?CND3
RETURN A
?CND3: GET NP,1 >A
ZERO? A \?CCL15
CALL DO-PMEM-ALLOC,1,8 >NEW-OBJECT
GET NP,7
PUT NEW-OBJECT,1,STACK
SET 'A,NEW-OBJECT
JUMP ?CND13
?CCL15: GET A,4 >CT
GRTR? ADJS-MAX-COUNT,CT \FALSE
?CND13: ADD A,10 >?TMP1
GET NP,2
PUT ?TMP1,CT,STACK
ADD 1,CT
PUT A,4,STACK
PUT FINDER,5,A
CALL2 NUMERIC-ADJ?,NP
PUT FINDER,10,STACK
GET ORPHAN-NP,2
PUT FINDER,6,STACK
PUT SEARCH-RES,1,0
PUT SEARCH-RES,2,FALSE-VALUE
SET 'NEW-OBJECT,ORPHAN-SR+8
GET ORPHAN-SR,0 >SZ
SET 'REM,LEN
?PRG17: GET NEW-OBJECT,0
CALL MATCH-OBJECT,STACK,FINDER,TRUE-VALUE
ZERO? STACK \?CND19
RETURN A
?CND19: DLESS? 'REM,1 /?REP18
DLESS? 'SZ,1 /?REP18
ADD NEW-OBJECT,2 >NEW-OBJECT
JUMP ?PRG17
?REP18: ZERO? CT /?CND27
PUT A,4,CT
?CND27: GET SEARCH-RES,1
ZERO? STACK /FALSE
RETURN A
.FUNCT RED-O-NP:ANY:0:2,N,TYP,A,NP,PP,A1,PTR,WD,?TMP2,?TMP1
EQUAL? N,3 \?CND1
POP DATA-STACK >PP
?CND1: POP DATA-STACK >NP
GETB NP,1
EQUAL? STACK,4 \?CND3
GET NP,3
EQUAL? STACK,INTQUOTE \?CND3
GET NP,4 >NP
LESS? 0,P-OFLAG /?CND3
GET NP,7
SUB STACK,P-LEXV
DIV STACK,2 >PP
ICALL MAKE-ROOM-FOR-TOKENS,1,G-LEXV,PP
PUT G-LEXV,PP,W?SAY
ICALL1 COPY-INPUT
THROW PARSER-RESULT-AGAIN,PARSE-SENTENCE-ACTIVATION
?CND3: ZERO? P-OFLAG /FALSE
ZERO? PP \?CND12
GET NP,2
GET STACK,4 >?TMP1
ZERO? ?TMP1 /?PRD19
PUSH ?TMP1
JUMP ?PEN17
?PRD19: GET NP,2
GET STACK,3
GET STACK,4
?PEN17: BTST STACK,32768 /?CND12
GET NP,2
GET STACK,4 >?TMP1
ZERO? ?TMP1 /?PRD23
PUSH ?TMP1
JUMP ?PEN21
?PRD23: GET NP,2
GET STACK,3
GET STACK,4
?PEN21: BAND STACK,4
BAND STACK,32767
ZERO? STACK /?CND12
GET NP,3
ZERO? STACK \?CND12
CALL2 TEST-SR,NP >A
ZERO? A /?CND12
XPUSH A,DATA-STACK /?BOGUS25
?BOGUS25: ICALL RED-O-ADJ,1,TYP
RFALSE
?CND12: COPYT O-LEXV,G-LEXV,LEXV-LENGTH-BYTES
COPYT O-INBUF,G-INBUF,61
LESS? P-OFLAG,0 \?CCL28
SUB 0,P-OFLAG >N
JUMP ?CND26
?CCL28: SET 'N,P-OFLAG
?CND26: GET G-LEXV,N
EQUAL? W?NO.WORD,STACK \?CCL31
ICALL INSERT-NP,0,NP
JUMP ?CND29
?CCL31: SET 'A1,FALSE-VALUE
GET NP,2 >A
ZERO? A /?CND34
PUT G-LEXV,N,A
GET NP,8 >A
GETB A,2 >?TMP2
GETB A,3 >?TMP1
MUL N,2
ADD 3,STACK
ICALL INBUF-ADD,?TMP2,?TMP1,STACK
?CND34: GET NP,1 >A
ZERO? A /?CND36
ICALL2 INSERT-ADJS,A
?CND36: ZERO? PP /?CND38
ADD N,P-LEXELEN
ICALL MAKE-ROOM-FOR-TOKENS,2,G-LEXV,STACK
ADD N,P-LEXELEN >?TMP1
GET PP,1
PUT G-LEXV,?TMP1,STACK
GET PP,2 >A
GETB A,1
EQUAL? STACK,4 \?CCL42
GET A,4 >A
JUMP ?CND40
?CCL42: GETB A,1
EQUAL? STACK,3 \?CND40
GET A,2 >A
?CND40: ADD N,4 >?TMP1
GET A,2
PUT G-LEXV,?TMP1,STACK
?CND38: GET NP,3 >A
ZERO? A /?CND29
SET 'PTR,N
?PRG49: SUB PTR,P-LEXELEN >PTR
GRTR? 0,PTR \?CCL53
ZERO? A1 /?PRD56
SET 'PTR,A1
JUMP ?PEN54
?PRD56: SET 'PTR,N
?PEN54: ICALL MAKE-ROOM-FOR-TOKENS,1,G-LEXV,PTR
JUMP ?REP50
?CCL53: GET G-LEXV,PTR >WD
EQUAL? WD,W?THE /?REP50
GET WD,4 >?TMP1
ZERO? ?TMP1 /?PRD65
PUSH ?TMP1
JUMP ?PEN63
?PRD65: GET WD,3
GET STACK,4
?PEN63: BTST STACK,32768 /?CCL58
GET WD,4 >?TMP1
ZERO? ?TMP1 /?PRD68
PUSH ?TMP1
JUMP ?PEN66
?PRD68: GET WD,3
GET STACK,4
?PEN66: BAND STACK,16
BAND STACK,32767
ZERO? STACK \?REP50
?CCL58: GET WD,4 >?TMP1
ZERO? ?TMP1 /?PRD75
PUSH ?TMP1
JUMP ?PEN73
?PRD75: GET WD,3
GET STACK,4
?PEN73: BTST STACK,32768 /?CCL70
GET WD,4 >?TMP1
ZERO? ?TMP1 /?PRD78
PUSH ?TMP1
JUMP ?PEN76
?PRD78: GET WD,3
GET STACK,4
?PEN76: BAND STACK,4
BAND STACK,32767
ZERO? STACK /?CCL70
SET 'A1,PTR
JUMP ?PRG49
?CCL70: ZERO? A1 /?PRD81
SET 'PTR,A1
JUMP ?PEN79
?PRD81: SET 'PTR,N
?PEN79: ICALL MAKE-ROOM-FOR-TOKENS,1,G-LEXV,PTR
?REP50: CALL2 GET-QUANTITY-WORD,A
PUT G-LEXV,PTR,STACK
?CND29: GET OOPS-TABLE,O-AGAIN
PUT OOPS-TABLE,O-START,STACK
ICALL1 COPY-INPUT
THROW PARSER-RESULT-AGAIN,PARSE-SENTENCE-ACTIVATION
RTRUE
.FUNCT RED-PERS:ANY:0:2,N,TYP,X,?TMP1
EQUAL? N,2,3 \TRUE
POP DATA-STACK >X
EQUAL? X,W?COMMA \?PRD7
EQUAL? N,2 /?CCL5
?PRD7: EQUAL? X,W?TO \FALSE
?CCL5: POP DATA-STACK >X
EQUAL? N,3 \?CND11
GET P-RUNNING,0
GET STACK,4 >?TMP1
ZERO? ?TMP1 /?PRD19
PUSH ?TMP1
JUMP ?PEN17
?PRD19: GET P-RUNNING,0
GET STACK,3
GET STACK,4
?PEN17: BTST STACK,32768 /FALSE
GET P-RUNNING,0
GET STACK,4 >?TMP1
ZERO? ?TMP1 /?PRD22
PUSH ?TMP1
JUMP ?PEN20
?PRD22: GET P-RUNNING,0
GET STACK,3
GET STACK,4
?PEN20: BAND STACK,1
BAND STACK,32767
ZERO? STACK /FALSE
?CND11: CALL2 HACK-TELL,X
RSTACK
.FUNCT HACK-TELL:ANY:1:1,X,NP
PUT PARSE-RESULT,1,W?TELL
GET W?TELL,3
GET STACK,2
ICALL GET-SYNTAX,STACK,1,FALSE-VALUE
CALL DETERMINE-OBJ,X,1 >NP
ZERO? NP \?CND1
CALL PARSER-ERROR,0,PARSER-ERROR-NOOBJ,X
RSTACK
?CND1: PUT PARSE-RESULT,2,TLEXV
PUT PARSE-RESULT,12,NP
GET NP,3 >X
EQUAL? X,WINNER,PLAYER,ME /TRUE
EQUAL? X,YOU /TRUE
GET TLEXV,0
EQUAL? STACK,W?YOU \?CND8
ICALL1 IGNORE-FIRST-WORD
?CND8: LESS? P-LEN,1 \?CCL12
SET 'P-CONT,FALSE-VALUE
JUMP ?CND10
?CCL12: SET 'P-CONT,TLEXV
?CND10: CALL2 HACK-TELL-1,NP
EQUAL? M-FATAL,STACK /?CCL14
ZERO? P-CONT \TRUE
?CCL14: SET 'P-CONT,-1
THROW PARSER-RESULT-DEAD,PARSE-SENTENCE-ACTIVATION
RTRUE
.FUNCT HACK-TELL-1:ANY:1:1,NP,X,NUM,CT,?TMP1
GET NP,4 >PRSO-NP
GET NP,3 >X
ZERO? P-WON /?CND1
GET NP,1 >CT
LESS? 1,CT \?CND1
GET NP,2 >NUM
GRTR? CT,NUM \FALSE
ADD 1,NUM
PUT NP,2,STACK
ADD NP,8 >?TMP1
MUL 2,NUM
GET ?TMP1,STACK >PRSO-NP
ADD NP,6 >?TMP1
MUL 2,NUM
GET ?TMP1,STACK >X
ICALL2 RT-PRINT-DESC,X
PRINTI ":
"
?CND1: SET 'PRSQ,FALSE-VALUE
SET 'PRSS,FALSE-VALUE
CALL PERFORM,V?TELL,X >X
PUT PARSE-RESULT,4,0
RETURN X
.FUNCT RED-VP:ANY:0:2,N,TYP,VERB,A1,A2,?TMP1
SET 'A1,TRUE-VALUE
SET 'A2,TRUE-VALUE
GRTR? N,2 \?CND1
POP DATA-STACK >A1
?CND1: POP DATA-STACK >VERB
GRTR? N,2 \?CND3
POP DATA-STACK >A2
EQUAL? N,4 \?CND3
POP DATA-STACK
?CND3: PUT PARSE-RESULT,1,VERB
PUT PARSE-RESULT,2,TLEXV
EQUAL? A1,TRUE-VALUE /?CCL9
GET A1,3 >?TMP1
ZERO? ?TMP1 /?PRD12
PUSH ?TMP1
JUMP ?PEN10
?PRD12: PUSH A1
?PEN10: PUT PARSE-RESULT,0,STACK
RTRUE
?CCL9: EQUAL? A2,TRUE-VALUE /TRUE
GET A2,3 >?TMP1
ZERO? ?TMP1 /?PRD16
PUSH ?TMP1
JUMP ?PEN14
?PRD16: PUSH A2
?PEN14: PUT PARSE-RESULT,0,STACK
RTRUE
.FUNCT RED-NP:ANY:0:2,N,TYP,NAME,QUANT,LEXB,LEXE,ADJ,NEW-OBJECT,?TMP1
SET 'QUANT,NP-QUANT-NONE
SET 'LEXE,TLEXV
POP DATA-STACK >NAME
EQUAL? NAME,1 \?CND1
SET 'NAME,FALSE-VALUE
?CND1: GET LEXE,0 >ADJ
EQUAL? ADJ,W?COMMA,W?AND /?CCL4
GET ADJ,4 >?TMP1
ZERO? ?TMP1 /?PRD11
PUSH ?TMP1
JUMP ?PEN9
?PRD11: GET ADJ,3
GET STACK,4
?PEN9: BAND STACK,32768
EQUAL? STACK,-32768 \?CND3
GET ADJ,4 >?TMP1
ZERO? ?TMP1 /?PRD14
PUSH ?TMP1
JUMP ?PEN12
?PRD14: GET ADJ,3
GET STACK,4
?PEN12: BAND STACK,32769
BAND STACK,32767
ZERO? STACK /?CND3
?CCL4: SUB LEXE,4 >LEXE
?CND3: POP DATA-STACK >ADJ
EQUAL? ADJ,1 \?CCL17
SET 'LEXB,LEXE
SET 'ADJ,FALSE-VALUE
JUMP ?CND15
?CCL17: GET ADJ,1 >LEXB
GET ADJ,3
ZERO? STACK /?CND15
GET ADJ,3 >QUANT
?CND15: CALL DO-PMEM-ALLOC,2,9 >NEW-OBJECT
PUT NEW-OBJECT,2,NAME
PUT NEW-OBJECT,1,ADJ
PUT NEW-OBJECT,7,LEXB
PUT NEW-OBJECT,8,LEXE
PUT NEW-OBJECT,3,QUANT
RETURN NEW-OBJECT
.FUNCT RED-OF:ANY:0:2,N,TYP,ONP,NP,TMP,A
POP DATA-STACK >ONP
POP DATA-STACK
EQUAL? STACK,W?OF \FALSE
POP DATA-STACK >NP
GET NP,3
ZERO? STACK /?CCL6
GET NP,2
ZERO? STACK \?CCL6
GET NP,1
ZERO? STACK \?CCL6
GET NP,3
PUT ONP,3,STACK
RETURN ONP
?CCL6: PUT NP,4,ONP
RETURN NP
.FUNCT RED-QT:ANY:0:2,N,TYP,Q,NEW-OBJECT
POP DATA-STACK >Q
EQUAL? Q,W?A,W?AN /FALSE
CALL DO-PMEM-ALLOC,2,9 >NEW-OBJECT
CALL2 GET-QUANTITY,Q
PUT NEW-OBJECT,3,STACK
PUT NEW-OBJECT,7,TLEXV
PUT NEW-OBJECT,8,TLEXV
RETURN NEW-OBJECT
.FUNCT GET-QUANTITY-WORD:ANY:1:1,Q,TBL
INTBL? Q,NP-QUANT-TBL,NP-QUANT-TBL-LEN,132 >TBL \FALSE
GET TBL,1
RSTACK
.FUNCT GET-QUANTITY:ANY:1:1,Q,TBL
INTBL? Q,NP-QUANT-TBL+2,NP-QUANT-TBL-LEN,132 >TBL \FALSE
SUB TBL,2
GET STACK,0
RSTACK
.FUNCT RED-QN:ANY:0:2,N,TYP,NP,Q
POP DATA-STACK >NP
GET NP,7
SUB STACK,4
PUT NP,7,STACK
POP DATA-STACK
CALL2 GET-QUANTITY,STACK
PUT NP,3,STACK
RETURN NP
.FUNCT RED-NPP:ANY:0:2,N,TYP,NPP,ONPP,PP,NP,RLOC,X1,X2,KLUDGE-FLAG,OONPP,?PR-NP,NN,TEMP
EQUAL? N,1 \?CCL3
POP DATA-STACK
RSTACK
?CCL3: EQUAL? N,2 \?CCL5
POP DATA-STACK >PP
POP DATA-STACK >ONPP
GET PP,1
EQUAL? STACK,W?BUT,W?EXCEPT \?CCL8
GETB ONPP,1
EQUAL? STACK,2 /?CCL11
CALL PARSER-ERROR,0,PARSER-ERROR-NOUND
RSTACK
?CCL11: GET ONPP,3
ZERO? STACK \?CCL13
GET DATA-STACK,0
EQUAL? 20,STACK /?CND14
POP DATA-STACK >X1
GET DATA-STACK,0
EQUAL? 20,STACK /?CND16
POP DATA-STACK >X2
CALL2 PMEM?,X2
ZERO? STACK /?CND18
GETB X2,1
EQUAL? STACK,2 \?CND18
GET X2,3
ZERO? STACK /?CND18
CALL REDUCE-EXCEPTION,PP,X2
ZERO? STACK /?CND18
SET 'KLUDGE-FLAG,TRUE-VALUE
?CND18: XPUSH X2,DATA-STACK /?CND16
?CND16: XPUSH X1,DATA-STACK /?CND14
?CND14: ZERO? KLUDGE-FLAG \?CND6
CALL PARSER-ERROR,0,PARSER-ERROR-NOUND
RSTACK
?CCL13: CALL REDUCE-EXCEPTION,PP,ONPP
ZERO? STACK \?CND6
RFALSE
?CCL8: CALL2 REDUCE-LOCATION,PP >RLOC
ZERO? RLOC /FALSE
?CND6: ZERO? RLOC \?CCL32
RETURN ONPP
?CCL32: GETB ONPP,1
EQUAL? STACK,2 \?CCL34
GET ONPP,5
ZERO? STACK /?CCL37
GET RLOC,1
CALL PARSER-ERROR,0,PARSER-ERROR-TMNOUN,STACK
RSTACK
?CCL37: PUT ONPP,5,RLOC
RETURN ONPP
?CCL34: SET 'OONPP,ONPP
?PRG38: GET OONPP,2 >?PR-NP
GET ?PR-NP,5
ZERO? STACK \?CND40
PUT ?PR-NP,5,RLOC
?CND40: GET OONPP,1 >OONPP
ZERO? OONPP \?CCL44
RETURN ONPP
?CCL44: GETB OONPP,1
EQUAL? STACK,2 \?PRG38
PUT OONPP,5,RLOC
RETURN ONPP
?CCL5: POP DATA-STACK >NP
POP DATA-STACK
EQUAL? STACK,W?AND,W?COMMA \FALSE
POP DATA-STACK >NPP
GETB NPP,1
EQUAL? STACK,2 \?CND49
GET NPP,6
ZERO? STACK \FALSE
?CND49: CALL DO-PMEM-ALLOC,3,3 >?PR-NP
PUT ?PR-NP,2,NP
SET 'NP,?PR-NP
GETB NPP,1
EQUAL? STACK,2 \?CCL55
CALL DO-PMEM-ALLOC,3,3 >OONPP
PUT OONPP,1,NP
PUT OONPP,2,NPP
RETURN OONPP
?CCL55: SET 'NN,NPP
?PRG56: GET NN,1 >TEMP
ZERO? TEMP \?CND58
PUT NN,1,NP
RETURN NPP
?CND58: SET 'NN,TEMP
JUMP ?PRG56
.FUNCT RED-PP:ANY:0:2,N,TYP,TMP,NOUN,PREP,NEW-OBJECT
POP DATA-STACK >NOUN
EQUAL? N,2 \?CCL3
POP DATA-STACK >PREP
JUMP ?CND1
?CCL3: POP DATA-STACK >TMP
EQUAL? TMP,W?OF \?CND1
POP DATA-STACK >PREP
EQUAL? PREP,W?OUT \FALSE
SET 'PREP,W?FROM
?CND1: ZERO? PREP /FALSE
CALL DO-PMEM-ALLOC,5,2 >NEW-OBJECT
PUT NEW-OBJECT,1,PREP
PUT NEW-OBJECT,2,NOUN
RETURN NEW-OBJECT
.FUNCT RED-POSS:ANY:0:2,N,TYP,OBJ,WD,A
EQUAL? N,3 \FALSE
POP DATA-STACK
EQUAL? STACK,W?S /?CCL6
CALL PARSER-ERROR,0,PARSER-ERROR-NOUND
RSTACK
?CCL6: POP DATA-STACK
EQUAL? STACK,W?APOSTROPHE /?CCL8
CALL PARSER-ERROR,0,PARSER-ERROR-NOUND
RSTACK
?CCL8: POP DATA-STACK
RSTACK
.FUNCT RED-ADJ:ANY:0:2,N,TYP,A1,A2,CT,AD,NEW-OBJECT,VV,TCT,?TMP1
ZERO? N /TRUE
POP DATA-STACK >A1
EQUAL? A1,1 \?CND4
CALL DO-PMEM-ALLOC,1,8 >NEW-OBJECT
PUT NEW-OBJECT,1,TLEXV
SET 'A1,NEW-OBJECT
?CND4: POP DATA-STACK >A2
CALL2 PMEM?,A2
ZERO? STACK /?CCL8
PUT A1,2,A2
RETURN A1
?CCL8: EQUAL? A2,W?MY \?CCL10
PUT A1,2,PLAYER
RETURN A1
?CCL10: EQUAL? A2,W?YOUR \?CCL12
PUT A1,2,WINNER
RETURN A1
?CCL12: EQUAL? A2,W?HIS \?CND6
GET PARSE-RESULT,5 >AD
ZERO? AD /?CCL17
GET AD,3 >AD
ZERO? AD /?CCL17
FSET? AD,PERSONBIT \?CCL17
PUT A1,2,AD
FSET? AD,FEMALE \?CND15
PUT A1,2,P-HIM-OBJECT
RETURN A1
?CCL17: PUT A1,2,P-HIM-OBJECT
?CND15: RETURN A1
?CND6: EQUAL? A2,W?HER \?CND23
GET PARSE-RESULT,5 >AD
ZERO? AD /?CCL27
GET AD,3 >AD
ZERO? AD /?CCL27
FSET? AD,PERSONBIT \?CCL27
FSET? AD,FEMALE \?CCL27
PUT A1,2,AD
RETURN A1
?CCL27: PUT A1,2,P-HER-OBJECT
RETURN A1
?CND23: EQUAL? A2,W?THEIR \?CCL34
GET PARSE-RESULT,5 >AD
ZERO? AD /?CCL37
GET AD,3 >AD
ZERO? AD /?CCL37
FSET? AD,PLURAL \?CCL37
PUT A1,2,AD
RETURN A1
?CCL37: PUT A1,2,P-THEM-OBJECT
RETURN A1
?CCL34: EQUAL? A2,W?ITS \?CCL42
GET PARSE-RESULT,5 >AD
ZERO? AD /?CCL45
GET AD,3 >AD
ZERO? AD /?CCL45
FSET? AD,PERSONBIT /?CCL45
PUT A1,2,AD
RETURN A1
?CCL45: PUT A1,2,P-IT-OBJECT
RETURN A1
?CCL42: ADD WORD-FLAG-TABLE,2 >?TMP1
GET WORD-FLAG-TABLE,0
INTBL? A2,?TMP1,STACK,132 >NEW-OBJECT \?CCL53
GET NEW-OBJECT,1
JUMP ?CND51
?CCL53: PUSH FALSE-VALUE
?CND51: BTST STACK,16384 \?CCL50
GET A2,3
PUT A1,2,STACK
RETURN A1
?CCL50: EQUAL? A2,W?A,W?AN \?CCL55
PUT A1,3,NP-QUANT-A
RETURN A1
?CCL55: EQUAL? A2,W?THE /?CND32
GET A2,4 >?TMP1
ZERO? ?TMP1 /?PRD64
PUSH ?TMP1
JUMP ?PEN62
?PRD64: GET A2,3
GET STACK,4
?PEN62: BTST STACK,32768 /FALSE
GET A2,4 >?TMP1
ZERO? ?TMP1 /?PRD67
PUSH ?TMP1
JUMP ?PEN65
?PRD67: GET A2,3
GET STACK,4
?PEN65: BAND STACK,4
BAND STACK,32767
ZERO? STACK /FALSE
SET 'AD,A2
GET A1,4 >CT
LESS? CT,ADJS-MAX-COUNT \?CND32
ADD A1,10 >VV
GET A1,4 >TCT
?PRG71: ZERO? TCT \?CND73
PUT VV,0,A2
ADD CT,1
PUT A1,4,STACK
RETURN A1
?CND73: GET VV,0
EQUAL? AD,STACK /?CND32
ADD VV,2 >VV
DEC 'TCT
JUMP ?PRG71
?CND32: RETURN A1
.FUNCT RED-QUOTE:ANY:0:2,N,TYP,NP,NEW-OBJECT
POP DATA-STACK
EQUAL? W?QUOTE,STACK \FALSE
CALL DO-PMEM-ALLOC,2,9 >NEW-OBJECT
PUT NEW-OBJECT,2,W?QUOTE
SUB P-RUNNING,4
PUT NEW-OBJECT,7,STACK
SET 'NP,NEW-OBJECT
?PRG4: GET P-RUNNING,0 >N
DLESS? 'P-LEN,0 /?CCL7
EQUAL? N,W?QUOTE,W?END.OF.INPUT \?CND6
?CCL7: EQUAL? N,W?QUOTE \?CCL12
PUT NP,8,P-RUNNING
ADD P-RUNNING,4 >P-RUNNING
JUMP ?CND10
?CCL12: SUB P-RUNNING,4
PUT NP,8,STACK
?CND10: GET OOPS-TABLE,O-START
SUB P-RUNNING,STACK
DIV STACK,4 >P-WORDS-AGAIN
CALL DO-PMEM-ALLOC,4,NOUN-PHRASE-MIN-LENGTH >NEW-OBJECT
PUT NEW-OBJECT,1,1
PUT NEW-OBJECT,3,INTQUOTE
PUT NEW-OBJECT,4,NP
RETURN NEW-OBJECT
?CND6: ADD P-RUNNING,4 >P-RUNNING
JUMP ?PRG4
.ENDSEG
.ENDI