shogun/parser.zap

	.SEGMENT "0"


	.FUNCT	SPECIAL-CONTRACTION?:ANY:1:1,PTR
	GET	PTR,0
	EQUAL?	STACK,W?FO \?CCL3
	GET	PTR,P-LEXELEN
	EQUAL?	STACK,W?APOSTROPHE \?CCL3
	GET	PTR,4
	EQUAL?	STACK,W?C \?CCL3
	RETURN	W?FOC
?CCL3:	GET	PTR,0
	EQUAL?	STACK,W?FOC \FALSE
	GET	PTR,P-LEXELEN
	EQUAL?	STACK,W?APOSTROPHE \FALSE
	GET	PTR,4
	EQUAL?	STACK,W?SLE \FALSE
	RETURN	W?FOCSLE


	.FUNCT	EXPAND-BE-CONTRACTIONS:ANY:0:0,LEN,PTR,OPTR,N,WD,SPWD,L,?TMP1
	GETB	P-LEXV,P-LEXWORDS >LEN
	SET	'PTR,P-LEXV+2
	SET	'OPTR,PTR
	SET	'L,LEN
?PRG1:	SET	'SPWD,FALSE-VALUE
	DLESS?	'L,0 \?CCL5
	PUTB	P-LEXV,P-LEXWORDS,LEN
	RTRUE	
?CCL5:	GET	PTR,0 >WD
	ZERO?	WD /?CCL7
	GET	PTR,P-LEXELEN
	EQUAL?	STACK,W?APOSTROPHE \?CCL7
	GET	P-QA-WORDS1,0
	INTBL?	WD,P-QA-WORDS1+2,STACK >N \?PRD12
	SUB	N,P-QA-WORDS1
	DIV	STACK,2 >N
	GET	P-QA-WORDS2,N >?TMP1
	GET	PTR,4
	EQUAL?	?TMP1,STACK /?CTR6
?PRD12:	CALL2	SPECIAL-CONTRACTION?,PTR >SPWD
	ZERO?	SPWD /?CCL7
?CTR6:	ZERO?	SPWD /?CCL17
	PUSH	8
	JUMP	?CND15
?CCL17:	PUSH	4
?CND15:	ADD	PTR,STACK >?TMP1
	MUL	L,4
	COPYT	?TMP1,PTR,STACK
	ZERO?	SPWD /?CCL20
	PUT	PTR,0,SPWD
	DEC	'L
	DEC	'LEN
	JUMP	?CND18
?CCL20:	GET	P-QB-WORDS-1,N >WD
	PUT	PTR,0,WD
	GET	P-QB-WORDS-2,N >WD
	PUT	PTR,P-LEXELEN,WD
?CND18:	DEC	'L
	DEC	'LEN
	JUMP	?PRG1
?CCL7:	EQUAL?	WD,W?APOSTROPHE \?CCL22
	GET	PTR,P-LEXELEN
	EQUAL?	STACK,W?S /?CCL22
	EQUAL?	OPTR,PTR /?CCL22
	SUB	PTR,4 >WD
	ZERO?	WD /?CCL22
	GETB	WD,2
	ADD	-1,STACK >?TMP1
	GETB	WD,3
	ADD	?TMP1,STACK
	GETB	P-INBUF,STACK
	EQUAL?	STACK,115,122 \?CCL22
	SUB	PTR,P-LEXV
	DIV	STACK,2
	ADD	P-LEXELEN,STACK
	ICALL	MAKE-ROOM-FOR-TOKENS,1,P-LEXV,STACK
	PUT	PTR,P-LEXELEN,W?S
	INC	'L
	INC	'LEN
	JUMP	?PRG1
?CCL22:	ADD	PTR,4 >PTR
	JUMP	?PRG1


	.FUNCT	NAKED-DIR?:ANY:0:0,WCNUM,LEN
	GET	TLEXV,0 >LEN
	ZERO?	LEN /FALSE
	GET	LEN,4 >WCNUM
	ZERO?	WCNUM \?CND3
	GET	LEN,3 >LEN
	GET	LEN,4 >WCNUM
?CND3:	BTST	WCNUM,32768 /FALSE
	BAND	WCNUM,32
	BAND	STACK,32767
	ZERO?	STACK /FALSE
	EQUAL?	P-LEN,1 \?CCL11
	RETURN	LEN
?CCL11:	SUB	TLEXV,P-LEXV
	LESS?	STACK,234 /?CND9
	RETURN	LEN
?CND9:	GET	TLEXV,P-LEXELEN >WCNUM
	EQUAL?	WCNUM,W?COMMA,W?AND \?CND13
	RETURN	LEN
?CND13:	GET	WCNUM,4 >WCNUM
	BAND	WCNUM,32768
	EQUAL?	STACK,-32768 \FALSE
	BAND	WCNUM,32776
	BAND	STACK,32767
	ZERO?	STACK /FALSE
	RETURN	LEN


	.FUNCT	PARSER:ANY:0:0,OWINNER,LEN,N,PV,?TMP1
	ICALL1	PMEM-RESET
	SET	'ERROR-PRIORITY,255
	SET	'ERROR-STRING,FALSE-VALUE
	SET	'OWINNER,WINNER
	GRTR?	P-CONT,0 \?CCL4
	SET	'TLEXV,P-CONT
	ZERO?	VERBOSITY /?CND5
	EQUAL?	PLAYER,WINNER \?CND5
	CRLF	
?CND5:	SET	'P-CONT,FALSE-VALUE
	JUMP	?CND2
?CCL4:	SET	'WINNER,PLAYER
	ZERO?	P-OFLAG \?CND9
	GET	OOPS-TABLE,O-PTR
	ZERO?	STACK \?CND9
	PUT	OOPS-TABLE,O-END,FALSE-VALUE
?CND9:	LOC	WINNER
	IN?	STACK,ROOMS \?CND13
	LOC	WINNER >HERE
?CND13:	ZERO?	LIT /?CCL16
	EQUAL?	HERE,LIT /?CND15
	IN?	LIT,HERE /?CND15
	CALL2	VISIBLE?,LIT
	ZERO?	STACK \?CND15
?CCL16:	CALL1	LIT? >LIT
?CND15:	GET	0,8
	BTST	STACK,F-REFRESH \?CND22
	ICALL1	V-$REFRESH
?CND22:	ZERO?	VERBOSITY /?CND24
	CRLF	
?CND24:	ICALL1	UPDATE-STATUS-LINE
	ICALL1	READ-INPUT
	GETB	P-LEXV,P-LEXWORDS >LEN
	ZERO?	LEN /?CND27
	INTBL?	W?QUOTE,P-LEXV+2,LEN,132 >N \?CND27
	ICALL	FIX-QUOTATIONS,LEN,N
?CND27:	ICALL1	EXPAND-BE-CONTRACTIONS
	GETB	P-LEXV,P-LEXWORDS >P-LEN
	SET	'TLEXV,P-LEXV+2
?CND2:	GET	TLEXV,0
	EQUAL?	STACK,W?PERIOD,W?THEN \?CND31
	ADD	TLEXV,4 >TLEXV
	DEC	'P-LEN
?CND31:	GET	TLEXV,0
	EQUAL?	STACK,W?YOU \?CND33
	ICALL1	IGNORE-FIRST-WORD
?CND33:	GET	TLEXV,0
	EQUAL?	STACK,W?GO,W?TO \?CND35
	ICALL1	IGNORE-FIRST-WORD
?CND35:	ZERO?	P-LEN \?CND37
	ICALL1	BEG-PARDON
	RFALSE	
?CND37:	CALL1	NAKED-DIR? >LEN
	ZERO?	LEN /?CCL41
	PUT	STATE-STACK,0,20
	PUT	DATA-STACK,0,20
	XPUSH	LEN,DATA-STACK /?BOGUS42
?BOGUS42:	ICALL2	RED-SD,1
	SET	'P-CONT,FALSE-VALUE
	SET	'P-OFLAG,0
	SET	'P-WORDS-AGAIN,1
	PUT	OOPS-TABLE,O-END,FALSE-VALUE
	PUT	OOPS-TABLE,O-START,TLEXV
	PUTB	P-LEXV,P-LEXWORDS,P-LEN
	COPYT	P-LEXV,G-LEXV,LEXV-LENGTH-BYTES
	COPYT	P-INBUF,G-INBUF,61
	PUT	PARSE-RESULT,13,0
	PUT	PARSE-RESULT,1,W?WALK
	DEC	'P-LEN
	LESS?	0,P-LEN \TRUE
	ADD	TLEXV,4 >TLEXV
	GET	TLEXV,0 >LEN
	ZERO?	LEN /TRUE
	GET	LEN,4 >LEN
	ZERO?	LEN /TRUE
	BAND	LEN,32768
	EQUAL?	STACK,-32768 \TRUE
	BAND	LEN,32776
	BAND	STACK,32767
	ZERO?	STACK /TRUE
	DLESS?	'P-LEN,1 /TRUE
	ADD	TLEXV,4 >P-CONT
	RTRUE	
?CCL41:	GET	TLEXV,0
	EQUAL?	STACK,W?OOPS,W?O \?CCL53
	CALL2	DO-OOPS,OWINNER
	ZERO?	STACK \?CND39
	RFALSE	
?CCL53:	ZERO?	P-OFLAG \?CND39
	LESS?	P-CONT,1 \?CND39
	PUT	OOPS-TABLE,O-END,FALSE-VALUE
?CND39:	SET	'P-CONT,FALSE-VALUE
	GET	TLEXV,0
	EQUAL?	STACK,W?AGAIN,W?G \?CCL61
	CALL2	DO-AGAIN,OWINNER
	ZERO?	STACK \?CND59
	RFALSE	
?CCL61:	PUTB	P-LEXV,P-LEXWORDS,P-LEN
	COPYT	P-LEXV,G-LEXV,LEXV-LENGTH-BYTES
	COPYT	P-INBUF,G-INBUF,61
	PUT	OOPS-TABLE,O-START,TLEXV
	PUT	OOPS-TABLE,O-LENGTH,P-LEN
	GET	OOPS-TABLE,O-END
	ZERO?	STACK \?CND59
	GETB	P-LEXV,P-LEXWORDS
	MUL	4,STACK >LEN
	DEC	'LEN
	GETB	TLEXV,LEN >?TMP1
	DEC	'LEN
	GETB	TLEXV,LEN
	ADD	?TMP1,STACK
	PUT	OOPS-TABLE,O-END,STACK
?CND59:	SET	'P-WON,FALSE-VALUE
	SET	'P-WALK-DIR,FALSE-VALUE
	CALL2	PARSE-IT,FALSE-VALUE >PV
?PRG66:	ZERO?	PV \?CCL70
	CALL1	PRINT-PARSER-FAILURE >PV
	JUMP	?PRG66
?CCL70:	EQUAL?	PV,1 /FALSE
	PUT	OOPS-TABLE,O-PTR,FALSE-VALUE
	GET	PV,4 >PRSA
	CALL1	GAME-VERB?
	ZERO?	STACK \?CND73
	SET	'P-OFLAG,0
?CND73:	GET	GWIM-MSG,1
	ZERO?	STACK /?CND75
	ICALL1	TELL-GWIM-MSG
	PUT	GWIM-MSG,1,0
?CND75:	GET	GWIM-MSG,2
	ZERO?	STACK /TRUE
	PRINTI	"["""
	GET	GWIM-MSG,2
	ICALL2	NP-PRINT,STACK
	PRINTI	""" meaning "
	GET	GWIM-MSG,3
	ICALL2	THE-PRINT,STACK
	PRINTI	"]
"
	PUT	GWIM-MSG,2,0
	RTRUE	


	.FUNCT	RED-SD:ANY:0:2,N,TYP,V,SYN,NEW-OBJECT
	GET	PARSE-RESULT,1 >V
	GET	W?WALK,3 >SYN
	ZERO?	V /?CCL2
	GET	V,3
	EQUAL?	SYN,STACK /?CND1
?CCL2:	SET	'V,W?WALK
	PUT	PARSE-RESULT,1,V
?CND1:	GET	V,3
	GET	STACK,2
	ADD	STACK,2 >SYN
	PUT	PARSE-RESULT,3,SYN
	GET	SYN,0
	PUT	PARSE-RESULT,4,STACK
	PUT	PARSE-RESULT,7,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	PARSE-IT:ANY:0:1,V,RES,NUM,W,SAV-LEXV,TMP,TV,T2,?TMP1
	PUT	SPLIT-STACK,0,0
	SET	'ERROR-PRIORITY,255
	PUT	ERROR-ARGS,1,0
	SET	'P-OLEN,P-LEN
	SET	'OTLEXV,TLEXV
	SET	'W,WINNER
	SET	'SAV-LEXV,TLEXV
?PRG1:	INC	'NUM
	ICALL2	BE-PATIENT,NUM
	PUT	STATE-STACK,0,20
	XPUSH	1,STATE-STACK /?BOGUS3
?BOGUS3:	PUT	DATA-STACK,0,20
	ICALL1	PMEM-RESET
	SET	'P-WORD-NUMBER,0
	SET	'TLEXV,SAV-LEXV
	SET	'P-LEN,P-OLEN
	SET	'WINNER,W
	COPYT	GWIM-MSG,0,8
	COPYT	PARSE-RESULT,0,PARSE-RESULT-LEN
	CALL2	PARSE-SENTENCE,PARSE-RESULT >RES
	EQUAL?	RES,PARSER-RESULT-AGAIN \?CCL6
	PUT	SPLIT-STACK,0,0
	SET	'ERROR-PRIORITY,255
	SET	'P-OLEN,P-LEN
	SET	'SAV-LEXV,TLEXV
	JUMP	?PRG1
?CCL6:	LESS?	RES,PARSER-RESULT-WON \?REP2
	GET	SPLIT-STACK,0
	ZERO?	STACK /?REP2
	ZERO?	RES /?REP2
?PRG12:	GET	SPLIT-STACK,0 >T2
	SUB	T2,1
	GET	SPLIT-STACK,STACK >TV
	BAND	TV,65280
	ZERO?	STACK /?CCL16
	GET	SPLIT-STACK,T2 >TMP
	BTST	TMP,32768 /?CCL19
	ADD	TV,6
	CALL	GET-TERMINAL-ACTION,TMP,STACK,1 >TV
	JUMP	?CND17
?CCL19:	BAND	TMP,32767 >?TMP1
	ADD	TV,6
	CALL	GET-TERMINAL-ACTION,?TMP1,STACK,0 >TV
?CND17:	ZERO?	TV \?CCL22
	SUB	T2,2 >T2
	PUT	SPLIT-STACK,0,T2
	JUMP	?CND14
?CCL22:	SUB	T2,1
	PUT	SPLIT-STACK,STACK,TV
	JUMP	?REP13
?CCL16:	GET	SPLIT-STACK,T2 >TMP
	EQUAL?	TMP,TV \?CCL24
	SUB	T2,2 >T2
	PUT	SPLIT-STACK,0,T2
?CND14:	ZERO?	T2 \?PRG12
?REP13:	GET	SPLIT-STACK,0
	ZERO?	STACK \?PRG1
?REP2:	ZERO?	P-RESPONDED /?CND29
	SUB	0,NUM
	ICALL2	BE-PATIENT,STACK
?CND29:	EQUAL?	RES,PARSER-RESULT-WON \?CCL33
	RETURN	PARSER-RESULT
?CCL24:	ADD	1,TMP
	PUT	SPLIT-STACK,T2,STACK
	JUMP	?REP13
?CCL33:	ZERO?	RES /TRUE
	RFALSE	


	.FUNCT	PARSE-SENTENCE:ANY:1:1,PR,SPLIT-NUM,RES,WCN,CURRENT-TOKEN,OLD-WCN,CAV,OFFS,T2,CURRENT-ACTION,REDUCTION,?TMP1
	SET	'SPLIT-NUM,-1
	GET	TLEXV,0 >CURRENT-TOKEN
	CATCH	 >PARSE-SENTENCE-ACTIVATION
	ZERO?	CURRENT-TOKEN \?CND1
	CALL2	UNKNOWN-WORD,TLEXV >CURRENT-TOKEN
	ZERO?	CURRENT-TOKEN \?CND1
	RETURN	PARSER-RESULT-DEAD
?CND1:	GET	CURRENT-TOKEN,4 >WCN
	SET	'OLD-WCN,WCN
?PRG5:	EQUAL?	CURRENT-TOKEN,W?S \?CND7
	SUB	TLEXV,4
	GET	STACK,0
	EQUAL?	STACK,W?APOSTROPHE \?CND7
	SET	'OLD-WCN,16
	SET	'WCN,OLD-WCN
?CND7:	ZERO?	WCN \?CCL13
	GET	CURRENT-TOKEN,3
	ZERO?	STACK \?CCL16
	CALL	BUZZER-WORD?,CURRENT-TOKEN,TLEXV
	ZERO?	STACK /?CND17
	MUL	P-LEXELEN,P-WORD-NUMBER
	ADD	STACK,P-LEXSTART
	PUT	OOPS-TABLE,O-PTR,STACK
	RETURN	PARSER-RESULT-DEAD
?CND17:	SET	'CAV,FALSE-VALUE
	JUMP	?CND11
?CCL16:	GET	CURRENT-TOKEN,3 >CURRENT-TOKEN
	GET	CURRENT-TOKEN,4 >OLD-WCN
	SET	'WCN,OLD-WCN
	JUMP	?PRG5
?CCL13:	BTST	OLD-WCN,32768 /?CCL21
	SET	'OFFS,1
	JUMP	?CND19
?CCL21:	SET	'OFFS,0
?CND19:	CALL2	PEEK-PSTACK,STATE-STACK
	GET	ACTION-TABLE,STACK
	GET	STACK,0
	CALL	GET-TERMINAL-ACTION,WCN,STACK,OFFS >CAV
	ZERO?	CAV /?CND22
	BAND	WCN,32767 >?TMP1
	GET	CAV,OFFS
	BCOM	STACK
	BAND	?TMP1,STACK
	ZERO?	STACK /?CND22
	ADD	CAV,6
	CALL	GET-TERMINAL-ACTION,WCN,STACK,OFFS
	ZERO?	STACK /?CND22
	ADD	SPLIT-NUM,2 >SPLIT-NUM
	ADD	SPLIT-NUM,1
	GET	SPLIT-STACK,0 >T2
	GRTR?	STACK,T2 \?CCL29
	INC	'T2
	LESS?	T2,21 /?CND30
	ICALL1	P-NO-MEM-ROUTINE
?CND30:	PUT	SPLIT-STACK,0,T2
	PUT	SPLIT-STACK,T2,CAV
	INC	'T2
	LESS?	T2,21 /?CND32
	ICALL1	P-NO-MEM-ROUTINE
?CND32:	PUT	SPLIT-STACK,0,T2
	BAND	OLD-WCN,32768
	BOR	STACK,WCN
	PUT	SPLIT-STACK,T2,STACK
	JUMP	?CND22
?CCL29:	SUB	SPLIT-NUM,1
	GET	SPLIT-STACK+2,STACK >CAV
	ZERO?	CAV /?CND22
?CND22:	ZERO?	CAV \?CND36
	RETURN	PARSER-RESULT-FAILED
?CND36:	GET	CAV,OFFS
	BAND	WCN,STACK >WCN
?CND11:	ZERO?	CAV /?PST39
	GET	CAV,2 >CURRENT-ACTION
	JUMP	?PRG41
?PST39:	SET	'CURRENT-ACTION,0
?PRG41:	ZERO?	CAV /?CCL45
	BAND	CURRENT-ACTION,65280
	ZERO?	STACK /?CCL45
	ADD	SPLIT-NUM,2 >SPLIT-NUM
	ADD	SPLIT-NUM,1
	GET	SPLIT-STACK,0 >T2
	GRTR?	STACK,T2 \?CCL50
	INC	'T2
	LESS?	T2,21 /?CND51
	ICALL1	P-NO-MEM-ROUTINE
?CND51:	PUT	SPLIT-STACK,0,T2
	GETB	CURRENT-ACTION,0
	PUT	SPLIT-STACK,T2,STACK
	INC	'T2
	LESS?	T2,21 /?CND53
	ICALL1	P-NO-MEM-ROUTINE
?CND53:	PUT	SPLIT-STACK,0,T2
	PUT	SPLIT-STACK,T2,1
	GETB	CURRENT-ACTION,1 >CURRENT-ACTION
	JUMP	?CND43
?CCL50:	GET	SPLIT-STACK+2,SPLIT-NUM
	GETB	CURRENT-ACTION,STACK >CURRENT-ACTION
	JUMP	?CND43
?CCL45:	ZERO?	CAV /?CND43
	ZERO?	CURRENT-ACTION \?CND43
	RETURN	PARSER-RESULT-FAILED
?CND43:	ZERO?	CAV /?CTR59
	LESS?	CURRENT-ACTION,128 \?CCL60
?CTR59:	ZERO?	CAV /?CND63
	XPUSH	CURRENT-TOKEN,DATA-STACK \?CCL67
	XPUSH	CURRENT-ACTION,STATE-STACK /?CND63
?CCL67:	ICALL1	P-NO-MEM-ROUTINE
?CND63:	DLESS?	'P-LEN,1 \?CCL72
	SET	'CURRENT-TOKEN,W?END.OF.INPUT
	ADD	1,P-WORD-NUMBER >P-WORDS-AGAIN
	SET	'P-CONT,FALSE-VALUE
	SET	'P-LEN,0
	JUMP	?CND70
?CCL72:	INC	'P-WORD-NUMBER
	ADD	TLEXV,4 >TLEXV
	GET	TLEXV,0 >CURRENT-TOKEN
	GRTR?	TLEXV,OTLEXV \?CND70
	SET	'OTLEXV,TLEXV
?CND70:	ZERO?	CURRENT-TOKEN \?CCL77
	CALL2	UNKNOWN-WORD,TLEXV >CURRENT-TOKEN
	ZERO?	CURRENT-TOKEN \?CND75
	RETURN	PARSER-RESULT-DEAD
?CCL77:	EQUAL?	CURRENT-TOKEN,W?THEN,W?!,W?PERIOD /?CCL80
	EQUAL?	CURRENT-TOKEN,W?? \?CND75
?CCL80:	SET	'P-WORDS-AGAIN,P-WORD-NUMBER
	DLESS?	'P-LEN,1 /?CCL85
	ADD	TLEXV,4 >P-CONT
	JUMP	?CND75
?CCL85:	SET	'P-CONT,FALSE-VALUE
?CND75:	GET	CURRENT-TOKEN,4 >OLD-WCN
	SET	'WCN,OLD-WCN
	JUMP	?PRG5
?CCL60:	GRTR?	CURRENT-ACTION,128 \?CCL87
	SUB	CURRENT-ACTION,129
	GET	REDUCTION-TABLE,STACK >REDUCTION
	GET	REDUCTION,0 >RES
	ZERO?	RES /?CND90
	FSTACK	RES,STATE-STACK
?CND90:	SET	'CURRENT-REDUCTION,REDUCTION
	SET	'P-RUNNING,TLEXV
	GET	REDUCTION,1 >?TMP1
	GET	REDUCTION,0
	CALL	?TMP1,STACK >RES
	SET	'TLEXV,P-RUNNING
	GRTR?	TLEXV,OTLEXV \?CND92
	SET	'OTLEXV,TLEXV
?CND92:	LESS?	P-LEN,1 \?CCL96
	SET	'CURRENT-TOKEN,W?END.OF.INPUT
	GET	CURRENT-TOKEN,4 >OLD-WCN
	SET	'WCN,OLD-WCN
	JUMP	?CND94
?CCL96:	GET	TLEXV,0
	EQUAL?	CURRENT-TOKEN,STACK /?CND94
	GET	TLEXV,0 >CURRENT-TOKEN
	GET	CURRENT-TOKEN,4 >OLD-WCN
	SET	'WCN,OLD-WCN
?CND94:	SET	'CURRENT-REDUCTION,FALSE-VALUE
	ZERO?	RES \?CTR99
	RETURN	PARSER-RESULT-FAILED
?CTR99:	XPUSH	RES,DATA-STACK /?CND98
	ICALL1	P-NO-MEM-ROUTINE
?CND98:	CALL2	PEEK-PSTACK,STATE-STACK
	GET	ACTION-TABLE,STACK >?TMP1
	GET	REDUCTION,4
	CALL	GET-NONTERMINAL-ACTION,?TMP1,STACK
	XPUSH	STACK,STATE-STACK /?PRG5
	ICALL1	P-NO-MEM-ROUTINE
	JUMP	?PRG5
?CCL87:	POP	DATA-STACK >PARSER-RESULT
	RETURN	PARSER-RESULT-WON


	.FUNCT	GET-TERMINAL-ACTION:ANY:3:3,TYPE,STATE,OFFS,V
	ZERO?	STATE /FALSE
	BAND	TYPE,32767 >TYPE
	SET	'V,STATE
?PRG4:	GET	V,0
	ZERO?	STACK \?CND6
	GET	V,1
	ZERO?	STACK /FALSE
?CND6:	GET	V,OFFS
	BAND	TYPE,STACK
	ZERO?	STACK /?CND10
	RETURN	V
?CND10:	ADD	V,6 >V
	JUMP	?PRG4


	.FUNCT	GET-NONTERMINAL-ACTION:ANY:2:2,STATE,TYPE,V
	GET	STATE,1
	ZERO?	STACK /FALSE
	GET	STATE,1 >V
?PRG4:	GETB	V,0
	ZERO?	STACK /FALSE
	GETB	V,0
	EQUAL?	STACK,TYPE \?CND6
	GETB	V,1
	RSTACK	
?CND6:	ADD	V,2 >V
	JUMP	?PRG4


	.FUNCT	BE-PATIENT:ANY:1:1,NUM,LIM
	SET	'LIM,16
	GETB	0,30
	EQUAL?	STACK,APPLE-2E,APPLE-2C,APPLE-2GS \?CND1
	SET	'LIM,4
?CND1:	LESS?	NUM,0 \?CCL5
	SUB	1,LIM
	LESS?	NUM,STACK \FALSE
	ZERO?	P-RESPONDED /FALSE
	SET	'P-RESPONDED,0
	BUFOUT	TRUE-VALUE
	PRINTR	"]"
?CCL5:	MOD	NUM,LIM
	ZERO?	STACK \FALSE
	EQUAL?	NUM,LIM \?CCL15
	SET	'P-RESPONDED,LIM
	PRINTI	"[Please be patient..."
	JUMP	?CND13
?CCL15:	ZERO?	P-RESPONDED /?CND13
	PRINTC	46
?CND13:	BUFOUT	FALSE-VALUE
	RTRUE	


	.FUNCT	MAIN-LOOP:ANY:0:0,X
?PRG1:	CALL1	MAIN-LOOP-1 >X
	JUMP	?PRG1


	.FUNCT	MAIN-LOOP-1:ANY:0:0,ICNT,OCNT,NUM,OBJ,V,OBJ1,NP,NP1,XX,CNT,TMP
	CALL1	PARSER >P-WON
	ZERO?	P-WON /?CCL3
?PRG4:	GET	PARSE-RESULT,4 >PRSA
	EQUAL?	PRSA,V?UNDO \?CCL8
	SET	'PRSS,FALSE-VALUE
	SET	'PRSQ,FALSE-VALUE
	CALL2	PERFORM,PRSA
	RSTACK	
?CCL8:	ISAVE	 >P-CAN-UNDO
	EQUAL?	P-CAN-UNDO,2 \?CND6
	EQUAL?	PRSA,V?SAVE \?CCL13
	ICALL1	CANT-UNDO
	RFALSE	
?CCL13:	SET	'P-CONT,-1
	ICALL1	V-$REFRESH
	RFALSE	
?CND6:	GET	PARSE-RESULT,5 >P-PRSO
	GET	PARSE-RESULT,6 >P-PRSI
	ZERO?	P-PRSO /?CCL17
	GET	P-PRSO,3
	EQUAL?	INTDIR,STACK \?CCL17
	GET	P-PRSO,4
	GET	STACK,2
	GETB	STACK,6 >P-DIRECTION
	JUMP	?CND15
?CCL17:	ZERO?	P-PRSI /?CND15
	GET	P-PRSI,3
	EQUAL?	INTDIR,STACK \?CND15
	GET	P-PRSI,4
	GET	STACK,2
	GETB	STACK,6 >P-DIRECTION
?CND15:	GET	PARSE-RESULT,1 >P-PRSA-WORD
	SET	'CLOCK-WAIT,FALSE-VALUE
	SET	'ICNT,0
	SET	'OCNT,0
	ZERO?	P-PRSI /?CND23
	GET	P-PRSI,1 >ICNT
	ZERO?	ICNT /?CND23
	SET	'P-MULT,ICNT
?CND23:	ZERO?	P-PRSO /?CND27
	GET	P-PRSO,1 >OCNT
	ZERO?	OCNT /?CND27
	SET	'P-MULT,OCNT
?CND27:	ZERO?	OCNT \?CCL33
	ZERO?	ICNT /?CND31
?CCL33:	EQUAL?	PRSA,V?WALK /?CND31
	ZERO?	P-IT-OBJECT /?CND31
	ZERO?	ICNT /?CND39
	ICALL	MAIN-LOOP-IT,ICNT,P-PRSI
?CND39:	ZERO?	OCNT /?CND31
	ICALL	MAIN-LOOP-IT,OCNT,P-PRSO
?CND31:	ZERO?	OCNT \?CCL45
	SET	'NUM,OCNT
	JUMP	?CND43
?CCL45:	GRTR?	OCNT,1 \?CCL47
	ZERO?	ICNT \?CCL50
	SET	'OBJ,FALSE-VALUE
	JUMP	?CND48
?CCL50:	GET	P-PRSI,3 >OBJ
	GET	P-PRSI,4 >NP
?CND48:	SET	'NUM,OCNT
	JUMP	?CND43
?CCL47:	GRTR?	ICNT,1 \?CCL54
	GET	P-PRSO,3 >OBJ
	GET	P-PRSI,4 >NP
	SET	'NUM,ICNT
	JUMP	?CND43
?CCL54:	SET	'NUM,1
?CND43:	ZERO?	OBJ \?CND57
	EQUAL?	ICNT,1 \?CND57
	GET	P-PRSI,3 >OBJ
	GET	P-PRSI,4 >NP
?CND57:	GET	PARSE-RESULT,12 >V
	ZERO?	V /?CND63
	GET	V,1
	LESS?	1,STACK \?CND63
	GET	V,2
	ZERO?	STACK \?CND63
	PUT	V,2,1
	GET	V,3
	ICALL2	DPRINT,STACK
	PRINTI	":
"
?CND63:	GET	PARSE-RESULT,15 >V
	ZERO?	V /?CCL70
	GET	V,0 >PRSQ
	JUMP	?CND68
?CCL70:	SET	'PRSQ,FALSE-VALUE
?CND68:	GET	PARSE-RESULT,13 >XX
	ZERO?	XX /?CCL73
	GET	XX,3 >PRSS
	JUMP	?CND71
?CCL73:	SET	'PRSS,FALSE-VALUE
?CND71:	ZERO?	LIT \?CCL76
	CALL1	SEE-VERB?
	ZERO?	STACK /?CCL76
	ICALL1	TELL-TOO-DARK
	SET	'P-CONT,-1
	JUMP	?CND74
?CCL76:	EQUAL?	PRSA,V?WALK \?CCL80
	ZERO?	P-WALK-DIR /?PRD83
	PUSH	P-WALK-DIR
	JUMP	?PEN81
?PRD83:	GET	P-PRSO,3
?PEN81:	CALL	PERFORM,PRSA,STACK >V
	JUMP	?CND74
?CCL80:	ZERO?	NUM \?CCL85
	CALL2	PERFORM,PRSA >V
	SET	'PRSO,FALSE-VALUE
	SET	'PRSO-NP,FALSE-VALUE
	JUMP	?CND74
?CCL85:	GRTR?	OCNT,1 \?CCL87
	EQUAL?	PRSA,V?COUNT \?CCL87
	CALL	PERFORM,PRSA,ROOMS >V
	JUMP	?CND74
?CCL87:	SET	'CNT,-1
	SET	'TMP,0
?PRG90:	INC	'CNT
	LESS?	CNT,NUM /?CND92
	ZERO?	TMP \?CND74
	ICALL1	MORE-SPECIFIC
	JUMP	?CND74
?CND92:	MUL	CNT,2
	ADD	NOUN-PHRASE-HEADER-LEN,STACK >XX
	GRTR?	ICNT,1 /?CCL98
	GET	P-PRSO,XX >OBJ1
	ADD	1,XX
	GET	P-PRSO,STACK >NP1
	JUMP	?CND96
?CCL98:	GET	P-PRSI,XX >OBJ1
	ADD	1,XX
	GET	P-PRSI,STACK >NP1
?CND96:	GRTR?	NUM,1 /?CCL100
	GET	NP1,3
	EQUAL?	STACK,NP-QUANT-ALL \?CND99
?CCL100:	CALL	PERF-MANY,OBJ1,OBJ,NP1,STR?1
	ZERO?	STACK /?PRG90
?CND99:	SET	'TMP,TRUE-VALUE
	GRTR?	ICNT,1 /?CCL107
	SET	'PRSO,OBJ1
	SET	'PRSO-NP,NP1
	SET	'PRSI,OBJ
	SET	'PRSI-NP,NP
	JUMP	?CND105
?CCL107:	SET	'PRSO,OBJ
	SET	'PRSO-NP,NP
	SET	'PRSI,OBJ1
	SET	'PRSI-NP,NP1
?CND105:	EQUAL?	IT,PRSI,PRSO,PRSS \?CND108
	CALL	FIX-HIM-HER-IT,IT,P-IT-OBJECT
	ZERO?	STACK /?PRG90
?CND108:	EQUAL?	HER,PRSI,PRSO,PRSS \?CND112
	CALL	FIX-HIM-HER-IT,HER,P-HER-OBJECT
	ZERO?	STACK /?PRG90
?CND112:	EQUAL?	HIM,PRSI,PRSO,PRSS \?CND116
	CALL	FIX-HIM-HER-IT,HIM,P-HIM-OBJECT
	ZERO?	STACK /?PRG90
?CND116:	EQUAL?	THEM,PRSI,PRSO,PRSS \?CND120
	CALL	FIX-HIM-HER-IT,THEM,P-THEM-OBJECT
	ZERO?	STACK /?PRG90
?CND120:	ICALL2	QCONTEXT-CHECK,PRSO
	ZERO?	PRSO /?CND124
	GET	PARSE-RESULT,3
	GETB	STACK,5 >XX
	CALL	TEST-ADJACENT,PRSO,XX
	ZERO?	STACK /?CND126
	ICALL2	NOT-HERE,PRSO
	JUMP	?PRG90
?CND126:	BAND	XX,96
	ZERO?	STACK /?CND124
	BTST	XX,128 /?CND124
	CALL	ITAKE-CHECK,PRSO,XX >V
	EQUAL?	M-FATAL,V /?CND74
	ZERO?	V \?PRG90
?CND124:	ZERO?	PRSI /?CND137
	GET	PARSE-RESULT,3
	GETB	STACK,9 >XX
	CALL	TEST-ADJACENT,PRSI,XX
	ZERO?	STACK /?CND139
	ICALL2	NOT-HERE,PRSI
	JUMP	?PRG90
?CND139:	BAND	XX,96
	ZERO?	STACK /?CND137
	BTST	XX,128 /?CND137
	CALL	ITAKE-CHECK,PRSI,XX >V
	EQUAL?	M-FATAL,V /?CND74
	ZERO?	V \?PRG90
?CND137:	CALL	PERFORM,PRSA,PRSO,PRSI >V
	EQUAL?	M-FATAL,V /?CND74
	EQUAL?	P-CONT,-1 \?PRG90
?CND74:	SET	'OPRSO,PRSO
	ZERO?	CLOCK-WAIT \?CND154
	CALL1	GAME-VERB?
	ZERO?	STACK \?CND154
	LOC	WINNER >V
	ZERO?	V /?CND158
	IN?	V,ROOMS /?CND158
	GETP	V,P?ACTION
	CALL	STACK,M-END >V
?CND158:	GETP	HERE,P?ACTION
	CALL	STACK,M-END >V
	EQUAL?	M-FATAL,V \?CND162
	SET	'P-CONT,-1
?CND162:	SET	'CLOCKER-RUNNING,1
	CALL1	CLOCKER >V
	SET	'CLOCKER-RUNNING,2
	EQUAL?	M-FATAL,V \?CND154
	SET	'P-CONT,-1
?CND154:	GET	PARSE-RESULT,12 >V
	ZERO?	V /?CND1
	GET	V,1
	LESS?	1,STACK \?CND1
	EQUAL?	P-CONT,-1 /?CND1
	CALL2	HACK-TELL-1,V >V
	EQUAL?	M-FATAL,V \?CCL174
	SET	'P-CONT,-1
	JUMP	?CND1
?CCL174:	ZERO?	V /?CND1
	JUMP	?PRG4
?CCL3:	SET	'CLOCK-WAIT,TRUE-VALUE
	SET	'P-CONT,FALSE-VALUE
?CND1:	SET	'PRSA,FALSE-VALUE
	SET	'PRSO,FALSE-VALUE
	SET	'PRSO-NP,FALSE-VALUE
	SET	'PRSI,FALSE-VALUE
	RETURN	PRSI


	.FUNCT	PERF-MANY:ANY:4:4,OBJ1,OBJ,NP1,STR
	EQUAL?	OBJ1,FALSE-VALUE,NOT-HERE-OBJECT \?CCL3
	ICALL2	NP-PRINT,NP1
	PRINT	STR
	ICALL2	NP-CANT-SEE,NP1
	RFALSE	
?CCL3:	GET	NP1,3
	EQUAL?	STACK,NP-QUANT-ALL \?CCL5
	CALL	VERB-ALL-TEST,OBJ1,OBJ
	ZERO?	STACK /FALSE
?CCL5:	CALL2	ACCESSIBLE?,OBJ1
	ZERO?	STACK /FALSE
	EQUAL?	OBJ1,PLAYER /FALSE
	EQUAL?	OBJ1,IT \?CCL14
	ICALL2	DPRINT,P-IT-OBJECT
	JUMP	?CND12
?CCL14:	EQUAL?	OBJ1,PSEUDO-OBJECT \?CCL16
	ICALL2	NP-PRINT,NP1
	JUMP	?CND12
?CCL16:	ICALL2	DPRINT,OBJ1
?CND12:	PRINT	STR
	RTRUE	


	.FUNCT	TEST-ADJACENT:ANY:2:2,OBJ,XX,LO,LW
	ZERO?	OBJ /FALSE
	BTST	XX,128 /FALSE
	BTST	XX,192 /FALSE
	CALL2	META-LOC,OBJ >LO
	ZERO?	LO /FALSE
	IN?	LO,ROOMS \FALSE
	FSET?	LO,TOUCHBIT \FALSE
	CALL2	META-LOC,WINNER >LW
	CALL	GLOBAL-IN?,OBJ,LW
	ZERO?	STACK \FALSE
	EQUAL?	LO,LW /FALSE
	RTRUE	


	.FUNCT	QCONTEXT-CHECK:ANY:1:1,PER,WHO
	EQUAL?	PRSA,V?TELL-ABOUT,V?SHOW \FALSE
	EQUAL?	PER,PLAYER \FALSE
	CALL2	FIND-A-WINNER,HERE >WHO
	ZERO?	WHO /?CND7
	SET	'QCONTEXT,WHO
?CND7:	CALL1	QCONTEXT-GOOD?
	ZERO?	STACK /FALSE
	EQUAL?	WINNER,PLAYER \FALSE
	SET	'WINNER,QCONTEXT
	ICALL2	TELL-SAID-TO,QCONTEXT
	RTRUE	


	.FUNCT	LIT?:ANY:0:2,RM,RMBIT,OHERE,LT
	ASSIGNED?	'RM /?CND1
	SET	'RM,HERE
?CND1:	ASSIGNED?	'RMBIT /?CND3
	SET	'RMBIT,TRUE-VALUE
?CND3:	SET	'OHERE,HERE
	SET	'HERE,RM
	ZERO?	RMBIT /?CCL7
	FSET?	RM,ONBIT \?CCL7
	SET	'LT,HERE
	JUMP	?CND5
?CCL7:	FSET?	WINNER,ONBIT \?CCL11
	CALL	HELD?,WINNER,RM
	ZERO?	STACK /?CCL11
	SET	'LT,WINNER
	JUMP	?CND5
?CCL11:	PUT	SEARCH-RES,1,0
	PUT	SEARCH-RES,2,FALSE-VALUE
	PUT	FINDER,0,ONBIT
	PUT	FINDER,1,FIND-FLAGS-GWIM
	EQUAL?	OHERE,RM \?CND14
	ICALL	FIND-DESCENDANTS,WINNER,7
	EQUAL?	WINNER,PLAYER /?CND14
	IN?	PLAYER,RM \?CND14
	ICALL	FIND-DESCENDANTS,PLAYER,7
?CND14:	GET	SEARCH-RES,1
	ZERO?	STACK \?CND20
	LOC	WINNER
	IN?	STACK,ROOMS /?CND22
	LOC	WINNER
	FSET?	STACK,OPENBIT /?CND22
	LOC	WINNER
	ICALL	FIND-DESCENDANTS,STACK,7
?CND22:	ICALL	FIND-DESCENDANTS,RM,7
?CND20:	GET	SEARCH-RES,1
	LESS?	0,STACK \?CND5
	GET	SEARCH-RES,4 >LT
?CND5:	SET	'HERE,OHERE
	RETURN	LT


	.FUNCT	IGNORE-FIRST-WORD:ANY:0:0,NW
	LESS?	1,P-LEN \FALSE
	GET	TLEXV,P-LEXELEN >NW
	ZERO?	NW /FALSE
	GET	NW,4 >NW
	ZERO?	NW /FALSE
	BTST	NW,32768 /FALSE
	BAND	NW,1
	BAND	STACK,32767
	ZERO?	STACK /FALSE
	ADD	TLEXV,4 >TLEXV
	DEC	'P-LEN
	RTRUE	


	.FUNCT	FIX-QUOTATIONS:ANY:2:2,LEN,PTR,X,QFLAG
	SET	'QFLAG,FALSE-VALUE
?PRG1:	ZERO?	QFLAG \?CCL5
	SET	'QFLAG,TRUE-VALUE
	SUB	PTR,P-LEXV
	DIV	STACK,2
	ADD	2,STACK >X
	ICALL	MAKE-ROOM-FOR-TOKENS,1,P-LEXV,X
	PUT	P-LEXV,X,W?NO.WORD
	JUMP	?CND3
?CCL5:	SET	'QFLAG,FALSE-VALUE
?CND3:	ADD	PTR,4 >PTR
	SUB	PTR,P-LEXV
	DIV	STACK,4 >X
	GETB	P-LEXV,P-LEXWORDS
	SUB	STACK,X >LEN
	ZERO?	LEN /TRUE
	INTBL?	W?QUOTE,PTR,LEN,132 >PTR /?PRG1
	RTRUE	


	.FUNCT	MAIN-LOOP-IT:ANY:2:2,ICNT,PRS,CNT,TOFF
?PRG1:	MUL	CNT,2
	ADD	NOUN-PHRASE-HEADER-LEN,STACK >TOFF
	GET	PRS,TOFF
	EQUAL?	IT,STACK \?CCL5
	CALL2	ACCESSIBLE?,P-IT-OBJECT
	ZERO?	STACK /?CCL5
	PUT	PRS,TOFF,P-IT-OBJECT
	ICALL	TELL-PRONOUN,P-IT-OBJECT,IT
	RTRUE	
?CCL5:	IGRTR?	'CNT,ICNT \?PRG1
	RTRUE	


	.FUNCT	P-NO-MEM-ROUTINE:ANY:0:1,TYP
	PRINTI	"[Sorry, but that"
	EQUAL?	TYP,7 \?CCL3
	PRINTI	"'s too many objects"
	JUMP	?CND1
?CCL3:	PRINTI	" sentence is too complicated"
?CND1:	PRINTI	".]
"
	THROW	PARSER-RESULT-DEAD,PARSE-SENTENCE-ACTIVATION
	RTRUE	


	.FUNCT	BEG-PARDON:ANY:0:0
	PRINTR	"[I beg your pardon?]"


	.FUNCT	UNKNOWN-WORD:ANY:1:1,RLEXV,X
	CALL2	NUMBER?,RLEXV >X
	ZERO?	X /?CCL3
	RETURN	X
?CCL3:	PRINTI	"[I don't know the word """
	SUB	RLEXV,P-LEXV
	DIV	STACK,2
	PUT	OOPS-TABLE,O-PTR,STACK
	ICALL2	WORD-PRINT,RLEXV
	PRINTI	".""]"
	CRLF	
	THROW	PARSER-RESULT-DEAD,PARSE-SENTENCE-ACTIVATION
	RTRUE	


	.FUNCT	WORD-PRINT:ANY:1:3,PTR,LEN,OFFS
	ASSIGNED?	'LEN /?CND1
	GETB	PTR,2 >LEN
?CND1:	ASSIGNED?	'OFFS /?PRG5
	GETB	PTR,3 >OFFS
?PRG5:	DLESS?	'LEN,0 /TRUE
	GETB	P-INBUF,OFFS
	PRINTC	STACK
	INC	'OFFS
	JUMP	?PRG5


	.FUNCT	DO-OOPS:ANY:1:1,OWINNER,PTR,VAL
	SET	'PTR,P-LEXSTART
	GET	TLEXV,P-LEXELEN
	EQUAL?	STACK,W?PERIOD,W?COMMA \?CND1
	ADD	PTR,P-LEXELEN >PTR
	DEC	'P-LEN
?CND1:	GRTR?	P-LEN,1 /?CCL5
	ICALL1	NAKED-OOPS
	RFALSE	
?CCL5:	CALL2	META-LOC,OWINNER
	EQUAL?	HERE,STACK /?CCL7
	ICALL2	NOT-HERE,OWINNER
	RFALSE	
?CCL7:	GET	OOPS-TABLE,O-PTR >VAL
	ZERO?	VAL /?CCL9
	SUB	P-LEN,1
	ICALL	REPLACE-ONE-TOKEN,STACK,P-LEXV,PTR,G-LEXV,VAL
	SET	'WINNER,OWINNER
	ICALL2	COPY-INPUT,TRUE-VALUE
	RTRUE	
?CCL9:	PUT	OOPS-TABLE,O-END,FALSE-VALUE
	ICALL1	CANT-OOPS
	RFALSE	


	.FUNCT	DO-AGAIN:ANY:1:1,OWINNER,N,?TMP1,?TMP2
	CALL2	META-LOC,OWINNER
	EQUAL?	HERE,STACK /?CCL3
	ICALL2	NOT-HERE,OWINNER
	RFALSE	
?CCL3:	LESS?	0,P-OFLAG /?CTR4
	ZERO?	P-WON /?CTR4
	GETB	G-INBUF,2
	ZERO?	STACK \?CCL5
?CTR4:	ICALL1	CANT-AGAIN
	RFALSE	
?CCL5:	GRTR?	P-LEN,1 \?CND1
	SUB	TLEXV,P-LEXV
	LESS?	STACK,234 \?CND1
	GET	TLEXV,P-LEXELEN >N
	EQUAL?	N,W?PERIOD,W?COMMA,W?THEN /?CND1
	EQUAL?	N,W?AND /?CND1
	ICALL1	DONT-UNDERSTAND
	RFALSE	
?CND1:	SET	'N,P-WORDS-AGAIN
	SET	'WINNER,OWINNER
	EQUAL?	N,1 /?CND16
	SUB	N,1
	ADD	P-LEN,STACK >P-LEN
	SUB	N,1 >?TMP2
	SUB	TLEXV,P-LEXV
	DIV	STACK,2 >?TMP1
	GET	OOPS-TABLE,O-START
	SUB	STACK,P-LEXV
	DIV	STACK,2
	ICALL	MAKE-ROOM-FOR-TOKENS,?TMP2,P-LEXV,?TMP1,STACK
	ZERO?	P-CONT /?CND16
	SUB	N,1
	MUL	STACK,4
	ADD	P-CONT,STACK >P-CONT
?CND16:	GET	OOPS-TABLE,O-START
	SUB	STACK,P-LEXV
	ADD	G-LEXV,STACK >?TMP1
	MUL	N,4
	COPYT	?TMP1,TLEXV,STACK
	RTRUE	


	.FUNCT	NP-SAVE:ANY:1:1,ROBJ,TMP
	COPYT	SEARCH-RES,ORPHAN-SR,20
	COPYT	ROBJ,ORPHAN-NP,20
	GET	ROBJ,5 >TMP
	ZERO?	TMP /?CCL3
	GET	TMP,2
	COPYT	STACK,ORPHAN-NP2,10
	PUT	ORPHAN-NP,5,ORPHAN-NP2
	JUMP	?CND1
?CCL3:	GET	ROBJ,4 >TMP
	ZERO?	TMP /?CCL5
	COPYT	TMP,ORPHAN-NP2,20
	PUT	ORPHAN-NP,4,ORPHAN-NP2
	JUMP	?CND1
?CCL5:	GET	ROBJ,6 >TMP
	ZERO?	TMP /?CND1
	COPYT	TMP,ORPHAN-NP2,20
	PUT	ORPHAN-NP,6,ORPHAN-NP2
?CND1:	GET	ROBJ,1 >TMP
	ZERO?	TMP /?CCL9
	COPYT	TMP,ORPHAN-ADJS,18
	PUT	ORPHAN-NP,1,ORPHAN-ADJS
	GET	TMP,2 >TMP
	GRTR?	0,TMP /?CCL12
	GRTR?	TMP,LAST-OBJECT /?CCL12
	PUT	ORPHAN-ADJS,2,TMP
	RETURN	ORPHAN-NP
?CCL12:	COPYT	TMP,ORPHAN-NP2,20
	GET	ORPHAN-NP2,1
	CALL2	PMEM?,STACK
	ZERO?	STACK /?CND15
	PUT	ORPHAN-NP2,1,FALSE-VALUE
?CND15:	PUT	ORPHAN-ADJS,2,ORPHAN-NP2
	RETURN	ORPHAN-NP
?CCL9:	PUT	ORPHAN-NP,1,0
	RETURN	ORPHAN-NP


	.FUNCT	PARSER-ERROR:ANY:0:5,STR,CLASS,OTHER,OTHER2,OTHER3,RP
	ZERO?	CURRENT-REDUCTION /FALSE
	GET	CURRENT-REDUCTION,2 >RP
	GRTR?	ERROR-PRIORITY,RP /?CCL3
	EQUAL?	ERROR-PRIORITY,RP \FALSE
	EQUAL?	CLASS,PARSER-ERROR-ORPH-NP /?CCL3
	EQUAL?	CLASS,PARSER-ERROR-NOUND /FALSE
	GET	ERROR-ARGS,1
	EQUAL?	STACK,PARSER-ERROR-NOUND \FALSE
?CCL3:	SET	'ERROR-PRIORITY,RP
	SET	'ERROR-STRING,STR
	ZERO?	CLASS /?CCL14
	PUT	ERROR-ARGS,0,3
	PUT	ERROR-ARGS,1,CLASS
	PUT	ERROR-ARGS,2,OTHER
	PUT	ERROR-ARGS,3,OTHER2
	CALL2	PMEM?,OTHER
	ZERO?	STACK /FALSE
	GETB	OTHER,1
	EQUAL?	STACK,4 \?CND17
	GET	OTHER,4 >OTHER
?CND17:	GETB	OTHER,1
	EQUAL?	STACK,2 \FALSE
	CALL2	NP-SAVE,OTHER
	PUT	ERROR-ARGS,2,STACK
	EQUAL?	CLASS,PARSER-ERROR-NOOBJ \FALSE
	GET	OTHER,3
	ZERO?	STACK \FALSE
	PUT	ERROR-ARGS,3,OTHER3
	RFALSE	
?CCL14:	PUT	ERROR-ARGS,0,0
	RFALSE	


	.FUNCT	BUZZER-WORD?:ANY:2:2,WD,PTR
	RFALSE	


	.FUNCT	NUMBER?:ANY:1:1,RLEXV,BPTR,SUM,TIM,NEG,CHR,CNT,?TMP1
	GETB	RLEXV,3 >BPTR
	GETB	RLEXV,2 >CNT
?PRG1:	DLESS?	'CNT,0 /?REP2
	GETB	P-INBUF,BPTR >CHR
	EQUAL?	CHR,58 \?CCL8
	SET	'TIM,SUM
	SET	'SUM,0
	JUMP	?CND6
?CCL8:	EQUAL?	CHR,45 \?CCL10
	ZERO?	NEG \FALSE
	SET	'NEG,TRUE-VALUE
	JUMP	?CND6
?CCL10:	GRTR?	CHR,57 /FALSE
	LESS?	CHR,48 /FALSE
	GRTR?	SUM,3276 /FALSE
	MUL	SUM,10 >?TMP1
	SUB	CHR,48
	ADD	?TMP1,STACK >SUM
?CND6:	INC	'BPTR
	JUMP	?PRG1
?REP2:	ZERO?	TIM /?CCL22
	GRTR?	TIM,23 /FALSE
	ZERO?	NEG \FALSE
	MUL	TIM,60
	ADD	SUM,STACK >SUM
	ICALL	CHANGE-LEXV,RLEXV,W?INT.TIM,BPTR,SUM
	RETURN	W?INT.TIM
?CCL22:	ZERO?	NEG /?CND27
	SUB	0,SUM >SUM
?CND27:	ICALL	CHANGE-LEXV,RLEXV,W?INT.NUM,BPTR,SUM
	RETURN	W?INT.NUM


	.FUNCT	CHANGE-LEXV:ANY:2:4,PTR,WRD,BPTR,SUM,X
	PUT	PTR,0,WRD
	SUB	PTR,P-LEXV
	ADD	G-LEXV,STACK >X
	PUT	X,0,WRD
	ASSIGNED?	'BPTR \FALSE
	PUT	PTR,1,SUM
	PUT	X,1,SUM
	SET	'P-NUMBER,SUM
	RETURN	P-NUMBER


	.FUNCT	TELL-GWIM-MSG:ANY:0:0,WD,VB
	PRINTC	91
	GET	GWIM-MSG,0 >WD
	ZERO?	WD /?CND1
	PRINTB	WD
	PRINTC	32
	GET	PARSER-RESULT,1 >VB
	EQUAL?	VB,W?SIT,W?LIE \?CCL5
	EQUAL?	WD,W?DOWN \?CND1
	PRINTI	"on "
	JUMP	?CND1
?CCL5:	EQUAL?	VB,W?GET \?CND1
	EQUAL?	WD,W?OUT \?CND1
	PRINTI	"of "
?CND1:	GET	GWIM-MSG,1
	ICALL2	THE-PRINT,STACK
	PRINTR	"]"

	.ENDSEG

	.ENDI