.H			Copyright (c) 1988-2002, Gary D. Campbell
NAME=PASS2	PASS3
CODE=0D00
0D00		NEXT	-------------	LINK: PASS2   ---------------------
:	Code in this module fans out to a P2xx (xx=type of the .OBJ file)
:	which moves all Global definitions from the NEXT  SymTabs into
:	SYMTAB, so that PASS.3 can do all the final fixups.
:
0D00 PASS.2	ENTRY
0D00		AA=%(BP+DBOT)		Set default DBSE computed by PASS1
0D03		%(BP+DBSE)=AA
0D06		SI,DS=%(BP+FB)		Pointer to File Base (1st .OBJ)
0D09		%(BP+XPT)=@0		Pointer to .OBJ Base Entry in XPATCH
0D0E		DO	CALL SET.PARMS	HL = @ <parm list> for .OBJ type.
0D11			SWAP HL,BP	Push <parm list> addresses
0D13			PUSH %(BP+4)	3rd address = PASS 2 PROC function
0D16			PUSH %(BP+6)
0D19			SWAP HL,BP	--  Push other parms Above  --
0D1B			POP %(BP+SDEF)
0D1E			POP %BP 	--   Pop NEXT  PARMS Here   --
0D21			DI,ES=%(BP+XPT)
0D24			ES:	AA=%DI
0D27			%(BP+CBSE)=AA
0D2A			DI=(DI+4)
0D2D			%(BP+XPT)=DI
0D30			CALL %%BP	Call PROC function for .OBJ type.
0D33			CALL MIN.SI
0D36*			$SI:0
0D39		LOOP UNTIL EQ
0D3B		GOTO CK.UNDEF		Rescan SYMTAB for undef'd symbols.
0D3E INIT.FB	PUSH DS
0D3F		PUSH SI
0D40		CALL SKIP.SYM			Skip to end of SymTab
0D43		AA=%(SI+1)			   & handle 1st fixup
0D46		%(BP+TDA)=AA
0D49*		$SI::0C0
0D4C		IF NZ,
0D4E*			$SI::080	Here, one or both CODE= or DATA=
0D51			AA=%(SI+3)		is present.
0D54			IF NZ,
0D56*				$SI::040	(test DATA= flag)
0D59				AA=%(SI+5)
0D5C		*		IF ZR,EXIT	(no DATA=)
0D5E			ELSE	%(BP+DBSE)=AA	YES: Set DATA=
0D61		POP SI
0D62		POP DS
0D63		RETURN
.PAD=10
0D70 P2FB	ENTRY			Pass 2: filetype=FB
0D70		CALL INIT.FB		Updates CBSE, DBSE, and TDA.
0D73		DO	A=$SI
0D75*			A:0
0D77		*	IF EQ,EXIT
0D79*			A:040		Globals are types 0x,1x,2, & 3x.
0D7B			IF LT,		(Abs, Ext, Code Rel, & Data Rel)
0D7D				PUSH AA
0D7E				CALL SYMDEF	Enter a Global into SYMTAB
0D81				POP AA
0D82*			AA=AA AND 0F
0D85*			SI=SI+AA
0D87		LOOP
0D89		AA=%(BP+TDA)
0D8C*		%(BP+DBSE)=%(BP+DBSE)+AA
0D8F		GOTO SKIP.REM
0D92 SYMDEF	DI,ES=%(BP+SYM) 	Lookup <string> at %(SI+3)
0D95		A=$SI				     _________________
0D97*		AA=AA AND 0F			    /	 (S = Skip)   \
0D9A		DO	ES:	C=$DI		[T S][	DEF  ]<string>[next]
0D9D*			BC=BC AND 0F		 T=0 New Entry (no def)
0DA1			IF ZR,			   1 Quad follow-on entry
0DA3				$DI+=A		   2 Old Def (reset)
0DA4				SWAP AA,BC	   3 Absolute Definition
0DA5				%DI+=AA
0DA6				PUSH SI
0DA7				PUSH BC
0DA8				SI=(SI+3)
0DAB*				BC=BC-03
0DAE				DO UNTIL BC=0
					$DI+=$SI+
					BC=BC-1
				LOOP (BC>0)
0DB0				$DI+=A
0DB1+				DI=DI-1
0DB2				POP AA
0DB3				POP SI
0DB4		*		EXIT		Here we make a new entry.
0DB6*			A:C
0DB8			IF EQ,
0DBA				PUSH SI
0DBB				SI=(SI+3)
0DBE				DI=(DI+3)
0DC1*				BC=BC-03
0DC4				DO UNTIL BC=0
    *					$SI+:$DI+
					BC=BC-1
				LOOP EQ (BC>0)
0DC6				POP SI
0DC7		*		IF EQ,EXIT	Here we find an old entry.
0DC9*			DI=DI+BC
0DCB		LOOP
0DCD*		DI=DI-AA			Re-point DI to Begin Entry
0DCF		GOTO %%(BP+SDEF)		(SI,DS must be preserved)
.PAD=10
001C LST=01C		NEXT  Symbol Table Pointer
0DE0 GET.FB	ENTRY			Get TKN in the NEXT  FB Symbol Table.
0DE0		SI,DS=%(BP+LST)
0DE3 FBLA	DO	BC=%SI		Look Ahead to next instance of TKN.
0DE5*			BC=BC AND 0F
0DE9		*	IF ZR,EXIT
0DEB*			SI=SI+BC
0DED*			$SI::080
0DF0		*	IF ZR,LOOP
0DF2*			A:$(SI+1)
0DF5		*	IF NE,LOOP
0DF7			BC=%(SI+2)
0DFA*			A:0		Return NZ, BC=Definition
0DFC		RETURN
0DFD DUPSYM	AA=@W.2
0E00 DSPSYM	ENTRY
0E00		PUSH BC
0E01		PUSH DS
0E02		PUSH SI
0E03		PUSH ES
0E04		PUSH DI
0E05		ES=CS
0E07		DI=0172
0E0A		BC=%SI
0E0C*		BC=BC AND 0F
0E10*		BC=BC-03
0E13		SI=(SI+3)
0E16		DO UNTIL BC=0
			$DI+=$SI+
			BC=BC-1
		LOOP (BC>0)
0E18		ES:	$DI=B
0E1B		SWAP AA,SI
0E1C		CALL DSPLY
0E1F		POP DI
0E20		POP ES
0E21		POP SI
0E22		POP DS
0E23		POP BC
0E24		RETURN
0E25 CK.UNDEF	SI,DS=%(BP+SYM)
0E28		DO	A=$SI
0E2A*			AA=AA AND 0F
0E2D		*	IF ZR,EXIT
0E2F*			$SI::0F0
0E32			IF ZR,
0E34				PUSH AA
0E35				AA=@W.3
0E38				CALL DSPSYM
0E3B				POP AA
0E3C*			SI=SI+AA
0E3E		LOOP
0E40		RETURN
.PAD=10
0E50 S2FB	ENTRY
0E50		BC=%(SI+1)
0E53 RE.S2FB	DE=@M2FB
0E56		A=$SI			Here, we update a
0E58		ES:	A'=$DI		SYMTAB definition at $DI
0E5B*		AA=AA AND 0F070 	with a NEXT  entry at $SI.
0E5E*		LSR A,4 		A = <SYMTAB Type><NEXT	Type>
0E61*		A=A OR A'
0E63 A.FCN	ENTRY
0E63		SWAP DE,BP		DE = @List of [(byte),(@Function)]..
0E65*		DO	A:$BP		Here we make a branch CALL to
0E68		*	IF EQ,EXIT	one of the Functions on the List.
0E6A			BP=(BP+3)
0E6D*			$BP:0		"A" must match a "byte" in the list
0E71		LOOP UNTIL EQ		     else, [ 0 ],[@error function].
0E73		BP=%(BP+1)
0E76		SWAP DE,BP
0E78		GOTO %DE		All regs unchanged except DE.
0E7A M2FB:	=000,@FB00,001,@FB01,002,@FB02,003,@FB03	NEXT  Type
0E86		=010,@FB10,011,@FB11,012,@FB12,013,@FB13	0=Abs 1=Ext
0E92		=020,@FB20,021,@FB21,022,@FB22,023,@FB23	2=CR  3=DR
0E9E		=030,@FB30,031,@FB31,032,@FB32,033,@FB33,0,@CRASH
0EAD FB00	NEXT		Global $DI=0, NEXT  $SI=0	See prev page
0EAD FB20	NEXT		Global $DI=2, NEXT  $SI=0	for Types of
0EAD FBXX:	ES:	%(DI+1)=BC				symbols in
0EB1*		ES:	$DI=$DI OR 030				SYMTAB.
0EB5		RETURN
0EB6 FB01	NEXT		Global $DI=0, NEXT  $SI=1
0EB6 FB21	NEXT		Global $DI=2, NEXT  $SI=1
0EB6		A=C
0EB8		PUSH SI
0EB9		CALL FBLA	Must Look Ahead (may be a Token Equate)
0EBC		IF NZ,CALL RE.S2FB	(If so, define it)
0EC1		POP SI
0EC2		RETURN
0EC3 FB02	NEXT		Global $DI=0, NEXT  $SI=2
0EC3 FB22	NEXT		Global $DI=2, NEXT  $SI=2
0EC3*		BC=BC+%(BP+CBSE)
0EC6		GOTO FBXX
0EC8 FB03	NEXT		Global $DI=0, NEXT  $SI=3
0EC8 FB23	NEXT		Global $DI=2, NEXT  $SI=3
0EC8*		BC=BC+%(BP+DBSE)
0ECB		GOTO FBXX
0ECD FB10	NEXT		Global $DI=1, NEXT  $SI=0
0ECD FB11	NEXT		Global $DI=1, NEXT  $SI=1
0ECD FB12	NEXT		Global $DI=1, NEXT  $SI=2
0ECD FB13	CALL CRASH	Global $DI=1, NEXT  $SI=3
0ED0 FB30	CALL DUPSYM	Global $DI=3, NEXT  $SI=0
0ED3		GOTO FB00
0ED5 FB31	GOTO FB01	Global $DI=3, NEXT  $SI=1
0ED7 FB32	CALL DUPSYM	Global $DI=3, NEXT  $SI=2
0EDA		GOTO FB02
0EDC FB33	CALL DUPSYM	Global $DI=3, NEXT  $SI=3
0EDF		GOTO FB03
.PAD=10
0EF0 P23X	ENTRY			Pass 2: filetype=3X
0EF0		CALL INIT.3X		Updates CBSE, DBSE, and TDA.
0EF3		DO	A=$SI
0EF5*			A:0
0EF7		*	IF EQ,EXIT
0EF9			PUSH AA 	      Enter a <symbol>
0EFA*			A=A AND 0F0	      into SYMTAB
0EFC*			A:040		      (External)
0EFE			IF NZ,
0F00*				A:060	      (Global)
0F02			IF EQ,CALL SYMDEF
0F07			POP AA
0F08*			AA=AA AND 0F
0F0B*			SI=SI+AA
0F0D		LOOP
0F0F		AA=%(BP+TDA)
0F12*		AA:0
0F14		IF NZ,
0F16			CALL EVAL.AA
0F19			%(BP+DBSE)=HL
0F1C+SKIP.REM:	SI=SI+2
0F1E		DO	A=$SI
0F20*			AA=AA AND 3F
0F23		*	IF ZR,EXIT
0F25*			SI=SI+AA
0F27		LOOP
0F29+		SI=SI+2
0F2B		RETURN
0F2C INIT.3X	PUSH DS
0F2D		PUSH SI
0F2E		CALL INIT.LST			Skip to end of SymTab
0F31*		AA=0				   & handle 1st fixup
0F33*		$SI::080
0F36		IF NZ,			Default TDA = 0
0F38*			$SI::040	Grab an explicit TDA
0F3B			AA=%(SI+1)		(first position)
0F3E			IF NZ,
0F40				AA=%(SI+3)	(second position)
0F43		%(BP+TDA)=AA		Set the TDA for post-PASS2 update
0F46		POP SI			NOTE: CODE= and DATA= declarations
0F47		POP DS			      are handled by XPL & PASS3.
0F48		RETURN
0F49 S23X	ENTRY		If we're looking at LST = 6x [Token]<string>
0F49*		$SI::020	then, we need to EVAL(Token) & update the
0F4C		IF NZ,		Global SYMTAB with an Absolute Definition.
0F4E			AA=%(SI+1)		(Key=0 in <label> Def)
0F51*			A=A OR 6		Request a Word Integer
0F53			CALL EVAL.AA		NZ->Got It; CY->Quad
0F56			IF NZ,			(may advise "DUPSYM")
0F58				PUSH FF
0F59				SWAP HL,BC
0F5B				CALL FBXX	Store the value in SYMTAB
0F5E*				POP FF		(Flag the entry "defined")
0F5F				IF CY,CALL Q.ENTRY	(Quad follow-on)
0F64		RETURN		Bad or No Def-->flagged by CK.UNDEF or PASS3
.PAD=10
0F70 EVAL.AA	ENTRY			(if any possibility that K=Self Rel).
0F70		PUSH DS 	RETURN: NZ-->BC:HL = value (DE=garbage)
0F71		PUSH SI 			NC if Size is OK
0F72		PUSH DI 			CY if Size Error
0F73		PUSH AA 		ZR-->Error	 AA=00000:0
0F74*		DI:048F
0F78		IF GE,
0F7A			NOP
0F7B		CALL EVAL.R
0F7E		POP DE			DE=Token:K, AA=00000:Y, Y=3,7,D,F
0F7F		IF NZ,CALL RESOLVE		Get Y=Fcn(K)
0F84		POP DI			AA=Token:Y, Y=1,2,3,5,6,7
0F85		POP SI
0F86		POP DS		Regs Unchanged: SI,DS,DI,ES,BP=@PARMS
0F87		RETURN
0F88 EVAL.R	PUSH AA 	AA = Token:K (K may = 0-F on CALL)
0F89		PUSH SI 		NZ-->Good Value, AA=00000:K=3,7,D,F
0F8A		CALL EVAL.T		ZR-->Error	 AA=00000:0
0F8D		POP SI
0F8E		POP DE
0F8F		IF NZ,CALL FIX.KEY	AA=000:K, K=Fcn(E)
0F94		RETURN
0F95*EVAL.T	SP:40000
0F99		IF LT,
0F9B*RTN.ZR:		AA=0
0F9D			RETURN		Error:		RTN ZR	AA=0
0F9E		CALL FIND.VAL
0FA1		IF ZR,			External:
0FA3			CALL FIND.T
0FA6			IF ^LE,GOTO RTN.ZR	(no VALUE(<label>)
0FA8			CALL EVAL.DEF		Find <label> in GST, AA=7.
0FAB			RETURN		NC,NZ	BC:HL = Abs Integer Value.
0FAC		AA=%(SI+3)
0FAF*		$SI:0E5
0FB2		IF EQ,GOTO EVAL.R	Evaluate an Equate
0FB4*		$SI:0D6
0FB7		IF EQ,
0FB9			CALL EVAL.R	Evaluate a Unary Expression
0FBC			IF NZ,CALL UNY.OP
0FC1			RETURN		Key=3,7,D,F (or ZR=error)
0FC2*		$SI:0D8
0FC5		IF EQ,
0FC7			CALL EVAL.R	Evaluate a Binary Expression
0FCA			IF NZ,CALL BINY.OP
0FCF			RETURN		Key=3,7,D,F (or ZR=error)
0FD0		SWAP AA,HL
0FD1		BC=%(SI+5)
0FD4*		$SI:0D5
0FD7		IF LT,
0FD9			H=0		Clear upper Byte
0FDB		IF LE,
0FDD*			BC=0		Clear upper Word
0FDF*		AA=0
0FE1*		A=A OR 3		Key=3, <value> = BC:HL
0FE3		RETURN			NC + NZ (Quad Ordinal)
.PAD=10
0FF0*UNY.OP	$(SI+5)::010	Test the UNY.OP Code
0FF4		IF NZ,		Format: x0xxxxxx --> x0uubbbb	[bb]bb =
0FF6*			A::8		x1xxxxxx --> x1uussbb	Biny Op Code
0FF8		*	IF NZ,EXIT			 10 = Word  ss =
0FFA			BC=~BC				 11 = Quad  Size
0FFC			HL=~HL			  uu = 00   = NOP
0FFE*			$(SI+5)::020		       01   = ~ (Ordinal)
1002		*	IF ZR,NEXT		       10   = + (Int NOP)
1004+			HL=HL+1 		       11   = - (Int Neg)
1005			IF ZR,
1007+				BC=BC+1
1008*		ELSE	$(SI+5)::020		Test for INT
100C			IF NZ,
100E*				A=A OR 04		(Set INT)
1010*			A::0F		NZ-->OK
1012			RETURN
1013*		AA=0			ZR-->UNY.OP on Code or Data Relative
1015		RETURN
1016 BINY.OP	CALL UNY.OP
1019		IF NZ,
101B			PUSH BC 	A:BC:HL = Left Operand
101C			PUSH HL
101D			PUSH AA
101E			AA=%(SI+6)
1021			CALL EVAL.R	A:BC:HL = K:Right Operand
1024			POP DE
1025			D=$(SI+5)	D=Op Code (see above)
1028			POP DI
1029			POP SI		E:SI:DI = K:Left Operand
102A		*	IF NZ,EXIT
102C		ELSE	RETURN
102D		SWAP A,D		Get A = BINY.OP (0-A)
102F*		A::040
1031		IF NZ,			need:	bbbbLLRR in A
1033*			A=A AND 3		bbbb = Binary Op Code (0-A)
1035*		A=A-2				LL = f(Left Key)  see TEST.D
1037 BINY.SUB	CALL TEST.D			RR = f(Right Key) see TEST.D
103A		D=E				00 = Ordinal Abs
103C		CALL TEST.D			01 = Integer Abs
103F		A'=A				10 = Code Relative
1041		DE=@BIN.MAP			11 = Data Relative
1044		SWAP HL,DE		------- Begin SWAP HL,DE ---------
1046		CS:	A=$(HL+A)		(BC:DE = Right Operand)
1048*		A:0				(HL = Index to Operator)
104A		IF NE,			A = New Key (from BIN.MAP)
104C			L=A'			0=Error, else 3,7,D,F (Quad)
104E.			RR HL,3 		Get HL = 2 x [Biny Op Code]
1051*			HL=HL AND 1E
1055			CS:	CALL %%(HL+BIN.LIST)
105A		SWAP HL,DE		------- End SWAP HL,DE -----------
105C*		A::0F
105E		RETURN
.PAD=10
:	   LL =  ----ORD---- ----INT---- ----C/R---- ----D/R----
:	   RR =  -- ++ CR DR -- ++ CR DR -- ++ CR DR -- ++ CR DR
1060 BIN.MAP:	=03,07,0D,0F,07,07,0D,0F,0D,0D,00,00,0F,0F,00,00	ADD
1070		=03,07,0D,0F,07,07,0D,0F,0D,0D,07,00,0F,0F,00,07	SUB
1080		=03,07,00,00,07,07,10*0,03,07,00,00,07,07,10*0		MUL/D
10A0		=03,07,00,00,07,07,10*0,07,07,00,00,07,07,10*0		MOD/I
10C0		=07,07,00,00,07,07,10*0,07,07,00,00,07,07,10*0		IML/D
10E0		=03,03,00,00,03,03,10*0,03,03,00,00,03,03,10*0		AND/O
1100		=03,03,00,00,03,03,10*0 				XOR
1110 BIN.LIST:	=@ADD,@SUB,@MUL,@DIV,@MOD,@IMD,@IML,@IDV,@AND,@IOR,@XOR
1126*TEST.D	ASL A,2 	Clear LS 2 bits of A
1129*		D::08		Given D = Key, Set LS 2 bits of A to:
112C		IF NZ,			  (1-3) --> 00 (Ordinal)
112E*			A=A OR 2	  (5-7) --> 01 (Integer)
1130*			D::2		  (C-D) --> 10 (Code Relative)
1133		*	IF NZ,EXIT	  (E-F) --> 11 (Data Relative)
1135 RTN.D:		RETURN			Code Relative
1136*		ELSE	D::4
1139			IF ZR,GOTO RTN.D	Ordinal
113B*		A=A OR 1			Integer | Data Relative
113D		RETURN
113E*ADD:	DE=DE+DI	BC:DE = Right Operand
1140*		BC=BC+CY+SI	SI:DI = Left Operand
1142		RETURN
1143 SUB:	SWAP SI,BC	Swap Left,Right to get:
1145		SWAP DI,DE	BC:DE = Left Operand
1147*		DE=DE-DI	SI:DI = Right Operand
1149*		BC=BC-CY-SI	so that Result = BC:DE
114B		RETURN
114C*MUL:	SI=SI OR BC	Need 0:DE * 0:DI
114E		IF NZ,
1150*			AA=0		(Else result = error)
1152		PUSH AA 	Save code:0X
1153		SWAP AA,DE	Get Right Operand 0.DE --> DE.AA
1154*		DE=0
1156*		DE.AA=AA*DI	Ordinal Multiply by Right Operand = DI
1158		SWAP AA,DE	Get Result into BC.DE
1159		SWAP AA,BC
115A		POP AA		Restore original code:0X
115B		RETURN
115C*IML:	SI=SI OR BC	Identical to MUL, except use `* Operator
115E		IF NZ,
1160*			AA=0		(Else result = error)
1162		PUSH AA 	Save code:0X
1163		SWAP AA,DE	Get Right Operand 0.DE --> DE.AA
1164*		DE=0
1166*		DE.AA=AA*`DI	Integer Multiply by Right Operand = DI
1168		SWAP AA,DE	Get Result into BC.DE
1169		SWAP AA,BC
116A		POP AA		Restore original code:0X
116B		RETURN
116C*AND:	BC=BC AND SI
116E*		DE=DE AND DI
1170		RETURN
1171*IOR:	BC=BC OR SI
1173*		DE=DE OR DI
1175		RETURN
1176*XOR:	BC=BC XOR SI
1178*		DE=DE XOR DI
117A		RETURN
.PAD=10
1180*DIV:	BC:0		Dividing SI.DI / BC.DE
1182		IF ZR,		   Need: DE.AA / BC
1184*			DE:SI
1186		*	IF GT,EXIT
1188*		ELSE	AA=0	Error if BC>0, or DE <= SI
118A*			SI=0
118C			DE=1
118F		SWAP AA,DI
1190		SWAP SI,BC
1192		SWAP DE,BC
1194*		AA=DE.AA/BC
1196*		BC=0		Get Result into BC.DE
1198		SWAP AA,DE
1199		SWAP AA,DI	Restore original code:0X
119A		RETURN
119B*IDV:	BC:0		Identical to DIV, except use `/ Operator
119D		IF ZR,		   Need: DE.AA / BC
119F*			DE:SI
11A1		*	IF GT,EXIT
11A3*		ELSE	AA=0	Error if BC>0, or DE <= SI
11A5*			SI=0
11A7			DE=1
11AA		SWAP AA,DI
11AB		SWAP SI,BC
11AD		SWAP DE,BC
11AF*		AA=DE.AA/`BC
11B1*		BC=0		Get Result into BC.DE
11B3		SWAP AA,DE
11B4		SWAP AA,DI	Restore original code:0X
11B5		RETURN
11B6*MOD:	BC:0		Modulo is like Divide, but Result is
11B8		IF ZR,			left in DE instead of AA.
11BA*			DE:SI
11BC		*	IF GT,EXIT
11BE*		ELSE	AA=0	Error if BC>0, or DE <= SI
11C0*			SI=0
11C2			DE=1
11C5		SWAP AA,DI
11C6		SWAP SI,BC
11C8		SWAP DE,BC
11CA*		DE=DE.AA\BC
11CC*		BC=0		Get Result into BC.DE
11CE		SWAP AA,DI	Restore original code:0X
11CF		RETURN
11D0*IMD:	BC:0		Identical to MOD, except use `\ Operator
11D2		IF ZR,
11D4*			DE:SI
11D6		*	IF GT,EXIT
11D8*		ELSE	AA=0	Error if BC>0, or DE <= SI
11DA*			SI=0
11DC			DE=1
11DF		SWAP AA,DI
11E0		SWAP SI,BC
11E2		SWAP DE,BC
11E4*		DE=DE.AA\`BC
11E6*		BC=0		Get Result into BC.DE
11E8		SWAP AA,DI	Restore original code:0X
11E9		RETURN
.PAD=10
11F0*RESOLVE	AA=AA XOR DE	Here,	DE=Token:K (K=0-F) of caller.
11F2*		AA=AA AND 0F		AA=00000:Y from EVAL.R (Y=3,7,D,F)
11F5*		AA=AA XOR DE		Now, AA=Token:Y BC:HL = Value
11F7		SWAP HL,DE
11F9*		HL=HL AND 0F		Need to branch on original Key
11FD*		HL=HL+HL		HL = 000:K, K = 0-F of caller.
11FF		CS:	HL=%(HL+R.FCN)
1204		SWAP HL,DE		Resolve Y in accordance with K.
1206		GOTO %DE
1208 R.FCN:	=@R.0,@R.1,@R.2,@R.3,@R.0,@R.5,@R.6,@R.7
1218		=@R.0,@R.9,@R.A,@R.B,@R.2,@R.3,@R.2,@R.3
1228*R.0:	A::8	ALL RETURNS FROM HERE ----------------> ARE: NC,NZ.
122A		IF NZ,
122C			SI=DBSE 		K=D,F
122F*			A::2
1231			IF ZR,
1233				SI=CBSE
1236			A=3			K=3 (Quad Ordinal)
1238*			HL=HL+%(BP+SI)
123A*			BC=BC+CY+%(BP+SI+2)	Add CBSE/DBSE to BC:HL
123D+		BC=BC+1
123E		IF NZ,			Key = 3,7
1240+			BC=BC-1
1241		*	IF NZ,EXIT	(BC not 0 or -1)
1243+			BC=BC+1
1244+		ELSE	BC=BC-1 	BC = Original Value (0 or -1)
1245*			A::4
1247			IF NZ,			(Key=7)
1249*				B=B XOR H
124B				B=C	Is sign of H extended into BC ?
124D		*		IF NEG,EXIT
124F+			ELSE	AA=AA-1 	(Key=2,6)	(Word)
1250*				H:C
1252		*		IF NE,EXIT	Is H = Sign Extension ?
1254*				A::4		(Yes)
1256				IF NZ,			(Key=2)
1258*					H=H XOR L	(Key=6)
125A					H=C		(Yes, check L)
125C		*			IF NEG,EXIT	(No, signs not equal)
125E+				AA=AA-1 		(Key=1,5 Byte)
125F		RETURN
.PAD=10
1270 R.1:	CALL R.0	Now, Y=1..3, 5..7
1273*		A=A AND 3
1275*		A::02		And, we want Y=1
1277		IF NZ,
1279.R.S:		CY=1		Size Error (RTN CY+NZ)
127A			RETURN
127B*R.T:	A:0			O.K. (RTN NZ+NZ)
127D		RETURN
127E R.2:	CALL R.1	Now, Y=1..3, 5..7
1281*R.W:	A::01		And, we want Y=2
1283		IF ZR,GOTO R.T		(Have a word, OK if C,E)
1285*		A::02			Byte or Quad (which?)
1287		IF NZ,GOTO R.S		(Quad wanting Word is a Size Error)
1289+		AA=AA+1 		Promote Byte to Word
128A		RETURN			O.K. (RTN NZ+NZ)
128B R.3:	CALL R.7	Here, we get a Quad Integer.
128E*		A=A XOR 4		Flip to Ordinal
1290		RETURN			Return (NC+NZ)
1291 R.5:	CALL R.0
1294*T.1:	A=A OR 4	Now, Y=5..7
1296*		A::2
1298		IF ZR,GOTO R.T	(Byte) O.K.		     (NC+NZ)
129A		GOTO R.S	(Word or Quad) Size Error    (CY+NZ)
129C R.6:	CALL R.5
129F		GOTO R.W
12A1 R.7:	CALL R.0	Here, we want a Quad Integer.
12A4*		A=A OR 7		Promote to Quad
12A6		RETURN			Return (NC+NZ)
12A7 R.9:	CALL R.0	Want Byte Self-Relative
12AA*		A::04
12AC		IF ZR,		(INT-->already Self-Rel)
12AE			PUSH BC
12AF			PUSH HL
12B0			HL=%(BP+CNXT)	Value of Token:Y (Y=3,D,F)
12B3			BC=%(BP+CNXT+2)
12B6			POP DI		Need to compute:
12B7			POP SI			SI:DI - BC:HL
12B8			DE=0303 	Keys of both operands = Quad Absolute
12BB			A=1			(op code = subtract)
12BD			CALL BINY.SUB	Get Self Relative value.
12C0			CALL R.0
12C3		GOTO T.1
12C5 R.A:	CALL R.9	Want Word Self-Relative
12C8		GOTO R.W
12CA R.B:	CALL R.9	Want Quad Self-Relative
12CD*		A=A OR 3
12CF		RETURN
.PAD=10
12E0 LST.3:	=03,03,03,03,03,07,07,07,03,03,03,03,0D,0D,0F,0F
12F0 LST.7:	=03,03,03,03,07,07,07,07,07,07,07,07,0D,0D,0F,0F
1300 LST.D:	=0D,0D,0D,0D,0D,0D,0D,0D,0D,0D,0D,0D,0D,0D,00,00
1310 LST.F:	=0F,0F,0F,0F,0F,0F,0F,0F,0F,0F,0F,0F,00,00,0F,0F
:
1320 FIX.KEY	PUSH HL 	Here,	A = Key from EVAL (3,7,D,F)
1321*		A:0D			E = Key from Caller (0-F)
1323		IF EQ,
1325			HL=@LST.D
1328		IF GT,
132A			HL=@LST.F
132D		IF LT,
132F			HL=@LST.3
1332*			A:07
1334			IF EQ,
1336				HL=@LST.7
1339		SWAP AA,DE
133A*		AA=AA AND 0F
133D		CS:	A=$(HL+A)
133F		POP HL
1340*		AA:0		ZR-->Error	   AA = 000:0
1342		RETURN		NZ-->Valid Value   AA = 000:K
.PAD=10
1350 FIND.T	PUSH HL 	RETURNS: AA,BC,DE,HL,ES,DI,BP unchanged.
1351		SI,DS=%(BP+LST) 	 NZ: SI,DS = SymTab Entry
1354		DO	HL=%(SI+1)	 ZR: SI,DS = End-of-Symtab [0]
1357*			HL=HL XOR AA
1359*			HL::0FFF0	Match Token (disregard :X)
135D		*	IF ZR,EXIT
135F F.NXT:		L=$SI
1361*			HL=HL AND 0F	ONLY branches here are from below.
1365			SI=(HL+SI)
1367		LOOP UNTIL ZR
1369		POP HL			NZ: Token Found (7x,Ax,Bx,Dx,Ex)
136A*RTN.FIND:	$SI:0			ZR: $SI = End-of-SymTab (not found)
136D		RETURN
136E FIND.VAL	CALL FIND.T	Given AA = Token:K Find 1st non-Label entry.
1371*		$SI:0D0
1374		IF GT,GOTO RTN.FIND	NZ: $SI = Entry type Dx-Ex
1376		PUSH HL 		ZR: End of SymTab
1377		GOTO F.NXT
1379 Q.ENTRY	AA=%SI
137B*		AA=AA AND 0F		Here, we make a Quad Entry
137E*		DI=DI+AA		(a type 13 entry used to extend a
1380		ES:	A=$DI			normal type 3X entry)
1383*		A:013
1385		IF EQ,
1387			ES:	%(DI+1)=HL	Replace an Existing Entry.
138B			RETURN
138C*		A:0
138E		IF NE,CALL CRASH	(must be at End-of-SYMTAB)
1393		A=013
1395		$DI+=A
1396		SWAP AA,HL
1397		%DI+=AA
1398*		AA=0
139A		$DI+=A
139B		RETURN
139C EVAL.DEF	PUSH ES 		ONLY CALLED when FIND.T fails.
139D		CALL FIND.DEF		Here, ES,DI = Pointer into SYMTAB
13A0		SWAP HL,DE			(See PASS3 for FIND.DEF)
13A2		ES:	A=$DI
13A5*		AA=AA AND 0F		RETURN: BC:HL = Value from SYMTAB
13A8*		DI=DI+AA
13AA		A=3			A = Absolute Quad Ordinal
13AC		ES:	BC=%(DI+1)	Get follow-on Quad in BC
13B0*		ES:	$DI:013
13B4		IF NE,
13B6*			BC=0
13B8*			H:0		else, sign Extend word into BC
13BA			IF NEG,
13BC+				BC=BC-1
13BD		POP ES			Here, we're done with ES,DI
13BE+		DI=DI-1 			(this just sets NZ)
13BF		RETURN		Flags = NZ,NC
13C0		NEXT
.
0D00 DBOT	0D03 DBSE	0D06 FB 	0D09 XPT
0D0E SET.PARMS	0D1B SDEF	0D27 CBSE	0D33 MIN.SI
0D40 SKIP.SYM	0D46 TDA	0D92 SYM	0DFD W.2
0E1C DSPLY	0E35 W.3	0E9E CRASH	0F2E INIT.LST
12B0 CNXT	139D FIND.DEF