.H			Copyright (c) 1996, Gary D. Campbell
NAME =MORE	MORE2,PREP,BODY,BACK,USAGE
$$$$ CODE=01000
0000 PARMS	(32)	---------------------- DEXPL ---------------------
1000 PRIMITIVES ENTRY	+ indicates Token, * indicates change w.r.t. PTRAN
1000	=@P.A	+  [space] alpha [alpha|.|digit]..
1002	=@P.B	+* [space] binary = 0|1 [0|1]..
1004	=@P.C	 * cont. optional (SI unchanged or past spaces on NextLine)
1006	=@P.D	 * Match 2+ spaces (bump SI; AA=0, or FAILURE)
1008	=@P.E	 * Verify [d . <comment>] CR (AA=0, or FAILURE)
100A	=@P.F	+  [space] Match file characters
100C	=@P.G	+  [space] Match 'arb' or "arb" (arb=notany(CR))
100E	=@P.H	+* [space] dec [hex]..
1010	=@P.I	+* ' (Match & Tokenize a "prim" suffix)
1012	=@P.J	   Initialize Match(Prep), S: comment, F: otherwise.
1014	=@P.K	   S: Wrapup Prep, F: Initialize for Match(Body)
1016	=@P.L	+* [space] match notany(alpha,control,space | [ ?#)
1018	=@P.M	 * cont. mandatory (SI = Col 6, NextLine or FAILURE)
101A :
101A : ALL PRIMITIVES HAVE 3 CHOICES (NOTE: %SP=RTN to SUC.MORE or DO.MORE):
101A : 1. Emit a Token: CALL ERR.xx; =err,pfx; SI=BeginMatch; AA=Length
101A : 2. Emit no Token: RTN SI=Match+1, AA=0
101A : 3. Fail via CALL GET.RETRY; =err; (directly to SUC.MORE or DO.MORE)
101A :--------- Keep the following consistent with MORE2 (0..53) -----------
0002 EXIT=2	Exit Address for WRAPUP Error (INIT.T)
0004 ADDR=4	Set = $OBJECT (INIT.B)
0008 S.S=8	Source Segment (INIT.T)
000C TOKN=12	Token (FF80+)
000E FLAGS=14	=0 (INIT.P), =255 (1st INIT.B), =CY (2nd INIT.B FAILs)
000F STATE=15	See F.N in MORE2 (set 0 by INIT.F)
0010 A.PTR=16	ALT Skip Byte (set by F.P, ref'd in MORE2)
0050 PREFIX=80	>prefix flag: Set=0 by INIT.T; NZ by F.R, and Ref'd by F.S
0051 ERROR.F=81 	Flags an Error during Wrapup (also Set=0 by INIT.T)
101A CK.BYTE	A=$SI+
101B*		A:" "		RETURN	SI=SI+1 only if 1 space skipped
101D		IF EQ,			EQ: stopshort(space,space)
101F			A=$SI		LT: $SI = control character
1021*			A:" "		GT: $SI = notany(space)
1023		*	IF NE,EXIT
1025		ELSE	SI=(SI-1)
1028 RTN:	RETURN		------- REGISTER USAGE -------
1029 CK.A.NUM	CALL CK.DEC.A	PRIMITIVES:
102C		IF NC,GOTO RTN		AA,HL = Scratch
102E*CK.ALPHA	A:"z"+1 		BC,DE,BP,DS:SI,ES:DI in use.
1030		IF LT,			S: AA=MatchLength, SI=BeginMatch
1032*			A:"a"		   AA=0, SI=@NextSource
1034			RETURN		F: Call GET.RETRY
1035.RTN.CY:	CY=1
1036		RETURN		FUNCTIONS:
1037+FOLLOW.ON	SI=SI+1 		AA,BC = Scratch
1038		A=$SI			DE,HL,BP,ES:DI in use
103A*		A:"."			DS:SI may = > (a prev Emit pointer)
103C		IF NE,GOTO CK.A.NUM	S: Direct RETURN
103E		PUSH SI 		F: CALL FAIL.WRAP or A="error byte"
103F		CALL FOLLOW.ON		   ="error byte"     CALL ERROR.A
1042		POP SI			   FAIL.SET = Alt Entry to FAIL.WRAP
1043		RETURN
1044 CK.DEC	CALL B.SOURCE	RETURN:
1047*CK.DEC.A	A:"9"+1 		NC if in range 0-9
1049		IF GE,GOTO RTN.CY	CY if outside this range
104B*		A:"0"
104D		RETURN
.P
104E CK.HEX	CALL CK.DEC	RETURN:
1051		IF CY,			NC if in range 0-9, A-F
1053*			A:"G"		CY if outside this range
1055			IF GE,GOTO RTN.CY
1057*			A:"A"
1059		RETURN
105A ERR.CY	IF NC,			IF EITHER AA=SI or CY=1
105C ERR.ZR		SWAP AA,SI	THEN GOTO GET.RETRY
105D*			AA=AA-SI	ELSE (AA>SI)
105F			IF NZ,		AA=Length, SI=@Source, CY=0
1061				POP HL
1062				CS:	L=$(HL+1)	Get Token pfx Code
1066				SWAP AA,HL
1067				$DI+=A			Emit it.
1068				SWAP AA,HL		Let SUC emit the
1069				RETURN	(back to SUC)	rest of the Token.
106A		GOTO GET.RETRY
106D P.A	CALL CK.BYTE	[space] alpha [follow.on]..
1070		PUSH SI
1071		CALL CK.ALPHA
1074		IF NC,
1076			DO	CALL FOLLOW.ON
1079			LOOP WHILE NC
107B.			CY=0
107C		POP AA
107D		CALL ERR.CY
1080		="AA"
1082 P.B	CALL CK.BYTE
1085		PUSH SI
1086		DO	A=$SI+
1087*			A:"0"
1089		*	IF EQ,LOOP
108B*			A:"1"
108D		LOOP WHILE EQ
108F+		SI=SI-1 	Last 0|1 fails, so stop short
1090		POP AA
1091		CALL ERR.ZR
1094		="BB"
1096 P.C	CALL CONTINUE		THIS PRIMITIVE DOESN'T FAIL
1099		IF NC,			CY-->No Continuation (SI unchanged)
109B SKIP.SP:		DO	A=$SI+		Otherwise (continuation), and
109C*				A:" "		SI is bumped past ALL Spaces.
109E			LOOP WHILE EQ
10A0+			SI=SI-1
10A1*RTN.ZR:	AA=0			AA=0,SI++ causes Success, and
10A3		RETURN					EMIT No Object Token.
10A4*P.D	%SI:"  "		MATCH (and skip) 2+ Spaces,
10A8		IF EQ,GOTO SKIP.SP			ELSE FAIL.
10AA		CALL GET.RETRY
10AD		="S"
10AE P.E	CALL CK.EOL		Match CR or space (space).. "."
10B1		IF EQ,GOTO RTN.ZR			ELSE FAIL.
10B3		CALL GET.RETRY
10B6		="E"
10B7*P.I	AA=0			match [']
10B9*		$SI:"'"
10BC		IF EQ,
10BE+			AA=AA+1 		Emit only if ' is present.
10BF			ES:	$DI="I"
10C3+			DI=DI+1
10C4		RETURN			Doesn't FAIL
.P
10C5 P.F	CALL CK.BYTE		[space] match file characters
10C8		PUSH SI 		Save index of 1st byte
10C9		DO	CALL FILE.CHR
10CC*			A'=A' XOR 5
10CF		LOOP UNTIL NZ		check bytes until 1 byte too many
10D1+		SI=SI-1 		BACKUP 1
10D2		POP AA			(NC, let ERR.CY detect FAIL=Null)
10D3		CALL ERR.CY
10D6		="FF"
10D8 P.G	CALL CK.BYTE	[space] match Quote Arb Quote
10DB		PUSH SI
10DC*		A:"'"
10DE		IF NE,
10E0*			A:'"'
10E2		*	IF NE,EXIT
10E4		ELSE	A'=A
10E6+			SI=SI+1
10E7			DO	A=$SI+
10E8*				A:A'
10EA		*		IF EQ,EXIT	(LEN = string content + 2)
10EC*				A:CR
10EE			LOOP UNTIL EQ
10F0.			CY=1		Here we FAIL due to premature EOL
10F1		POP AA
10F2		CALL ERR.CY
10F5		="QG"
10F7 P.H	CALL CK.BYTE	[space]
10FA		PUSH SI 	dec [hex].. (range depends on usage)
10FB		CALL CK.DEC
10FE		IF NC,
1100			DO	CALL CK.HEX
1103			LOOP UNTIL CY
1105+		SI=SI-1
1106		POP AA
1107		CALL ERR.ZR
110A		="HH"
110C P.J	CALL CLASSIFY	This is the FIRST ALTERNATIVE OF PREP
110F		IF EQ,RTN	RETURN SUCCESS IF <null line>
1112		PUSH SI 	ELSE, SI not advanced below --> Fail
1113		IF GT,
1115			HL=@CK.LIST-4		Here we "fixup" all
1118			A=$SI			"prep" statements.
111A*			A=A AND 5F		This means rewriting
111C			DO	HL=(HL+4)	columns 1-4 if there
111F*				CS:	$(HL+4):0	is an "=" in
1124			*	IF EQ,EXIT		column 5.
1126*				CS:	A:$HL
1129			LOOP UNTIL EQ
112B			CS:	AA=%HL
112E			%SI=AA
1130			CS:	AA=%(HL+2)
1134			%(SI+2)=AA
1137 RTN.J:	POP AA
1138		CALL ERR.ZR	P.J fails; P.K & P.L both signal ALT = "J"
113B		="=J"					(if they succeed)
113D P.M	CALL CONTINUE
1140		IF CY,			Failure: RTN to SUC.MORE (CY=1)
1142			POP AA		Success: RTN to DO.SUC (AA=0)
1143		RETURN
.P
1144 P.K	PUSH SI 	This primitive
1145		CALL CLASSIFY		SUCCEEDS if column 5 is "="
1148		IF GT,
114A			SI=(SI+5)	and FAILS otherwise.
114D		GOTO RTN.J
114F P.L	CALL CK.BYTE		UNQUOTED LITERAL
1152		PUSH SI
1153		DO	A=$SI+		Match anything but the following:
1154			CALL CK.ALPHA
1157		*	IF NC,EXIT	(rejects a-z)
1159*			A:" "
115B		*	IF LE,EXIT	(rejects SP and control chars)
115D*			A:"|"
115F		*	IF EQ,EXIT
1161*			A:"["		Also reject | and [
1163		*	IF EQ,EXIT
1165*			$SI:"#" 	Look Ahead one character
1168		LOOP WHILE NE		If it's not a #, then LOOP
116A+		SI=SI-1 		ANYTHING ELSE:	Stopshort.
116B		GOTO RTN.J
116D SKIP.CR	DO	A=$SI+
116E*			SI:65520
1172			IF GE,CALL CRASH
1177*			A:CR
1179		LOOP UNTIL EQ
117B+		SI=SI+1
117C EOF.COUNT	PUSH BC 	RETURN AA = MIN(65520, EndSource-SourcePtr)
117D		PUSH DE
117E		PUSH DI 		SI,DS = SourcePointer
117F		PUSH ES
1180		CS:	DI,ES=%FILE.EOF
1185		CALL PTR.DIFF
1188		POP ES
1189		POP DI
118A		POP DE
118B		POP AA
118C		SWAP AA,BC
118D*		AA:0
118F		RETURN
1190 CLASSIFY	CALL COMMENT		LE = EOF or Comment, GT = Other
1193		IF LE,
1195*			AA=0		EQ --> Comment or EOF
1197			RETURN
1198		AA="="
119B*		A:$(SI+4)
119E		IF NE,
11A0			A'=~A'
11A2*		A:A'			LT --> Possible GoodLine
11A4		RETURN			GT --> "=" in Col 5
.PAD=10
11B0 COMMENT	CALL EOF.COUNT	Come here WITH: SI = <begin statement>
11B3*		AA:8			  NEED: SI < CR,LF if EOF or Comment
11B6		IF GE,			  else, SI = same, if GoodLine
11B8			AA=%SI
11BA*			AA:"<<"
11BD			IF EQ,
11BF+				DO	SI=SI+1
11C0*					SI:65520
11C4					IF GE,CALL CRASH
11C9					AA=%SI
11CB*					AA:">>"
11CE		*			IF EQ,EXIT
11D0*					A:CR
11D2				*	IF NE,LOOP
11D4					CALL EOF.COUNT
11D7*					AA:14		LF>>LFxxxx xLF[eof]
11DA				LOOP WHILE GE
11DC		*		EXIT
11DE*			CS:	A:$PERIOD
11E3		*	IF EQ,EXIT
11E5			PUSH BC
11E6			PUSH SI
11E7			BC=6
11EA			DO	A=$SI+
11EB*				A:CR
11ED			*	IF EQ,EXIT
11EF*				A:":"
11F1				BC=BC-1
			LOOP NE (BC>0)
11F3			POP SI		RETURN:
11F4			POP BC			GT = Possible GoodLine
11F5		*	IF EQ,EXIT			     (SI unchanged)
11F7.			CY=0			LT = EOF     (SI < CR,LF)
11F8		RETURN				EQ = Comment (SI < CR,LF)
11F9 CONTINUE	CALL CK.EOL
11FC		IF EQ,
11FE			PUSH SI 	This Function Moves SI to Column 6
11FF			CALL SKIP.CR		of a Continuation Line, or
1202			CALL CLASSIFY		it leaves SI unchanged.
1205			POP AA		A Continuation Line is a GoodLine
1206			SWAP AA,SI		following the Current Line,
1207		*	IF GE,EXIT			IF $SI = "  " or CR.
1209			SWAP AA,SI
120A			CS:	AA=%OBJECT	It also updates Columns 1-5
120E			CALL WRITE.HEX		of the Continuation Line.
1211+			SI=SI+1
1212*			AA=0		RETURN	NC: Continuation, SI Bumped.
1214			RETURN			CY: No Continuation.
1215.		CY=1				    (SI unchanged)
1216		RETURN
1217 CK.EOL	PUSH SI 		End-of-Line in DEXPL is signalled
1218		CALL SKIP.SP		by CR, or "  ."
121B		A=$SI
121D*		A:CR
121F		IF NE,
1221*			%(SI-2):"  "
1226		*	IF NE,EXIT
1228*			CS:	A:$PERIOD
122D		POP SI
122E		RETURN
.PAD=10
000C PB.OFF=12	OFFSET to contents of PARMBYTE
0017 BW.OFF=23	OFFSET to contents of BASEWORD
1230 I.SYM:	=11,@0F0,"PARMBYTE",11,@0,"BASEWORD",02B,@0,"DEXPLDEF"
1251 E.SYM	NEXT
1251 INIT.F	ENTRY		Initialize on behalf of entire source file
1251*		AA=0
1253		%ERR.CNT=AA
1256		%PARMS+FLAGS=AA
1259		%PARMS+TOKN=@0FF80
125F		CALL FILE.POINT
1262		SWAP ES,DS		$(SI,DS) = <filename>.<ext>
1266		SWAP SI,DI		$(DI,ES) = Symtab 1st entry
1268		A=0FB		Need Init Symtab = <sig><adr><rootfile>,0
126A		$DI+=A				    0FB,0,0,<sourcefile>,0
126B*		AA=0					    (pad w/Spaces)
126D		%DI+=AA
126E		DO	$DI+=$SI+
126F*			$SI:"."
1272		LOOP UNTIL EQ
1274		AA="  "
1277		%DI+=AA
1278		%DI+=AA
1279		%DI+=AA
127A		%DI+=AA
127B		SI=@I.SYM		BASE=<hex> resets $BW.OFF(word) F.H
127E		DI=@PB.OFF-1		[<parms>].. reset $PB.OFF(bits) F.B
1281		BC=@E.SYM-I.SYM 	[xxxx0000]
1284		DO UNTIL BC=0		 |||^- 1=Word, 0=Quad
			$DI+=$SI+	 ||^- 1=Little, 0=Big Endian
			BC=BC-1 	 ^^- =Version (0,1,2,3)
		LOOP (BC>0)		 MSB later signifies "Use Default
1286		%SYMTAB=DI			Load Address"
128A		SWAP AA,BC		 (see F.B and F.H for actual code)
128B		%DI+=AA 	SymTab set to start at @0-word terminator
128C		ES=CS			of the BASE_WORD entry.
128E		RETURN
128F NEXT.LINE	ENTRY
128F		CS:	SI,DS=%FILE.PTR 	Get pointers positioned
1294		CALL EOF.COUNT			for another line of source.
1297		SWAP AA,BC			RTN CY if too near the EOF.
1298		DO UNTIL BC=0
129A			A=$SI+
129B*			A:CR
129D			BC=BC-1
		LOOP NE (BC>0)
129F+		SI=SI+1 		LFxxxx xLF
12A0		CALL MIN.SI		 ^BC------^EOF
12A3		AA=DS			  (min = 9)
12A5		DS=CS
12A7*		BC:9
12AA		IF GE,
12AC			%FILE.PTR+2=AA
12AF			%FILE.PTR=SI
12B3		RETURN
.PAD=10
12C0 CK.LIST:	="BASE","NAME",51*0	(CK.LIST = End-of-E.LIST)
12FB INIT.P	ENTRY
12FB		BP=@PREP	Call to INIT before call MATCH(prep)
12FE		DE=(BP+2)		BP = prep main statement alts
1301		BP=%BP			DE = prep subpatterns
1304		AA=@E.O.CODE		reset End-of-Memory Pointer
1307*		A'=A'+2
130A		A=0		E.O.MEM controls ALLOCATION & Stack Overflow
130C		%E.O.MEM=AA
130F		AA=%TOKENS+2
1312		ES=AA		ES = Token Segment
1314*		AA=0		DI will Index EOF of Tokens (until WRAPUP)
1316		$PARMS+FLAGS=A
1319		SWAP AA,DI		DI,ES = Match Object (Token Stream)
131A		SI,DS=%FILE.PTR 	SI,DS = Match Source
131E		CS:	%MAX.SRC=SI
1323		CS:	%COLUMN1=SI
1328		RETURN
1329 INIT.B	ENTRY		Initialize before call MATCH(body)
1329		DS=CS
132B		BP=@BODY
132E		DE=(BP+2)
1331		BP=%BP
1334*		$PARMS+FLAGS=$PARMS+FLAGS+255
1339		IF NC,
133B			AA=%OBJECT
133E			%PARMS+ADDR=AA		Object Index of Initial ALT
1341			SI,DS=%FILE.PTR
1345			CALL WRITE.HEX
1348+			SI=SI+1
1349.			CY=0
134A		RETURN
134B INIT.T	ENTRY		Init for Token --> Object Translation.
134B		BP=@PARMS
134E		HL=@BACK
1351		%BP=HL			%BP=@BACK Subpatterns
1354		CS:	HL=%HL		HL=%BACK (1st Pattern)
1357		SWAP DE,DI		DE=End-of-Tokens
1359*		DI=0
135B		%(BP+EXIT)=SP		Set an Exit Address
135E		CS:	%FILE.PTR=SI	Update SourcePtr; can't BACKUP now
1363		%(BP+S.S)=DS		Save the Source Segment Register
1366		%(BP+PREFIX)=@0 	Reset the >prefix flag & ERROR.F
136B		RETURN
136C FAIL.SET	ENTRY
136C*		ES:	$(DI-4):-1
1371		IF NE,
1373			ES:	AA=%(DI-2)
1377			CS:	%MAX.SRC=AA
13A0 :		<fall into FAIL.WRAP>
.P
137B FAIL.WRAP	ENTRY
137B		POP SI			Code this page is
137C		CS:	A=$SI			ALMOST identical to PTRAN.
137F ERROR.A	ENTRY
137F*		$(BP+ERROR.F)=$(BP+ERROR.F) OR 1
1383		CS:	$ERR.FLG=A
1387 F.E:	SP=%(BP+EXIT)
138A ERROR	ENTRY			CALLED from TRANSLATE or WRAPUP.
138A		CS:	DS=%FILE.PTR+2	When both MATCH(prep) and MATCH(body)
138F		CS:	SI=%COLUMN1	OR WRAPUP can't handle statement.
1394*		$(SI+4):"="				(column 5)
1398		IF EQ,			Kxxx=arb
139A+			SI=SI+1 	Knn?=arb	(column 2)
139B ERR.1:		%(SI+2)="?="
13A0			CS:	AA=%MAX.SRC
13A4*			CS:	AA=AA-%COLUMN1
13A9*			AAM		A'=10's, A=1's (Decimal Number)
13AB*			AA=AA OR "00"
13AE			SWAP A,A'
13B0*			A:"9"
13B2			IF GT,
13B4				A="9"		(max=99)
13B6			%SI=AA
13B8 BUMP.E.CNT 	ENTRY
13B8			CS:	A=$ERR.CNT
13BC*			A=A+01
13BE*			DAA		Keep a BCD ERR.CNT
13BF			IF CY,
13C1				A=099		(max=99)
13C3			CS:	$ERR.CNT=A
13C7			RETURN
13C8		CS:	A=$ERR.FLG		xxxx+label
13CC		$(SI+4)=A			nn?=xlabel
13CF		GOTO ERR.1
.PAD=10
13E0 FUNCTIONS	ENTRY	---- NOTE: F.I thru F.N, & F.Q are in MORE2 ----
13E0	=@F.0	Pattern Post-Processing
13E2	=@F.A	a.num Reference (=PTRAN)
13E4	=@F.B	BASE= [parm].. masks PARMBYTE in SymTab
13E6	=@F.C	updates skip field for pattern "alt" (=PTRAN)
13E8	=@F.D	a.num Definition (=PTRAN)
13EA	=@F.E	error (in a PREP statement) (=PTRAN)
13EC	=@F.F	NAME= <file> updates SymTab (=PTRAN)
13EE	=@F.G	'literal' LITERAL (=PTRAN's F.G & F.H)
13F0	=@F.H	hex (for BASE=)
13F2	=@F.I	maps: prim...prim' --> [override] prim ... [m]
13F4	=@F.J	records index to < prefix (for a Macro Statement)
13F6	=@F.K	Konstant <binary> (1 byte)
13F8	=@F.L	Length + <binary> (2 bytes until compressed)
13FA	=@F.M	mash the [field..field] emits together.
13FC	=@F.N	handles State-Change (Sequence) & Wrapup of Blocks
13FE	=@F.O	If prev = 0 | 8, then OBJECT=OBJECT-1
1400	=@F.P	Sets A.PTR = Current Object Index (used by F.I)
1402	=@F.Q	See: EMIT(60) ref (verifies ref=@prim, not a field)
1404	=@F.R	Set >prefix flag
1406	=@F.S	Check >prefix flag; if ZR, emit "p" (CALL CK.EOL)
1408	=16*0
1418 F.O:	CALL GET.EMIT
141B*		$(SI-1):0
141F		IF NE,
1421*			$(SI-1):8
1425		*	IF NE,EXIT
1427+		ELSE	CS:	%OBJECT=%OBJECT-1
142C		RETURN
142D GET.TOKEN	ENTRY
142D		DS=%(BP+S.S)
1430		ES:	SI=%(DI+2)
1434		ES:	C=$(DI+1)
1438		B=0
143A		RETURN
143B F.A:	BC=04049	Reference <a.num> from State = 3, 4, or 5.
143E*		$(BP+STATE):5	Error = "I"	4X = Pattern (3 or 4)
1442		IF EQ,		(Inconsistent)	8X = Object  (5)
1444			B=080	Error handled in LOOKUP.T
1446		CALL LOOKUP.T			EMIT (A = Ref Token)
1449		GOTO EMIT.A
144C F.D:	BC=04049	Define <a.num> from State = 3 or 5.
144F		AA=%(BP+ADDR)			4X = Pattern
1452*		$(BP+STATE):5			8X = Object
1456		IF EQ,
1458			CS:	AA=%OBJECT
145C			B=080		Error = "I"nconstent
145E		GOTO DEFINE.V		(FAIL.WRAP called from DEFINE)
14B5 :			----------Other Error Codes-----------
14B5 :	D = Duplicate Symbol or Alt	> = Overflow or Overrun
14B5 :	R = Recursion			Y = Synonym Error
14B5 :	' = Bad use of ' Suffix 	O = Statement Order
14B5 :	P = Prefix Error		S = Statement Sequence Error
14B5 :	I = Inconsistency		^ = Infinite Recursion
14B5 :	U = Undefined Symbol		? = Unexpected Error
14B5 :
14B5 :
.PAD=10
1470 F.0:	PUSH DE
1471		PUSH HL
1472		PUSH ES
1473		PUSH DI
1474		CALL CK.LEFT
1477		CALL SORT.ALTS
147A		CALL F.1
147D		POP DI
147E		POP ES
147F		POP HL
1480		POP DE
1481		RETURN
1482+F.B:	HL=HL+1 		Get the EMIT code in the next
1483		CS:	A=$(HL+1)	Pattern Element.  Use it to AND
1487		SI=PB.OFF		with the Symtab entry "PARMBYTE."
148A		CS:	DS=%SYMTAB+2
148F*		$SI=$SI AND A
1491		RETURN
1492 F.C:	CALL GET.SKIP		Look at the previous Prefix
1495*		B:020
1498		IF LT,
149A*			AA:1
149D		*	IF EQ,EXIT
149F			PUSH AA
14A0			A=7F
14A2			CALL EMIT.A
14A5			POP AA
14A6+			AA=AA+1
14A7*		ELSE	AA:3F			IS skip distance > 3F ?
14AA		*	IF LE,EXIT
14AC			CALL FAIL.WRAP
14AF			=">"
14B0*		$SI=$SI OR A
14B2		RETURN
14B3 F.H:	PUSH HL
14B4		CALL GET.TOKEN		Here, we convert source to hex
14B7*		HL=0
14B9		DO	A=$SI+
14BA*			A:"A"
14BC			IF GE,
14BE*				A=A+9	Bump A=41 +9 (to 4A)
14C0*			A=A AND 0F	and take LS 4 bits.
14C2*			ASL HL,4
14C5*			L=L OR A
14C7			BC=BC-1
		LOOP (BC>0)
14C9		SWAP AA,HL
14CA		POP HL
14CB		CS:	DS=%SYMTAB+2	Here, we save the hex into the
14D0		%BW.OFF=AA		Symtab entry "BASEWORD"
14D3		RETURN
14D4 GET.SKIP	ENTRY
14D4		SWAP AA,SI	DS:SI Set by > Action (just before "c")
14D5		CALL GET.EMIT
14D8		B=$(SI-1)	B = Most Recent Byte Emitted
14DB		SWAP AA,SI	Now, AA=Current Object
14DC*		AA=AA-SI		and, SI=Previous ALT
14DE		RETURN		AA = SKIP (byte count)
.PAD=10
14E0 F.F:	PUSH ES 	Get here before ALL variable SymTab Entries
14E1		PUSH DI 	(Root, ParmByte, & BaseWord are fixed len)
14E2		CALL BUFFER		Handle NAME=<filename>
14E5		ES=%SYMTAB+2	DS:SI = BUFFER(<filename>)
14E9		DI=3			Index to Root NAME entry.
14EC		PUSH SI
14ED		PUSH BC 	BC = Length of <filename>
14EE*		BC:8
14F1		IF GT,				Name too large ?
14F3			BC=8			Truncate to 8 chars
14F6		DO UNTIL BC=0		Rewrite "Root" entry
			$DI+=$SI+
			BC=BC-1 	with new NAME=<rootfile>
		LOOP (BC>0)
14F8*		DO	DI:11
14FB		*	IF GE,EXIT
14FD			ES:	$DI=" "
1501+			DI=DI+1 	Pad with Spaces if necessary.
1502		LOOP
1504		POP BC
1505		POP SI
1506		POP ES
1507		POP DI		regs used: AA,BC,DS:SI
1508		RETURN		regs unchanged: DE,HL,ES:DI,BP
1509		DO	A=$SI+
150A*			A:021
150C		*	IF LT,EXIT
150E*			A:"a"
1510			IF GE,
1512*				A:"z"
1514		*		IF LE,EXIT
1516*			A:7F
1518		*	IF GE,EXIT
151A			CALL EMIT.A
151D			BC=BC-1
		*	LOOP (BC>0)
151F			RETURN
1520 F.G:		CALL GET.TOKEN		Handle a Literal
1523*			$SI:'"'
1526			IF NE,			First, check for
1528*				$SI:"'" 		a delimiter.
152B		*		IF NE,LOOP	(If none, emit it.)
152D+			BC=BC-1 		If one, ignore it,
152E+			SI=SI+1 		AND ignore its partner.
152F			BC=BC-1
		LOOP (BC>0)
1531		CALL FAIL.WRAP
1534		="K",0
.PAD=10
1540 F.P:	CALL GET.EMIT
1543		%(BP+A.PTR)=SI
1546		RETURN
1547 CK.LEFT	CS:	DS=%OBJECT+2	The following code is identical
154C		SI=%(BP+ADDR)		in both PTRAN and DEXPL.
154F CK.MORE	C=$SI			-----------------------------------
1551*		C::01000000
1554		IF NZ,
1556+			SI=SI+1
1557+			C=C-1
1559*		DO	BC=BC AND 3F
155D+			SI=SI+1
155E+			BC=BC-1
155F			PUSH BC
1560			PUSH SI
1561			IF NZ,
1563				A=$SI		Checking left-most element
1565*				A:020		if [ ], get next element
1567				IF EQ,
1569					A=$(SI+1)
156C*				A:0		and test to see if subpat'rn
156E			*	IF POS,EXIT
1570				CALL MAP.IT	If it is, get its address
1573*				A':-1
1576			*	IF EQ,EXIT
1578*				AA:%(BP+ADDR)	and verify that we aren't
157B				IF EQ,			back where we
157D					CALL FAIL.WRAP	started.  If we are,
1580					="L"		it's left recursion.
1581				SWAP AA,SI
1582				CALL CK.MORE
1585			POP SI
1586			POP BC
1587*			SI=SI+BC
1589			C=$SI
158B*			C:0
158D		LOOP UNTIL NEG
158F		RETURN
1590 SORT.ALTS	ES=DS
1592		CALL INS.OVRRDS
1595		IF NEG,RTN
1598		DO	SI=%(BP+ADDR)
159B			DO	CALL CMP.ALTS	Must ALTS be Exchanged ?
159E				IF CY,		HL is Set by CMP.ALTS
15A0					CALL ROTATE	Moves ALT at $DI
15A3			*		EXIT		to $HL & [HL..DI] up.
15A5				C=$SI
15A7*				BC=BC AND 3F
15AB*				SI=SI+BC
15AD*				SI:DI
15AF			*	IF NE,LOOP
15B1				CALL DI.P.ONE
15B4		LOOP UNTIL NEG
15B6		CALL DEL.OVRRDS 	Sets final value of $OBJECT
15B9		RETURN
.PAD=10
15C0 CMP.ALTS	PUSH SI
15C1		C=$SI
15C3*		BC=BC AND 3F
15C7*		SI=SI+BC
15C9		A=$(SI-1)		A  = Next ALT #
15CC		POP SI
15CD		A'=-1
15CF*		SI:%(BP+ADDR)
15D2		IF NE,
15D4			A'=$(SI-1)	A' = Prev ALT #
15D7*		A':A
15D9		IF GT,			IF Prev #  >  Next #
15DB			HL=SI		then Put Insert Point = Next ALT
15DD		PUSH SI 		(otherwise it remains somewhere
15DE		C=$SI			farther left, or at the beginning)
15E0*		C=C AND 7F
15E3*		C::040			Adjust for the initial prefix ALT
15E6		IF NZ,			(it can now be anywhere & may have
15E8*			C=C-041 	an override byte flagged after it).
15EB+			SI=SI+1 	Get rid of the bit and the byte.
15EC+		SI=SI+1 		Now, SI = 1st ALT byte to be matched.
15ED*		C:$DI
15EF		IF LE,
15F1			PUSH BC 	Match only if $SI shorter than $DI.
15F2			PUSH DI 	(fail if same length & full match).
15F3+			BC=BC-2
15F5+			DI=DI+1 	(flags = NZ at this point)
15F6			DO UNTIL BC=0
    *				$SI+:$DI+
				BC=BC-1
			LOOP EQ (BC>0)
15F8			POP DI		Flags EQ here only if complete match.
15F9			POP BC
15FA		*	IF NE,EXIT	No need to exchange.
15FC*			C:$DI
15FE			IF EQ,			Fail if same lengths.
1600				CALL FAIL.WRAP
1603				="D"
1604			POP SI		Here we need to exchange due to
1605			CALL TST.NEXT	$SI being a proper head of $DI.
1608			IF NE,			Compare Prev ALT # to
160A+				A'=A'+1 	# of ALT to be Inserted.
160C				CALL TST.NEXT
160F			IF EQ,		If Insert would be in sequence here,
1611				HL=SI		then, set Insert Point here.
1613.			CY=1		Otherwise, accept Point set above.
1614			RETURN
1615		POP SI		<<<<	Here we have disjoint ALTs.
1616		CALL GET.BOTH		Are Both Literals OR NOT Literals?
1619*		B=B XOR C		(B & C = types of 1st Elements)
161B		IF ZR,			(if not the same, RTN NC)
161D			CALL TST.NEXT	If they are, check their sequence.
1620		*	IF GT,EXIT	(no insert needed, RTN NC)
1622*			A':A		RTN CY ONLY if we need to insert.
1624		*	IF EQ,EXIT	(RTN NC)
1626.			CY=~CY		NC if A'< A;  CY ONLY if A'> A.
1627		RETURN
.PAD=10
1630 TST.NEXT	PUSH DI
1631		C=$DI
1633*		DI=DI+BC
1635*		A':$(DI-1)
1638		POP DI
1639		RETURN
163A GET.BOTH	B=$(SI+1)	SI in range of initial ALT
163D*		$SI::040	DI is to the right of that.
1640		IF NZ,
1642			B=$(SI+2)	Skip possible leading ALT Override.
1645		C=$(DI+1)	Return	B = Type of ALT at $DI, and
1648		CALL TEST.B		C = Type of ALT at $SI.
164B		SWAP B,C	Possible Ranges of Element B.
164D*TEST.B	B=B-021 	00-20 21-60 61-7A 7A-7E 7F-FF
1650*		B:5A		      00-3F 40-59 5A-5D 5E...
1653		IF GE,		      ^LIT^   |   ^LIT^  |
1655*			B:5D		 |    |    LE:	GT:
1658		*	EXIT		 |    |     |	 |
165A*		ELSE	B:3F		LE:  GT:    |	 |
165D		B=-1			 |    |     |	 |
165F		IF GT,			B=-1  |    B=-1  |
1661			B=0		     B=0	B=0
1663		RETURN
1664 ROTATE	SI=HL
1666		L=$DI
1668*		HL=HL AND 3F		HL = Length of Upper Area
166C		DE=DI
166E*		DE=DE-SI		DE = Length of Lower Area
1670		BC=HL
1672*		BC=BC+DE		[      ] [	   ]
1674		PUSH DI 		^SI	 ^DI
1675		A=$DI
1677		DO	SWAP A,A'
1679			A=$SI
167B			$SI=A'
167D*			SI:DI
167F			IF LT,
1681*				SI=SI+HL
1683			*	EXIT
1685			ELSE	IF EQ,
1687+					SI=SI+1
1688+					DI=DI+1
1689					A=$SI
168B*				SI=SI-DE
168D			BC=BC-1
		LOOP (BC>0)		--- REGISTERS ---
168F		POP DI		--- BEFORE ----    --- AFTER -----
1690*		DI=DI+HL	[  DE  ] [ HL ]    [ HL ] [  DE  ]
1692*		$DI:0		^SI	 ^DI			  ^DI
1695		RETURN		AA=BC=DE=xx	   AA=xx, BC=0, SI=xx.
.PAD=10
16A0 INS.OVRRDS CALL DI.A.ONE		If single ALT, take an early exit.
16A3		IF POS,
16A5			SI=%(BP+ADDR)		Get @Begin Statement
16A8			A=$SI			and check for a
16AA*			A=A+A			"Bracket ID"
16AC		*	IF POS,EXIT		Exit early if one is flagged.
16AE		ELSE	RETURN
16AF		E=0			E = # of Current ALT
16B1		DO	L=$SI
16B3*			HL=HL AND 3F
16B7			$SI=L		Set upper 2 bits of Skip = 0
16B9*			L:2			Test size of Current ALT
16BC			HL=(HL+SI)		(HL = @ Next Alt)
16BE			IF GE,
16C0				A=$(HL-1)	Size > 1,
16C3*				A:020		so test for ALT Override
16C5			*	IF GE,NEXT
16C7				SWAP AA,DE	E = Override
16C8			*	EXIT
16CA*			ELSE	E:32		if there was no override,
16CD		*		IF GE,EXIT		(AND E < 32)
16CF+				$SI=$SI+1	then we insert an Override
16D1*				$SI::00111111
16D4		*		IF ZR,EXIT		(skip byte overflow)
16D6				CS:	DI=%OBJECT	DI = Cutoff Point
16DB				A=E
16DD+				HL=HL-1
16DE+				DO	HL=HL+1 	From HL to Cutoff,
16DF					SWAP A,A'	move all the bytes
16E1					A=$HL		up one position,
16E3					$HL=A'		inserting ALT at 1st
16E5*					HL:DI		position.
16E7				LOOP UNTIL GT
16E9+				CS:	%OBJECT=%OBJECT+1	Bump Cutoff.
16EE			L=$SI
16F0*			HL=HL AND 3F		$SI = Current ALT Skip Byte
16F4			SI=(HL+SI)
16F6*			$SI::11000000		$SI = Next ALT's Skip Byte
16F9			IF ZR,			ZR-->not a synonym
16FB+				E=E+1			so, bump ALT #.
16FD		*	IF POS,LOOP		NEG-->We're at End-Statement
16FF DI.A.ONE	ELSE	DI=%(BP+ADDR)		End-Statement = ^0.
1702 DI.P.ONE		C=$DI		Here is our exit sequence,
1704*			BC=BC AND 3F		if we inserted overrides,
1708*			DI=DI+BC		we always return POS.
170A*			$DI:0		If we didn't, we returned NEG (above)
170D			RETURN
170E		CALL FAIL.WRAP		Here is our abort sequence.
1711		=">"
1712 F.R	$(BP+PREFIX)=1		Set the >prefix flag.
1716		RETURN
1717*F.S	$(BP+PREFIX):0		Check the >prefix flag
171B		IF EQ,
171D			A="p"		IF <set> THEN EMIT("p")
171F			CALL EMIT.A	(causes CALL CK.EOL in XPL)
1722		RETURN
.P
1723 DEL.OVRRDS SI=%(BP+ADDR)		Here we're looking at a set of ALTS
1726		PUSH SI 		with all explicit ALT Overrides.
1727		E=-1			Sign & Synonym bits are all clear.
1729		DO	L=$SI
172B*			HL=HL AND 3F	Set synonym bits as appropriate.
172F			HL=(HL+SI)	Now, SI=@ALT, HL=@Next ALT
1731*			E:$(HL-1)	E = # of prev Alt
1734			IF EQ,				Synonym ?
1736*				$SI=$SI OR 01000000	(set Synonym bit)
1739			*	EXIT
173B+			ELSE	E=E+1		Else, E = Current ALT #
173D*			$SI::3D 	Two-Byte Alt?
1740			IF ZR,
1742+				E=E-1		(Prev Alt #)
1744				CALL CRUSH.2	Delete a 2-byte Alt
1747			*	EXIT		(SI now = Next Alt)
1749*			ELSE	E:$(HL-1)
174C				IF NE,		Is Alt in Sequence?
174E					E=$(HL-1)	(no, update E)
1751				*	EXIT
1753				ELSE	CALL CRUSH.1	Yes, Crush Override.
1756				L=$SI
1758*				HL=HL AND 3F	Bump to next Alt.
175C				SI=(HL+SI)
175E*			$SI:0			End-Statement = `0 (NEG)
1761		LOOP WHILE POS
1763		POP SI			Synonym bit on 1st Skip can't be 1.
1764*		$SI=$SI OR `0		Set the sign bit on the 1st Skip.
1767		RETURN
1768 CRUSH.2	PUSH HL
1769		CALL CRUSH.1
176C		POP HL
176D+		HL=HL-1
176E CRUSH.1	CS:	DI=%OBJECT	Here, we can get rid
1773+		$SI=$SI-1		of a redundant
1775		DO	A=$HL		ALT Override.
1777			$(HL-1)=A
177A+			HL=HL+1
177B*			HL:DI
177D		LOOP UNTIL GT
177F+		CS:	%OBJECT=%OBJECT-1
1784		RETURN
1785		NEXT
.
1044 B.SOURCE	106A GET.RETRY	10C9 FILE.CHR	10EC CR
1172 CRASH	1180 FILE.EOF	1185 PTR.DIFF	11DE PERIOD
120A OBJECT	120E WRITE.HEX	1253 ERR.CNT	125F FILE.POINT
1286 SYMTAB	128F FILE.PTR	12A0 MIN.SI	12FB PREP
1304 E.O.CODE	130C E.O.MEM	130F TOKENS	131E MAX.SRC
1323 COLUMN1	132B BODY	134E BACK	1383 ERR.FLG
13F2 F.I	13F4 F.J	13F6 F.K	13F8 F.L
13FA F.M	13FC F.N	1402 F.Q	1418 GET.EMIT
1446 LOOKUP.T	1449 EMIT.A	145E DEFINE.V	147A F.1
14E2 BUFFER	1570 MAP.IT