1678 lines
34 KiB
Plaintext
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
|