.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