1679 lines
34 KiB
Plaintext
1679 lines
34 KiB
Plaintext
|
|
||
|
.SEGMENT "0"
|
||
|
|
||
|
|
||
|
.FUNCT DIR-VERB-PRSI?:ANY:1:1,NP
|
||
|
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,VERB,PART1,PART2,DATA,OBJ
|
||
|
POP DATA-STACK >PART2
|
||
|
POP DATA-STACK >OBJ
|
||
|
POP DATA-STACK >PART1
|
||
|
POP DATA-STACK
|
||
|
GET PARSE-RESULT,1
|
||
|
CALL2 ROOT-VERB,STACK >VERB
|
||
|
ZERO? VERB /FALSE
|
||
|
GET VERB,3 >DATA
|
||
|
ZERO? DATA /FALSE
|
||
|
EQUAL? PART1,TRUE-VALUE \?CND6
|
||
|
CALL SVN,PART2,DATA,OBJ
|
||
|
ZERO? STACK \TRUE
|
||
|
PUT PARSE-RESULT,8,PART2
|
||
|
?CND6: CALL SVN,PART1,DATA,OBJ
|
||
|
RSTACK
|
||
|
|
||
|
|
||
|
.FUNCT SVN:ANY:3:3,PART,DATA,OBJ,SYN,OBJ1,OBJ2
|
||
|
GET PARSE-RESULT,8
|
||
|
ZERO? STACK \?CCL3
|
||
|
GET DATA,2 >SYN
|
||
|
ZERO? SYN /?CCL3
|
||
|
CALL GET-SYNTAX,SYN,1,PART >SYN
|
||
|
ZERO? SYN /?CCL3
|
||
|
CALL DETERMINE-OBJ,OBJ,1 >OBJ1
|
||
|
ZERO? OBJ1 \?CCL9
|
||
|
GETB SYN,5
|
||
|
CALL PARSER-ERROR,0,PARSER-ERROR-NOOBJ,OBJ,PART,STACK
|
||
|
RSTACK
|
||
|
?CCL9: GET OBJ1,3
|
||
|
EQUAL? INTDIR,STACK \?CCL11
|
||
|
GET PARSE-RESULT,1
|
||
|
EQUAL? STACK,W?WALK,W?GO,W?RUN \?CCL11
|
||
|
GET OBJ,2
|
||
|
XPUSH STACK,DATA-STACK \?CCL11
|
||
|
CALL2 RED-SD,1
|
||
|
RSTACK
|
||
|
?CCL11: PUT PARSE-RESULT,5,OBJ1
|
||
|
RETURN PARSE-RESULT
|
||
|
?CCL3: GET DATA,3 >SYN
|
||
|
ZERO? SYN /FALSE
|
||
|
CALL GET-SYNTAX,SYN,2,PART,TRUE-VALUE >SYN
|
||
|
ZERO? SYN /FALSE
|
||
|
CALL DETERMINE-OBJ,OBJ,1 >OBJ1
|
||
|
ZERO? OBJ1 \?CCL21
|
||
|
GETB SYN,5
|
||
|
CALL PARSER-ERROR,0,PARSER-ERROR-NOOBJ,OBJ,PART,STACK
|
||
|
RSTACK
|
||
|
?CCL21: 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-SVPNPN:ANY:0:2,N,TYP,N1,N2,PART,P2,OBJ1,OBJ2,SYN,?TMP1
|
||
|
POP DATA-STACK >N2
|
||
|
POP DATA-STACK >P2
|
||
|
EQUAL? P2,TRUE-VALUE \?CCL3
|
||
|
GET GWIM-MSG,0 >?TMP1
|
||
|
ZERO? ?TMP1 /?PRD6
|
||
|
PUSH ?TMP1
|
||
|
JUMP ?PEN4
|
||
|
?PRD6: PUSH 1
|
||
|
?PEN4: PUT PARSE-RESULT,8,STACK
|
||
|
JUMP ?CND1
|
||
|
?CCL3: PUT PARSE-RESULT,8,P2
|
||
|
?CND1: POP DATA-STACK >N1
|
||
|
POP DATA-STACK >PART
|
||
|
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-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
|
||
|
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 >OLD-OBJECT
|
||
|
PUT OLD-OBJECT,1,PREP
|
||
|
PUT OLD-OBJECT,2,RLOC
|
||
|
RETURN OLD-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,CT,PTR,CNT
|
||
|
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 'OLD-OBJECT,OBJ
|
||
|
SET 'CT,FALSE-VALUE
|
||
|
?PRG48: CALL DETERMINE-NP,0,NUM,OLD-OBJECT,TRUE-VALUE >PTR
|
||
|
ZERO? PTR /FALSE
|
||
|
GET OLD-OBJECT,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 OLD-OBJECT,1 >OLD-OBJECT
|
||
|
ZERO? OLD-OBJECT \?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 'PTR,OBJ
|
||
|
ADD RES,6 >CT
|
||
|
?PRG66: GET PTR,3 >OLD-OBJECT
|
||
|
GET OLD-OBJECT,1
|
||
|
MUL 4,STACK >CNT
|
||
|
ADD OLD-OBJECT,6
|
||
|
COPYT STACK,CT,CNT
|
||
|
ADD CT,CNT >CT
|
||
|
GET PTR,1 >PTR
|
||
|
ZERO? PTR \?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,?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 >OLD-OBJECT
|
||
|
PUT OLD-OBJECT,1,1
|
||
|
PUT OLD-OBJECT,3,NOT-HERE-OBJECT
|
||
|
PUT OLD-OBJECT,4,ROBJ
|
||
|
SET 'RES,OLD-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 >OLD-OBJECT
|
||
|
PUT OLD-OBJECT,1,COUNT
|
||
|
SET 'RES,OLD-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
|
||
|
EQUAL? STACK,V?WALK-TO /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
|
||
|
GET ORPHAN-SR,1
|
||
|
ZERO? STACK /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
|
||
|
SET 'P-OFLAG,0
|
||
|
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
|
||
|
SET 'P-OFLAG,0
|
||
|
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,NEW-OBJECT,?TMP1
|
||
|
GET ORPHAN-SR,1
|
||
|
ZERO? STACK /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
|
||
|
CALL1 TEST-O-SR
|
||
|
ZERO? STACK /?CND17
|
||
|
RETURN A
|
||
|
?CND17: ZERO? CT /?CND19
|
||
|
PUT A,4,CT
|
||
|
?CND19: GET SEARCH-RES,1
|
||
|
ZERO? STACK /FALSE
|
||
|
RETURN A
|
||
|
|
||
|
|
||
|
.FUNCT TEST-O-SR:ANY:0:0,VEC,SZ,REM
|
||
|
SET 'VEC,ORPHAN-SR+8
|
||
|
GET ORPHAN-SR,0 >SZ
|
||
|
GET ORPHAN-SR,1 >REM
|
||
|
?PRG1: GET VEC,0
|
||
|
CALL MATCH-OBJECT,STACK,FINDER,TRUE-VALUE
|
||
|
ZERO? STACK /TRUE
|
||
|
DLESS? 'REM,1 /FALSE
|
||
|
DLESS? 'SZ,1 /FALSE
|
||
|
ADD VEC,2 >VEC
|
||
|
JUMP ?PRG1
|
||
|
|
||
|
|
||
|
.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
|
||
|
SET 'P-OFLAG,0
|
||
|
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
|
||
|
GET NP,2 >A
|
||
|
EQUAL? STACK,W?NO.WORD,A \?CCL31
|
||
|
ICALL INSERT-NP,0,NP
|
||
|
JUMP ?CND29
|
||
|
?CCL31: SET 'A1,FALSE-VALUE
|
||
|
ZERO? A /?CND34
|
||
|
ICALL MAKE-ROOM-FOR-TOKENS,1,G-LEXV,N
|
||
|
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
|
||
|
SET 'P-OFLAG,0
|
||
|
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 /?CCL2
|
||
|
GET NP,3
|
||
|
EQUAL? STACK,NOT-HERE-OBJECT \?CND1
|
||
|
?CCL2: 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 \?CND10
|
||
|
ICALL1 IGNORE-FIRST-WORD
|
||
|
?CND10: LESS? P-LEN,1 \?CCL14
|
||
|
SET 'P-CONT,FALSE-VALUE
|
||
|
JUMP ?CND12
|
||
|
?CCL14: SET 'P-CONT,TLEXV
|
||
|
?CND12: CALL2 HACK-TELL-1,NP
|
||
|
EQUAL? M-FATAL,STACK /?CCL16
|
||
|
ZERO? P-CONT \TRUE
|
||
|
?CCL16: 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
|
||
|
CALL PERF-MANY,X,FALSE-VALUE,PRSO-NP,STR?221
|
||
|
ZERO? STACK \?CND1
|
||
|
RETURN M-FATAL
|
||
|
?CND1: SET 'PRSQ,FALSE-VALUE
|
||
|
SET 'PRSS,FALSE-VALUE
|
||
|
ZERO? P-RESPONDED /?CND9
|
||
|
SUB 0,P-RESPONDED
|
||
|
ICALL2 BE-PATIENT,STACK
|
||
|
?CND9: 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,32776
|
||
|
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
|
||
|
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 '?PR-NP,NPP
|
||
|
?PRG56: GET ?PR-NP,1 >OONPP
|
||
|
ZERO? OONPP \?CND58
|
||
|
PUT ?PR-NP,1,NP
|
||
|
RETURN NPP
|
||
|
?CND58: SET '?PR-NP,OONPP
|
||
|
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-ADJS:ANY:0:2,N,TYP,A1,ART,NEW-OBJECT
|
||
|
POP DATA-STACK >A1
|
||
|
EQUAL? 1,N \?CCL3
|
||
|
RETURN A1
|
||
|
?CCL3: EQUAL? 1,A1 \?CND4
|
||
|
CALL DO-PMEM-ALLOC,1,8 >NEW-OBJECT
|
||
|
PUT NEW-OBJECT,1,TLEXV
|
||
|
SET 'A1,NEW-OBJECT
|
||
|
?CND4: POP DATA-STACK >ART
|
||
|
CALL2 PMEM?,ART
|
||
|
ZERO? STACK /?CCL8
|
||
|
PUT A1,2,ART
|
||
|
RETURN A1
|
||
|
?CCL8: EQUAL? ART,W?A,W?AN \?CCL10
|
||
|
PUT A1,3,NP-QUANT-A
|
||
|
RETURN A1
|
||
|
?CCL10: EQUAL? ART,W?THE \FALSE
|
||
|
RETURN A1
|
||
|
|
||
|
|
||
|
.FUNCT RED-ADJ:ANY:0:2,N,TYP,A1,A2,CT,AD,NEW-OBJECT,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
|
||
|
EQUAL? A2,W?MY \?CCL8
|
||
|
PUT A1,2,PLAYER
|
||
|
RETURN A1
|
||
|
?CCL8: EQUAL? A2,W?YOUR \?CCL10
|
||
|
PUT A1,2,WINNER
|
||
|
RETURN A1
|
||
|
?CCL10: EQUAL? A2,W?HIS \?CND6
|
||
|
GET PARSE-RESULT,5 >AD
|
||
|
ZERO? AD /?CCL15
|
||
|
GET AD,3 >AD
|
||
|
ZERO? AD /?CCL15
|
||
|
FSET? AD,PERSONBIT \?CCL15
|
||
|
PUT A1,2,AD
|
||
|
FSET? AD,FEMALE \?CND13
|
||
|
PUT A1,2,P-HIM-OBJECT
|
||
|
RETURN A1
|
||
|
?CCL15: PUT A1,2,P-HIM-OBJECT
|
||
|
?CND13: RETURN A1
|
||
|
?CND6: EQUAL? A2,W?HER \?CND21
|
||
|
GET PARSE-RESULT,5 >AD
|
||
|
ZERO? AD /?CCL25
|
||
|
GET AD,3 >AD
|
||
|
ZERO? AD /?CCL25
|
||
|
FSET? AD,PERSONBIT \?CCL25
|
||
|
FSET? AD,FEMALE \?CCL25
|
||
|
PUT A1,2,AD
|
||
|
RETURN A1
|
||
|
?CCL25: PUT A1,2,P-HER-OBJECT
|
||
|
RETURN A1
|
||
|
?CND21: EQUAL? A2,W?THEIR \?CCL32
|
||
|
GET PARSE-RESULT,5 >AD
|
||
|
ZERO? AD /?CCL35
|
||
|
GET AD,3 >AD
|
||
|
ZERO? AD /?CCL35
|
||
|
FSET? AD,PLURAL \?CCL35
|
||
|
PUT A1,2,AD
|
||
|
RETURN A1
|
||
|
?CCL35: PUT A1,2,P-THEM-OBJECT
|
||
|
RETURN A1
|
||
|
?CCL32: EQUAL? A2,W?ITS \?CCL40
|
||
|
GET PARSE-RESULT,5 >AD
|
||
|
ZERO? AD /?CCL43
|
||
|
GET AD,3 >AD
|
||
|
ZERO? AD /?CCL43
|
||
|
FSET? AD,PERSONBIT /?CCL43
|
||
|
PUT A1,2,AD
|
||
|
RETURN A1
|
||
|
?CCL43: PUT A1,2,P-IT-OBJECT
|
||
|
RETURN A1
|
||
|
?CCL40: ADD WORD-FLAG-TABLE,2 >?TMP1
|
||
|
GET WORD-FLAG-TABLE,0
|
||
|
INTBL? A2,?TMP1,STACK,132 >NEW-OBJECT \?CCL51
|
||
|
GET NEW-OBJECT,1
|
||
|
JUMP ?CND49
|
||
|
?CCL51: PUSH FALSE-VALUE
|
||
|
?CND49: BTST STACK,16384 \?CCL48
|
||
|
GET A2,3
|
||
|
PUT A1,2,STACK
|
||
|
RETURN A1
|
||
|
?CCL48: GET A2,4 >?TMP1
|
||
|
ZERO? ?TMP1 /?PRD58
|
||
|
PUSH ?TMP1
|
||
|
JUMP ?PEN56
|
||
|
?PRD58: GET A2,3
|
||
|
GET STACK,4
|
||
|
?PEN56: BTST STACK,32768 /FALSE
|
||
|
GET A2,4 >?TMP1
|
||
|
ZERO? ?TMP1 /?PRD61
|
||
|
PUSH ?TMP1
|
||
|
JUMP ?PEN59
|
||
|
?PRD61: GET A2,3
|
||
|
GET STACK,4
|
||
|
?PEN59: BAND STACK,4
|
||
|
BAND STACK,32767
|
||
|
ZERO? STACK /FALSE
|
||
|
SET 'AD,A2
|
||
|
GET A1,4 >CT
|
||
|
LESS? CT,ADJS-MAX-COUNT \?CND30
|
||
|
ADD A1,10 >NEW-OBJECT
|
||
|
GET A1,4 >TCT
|
||
|
?PRG65: ZERO? TCT \?CND67
|
||
|
PUT NEW-OBJECT,0,A2
|
||
|
ADD CT,1
|
||
|
PUT A1,4,STACK
|
||
|
RETURN A1
|
||
|
?CND67: GET NEW-OBJECT,0
|
||
|
EQUAL? AD,STACK /?CND30
|
||
|
ADD NEW-OBJECT,2 >NEW-OBJECT
|
||
|
DEC 'TCT
|
||
|
JUMP ?PRG65
|
||
|
?CND30: 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
|