1442 lines
30 KiB
Plaintext
1442 lines
30 KiB
Plaintext
|
|
.SEGMENT "0"
|
|
|
|
|
|
.FUNCT RED-FCN,N,TYP
|
|
ZERO? N /TRUE
|
|
EQUAL? N,1 \FALSE
|
|
POP DATA-STACK
|
|
RSTACK
|
|
|
|
|
|
.FUNCT RED-PART,N,TYP,WD
|
|
ZERO? N /TRUE
|
|
POP DATA-STACK >WD
|
|
EQUAL? WD,TRUE-VALUE,W?OF /?CCL5
|
|
CALL WORD-TYPE?,WD,P-PARTICLE-CODE
|
|
ZERO? STACK /FALSE
|
|
?CCL5: EQUAL? N,1 \?CCL9
|
|
RETURN WD
|
|
?CCL9: POP DATA-STACK
|
|
RSTACK
|
|
|
|
|
|
.FUNCT GET-SYNTAX,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,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
|
|
EQUAL? PART,1 \?CCL6
|
|
GET DATA,0
|
|
GRTR? 0,STACK /?CCL6
|
|
GET DATA,0
|
|
PUT PARSE-RESULT,4,STACK
|
|
RTRUE
|
|
?CCL6: GET DATA,2 >SYN
|
|
ZERO? SYN /?CCL10
|
|
CALL GET-SYNTAX,SYN,1,PART,TRUE-VALUE >SYN
|
|
ZERO? SYN /?CCL10
|
|
CALL DETERMINE-OBJ,FALSE-VALUE,1 >OBJ
|
|
ZERO? OBJ /?CCL10
|
|
PUT PARSE-RESULT,5,OBJ
|
|
RTRUE
|
|
?CCL10: 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,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: ZERO? STACK /?CND1
|
|
GET VERB,3 >DATA
|
|
ZERO? DATA /?CND1
|
|
SET 'VERB,DATA
|
|
?CND1: RETURN VERB
|
|
|
|
|
|
.FUNCT RED-SVN,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
|
|
GET PARSE-RESULT,8
|
|
ZERO? STACK \?CCL6
|
|
GET DATA,2 >SYN1
|
|
ZERO? SYN1 /?CCL6
|
|
CALL GET-SYNTAX,SYN1,1,PART >SYN1
|
|
ZERO? SYN1 /?CCL6
|
|
CALL DETERMINE-OBJ,OBJ,1 >OBJ1
|
|
ZERO? OBJ1 \?CCL12
|
|
CALL PARSER-ERROR,0,PARSER-ERROR-NOOBJ,OBJ,PART
|
|
RSTACK
|
|
?CCL12: GET OBJ1,3
|
|
EQUAL? INTDIR,STACK \?CCL14
|
|
GET PARSE-RESULT,1
|
|
CALL DIR-VERB-WORD?,STACK
|
|
ZERO? STACK /?CCL14
|
|
GET OBJ,2
|
|
XPUSH STACK,DATA-STACK \?CCL14
|
|
CALL RED-SD,1,TYP
|
|
RSTACK
|
|
?CCL14: PUT PARSE-RESULT,5,OBJ1
|
|
RETURN PARSE-RESULT
|
|
?CCL6: 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 \?CCL24
|
|
CALL PARSER-ERROR,0,PARSER-ERROR-NOOBJ,OBJ,PART
|
|
RSTACK
|
|
?CCL24: 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,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,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,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
|
|
GET STACK,3 >SYN
|
|
ZERO? SYN \?CCL12
|
|
CALL PARSER-ERROR,0,PARSER-ERROR-TMNOUN
|
|
RSTACK
|
|
?CCL12: CALL GET-SYNTAX,SYN,2,PART >SYN
|
|
ZERO? SYN \?CCL14
|
|
CALL PARSER-ERROR,0,PARSER-ERROR-NOUND
|
|
RSTACK
|
|
?CCL14: CALL DETERMINE-OBJ,N1,1 >OBJ1
|
|
ZERO? OBJ1 \?CCL16
|
|
CALL PARSER-ERROR,0,PARSER-ERROR-NOOBJ,N1,PART
|
|
RSTACK
|
|
?CCL16: CALL DETERMINE-OBJ,N2,2 >OBJ2
|
|
ZERO? OBJ2 \?CCL18
|
|
CALL PARSER-ERROR,0,PARSER-ERROR-NOOBJ,N2,PART
|
|
RSTACK
|
|
?CCL18: CALL DIR-VERB-PRSI?,OBJ2
|
|
ZERO? STACK /?CCL20
|
|
CALL PARSER-ERROR,0,PARSER-ERROR-NOUND
|
|
RSTACK
|
|
?CCL20: POP DATA-STACK
|
|
PUT PARSE-RESULT,5,OBJ1
|
|
PUT PARSE-RESULT,6,OBJ2
|
|
RTRUE
|
|
|
|
|
|
.FUNCT RED-SVPNPN,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-SD,N,TYP,V,NEW-OBJECT
|
|
SET 'V,W?WALK
|
|
PUT PARSE-RESULT,1,V
|
|
GET V,3
|
|
GET STACK,2
|
|
ICALL GET-SYNTAX,STACK,1,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 RED-SVD,N,TYP,DIR
|
|
POP DATA-STACK >DIR
|
|
GET PARSE-RESULT,1
|
|
CALL DIR-VERB-WORD?,STACK
|
|
ZERO? STACK /FALSE
|
|
POP DATA-STACK
|
|
XPUSH DIR,DATA-STACK /?BOGUS4
|
|
?BOGUS4: SUB N,1
|
|
CALL RED-SD,STACK,TYP
|
|
RSTACK
|
|
|
|
|
|
.FUNCT RED-SP,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,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,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,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,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,OBJ,NUM,PICK,VAL,RES,COUNT,SYN,S-FLAGS,SEARCH-ACT,OLD-OBJECT,NO,CT,PTR,CNT,TMP
|
|
GET PARSE-RESULT,3 >SYN
|
|
EQUAL? NUM,1 \?CCL3
|
|
GETB SYN,5 >S-FLAGS
|
|
JUMP ?CND1
|
|
?CCL3: GETB SYN,9 >S-FLAGS
|
|
?CND1: EQUAL? NUM,1 \?CCL6
|
|
GETB SYN,4 >SEARCH-ACT
|
|
JUMP ?CND4
|
|
?CCL6: GETB SYN,8 >SEARCH-ACT
|
|
?CND4: ZERO? OBJ \?CCL9
|
|
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 /?CND10
|
|
PUT FINDER,2,NP-QUANT-ALL
|
|
?CND10: EQUAL? SEARCH-ACT,ROOMSBIT \?PRD16
|
|
PUT SEARCH-RES,4,ROOMS
|
|
JUMP ?CTR13
|
|
?PRD16: ZERO? S-FLAGS /?CCL14
|
|
CALL2 FIND-OBJECTS,S-FLAGS
|
|
ZERO? STACK \?PRD21
|
|
ZERO? PICK /?CCL14
|
|
GET SEARCH-RES,1
|
|
ZERO? STACK /?CCL14
|
|
?PRD21: EQUAL? NUM,1 \?CCL29
|
|
GET SYN,1
|
|
JUMP ?CND27
|
|
?CCL29: GET SYN,3
|
|
?CND27: PUT GWIM-MSG,0,STACK
|
|
GET SEARCH-RES,4
|
|
PUT GWIM-MSG,1,STACK
|
|
?CTR13: 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
|
|
?CCL14: GET PARSE-RESULT,1
|
|
PUT ORPHAN-S,O-VERB,STACK
|
|
ZERO? P-LEN \?CCL32
|
|
ADD TLEXV,4
|
|
JUMP ?CND30
|
|
?CCL32: PUSH TLEXV
|
|
?CND30: 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 /?CND33
|
|
GET VAL,3 >VAL
|
|
?CND33: PUT ORPHAN-S,O-SUBJECT,VAL
|
|
GET PARSE-RESULT,5
|
|
CALL PARSER-ERROR,0,PARSER-ERROR-ORPH-S,STACK
|
|
RSTACK
|
|
?CCL9: GETB OBJ,1
|
|
EQUAL? STACK,4 \?CCL36
|
|
RETURN OBJ
|
|
?CCL36: GETB OBJ,1
|
|
EQUAL? STACK,2 \?CCL38
|
|
SET 'SEARCH-FLAGS,S-FLAGS
|
|
CALL DETERMINE-NP,0,NUM,OBJ
|
|
RSTACK
|
|
?CCL38: BTST S-FLAGS,16 /?CCL40
|
|
GET PARSE-RESULT,1
|
|
CALL PARSER-ERROR,0,PARSER-ERROR-NOMULT,NUM,STACK
|
|
RSTACK
|
|
?CCL40: SET 'SEARCH-FLAGS,S-FLAGS
|
|
SET 'NO,OBJ
|
|
SET 'CT,FALSE-VALUE
|
|
?PRG41: CALL DETERMINE-NP,0,NUM,NO,TRUE-VALUE >PTR
|
|
ZERO? PTR /FALSE
|
|
GET NO,3
|
|
GET STACK,1
|
|
ADD COUNT,STACK >COUNT
|
|
ZERO? CT \?CND46
|
|
ADD PTR,6 >PTR
|
|
SET 'CNT,COUNT
|
|
?PRG48: DLESS? 'CNT,0 /?CND46
|
|
GET PTR,0
|
|
EQUAL? NOT-HERE-OBJECT,STACK /?CCL54
|
|
SET 'CT,TRUE-VALUE
|
|
?CND46: GET NO,1 >NO
|
|
ZERO? NO \?PRG41
|
|
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
|
|
?PRG59: 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 \?PRG59
|
|
RETURN RES
|
|
?CCL54: ADD PTR,4 >PTR
|
|
JUMP ?PRG48
|
|
|
|
|
|
.FUNCT CHECK-DIR-ADJS,ADJS,AV,CT,ADJ,PT
|
|
ADD ADJS,10 >AV
|
|
GET ADJS,4 >CT
|
|
?PRG1: DLESS? 'CT,0 /TRUE
|
|
GET AV,CT >ADJ
|
|
CALL WORD-TYPE?,ADJ,P-DIR-CODE
|
|
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 \?CND10
|
|
PUT AV,CT,ADJ
|
|
RTRUE
|
|
?CND10: PUT AV,CT,ADJ
|
|
JUMP ?PRG1
|
|
|
|
|
|
.FUNCT NUMERIC-ADJ?,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,SEARCH-ACT,WHICH,OBJ,MULTI,SYN,ROBJ,RLOC,QUANT,OWNER,RES,COUNT,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
|
|
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
|
|
PUT SEARCH-RES,2,FALSE-VALUE
|
|
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: GET ROBJ,2
|
|
EQUAL? STACK,W?HIMSELF \?CND21
|
|
EQUAL? 2,WHICH \?CCL25
|
|
GET PARSE-RESULT,5 >COUNT
|
|
ZERO? COUNT /?CCL25
|
|
GET COUNT,3 >COUNT
|
|
ZERO? COUNT /?CCL25
|
|
FSET? COUNT,PERSONBIT \?CCL25
|
|
SET 'RES,COUNT
|
|
JUMP ?CND21
|
|
?CCL25: SET 'RES,P-HIM-OBJECT
|
|
?CND21: ZERO? RES /?CND30
|
|
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
|
|
?CND30: 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 \?CND34
|
|
GET ROBJ,1
|
|
ZERO? STACK /?CND34
|
|
GET ROBJ,1
|
|
ICALL2 CHECK-DIR-ADJS,STACK
|
|
?CND34: GET SEARCH-RES,1 >COUNT
|
|
ZERO? COUNT \?CCL40
|
|
GET ROBJ,2 >RLOC
|
|
ZERO? RLOC /?CCL40
|
|
ADD WORD-FLAG-TABLE,2 >?TMP1
|
|
GET WORD-FLAG-TABLE,0
|
|
INTBL? RLOC,?TMP1,STACK,132 >OLD-OBJECT \?CCL46
|
|
GET OLD-OBJECT,1
|
|
JUMP ?CND44
|
|
?CCL46: PUSH FALSE-VALUE
|
|
?CND44: BTST STACK,16 \?CCL40
|
|
PUT ROBJ,3,NP-QUANT-ALL
|
|
GET RLOC,3
|
|
PUT ROBJ,2,STACK
|
|
JUMP ?FCN
|
|
?CCL40: ZERO? COUNT \?CCL48
|
|
ZERO? MULTI \?CCL50
|
|
GET PARSE-RESULT,4
|
|
CALL NOT-HERE-VERB?,STACK
|
|
ZERO? STACK /?CND38
|
|
?CCL50: 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 ?CND38
|
|
?CCL48: EQUAL? COUNT,1 /?CTR53
|
|
ZERO? QUANT \?CTR53
|
|
GET SEARCH-RES,4
|
|
GETP STACK,P?GENERIC
|
|
CALL STACK,SEARCH-RES,FINDER >RES
|
|
ZERO? RES /?CCL54
|
|
?CTR53: EQUAL? RES,NOT-HERE-OBJECT \?CCL60
|
|
CALL PARSER-ERROR,0,PARSER-ERROR-NOOBJ,OBJ
|
|
RSTACK
|
|
?CCL60: ZERO? RES /?CND58
|
|
SET 'COUNT,1
|
|
PUT SEARCH-RES,1,1
|
|
PUT SEARCH-RES,2,FALSE-VALUE
|
|
EQUAL? RES,HERE \?CCL64
|
|
PUSH GLOBAL-HERE
|
|
JUMP ?CND62
|
|
?CCL64: PUSH RES
|
|
?CND62: PUT SEARCH-RES,4,STACK
|
|
?CND58: 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 \?CCL66
|
|
GET ROBJ,1 >SYN
|
|
ZERO? SYN /?CND65
|
|
GET SYN,2 >SYN
|
|
ZERO? SYN /?CND65
|
|
?CCL66: LESS? 0,SYN \?CCL72
|
|
GRTR? SYN,LAST-OBJECT \?CND65
|
|
?CCL72: GET SEARCH-RES,3 >SYN
|
|
GET ROBJ,4
|
|
ZERO? STACK /?CCL77
|
|
PUT ROBJ,4,SYN
|
|
JUMP ?CND65
|
|
?CCL77: GET ROBJ,1
|
|
PUT STACK,2,SYN
|
|
?CND65: ADD RES,6
|
|
CALL DETERMINE-NP-XFER,COUNT,ROBJ,SEARCH-RES,STACK >SYN
|
|
ZERO? SYN /?CND38
|
|
SUB COUNT,SYN
|
|
PUT RES,1,STACK
|
|
?CND38: ZERO? RES \?PRD84
|
|
RETURN RES
|
|
?CCL54: CALL2 READY-TO-DISAMBIGUATE?,ROBJ
|
|
ZERO? STACK /?CND38
|
|
GET PARSE-RESULT,1
|
|
CALL PARSER-ERROR,0,PARSER-ERROR-ORPH-NP,ROBJ,STACK
|
|
RSTACK
|
|
?PRD84: GETB OBJ,1
|
|
EQUAL? STACK,3 /?CCL82
|
|
RETURN RES
|
|
?CCL82: PUT OBJ,3,RES
|
|
RETURN RES
|
|
|
|
|
|
.FUNCT FIND-OWNERS,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?,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,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 RED-O-ADJ,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,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,1 /?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,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,NP,A,CT,LEN,NEW-OBJECT,SZ,REM,?TMP1
|
|
GET ORPHAN-SR,1 >LEN
|
|
ZERO? LEN /FALSE
|
|
GET NP,2 >A
|
|
CALL WORD-TYPE?,A,P-QUANT-CODE
|
|
ZERO? STACK /?CCL5
|
|
RETURN A
|
|
?CCL5: GET NP,1 >A
|
|
ZERO? A \?CCL7
|
|
CALL DO-PMEM-ALLOC,1,8 >NEW-OBJECT
|
|
GET NP,7
|
|
PUT NEW-OBJECT,1,STACK
|
|
SET 'A,NEW-OBJECT
|
|
JUMP ?CND1
|
|
?CCL7: GET A,4 >CT
|
|
GRTR? ADJS-MAX-COUNT,CT \FALSE
|
|
?CND1: 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
|
|
?PRG9: GET NEW-OBJECT,0
|
|
CALL MATCH-OBJECT,STACK,FINDER,TRUE-VALUE
|
|
ZERO? STACK \?CND11
|
|
RETURN A
|
|
?CND11: DLESS? 'REM,1 /?REP10
|
|
DLESS? 'SZ,1 /?REP10
|
|
ADD NEW-OBJECT,2 >NEW-OBJECT
|
|
JUMP ?PRG9
|
|
?REP10: ZERO? CT /?CND19
|
|
PUT A,4,CT
|
|
?CND19: GET SEARCH-RES,1
|
|
ZERO? STACK /FALSE
|
|
RETURN A
|
|
|
|
|
|
.FUNCT RED-O-NP,N,TYP,A,NP,PP,A1,PTR,WD,?TMP1,?TMP2
|
|
EQUAL? N,2 \?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
|
|
ZERO? 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
|
|
CALL WORD-TYPE?,STACK,P-ADJ-CODE
|
|
ZERO? STACK /?CND12
|
|
GET NP,3
|
|
ZERO? STACK \?CND12
|
|
CALL2 TEST-SR,NP >A
|
|
ZERO? A /?CND12
|
|
XPUSH A,DATA-STACK /?BOGUS18
|
|
?BOGUS18: 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 \?CCL21
|
|
SUB 0,P-OFLAG >N
|
|
JUMP ?CND19
|
|
?CCL21: SET 'N,P-OFLAG
|
|
?CND19: GET G-LEXV,N
|
|
EQUAL? W?NO.WORD,STACK \?CCL24
|
|
ICALL INSERT-NP,0,NP
|
|
JUMP ?CND22
|
|
?CCL24: SET 'A1,FALSE-VALUE
|
|
GET NP,2 >A
|
|
ZERO? A /?CND27
|
|
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
|
|
?CND27: GET NP,1 >A
|
|
ZERO? A /?CND29
|
|
ICALL2 INSERT-ADJS,A
|
|
?CND29: ZERO? PP /?CND31
|
|
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 \?CCL35
|
|
GET A,4 >A
|
|
JUMP ?CND33
|
|
?CCL35: GETB A,1
|
|
EQUAL? STACK,3 \?CND33
|
|
GET A,2 >A
|
|
?CND33: ADD N,4 >?TMP1
|
|
GET A,2
|
|
PUT G-LEXV,?TMP1,STACK
|
|
?CND31: GET NP,3 >A
|
|
ZERO? A /?CND22
|
|
SET 'PTR,N
|
|
?PRG42: SUB PTR,P-LEXELEN >PTR
|
|
GRTR? 0,PTR \?CCL46
|
|
ZERO? A1 /?PRD49
|
|
SET 'PTR,A1
|
|
JUMP ?PEN47
|
|
?PRD49: SET 'PTR,N
|
|
?PEN47: ICALL MAKE-ROOM-FOR-TOKENS,1,G-LEXV,PTR
|
|
JUMP ?REP43
|
|
?CCL46: GET G-LEXV,PTR >WD
|
|
EQUAL? WD,W?THE /?REP43
|
|
CALL WORD-TYPE?,WD,P-QUANT-CODE
|
|
ZERO? STACK \?REP43
|
|
CALL WORD-TYPE?,WD,P-ADJ-CODE
|
|
ZERO? STACK /?CCL55
|
|
SET 'A1,PTR
|
|
JUMP ?PRG42
|
|
?CCL55: ZERO? A1 /?PRD58
|
|
SET 'PTR,A1
|
|
JUMP ?PEN56
|
|
?PRD58: SET 'PTR,N
|
|
?PEN56: ICALL MAKE-ROOM-FOR-TOKENS,1,G-LEXV,PTR
|
|
?REP43: CALL2 GET-QUANTITY-WORD,A
|
|
PUT G-LEXV,PTR,STACK
|
|
?CND22: 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,N,TYP,X
|
|
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
|
|
CALL WORD-TYPE?,STACK,P-VERB-CODE
|
|
ZERO? STACK /FALSE
|
|
?CND11: CALL2 HACK-TELL,X
|
|
RSTACK
|
|
|
|
|
|
.FUNCT HACK-TELL,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
|
|
ICALL2 IGNORE-FIRST-WORD,W?YOU
|
|
LESS? P-LEN,1 \?CCL8
|
|
SET 'P-CONT,FALSE-VALUE
|
|
JUMP ?CND6
|
|
?CCL8: SET 'P-CONT,TLEXV
|
|
?CND6: CALL2 HACK-TELL-1,NP
|
|
EQUAL? M-FATAL,STACK /?CCL10
|
|
ZERO? P-CONT \TRUE
|
|
?CCL10: SET 'P-CONT,-1
|
|
THROW PARSER-RESULT-DEAD,PARSE-SENTENCE-ACTIVATION
|
|
RTRUE
|
|
|
|
|
|
.FUNCT HACK-TELL-1,NP,X,NUM,CT,?TMP1
|
|
GET NP,4 >PRSO-NP
|
|
GET NP,3 >X
|
|
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 DPRINT,X
|
|
PRINTI ":
|
|
"
|
|
?CND1: CALL PERFORM,V?TELL,X >X
|
|
PUT PARSE-RESULT,4,0
|
|
RETURN X
|
|
|
|
|
|
.FUNCT RED-VP,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,N,TYP,NAME,QUANT,LEXB,LEXE,ADJ,NEW-OBJECT
|
|
SET 'QUANT,NP-QUANT-NONE
|
|
SET 'LEXE,TLEXV
|
|
POP DATA-STACK >NAME
|
|
EQUAL? NAME,1 \?CND1
|
|
SET 'NAME,FALSE-VALUE
|
|
?CND1: GET LEXE,0
|
|
CALL WORD-TYPE?,STACK,P-COMMA-CODE,P-EOI-CODE
|
|
ZERO? STACK /?CND3
|
|
SUB LEXE,4 >LEXE
|
|
?CND3: POP DATA-STACK >ADJ
|
|
EQUAL? ADJ,1 \?CCL7
|
|
SET 'LEXB,LEXE
|
|
SET 'ADJ,FALSE-VALUE
|
|
JUMP ?CND5
|
|
?CCL7: GET ADJ,1 >LEXB
|
|
GET ADJ,3
|
|
ZERO? STACK /?CND5
|
|
GET ADJ,3 >QUANT
|
|
?CND5: 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,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,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,Q,TBL
|
|
INTBL? Q,NP-QUANT-TBL,NP-QUANT-TBL-LEN,132 >TBL \FALSE
|
|
GET TBL,1
|
|
RSTACK
|
|
|
|
|
|
.FUNCT GET-QUANTITY,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,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,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,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 \?CCL5
|
|
POP DATA-STACK >PREP
|
|
EQUAL? PREP,W?OUT \FALSE
|
|
SET 'PREP,W?FROM
|
|
JUMP ?CND1
|
|
?CCL5: EQUAL? TMP,W?NOT \?CND1
|
|
POP DATA-STACK >PREP
|
|
EQUAL? PREP,W?BUT,W?EXCEPT \FALSE
|
|
?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,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,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
|
|
RETURN A1
|
|
?CCL17: PUT A1,2,P-HIM-OBJECT
|
|
RETURN A1
|
|
?CND6: EQUAL? A2,W?ITS \?CCL23
|
|
GET PARSE-RESULT,5 >AD
|
|
ZERO? AD /?CCL26
|
|
GET AD,3 >AD
|
|
ZERO? AD /?CCL26
|
|
FSET? AD,PERSONBIT /?CCL26
|
|
PUT A1,2,AD
|
|
RETURN A1
|
|
?CCL26: PUT A1,2,P-IT-OBJECT
|
|
RETURN A1
|
|
?CCL23: ADD WORD-FLAG-TABLE,2 >?TMP1
|
|
GET WORD-FLAG-TABLE,0
|
|
INTBL? A2,?TMP1,STACK,132 >NEW-OBJECT \?CCL34
|
|
GET NEW-OBJECT,1
|
|
JUMP ?CND32
|
|
?CCL34: PUSH FALSE-VALUE
|
|
?CND32: BTST STACK,16384 \?CCL31
|
|
GET A2,3
|
|
PUT A1,2,STACK
|
|
RETURN A1
|
|
?CCL31: EQUAL? A2,W?A,W?AN \?CCL36
|
|
PUT A1,3,NP-QUANT-A
|
|
RETURN A1
|
|
?CCL36: EQUAL? A2,W?THE /?CND21
|
|
CALL WORD-TYPE?,A2,P-ADJ-CODE
|
|
ZERO? STACK /FALSE
|
|
SET 'AD,A2
|
|
GET A1,4 >CT
|
|
LESS? CT,ADJS-MAX-COUNT \?CND21
|
|
ADD A1,10 >VV
|
|
GET A1,4 >TCT
|
|
?PRG44: ZERO? TCT \?CND46
|
|
PUT VV,0,A2
|
|
ADD CT,1
|
|
PUT A1,4,STACK
|
|
RETURN A1
|
|
?CND46: GET VV,0
|
|
EQUAL? AD,STACK /?CND21
|
|
ADD VV,2 >VV
|
|
DEC 'TCT
|
|
JUMP ?PRG44
|
|
?CND21: RETURN A1
|
|
|
|
|
|
.FUNCT RED-QUOTE,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
|