planetfall/parser.zap

	.FUNCT	PARSER,PTR=P-LEXSTART,WORD,VAL=0,VERB=0,LEN,DIR=0,NW=0,LW=0,NUM,SCNT,CNT=-1
?PRG1:	IGRTR?	'CNT,P-ITBLLEN /?REP2
	PUT	P-ITBL,CNT,0
	JUMP	?PRG1
?REP2:	SET	'P-ADVERB,FALSE-VALUE
	SET	'P-ADJECTIVE,FALSE-VALUE
	SET	'P-MERGED,FALSE-VALUE
	PUT	P-PRSO,P-MATCHLEN,0
	PUT	P-PRSI,P-MATCHLEN,0
	PUT	P-BUTS,P-MATCHLEN,0
	ZERO?	QUOTE-FLAG \?CND6
	EQUAL?	WINNER,ADVENTURER /?CND6
	SET	'WINNER,ADVENTURER
	LOC	WINNER
	FSET?	STACK,VEHBIT /?CND6
	LOC	WINNER >HERE
?CND6:	ZERO?	P-CONT /?CCL14
	SET	'PTR,P-CONT
	SET	'P-CONT,FALSE-VALUE
	EQUAL?	PRSA,V?TELL /?CND12
	ZERO?	SUPER-BRIEF \?CND12
	CRLF	
	JUMP	?CND12
?CCL14:	SET	'WINNER,ADVENTURER
	SET	'QUOTE-FLAG,FALSE-VALUE
	LOC	WINNER
	FSET?	STACK,VEHBIT /?CND19
	LOC	WINNER >HERE
?CND19:	SET	'SCNT,P-SPACE
?PRG21:	DLESS?	'SCNT,0 /?REP22
	ZERO?	SUPER-BRIEF \?PRG21
	CRLF	
	JUMP	?PRG21
?REP22:	PRINTC	62
	READ	P-INBUF,P-LEXV
?CND12:	GETB	P-LEXV,P-LEXWORDS >P-LEN
	ZERO?	P-LEN \?CND27
	PRINTI	"I beg your pardon?"
	CRLF	
	RFALSE	
?CND27:	SET	'LEN,P-LEN
	SET	'P-DIR,FALSE-VALUE
	SET	'P-NCN,0
	SET	'P-GETFLAGS,0
?PRG29:	DLESS?	'P-LEN,0 \?CCL33
	SET	'QUOTE-FLAG,FALSE-VALUE
	JUMP	?REP30
?CCL33:	GET	P-LEXV,PTR >WORD
	ZERO?	WORD \?CTR34
	CALL	NUMBER?,PTR >WORD
	ZERO?	WORD /?CCL35
?CTR34:	EQUAL?	WORD,W?TO \?CCL40
	EQUAL?	VERB,ACT?TELL \?CCL40
	SET	'WORD,W?QUOTE
	JUMP	?CND38
?CCL40:	EQUAL?	WORD,W?THEN \?CND38
	ZERO?	VERB \?CND38
	ZERO?	QUOTE-FLAG \?CND38
	PUT	P-ITBL,P-VERB,ACT?TELL
	PUT	P-ITBL,P-VERBN,0
	SET	'WORD,W?QUOTE
?CND38:	EQUAL?	WORD,W?THEN,W?PERIOD /?CTR48
	EQUAL?	WORD,W?QUOTE \?CCL49
?CTR48:	EQUAL?	WORD,W?QUOTE \?CND52
	ZERO?	QUOTE-FLAG /?CCL56
	SET	'QUOTE-FLAG,FALSE-VALUE
	JUMP	?CND52
?CCL56:	SET	'QUOTE-FLAG,TRUE-VALUE
?CND52:	ZERO?	P-LEN /?PEN57
	ADD	PTR,P-LEXELEN >P-CONT
?PEN57:	PUTB	P-LEXV,P-LEXWORDS,P-LEN
	JUMP	?REP30
?CCL49:	CALL	WT?,WORD,16,3 >VAL
	ZERO?	VAL /?CCL60
	EQUAL?	LEN,1 /?CTR59
	EQUAL?	LEN,2 \?PRD65
	EQUAL?	VERB,ACT?WALK /?CTR59
?PRD65:	ADD	PTR,P-LEXELEN
	GET	P-LEXV,STACK >NW
	EQUAL?	NW,W?THEN,W?QUOTE \?PRD68
	EQUAL?	VERB,ACT?WALK \?PRD68
	GRTR?	LEN,2 /?CTR59
?PRD68:	EQUAL?	NW,W?PERIOD \?PRD72
	EQUAL?	VERB,ACT?WALK,FALSE-VALUE \?PRD72
	GRTR?	LEN,1 /?CTR59
?PRD72:	ZERO?	QUOTE-FLAG /?PRD76
	EQUAL?	LEN,2 \?PRD76
	EQUAL?	NW,W?QUOTE /?CTR59
?PRD76:	GRTR?	LEN,2 \?CCL60
	EQUAL?	VERB,ACT?WALK \?CCL60
	EQUAL?	NW,W?COMMA,W?AND \?CCL60
?CTR59:	SET	'DIR,VAL
	EQUAL?	NW,W?COMMA,W?AND \?CND83
	ADD	PTR,P-LEXELEN
	PUT	P-LEXV,STACK,W?THEN
?CND83:	GRTR?	LEN,2 /?CND31
	SET	'QUOTE-FLAG,FALSE-VALUE
	JUMP	?REP30
?CCL60:	CALL	WT?,WORD,64,1 >VAL
	ZERO?	VAL /?CCL88
	ZERO?	VERB \?CCL88
	SET	'VERB,VAL
	PUT	P-ITBL,P-VERB,VAL
	PUT	P-ITBL,P-VERBN,P-VTBL
	PUT	P-VTBL,0,WORD
	MUL	PTR,2
	ADD	STACK,2 >NUM
	GETB	P-LEXV,NUM
	PUTB	P-VTBL,2,STACK
	ADD	NUM,1
	GETB	P-LEXV,STACK
	PUTB	P-VTBL,3,STACK
	JUMP	?CND31
?CCL88:	CALL	WT?,WORD,8,0 >VAL
	ZERO?	VAL \?CTR91
	EQUAL?	WORD,W?ALL,W?ONE,W?A /?CTR91
	EQUAL?	WORD,W?BOTH /?CTR91
	CALL	WT?,WORD,32
	ZERO?	STACK \?CTR91
	CALL	WT?,WORD,128
	ZERO?	STACK /?CCL92
?CTR91:	GRTR?	P-LEN,0 \?CCL101
	ADD	PTR,P-LEXELEN
	GET	P-LEXV,STACK
	EQUAL?	STACK,W?OF \?CCL101
	ZERO?	VAL \?CCL101
	EQUAL?	WORD,W?ALL,W?ONE,W?A /?CCL101
	EQUAL?	WORD,W?BOTH \?CND31
?CCL101:	ZERO?	VAL /?CCL108
	ZERO?	P-LEN /?CTR107
	ADD	PTR,2
	GET	P-LEXV,STACK
	EQUAL?	STACK,W?THEN,W?PERIOD \?CCL108
?CTR107:	LESS?	P-NCN,2 \?CND31
	PUT	P-ITBL,P-PREP1,VAL
	PUT	P-ITBL,P-PREP1N,WORD
	JUMP	?CND31
?CCL108:	EQUAL?	P-NCN,2 \?CCL116
	PRINTI	"I found too many nouns in that sentence."
	CRLF	
	RFALSE	
?CCL116:	INC	'P-NCN
	CALL	CLAUSE,PTR,VAL,WORD >PTR
	ZERO?	PTR /FALSE
	LESS?	PTR,0 \?CND31
	SET	'QUOTE-FLAG,FALSE-VALUE
?REP30:	ZERO?	DIR /?CND126
	SET	'PRSA,V?WALK
	SET	'PRSO,DIR
	SET	'P-WALK-DIR,DIR
	RTRUE	
?CCL92:	CALL	WT?,WORD,4
	ZERO?	STACK \?CND31
	EQUAL?	VERB,ACT?TELL \?CCL123
	CALL	WT?,WORD,64,1
	ZERO?	STACK /?CCL123
	PRINTI	"Please consult your manual for the correct way to talk to other people or creatures."
	CRLF	
	RFALSE	
?CCL123:	CALL	CANT-USE,PTR
	RFALSE	
?CCL35:	CALL	UNKNOWN-WORD,PTR
	RFALSE	
?CND31:	SET	'LW,WORD
	ADD	PTR,P-LEXELEN >PTR
	JUMP	?PRG29
?CND126:	SET	'P-WALK-DIR,FALSE-VALUE
	ZERO?	P-OFLAG /?CND128
	CALL	ORPHAN-MERGE
?CND128:	CALL	SYNTAX-CHECK
	ZERO?	STACK /FALSE
	CALL	SNARF-OBJECTS
	ZERO?	STACK /FALSE
	CALL	MANY-CHECK
	ZERO?	STACK /FALSE
	CALL	TAKE-CHECK
	ZERO?	STACK \TRUE
	RFALSE	


	.FUNCT	WT?,PTR,BIT,B1=5,OFFST=P-P1OFF,TYP
	GETB	PTR,P-PSOFF >TYP
	BTST	TYP,BIT \FALSE
	GRTR?	B1,4 /TRUE
	EQUAL?	BIT,128 /TRUE
	BAND	TYP,P-P1BITS >TYP
	EQUAL?	TYP,B1 /?CND9
	INC	'OFFST
?CND9:	GETB	PTR,OFFST
	RSTACK	


	.FUNCT	CLAUSE,PTR,VAL,WORD,OFF,NUM,ANDFLG=0,FIRST??=1,NW,LW=0,?TMP1
	SUB	P-NCN,1
	MUL	STACK,2 >OFF
	ZERO?	VAL /?CCL3
	ADD	P-PREP1,OFF >NUM
	PUT	P-ITBL,NUM,VAL
	ADD	NUM,1
	PUT	P-ITBL,STACK,WORD
	ADD	PTR,P-LEXELEN >PTR
	JUMP	?CND1
?CCL3:	INC	'P-LEN
?CND1:	ZERO?	P-LEN \?CND4
	DEC	'P-NCN
	RETURN	-1
?CND4:	ADD	P-NC1,OFF >NUM
	MUL	PTR,2
	ADD	P-LEXV,STACK
	PUT	P-ITBL,NUM,STACK
	GET	P-LEXV,PTR
	EQUAL?	STACK,W?THE,W?A,W?AN \?PRG8
	GET	P-ITBL,NUM
	ADD	STACK,4
	PUT	P-ITBL,NUM,STACK
?PRG8:	DLESS?	'P-LEN,0 \?CND10
	ADD	NUM,1 >?TMP1
	MUL	PTR,2
	ADD	P-LEXV,STACK
	PUT	P-ITBL,?TMP1,STACK
	RETURN	-1
?CND10:	GET	P-LEXV,PTR >WORD
	ZERO?	WORD \?CTR13
	CALL	NUMBER?,PTR >WORD
	ZERO?	WORD /?CCL14
?CTR13:	ZERO?	P-LEN \?CCL19
	SET	'NW,0
	JUMP	?CND17
?CCL19:	ADD	PTR,P-LEXELEN
	GET	P-LEXV,STACK >NW
?CND17:	EQUAL?	WORD,W?AND,W?COMMA \?CCL22
	SET	'ANDFLG,TRUE-VALUE
	JUMP	?CND12
?CCL22:	EQUAL?	WORD,W?ALL,W?BOTH,W?ONE \?CCL24
	EQUAL?	NW,W?OF \?CND12
	DEC	'P-LEN
	ADD	PTR,P-LEXELEN >PTR
	JUMP	?CND12
?CCL24:	EQUAL?	WORD,W?THEN,W?PERIOD /?CTR27
	CALL	WT?,WORD,8
	ZERO?	STACK /?CCL28
	ZERO?	FIRST?? \?CCL28
?CTR27:	INC	'P-LEN
	ADD	NUM,1 >?TMP1
	MUL	PTR,2
	ADD	P-LEXV,STACK
	PUT	P-ITBL,?TMP1,STACK
	SUB	PTR,P-LEXELEN
	RSTACK	
?CCL28:	CALL	WT?,WORD,128
	ZERO?	STACK /?CCL34
	GRTR?	P-LEN,0 \?CCL37
	EQUAL?	NW,W?OF \?CCL37
	EQUAL?	WORD,W?ALL,W?ONE \?CND12
?CCL37:	CALL	WT?,WORD,32,2
	ZERO?	STACK /?CCL41
	ZERO?	NW /?CCL41
	CALL	WT?,NW,128
	ZERO?	STACK \?CND12
?CCL41:	ZERO?	ANDFLG \?CCL46
	EQUAL?	NW,W?BUT,W?EXCEPT /?CCL46
	EQUAL?	NW,W?AND,W?COMMA /?CCL46
	ADD	NUM,1 >?TMP1
	ADD	PTR,2
	MUL	STACK,2
	ADD	P-LEXV,STACK
	PUT	P-ITBL,?TMP1,STACK
	RETURN	PTR
?CCL46:	SET	'ANDFLG,FALSE-VALUE
	JUMP	?CND12
?CCL34:	ZERO?	P-OFLAG \?PRD52
	ZERO?	P-MERGED \?PRD52
	GET	P-ITBL,P-VERB
	ZERO?	STACK /?CCL50
?PRD52:	CALL	WT?,WORD,32
	ZERO?	STACK \?CND12
	CALL	WT?,WORD,4
	ZERO?	STACK \?CND12
?CCL50:	ZERO?	ANDFLG /?CCL59
	CALL	WT?,WORD,16
	ZERO?	STACK \?CTR58
	CALL	WT?,WORD,64
	ZERO?	STACK /?CCL59
?CTR58:	SUB	PTR,4 >PTR
	ADD	PTR,2
	PUT	P-LEXV,STACK,W?THEN
	ADD	P-LEN,2 >P-LEN
?CND12:	SET	'LW,WORD
	SET	'FIRST??,FALSE-VALUE
	ADD	PTR,P-LEXELEN >PTR
	JUMP	?PRG8
?CCL59:	CALL	WT?,WORD,8
	ZERO?	STACK \?CND12
	CALL	CANT-USE,PTR
	RFALSE	
?CCL14:	CALL	UNKNOWN-WORD,PTR
	RFALSE	


	.FUNCT	NUMBER?,PTR,CNT,BPTR,CHR,SUM=0,TIM=0,?TMP1
	MUL	PTR,2
	ADD	P-LEXV,STACK
	GETB	STACK,2 >CNT
	MUL	PTR,2
	ADD	P-LEXV,STACK
	GETB	STACK,3 >BPTR
?PRG1:	DLESS?	'CNT,0 /?REP2
	GETB	P-INBUF,BPTR >CHR
	GRTR?	SUM,10000 /FALSE
	LESS?	CHR,58 \FALSE
	GRTR?	CHR,47 \FALSE
	MUL	SUM,10 >?TMP1
	SUB	CHR,48
	ADD	?TMP1,STACK >SUM
	INC	'BPTR
	JUMP	?PRG1
?REP2:	PUT	P-LEXV,PTR,W?INTNUM
	GRTR?	SUM,10000 /FALSE
	SET	'P-NUMBER,SUM
	RETURN	W?INTNUM


	.FUNCT	ORPHAN-MERGE,CNT=-1,TEMP,VERB,BEG,END,ADJ=0,WRD,?TMP1
	SET	'P-OFLAG,FALSE-VALUE
	GET	P-ITBL,P-VERBN
	GET	STACK,0 >WRD
	CALL	WT?,WRD,32,2
	ZERO?	STACK /?CCL3
	SET	'ADJ,TRUE-VALUE
	JUMP	?CND1
?CCL3:	CALL	WT?,WRD,128,0
	ZERO?	STACK /?CND1
	ZERO?	P-NCN \?CND1
	PUT	P-ITBL,P-VERB,0
	PUT	P-ITBL,P-VERBN,0
	ADD	P-LEXV,2
	PUT	P-ITBL,P-NC1,STACK
	ADD	P-LEXV,6
	PUT	P-ITBL,P-NC1L,STACK
	SET	'P-NCN,1
?CND1:	GET	P-ITBL,P-VERB >VERB
	ZERO?	VERB /?CCL9
	ZERO?	ADJ \?CCL9
	GET	P-OTBL,P-VERB
	EQUAL?	VERB,STACK \FALSE
?CCL9:	EQUAL?	P-NCN,2 /FALSE
	GET	P-OTBL,P-NC1
	EQUAL?	STACK,1 \?CCL16
	GET	P-ITBL,P-PREP1 >TEMP
	GET	P-OTBL,P-PREP1
	EQUAL?	TEMP,STACK /?CTR18
	ZERO?	TEMP \FALSE
?CTR18:	ZERO?	ADJ /?CCL24
	ADD	P-LEXV,2
	PUT	P-OTBL,P-NC1,STACK
	ADD	P-LEXV,6
	PUT	P-OTBL,P-NC1L,STACK
	JUMP	?PRG64
?CCL24:	GET	P-ITBL,P-NC1
	PUT	P-OTBL,P-NC1,STACK
	GET	P-ITBL,P-NC1L
	PUT	P-OTBL,P-NC1L,STACK
	JUMP	?PRG64
?CCL16:	GET	P-OTBL,P-NC2
	EQUAL?	STACK,1 \?CCL26
	GET	P-ITBL,P-PREP1 >TEMP
	GET	P-OTBL,P-PREP2
	EQUAL?	TEMP,STACK /?CTR28
	ZERO?	TEMP \FALSE
?CTR28:	ZERO?	ADJ /?CND32
	ADD	P-LEXV,2
	PUT	P-ITBL,P-NC1,STACK
	ADD	P-LEXV,6
	PUT	P-ITBL,P-NC1L,STACK
?CND32:	GET	P-ITBL,P-NC1
	PUT	P-OTBL,P-NC2,STACK
	GET	P-ITBL,P-NC1L
	PUT	P-OTBL,P-NC2L,STACK
	SET	'P-NCN,2
	JUMP	?PRG64
?CCL26:	ZERO?	P-ACLAUSE /?PRG64
	EQUAL?	P-NCN,1 /?CCL37
	ZERO?	ADJ \?CCL37
	SET	'P-ACLAUSE,FALSE-VALUE
	RFALSE	
?CCL37:	GET	P-ITBL,P-NC1 >BEG
	ZERO?	ADJ /?CND40
	ADD	P-LEXV,2 >BEG
	SET	'ADJ,FALSE-VALUE
?CND40:	GET	P-ITBL,P-NC1L >END
?PRG42:	GET	BEG,0 >WRD
	EQUAL?	BEG,END \?CCL46
	ZERO?	ADJ /?CCL49
	CALL	ACLAUSE-WIN,ADJ
	JUMP	?PRG64
?CCL49:	SET	'P-ACLAUSE,FALSE-VALUE
	RFALSE	
?CCL46:	ZERO?	ADJ \?CCL51
	GETB	WRD,P-PSOFF
	BTST	STACK,32 /?CTR50
	EQUAL?	WRD,W?ALL,W?ONE \?CCL51
?CTR50:	SET	'ADJ,WRD
?CND44:	ADD	BEG,P-WORDLEN >BEG
	ZERO?	END \?PRG42
	SET	'END,BEG
	SET	'P-NCN,1
	SUB	BEG,4
	PUT	P-ITBL,P-NC1,STACK
	PUT	P-ITBL,P-NC1L,BEG
	JUMP	?PRG42
?CCL51:	GETB	WRD,P-PSOFF
	BTST	STACK,128 /?CCL56
	EQUAL?	WRD,W?ONE \?CND44
?CCL56:	EQUAL?	WRD,P-ANAM,W?ONE \FALSE
	CALL	ACLAUSE-WIN,ADJ
?PRG64:	IGRTR?	'CNT,P-ITBLLEN \?CCL68
	SET	'P-MERGED,TRUE-VALUE
	RTRUE	
?CCL68:	GET	P-OTBL,CNT
	PUT	P-ITBL,CNT,STACK
	JUMP	?PRG64


	.FUNCT	ACLAUSE-WIN,ADJ
	GET	P-OTBL,P-VERB
	PUT	P-ITBL,P-VERB,STACK
	SET	'P-CCSRC,P-OTBL
	ADD	P-ACLAUSE,1
	CALL	CLAUSE-COPY,P-ACLAUSE,STACK,ADJ
	GET	P-OTBL,P-NC2
	ZERO?	STACK /?PEN1
	SET	'P-NCN,2
?PEN1:	SET	'P-ACLAUSE,FALSE-VALUE
	RTRUE	


	.FUNCT	WORD-PRINT,CNT,BUF
?PRG1:	DLESS?	'CNT,0 /TRUE
	GETB	P-INBUF,BUF
	PRINTC	STACK
	INC	'BUF
	JUMP	?PRG1


	.FUNCT	UNKNOWN-WORD,PTR,BUF,?TMP1
	PRINTI	"I don't know the word """
	MUL	PTR,2 >BUF
	ADD	P-LEXV,BUF
	GETB	STACK,2 >?TMP1
	ADD	P-LEXV,BUF
	GETB	STACK,3
	CALL	WORD-PRINT,?TMP1,STACK
	PRINTI	"."""
	CRLF	
	SET	'QUOTE-FLAG,FALSE-VALUE
	SET	'P-OFLAG,FALSE-VALUE
	RETURN	P-OFLAG


	.FUNCT	CANT-USE,PTR,BUF,?TMP1
	PRINTI	"I can't use the word """
	MUL	PTR,2 >BUF
	ADD	P-LEXV,BUF
	GETB	STACK,2 >?TMP1
	ADD	P-LEXV,BUF
	GETB	STACK,3
	CALL	WORD-PRINT,?TMP1,STACK
	PRINTI	""" here."
	CRLF	
	SET	'QUOTE-FLAG,FALSE-VALUE
	SET	'P-OFLAG,FALSE-VALUE
	RETURN	P-OFLAG


	.FUNCT	SYNTAX-CHECK,SYN,LEN,NUM,OBJ,DRIVE1=0,DRIVE2=0,PREP,VERB,TMP,?TMP2,?TMP1
	GET	P-ITBL,P-VERB >VERB
	ZERO?	VERB \?CND1
	PRINTI	"I can't find a verb in that sentence!"
	CRLF	
	RFALSE	
?CND1:	SUB	255,VERB
	GET	VERBS,STACK >SYN
	GETB	SYN,0 >LEN
	INC	'SYN
?PRG3:	GETB	SYN,P-SBITS
	BAND	STACK,P-SONUMS >NUM
	GRTR?	P-NCN,NUM /?CND5
	LESS?	NUM,1 /?CCL9
	ZERO?	P-NCN \?CCL9
	GET	P-ITBL,P-PREP1 >PREP
	ZERO?	PREP /?CTR8
	GETB	SYN,P-SPREP1
	EQUAL?	PREP,STACK \?CCL9
?CTR8:	SET	'DRIVE1,SYN
	JUMP	?CND5
?CCL9:	GETB	SYN,P-SPREP1 >?TMP1
	GET	P-ITBL,P-PREP1
	EQUAL?	?TMP1,STACK \?CND5
	EQUAL?	NUM,2 \?CCL18
	EQUAL?	P-NCN,1 \?CCL18
	SET	'DRIVE2,SYN
?CND5:	DLESS?	'LEN,1 \?CCL24
	ZERO?	DRIVE1 \?REP4
	ZERO?	DRIVE2 \?REP4
	PRINTI	"I don't understand that sentence."
	CRLF	
	RFALSE	
?CCL18:	GETB	SYN,P-SPREP2 >?TMP1
	GET	P-ITBL,P-PREP2
	EQUAL?	?TMP1,STACK \?CND5
	CALL	SYNTAX-FOUND,SYN
	RTRUE	
?CCL24:	ADD	SYN,P-SYNLEN >SYN
	JUMP	?PRG3
?REP4:	ZERO?	DRIVE1 /?CCL32
	GETB	DRIVE1,P-SFWIM1 >?TMP2
	GETB	DRIVE1,P-SLOC1 >?TMP1
	GETB	DRIVE1,P-SPREP1
	CALL	GWIM,?TMP2,?TMP1,STACK >OBJ
	ZERO?	OBJ /?CCL32
	PUT	P-PRSO,P-MATCHLEN,1
	PUT	P-PRSO,1,OBJ
	CALL	SYNTAX-FOUND,DRIVE1
	RSTACK	
?CCL32:	ZERO?	DRIVE2 /?CCL36
	GETB	DRIVE2,P-SFWIM2 >?TMP2
	GETB	DRIVE2,P-SLOC2 >?TMP1
	GETB	DRIVE2,P-SPREP2
	CALL	GWIM,?TMP2,?TMP1,STACK >OBJ
	ZERO?	OBJ /?CCL36
	PUT	P-PRSI,P-MATCHLEN,1
	PUT	P-PRSI,1,OBJ
	CALL	SYNTAX-FOUND,DRIVE2
	RSTACK	
?CCL36:	EQUAL?	VERB,ACT?FIND \?CCL40
	PRINTI	"I can't answer that question."
	CRLF	
	RFALSE	
?CCL40:	EQUAL?	WINNER,ADVENTURER /?CCL42
	CALL	CANT-ORPHAN
	RSTACK	
?CCL42:	CALL	ORPHAN,DRIVE1,DRIVE2
	PRINTI	"What do you want to "
	GET	P-OTBL,P-VERBN >TMP
	ZERO?	TMP \?CCL45
	PRINTI	"tell"
	JUMP	?CND43
?CCL45:	GETB	P-VTBL,2
	ZERO?	STACK \?CCL47
	GET	TMP,0
	PRINTB	STACK
	JUMP	?CND43
?CCL47:	GETB	TMP,2 >?TMP1
	GETB	TMP,3
	CALL	WORD-PRINT,?TMP1,STACK
	PUTB	P-VTBL,2,0
?CND43:	ZERO?	DRIVE2 /?CND48
	CALL	CLAUSE-PRINT,P-NC1,P-NC1L
?CND48:	SET	'P-OFLAG,TRUE-VALUE
	ZERO?	DRIVE1 /?CCL52
	GETB	DRIVE1,P-SPREP1
	JUMP	?CND50
?CCL52:	GETB	DRIVE2,P-SPREP2
?CND50:	CALL	PREP-PRINT,STACK
	PRINTC	63
	CRLF	
	RFALSE	


	.FUNCT	CANT-ORPHAN
	PRINTI	"""I don't understand! What are you referring to?"""
	CRLF	
	RFALSE	


	.FUNCT	ORPHAN,D1,D2,CNT=-1
	PUT	P-OCLAUSE,P-MATCHLEN,0
	SET	'P-CCSRC,P-ITBL
?PRG1:	IGRTR?	'CNT,P-ITBLLEN /?REP2
	GET	P-ITBL,CNT
	PUT	P-OTBL,CNT,STACK
	JUMP	?PRG1
?REP2:	EQUAL?	P-NCN,2 \?CND6
	CALL	CLAUSE-COPY,P-NC2,P-NC2L
?CND6:	LESS?	P-NCN,1 /?CND8
	CALL	CLAUSE-COPY,P-NC1,P-NC1L
?CND8:	ZERO?	D1 /?CCL12
	GETB	D1,P-SPREP1
	PUT	P-OTBL,P-PREP1,STACK
	PUT	P-OTBL,P-NC1,1
	RTRUE	
?CCL12:	ZERO?	D2 /FALSE
	GETB	D2,P-SPREP2
	PUT	P-OTBL,P-PREP2,STACK
	PUT	P-OTBL,P-NC2,1
	RTRUE	


	.FUNCT	CLAUSE-PRINT,BPTR,EPTR,THE?=1,?TMP1
	GET	P-ITBL,BPTR >?TMP1
	GET	P-ITBL,EPTR
	CALL	BUFFER-PRINT,?TMP1,STACK,THE?
	RSTACK	


	.FUNCT	BUFFER-PRINT,BEG,END,CP,NOSP=0,WRD,FIRST??=1,PN=0,?TMP1
?PRG1:	EQUAL?	BEG,END /TRUE
	ZERO?	NOSP /?CCL8
	SET	'NOSP,FALSE-VALUE
	JUMP	?CND6
?CCL8:	PRINTC	32
?CND6:	GET	BEG,0 >WRD
	EQUAL?	WRD,W?PERIOD \?CCL11
	SET	'NOSP,TRUE-VALUE
	JUMP	?CND3
?CCL11:	EQUAL?	WRD,W?FLOYD,W?BLATHER \?CCL13
	CALL	CAPITALIZE,BEG
	SET	'PN,TRUE-VALUE
	JUMP	?CND3
?CCL13:	ZERO?	FIRST?? /?CND14
	ZERO?	PN \?CND14
	ZERO?	CP /?CND14
	PRINTI	"the "
?CND14:	ZERO?	P-OFLAG /?CCL21
	PRINTB	WRD
	JUMP	?CND19
?CCL21:	EQUAL?	WRD,W?IT \?CCL23
	EQUAL?	P-IT-LOC,HERE \?CCL23
	PRINTD	P-IT-OBJECT
	JUMP	?CND19
?CCL23:	GETB	BEG,2 >?TMP1
	GETB	BEG,3
	CALL	WORD-PRINT,?TMP1,STACK
?CND19:	SET	'FIRST??,FALSE-VALUE
?CND3:	ADD	BEG,P-WORDLEN >BEG
	JUMP	?PRG1


	.FUNCT	CAPITALIZE,PTR,?TMP1
	GETB	PTR,3
	GETB	P-INBUF,STACK
	SUB	STACK,32
	PRINTC	STACK
	GETB	PTR,2
	SUB	STACK,1 >?TMP1
	GETB	PTR,3
	ADD	STACK,1
	CALL	WORD-PRINT,?TMP1,STACK
	RSTACK	


	.FUNCT	PREP-PRINT,PREP,WRD
	ZERO?	PREP /FALSE
	PRINTC	32
	CALL	PREP-FIND,PREP >WRD
	PRINTB	WRD
	RTRUE	


	.FUNCT	CLAUSE-COPY,BPTR,EPTR,INSRT=0,BEG,END
	GET	P-CCSRC,BPTR >BEG
	GET	P-CCSRC,EPTR >END
	GET	P-OCLAUSE,P-MATCHLEN
	MUL	STACK,P-LEXELEN
	ADD	STACK,2
	ADD	P-OCLAUSE,STACK
	PUT	P-OTBL,BPTR,STACK
?PRG1:	EQUAL?	BEG,END \?CCL5
	GET	P-OCLAUSE,P-MATCHLEN
	MUL	STACK,P-LEXELEN
	ADD	STACK,2
	ADD	P-OCLAUSE,STACK
	PUT	P-OTBL,EPTR,STACK
	RTRUE	
?CCL5:	ZERO?	INSRT /?CND6
	GET	BEG,0
	EQUAL?	P-ANAM,STACK \?CND6
	CALL	CLAUSE-ADD,INSRT
?CND6:	GET	BEG,0
	CALL	CLAUSE-ADD,STACK
	ADD	BEG,P-WORDLEN >BEG
	JUMP	?PRG1


	.FUNCT	CLAUSE-ADD,WRD,PTR
	GET	P-OCLAUSE,P-MATCHLEN
	ADD	STACK,2 >PTR
	SUB	PTR,1
	PUT	P-OCLAUSE,STACK,WRD
	PUT	P-OCLAUSE,PTR,0
	PUT	P-OCLAUSE,P-MATCHLEN,PTR
	RTRUE	


	.FUNCT	PREP-FIND,PREP,CNT=0,SIZE
	GET	PREPOSITIONS,0
	MUL	STACK,2 >SIZE
?PRG1:	IGRTR?	'CNT,SIZE /FALSE
	GET	PREPOSITIONS,CNT
	EQUAL?	STACK,PREP \?PRG1
	SUB	CNT,1
	GET	PREPOSITIONS,STACK
	RSTACK	


	.FUNCT	SYNTAX-FOUND,SYN
	SET	'P-SYNTAX,SYN
	GETB	SYN,P-SACTION >PRSA
	RETURN	PRSA


	.FUNCT	GWIM,GBIT,LBIT,PREP,OBJ
	EQUAL?	GBIT,RMUNGBIT \?CND1
	RETURN	ROOMS
?CND1:	SET	'P-GWIMBIT,GBIT
	SET	'P-SLOCBITS,LBIT
	PUT	P-MERGE,P-MATCHLEN,0
	CALL	GET-OBJECT,P-MERGE,FALSE-VALUE
	ZERO?	STACK /?CCL5
	SET	'P-GWIMBIT,0
	GET	P-MERGE,P-MATCHLEN
	EQUAL?	STACK,1 \FALSE
	GET	P-MERGE,1 >OBJ
	FSET?	OBJ,VEHBIT \?CND9
	EQUAL?	PREP,PR?DOWN \?CND9
	SET	'PREP,PR?ON
?CND9:	PRINTC	40
	ZERO?	PREP /?CND13
	CALL	PREP-FIND,PREP
	PRINTB	STACK
	PRINTI	" the "
?CND13:	PRINTD	OBJ
	PRINTC	41
	CRLF	
	RETURN	OBJ
?CCL5:	SET	'P-GWIMBIT,0
	RFALSE	


	.FUNCT	SNARF-OBJECTS,PTR
	GET	P-ITBL,P-NC1 >PTR
	ZERO?	PTR /?CND1
	GETB	P-SYNTAX,P-SLOC1 >P-SLOCBITS
	GET	P-ITBL,P-NC1L
	CALL	SNARFEM,PTR,STACK,P-PRSO
	ZERO?	STACK /FALSE
	GET	P-BUTS,P-MATCHLEN
	ZERO?	STACK /?CND1
	CALL	BUT-MERGE,P-PRSO >P-PRSO
?CND1:	GET	P-ITBL,P-NC2 >PTR
	ZERO?	PTR /TRUE
	GETB	P-SYNTAX,P-SLOC2 >P-SLOCBITS
	GET	P-ITBL,P-NC2L
	CALL	SNARFEM,PTR,STACK,P-PRSI
	ZERO?	STACK /FALSE
	GET	P-BUTS,P-MATCHLEN
	ZERO?	STACK /TRUE
	GET	P-PRSI,P-MATCHLEN
	EQUAL?	STACK,1 \?CCL15
	CALL	BUT-MERGE,P-PRSO >P-PRSO
	RTRUE	
?CCL15:	CALL	BUT-MERGE,P-PRSI >P-PRSI
	RTRUE	


	.FUNCT	BUT-MERGE,TBL,LEN,BUTLEN,CNT=1,MATCHES=0,OBJ,NTBL
	GET	TBL,P-MATCHLEN >LEN
	PUT	P-MERGE,P-MATCHLEN,0
?PRG1:	DLESS?	'LEN,0 /?REP2
	GET	TBL,CNT >OBJ
	CALL	ZMEMQ,OBJ,P-BUTS
	ZERO?	STACK \?CND3
	ADD	MATCHES,1
	PUT	P-MERGE,STACK,OBJ
	INC	'MATCHES
?CND3:	INC	'CNT
	JUMP	?PRG1
?REP2:	PUT	P-MERGE,P-MATCHLEN,MATCHES
	SET	'NTBL,P-MERGE
	SET	'P-MERGE,TBL
	RETURN	NTBL


	.FUNCT	SNARFEM,PTR,EPTR,TBL,BUT=0,LEN,WV,WORD,NW
	SET	'P-AND,FALSE-VALUE
	SET	'P-GETFLAGS,0
	SET	'P-CSPTR,PTR
	SET	'P-CEPTR,EPTR
	PUT	P-BUTS,P-MATCHLEN,0
	PUT	TBL,P-MATCHLEN,0
	GET	PTR,0 >WORD
?PRG1:	EQUAL?	PTR,EPTR \?CCL5
	ZERO?	BUT /?PRD8
	PUSH	BUT
	JUMP	?PEN6
?PRD8:	PUSH	TBL
?PEN6:	CALL	GET-OBJECT,STACK
	RSTACK	
?CCL5:	GET	PTR,P-LEXELEN >NW
	EQUAL?	WORD,W?ALL,W?BOTH \?CCL11
	SET	'P-GETFLAGS,P-ALL
	EQUAL?	NW,W?OF \?CND3
	ADD	PTR,P-WORDLEN >PTR
	JUMP	?CND3
?CCL11:	EQUAL?	WORD,W?BUT,W?EXCEPT \?CCL15
	ZERO?	BUT /?PRD20
	PUSH	BUT
	JUMP	?PEN18
?PRD20:	PUSH	TBL
?PEN18:	CALL	GET-OBJECT,STACK
	ZERO?	STACK /FALSE
	SET	'BUT,P-BUTS
	PUT	BUT,P-MATCHLEN,0
	JUMP	?CND3
?CCL15:	EQUAL?	WORD,W?A,W?ONE \?CCL22
	ZERO?	P-ADJ \?CCL25
	SET	'P-GETFLAGS,P-ONE
	EQUAL?	NW,W?OF \?CND3
	ADD	PTR,P-WORDLEN >PTR
	JUMP	?CND3
?CCL25:	SET	'P-NAM,P-ONEOBJ
	ZERO?	BUT /?PRD32
	PUSH	BUT
	JUMP	?PEN30
?PRD32:	PUSH	TBL
?PEN30:	CALL	GET-OBJECT,STACK
	ZERO?	STACK /FALSE
	ZERO?	NW \?CND3
	RTRUE	
?CCL22:	EQUAL?	WORD,W?AND,W?COMMA \?CCL36
	EQUAL?	NW,W?AND,W?COMMA /?CCL36
	SET	'P-AND,TRUE-VALUE
	ZERO?	BUT /?PRD43
	PUSH	BUT
	JUMP	?PEN41
?PRD43:	PUSH	TBL
?PEN41:	CALL	GET-OBJECT,STACK
	ZERO?	STACK \?CND3
	RFALSE	
?CCL36:	CALL	WT?,WORD,8
	ZERO?	STACK /?CCL45
	EQUAL?	PTR,P-CSPTR \?CCL45
	ADD	P-CSPTR,P-WORDLEN >P-CSPTR
	JUMP	?CND3
?CCL45:	CALL	WT?,WORD,4
	ZERO?	STACK \?CND3
	EQUAL?	WORD,W?AND,W?COMMA /?CND3
	EQUAL?	WORD,W?OF \?CCL51
	ZERO?	P-GETFLAGS \?CND3
	SET	'P-GETFLAGS,P-INHIBIT
	JUMP	?CND3
?CCL51:	CALL	WT?,WORD,32,2 >WV
	ZERO?	WV /?CCL55
	CALL	ADJ-CHECK
	ZERO?	STACK /?CCL55
	SET	'P-ADJ,WV
	SET	'P-ADJN,WORD
	SET	'P-ADJECTIVE,WORD
	JUMP	?CND3
?CCL55:	CALL	WT?,WORD,128,0
	ZERO?	STACK /?CND3
	SET	'P-NAM,WORD
	SET	'P-ONEOBJ,WORD
?CND3:	EQUAL?	PTR,EPTR /?PRG1
	ADD	PTR,P-WORDLEN >PTR
	SET	'WORD,NW
	JUMP	?PRG1


	.FUNCT	ADJ-CHECK
	ZERO?	P-ADJ /TRUE
	EQUAL?	P-ADJ,A?FIRST,A?SECOND,A?THIRD /FALSE
	EQUAL?	P-ADJ,A?FOURTH,A?OLD,A?NEW /FALSE
	EQUAL?	P-ADJ,A?SEND,A?RECEIVE,A?KITCHEN /FALSE
	EQUAL?	P-ADJ,A?UPPER,A?LOWER,A?SHUTTL /FALSE
	EQUAL?	P-ADJ,A?ELEVATOR /FALSE
	EQUAL?	P-ADJ,A?SQUARE,A?ROUND,A?GOOD /FALSE
	EQUAL?	P-ADJ,A?SHINY,A?CRACKED,A?FRIED /FALSE
	EQUAL?	P-ADJ,A?TELEPO,A?MINI,A?MINIAT /FALSE
	RTRUE	


	.FUNCT	GET-OBJECT,TBL,VRB=1,BITS,LEN,XBITS,TLEN,GCHECK=0,OLEN=0,OBJ
	SET	'XBITS,P-SLOCBITS
	GET	TBL,P-MATCHLEN >TLEN
	BTST	P-GETFLAGS,P-INHIBIT /TRUE
	ZERO?	P-NAM \?CND3
	ZERO?	P-ADJ /?CND3
	CALL	WT?,P-ADJN,128,0
	ZERO?	STACK /?CND3
	SET	'P-NAM,P-ADJN
	SET	'P-ADJ,FALSE-VALUE
?CND3:	ZERO?	P-NAM \?CND8
	ZERO?	P-ADJ \?CND8
	EQUAL?	P-GETFLAGS,P-ALL /?CND8
	ZERO?	P-GWIMBIT \?CND8
	ZERO?	VRB /FALSE
	PRINTI	"I couldn't find a noun in that sentence!"
	CRLF	
	RFALSE	
?CND8:	EQUAL?	P-GETFLAGS,P-ALL \?CCL17
	ZERO?	P-SLOCBITS \?CND16
?CCL17:	SET	'P-SLOCBITS,-1
?CND16:	SET	'P-TABLE,TBL
?PRG20:	ZERO?	GCHECK /?CCL24
	CALL	GLOBAL-CHECK,TBL
	JUMP	?CND22
?CCL24:	ZERO?	LIT /?CND25
	EQUAL?	WINNER,ADVENTURER /?CND27
	FCLEAR	WINNER,OPENBIT
?CND27:	CALL	DO-SL,HERE,SOG,SIR
	EQUAL?	WINNER,ADVENTURER /?CND25
	FSET	WINNER,OPENBIT
?CND25:	CALL	DO-SL,WINNER,SH,SC
	EQUAL?	WINNER,ADVENTURER /?CND22
	EQUAL?	P-GETFLAGS,P-ALL /?CND22
	CALL	DO-SL,ADVENTURER,SH,SC
?CND22:	GET	TBL,P-MATCHLEN
	SUB	STACK,TLEN >LEN
	BTST	P-GETFLAGS,P-ALL /?CND35
	BTST	P-GETFLAGS,P-ONE \?CCL38
	ZERO?	LEN /?CCL38
	EQUAL?	LEN,1 /?CND41
	RANDOM	LEN
	GET	TBL,STACK
	PUT	TBL,1,STACK
	PRINTI	"(How about the "
	GET	TBL,1
	PRINTD	STACK
	PRINTI	"?)"
	CRLF	
?CND41:	PUT	TBL,P-MATCHLEN,1
?CND35:	SET	'P-SLOCBITS,XBITS
	SET	'P-NAM,FALSE-VALUE
	SET	'P-ADJ,FALSE-VALUE
	RTRUE	
?CCL38:	GRTR?	LEN,1 /?CTR43
	ZERO?	LEN \?CCL44
	EQUAL?	P-SLOCBITS,-1 /?CCL44
?CTR43:	EQUAL?	P-SLOCBITS,-1 \?CCL51
	SET	'P-SLOCBITS,XBITS
	SET	'OLEN,LEN
	GET	TBL,P-MATCHLEN
	SUB	STACK,LEN
	PUT	TBL,P-MATCHLEN,STACK
	JUMP	?PRG20
?CCL51:	ZERO?	LEN \?CND52
	SET	'LEN,OLEN
?CND52:	EQUAL?	WINNER,ADVENTURER /?CCL56
	CALL	CANT-ORPHAN
	RFALSE	
?CCL56:	ZERO?	VRB /?CCL58
	ZERO?	P-NAM /?CCL58
	CALL	WHICH-PRINT,TLEN,LEN,TBL
	EQUAL?	TBL,P-PRSO \?CCL63
	SET	'P-ACLAUSE,P-NC1
	JUMP	?CND61
?CCL63:	SET	'P-ACLAUSE,P-NC2
?CND61:	SET	'P-AADJ,P-ADJ
	SET	'P-ANAM,P-NAM
	CALL	ORPHAN,FALSE-VALUE,FALSE-VALUE
	SET	'P-OFLAG,TRUE-VALUE
	JUMP	?CND54
?CCL58:	ZERO?	VRB /?CND54
	PRINTI	"I couldn't find a noun in that sentence!"
	CRLF	
?CND54:	SET	'P-NAM,FALSE-VALUE
	SET	'P-ADJ,FALSE-VALUE
	RFALSE	
?CCL44:	ZERO?	LEN \?CCL66
	ZERO?	GCHECK /?CCL66
	ZERO?	VRB /?CND69
	SET	'P-SLOCBITS,XBITS
	ZERO?	LIT \?CTR72
	EQUAL?	P-NAM,W?GRUE \?CCL73
?CTR72:	CALL	OBJ-FOUND,NOT-HERE-OBJECT,TBL
	SET	'P-XNAM,P-NAM
	SET	'P-XADJ,P-ADJ
	SET	'P-XADJN,P-ADJN
	SET	'P-NAM,FALSE-VALUE
	SET	'P-ADJ,FALSE-VALUE
	SET	'P-ADJN,FALSE-VALUE
	RTRUE	
?CCL73:	PRINTI	"It's too dark to see!"
	CRLF	
?CND69:	SET	'P-NAM,FALSE-VALUE
	SET	'P-ADJ,FALSE-VALUE
	RFALSE	
?CCL66:	ZERO?	LEN \?CND35
	SET	'GCHECK,TRUE-VALUE
	JUMP	?PRG20


	.FUNCT	MOBY-FIND,TBL,FOO,LEN
	SET	'P-SLOCBITS,-1
	SET	'P-NAM,P-XNAM
	SET	'P-ADJ,P-XADJ
	PUT	TBL,P-MATCHLEN,0
	FIRST?	ROOMS >FOO /?PRG2
?PRG2:	ZERO?	FOO /?REP3
	CALL	SEARCH-LIST,FOO,TBL,P-SRCALL
	NEXT?	FOO >FOO /?PRG2
	JUMP	?PRG2
?REP3:	GET	TBL,P-MATCHLEN >LEN
	ZERO?	LEN \?CND8
	CALL	DO-SL,LOCAL-GLOBALS,1,1
?CND8:	GET	TBL,P-MATCHLEN >LEN
	ZERO?	LEN \?CND10
	CALL	DO-SL,ROOMS,1,1
?CND10:	GET	TBL,P-MATCHLEN >LEN
	EQUAL?	LEN,1 \?CND12
	GET	TBL,1 >P-MOBY-FOUND
?CND12:	SET	'P-NAM,FALSE-VALUE
	SET	'P-ADJ,FALSE-VALUE
	RETURN	LEN


	.FUNCT	WHICH-PRINT,TLEN,LEN,TBL,OBJ,RLEN
	SET	'RLEN,LEN
	PRINTI	"Which"
	ZERO?	P-OFLAG \?CTR2
	ZERO?	P-MERGED \?CTR2
	ZERO?	P-AND /?CCL3
?CTR2:	PRINTC	32
	PRINTB	P-NAM
	JUMP	?CND1
?CCL3:	EQUAL?	TBL,P-PRSO \?CCL8
	CALL	CLAUSE-PRINT,P-NC1,P-NC1L,FALSE-VALUE
	JUMP	?CND1
?CCL8:	CALL	CLAUSE-PRINT,P-NC2,P-NC2L,FALSE-VALUE
?CND1:	PRINTI	" do you mean, "
?PRG9:	INC	'TLEN
	GET	TBL,TLEN >OBJ
	PRINTI	"the "
	PRINTD	OBJ
	EQUAL?	LEN,2 \?CCL13
	EQUAL?	RLEN,2 /?CND14
	PRINTC	44
?CND14:	PRINTI	" or "
	JUMP	?CND11
?CCL13:	GRTR?	LEN,2 \?CND11
	PRINTI	", "
?CND11:	DLESS?	'LEN,1 \?PRG9
	PRINTR	"?"


	.FUNCT	GLOBAL-CHECK,TBL,LEN,RMG,RMGL,CNT=0,OBJ,OBITS,FOO
	GET	TBL,P-MATCHLEN >LEN
	SET	'OBITS,P-SLOCBITS
	GETPT	HERE,P?GLOBAL >RMG
	ZERO?	RMG /?CND1
	PTSIZE	RMG
	SUB	STACK,1 >RMGL
?PRG3:	GETB	RMG,CNT >OBJ
	CALL	THIS-IT?,OBJ,TBL
	ZERO?	STACK /?CND5
	CALL	OBJ-FOUND,OBJ,TBL
?CND5:	IGRTR?	'CNT,RMGL \?PRG3
?CND1:	GETPT	HERE,P?PSEUDO >RMG
	ZERO?	RMG /?CND9
	PTSIZE	RMG
	DIV	STACK,4
	SUB	STACK,1 >RMGL
	SET	'CNT,0
?PRG11:	MUL	CNT,2
	GET	RMG,STACK
	EQUAL?	P-NAM,STACK \?CCL15
	SET	'LAST-PSEUDO-LOC,HERE
	MUL	CNT,2
	ADD	STACK,1
	GET	RMG,STACK
	PUTP	PSEUDO-OBJECT,P?ACTION,STACK
	GETPT	PSEUDO-OBJECT,P?ACTION
	SUB	STACK,5 >FOO
	GET	P-NAM,0
	PUT	FOO,0,STACK
	GET	P-NAM,1
	PUT	FOO,1,STACK
	CALL	OBJ-FOUND,PSEUDO-OBJECT,TBL
	JUMP	?CND9
?CCL15:	IGRTR?	'CNT,RMGL \?PRG11
?CND9:	GET	TBL,P-MATCHLEN
	EQUAL?	STACK,LEN \FALSE
	SET	'P-SLOCBITS,-1
	SET	'P-TABLE,TBL
	CALL	DO-SL,GLOBAL-OBJECTS,1,1
	SET	'P-SLOCBITS,OBITS
	GET	TBL,P-MATCHLEN
	ZERO?	STACK \FALSE
	EQUAL?	PRSA,V?LOOK-INSIDE,V?SEARCH /?CCL25
	EQUAL?	PRSA,V?EXAMINE,V?FIND,V?THROUGH \FALSE
?CCL25:	CALL	DO-SL,ROOMS,1,1
	RSTACK	


	.FUNCT	DO-SL,OBJ,BIT1,BIT2
	ADD	BIT1,BIT2
	BTST	P-SLOCBITS,STACK \?CCL3
	CALL	SEARCH-LIST,OBJ,P-TABLE,P-SRCALL
	RSTACK	
?CCL3:	BTST	P-SLOCBITS,BIT1 \?CCL6
	CALL	SEARCH-LIST,OBJ,P-TABLE,P-SRCTOP
	RSTACK	
?CCL6:	BTST	P-SLOCBITS,BIT2 \TRUE
	CALL	SEARCH-LIST,OBJ,P-TABLE,P-SRCBOT
	RSTACK	


	.FUNCT	SEARCH-LIST,OBJ,TBL,LVL,FLS,NOBJ
	FIRST?	OBJ >OBJ \FALSE
?PRG4:	EQUAL?	LVL,P-SRCBOT /?CND6
	GETPT	OBJ,P?SYNONYM
	ZERO?	STACK /?CND6
	CALL	THIS-IT?,OBJ,TBL
	ZERO?	STACK /?CND6
	CALL	OBJ-FOUND,OBJ,TBL
?CND6:	FSET?	OBJ,INVISIBLE /?CND11
	ZERO?	LVL \?PRD15
	FSET?	OBJ,SEARCHBIT /?PRD15
	FSET?	OBJ,SURFACEBIT \?CND11
?PRD15:	FIRST?	OBJ >NOBJ \?CND11
	FSET?	OBJ,OPENBIT /?CCL12
	FSET?	OBJ,TRANSBIT \?CND11
?CCL12:	ZERO?	LVL \?CCL24
	FSET?	OBJ,SEARCHBIT \?CCL24
	EQUAL?	P-GETFLAGS,P-ALL /?CND11
?CCL24:	FSET?	OBJ,SURFACEBIT \?CCL30
	PUSH	P-SRCALL
	JUMP	?CND28
?CCL30:	FSET?	OBJ,SEARCHBIT \?CCL32
	PUSH	P-SRCALL
	JUMP	?CND28
?CCL32:	PUSH	P-SRCTOP
?CND28:	CALL	SEARCH-LIST,OBJ,TBL,STACK >FLS
?CND11:	NEXT?	OBJ >OBJ /?PRG4
	RTRUE	


	.FUNCT	OBJ-FOUND,OBJ,TBL,PTR
	GET	TBL,P-MATCHLEN >PTR
	ADD	PTR,1
	PUT	TBL,STACK,OBJ
	ADD	PTR,1
	PUT	TBL,P-MATCHLEN,STACK
	RTRUE	


	.FUNCT	TAKE-CHECK
	GETB	P-SYNTAX,P-SLOC1
	CALL	ITAKE-CHECK,P-PRSO,STACK
	ZERO?	STACK /FALSE
	GETB	P-SYNTAX,P-SLOC2
	CALL	ITAKE-CHECK,P-PRSI,STACK
	RSTACK	


	.FUNCT	ITAKE-CHECK,TBL,IBITS,PTR,OBJ,TAKEN
	GET	TBL,P-MATCHLEN >PTR
	ZERO?	PTR /TRUE
	BTST	IBITS,SHAVE /?PRG8
	BTST	IBITS,STAKE \TRUE
?PRG8:	DLESS?	'PTR,0 /TRUE
	ADD	PTR,1
	GET	TBL,STACK >OBJ
	EQUAL?	OBJ,IT \?CND13
	SET	'OBJ,P-IT-OBJECT
?CND13:	CALL	HELD?,OBJ
	ZERO?	STACK \?PRG8
	EQUAL?	OBJ,HANDS /?PRG8
	SET	'PRSO,OBJ
	FSET?	OBJ,TRYTAKEBIT \?CCL21
	SET	'TAKEN,TRUE-VALUE
	JUMP	?CND19
?CCL21:	EQUAL?	WINNER,ADVENTURER /?CCL23
	SET	'TAKEN,FALSE-VALUE
	JUMP	?CND19
?CCL23:	BTST	IBITS,STAKE \?CCL25
	CALL	ITAKE,FALSE-VALUE
	EQUAL?	STACK,TRUE-VALUE \?CCL25
	SET	'TAKEN,FALSE-VALUE
	JUMP	?CND19
?CCL25:	SET	'TAKEN,TRUE-VALUE
?CND19:	ZERO?	TAKEN /?CCL30
	BTST	IBITS,SHAVE \?CCL30
	EQUAL?	OBJ,NOT-HERE-OBJECT \?CND33
	PRINTI	"You don't have that!"
	CRLF	
	RFALSE	
?CND33:	PRINTI	"You don't have the "
	PRINTD	OBJ
	PRINTC	46
	CRLF	
	CALL	THIS-IS-IT,OBJ
	RFALSE	
?CCL30:	ZERO?	TAKEN \?PRG8
	EQUAL?	WINNER,ADVENTURER \?PRG8
	PRINTI	"(Taking the "
	PRINTD	OBJ
	PRINTI	" first)"
	CRLF	
	JUMP	?PRG8


	.FUNCT	HERE?,CAN
?PRG1:	LOC	CAN >CAN
	ZERO?	CAN /?REP2
	EQUAL?	CAN,HERE \?PRG1
	RTRUE	
?REP2:	CALL	GLOBAL-IN?,CAN,HERE
	ZERO?	STACK \TRUE
	EQUAL?	CAN,PSEUDO-OBJECT /TRUE
	RFALSE	


	.FUNCT	HELD?,CAN
?PRG1:	LOC	CAN >CAN
	ZERO?	CAN /FALSE
	EQUAL?	CAN,WINNER \?PRG1
	RTRUE	


	.FUNCT	MANY-CHECK,LOSS=0,TMP,?TMP1
	GET	P-PRSO,P-MATCHLEN
	GRTR?	STACK,1 \?CCL3
	GETB	P-SYNTAX,P-SLOC1
	BTST	STACK,SMANY /?CCL3
	SET	'LOSS,1
	JUMP	?CND1
?CCL3:	GET	P-PRSI,P-MATCHLEN
	GRTR?	STACK,1 \?CND1
	GETB	P-SYNTAX,P-SLOC2
	BTST	STACK,SMANY /?CND1
	SET	'LOSS,2
?CND1:	ZERO?	LOSS /TRUE
	PRINTI	"I can't use multiple "
	EQUAL?	LOSS,2 \?CND12
	PRINTI	"in"
?CND12:	PRINTI	"direct objects with """
	GET	P-ITBL,P-VERBN >TMP
	ZERO?	TMP \?CCL16
	PRINTI	"tell"
	JUMP	?CND14
?CCL16:	ZERO?	P-OFLAG \?CTR17
	ZERO?	P-MERGED /?CCL18
?CTR17:	GET	TMP,0
	PRINTB	STACK
	JUMP	?CND14
?CCL18:	GETB	TMP,2 >?TMP1
	GETB	TMP,3
	CALL	WORD-PRINT,?TMP1,STACK
?CND14:	PRINTI	"."""
	CRLF	
	RFALSE	


	.FUNCT	ZMEMQ,ITM,TBL,SIZE=-1,CNT=1
	ZERO?	TBL /FALSE
	LESS?	SIZE,0 /?CCL5
	SET	'CNT,0
	JUMP	?PRG6
?CCL5:	GET	TBL,0 >SIZE
?PRG6:	GET	TBL,CNT
	EQUAL?	ITM,STACK /TRUE
	IGRTR?	'CNT,SIZE \?PRG6
	RFALSE	


	.FUNCT	ZMEMQB,ITM,TBL,SIZE,CNT=0
?PRG1:	GETB	TBL,CNT
	EQUAL?	ITM,STACK /TRUE
	IGRTR?	'CNT,SIZE \?PRG1
	RFALSE	


	.FUNCT	LIT?,RM,OHERE,LIT=0
	SET	'P-GWIMBIT,ONBIT
	SET	'OHERE,HERE
	SET	'HERE,RM
	FSET?	RM,ONBIT \?CCL3
	SET	'LIT,TRUE-VALUE
	JUMP	?CND1
?CCL3:	PUT	P-MERGE,P-MATCHLEN,0
	SET	'P-TABLE,P-MERGE
	SET	'P-SLOCBITS,-1
	EQUAL?	OHERE,RM \?CND4
	CALL	DO-SL,WINNER,1,1
?CND4:	CALL	DO-SL,RM,1,1
	GET	P-TABLE,P-MATCHLEN
	GRTR?	STACK,0 \?CND1
	SET	'LIT,TRUE-VALUE
?CND1:	SET	'HERE,OHERE
	SET	'P-GWIMBIT,0
	RETURN	LIT


	.FUNCT	PRSO-PRINT,PTR
	ZERO?	P-MERGED \?CTR2
	GET	P-ITBL,P-NC1 >PTR
	GET	PTR,0
	EQUAL?	STACK,W?IT \?CCL3
?CTR2:	PRINTC	32
	PRINTD	PRSO
	RTRUE	
?CCL3:	GET	P-ITBL,P-NC1L
	CALL	BUFFER-PRINT,PTR,STACK,FALSE-VALUE
	RSTACK	


	.FUNCT	THIS-IT?,OBJ,TBL,SYNS,?TMP1
	FSET?	OBJ,INVISIBLE /FALSE
	ZERO?	P-NAM /?CCL5
	GETPT	OBJ,P?SYNONYM >SYNS
	PTSIZE	SYNS
	DIV	STACK,2
	SUB	STACK,1
	CALL	ZMEMQ,P-NAM,SYNS,STACK
	ZERO?	STACK /FALSE
?CCL5:	ZERO?	P-ADJ /?CCL9
	GETPT	OBJ,P?ADJECTIVE >SYNS
	ZERO?	SYNS /FALSE
	PTSIZE	SYNS
	SUB	STACK,1
	CALL	ZMEMQB,P-ADJ,SYNS,STACK
	ZERO?	STACK /FALSE
?CCL9:	ZERO?	P-GWIMBIT /TRUE
	FSET?	OBJ,P-GWIMBIT /TRUE
	RFALSE	

	.ENDI