find.zap


	.SEGMENT "0"


	.FUNCT	FIND-DESCENDANTS:ANY:2:2,PARENT,FLAGS,F,FOBJ
	SET	'F,FINDER
	EQUAL?	PARENT,GLOBAL-HERE \?CND1
	SET	'PARENT,HERE
?CND1:	FIRST?	PARENT >FOBJ \TRUE
?PRG6:	CALL2	VISIBLE?,FOBJ
	ZERO?	STACK /?CND8
	BTST	FLAGS,8 /?CND10
	BTST	FLAGS,1 \?PRF16
	PUSH	1
	JUMP	?PEN14
?PRF16:	PUSH	0
?PEN14:	CALL	MATCH-OBJECT,FOBJ,F,STACK
	ZERO?	STACK /FALSE
?CND10:	BTST	FLAGS,4 \?CND8
	FIRST?	FOBJ \?CND8
	EQUAL?	FOBJ,WINNER /?CND8
	FSET?	FOBJ,SEARCHBIT \?PRD24
	FSET?	FOBJ,OPENBIT /?CCL18
	FSET?	FOBJ,TRANSBIT /?CCL18
?PRD24:	FSET?	FOBJ,SURFACEBIT \?CND8
?CCL18:	BTST	FLAGS,1 \?CCL33
	PUSH	5
	JUMP	?CND31
?CCL33:	PUSH	4
?CND31:	CALL	FIND-DESCENDANTS,FOBJ,STACK
	ZERO?	STACK /FALSE
?CND8:	NEXT?	FOBJ >FOBJ /?PRG6
	RTRUE	


	.FUNCT	EXCLUDED?:ANY:2:2,FOBJ,F,EXC,PHRASE,CT,VEC,VV
	GET	F,8 >EXC
	ZERO?	EXC /FALSE
	GET	EXC,3 >PHRASE
	GET	PHRASE,1 >CT
	ADD	PHRASE,6 >VEC
?PRG6:	DLESS?	'CT,0 \?CND8
	SET	'VV,FALSE-VALUE
	JUMP	?REP7
?CND8:	GET	VEC,0
	EQUAL?	FOBJ,STACK \?CND10
	SET	'VV,TRUE-VALUE
?REP7:	ZERO?	VV \TRUE
	GET	EXC,1 >EXC
	ZERO?	EXC /FALSE
	GET	EXC,3 >PHRASE
	GET	PHRASE,1 >CT
	ADD	PHRASE,6 >VEC
	JUMP	?PRG6
?CND10:	ADD	VEC,4 >VEC
	JUMP	?PRG6


	.FUNCT	INVALID-OBJECT?:ANY:1:1,OBJ
	RFALSE	


	.FUNCT	MATCH-OBJECT:ANY:3:3,FOBJ,F,INCLUDE?,NOUN,ADJS,APP,TB,RES,?TMP1
	GET	F,9 >RES
	FSET?	FOBJ,INVISIBLE /TRUE
	GET	F,6 >NOUN
	EQUAL?	NOUN,FALSE-VALUE,W?ONE /?PRD6
	GETPT	FOBJ,P?SYNONYM >TB
	ZERO?	TB /TRUE
	PTSIZE	TB
	DIV	STACK,2
	INTBL?	NOUN,TB,STACK \TRUE
?PRD6:	GET	F,7 >ADJS
	ZERO?	ADJS /?PRD11
	CALL	CHECK-ADJS,FOBJ,F,ADJS
	ZERO?	STACK /TRUE
?PRD11:	GET	F,5 >ADJS
	ZERO?	ADJS /?PRD14
	CALL	CHECK-ADJS,FOBJ,F,ADJS
	ZERO?	STACK /TRUE
?PRD14:	CALL	EXCLUDED?,FOBJ,F
	ZERO?	STACK \TRUE
	GET	F,1
	BTST	STACK,1 /?CTR2
	CALL2	INVALID-OBJECT?,FOBJ
	ZERO?	STACK \TRUE
?CTR2:	ZERO?	INCLUDE? /TRUE
	GET	F,5 >ADJS
	ZERO?	ADJS /?CCL24
	GET	ADJS,4 >?TMP1
	GETPT	FOBJ,P?ADJECTIVE
	PTSIZE	STACK
	DIV	STACK,2
	EQUAL?	?TMP1,STACK \?CCL24
	PUT	RES,1,1
	PUT	RES,2,FALSE-VALUE
	PUT	RES,4,FOBJ
	EQUAL?	FOBJ,HERE \FALSE
	PUT	RES,4,GLOBAL-HERE
	RFALSE	
?CCL24:	GET	F,0 >APP
	ZERO?	APP /?CCL31
	GET	F,1
	BTST	STACK,1 /?CCL31
	GET	RES,1
	ZERO?	STACK /?CTR35
	GET	F,2
	ZERO?	STACK /?CCL36
?CTR35:	CALL	ADD-OBJECT,FOBJ,F
	RSTACK	
?CCL36:	CALL	TEST-OBJECT,FOBJ,APP,F
	ZERO?	STACK /FALSE
	GET	RES,1
	EQUAL?	STACK,1 \?CCL43
	GET	RES,4
	CALL	TEST-OBJECT,STACK,APP,F
	ZERO?	STACK \?CCL46
	PUT	RES,4,FOBJ
	EQUAL?	FOBJ,HERE \TRUE
	PUT	RES,4,GLOBAL-HERE
	RTRUE	
?CCL46:	CALL	ADD-OBJECT,FOBJ,F
	RSTACK	
?CCL43:	CALL	ADD-OBJECT,FOBJ,F
	RSTACK	
?CCL31:	ZERO?	APP \?CCL50
	GET	F,1
	BTST	STACK,1 \?CTR52
	GET	F,2
	ZERO?	STACK /TRUE
?CTR52:	CALL	ADD-OBJECT,FOBJ,F
	RSTACK	
?CCL50:	CALL	TEST-OBJECT,FOBJ,APP,F
	ZERO?	STACK /TRUE
	CALL	ADD-OBJECT,FOBJ,F
	RSTACK	


	.FUNCT	TEST-OBJECT:ANY:3:3,FOBJ,APP,F,N,NN,?TMP1
	BAND	APP,65280
	ZERO?	STACK \?CCL3
	BTST	APP,128 \?CCL6
	BAND	APP,63
	FSET?	FOBJ,STACK /FALSE
	RTRUE	
?CCL6:	FSET?	FOBJ,APP /TRUE
	RFALSE	
?CCL3:	GET	APP,1
	BTST	STACK,256 \?CND12
	GET	APP,1
	BAND	STACK,63
	GETP	FOBJ,STACK >?TMP1
	GET	APP,2
	EQUAL?	?TMP1,STACK /TRUE
	RFALSE	
?CND12:	GET	APP,0 >N
?PRG17:	GET	APP,N >NN
	BTST	NN,128 \?CCL21
	BAND	NN,63
	FSET?	FOBJ,STACK /?CND19
	RTRUE	
?CCL21:	FSET?	FOBJ,NN /TRUE
?CND19:	DLESS?	'N,1 \?PRG17
	RFALSE	


	.FUNCT	ADD-OBJECT:ANY:2:2,OBJ,F,VEC,NC,DOIT?,SYN,WHICH,?TMP1
	GET	F,9 >VEC
	SET	'DOIT?,TRUE-VALUE
	GET	F,3 >SYN
	GET	F,4 >WHICH
	EQUAL?	OBJ,HERE \?CND1
	SET	'OBJ,GLOBAL-HERE
?CND1:	GET	F,2
	ZERO?	STACK \?CND3
	ZERO?	SYN /?CND3
	GET	VEC,1
	EQUAL?	1,STACK \?CND3
	CALL	MULTIPLE-EXCEPTION?,OBJ,SYN,WHICH,F
	ZERO?	STACK /?CCL10
	SET	'DOIT?,FALSE-VALUE
	JUMP	?CND3
?CCL10:	GET	VEC,4
	CALL	MULTIPLE-EXCEPTION?,STACK,SYN,WHICH,F
	ZERO?	STACK /?CND3
	PUT	VEC,4,OBJ
	SET	'DOIT?,FALSE-VALUE
?CND3:	ZERO?	DOIT? /TRUE
	GET	F,2
	ZERO?	STACK /?PRD17
	GET	F,3
	ZERO?	STACK /?PRD17
	GET	F,3 >?TMP1
	GET	F,4
	CALL	MULTIPLE-EXCEPTION?,OBJ,?TMP1,STACK,F
	ZERO?	STACK \TRUE
?PRD17:	CALL	NOT-IN-FIND-RES?,OBJ,VEC >WHICH
	ZERO?	WHICH /TRUE
	GET	VEC,1
	ADD	1,STACK
	PUT	VEC,1,STACK
	PUT	WHICH,0,OBJ
	GET	F,2
	EQUAL?	STACK,NP-QUANT-A /FALSE
	RTRUE	


	.FUNCT	NOT-IN-FIND-RES?:ANY:2:3,OBJ,VEC,NO-CHANGE?,CT,SZ,ANS,NVEC,NEW-OBJECT
	GET	VEC,1 >CT
	GET	VEC,0 >SZ
?PRG1:	ADD	VEC,8 >ANS
	LESS?	CT,1 \?CCL5
	RETURN	ANS
?CCL5:	GRTR?	CT,SZ \?CCL7
	SUB	CT,SZ >CT
	JUMP	?CND3
?CCL7:	SET	'SZ,CT
?CND3:	INTBL?	OBJ,ANS,SZ /FALSE
	GET	VEC,2 >NVEC
	ZERO?	NVEC /?CCL12
	SET	'VEC,NVEC
	SET	'SZ,FIND-RES-MAXOBJ
	JUMP	?PRG1
?CCL12:	LESS?	SZ,FIND-RES-MAXOBJ \?CCL14
	MUL	2,SZ
	ADD	ANS,STACK
	RSTACK	
?CCL14:	ZERO?	NO-CHANGE? \TRUE
	SET	'SZ,FIND-RES-MAXOBJ
	CALL	DO-PMEM-ALLOC,7,9 >NEW-OBJECT
	SET	'NVEC,NEW-OBJECT
	PUT	VEC,2,NVEC
	ADD	NVEC,8
	RSTACK	


	.FUNCT	EVERYWHERE-VERB?:ANY:0:2,WHICH,SYNTAX,SYN
	ASSIGNED?	'WHICH /?CND1
	GET	FINDER,4 >WHICH
?CND1:	ASSIGNED?	'SYNTAX /?CND3
	GET	PARSE-RESULT,3 >SYNTAX
?CND3:	EQUAL?	WHICH,1 \?CCL7
	GETB	SYNTAX,5 >SYN
	JUMP	?CND5
?CCL7:	GETB	SYNTAX,9 >SYN
?CND5:	BTST	SYN,128 \FALSE
	BTST	SYN,64 \TRUE
	RFALSE	


	.FUNCT	MULTIPLE-EXCEPTION?:ANY:4:4,OBJ,SYNTAX,WHICH,F,L,VB
	LOC	OBJ >L
	GET	SYNTAX,0 >VB
	EQUAL?	OBJ,FALSE-VALUE,ROOMS \?CCL3
	INC	'P-NOT-HERE
	RTRUE	
?CCL3:	CALL	EVERYWHERE-VERB?,WHICH,SYNTAX
	ZERO?	STACK \?CCL5
	CALL2	ACCESSIBLE?,OBJ
	ZERO?	STACK /TRUE
?CCL5:	EQUAL?	VB,V?TAKE \?CCL9
	GET	F,6
	ZERO?	STACK \?CCL9
	EQUAL?	WHICH,1 \?CCL9
	FSET?	OBJ,TAKEBIT /?CCL15
	FSET?	OBJ,TRYTAKEBIT \TRUE
?CCL15:	EQUAL?	L,WINNER /TRUE
	RFALSE	
?CCL9:	EQUAL?	VB,V?DROP \FALSE
	IN?	OBJ,WINNER \TRUE
	RFALSE	


	.FUNCT	CHECK-ADJS-THERE?:ANY:1:1,OWNER,TMP
	GET	OWNER-SR-THERE,1 >TMP
	ZERO?	TMP /FALSE
	INTBL?	OWNER,OWNER-SR-THERE+8,TMP /TRUE
	RFALSE	


	.FUNCT	CHECK-ADJS:ANY:3:3,OBJ,F,ADJS,CNT,TMP,OWNER,ID,VEC,CT,ADJ,FL,OADJS,NUM,?TMP1
	GETP	OBJ,P?OWNER >OWNER
	GETB	ADJS,1
	EQUAL?	STACK,2 /?CCL2
	GET	ADJS,2 >TMP
	ZERO?	TMP /?CND1
?CCL2:	SET	'ID,OWNER
	LESS?	0,ID \?CCL7
	SET	'ID,OWNER
	GRTR?	ID,LAST-OBJECT /?CCL7
	EQUAL?	OWNER,TMP /?CND1
	EQUAL?	OWNER,ROOMS \?CCL14
	GET	OWNER-SR-HERE,1
	ZERO?	STACK /?CCL17
	GET	OWNER-SR-HERE,4 >ID
	JUMP	?CND1
?CCL17:	GET	OWNER-SR-THERE,1
	ZERO?	STACK /FALSE
	GET	OWNER-SR-THERE,4 >ID
	JUMP	?CND1
?CCL14:	GET	OWNER-SR-HERE,1 >TMP
	ZERO?	TMP \?CCL21
	CALL2	CHECK-ADJS-THERE?,OWNER
	ZERO?	STACK \?CND1
	RFALSE	
?CCL21:	INTBL?	OWNER,OWNER-SR-HERE+8,TMP /?CND1
	CALL2	CHECK-ADJS-THERE?,OWNER
	ZERO?	STACK \?CND1
	RFALSE	
?CCL7:	ZERO?	OWNER /?CCL28
	GET	OWNER-SR-HERE,1 >CNT
	ZERO?	CNT \?CCL31
	SET	'ID,PLAYER
	JUMP	?CND1
?CCL31:	ADD	OWNER,2 >TMP
	SET	'VEC,OWNER-SR-HERE+8
?PRG33:	DLESS?	'CNT,0 /FALSE
	GET	VEC,0 >?TMP1
	GET	OWNER,0
	INTBL?	?TMP1,TMP,STACK >ID \?CCL39
	GET	ID,0 >ID
	JUMP	?CND1
?CCL39:	ADD	VEC,2 >VEC
	JUMP	?PRG33
?CCL28:	LESS?	0,TMP \?CCL41
	GRTR?	TMP,LAST-OBJECT /?CCL41
	CALL	HELD?,OBJ,TMP
	ZERO?	STACK \?CND1
	RFALSE	
?CCL41:	GET	OWNER-SR-HERE,1 >TMP
	ZERO?	TMP /FALSE
	LOC	OBJ
	INTBL?	STACK,OWNER-SR-HERE+8,TMP >ID \FALSE
?CND1:	EQUAL?	ID,0,OBJ /?CND50
	GET	F,9
	PUT	STACK,3,ID
?CND50:	GETB	ADJS,1
	EQUAL?	STACK,2 /TRUE
	ADD	ADJS,10 >VEC
	GET	ADJS,4 >CT
	GETPT	OBJ,P?ADJECTIVE >OADJS
	PTSIZE	OADJS
	DIV	STACK,2 >NUM
?PRG54:	DLESS?	'CT,0 /TRUE
	GET	VEC,CT >ADJ
	SET	'ID,ADJ
	EQUAL?	ADJ,W?NO.WORD /?PRG54
	INTBL?	ID,OADJS,NUM /?PRG54
	EQUAL?	ID,W?CLOSED,W?SHUT \?CCL63
	FSET?	OBJ,OPENBIT \?PRG54
?CCL63:	EQUAL?	ID,W?OPEN \FALSE
	FSET?	OBJ,OPENBIT /?PRG54
	RFALSE	


	.FUNCT	SEARCH-IN-LG?:ANY:1:1,OBJ
	RFALSE	


	.FUNCT	EXCLUDE-HERE-OBJECT?:ANY:0:0
	RFALSE	


	.FUNCT	FIND-OBJECTS:ANY:0:3,SEARCH,PARENT,NO-ADJACENT,GLBS,CONT?,N,RES,NEW-OBJECT,FLAG,?PR-FLAG,?TMP1,?TMP2
	ASSIGNED?	'SEARCH /?CND1
	GET	FINDER,4
	EQUAL?	1,STACK \?CCL5
	GET	PARSE-RESULT,3
	GETB	STACK,5 >SEARCH
	JUMP	?CND1
?CCL5:	GET	PARSE-RESULT,3
	GETB	STACK,9 >SEARCH
?CND1:	SET	'CONT?,TRUE-VALUE
	GET	FINDER,9 >RES
	PUT	RES,1,0
	PUT	RES,2,FALSE-VALUE
	ZERO?	PARENT /?CCL8
	CALL	FIND-DESCENDANTS,PARENT,7
	ZERO?	STACK /?CND6
	GET	RES,1
	ZERO?	STACK \?CND6
?CCL8:	ZERO?	PARENT /?CND13
	ZERO?	NO-ADJACENT \?CND13
	GET	FINDER,5 >GLBS
	ZERO?	GLBS \?CND13
	CALL	DO-PMEM-ALLOC,1,8 >NEW-OBJECT
	PUT	NEW-OBJECT,2,PARENT
	SET	'GLBS,NEW-OBJECT
	PUT	FINDER,5,GLBS
?CND13:	BTST	SEARCH,128 \?CND19
	BTST	SEARCH,64 /?CND19
	FIRST?	GENERIC-OBJECTS \?CND19
	FIRST?	GENERIC-OBJECTS >NEW-OBJECT /?PRG25
?PRG25:	CALL	MATCH-OBJECT,NEW-OBJECT,FINDER,TRUE-VALUE
	ZERO?	STACK /?REP26
	NEXT?	NEW-OBJECT >NEW-OBJECT /?PRG25
?REP26:	GET	RES,1 >CONT?
	ZERO?	CONT? /?CND19
	EQUAL?	CONT?,1 /TRUE
	RFALSE	
?CND19:	SET	'NEW-OBJECT,FALSE-VALUE
?PRG35:	ZERO?	NEW-OBJECT \?PRD40
	BAND	SEARCH,12
	ZERO?	STACK \?CCL38
?PRD40:	ZERO?	NEW-OBJECT /?CND37
?CCL38:	ZERO?	NEW-OBJECT \?CTR44
	BTST	SEARCH,8 \?CCL45
?CTR44:	SET	'?PR-FLAG,6
	JUMP	?CND43
?CCL45:	SET	'?PR-FLAG,2
?CND43:	ZERO?	NEW-OBJECT \?CTR49
	BAND	SEARCH,12
	ZERO?	STACK /?CCL50
?CTR49:	BOR	1,?PR-FLAG >FLAG
	JUMP	?CND48
?CCL50:	BAND	?PR-FLAG,-2 >FLAG
?CND48:	ZERO?	NEW-OBJECT \?CCL55
	BTST	SEARCH,4 /?CCL55
	BOR	8,FLAG
	JUMP	?CND53
?CCL55:	BAND	FLAG,-9
?CND53:	CALL	FIND-DESCENDANTS,WINNER,STACK >CONT?
?CND37:	ZERO?	NEW-OBJECT \?CCL59
	BAND	SEARCH,3
	ZERO?	STACK /?CND58
?CCL59:	ZERO?	NEW-OBJECT \?CTR63
	BAND	SEARCH,3
	ZERO?	STACK /?CCL64
?CTR63:	SET	'?PR-FLAG,3
	JUMP	?CND62
?CCL64:	SET	'?PR-FLAG,2
?CND62:	ZERO?	NEW-OBJECT \?CTR69
	BTST	SEARCH,2 \?CCL70
?CTR69:	BOR	4,?PR-FLAG >FLAG
	JUMP	?CND68
?CCL70:	BAND	?PR-FLAG,-5 >FLAG
?CND68:	ZERO?	NEW-OBJECT \?CCL75
	BTST	SEARCH,1 /?CCL75
	BOR	8,FLAG
	JUMP	?CND73
?CCL75:	BAND	FLAG,-9
?CND73:	CALL	FIND-DESCENDANTS,HERE,STACK >CONT?
?CND58:	GET	RES,1
	ZERO?	STACK \?CND6
	BTST	SEARCH,15 /?CND78
	ZERO?	NEW-OBJECT \?CND78
	GET	TLEXV,0 >GLBS
	ZERO?	GLBS /?CCL86
	GET	GLBS,4
	ZERO?	STACK \?CTR85
	GET	GLBS,3
	ZERO?	STACK /?CCL86
?CTR85:	SET	'NEW-OBJECT,TRUE-VALUE
	JUMP	?PRG35
?CCL86:	BTST	SEARCH,64 \?CND78
	BTST	SEARCH,128 \FALSE
?CND78:	GETPT	HERE,P?GLOBAL >GLBS
	ZERO?	GLBS /?CND94
	PTSIZE	GLBS
	DIV	STACK,2 >N
?PRG97:	DLESS?	'N,0 /?CND94
	GET	GLBS,N >?PR-FLAG
	CALL	MATCH-OBJECT,?PR-FLAG,FINDER,TRUE-VALUE >CONT?
	ZERO?	CONT? /?CND94
	FIRST?	?PR-FLAG \?PRG97
	BTST	SEARCH,2 \?PRG97
	CALL2	SEARCH-IN-LG?,?PR-FLAG
	ZERO?	STACK /?PRG97
	CALL	FIND-DESCENDANTS,?PR-FLAG,FD-INCLUDE? >CONT?
	ZERO?	CONT? \?PRG97
?CND94:	ZERO?	CONT? /?CND111
	CALL1	EXCLUDE-HERE-OBJECT?
	ZERO?	STACK \?CND111
	CALL	MATCH-OBJECT,HERE,FINDER,TRUE-VALUE >CONT?
?CND111:	ZERO?	CONT? /?CND115
	LOC	PLAYER
	EQUAL?	HERE,STACK /?CND115
	LOC	PLAYER
	GETP	STACK,P?THINGS
	ZERO?	STACK /?CND115
	LOC	PLAYER
	CALL	TEST-THINGS,STACK,FINDER >CONT?
?CND115:	ZERO?	CONT? /?CND120
	GETP	HERE,P?THINGS
	ZERO?	STACK /?CND120
	CALL	TEST-THINGS,HERE,FINDER >CONT?
?CND120:	GET	RES,1
	ZERO?	STACK /?CND124
	SET	'CONT?,FALSE-VALUE
?CND124:	ZERO?	CONT? /?CND126
	BTST	SEARCH,2 \?CCL130
	PUSH	5
	JUMP	?CND128
?CCL130:	PUSH	1
?CND128:	CALL	FIND-DESCENDANTS,GLOBAL-OBJECTS,STACK >CONT?
?CND126:	ZERO?	CONT? /?CND131
	GET	RES,1
	ZERO?	STACK \?CND131
	ZERO?	NO-ADJACENT \?CND131
	GETP	HERE,P?ADJACENT >GLBS
	ZERO?	GLBS /?CND131
	GETB	GLBS,0 >N
?PRG137:	GETB	GLBS,N
	ZERO?	STACK /?CCL141
	DEC	'N
	GETB	GLBS,N
	ICALL	FIND-OBJECTS,1,STACK,TRUE-VALUE
	JUMP	?CND139
?CCL141:	DEC	'N
?CND139:	DLESS?	'N,1 \?PRG137
	GET	RES,1
	ZERO?	STACK /?CND131
	SET	'CONT?,FALSE-VALUE
?CND131:	ZERO?	CONT? /?CND6
	GET	RES,1
	ZERO?	STACK \?CND6
	BTST	SEARCH,128 \?PRD152
	BTST	SEARCH,64 \?CCL147
?PRD152:	GET	PARSE-RESULT,1 >?TMP2
	ADD	WORD-FLAG-TABLE,2 >?TMP1
	GET	WORD-FLAG-TABLE,0
	INTBL?	?TMP2,?TMP1,STACK,132 >FLAG \?CCL157
	GET	FLAG,1
	JUMP	?CND155
?CCL157:	PUSH	FALSE-VALUE
?CND155:	BTST	STACK,512 \?CND6
?CCL147:	SET	'?PR-FLAG,1
?PRG158:	CALL	MATCH-OBJECT,?PR-FLAG,FINDER,TRUE-VALUE
	ZERO?	STACK /?CND6
	IGRTR?	'?PR-FLAG,LAST-OBJECT \?PRG158
?CND6:	GET	RES,1
	EQUAL?	STACK,1 /TRUE
	RFALSE	


	.FUNCT	TEST-THINGS:ANY:2:2,RM,F,CT,RMG,RMGL,TTBL,NOUN,XCT,V,X,?TMP1
	GETP	RM,P?THINGS >RMG
	GET	RMG,0 >RMGL
	ADD	RMG,2 >RMG
	GET	F,5 >CT
	ZERO?	CT /?CND1
	GET	CT,4 >CT
?CND1:	GET	F,6 >NOUN
	GET	F,5
	ADD	STACK,10 >V
?PRG3:	GET	RMG,0 >TTBL
	EQUAL?	NOUN,W?ONE /?PRD8
	GETB	TTBL,1 >XCT
	EQUAL?	XCT,1 \?PRD11
	GET	TTBL,2
	EQUAL?	NOUN,STACK /?PRD8
?PRD11:	GET	TTBL,2
	INTBL?	NOUN,STACK,XCT \?CND5
?PRD8:	ZERO?	CT /?PRD14
	GETB	TTBL,0 >XCT
	EQUAL?	XCT,1 \?PRD17
	GET	V,0 >?TMP1
	GET	TTBL,1
	EQUAL?	?TMP1,STACK /?PRD14
?PRD17:	GET	V,0 >?TMP1
	GET	TTBL,1
	INTBL?	?TMP1,STACK,XCT \?CND5
?PRD14:	GET	F,7
	ZERO?	STACK /?CCL6
	GET	OWNER-SR-HERE,1
	EQUAL?	1,STACK \?CND5
	GET	OWNER-SR-HERE,4
	EQUAL?	PSEUDO-OBJECT,STACK \?CND5
	EQUAL?	LAST-PSEUDO-LOC,RM \?CND5
	GETP	PSEUDO-OBJECT,P?ACTION >?TMP1
	GET	RMG,1
	EQUAL?	?TMP1,STACK \?CND5
?CCL6:	SET	'LAST-PSEUDO-LOC,RM
	GET	RMG,1
	PUTP	PSEUDO-OBJECT,P?ACTION,STACK
	GETPT	PSEUDO-OBJECT,P?ACTION
	SUB	STACK,7 >V
	COPYT	NOUN,V,6
	ADD	WORD-FLAG-TABLE,2 >?TMP1
	GET	WORD-FLAG-TABLE,0
	INTBL?	NOUN,?TMP1,STACK,132 >X \?CCL31
	GET	X,1
	JUMP	?CND29
?CCL31:	PUSH	FALSE-VALUE
?CND29:	BTST	STACK,PLURAL-FLAG \?CCL28
	FSET	PSEUDO-OBJECT,PLURAL
	JUMP	?CND26
?CCL28:	FCLEAR	PSEUDO-OBJECT,PLURAL
?CND26:	ICALL	ADD-OBJECT,PSEUDO-OBJECT,F
	RFALSE	
?CND5:	ADD	RMG,4 >RMG
	DLESS?	'RMGL,1 \?PRG3
	RTRUE	

	.ENDSEG

	.ENDI