;       COMMON DATA FOR CP/M ASSEMBLER MODULE
		ORG		100H
		ENDA	EQU 20F0H		;END OF ASSEMBLER PROGRAM
		BDOS	EQU 5H			;ENTRY TO DOS, USED TO COMPUTE END MEMORY
		LXI		SP, ENDMOD
		LHLD	BDOS+1
		SHLD	SYMAX			;COMPUTE END OF MEMORY
		JMP		ENDMOD
;
;		PRINT BUFFER AND PRINT BUFFER POINTER
		PBMAX	EQU 120			;MAX PRINT BUFFER
PBUFF:
		DS		PBMAX
PBP:
		DS		1				;PRINT BUFFER POINTER
;
;		SCANNER PARAMETERS
TOKEN:
		DS		1				;CURRENT TOKEN
VALUE:
		DS		2				;BINARY VALUE FOR NUMBERS
ACCLEN:
		DS		1				;ACCUMULATOR LENGTH
		ACMAX	EQU 64			;LENGTH OF ACCUMULATOR
ACCUM:
		DS		ACMAX			;ACCUMULATOR (MUST FOLLOW ACCLEN)
;
;		OPERAND EXPRESSION EVALUATOR PARAMETERS
EVALUE:
		DS		2				;VALUE OF EXPRESSION AFTER EVALUATION
;
;		SYMBOL TABLE MODULE PARAMETERS
SYTOP:
		DW      ENDA     		;FIRST LOCATION AVAILABLE FOR SYMBOL TABLE
SYMAX:
		DS		2				;LAST AVAILABLE LOCATION FOR SYMBOL TABLE
;
;		MISCELLANEOUS DATA AREAS
PASS:
		DS		1				;PASS # 0,1
FPC:
		DS		2				;FILL ADDRESS FOR NEXT HEX RECORD
ASPC:
		DS		2				;ASSEMBLER'S PSEUDO PC
SYBAS:
		DW		ENDA			;SYMBOL TABLE BASE
SYADR:
		DS		2				;CURRENT SYMBOL BASE
		ENDMOD	EQU ($ AND 0FF00H)+100H
		END


;		I/O MODULE FOR CP/M ASSEMBLER
;
		ORG		206H
		BOOT	EQU SOCH		;REBOOT LOCATION
								;I/O MODULE ENTRY POINTS
		JMP		INIT			;INITIALIZE, START ASSEMBLER
		JMP		SETUP			;FILE SETUP
		JMP		GNC				;GET NEXT CHARACTER
		JMP		PNC				;PUT NEXT OUTPUT CHARACTER
		JMP		PNB				;PUT NEXT HEX BYTE
		JMP		PCHAR			;PRINT CONSOLE CHARACTER
		JMP		PCON			;PRINT CONSOLE BUFFER TO CRLF
		JMP		WOBUFF			;WRITE OUTBUFFER
		JMP		PERR			;PLACE ERROR CHARACTER INTO PBUFF
		JMP		DHEX			;PLACE HEX BYTE INTO OUTPUT BUFFER
		JMP		EOR				;END OF ASSEMBLY
;		DATA FOR I/O MODULE
BPC:
		DS		2				;BASE PC FOR CURRENT HEX RECORD
DBL:
		DS		1				;HEX BUFFER LENGTH
DBUFF:
		DS		16				;HEX BUFFER
;
;		DISK NAMES
		CDISK	DS 1			;CURRENTLY SELECTED DISK
		ADISK	DS 1			;.ASM DISK
PDISK:
		DS		1				;.PRN DISK
HDISK:
		DS		1				;.HEX DISK
;
;
;		COMMON EQUATES
		QBMAX	EQU 120			;MAX PRINT SIZE
		QBUFF	EQU 10CH		;PRINT BUFFER
		QBP		EQU QBUFF+QBMAX	;PRINT BUFFER POINTER
;
		TOKEN	EQU QBP+1		;CURRENT TOKEN USER SCAN
		VALUE	EQU TOKEN+l		;VALUE OF NUMBER IN BINARY
		ACCLEN	EQU VALUE+2		;ACCUMULATOR LENGTH
		ACMAX	EQU 64			;MAX.ACCUMULATOR LENGTH
		ACCUM	EQU ACCLEN+1
;
		EVALUE	EQU ACCUM+ACMAX	;VALUE FROM EXPRESSION ANALYSIS
;
		SYTOP	EQU EVALUE+2	;CURRENT SYMBOL TOP
		SYMAX	EQU SYTOP+2		;MAX ADDRESS+1
;
		PASS	EQU SYMAX+2		;CURRENT PASS NUMBER
		FPC		EQU PASS+1		;PILL ADDRESS FOR DHEX ROUTINE
		ASPC	EQU FPC+2		;ASSEMBLER'S PSEUDO PC
;
		CR		EQU 0DH			;CARRIAGE RETURN
		LF		EQU 0AH			;LINE FEED
		EOF		EQU 1AH			;END OF FILE MARK
;
;
;		DOS ENTRY POINTS
		BDOS	EQU 5H			;DOS ENTRY POINT
		READC	EQU 1			;READ CONSOLE DEVICE
		WRITC	EQU 2			;WRITE CONSOLE DEVICE
		REDYC	EQU 11			;CONSOLE CHARACTER READY
		SELECT	EQU 14			;SELECT DISK SPECIFIED BY REGISTER E
		OPENF	EQU 15			;OPEN FILE
		CLOSF	EQU 16			;CLOSE FILE
		DELEF	EQU 19			;DELETE FILE
		READF	EQU 20			;READ FILE
		WRITF	EQU 21			;WRITE FILE
		MAKEF	EQU 22			;MAKE A FILE
		CSEL	EQU 25			;RETURN CURRENTLY SELECTED DISK
		SETDM	EQU 26			;SET DMA ADDRESS
;
;		FILE AND BUFFERING PARAMETERS
		NSB		EQU 8			;NUMBER OF SOURCE BUFFERS
		NPB		EQU 6			;NUMBER OF PRINT BUFFERS
		NHB		EQU 6			;NUMBER OF HEX BUFFERS
;
		SSIZE	EQU NSB*128
		PSIZE	EQU NPB*128
		ESIZE	EQU NHB*128
;
;		FILE CONTROL BLOCKS
SCB:
		DS		9				;FILE NAME
		DB		'ASM'			;FILE TYPE
SCBR:
		DS		1				;REEL NUMBER (ZEROED IN SETUP)
		DS		19				;MISC AND DISK MAP
SCBCR:
		DS		1				;CURRENT RECORD (ZEROED IN SETUP)
;
PCB:
		DS		9
		DB		'PRN', 0
		DS		19
		DB		0				;RECORD TO WRITE NEXT
;
HCB:
		DS		9
		DB		'HEX', 0
		DS		19
		DB		0
;
;		POINTERS AND BUFFERS
SBP:
		DW		SSIZE			;NEXT CHARACTER POSITION TO READ
SBUFF:
		DS		SSIZE
;
PBP:
		DW		0
PBUFF:
		DS		PSIZE
;
HBP:
		DW		0
HBUFF:
		DS		HSIZE
		FCB		EQU SCH			;FILE CONTROL BLOCK ADDRESS
		FNM		EQU 1			;POSITION OF FILE NAME
		FLN		EQU 9			;FILE NAME LENGTH
		DUFF	EQU 80H			;INPUT DISK BUFFER ADDRESS
;
SEL:							;SELECT DISK IN REG-A
		LXI		H, CDISK
		CMP		M				;SAME?
		RZ
		MOV		M, A			;CHANGE CURRENT DISK
		MOV		E, A
		MVI		C, SELECT
		CALL	BDOS
		RET
;
SCNP:							;SCAN THE NEXT PARAMETER
		INX		H
		MOV		A, M
		CPI		' '
		JZ		SCNP0
		SBI		'A'				;NORMALIZE
		RET
SCNP0:
		LDA		CDISK
		RET
;
PCON:							;PRINT MESSAGE AT H,L TO CONSOLE DEVICE
		MOV		A, M
		CALL	PCHAR
		MOV		A, M
		INX		H
		CPI		CR
		JNZ		PCON
		MVI		A, LF
		CALL	PCHAR
		RET
;
FNAME:							;FILL NAME FROM DEFAULT FILE CONTROL BLOCK
		LXI		D, FCB
		MVI		B, FLN
FNAM0:
		LDAX	D				;GET NEXT FILE CHARACTER
		CPI		'?'
		JZ		FNERR			;FILE NAME ERROR
		MOV		M, A			;STORE TO FILE CNTRL BLOCK
		INX		H
		INX		D
		DCR		B
		JNZ		FNAM0			;FOR NEXT CHARACTER
		RET
;
INIT:							;SET UP STACK AND FILES, START ASSEMBLER
		LXI		H				;TITL
		CALL	PCON
		JMP		SET0
;
OPEN:							;OPEN FILE ADDRESSED BY D,E
		MVI		C				;OPENF
		CALL	BDOS
		CPI		255
		RNZ
								;OPEN ERROR
		LXI		H, ERROP
		CALL	PCON
		JMP		BOOT
;
CLOSE:							;CLOSE FILE ADDRESSED BY D,E
		MVI		C, CLOSF
		CALL	BDOS
		CPI		255
		RNZ						;CLOSE OK
		LXI		H, ERRCL
		CALL	PCON
		JMP		BOOT
;
DELETE:							;DELETE FILE' ADDRESSED BY D,E
		MVI		C, DELEF
		JMP		BDOS
;
MAKE:							;MAKE FILE ADDRESSED BY D,E
		MVI		C, MAKEF
		CALL	BDOS
		CPI		255
		RNZ
								;MAKE ERROR
		LXI		H, ERRMA
		CALL	PCON
		JMP		BOOT
;
SELA:
		LDA		ADISK
		CALL	SEL
		RET
;
NPR:							;RETURN ZERO FLAG IF NO PRINT FILE
		LDA		PDISK
		CPI		'Z'-'A'
		RZ
		CPI		'X'-'A'			;CONSOLE:
		RET
;
SELP:
		LDA		PDISK
		CALL	SEL
		RET
;
SELH:
		LDA		HDISK
		CALL	SEL
		RET
;
SET0:							;SET UP FILES FOR INPUT AND OUTPUT
		LDA		FCB				;GET FIRST CHARACTER
		CPI						;MAY HAVE FORGOTTEN NAME
		JZ		FNERR			;FILE NAME ERROR
		MVI		C, CSEL			;CURRENT DISK?
		CALL	BDOS			;GET IT TO REG
		STA		CDISK
;
;		SCAN PARAMETERS
		LXI		H, FCB+FLN-1
		CALL	SCNP
		STA		ADISK
		CALL	SCNP
		STA		HDISK
		CALL	SCNP
		STA		PDISK
;
		LXI		H, SCB			;ADDRESS SOURCE FILE CONTROL BLOCK
		CALL	FNAME			;FILE NAME OBTAINED FROM DEFAULT FCB
;
		CALL	NPR				;Z OR X?
		JZ		NOPR
		LXI		H, PCB			;ADDRESS PRINT FILE CONTROL BLOCK
		PUSH	H				;SAVE A COPY FOR OPEN
		PUSH	H				;SAVE A COPY FOR DELETE
		CALL	FNAME			;FILL PCB
		CALL	SELP
		POP		D				;FCB ADDRESS
		CALL	DELETE
		POP		D				;FCB ADDRESS?
		CALL	MAKE
;
NOPR:							;TEST FOR HEX FILE
		LDA		HDISK
		CPI		'Z'-'A'
		JZ		NOHEX
		LXI		H, HCB
		PUSH	H
		PUSH	H
		CALL	FNAME
		CALL	SELH
		POP		D
		CALL	DELETE
		POP		D
		CALL	MAKE
;
;		FILES SET UP, CALL ASSEMBLER
NOHEX:
		JMP		ENDMOD
;
SETUP:							;SETUP INPUT FILE FOR SOURCE PROGRAM
		LXI		H, SSIZE
		SHLD	SBP				;CAUSE IMMEDIATE READ
		XRA		A				;ZERO  VALUE
		STA		SCBR			;CLEAR REEL NUMBER
		STA		SCBCR			;CLEAR CURRENT RECORD
		STA		DBL				;CLEAR HEX BUFFER LENGTH
		CALL	SELA
		LXI		D, SCB
		CALL	OPEN
;
		RET
;
FNERR:							;FILE NAME ERROR
		LXI		H, ERRFN
		CALL	PCON
		JMP		BOOT
;
;
GCOMP:							;COMPARE D,E AGAINS H,L
		MOV		A, D
		CMP		H
		RNZ
		MOV		A, E
		CMP		L
		RET
;
GNC:							;GET NEXT CHARACTER FROM SOURCE BUFFER
		PUSH	B
		PUSH	D
		PUSH	H				;ENVIRONMENT SAVED
		LHLD	SBP
		LXI		D				;SSIZE
		CALL	GCOMP
		JNZ		GNC2
;
								;READ ANOTHER BUFFER
		CALL	SELA
		LXI		H, 0
		SHLD	SBP
		MVI		B, NSB			;NUMBER OF SOURCE BUFFERS
		LXI		H, SBUFF
GNC0:							;READ 128 BYTES
		PUSH	B				;SAVE COUNT
		PUSH	H				;SAVE BUFFER ADDRESS
		MVI		C, READF
		LXI		D, SCB
		CALL	BDOS			;PERFORM THE READ
		POP		H				;RESTORE BUFFER ADDRESS
		POP		B				;RESTORE BUFFER COUNT
		ORA		A				;SET FLAGS
		MVI		C, 128
		JNZ		GNC1
								;NORMAL READ OCCURRED
		LXI		D, BUFF			;SOURCE BUFFER ADDRESS
		MVI		C, 128
MOV0:
		LDAX	D				;GET CHARACTER
		MOV		M, A			;STORE CHARACTER
		INX		D
		INX		H
		DCR		C
		JNZ		MOV0
								;BUFFER LOADED, TRY NEXT BUFFER
;
		DCR		B
		JNZ		GNC0
		JMP		GNC2
;
GNCl:							;EOF OR ERROR
		CPI		3				;ALLOW 0,1,2
		JNC		FRERR			;FILE READ ERROR
GNCE:
		MVI		M, EOF			;STORE'AND END OF FILE CHARACTER
		INX		H
		DCR		C
		JNZ		GNCE			;FILL CURRENT BUFFER WITH EOF'S
;
GNC2:							;GET CHARACTER TO ACCUMULATOR AND RETURN
		LXI		D, SBUFF
		LHLD	SBP
		PUSH	H				;SAVE CURRENT SBP
		INX		H				;READY FOR NEXT READ
		SHLD	SBP
		POP		H				;RESTORE PREVIOUS SBP
		DAD		D				;ABSOLUTE ADDRESS OF CHARACTER
		MOV		A, M			;GET IT
		POP		H
		POP		D
		POP		B
		RET
;
FRERR:
		LXI		H, ERRFR
		CALL	PCON			;PRINT READ ERROR MESSAGE
		JMP		BOOT
;
PNC:							;SAME AT PNCF, BUT ENVIRONMENT IS SAVED FIRST
		PUSH	B
								;CHECK FOR CONSOLE OUTPUT /'NO OUTPUT
		MOV		B, A			;SAVE CHARACTER
		LDA		PDISK			;Z  OR  X?
		CPI		'Z'-'A'			;Z NO OUTPUT
		JZ		PNRET
;
		CPI		'X'-'A'
		MOV		A, B			;RECOVER CHAR FOR CON OUT
		JNZ		PNGO
		CALL	PCHAR
		JMP		PNRET
;
								;NOT X OR Z, SO PRINT IT
PNGO:
		PUSH	D
		PUSH	H
		CALL	PNCF
		POP		H
		POP		D
PNRET:
		POP		B
		RET
;
PNCF:							;PRINT NEXT CHARACTER
		LHLD	PBP
		XCHG
		LXI		H, PBUFF
		DAD		D
		MOV		M, A			;CHARACTER STORED AT PBP IN PBUFF
		XCHG					;PBP TO H,L
		INX		H				;POINT TO NEXT CHARACTER
		SHLD	PBP				;REPLACE IT
		XCHG
		LXI		H, PSIZE
		CALL	GCOMP			;AT END OF BUFFER?
		RNZ						;RETURN IF NOT
;
								;OVERFLOW, WRITE BUFFER
		CALL	SELP
		LXI		H, 0
		SHLD	PSP
		LXI		H, PBUFF
		LXI		D, PCB			;D,E ADDRESS FILE CONTROL BLOCK
		MVI		B, NPS			;NUMBER OF BUFFERS TO B
;       (DROP THROUGH TO WBUFF)
;
WBUFF:							;WRITE BUFFERS STARTING AT H,L FOR B BUFFERS
;	 CHECK FOR EOF'S
		MOV		A, M
		CPI		EOF
		RZ						;DON'T DO THE WRITE
;
		PUSH	B				;SAVE NUMBER OF BUFFERS
		PUSH	D				;SAVE FCB ADDRESS
		MVI		C, 128			;READY FOR MOVE
		LXI		D, BUFF
WBUF0:							;MOVE TO BUFFER
		MOV		A, M			;GET CHARACTER
		STAX	D				;PUT CHARACTER
		INX		H
		INX		D
		DCR		C
		JNZ		WBUF0
;
								;WRITE   BUFFER
		POP		D				;RECOVER FCB ADDRESS
		PUSH	D				;SAVE IT AGAIN FOR LATER
		PUSH	H				;SAVE BUFFER ADDRESS
		MVI		C, WRITF		;DOS WRITE FUNCTION
		CALL	BDOS
		POP		H				;RECOVER BUFFER ADDRESS
		POP		D				;RECOVER FCB ADDRESS
		POP		B				;RECOVER BUFFER COUNT
		ORA		A				;SET ERROR RETURN FLAGS
		JNZ		FWERR
;
								;WRITE    OX
		DCR		B
		RZ						;RETURN IF NO' MORE BUFFERS TO WRITE
		JMP		WBUFF
;
FWERR:							;ERROR IN WRITE
		LXI		H, ERRFW
		CALL	PCON			;ERROR MESSAGE OUT
		JMP		EORC			;TO CLOSE AND REBOOT
;
;
PNB:							;PUT NEXT HEX BYTE
		PUSH	B
		PUSH	D
		PUSH	H
		CALL	PNBF
		POP		H
		POP		D
		POP		B
		RET
;
PNBF:							;PUT NEXT BYTE
;       (SIMILAR TO THE PNCF SUBROUTINE)
		LHLD	HBP
		XCHG
		LXI		H, HBUFF
		DAD		D
		MOV		M, A			;CHARACTER STORED AT HBP IN HBUFF
		XCHG
		INX		H				;HBP INCREMENTED
		SHLD	HBP
		XCHG					;BACK TO D,E
		LXI		H, HSIZE
		CALL	GCOMP			;EQUAL?
		RNZ
;
								;OVERFLOW, WRITE BUFFERS
		CALL	SEDH
		LXI		H, D
		SHLD	HBP
		LXI		H, HBUFF
		LXI		D, HCB			;FILE CONTROL BLOCK FOR HEX FILE
		MVI		B, NHB
		JMP		WBUFF			;WRITE BUFFERS
;
PCHAR:							;PRINT CHARACTER IN REGISTER A
		PUSH	B
		PUSH	D
		PUSH	H
		MVI		C, WRITC
		MOV		E, A
		CALL	BDOS
		POP		H
		POP		D
		POP		B
		RET
;
WOCHAR:							;WRITE CHARACTER IN REG-A WITH REFLECT AT CONSOLE IF EB
		MOV		C, A			;SAVE THE CHAR
		CALL	PNC				;PRINT CHAR
		LDA		QBUFF
		CPI
		RZ
								;ERROR	IN LINE
		LDA		PDISK
		CPI		'X'-'A'
		RZ						;ALREADY PRINTED IF 'X'
;
		MOV		A, C			;RECOVER CHARACTER
		CALL	PCHAR			;PRINT IT
		RET
;
WOBUFF:							;WRITE THE OUTPUT BUFFER TO THE PRINT FILE
		LDA		QBP				;GET CHARACTER COUNT
		LXI		H, QBUFF		;BASE OF BUFFER
WOB0:
		ORA		A				;ZER0 COUNT?
		JZ		WOBE
								;NOT END, SAVE COUNT AND GET CHARACTER
		MOV		B, A			;SAVE COUNT
		MOV		A, M
		CALL	WOCHAR			;WRITE CHARACTER
		INX		H				;ADDRESS NEXT CHARACTER OF BUFFER
		MOV		A, B			;GET COUNT
		DCR		A
		JMP		WOB0
;
WOBE:							;END OF PRINT - ZERO QBP
		STA		QBP
								;FOLLOW BY CR LF
		MVI		A, CR
		CALL	WOCHAR
		MVI		A, LF
		CALL	WOCHAR
		LXI		H, QBUFF
		MVI		A, QBMAX		;READY TO BLANK OUT
WOB2:
		MVI		M,' ' 
		INX		H
		DCR		A
		JNZ		WOB2
		RET
;
;
PERR:							;FILL QBUFF ERROR MESSAGE POSITION
		MOV		B, A			;SAVE CHARACTER
		LXI		H, QBUFF
		MOV		A, M
		CPI		' '
		RNZ						;DON'T CHANGE IT IF ALREADY SET
		MOV		M, B			;STORE ERROR CHARACTER
		RET
;

EOR:							;END OF ASSEMBLER
		CALL	NPR				;Z OR A?
		JZ		EOPR
								;FILL OUTPUT FILES WITH EOF'S
EOR2:
		LHLD	PBP
		MOV		A, L
		ORA		H				;VALUE ZERO?
		JZ		EOPR
		MVI		A, EOF			;CTL-Z IS END OF FILE
		CALL	PNC				;PUT ENDFILES IN PRINT BUFFER
		JMP		EOR2			;EVENTUALLY BUFFER IS WRITTEN
;
EOPR:							;END 0F PRINT PILE, CHECK HEX
		LDA		HDISK
		CPI		'Z'-'A'
		JZ		EORC
EOR0:							;WRITE TERMINATING RECORD INTO HEX FILE
		LDA		DBL				;MAY BE ZERO ALREADY
		ORA		A
		CNZ		WHEX			;WRITE HEX BUFFER IF NOT ZERO
		LHLD	FPC				;GET CURRENT FPC AS LAST ADDRESS
		SHLD	BPC				;RECORD LENGTH ZERO, BASE ADDRESS 0000
		CALL	WHEX			;WRlTE HEX BUFFER
;
								;NOW CLEAR OUTPUT BUFFER FOR HEX FILE
EOR1:
		LHLD	HBP
		MOV		A, L
		ORA		H
		JZ		EORC
		MVI		A, EOF
		CALL	PNB
		JMP		EOR1
;
;		CLOSE FILES AND TERMINATE
EORC:
		CALL	NPR
		JZ		EORPC
		CALL	SELP
		LXI		D, PCB
		CALL	CLOSE
EORPC:
		LDA		HDISK
		CPI		'Z'-'A'
		JZ		EORHC
		CALL	SELH
		LXI		D, HCB
		CALL	CLOSE
;
EORHC:
		LXI		H, ENDA
		CALL	PCON
		JMP		BOOT
;
TITL:
		DB		'CP/M ASSEMBLER - VER 1.0', CR
ERROP:
		DB		'NO SOURCE FILE PRESENT', CR
ERRMA:
		DB		'NO DIRECTORY SPACE', CR
ERRFN:
		DB		'SOURCE FILE NAME ERROR', CR
ERRFR:
		DB		'SOURCE FILE READ ERROR', CR
ERRFW:
		DB		'OUTPUT FILE WRITE ERROR', CR
ERRCL:
		DB		'CANNOT CLOSE FILES', CR
PENDA:
		DB		'END OF ASSEMBLY', CR
;
DHEX:							;DATA TO HEX BUFFER (BYTE IN REG-A)
		PUSH	B
		MOV		B, A			;HOLD CHARACTER FOR 'Z' TEST
		LDA		HDISK
		CPI		'Z'-'A'
		MOV		A, B			;RECOVER CHARACTER
		JZ		DHRET
		PUSH	D				;ENVIRONMENT SAVED
		PUSH	PSW				;SAVE DATA BYTE
		LXI		H, DBL			;CURRENT LENGTH
		MOV		A, M			;TO ACCUM
		ORA		A				;ZERO?
		JZ		DHEX3
;
								;LENGTH	NOT ZERO, MAY BE FULL BUFFER
		CPI		16
		JC		DHEX1			;BR IF LESS THAN 16 BYTES
								;BUFFER FULL, DUMP IT
		CALL	WHEX			;DBL = 0 UPON RETURN
		JMP		DHEX3			;SET BPC AND DATA BYTE
;
DHEX1:							;PARTIAL BUFFER IN PROGRESS, CHECK FOR SEQUENTIAL BYTE LOAD
		LHLD	FPC
		XCHG
		LHLD	BPC				;BASE PC IN H,L
		MOV		C, A			;CURRENT LENGTH OF BUFFER
		MVI		B, 0			;IS IN B,C
		DAD		B				;BPC+DBL TO H,L
		MOV		A, E			;READY FOR COMPARE
		CMP		L				;EQUAL?
		JNZ		DHEX2			;BR IF NOT
		MOV		A, D			;CHECK HO BYTE
		CMP		H
		JZ		DHEX4			;BR IF SAME ADDRESS
;
DHEX2:							;NON SEQUENTIAL ADDRESS, DUMP AND CHANGE BASE ADDRESS
		CALL	WHEX
DHEX3:							;SET NEW BASE
		LHLD	FPC
		SHLD	BPC
;
DHEX4:							;STORE DATA BYTE AND INC DBL
		LXI		H, DBL
		MOV		E, M			;LENGTH TO REG-E
		INR		M				;DBL=DBL+1
		MVI		D, 0			;HIGH ORDER ZERO FOR DOUBLE ADD
		LXI		H, DBUFF
		DAD		D				;DBUFF+DBL TO H,L
		POP		PSW				;RESTORE DATA BYTE
		MOV		M, A			;INTO DATA BUFFER
		POP		D
DHRET:
		POP		B				;ENVIRONMENT RESTORED
		RET
;
WRC:							;WRITE CHARACTER WITH CHECK SUM IN D
		PUSH	PSW
		RRC
		RRC
		RRC
		RRC
		ANI		0FH
		CALL	HEXC			;OUTPUT HEX CHARACTER
		POP		PSW				;RESTORE BYTE
		PUSH	PSW				;SAVE A VERSION
		ANI		0FH
		CALL	HEXC			;WRITE LOW NIBBLE
		POP		PSW				;RESTORE BYTE
		ADD		D				;COMPUTE CHECKSUM
		MOV		D, A			;SAVE CS
		RET
;
HEXC:							;WRITE CHARACTER
		ADI		90H
		DAA
		ACI		40H
		DAA
		JMP		PNB				;PUT BYTE
;
WHEX:							;WRITE CURRENT HEX BUFFER
		MVI     A, ':'			;RECORD HEADER
		CALL	PNB				;PUT BYTE
		LXI		H, DBL			;RECORD LENGTH ADDRESS
		MOV		E, M			;LENGTH TO REG-E
		XRA		A				;ZERO TO REG-A
		MOV		D, A			;CLEAR CHECKSUM
		MOV		M, A			;LENGTH IS ZEROED FOR NEXT WRITE
		LHLD	BPC				;BASE ADDRESS FOR RECORD
		MOV		A, E			;LENGTH TO A
		CALL	WRC				;WRITE HEX VALUE
		MOV		A, H			;HIGH ORDER BASE ADDR
		CALL	WRC				;WRITE HO BYTE
		MOV		A, L			;LOW ORDER BASE ADDR
		CALL	WRC				;WRITE LO BYTE
		XRA		A				;ZERO TO A
		CALL	WRC				;WRITE RECORD TYPE 00
		MOV		A, E			;CHECK FOR LENGTH 0
		ORA		A
		JZ		WHEX1
;
								;NON - ZERO, WRITE DATA BYTES
		LXI		H, DBUFF
WHEX0:
		MOV		A, M			;GET BYTE
		INX		H
		CALL	WRC				;WRITE DATA BYTE
		DCR		E				;END OF BUFFER?
		JNZ		WHEX0
;
								;END OF DATA BYTES, WRITE CHECK SUM
WHEX1:
		XRA		A
		SUB		D				;COMPUTE CHECKSUM
		CALL	WRC
;
								;SEND CRLF AT END OF RECORD
		MVI		A, CR
		CALL	PNB
		MVI		A, LF
		CALL	PNB
		RET
;
;
;
		ENDMOD	EQU ($ AND 0FFE0H)+20H
		END
		ORG		1100H
		JMP		ENDMOD			;END OF THIS MODULE
		JMP		INITS			;INITIALIZE THE SCANNER
		JMP		SCAN			;CALL THE SCANNER
;
;
;		ENTRY POINTS IN I/O MODULE
		IOMOD	EQU 200H
		GNCF	EQU IOMOD+6H
		WOBUFF	EQU IOMOD+15H
		PERR	EQU IOMOD+18H
;
LASTC:
		DS		1				;LAST CHAR SCANNED
NEXTC:
		DS		1				;LOOK AHEAD CHAR
STYPE:
		DS		1				;RADIX INDICATOR
;
;		COMMON EQUATES
		PBMAX	EQU 120			;MAX PRINT SIZE
		PBUFF	EQU 10CH		;PRINT BUFFER
		PBP		EQU PBUFF+PBMAX	;PRINT BUFFER POINTER
;
		TOKEN	EQU PEP+1		;CURRENT TOKEN UDER SCAN
		VALUE	EQU TOKEN+1		;VALUE OF NUMBER IN BINARY
		ACCLEN	EQU VALUE+2		;ACCUMULATOR LENGTH
		ACMAX	EQU 64			;MAX ACCUMULATOR LENGTH
		ACCUM	EQU ACCLEN+1
;
		EVALUE	EQU ACCUM+ACMAX	;VALUE FROM EXPRESSION ANALYSIS
;
		SYTOP	EQU EVALUE+2	;CURRENT SYMBOL TOP
		SYMAX	EQU SYTOP+2		;MAX ADDRESS+1
;
		PASS	EQU SYMAX+2		;CURRENT PASS NUMBER
		FPC		EQU PASS+1		;FILL ADDRESS FOR NEXT HEX BYTE
		ASPC	EQU FPC+2		;ASSEMBLER'S PSEUDO PC
;
;		GLOBAL EQUATES
		IDEN	EQU 1 IDENTIFIER
		NUMB	EQU 2			;NUMBER
		STRNG	EQU 3			;STRING
		SPECL	EQU 4			;SPECIAL CHARACTER
;
		PLABT	EQU 0001B		;PROGRAM LABEL
		DLABT	EQU 0010B		;DATA LABEL
		EQUT	EQU 0100B		;EQUATE
		SETT	EQU 0101B		;SET
		MACT	EQU 0110B		;MACRO
;
		EXTT	EQU 1000B		;EXTERNAL
		REFT	EQU 1011B		;REFER
		GLBT	EQU 1100B		;GLOBAL
;
		BINV	EQU 2
		OCTV	EQU 8
		DECV	EQU 10
		HEXV	EQU 16
		CR		EQU 0DH
		LF		EQU 0AH
		EOF		EQU 1AH
		TAB		EQU 09H			;TAB CHARACTER
;
;
;		UTILITY SUBROUTINES
GNC:							;GET NEXT CHARACTER AND ECHO TO PRINT FILE
		CALL	GNCF
		PUSH	PSW
		CPI		CR
		JZ		GNC0
		CPI		LF				;IF LF THEN DUMP CURRENT BUFFER
		JZ		GNC0
;
;NOT A CR OR LF, PLACE INTO BUFFER IF THERE IS ENOUGH ROOM
		LDA		PBP
		CPI		PBMAX
		JNC		GNC0
								;ENOUGH ROOM, PLACE INTO BUFFER
		MOV		E, A
		MVI		D, 0			;DOUBLE PRECISION PBP IN D,E
		INR		A
		STA		PBP				;INCREMENTED PBP IN MEMORY
		LXI		H, PBUFF
		DAD		D				;PBUFF(PBP)
		POP		PSW
		MOV		M, A			;PBUFF(PBP) - CHAR
		RET
GNC0:							;CHAR NOT PLACED INTO BUFFER
		POP		PSW
		RET
;
INITS:							;INITIALIZE THE'SCANNER
		CALL	ZERO
		STA		NEXTC			;CLEAR NEXT CHARACTER
		STA		PBP
		MVI		A, LF			;SET LAST CHAR TO LF
		STA		LASTC
		CALL	WOBUFF			;CLEAR BUFFER
		MVI		A, 16			;START OF PRINT LINE
		STA		PBP
		RET
;
ZERO:
		XRA		A
		STA		ACCLEN
		STA		STYPE
		RET
;
SAVER:							;STORE THE NEXT CHARACTER INTO THE ACCUMULATOR AND UPDATE ACCLEN
		LXI		H, ACCLEN
		MOV		A, M
		CPI		ACMAX
		JC		SAV1			;JUMP IF NOT UP TO LAST POSITION
		MVI		M, 0
		CALL	ERRO
SAV1:
		MOV		E, M			;D,E WILL HOLD INDEX
		MVI		D, 0
		INR		M				;ACCLEN INCREMENTED
		INX		H				;ADDRESS ACCUMULATOR
		DAD		D				;ADD INDEX TO ACCUMULATOR
		LDA		NEXTC			;GET CHARACTER
		MOV		M, A			;INTO ACCUMULATOR
		RET
;
TDOLL:							;TEST FOR DOLLAR SIGN, ASSUMING H,L ADDRESS NEXTC
		MOV		A, M
		CPI		'$'
		RNZ
		XRA		A				;TO GET A ZERO
		MOV		M, A			;CLEARS NEXTC
		RET						;WITH ZERO FLAG SET
;
NUMERIC:						;CHECK NEXTC FOR NUMERIC, RETURN ZERO FLAG IF NOT NUMERIC
		LDA		NEXTC
		SUI		'0'
		CPI		10
								;CARRY RESET IF NUMERIC
		RAL
		ANI		1B				;ZERO IF NOT NUMERIC
		RET
;
HEX:							;RETURN ZERO FLAG IF NEXTC IS NOT HEXADECIMAL
		CALL	NUMERIC
		RNZ						;RETURNS IF 0-9
		LDA		NEXTC
		SUI		'A'
		CPI		6
								;CARRY SET IF OUT OF RANGE
		RAL
		ANI		1B
		RET
;
LETTER:							;RETURN ZERO FLAG IF NEXTC IS NOT A LETTER
		LDA		NEXTC
		SUI		'A'
		CPI		26
		RAL
		ANI		1B
		RET
;
ALNUM:							;RETURN ZERO FLAG IF NOT ALPHANUMERIC
		CALL	LETTER
		RNZ
		CALL	NUMERIC
		RET
;
TRANS:							;TRANSLATE TO UPPER CASE
		LDA		NEXTC
		CPI		'A' OR 1100000B	;LOWER CASE A
		RC						;CARRY IF LESS THAN LOWER A
		CPI		('Z' OR 1100000B)+1	;LOWER CASE Z
		RNC						;NO CARRY IF GREATER THAN LOWER
		ANI		10111110		;CONVERT TO UPPER CASE
		STA		NEXTC
		RET
;
GNCN:							;GET CHARACTER AND STORE TO NEXTC
		CALL	GNC
		STA		NEXTC
		CALL	TRANS			;TRANSLATE TO UPPER CASE
		RET
;
EOLT:							;END OF LINE TEST FOR COMMENT SCAN
		CPI		CR
		RZ
		CPI		EOF
		RZ
		CPI     '!'
		RET
;
SCAN:							;FIND NEXT TOKEN IN INPUT STREAM
		XRA		A
		STA		TOKEN
		CALL	ZERO
;
;		DEBLANK
DEBL:
		LDA		NEXTC
		CPI		TAB				;TAB CHARACTER TREATED AS BLANK OUTSIDE STRING
		JZ		DEB0
		CPI		';'        		;MAY BE A COMMENT
		JZ		DEB1			;DEBLANK THROUGH COMMENT
		CPI		'*'				;PROCESSOR'TECH COMMENT
		JNZ		DEB2			;NOT *
		LDA		LASTC
		CPI		LF				;LAST LINE FEED?
		JNZ		DEB2			;NOT LF*
								;COMMENT FOUND, REMOVE IT
DEB1:
		CALL	GNCN
		CALL	EOLT			;CR, EOF, OR !
		JZ		FINDL			;HANDLE END OF LINE
		JMP		DEB1			;OTHERWISE CONTINUE SCAN
DEB2:
		ORI		' '				;MAY BE ZERO
		CPI		' '
		JNZ		FINDL
DEB0:
		CALL	GNCN			;GET NEXT AND STORE'TO NEXTC
		JMP		DEBL
;
;		LINE DEBLANKED, FIND TOKEN TYPE
FINDL:							;LOOK FOR LETTER, DECIMAL DIGIT, OR STRING QUOTE
		CALL	LETTER
		JZ		FIND0
		MVI		A, IDEN
		JMP		STOKEN
;
FIND0:
		CALL	NUMERIC
		JZ		FIND1
		MVI		A, NUMB
		JMP		STOKEN
;
FIND1:
		LDA		NEXTC
		CPI		''''
		JNZ		FIND2
		XRA		A
		STA		NEXTC			;D0N'T STORE THE QUOTE
		MVI		A, STRNG
		JMP		STOKEN
;
FIND2:							;ASSUME IT IS A SPECIAL CHARACTER
		CPI		LF				;IF LF THEN DUMP THE BUFFER
		JNZ		FIND3
								;LF FOUND
		LDA		PASS
		ORA		A
		CNZ		WOBUFF
		LXI		H, PBUFF		;CLEAR ERROR CHAR ON BOTH PASSES
		MVI		M, ' '
		MVI		A, 16
		STA		PBP				;START NEW LINE
FIND3:
		MVI		A, SPECL
;
STOKEN:
		STA		TOKEN
;
;
;		LOOP WHILE CURRENT ITEM IS ACCUMULATING
SCTOK:
		LDA		NEXTC
		STA		LASTC			;SAVE LAST CHARACTER
		ORA		A
		CNZ		SAVER			;STORE CHARACTER INTO ACCUM IF NOT ZERO
		CALL	GNCN			;GET NEXT TO NEXTC
		LDA		TOKEN
		CPI		SPECL
		RZ						;RETURN IF SPECIAL CHARACTER
		CPI		STRNG
		CNZ		TRANS			;TRANSLATE TO UPPER CASE IF NOT IN STRING
		LXI		H, NEXTC
		LDA		TOKEN
;
		CPI		IDEN
		JNZ		SCT2
;
								;ACCUMULATING AN IDENTIFIER
		CALL	TDOLL			;$?
		JZ		SCTOK			;IF SO, SKIP IT
		CALL	ALNUM			;ALPHA NUMERIC?
		RZ						;RETURN IF END
								;NOT END OF THE IDENTIFIER
		JMP		SCTOK
;
SCT2:							;NOT SPECIAL OR IDENT, CHECK NUMBER
		CPI		NUMB
		JNZ		SCT3
;
								;ACCUMULATING A NUMBER, CHECK FOR $
		CALL	TDOLL
		JZ		SCTOK			;SKIP IF FOUND
		CALL	HEX				;HEX CHARACTER?
		JNZ		SCTOK			;STORE IT IF FOUND
								;END OF NUMBER, LOOK FOR RADIX INDICATOR
;
		LDA		NEXTC
		CPI		'O'				;OCTAL INDICATOR
		JZ		NOCT
		CPI		'O'				;OCTAL INDICATOR
		JNZ		NUM2
;
NOCT:							;OCTAL
		MVI		A, OCTV
		JMP		SSTYP
NUM2:
		CPI		'H'
		JNZ		NUM3
		MVI		A, HEXV
SSTYP:
		STA		STYPE
		XRA		A
		STA		NEXTC			;CLEARS THE LOOKAHEAD CHARACTER
		JMP		NCON
;
;		RADIX MUST COME FROM ACCUM
NUM3:
		LDA		LASTC
		CPI		'B'
		JNZ		NUM4
		MVI		A, BINV
		JMP		SSTY1
;
NUM4:
		CPI		'D'
		MVI		A, DECV
		JNZ		SSTY2
SSTY1:
		LXI		H, ACCLEN
		DCR		M				;ACCLEN DECREMENTED TO REMOVE RADIX INDICATOR
SSTY2:
		STA		STYPE
;
NCON:							;NUMERIC CONVERSION OCCURS HERE
		LXI		H, 0
		SHLD	VALUE			;VALUE ACCUMULATES BINARY EQUIVALENT
		LXI		H, ACCLEN
		MOV		C, M			;C=ACCLEN
		INX		H				;ADDRESSES ACCUM
CLOP:							;NEXT DIGIT IS PROCESSED HERE
		MOV		A, M
		INX		H				;READY FOR NEXT LOOP
		CPI		'A'
		JNC		CLOP1			;NOT HEX A-F
		SUI		'0'				;NORMALIZE
		JMP		CLOP2
;
CLOP1:							;HEX A-F            H
		SUI		'A'-10
CLOP2:							;CHECK SIZE AGAINST RADIX
		PUSH	H				;SAVE ACCUM ADDR
		PUSH	B				;SAVE CURRENT POSITION
		MOV		C, A
		LXI		H, STYPE
		CMP		M
		CNC		ERRV			;VALUE ERROR IF DIGIT>=RADIX
		MVI		B, 0			;DOUBLE PRECISION DIGIT
		MOV		A, M			;RADIX TO ACCUMULATOR
		LHLD	VALUE
		XCHG					;VALUE TO D,E - ACCUMULATE RESULT IN H,L
		LXI		H, 0			;ZERO ACCUMULATOR
CLOP3:							;LOOP UNTIL RADIX GOES TO ZERO
		ORA		A
		JZ		CLOP4
		RAR						;TEST LSB
		JNC		TTWO			;SKIP SUMMING OPERATION IF LSB=0
		DAD		D				;ADD IN VALUE
TTWO:							;MULTIPLY VALUE    * 2 FOR SHL OPERATION
		XCHG
		DAD		H
		XCHG
		JMP		CLOP3
;
;
CLOP4:							;END OF NUMBER CONVERSION
		DAD		B				;DIGIT ADDED IN
		SHLD	VALUE
		POP		B
		POP		H
		DCR		C				;MORE DIGITS?
		JNZ		CLOP
		RET						;DONE WITH THE NUMBER
;
SCT3:							;MUST BE A STRING
		LDA		NEXTC
		CPI		CR				;END OF LINE?
		JZ		ERRO			;AND RETURN
		CPI
		JNZ		SCTOK
		CALL	GNCN
		CPI		''''
		RNZ						;RETURN IF SINGLE QUOTE ENCOUNTERED
		JMP		SCTOK			;OTHERWISE TREAT AS ONE QUOTE
;
;		END OF SCANNER
;
;		ERROR MESSAGE ROUTINES
ERRV:							;'V' VALUE ERROR
		PUSH	PSW
		MVI		A, 'V'
		JMP		ERR
;
ERRO:							;'O' OVERFLOW ERROR
		PUSH	PSW
		MVI		A, 'O'
		JMP		ERR
;
ERR:							;PRINT ERROR MESSAGE
		PUSH	B
		PUSH	H
		CALL	PERR
		POP		H
		POP		B
		POP		PSW
		RET
;
ENDMOD:
		EQU		($ AND 0FF00H) + 100H
		END

;		SYMBOL TABLE MANIPULATION MODULE
;
		ORG		1340H
		IOMOD	EQU 200H		;IO MODULE ENTRY POINT
		PCON	EQU IOMOD+12H
		EOR		EQU IOMOD+1EH
;
;
;		ENTRY POINTS TO SYMBOL TABLE MODULE
		JMP		ENDMOD
		JMP		INISY
		JMP		LOOKUP
		JMP		FOUND
		JMP		ENTER
		JMP		SETTY
		JMP		GETTY
		JMP		SETVAL
		JMP		GETVAL
;
;		COMMON EQUATES
		PBMAX	EQU 120			;MAX PRINT SIZE
		PBUFF	EQU 10CH		;PRINT BUFFER
		PBP		EQU PBUFF+PBMAX	;PRINT BUFFER POINTER
;
		TOKEN	EQU PBP+1		;CURRENT TOKEN UDER SCAN
		VALUE	EQU TOKEN+1		;VALUE OF NUMBER IN BINARY
		ACCLEN	EQU VALUE+2		;ACCUMULATOR LENGTH
		ACMAX	EQU 64			;MAX ACCUMULATOR LENGTH
		ACCUM	EQU ACCLEN+1
;
		EVALUE	EQU ACCUM+ACMAX	;VALUE FROM EXPRESSION ANALYSIS
;
		SYTOP	EQU EVALUE+2	;CURRENT SYMBOL TOP
		SYMAX	EQU SYTOP+2		;MAX ADDRESS+1
;
		PASS	EQU SYMAX+2		;CURRENT PASS NUMBER
		FPC		EQU PASS+1		;FILL ADDRESS FOR NEXT HEX BYTE
		ASPC	EQU FPC+2		;ASSEMBLER'S PSEUDO PC
		SYBAS	EQU ASPC+2		;BASE OF SYMBOL TABLE
		SYADR	EQU SYBAS+2		;CURRENT SYMBOL BEING ACCESSED
;
;		GLOBAL EQUATES
		IDEN	EQU 1			;IDENTIFIER
		NUMB	EQU 2			;NUMBER
		STRNG	EQU 3			;STRING
		SPECL	EQU 4			;SPECIAL CHARACTER
;
		PLABT	EQU 0001B		;PROGRAM LABEL
		DLABT	EQU 0010B		;DATA LABEL
		EQUT	EQU 0100B		;EQUATE
		SETT	EQU 0101B		;SET
		MACT	EQU 0110B		;MACRO
;
		EXTT	EQU 1000B		;EXTERNAL
		REFT	EQU 1011B		;REFER
		GLBT	EQU 1100B		;GLOBAL
;
		CR		EQU 0DH
;		DATA AREAS
								;SYMBOL TABLE BEGINS AT THE END OF THIS MODULE
		FIXD	EQU 5			;5 BYTES OVERHEAD WITH EACH SYMBOL ENTRY
								;2BY COLLISION, 1BY TYPE/LEN, 2BY VALUE
		HSIZE	EQU 128			;HASH TABLE SIZE
		HMASK	EQU HSIZE-1		;HASH  MASK  FOR CODING
HASHT:
		DS		HSIZE*2			;HASH TABLE
HASHC:
		DS		1				;HASH CODE AFTER CALL ON LOOKUP
;
;		SYMBOL TABLE ENTRY FORMAT IS
;       -----------------
;       : HIGH VAL BYTE :
;	    -----------------
;       : LOW  VAL BYTE :
;	    -----------------
;       : CHARACTER H   :
;	    -----------------
;	    :   ...         :
;		-----------------                                  :
;       : CHARACTER 1   :
;		-----------------
;       : TYPE   ; LENG :
;		-----------------
;       : HIGH COLLISION:
;		-----------------
;		SYADR*   : LOW COLLISION :
;		-----------------
;
;		WHERE THE LOW/HIGH COLLISION FIELD ADDRESSES ANOTHER ENTRY WITH
;		THE SAME HASH CODE (OR ZERO IF THE END OF CHAIN), TYPE DESCRIBES
;		THE ENTRY TYPE (GIVEN BELOW), LENG IS THE NUMBER OF CHARACTERS IN
;		THE SYMBOL PRINTNAME -1 (I.E., LENG=0 IS A SINGLE CHARACTER PRINT-
;		NAME, WHILE LENG=15 INDICATES A 16 CHARACTER NAME). CHARACTER 1
;		THROUGH N GIVE THE PRINTNAME CHARACTERS IN ASCII UPPER CASE (ALL
;		LOWER CASE NAMES ARE TRANSLATED ON INPUT), AND THE LOW/HIGH VALUE
;		GIVE THE PARTICULAR ADDRESS OR CONSTANT VALUE ASSOCIATED WITH THE
;		NAME. THE REPRESENTATION OF MACROS DIFFERS IN THE FIELDS WHICH
;		FOLLOW THE VALUE FIELD (MACROS ARE NOT CURRENTLY IMPLEMENTED).
;
;	THE TYPE FIELD CONSISTS OF FOUR BITS WHICH ARE ASSIGNED AS
;		FOLLOWS:
;
;                 0000     UNDEFINED SYMBOL
;                 0001     LOCAL   LABELLED PROGRAM
;                 0010     LOCAL   LABELLED DATA
;                 0011     (UNUSED)
;                 0100             EQUATE
;                 0101             SET
;                 0110             MACRO
;                 0111             (UNUSED)
;
;                 1000             (UNUSED)
;                 1001     EXTERN  LABELLED PROGRAM
;                 1010     EXTERN  LABELLED DATA
;                 1011             REFERENCE TO MODULE
;                 1100             (UNUSED)
;                 1101     GLOBAL  UNDEFINED SYMBOL
;                 1110     GLOBAL  LABELLED PROGRAM
;                 1111             (UNUSED)
;
;		TYPE DEFINITIONS
;
		PLABT	EQU 0001B		;PROGRAM LABEL
		DLABT	EQU 0010B		;DATA LABEL
		EQUT	EQU 0100B		;EQUATE
		SETT	EQU 0101B		;SET
		MACT	EQU 0110B		;MACRO
;
		EXTT	EQU 1000B		;EXTERNAL ATTRIBUTE
		REFT	EQU 1011B		;REFER
		GLBT	EQU 1100B		;GLOBAL ATTRIBUTE
;
;
INISY:							;INITIALIZE THE SYMBOL TABLE
		LXI		H, HASHT		;ZERO THE HASH TABLE
		MVI		B, HSIZE
		XRA		A				;CLEAR ACCUM
INIO:
		MOV		M, A
		INX		H
		MOV		M, A			;CLEAR DOUBLE WORD
		INX		H
		DCR		B
		JNZ		INIO

								;SET SYMBOL TABLE POINTERS
		LXI		H, 0
		SHLD	SYADR
;
		RET
;
CHASH:							;COMPUTE HASH CODE FOR CURRENT ACCUMULATOR
		LXI		H, ACCLEN
		MOV		B, M			;GET ACCUM LENGTH
		XRA		A				;CLEAR ACCUMULATOR
CH0:
		INX		H				;MOVE TO FIRST/NEXT CHARACTER POSITION
		ADD		M				;ADD WITH OVERFLOW
		DCR		B
		JNZ		CH0
		ANI		HMASK			;MASK BITS FOR MODULO HZISE
		STA		HASHC			;FILL HASHC WITH RESULT
		RET
;
SETLN:							;SET THE LENGTH FIELD OF THE CURRENT SYMBOL
		MOV		B, A			;SAVE LENGTH IN B
		LHLD	SYADR
		INX		H
		INX		H
		MOV		A, M			;GET TYPE/LENGTH FIELD
		ANI		0F0H			;MASK OUT TYPE FIELD
		ORA		B				;MASK IN  LENGTH
		MOV		M, A
		RET
;
GETLN:							;GET THE LENGTH FIELD TO REG-A
		LHLD	SYADR
		INX		H
		INX		H
		MOV		A, M
		ANI		0FH
		INR		A				;LENGTH IS STORED AS VALUE - 1
		RET
;
FOUND:							;FOUND RETURNS TRUE IF SYADR IS NOT ZERO (TRUE IS NZ FLAG HERE)
		LHLD	SYADR
		MOV		A, L
		ORA		H
		RET
;
LOOKUP:							;LOOK FOR SYMBOL IN ACCUMULATOR
		CALL	CHASH			;COMPUTE HASH CODE
								;NORMALIZE IDENTIFIER TO 16 CHARACTERS
		LXI		H, ACCLEN
		MOV		A, M
		CPI		17
		JC		LENOK
		MVI		M, 16
LENOK:
								;LOOK FOR SYMBOL THROUGH HASH TABLE
		LXI		H, HASHC
		MOV		E, M
		MVI		D, 0			;DOUBLE HASH CODE IN D,E
		LXI		H, HASHT		;BASE OF HASH TABLE
		DAD		D
		DAD		D				;HASHT(HASHC)
		MOV		E, M			;LOW ORDER ADDRESS
		INX		H
		MOV		H, M
		MOV		L, E			;HEADER TO LIST OF SYMBOLS IS IN H,L
LOOK0:
		SHLD	SYADR
		CALL	FOUND
		RZ						;RETURN IF SYADR BECOMES ZERO
;
								;OTHERWISE EXAMINE CHARACTER STRING FOR MATCH
		CALL	GETLN			;GET LENGTH TO REG-A
		LXI		H, ACCLEN
		CMP		M
		JNZ		LCOMP
;
								;LENGTH MATCH, TRY TO MATCH CHARACTERS
		MOV		B, A			;STRING LENGTH IN B
		INX		H				;HL ADDRESSES ACCUM
		XCHG					;TO D,E
		LHLD	SYADR
		INX		H
		INX		H
		INX		H				;ADDRESSES CHARACTERS
LOOK1:
		LDAX	D				;NEXT CHARACTER FROM ACCUM
		CMP		M				;NEXT CHARACTER IN SYMBOL TABLE
		JNZ		LCOMP
								;CHARACTER MATCHED, INCREMENT TO NEXT
		INX		D
		INX		H
		DCR		B
		JNZ		LOOK1
;
								;COMPLETE MATCH AT CURRENT SYMBOL, SYADR IS SET
		RET
;
LCOMP:							;NOT FOUND, MOVE SYADR DOWN ONE COLLISION ADDRESS
		LHLD	SYADR
		MOV		E, M
		INX		H
		MOV		D, M			;COLLISION ADDRESS IN D,E
		XCHG
		JMP		LOOK0
;
;
ENTER:							;ENTER SYMBOL IN ACCUMULATOR
								;ENSURE THERE IS ENOUGH SPACE IN THE TABLE
		LXI		H				;ACCLEN
		MOV		E, M
		MVI		D, 0			;DOUBLE PRECISION ACCLEN IN D,E
		LHLD	SYTOP
		SHLD	SYADR			;NEXT SYMBOL LOCATION
		DAD		D				;SYTOP+ACCLEN
		LXI		D, FIXD			;FIXED DATA/SYMBOL
		DAD		D				;HL HAS NEXT TABLE LOCATION FOR SYMBOL
		XCHG					;NEW SYTOP IN D,E
		LHLD	SYMAX			;MAXIMUM SYMTOP VALUE
		MOV		A, E
		SUB		L				;COMPUTE 16-BIT DIFFERENCE
		MOV		A, D
		SBB		H
		XCHG					;NLW SYTOP IN H,L
		JNC		OVERER			;OVERFLOW IN TABLE
;
								;OTHERWISE NO ERROR
		SHLD	SYTOP			;SET NEW TABLE TOP
		LHLD	SYADR			;SET COLLISION FIELD
		XCHG					;CURRENT SYMBOL ADDRESS TO D,E
		LXI		H, HASHC		;HASH CODE FOR CURRENT SYMBOL TO H,L
		MOV		C, M			;LOW BYTE
		MVI		B, 0			;DOUBLE PRECISION VALUE IN B,C
		LXI		H, HASHT		;BASE OF HASH TABLE
		DAD		B
		DAD		B				;HASHT(HASHC) IN H,L
								;D,E ADDRESSES CURRENT SYMBOL - CHANGE LINKS
		MOV		C, M			;LOW ORDER OLD HEADER
		INX		H
		MOV		B, M			;HIGH ORDER OLD HEADER
		MOV		M, D			;HIGH ORDER NEW HEADER TO HASH TABLE
		DCX		H
		MOV		M, E			;LCW ORDER NEW HEADER TO HASH TABLE
		XCHG					;H,L HOLDS SYMBOL TABLE ADDRESS
		MOV		M, C			;LOW ORDER OLD HEADER TO COLLISION FIELD
		INX		H
		MOV		M, B			;HIGH ORDER OLD HEADER TO COLLISION FIELD
;
								;HASH CHAIN NOW REPAIRED FOR THIS ENTRY, COPY THE PRINTNAME
		LXI		D, ACCLEN
		LDAX	D				;GET SYMBOL LENGTH
		CPI		17				;LARGER THAN 16 SYMBOLS?
		JC		ENT1
		MVI		A, 16			;TRUNCATE TO 16 CHARACTERS
								;COPY LENGTH FIELD, FOLLOWED BY PRINTNAME CHARACTERS
ENT1:
		MOV		B, A			;COPY LENGTH TO B
		DCR		A				;1-16 CHANGED TO 0-15
		INX		H				;FOLLOWING COLLISION FIELD
		MOV		M, A			;STORE LENGTH WITH UNDEFINED TYPE (0000)
ENT2:
		INX		H
		INX		D
		LDAX	D
		MOV		M, A			;STORE NEXT CHARACTER OF PRINTNAME
		DCR		B				;LENGTH=LENGTH-1
		JNZ		ENT2			;FOR ANOTHER CHARACTER
;
								;PRINTNAME COPIED, ZERO THE VALUE FIELD
		XRA		A				;ZERO A
		INX		H				;LOW ORDER VALUE
		MOV		M, A
		INX		H
		MOV		M, A			;HIGH ORDER VALUE
		RET
;
OVERER:							;OVERFLOW IN SYMBOL TABLE
		LXI		H, ERRO
		CALL	PCON
		JMP		EOR				;END OF EXEQUTION
ERRO:
		DB		'SYMBOL TABLE OVERFLOW', CR
;
SETTY:							;SET CURRENT SYMBOL TYPE TO VALUE IN REG-A
		RAL
		RAL
		RAL
		RAL
		ANI		0F0H			;TYPE MOVED TO HIGH ORDER 4-BITS
		MOV		B, A			;SAVE IT IN B
		LHLD	SYADR			;BASE OF SYMBOL TO ACCESS
		INX		H
		INX		H				;ADDRESS OF TYPE/LENGTH FIELD
		MOV		A, M			;GET IT AND MASK
		ANI		0FH				;LEAVE LENGTH
		ORA		B				;MASK IN TYPE
		MOV		M, A			;STORE IT
		RET
;
GETTY:							;RETURN THE TYPE OF THE VALUE IN CURRENT SYMBOL
		LHLD	SYADR
		INX		H
		INX		H
		MOV		A, M
		RAR
		RAR
		RAR
		RAR
		ANI		0FH				;TYPE MOVED TO LOW 4-BITS OF REG-A
		RET
;
VALADR:							;GET VALUE FIELD ADDRESS FOR CURRENT SYMBOL
		CALL	GETLN			;PRINTNAME LENGTH TO ACCUM
		LHLD	SYADR			;BASE ADDRESS
		MOV		E, A
		MVI		D, 0
		DAD		D				;BASE(LEN)
		INX		H
		INX		H				;FOR COLLISION FIELD
		INX		H				;FOR TYPE/LEN FIELD
		RET						;WITH H,L ADDRESSING VALUE FIELD
;
SETVAL:							;SET THE VALUE FIELD OF THE CURRENT SYMBOL
								;VALUE IS SENT IN H,L
		PUSH	H				;SAVE VALUE TO SET
		CALL	VALADR
		POP		D				;POP VALUE TO SET, HL HAS ADDRESS TO FILL
		MOV		M, E
		INX		H
		MOV		M, D			;FIELD SET
		RET
;
GETVAL:							;GET THE VALUE FIELD OF THE CURRENT SYMBOL TO H,L
		CALL	VALADR 			;ADDRESS OF VALUE FIELD TO H, L
		MOV		E, M
		INX		H
		MOV		D, M
		XCHG
		RET
;
		ENDMOD	EQU ($ AND 0FFE0H) + 20H
		END
		ORG		15A0H
		JMP		ENDMOD			;TO NEXT MODULE
		JMP		BSEAR
		JMP		BGET
;
;		COMMON EQUATES
		PBMAX	EQU 120			;MAX PRINT SIZE
		PBUFF	EQU 10CH		;PRINT BUFFER
		PBP		EQU PBUFF+PBMAX	;PRINT BUFFER POINTER
;
		TOKEN	EQU PBP+1		;CURRENT TOKEN UDER SCAN
		VALUE	EQU TOKEN+1		;VALUE OR NUMBER IN BINARY
		ACCLEN	EQU VALUE+2		;ACCUMULATOR LENGTH
		ACMAX	EQU 64			;MAX ACCUMULATOR LENGTH
		ACCUM	EQU ACCLEN+1
;
		EVALUE	EQU ACCUM+ACMAX	;VALUE FROM EXPRESSION ANALYSIS
;
		SYTOP	EQU EVALUE+2	;CURRENT SYMBOL TOP
		SYMAX	EQU SYTOP+2		;MAX ADDRESS+1
;
		PASS	EQU SYMAX+2		;CURRENT PASS NUMBER
		FPC		EQU PASS+1		;FILL ADDRESS FOR NEXT HEX BYTE
		ASPC	EQU FPC+2		;ASSEMBLER'S PSEUDO PC
;
;		GLOBAL EQUATES
		IDEN	EQU 1			;IDENTIFIER
		NUMB	EQU 2			;NUMBER
		STRNG	EQU 3			;STRING
		SPECL	EQU 4			;SPECIAL CHARACTER
;
		PLABT	EQU 0001B		;PROGRAM LABEL
		DLABT	EQU 0010B		;DATA LABEL
		EQUT	EQU 0100B		;EQUATE
		SETT	EQU 0101B		;SET
		MACT	EQU 0110B		;MACRO
;
		EXTT	EQU 1000B		;EXTERNAL
		REFT	EQU 1011B		;REFER
		GLBT	EQU 1100B		;GLOBAL
;
;
		CR		EQU 0DH			;CARRIAGB RETURN
;
;
;		TABLE DEFINITIONS
;
;		TYPES
		XBASE	EQU 0			;START OF OPERATORS
;       01 THROUGH 015 DENOTE OPERATIONS
		RT		EQU 16
		PT		EQU RT+1		;RT IS REGISTER TYPE, PT IS PSEUDO OPERATION
		OBASE	EQU PT+1
		01		EQU OBASE+1		;SIMPLE
		02		EQU OBASE+2		;LXI
		03		EQU OBASE+3		;DAD
		04		EQU OBASE+4		;PUSH/POP
		05		EQU OBASE+5		;JMP/CALL
		06		EQU OBASE+6		;MOV
		07		EQU OBASE+7		;MVI
		08		EQU OBASE+8		;ACC IMMEDIATE
		09		EQU OBASE+9		;LDAX/STAX
		010		EQU OBASE+10	;LHLD/SHLD/LDA/STA
		011		EQU OBASE+11	;ACCUM REGISTER
		012		EQU OBASE+12	;INC/DEC
		013		EQU OBASE+13	;INX/DCX
		014		EQU OBASE+14	;RST
		015		EQU OBASE+15	;IN/OUT
;
;		X1 THROUGH X15 DENOTE OPERATORS
		X1		EQU XBASE		;*
		X2		EQU XBASE+1		;/
		X3		EQU XBASE+2		;MOD
		X4		EQU XBASE+3		;SHL
		X5		EQU XBASE+4		;SHR
		X6		EQU XBASE+5		;+
		X7		EQU XBASE+6		;-
		X8		EQU XBASF+7		;UNARY -
		X9		EQU XBASE+8		;NOT
		X10		EQU XBASF+9		;AND
		X11		EQU XBASE+10	;OR
		X12		EQU XBASE+11	;XOR
		X13		EQU XBASE+12	;(
		X14		EQU XBASE+13	;)
		X15		EQU XBASE+14	;,
		X16		EQU XBASE+15	;CR
;
;
;
;
;		RESERVED WORD TABLES
;
;		BASE ADDRESS VECTOR FOR CHARACTERS
CINX:
		DW		CHAR1			;LENGTH   1 BASE
		DW		CHAR2			;LENGTH   2 BASE
		DW		CHAR3			;LENGTH   3 BASE
		DW		CHAR4			;LENGTH   4 BASE
		DW		CHARS			;LENGTH   5 BASE
		DW		CHAR6			;LENGTH   6 BASE
;
		CMAX	EQU ($-CINX)/2-1	;LARGEST STRING TO MATCH
;
CLEN:							;LENGTH VECTOR GIVES THE NUMBER OF ITEMS IN EACH TABLE
		DB		CHAR2-CHAR1
		DB		(CHAR3-CHAR2)/2
		DB		(CHAR4-CHAR3)/3
		DB		(CHAR5-CHAR4)/4
		DB		(CHAR6-CHAR5)/5
;
TVINX:							;TABLE OF TYPE,VALUE PAIRS FOR EACH RESERVED SYMBOL
		DW		TV1
		DW		TV2
		DW		TV3
		DW		TV4
		DW		TV5
;
;		CHARACTER VECTORS FOR 1,2,3,4, AND 5 CHARACTER NAMES
CHAR1:
		DB		CR, '()*'
		DB		'+'
		DB		', -/A'
		DB		'BCDE'
		DB		'HLM'
;
CHAR2:
		DB		'DBDIDSDW'
		DB		'EIIFINOR'
		DB		'SP'
;
CHAR3:
		DB		'ACIADCADDADI'
		DB		'ANAANDANICMA'
		DB		'CMCCMPCPIDAA'
		DB		'DADDCRDCXEND'
		DB		'EQUHLTINRINX'
		DB		'JMPLDALXIMOD'
		DB		'MOVMVINOPNOT'
		DB		'ORACRGORIOUT'
		DB		'POPPSWRALRAR'
		DB		'RETRLCRRCRST'
		DB		'SBBSBISETSHL'
		DB		'SHRSTASTCSUB'
		DB		'SUIXORXRAXRI'
;
CHAR4:
		DB		'CALLENDMLDAXLHLDPCHL'
		DB		'PUSHSHLDSPHLSTAX'
		DB		'XCHGXTHL'
;
CHAR5:
		DB		'ENDIFMACROTITLE'
;
CHAR6:							;END OF CHARACTER VECTOR
;
TV1:								;TYPE,VALUE PAIRS FOR CHAR1 VECTOR
		DB		X16, 10, X13, 20 	;CR (
		DB		X14, 30, X1, 80		;)
		DB		X6, 70				;+
		DB		X15, 10, X7, 70		;, -
		DB		X2, 80, RT, 7		;/ A
		DB		RT, 0, RT, 1		;B C
		DB		RT, 2, RT, 3		;D E
		DB		RT, 4, RT, 5		;H L
		DB		RT, 6				;M
;
TV2:								;TYPE,VALUE PAIRS FOR CHAR2 VECTOR
		DB		PT, 1, 01, 0F3H		;DB DI
		DB		PT, 2, PT, 3		;DS DW
		DB		01, 0FBH, PT, 8		;EI IP
		DB		015, 0DBH, X11, 40	;IN OR
		DB		RT, 6				;SP
;
;
TV3:								;TYPE,VALUE PAIRS FOR CHAR3 VECTOR
		DB		08, 0CEH, 011, 88H	;ACI  ADC
		DB		011, 80H, 08, 0C6H	;ADD  ADI
		DB		011, 0A0H, X10, 50	;ANA  AND
		DB		08, 0E6H, 01, 2FB	;ANI  CMA
		DB		01, 3FH, 011, 0B8H	;CMC  CMP
		DB		03, 0FEH, 01, 27H	;CPI  DAA
		DB		03, 09H, 012, 05H	;DAD  DCR
		DB		013, 0BH, PT, 4		;DCX  END
		DB		PT, 7, 01, 76H		;EQU  HLT
		DB		012, 04H, 013, 03H	;INR  INX
		DB		05, 0C3H, 010, 3AH	;JMP  LDA
		DB		02, 01H, X3, 80		;LXI  MOD
		DB		06, 40H, 07, 06H	;MOV  MVI
		DB		01, 00H, X9, 60		;NOP  NOT
		DB		011, 0B0H, PT, 10	;ORA  ORG
		DB		08, 0F6H, 015, 0D3H	;ORI  OUT
		DB		04, 0C1H, RT, 6		;POP  PSW
		DB		01, 17H, 01, 1FH	;RAL  RAR
		DB		01, 0C9H, 01, 07H	;PET  RLC
		DB		01, 0FH, 014, 0C7H	;RRC  RST
		DB		011, 098H, 03, 0DEH	;SSB  SBI
		DB		PT, 11, X4, 80		;SET  SHL
		DB		X5, 80, 010, 32H	;STA  STC
		DB		01, 37H, 011, 90H	;STC  SUB
		DB		08, 0D6H, X12, 40	;SUl  XOR
		DB		011, 0A8H, OS, 0EEH	;XRA  XRI
;
;
TV4:								;TYPE,VALUE PAIRS FOR CHAR4 VECTOR
		DB		05, 0CDH			;CALL
		DB		PT, 6, 09, 0AH		;ENDM   LDAX
		DB		010, 02AH, 01, 0E9H	;LHLD   PCHL
		DB		04, 0C5H, 010, 22H	;PUSH   SHLD
		DB		01, 0F9H, 09, 02H	;SPHL   STAX
		DB		01, 0EBH, 01, 0E3H	;XCHG   XTHL
;
TV5:    						;TYPE,VALUE PAIRS FOR CHAR5 VECTOR
		DB		PT, 5, PT, 9	;ENDIF MACRO
		DB		PT, 12			;TITLE
;
SUFTAS:							;TABLE OF SUFFIXES FOR J C AND R OPERATIONS
		DB		'NZZ NCC POPEP M'
;
BSEAR:	;BINARY SEARCH MNEMONIC TABLE
;		INPUT: UR = UPPER BOUND OF TABLE (I.E., TABLE LENGTH-1)
;		SR = SIZE OF EACH TABLE ELEMENT
;		H,L ADDRESS BASE OF TABLE TO SEARCH
;		OUTPUT: ZERO FLAG INDICATES MATCH WAS FOUND, IN WHICH CASE
;		THE ACCUMULATOR CONTAINS AN INDEX TO THE ELEMENT
;		NOT ZERO FLAG INDICATES NO MATCH FOUND IN TABLE
;
		UR		EQU B			;UPPER SOUND REGISTER
		LR		EQU C			;LOWER BOUND REGISTER
		SR		EQU D			;SIZE REGISTER
		MR		EQU E			;MIDDLE POINTER REGISTER
		SP1		EQU B			;SIZE PRIME, USED IN COMPUTING MIDDLE FOSITON
		SP1P	EQU C			;ANOTHER COPY OF SIZE PRIME
		KR		EQU H			;K
;
		MVI		MR, 255			;MARK M <> OLD M
		INR		UR				;U=U+1
		MVI		LR, 0			;L = 0
;
;		COMPUTE M' = (U+L)/2
NEXT:
		XRA		A
		MOV		A, UR			;CY=0, A=U
		ADD		LR				;(U+L)
		RAR						;(U+L)/2
		CMP		MR				;SAME AS LAST TIME THROUGH?
		JZ		NMATCH			;JUMP IF = TO  NO MATCH
;
								;MORE ELEMENTS TO SCAN
		MOV		MR, A			;NEW MIDDLE VALUE
		PUSH	H				;SAVE A COPY OF THE BASE ADDRESS
		PUSH	D				;SAVE S,M
		PUSH	B				;SAVE U,L
		PUSH	H				;SAVE ANOTHER COPY OF THE BASE ADDRESS
		MOV		SP1, SR			;S'= S
		MOV		SP1P, SP1		;S** = S*
		DCR		A				;ACCLEN-1
		MOV		E, A
		MVI		D, 0			;DOUBLE ACCLEN-1 TO D,E
		PUSH	D				;SAVE A COPY FOR LATER
		CPI		CMAX			;TOO LONG?
		JNC		NGET			;NOT IN RANGE IF CARRY
		LXI		H, CLEN			;LENGTH VECTOR
		DAD		D
		MOV		UR, M			;FILL UPPER BOUND FROM MEMORY
		LXI		H, CINX
		DAD		D
		DAD		D				;BASE ADDRESS TO H,L
		MOV		D, M
		INX		H
		MOV		H, M
		MOV		L, D			;NOW IN H,L
		MOV		SR, C			;FILL THE SIZE REGISTER
		CALL	BSEAR			;PERFORM THE BINARY SEARCH
		JNZ		SCASE			;ZERO IF FOUND
		POP		D				;RESTORE INDEX
		LXI		H, TVINX
		DAD		D
		DAD		D				;ADDRESSING PROPER TV ELEMENT
		MOV		E, M
		INX		H
		MOV		D, M
								;D,E IS BASE ADDRESS OF TYPE/VALUE VECTOR, ADD DISPLACEMENT
		MOV		L, A
		MVI		H, 0
		DAD		H				;DOUBLED
		DAD		D				;INDEXED
		MOV		A, M			;TYPE TO ACC
		INX		H
		MOV		B, M			;VALUE TO B
		RET						;TYPE IN ACC, VALUE IN B
;
SCASE:							;NAME NOT TOO LONG, BUT NOT FOUND IN TABLES, MAY BE J C OR R
		POP		D				;RESTORE INDEX
		CALL	PREFIX
		RNZ						;NOT FOUND AS PREFIX J C OR R IF NOT ZERO FLAG
		PUSH	B				;SAVE VALUE AND TYPE
		CALL	SUFFIX			;ZERO IF SUFFIX MATCHED
		MOV		A, B			;READY FOR MASK IF ZERO FLAG
		POP		B				;RECALL VALUE AND TYPE
		RNZ						;RETURN IF NOT ZERO FLAG SET
								;MASK IN THE PROPER BITS AND RETURN
		ORA		A				;CLEAR CARRY
		RAL
		RAL
		RAL
		ORA		B				;VALUE SET TO JNZ ...
		MOV		B, A			;REPLACE
		MOV		A, C			;RETURN WITH TYPE IN REGISTER A
		CMP		A				;CLEAR THE ZERO FLAG
		RET
;
NGET:							;CAN'T FIND THE ENTRY, RETURN WITH ZERO FLAG RESET
		POP		D				;GET THE ELEMENT BACK
		XRA		A				;CLEAR
		INR		A				;ZERO FLAG RESET
		RET
;
;
		ENDMOD	EQU ($ AND 0FFE0H) + 20H	;NEXT MODULE ADDRESS
		END
		DCR		A				;ACCLEN-l
		MOV		E, A
		MVI		D, 0			;DOUBLE ACCLEN-1 TO D,E
		PUSH	D				;SAVE A COPY FOR LATER
		CPI		CMAX			;TOO LONG?
		JNC		NGET			;NOT IN RANGE IF CARRY
		LXI		H, CLEN			;LENGTH VECTOR
		DAD		D
		MOV		UR, M			;FILL UPPER BOUND FROM MEMORY
		LXI		H, CINX
		DAD		D
		DAD		D				;BASE ADDRESS TO H,L
		MOV		D, M
		INX		H
		MOV		H, M
		MOV		L, D			;NOW IN H,L
		MOV		SR, C			;FILL THE SIZE REGISTER
		CALL	BSEAR			;PERFORM THE BINARY SEARCH
		JNZ		SCASE			;ZERO IF FOUND
		POP		D				;RESTORE INDEX
		LXI		H, TVINX
		DAD		D
		DAD		D				;ADDRESSING PROPER TV ELEMENT
		MOV		E, M
		INX		H
		MOV		D, M
								;D,E IS BASE ADDRESS OF TYPE/VALUE VECTOR, ADD DISPLACEMENT
		MOV		L, A
		MVI		H, 0
		DAD		H				;DOUBLED
		DAD		D				;INDEXED
		MOV		A, M			;TYPE TO ACC
		INX		H
		MOV		B, H			;VALUE TO B
		RET						;TYPE IN ACC, VALUE IN B
;
SCASE:							;NAME NOT TOO LONG, BUT NOT FOUND IN TABLES, MAY BE J C OR R
		POP		D				;RESTORE INDEX
		CALL	PREFIX
		RNZ						;NOT FOUND AS PREFIX J C OR R   IF NOT ZERO FLAG
		PUSH	B				;SAVE VALUE AND TYPE
		CALL	SUFFIX			;ZERO IF SUFFIX MATCHED
		MOV		A, B			;READY FOR MASK IF ZERO FLAG
		POP		B				;RECALL VALUE AND TYPE
		RNZ						;RETURN IF NOT ZERO FLAG SET
								;MASK IN THE PROPER BITS AND RETURN
		ORA		A				;CLEAR CARRY
		RAL
		RAL
		RAL
		ORA		B				;VALUE SET TO JNZ ...
		MOV		B, A			;REPLACE
		MOV		A, C			;RETURN WITH TYPE IN REGISTER A
		CMP		A				;CLEAR THE ZERO FLAG
		RET
;
NGET:							;CAN'T FIND THE ENTRY, RETURN WITH ZERO FLAG RESET
		POP		D				;GET THE ELEMENT BACK
		XRA		A				;CLEAR
		INR		A				;ZERO FLAG RESET
		RET
;
;
		ENDMOD	EQU ($ AND 0FFE0H) + 20H	;NEXT MODULE ADDRESS
		END
								;OPERAND   SCAN MODULE
		ORG		1860H
;
;		EXTERNALS
		IOMOD	EQU 200H		;I/O MODULE
		SCMOD	EQU 1100H		;SCANNER MODULE
		SYMOD	EQU 1340H		;SYMBOL TABLE MODULE
		BMOD	EQU 15A0H		;BINARY SEARCH MODULE
;
;
		PERR	EQU IOMOD+18H
		SCAN	EQU SCMOD+6H	;SCANNER ENTRY POINT
		CR		EQU 0DH			;CARRIAGE RETURN
;
		LOOKUP	EQU SYMOD+6H	;LOOKUP
		FOUND	EQU LOOKUP+3	;FOUND SYMBOL IF ZERO FLAG NOT SET
		ENTER	EQU FOUND+3		;ENTER SYMBOL
		SETTY	EQU ENTER+3		;SET TYPE FIELD
		GETTY	EQU SETTY+3		;SET TYPE FIELD
		SETVAL	EQU GETTY+3		;SET VALUE FIELD
		GETVAL	EQU SETVAL+3	;GET VALUE FIELD
;
		BSEAR	EQU BMOD+3		;BINARY SEARCH ROUTINE
		BGET	EQU BSEAR+3		;GET VALUES WITH SEARCH
;
;		COMMON EQUATES
		PBMAX	EQU 120			;MAX PRINT SIZE
		PBUFF	EQU 10CH		;PRINT BUFFER
		PBP		EQU PBUFF+PBMAX	;PRINT BUFFER POINTER
;
		TOKEN	EQU PBP+1		;CURRENT TOKEN UDER SCAN
		VALUE	EQU TOKEN+1		;VALUE OF NUMBER IN BINARY
		ACCLEN	EQU VALUE+2		;ACCUMULATOR LENGTH
		ACMAX	EQU 64			;MAX ACCUMULATOR LENGTH
		ACCUM	EQU ACCLEN+1
;
		EVALUE	EQU ACCUM+ACMAX	;VALUE FROM EXPRESSION ANALYSIS
;
		SYTOP	EQU EVALUE+2	;CURRENT SYMBOL TOP
		SYMAX	EQU SYTOP+2		;MAX ADDRESS+1
;
		PASS	EQU SYMAX+2		;CURRENT PASS NUMBER
		FPC		EQU PASS+1		;FILL ADDRESS FOR NEXT HEX BYTE
		ASPC	EQU PPC+2		;ASSEMBLER'S PSEUDO PC
;
;		GLOBAL EQUATES
		IDEN	EQU 1			;IDENTIFIER
		NUMB	EQU 2			;NUMBER
		STRNG	EQU 3			;STRING
		SPECL	EQU 4			;SPECIAL CHARACTER
;
		PLABT	EQU 0001B		;PROGRAM LABEL
		DLABT	EQU 0010B		;DATA LABEL
		EQUT	EQU 0100B		;EQUATE
		SETT	EQU 0101B		;SET
		MACT	EQU 0110B		;MACRO
;
		EXTT	EQU 1000B		;EXTERNAL
		REFT	EQU 1011B		;REFER
		GLBT	EQU 1100B		;GLOBAL
;
;
;		TABLE DEFINITIONS
		XBASE	EQU 0			;START OF OPERATORS
		OPER	EQU 15			;LAST OPERATOR
		RT		EQU 16
		PT		EQU RT+1		;RT IS REGISTER TYPE, PT IS PSEUDO OPERATION
		OBASE	EQU PT+1
;
		PLUS	EQU 5
		MINUS	EQU 6
		NOTF	EQU 8			;NOT
		LPAR	EQU 12
		RPAR	EQU 13
		OSMAX	EQU 10
		VSMAX	EQU 8*2
;
;
;		BEGINNING OF MODULE
		JMP		ENDMOD			;PAST THIS MODULE
		JMP		OPAND			;SCAN OPERAND FIELD
		JMP		MULF			;MULTIPLY FUNCTION
		JMP		DIVE			;DIVIDE FUNCTION
UNARY:
		DS		1				;TRUE IF NEXT OPERATOR IS UNARY
OPERV:
		DS		OSMAX			;OPERATOR STACK
HIERV:
		DS		OSMAX			;OPERATOR PRIORITY
VSTACK:
		DS		VSMAX			;VALUE STACK
OSP:
		DS		1				;OPERATOR STACK POINTER
VSP:
		DS		1				;VALUE STACK POINTER
;
;
;
STKV:							;PLACE CURRENT H,L VALUE AT TOP OF VSTACK
		XCHG					;HOLD VALUE IN D,E
		LXI		H, VSP
		MOV		A, M
		CPI		VSMAX
		JC		STKV0
		CALL	ERREX			;OVERFLOW IN EXPRESSION
		MVI		M, 0			;VSP=0
STKV0:
		MOV		A, M			;GET VSP
		INR		M				;VSP=VSP+1
		INR		M				;VSP=VSP+2
		MOV		C, A			;SAVE VSP
		MVI		B, 0			;DOUBLE VSP
		LXI		H, VSTACK
		DAD		B
		MOV		M, E			;LOW BYTE
		INX		H
		MOV		M, D			;HIGH BYTE
		RET
;
STKO:							;STACK OPERATOR (REG-A) AND PRIORITY (REG-B)
		PUSH	PSW				;SAVE IT
		LXI		H, OSP
		MOV		A, M
		CPI		OSMAX
		JC		STK01
		MVI		M, 0
		CALL	ERREX			;OPERATOR STACK OVERFLOW
STK01:
		MOV		E, M			;GET OSP
		MVI		D, 0
		INR		M				;OSP=OSP+1
		POP		PSW				;RECALL OPERATOR
		LXI		H, OPERV
		DAD		D				;OPERV(OSP)
		MOV		M, A			;OPERV(OSP)=OPERATOR
		LXI		H, HIERV
		DAD		D
		MOV		M, B			;HIERV(OSP)=PRIORITY
		RET
;
LODV1:  						;LOAD TOP ELEMENT FROM VSTACK TO H,L
		LXI		H, VSP
		MOV		A, M
		ORA		A
		JNZ		LODOK
		CALL	ERREX			;UNDERFLOW
		LXI		H, 0
		RET
;
LODOK:
		DCR		M
		DCR		M				;VSP=VSP-2
		MOV		C, M			;LOW BYTE
		MVI		B, 0
		LXI		H, VSTACK
		DAD		B				;VSTACK(VSP)
		MOV		C, M			;GET LOW BYTE
		INX		H
		MOV		H, M
		MOV		L, C
		RET
;
LODV2:							;LOAD TOP TWO ELEMENTS DE HOLDS TOP, HL HOLDS TOP-1
		CALL	LODV1
		XCHG
		CALL	LODV1
		RET
;
APPLY:							;APPLY OPERATOR IN REG-A TO TOP OF STACK
		MOV		L, A
		MVI		H, 0
		DAD		H				;OPERATOR NUMBER*2
		LXI		D, OPTAB
		DAD		D				;INDEXED OPTAB
		MOV		E, M			;LOW ADDRESS
		INX		H
		MOV		H, M			;HIGH ADDRESS
		MOV		L, E
		PCHL					;SET PC AND GO TO SUBROUTINE
;
OPTAB:
		DW		MULOP
		DW		DIVOP
		DW		MODOP
		DW		SHLOP
		DW		SHROP
		DW		ADDOP
		DW		SUBOP
		DW		NEGOP
		DW		NOTOP
		DW		ANDOP
		DW		OROP
		DW		XOROP
		DW		ERREX			;(
;
;		SPECIFIC HANDLERS FOLLOW
SHFT:							;SET UP OPERANDS FOR SHIFT L AND R
		CALL	LODV2
		MOV		A, D			;ENSURE 0-15
		ORA		A
		JNZ		SHERR
		MOV		A, E
		CPI		17
		RC						;RETURN IP 0-16 SHIFT
SHERR:
		CALL	ERREX
		MVI		A, 16
		RET
;
NEGF:							;COMPUTE 0-H,L TO H,L
		XRA		A
		SUB		L
		MOV		L, A
		MVI		A, 0
		SBB		H
		MOV		H, A
		RET
;
DIVF:
		CALL	LODV2
DIVE:							;(EXTERNAL ENTRY FROM MAIN PROGRAM)
		XCHG					;SWAP D,E WITH H,L FOR DIVIDE FUNCTION
								;COMPUTE X/Y WHERE X IS IN D,E AND Y IS IN H,L
								;THE VALUE OF X/Y APPEARS IN D,E AND X MOD Y IS IN H,L
;
		SHLD	DTEMP			;SAVE X IN TEMPORARY
		LXI		H, BNUM			;STORE BIT COUNT
		MVI		M, 11H
		LXI		B, 0			;INTIALIZE RESULT
		PUSH	B
		XRA		A				;CLEAR FLAGS
DLOOP:
		MOV		A, E			;GET LOW Y BYTE
		RAL
		MOV		E, A
		MOV		A, D
		RAL
		MOV		D, A
		DCR		M				;DECREMENT BIT COUNT
		POP		H				;RESTORE TEMP RESULT
		RZ						;ZERO BIT COUNT MEANS ALL DONE
		MVI		A, 0			;ADD IN CARRY
		ACI		0				;CARRY
		DAD		H				;SHIFT TEMP RESULT LEFT ONE BIT
		MOV		B, H			;COPY HA AND L TO A A ND C
		ADD		L
		LHLD	DTEMP			;GET ADDRESS OF X
		SUB		L				;SUBTRACT FROM TEMPORARY RESULT
		MOV		C, A
		MOV		A, B
		SBB		H
		MOV		B, A
		PUSH	B				;SAVE TEMP RESULT IN STACK
		JNC		DSKIP			;NO BORROW FROM SUBTRACT
		DAD		B				;ADD X BACK IN
		XTHL					;REPLACE TEMP RESULT ON STACK
DSKIP:
		LXI		H, BNUM			;RESTORE H,L
		CMC
		JMP		DLOOP			;REPEAT LOOP STEPS
;
DTEMP:
		DS		2
BNUM:
		DS		1
;
MULF:							;MULTIPLY D,E BY H,L AND REPLACE H,L WITH RESULT
		MOV		B, H
		MOV		C, L			;COPY OF 1ST VALUE TO B,C FOR SHIFT AND ADD
		LXI		H, 0			;H,L IS THE ACCUMULATOR
MUL0:
		XRA		A
		MOV		A, B			;CARRY IS CLEARED
		RAR
		MOV		B, A
		MOV		A, C
		RAR
		MOV		C, A
		JC		MUL1			;SKIP THIS ADD IF LSB IS ZERO
		ORA		B
		RZ						;RETURN WITH H,L
		JMP		MUL2			;SKIP ADD
MUL1:
		DAD		D				;ADD CURRENT VALUE OF D
MUL2:
		XCHG					;READY FOR *2
		DAD		H
		XCHG
		JMP		MUL0
;
MULOP:							;MULTIPLY D,E BY H,L
		CALL	LODV2
		CALL	MULF
		JMP		ENDOP
;
DIVOP:							;DIVIDE H,L BY D,E
		CALL	DIVF
		XCHG					;RESULT TO H,L
		JMP		ENDOP
;
MODOP:
		CALL	DIVF
		JMP		ENDOP
;
SHLOP:
		CALL	SHFT			;CHECK VALUES
SHL0:
		ORA		A				;DONE?
		JZ		ENDOP
		DAD		H				;HL=HL*2
		DCR		A
		JMP		SHL0
;
SHROP:
		CALL	SHFT
SHR0:
		ORA		A				;DONE?
		JZ		ENDOP
		PUSH	PSW				;SAVE CURRENT COUNT
		XRA		A
		MOV		A, H
		RAR
		MOV		H, A
		MOV		A, L
		RAR
		MOV		L, A
		POP		PSW
		DCR		A
		JMP		SHR0
;
ADDOP:
		CALL	LODV2
ADD0:
		DAD		D
		JMP		ENDOP
;
SUBOP:
		CALL	LODV2
		XCHG					;TREAT AS HL+(-DE)
		CALL	NEGF			;0-HL
		JMP		ADD0
;
NEGOP:
		CALL	LODV1
NEG0:
		CALL	NEGF			;COMPUTE 0-HL
		JMP		ENDOP
;
NOTOP:
		CALL	LODV1
		INX		H				;65536-HL - 65535-(HL+1)
		JMP		NEG0
;
ANDOP:
		CALL	LODV2
		MOV		A, D
		ANA		H
		MOV		H, A
		MOV		A, E
		ANA		L
		MOV		L, A
		JMP		ENDOP
;
OROP:
		CALL	LODV2
		MOV		A, D
		ORA		H
		MOV		H, A
		MOV		A, E
		ORA		L
		MOV		L, A
		JMP		ENDOP
;
XOROP:
		CALL	LODV2
		MOV		A, D
		XRA		H
		MOV		H, A
		MOV		A, E
		XRA		L
		MOV		L, A
;
ENDOP:
		JMP		STKV
;
;
;
ENDEXP:							;RETURNS ZERO FLAG IF SYMBOL IS CR, :, OR .
		LDA		TOKEN
		CPI		SPECL
		RNZ						;NOT END IF NOT SPECIAL
;
		LDA		ACCUM
		CPI		CR
		RZ
		CPI		';'
		RZ
		CPI		','
		RZ
		CPI		'|'
		RET
;
OPAND:							;SCAN THE OPERAND FIELD OF AN INSTRUCTION
;        (NOT A DB WITH FIRST TOKEN STRING > 2 OR 0)
		XRA		A
		STA		OSP				;ZERO OPERATOR STACK POINTER
		STA		VSP
		DCR		A				;255
		STA		UNARY
		LXI		H, 0
		SHLD	EVALUE
;
OP0:							;ARRIVE HERE WITH NEXT ITEM ALREADY SCANNED
		CALL	ENDEXP			;DONE?
		JNZ		OP1
								;EMPTY THE OPERATOR STACK
EMPOP:
		LXI		H, OSP
		MOV		A, M			;GET THE OSP AND CHECK FOR EMPTY
		ORA		A
		JZ		CHKVAL			;JUMP IF EMPTY
		DCR		M				;POP ELEMENT
		MOV		E, A			;COPY FOR DOUBLE ADD
		DCR		E
		MVI		D, 0
		LXI		H, OPERV
		DAD		D				;INDEXED - OPERV(OSP)
		MOV		A, M			;GET OPERATOR
		CALL	APPLY			;APPLY OPERATOR
		JMP		EMPOP
;
CHKVAL:
		LDA		VSP				;MUST HAVE ONE ELEMENT IT THE STACK
		CPI		2
		CNZ		ERREX
		LDA		PBUFF
		CPI		' '
		RNZ						;EVALUE REMAINS AT ZERO
		LHLD	VSTACK			;GET DOUBLE BYTE IN STACK
		SHLD	EVALUE
		RET
;
OP1:							;MORE TO SCAN
		LDA		PBUFF
		CPI		' '
		JNZ		GETOP
		LDA		TOKEN
		CPI		STRNG			;IS THIS A STRING?
		JNZ		OP3
;
								;STRING - CONVERT TO DOUBLE PRECISION
		LDA		ACCLEN
		ORA		A
		CZ		ERREX			;ERROR IF LENGTH=0
		CPI		3
		CNC		ERREX			;ERROR IF LENGTH>2
		MVI		D, 0
		LXI		H, ACCUM
		MOV		E, M			;LSBYTE
		INX		H
		DCR		A				;A HAS THE LENGTH
		JZ		OP2				;ONE OR TWO BYTES
		MOV		D, M			;FILL HIGH ORDER
OP2:
		XCHG					;VALUE TO H,L
		JMP		STNUM			;STORE TO STACK
;
OP3:							;NOT A STRING, CHECK FOR NUMBER
		CPI		NUMB
		JNZ		OP4
		LHLD	VALUE			;NUMERIC VALUE
		JMP		STNUM
;
OP4:							;NOT STRING OR NUMBER, MUST BE ID OR SPECL
		CALL	BGET			;BINARY SEARCH, GET ATTRIBUTES
		JNZ		OP6				;MATCH?
								;YES, MAY BE OPERATOR
		CPI		OPER+1
		JNC		OP5
								;OPERATOR ENCOUNTERED MS NIBBLE OF B IS PRIORITY NUMBER LS NIBBLE
								;IS THE OPERATOR
								;ACC HAS THE OPERATOR NUMBER, B HAS PRIORITY
		CPI		LPAR			;(?
		MOV		C, A			;SAVE COPY OF OPERATOR NUMBER
		LDA		UNARY
		JNZ		OPER1			;JUMP IF NOT A (
;       ( ENCOUNTERED, UNARY MUST BE TRUE
		ORA		A
		CZ		ERREX
		MVI		A, 0FFH
		STA		UNARY			;UNARY IS SET TRUE
		MOV		A, C			;RECOVER OPERATOR
		JMP		OPER4			;CALLS STKO AND SETS UNARY TO TRUE
;
;
OPER1:							;NOT A LEFT PAREN
		ORA		A
		JNZ		OPER6			;MUST BE + OR - SINCE UNARY IS SET
;
								;UNARY NOT SET, MUST BE BINARY OPERATOR
OPER2:							;COMPARE HIERARCHY OF TOS
		PUSH	B				;SAVE PRIORITY AND OPERATOR NUMBER
		LDA		OSP
		ORA		A
		JZ		OPER3			;NO MORE OPERATORS IN STACK
		MOV		E, A			;OSP TO E
		DCR		E				;OSP-1
		MVI		D, 0
		LXI		H, HIERV
		DAD		D				;HL ADDRESSES TOP OF OPERATOR STACK
		MOV		A, M			;PRIORITY OF TOP OPERATOR
		CMP		B				;CURRENT GREATER?
		JC		OPER3			;JUMP IF SO
								;APPLY TOP OPERATOR TO VALUE STACK
		LXI		H, OSP
		MOV		M, E			;OSP-OSP-1
		LXI		H, OPERV
		DAD		D
		MOV		A, M			;OPERATOR NUMBER TO ACC
		CALL	APPLY
		POP		B				;RESTORE OPERATOR NUMBER AND PRIORITY
		JMP		OPER2			;FOR ANOTHER TEST
;
OPER3:							;ARRIVE HERE WHEN OPERATOR IS STACKED
								;CHECK FOR RIGHT PAREN BALANCE
		POP		B				;OPERATOR NUMBER IN C, PRIORITY IN B
		MOV		A, C
		CPI		RPAR
		JNZ		OPER4			;JUMP IF NOT A RIGHT PAREN
;
								;RIGHT PAREN FOUND, STACK MUST CONTAIN LEFT PAREN TO DELETE
		LXI		H, OSP
		MOV		A, M
		ORA		A				;ZERO?
		JZ		LPERR			;PAREN ERROR IF SO
		DCR		A				;OSP-1
		MOV		M, A			;STORED TO MEMORY
		MOV		E, A
		MVI		D, 0
		LXI		H, OPERV
		DAD		D
		MOV		A, M			;TOP OPERATOR IN REG-A
		CPI		LPAR
		JZ		NLERR			;JMP IF NO ERROR - PARENS BALANCE
LPERR:
		CALL	ERREX
NLERR:							;ERROR REPORTING COMPLETE
		XRA		A
		JMP		OPER5			;TO CLEAR UNARY FLAG
;
OPER4:							;ORDINARY OPERATOR
		CALL	STKO
		MVI		A, 0FFH			;TO SET UNARY FLAG
OPER5:
		STA		UNARY
		JMP		GETOP			;FOP ANOTHER ELEMENT
;
OPER6:							;UNARY SET, MUST BE + OR -
		MOV		A, C			;RECALL OPERATOR
		CPI		PLUS
		JZ		GETOP			;IGNORE UNARY PLUS
		CPI		MINUS
		JNZ		CHKNOT
		INR		A				;CHANGE TO UNARY  MINUS
		MOV		C, A
		JMP		OPER2
CHKNOT:							;UNARY  NOT SYMBOL?
		CPI		NOTF
		CNZ		ERREX
		JMP		OPER2
;
OP5:							;ELEMENT FOUND IN TABLE, NOT AN OPERATOR
		CPI		PT				;PSEUDO OPERATOR?
		CZ		ERREX			;ERROR IF SO
		MOV		L, B			;GET LOW VALUE TO L
		MVI		H, 0			;ZERO HIGH ORDER BYTE
		JMP		STNUM			;STORE IT
;
OP6:							;NOT POUND IN TABLE SCAN, $?
		LDA		TOKEN
		CPI		SPECL
		JNZ		OP7
		LDA		ACCUM
		CPI		'$'
		JZ		CURPC			;USE CURRENT PC
		CALL	ERREX
		LXI		H, 0
		JMP		STNUM
CURPC:
		LHLD	ASPC			;GET CURRENT PC
		JMP		STNUM
:
0P7:							;NOT $, LOOK IT UP
		CALL	LOOKUP
		CALL	FOUND
		JNZ		FIDENT
								;NOT FOUND IN SYMBOL TABLE, ENTER IF PASS 1
		MVI		A, 'P'
		CALL	PERR
		CALL	ENTER			;ENTER SYMBOL WITH ZERO TYPE FIELD
		JMP		FIDE0
FIDENT:
		CALL	GETTY			;TYPE TO H,L
		ANI		111B
		MVI		A, 'U'
		CZ		PERR
;
FIDE0:
		CALL	GETVAL			;VALUE TO H,L
;
STNUM:							;STORE H,L TO VALUE STACK
		LDA		UNARY
		ORA		A				;UNARY OPERATION SET
		XRA		ARREX			;OPERAND ENCOUNTERED WITH UNARY OFF
		STA		UNARY			;SET TO OFF
		CALL	STKV			;STACK THE VALUE
;
GETOP:
		CALL	SCAN
		JMP		OP0
;
ERREX:							;PUT 'E' ERROR IN OUTPUT BUFFER
		PUSH	H
		MVI		A, 'E'
		CALL	PERR
		POP		H
		RET
;
		ENDMOD	EQU ($ AND 0FFE0H) + 20H	;NEXT HALF PAGE
		END
;		CP/M RESIDENT ASSEMBLER MAIN PROGRAM

;                COPYRIGHT (C) 1976
;                 GARY A.   KILDALL
;
		ORG		1BA0H
;		MODULE ENTRY POINTS
		IOMOD	EQU 200H		;IO MODULE
		SCMOD	EQU 1100H		;SCANNER MODULE
		SYMOD	EQU 1340H		;SYMBOL TABLE MODULE
		BMOD	EQU 15A0H		;BINARY SEARCH MODULE
		OPMOD	EQU 1860H		;OPERAND SCAN MODULE
;
		SETUP	EQU IOMOD+3H	;FILE SETUP FOR EACH PASS
		PCON	EQU IOMOD+12H	;WRITE CONSOLE BUFFER TO CR
		WOBUFF	EQU IOMOD+15H	;WRITE PRINT BUFFER AND REINITIALIZE
		PERR	EQU IOMOD+18H	;WRITE ERROR CHARACTER TO PRINT BUFFER
		DHEX	EQU IOMOD+1BH	;SEND HEX CHARACTER TO MACHINE CODE FILE
		EOR		EQU IOMOD+1EH	;END OF PROCESSING, CLOSE FILES AND TERMINATE
;
		INITS	EQU SCMOD+3H	;INITIALIZE SCANNER MODULE
		SCAN	EQU SCMOD+6H	;SCAN NEXT TOKEN
;
		INISY	EQU SYMOD+3H	;INITIALIZE SYMBOL TABLE
		LOOKUP	EQU SYMOD+6H	;LOOKUP SYMBOL IN ACCUMULATOR
		FOUND	EQU SYMOD+9H	;FOUND IF NZ FLAG
		ENTER	EQU SYMOD+0CH	;ENTER SYMBOL IN ACCUMULATOR
		SETTY	EQU SYMOD+0FH	;SET TYPE FIELD
		GETTY	EQU SYMOD+12H	;GET TYPE FIELD
		SETVAL	EQU SYMOD+15H	;SET VALUE FIELD
		GETVAL	EQU SYMOD+18H	;GET VALUE FIELD
;
		BGET	EQU BMOD+6H		;BINARY SEARCH AND GET TYPE/VALUE PAIR
;
		OPAND	EQU OPMOD+3H	;GET OPERAND VALUE TO 'EVALUE'
		MULF	EQU OPMOD+6H	;MULT D,E BY H,L TO H,L
		DIVF	EQU OPMOD+9H	;DIVIDE HL BY DE, RESULT TO DE
;
;
;		COMMON EQUATES
		PBMAX	EQU 120			;MAX PRINT SIZE
		PBUFF	EQU 10CH		;PRINT BUFFER
		PBP		EQU PBUFF+PBMAX	;PRINT BUFFER POINTER
;
		TOKEN	EQU PBP+1		;CURRENT TOKEN UDER SCAN
		VALUE	EQU TOKEN+1		;VALUE OF NUMBER IN BINARY
		ACCLEN	EQU VALUE+2		;ACCUMULATOR LENGTH
		ACMAX	EQU 64			;MAX ACCUMULATOR LENGTH
		ACCUM	EQU ACCLEN+1
;
		EVALUE	EQU ACCUM+ACMAX	;VALUE FROM EXPRESSION ANALYSIS
;
		SYTOP	EQU EVALUE+2	;CURRENT SYMBOL TOP
		SYMAX	EQU SYTOP+2		;MAX ADDRESS+1
;
		PASS	EQU SYMAX+2		;CURRENT PASS NUMBER
		FPC		EQU PASS+1		;FILL ADDRESS FOR NEXT HEX BYTE
		ASPC	EQU FPC+2		;ASSEMBLER'S PSEUDO PC
		SVBAS	EQU ASPC+2		;BASE OF SYMBOL TABLE
		SYADR	EQU SYBAS+2		;CURRENT SYMBOL ADDRESS
;
;		GLOBAL EQUATES
		IDEN	EQU 1			;IDENTIFIER
		NUMB	EQU 2			;NUMBER
		STRNG	EQU 3			;STRING
		SPECL	EQU 4			;SPECIAL CHARACTER
;
		PLABT	EQU 0001B		;PROGRAM LABEL
		DLABT	EQU 0010B		;DATA LABEL
		EQUT	EQU 0100B		;EQUATE
		SETT	EQU 0101B		;SET
		MACT	EQU 0110B		;MACRO
;
		EXTT	EQU 1000B		;EXTERNAL
		REFT	EQU 1011B		;REFER
		GLBT	EQU 1100B		;GLOBAL
;
		CR		EQU 0DH			;CARRIAGE RETURN
		LF		EQU 0AH			;LINE FEED
		EOF		EQU 1AH			;END OF FILE
		NBMAX	EQU 16			;STARTING POSITION OF PRINT LINE
;
;
		RT		EQU 16			;REGISTER TYPE
		PT		EQU RT+1		;PSEUDO OPERATION
		PENDIF	EQU 5			;PSEUDO OPERATOR 'ENDIF'
		OBASE	EQU PT+1
		O1		EQU OBASE+1		;FIRST OPERATOR
		O15		EQU OBASE+15	;LAST OPERATOR
;
;		MAIN STATEMENT PROCESSING LOOP
		XRA		A
		STA		PASS			;SET TO PASS 0 INITIALLY
		CALL	INISY			;INITIALIZE THE SYMBOL TABLE
RESTART:						;PASS LOOP GOES FROM 0 TO 1
		CALL	INITS			;INITIALIZE THE SCANNER
		CALL	SETUP			;SET UP THE INPUT FILE
		LXI		H, 0
		SHLD	SYLAB			;ASSUME NO STARTING LABEL
		SHLD	FPC
		SHLD	ASPC
		SHLD	EPC				;END PC
;
SCNEXT:							;SCAN THE NEXT INPUT ITEM
		CALL	SCAN
SCN0:
		LDA		TOKEN
		CPI		NUMB			;SKIP LEADING NUMBERS FROM LINE EDITORS
		JZ		SCNEXT
		CPI		SPECL			;MAY BE PROCESSOR TECH'S COMMENT
		JNZ		SCN1
								;SPECIAL CHARACTER, CHECK FOR *
		LDA		ACCUM
		CPI		'*'
		JNZ		CHEND			;END OF LINE IF NOT *
;       * FOUND, NO PRECEDING LABEL ALLOWED
		CALL	SETLA
		JNZ		STERR			;ERROR IF LABEL
		JMP		CHEN1			;SCAN THE COMMENT OTHERWISE
;
SCN1:							;NOT NUMBER OR SPECIAL CHARACTER, CHECK FOR IDENTIFIER
		CPI		IDEN
		JNZ		STERR			;ERROR IF NOT
;
								;IDENTIFIER FOUND, MAY BE LABEL, OPCODE, OR MACRO
		CALL	BGET			;BINARY SEARCH FIXED DATA
		JZ		CHKPT			;CHECK FOR PSEUDO OR REAL OPERATOR
;
								;BINARY SEARCH WAS UNSUCCESSFUL, CHECK FOR MACRO
		CALL	LOOKUP
		CALL	FOUND
		JNZ		LFOUN			;NZ FLAG SET IF FOUND
;
								;NOT FOUND, ENTER IT
		CALL	ENTER			;THIS MUST BE PASS
		LDA		PASS
		ORA		A
		CNZ		ERRP			;PHASE ERROR IF NOT
		JMP		SETSY			;SET SYLAB
;
								;ITEM WAS FOUND, CHECK FOR MACRO
LFOUN:
		CALL	GETTY
		CPI		MACT
		JNZ		SETSY
;
								;MACRO DEFINITION FOUND, EXPAND MACRO
		CALL	ERRN			;NOT CURRENTLY IMPLEMENTED
		JMP		CHEN1			;SCANS TO END OF CURRENT LINE
;
SETSY:							;LABEL FOUND - IS IT THE ONLY ONE?
		LHLD	SYLAB
		MOV		A, L
		ORA		H
		CNZ		ERRL			;LABEL ERROR IF NOT
		LHLD	SYADR			;ADDRESS OF SYMBOL
		SHLD	SYLAB			;MARK AS LABEL FOUND
;
								;LABEL FOUND, SCAN OPTIONAL ':'
		CALL	SCAN
		LDA		TOKEN
		CPI		SPECL
		JNZ		SCN0			;SKIP NEXT SCAN IF NOT SPECIAL
		LDA		ACCUM
		CPI		':'
		JNZ		SCN0
		JMP		SCNEXT			;TO IGNORE ':'
;
								;BINARY SEARCH FOUND SYMBOL, CHECK FOR PSEUDO OR REAL OP
CHKPT:
		CPI		PT				;PSEUDO OPCODE?
		JNZ		CHKOT
;
								;PSEUDO OPCODE FOUND, BRANCH TO CASES
		MOV		E, B			;B HAS PARTICULAR OPERATOR NUMBER
		MVI		D, 0			;DOUBLE PRECISION VALUE TO D,E
		DCX		D				;BIASED BY +1
		LXI		H, PTTAB		;BASE OF JUMP TABLE
		DAD		D
		DAD		D
		MOV		E, M
		INX		H
		MOV		H, M
		MOV		L, E
		PCHL					;JUMP INTO TABLE
;
PTTAB:							;PSEUDO OPCODE JUMP TABLE
		DW		SDB				;DB
		DW		SDS				;DS
		DW		SDW				;DW
		DW		SEND			;END
		DW		SENDIF			;ENDIF
		DW		SENDM			;ENDM
		DW		SEQU			;EQU
		DW		SIF				;IF
		DW		SMACRO			;MACRO
		DW		SORG			;ORG
		DW		SSET			;SET
		DW		STITLE			;TITLE
;
SDB:
		CALL	FILAB			;SET LABEL FOR THIS LINE TO ASPC
SDB0:
		CALL	SCAN			;PAST DB TO NEXT ITEM
		LDA		TOKEN			;LOOK FOR LONG STRING
		CPI		STRNG
		JNZ		SDBC			;SKIP IF NOT STRING
		LDA		ACCLEN
		DCR		A				;LENGTH 1 STRING?
		JZ		SDBC
								;LENGTH 0,2,... STRING
		MOV		B, A
		INR		B
		INR		B				;BECOMES 1,3,... FOR 0,2,... LENGTHS
		LXI		H, ACCUM		;ADDRESS CHARACTERS IN STRING
SDB1:
		DCR		B				;COUNT DOWN TO ZERO
		JZ		SDB2			;SCAN DELIMITER AT END OF STRING
		PUSH	B				;SAVE COUNT
		MOV		B, M			;GET CHARACTER
		INX		H
		PUSH	H				;SAVE ACCUM POINTER
		CALL	FILHB			;SEND TO HEX FILE
		POP		H
		POP		B
		JMP		SDB1
SDB2:
		CALL	SCAN			;TO THE DELIMITER
		JMP		SDB3
;
								;NOT A LONG STRING
SDBC:
		CALL	OPAND			;COMPUTE OPERAND
		LHLD	EVALUE			;VALUE TO H,L
		MOV		A, H
		ORA		A				;HIGH ORDER MUST BE ZERO
		CNZ		ERBD			;DATA ERROR
		MOV		B, L			;GET LOW BYTE
		CALL	FILHB
SDB3:							;END OF ITEM - UPDATE ASPC
		CALL	SETAS			;SET ASPC TO FPC
		CALL	DELIM
		CPI		','
		JZ		SDB0			;FOR ANOTHER ITEM
		JMP		CHEND			;CHECK END OF LINE SYNTAX
;
SDS:
		CALL	FILAB			;HANDLE LABEL IF IT OCCURRED
		CALL	PADD			;PRINT ADDRESS
		CALL	EXP16			;SCAN AND GET 16BIT OPERAND
		XCHG					;TO D,E
		LHLD	ASPC			;CURRENT PSEUDO PC
		DAD		D				;+EXPRESSION
		SHLD	ASPC
		SHLD	FPC				;NEXT TO FILL
		JMP		CHEND
;
SDW:
		CALL	FILAB			;HANDLE OPTIONAL LABEL
SDW0:
		CALL	EXP16			;GET 16BIT OPERAND
		PUSH	H				;SAVE A COPY
		MOV		B, L			;LOW BYTE FIRST
		CALL	FILHB			;SEND LOW BYTE
		POP		H				;RECLAIM A COPY
		MOV		B, H			;HIGH BYTE NEXT
		CALL	FILHB			;SEND HIGH BYTE
		CALL	SETAS			;SET ASPC=FPC
		CALL	DELIM			;CHECK DELIMITER SYNTAX
		CPI		','
		JZ		SDW0			;GET MORE DATA
		JMP		CHEND
;
SEND:
		CALL	FILAB
		CALL	PADD			;WRITE LAST LOC
		LDA		PBUFF
		CPI		' '
		JNZ		CHEND
		CALL	EXP16			;GET EXPRESSION IF IT'S THERE
		LDA		PBUFF
		CPI		' '
		JNZ		SEND0
		SHLD	EPC				;EXPRESSION FOUND, STORE IT FOR LATER
SEND0:
		MVI		A, ' '
		STA		PBUFF			;CLEAR ERROR, IF IT OCCURRED
		CALL	SCAN			;CLEAR CR
		LDA		TOKEN
		CPI		SPECL
		JNZ		STERR
		LDA		ACCUM
		CPI		LF
		JNZ		STERR
		JMP		ENDAS			;END OF ASSEMBLER
;
SENDIF:
		JMP		POEND
;
SENDM:
		CALL	ERRN
		JMP		POEND
;
SEQU:
		CALL	SETLA
		JZ		STERR			;MUST BE A LABEL
		LHLD	ASPC			;HOLD TEMP ASPC
		PUSH	H				;IN STACK
		CALL	EXP16			;GET 16BIT OPERAND
		SHLD	ASPC			;VALUE OF EXPRESSION
		CALL	FI LAB
		CALL	PADDR			;COMPUTED VALUE
		LXI		H, PBUFF+6		;SPACE AFTER VALUE
		MVI		M, '='
		POP		H				;REAL ASPC
		SHLD	ASPC			;CHANGE BACK
		JMP		CHEND
;
SIF:
		CALL	FILAB			;IN CASE OF LABEL
		CALL	EXP16			;GET IF EXPRESSION
		LDA		PBUFF
		CPI		' '
		JNZ		CHEND			;SKIP IF ERROR
		MOV		A, L			;GET LSB
		RAR
		JC		CHEND			;TRUE IF CARRY BIT SET
;
								;SKIP TO EOF OR ENDIF
SIF0:
		CALL	SCAN
		LDA		TOKEN
		CPI		SPECL
		JNZ		SIF1
		LDA		ACCUM
		CPI		EOF
		MVI		A, 'B'			;BALANCE ERROR
		CZ		PERR
		JZ		ENDAS
		JMP		SIF0			;FOR ANOTHER
SIF1:							;NOT A SPECIAL CHARACTER
		CPI		IDEN
		JNZ		SIF0			;NOT AN IDENTIFIER
		CALL	BGET			;LOOK FOR ENDIF
		JNZ		SIF0			;NOT FOUND
		CPI		PT				;PSEUDO OP?
		JNZ		SIF0
		MOV		A, B			;GET OPERATOR NUMBER
		CPI		PENDIF			;ENDIF?
		JNZ		SIF0			;GET ANOTHER TOKEN
		JMP		POEND			;OK, CHECK END OF LINE
;
SMACRO:
		CALL	ERRN
		JMP		CHEND
;
SORG:
		CALL	EXP16
		LDA		PBUFF
		CPI		' '
		JNZ		CHEND			;SKIP ORG IF ERROR
		SHLD	ASPC			;CHANGE PC
		SHLD	FPC				;CHANGE NEXT TO HIT
		CALL	FILAB			;IN CASE OF LABEU
		CALL	PADD
		JMP		CHEND
;
SSET:
		CALL	SETLA
		JZ		STERR			;MUST BE LABELLED1)
;
		CALL	GETTY
		CPI		SETT
		CNZ		ERRL			;LABEL ERROR
		MVI		A, SETT
		CALL	SETTY			;REPLACE TYPE WITH 'SET'
		CALL	EXP16			;GET THE EXPRESSION
		PUSH	H				;SAVE IT
		CALL	SFTLA			;RE-ADDRESS LABEL
		POP		H				;RECLAIM IT
		CALL	SETVAL
		LXI		H, 0
		SHLD	SYLAB			;PREVENT LABEL PROCESSING
		JMP		CHEND
;
;
STITLE:
		CALL	ERRN			;NOT IMPLEMENTED
;
POEND:							;PSEUDO OPERATOR END - SCAN TO NEXT TOKEN
		CALL	SCAN
		JMP		CHEND
;
								;NOT A PSEUDO OPCODE, CHECK FOR REAL OPCODE
CHKOT:
		SUI		01				;BASE OF OPCODES
		CPI		015				;PAST LAST OPCODE?
		JNC		STERR			;STATEMENT ERROR IF SO
;
								;FOUND OPCODE, COMPUTE INDEX INTO TABLE AND JUMP TO CASE
		MOV		E, A
		MVI		D, 0
		LXI		H, OPTAB
		DAD		D
		DAD		D
		MOV		E, M
		INX		H
		MOV		H, M
		MOV		L, E
		PCHL					;JUMP TO CASE
;
OPTAB:							;OPCODE CATEGORIES
		DW		SSIMP			;SIMPLE
		DW		SLXI			;LXI
		DW		SDAD			;DAD
		DW		SPUSH			;PUSH/POP
		DW		SJMP			;JMP/CALL
		DW		SMOV			;MOV
		DW		SMVI			;MVI
		DW		SACCI			;ACCUM IMMEDIATE
		DW		SLDAX			;LDAX/STAX
		DW		SLHLD			;LHLD/SHLD/LDA/STA
		DW		SACCR			;ACCUM-REGISTER
		DW		SINC			;INC/DCR
		DW		SINX			;INX/DCX
		DW		SRST			;RESTART
		DW		SIN				;IN/OUT
;
SSIMP:							;SIMPLE OPERATION CODES
		CALL	FILHB			;SEND HEX VALUE TO MACHINE CODE FILE
		CALL	SCAN			;TO NEXT TOKEN
		JMP		INCPC
;
SLXI:							;LXI H,16B
		CALL	SHDREG			;SCAN DOUBLE PRECISION REGISTER
		CALL	CHCOM			;CHECK FOR COMMA FOLLOWING REGISTER
		CALL	SETADR			;SCAN AND EMIT DOUBLE PRECISION OPERAND
		JMP		INCPC
;
SDAD:							;DAD B
		CALL	SHDREG			;SCAN AND EMIT DOUBLE PRECISION REGISTER
		JMP		INCPC
;
SPUSH:							;PUSH B  POP D
		CALL	SHREG			;SCAN SINGLE PRECISION REGISTER TO A
		CPI		111000B			;MAY BE PSW
		JZ		SPU0
								;NOT PSW, MUST BE B,D, OR H
		ANI		0010000B		;LOW BIT MUST BE 0
		CNZ		ERRR			;REGISTER ERROR IF NOT
SPU0:
		MOV		A, C			;RECALL REGISTER AND MASK IN CASE OF ERROR
		ANI		110000B
		ORA		B				;MASK IN OPCODE FOR PUSH OR POP
		JMP		FILINC			;FILL HEX VALUE AND INCREMENT PC
;
SJMP:							;JMP 16B/ CALL 16B
		CALL	FILHB			;EMIT JMP  OR CALL OPCODE
		CALL	SETADR			;EMIT 16BIT OPERAND
		JMP		INCPC
;
SMOV:							;MOV A,B
		CALL	SHREG
		ORA		B				;MASK IN OPCODE
		MOV		B, A			;SAVE IN B TEMPORARILY
		CALL	CHCOM			;MUST BE COMMA SEPARATOR
		CALL	EXP3			;VALUE MUST BE 0-7
		ORA		B				;MASK IN OPCODE    CPM VERSION
		JMP		FILINC
;
SMVI:							;MVI A,8B
		CALL	SHREG
		ORA		B				;MASK IN OPCODE
		CALL	FILHEX			;EMIT OPCODE
		CALL	CHCOM			;SCAN COMMA
		CALL	SETBYTE			;EMIT 8BIT VALUE
		JMP		INCPC
;
SACCI:							;ADI 8B
		CALL	FILHB			;EMIT IMMEDIATE OPCODE
		CALL	SETBYTE			;EMIT 8BIT OPERAND
		JMP		INCPC
;
SLDAX:							;LDAX B/STAX D
		CALL	SHREG
		ANI		101000B			;MUST BE B OR D
		CNZ		ERRR			;REGISTER ERROR IF NOT
		MOV		A, C			;RECOVER REGISTER NUMBER
		ANI		010000B			;CHANGE TO B OR D IF ERROR
		ORA		B				;MASK IN OPCODE
		JMP		FILING			;EMIT OPCODE
;
SLHLD:							;LHLD 16B/ SHLD 16B/ LDA 16B/ STA 16B
		CALL	FILHB			;EMIT OPCODE
		CALL	SETADR			;EMIT OPERAND
		JMP		INCPC
;
SACCR:							;ADD B
		CALL	EXP3			;RIGHT ADJUSTED 3BIT VALUE FOR REGISTER
		ORA		B				;MASK IN OPCODE
		JMP		FILINC
;
SINC:							;INR B/DCR D
		CALL	SHREG			;GET REGISTER
		ORA		B
		JMP		FILINC
;
SINX:							;INX H/DCX B
		CALL	SHREG
		ANI		001000B			;MUST BE B D M OR SP
		CNZ		ERRR			;REGISTER ERROR IF NOT
		MOV		A, C			;RECOVER REGISTER
		ANI		110000B			;IN CASE 0F ERROR
		ORA		B				;MASK IN OPCODE
		JMP		FILINC
;
SRST:							;RESTART 4
		CALL	SHREG			;VALUE IS 0-7
		ORA		B				;OPCODE MASKED
		JMP		FILINC
;
SIN:							;IN 8B/0UT 8B
		CALL	FILHB			;EMIT OPCODE
		CALL	SETBYTE			;EMIT 8BIT OPERAND
		JMP		INCPC
;
FILINC:							;FILL HEX VALUE FROM A, BEFORE INCREMENTING PC
		CALL	FILHEX
;
INCPC:							;CHANGE ASSEMBLER'S PSEUDO PROGRAM COUNTER
		CALL	FILAB			;SET ANY LABELS WHICH OCCUR ON THE LINE
		CALL	SETAS			;ASPC=FPC
		JMP		CHEND			;END OP LINE SCAN
;
;
								;UTILITY SUBROUTINES FOR OPERATION CODES
;
DELIM:							;CHECK DELIMITER SYNTAX FOR D^TA STATEMENTS
		LDA		TOKEN
		CPI		SPECL
		CNZ		ERRD
		LDA		ACCUM
		CPI		','
		RZ
		CPI		';'
		RZ
		CPI		CR
		CNZ		ERRD
		RET
;
EXP16:							;GET 16BIT VALUE TO H,L
		PUSH	B
		CALL	SCAN			;START SCANNING OPERAND FIELD
		CALL	OPAND
		LHLD	EVALUE			;VALUE TO H,L
		POP		B
		RET
;
EXP8:							;GET 8BIT VALUE TO REG A
		CALL	EXP16
		MOV		A, H
		ORA		A
		CNZ		ERRV			;VALUE ERROR IF HIGH BYTE NOT ZERO
		MOV		A, L
		RET
;
EXP3:							;GET 3BIT VALUE TO REG A
		CALL	EXP8
		CPI		8
		CNC		ERRV			;VALUE ERROR IF >=8
		ANI		111B			;REDUCE IF ERROR OCCURS
		RET
;
SHREG:							;GET 3BIT VALUE AND SHIFT LEFT BY
		CALL	EXP3
		RAL
		RAL
		RAL
		ANI		111000B
		MOV		C, A			;COPY TO C
		RET
;
SHDREG:							;GET DOUBLE REGISTER TO A
		CALL	SHREG
		ANI		001000B			;CHECK FOR A,C,E, OR L
		CNZ		ERRR			;REGISTER ERROR
		MOV		A, C			;RECOVER REGISTER
		ANI		110000B			;FIX IT IF ERROR OCCURRED
		ORA		B				;MASK OPCODE
		JMP		FILHEX			;EMIT IT
;
SETBYTE:						;EMIT 16BIT OPERAND
		CALL	EXP8
		JMP		FILHEX
;
SETADR:							;EMIT 16BIT OPERAND
		CALL	EXP16
		JMP		FILADR
;
CHCOM:							;CHECK FOR COMMA FOLLOWING EXPRESSION
		PUSH	PSW
		PUSH	B
		LDA		TOKEN
		CPI		SPECL
		JNZ		COMER
								;SPECIAL CHARACTER, CHECK FOR COMMA
		LDA		ACCUM
		CPI		','
		JZ		COMRET			;RETURN IF COMMA FOUND
COMER:							;COMMA ERROR
		MVI		A, 'C'
		CALL	PERR
COMRET:
		POP		B
		POP		PSW
		RET
;
CHEND:							;END OF LINE CHECK
		CALL	FILAB			;IN CASE OF A LABEL
		LDA		TOKEN
		CPI		SPECL
		JNZ		STERR			;MUST BE A SPECIAL CHARACTER
		LDA		ACCUM
		CPI		CR				;CARRIAGE RETURN
		JNZ		CHEN0
								;CARRIAGE RETURN FOUND, SCAN PICKS UP LF AND PUSHES LINE
		CALL	SCAN
		JMP		SCNEXT
;
CHEN0:							;NOT CR, CHECK FOR COMMENT
		CPI		':'
		JNZ		CHEN2
		CALL	FILAB			;IN CASE LABELLED EMPTY LINE
								;CLEAR COMMENT TO END OF LINE
CHEN1:
		CALL	SCAN
		LDA		TOKEN
		CPI		SPECL
		JNZ		CHEN1
		LDA		ACCUM
		CPI		LF
		JZ		SCNEXT
		CPI		EOF
		JZ		ENDAS			;END 0F ASSEMBLY IF EOF
		CPI		'!'
		JZ		SCNEXT			;LOGICAL END OF LINE
		JMP		CHEN1			;NONE OF THE ABOVE
;
								;NOT CR OP LF. MAY BE LOGICAL END OF LINE
CHEN2:
		CPI		'!'
		JZ		SCNEXT
		CPI		EOF
		JZ		ENDAS
;
								;STATEMENT ERROR IN OPERAND FIELD
STERR:
		MVI		A, 'S'
		CALL	PERR
		JMP		CHEN1			;TO DUMP LINE
;
DIFF:							;COMPUTE DE-HL TO HL
		MOV		A, E
		SUB		L
		MOV		L, A
		MOV		A, D
		SBB		H
		MOV		H, A
		RET
;
ENDAS:							;END OF ASSEMBLY FOR THIS PASS
		LXI		H, PASS
		MOV		A, M
		INR		M				;PASS NUMBER INCREMENTED
		ORA		A
		JZ		RESTART
		CALL	SCAN			;TO CLEAR LAST LINE FEED
		CALL	PADD			;WRITE LAST ADDRESS
		LXI		H, PBUFF+5
		MVI		M, CR			;SET TO CR FOR END OF MESSAGE
		LXI		H, PBUFF+1
		CALL	PCON			;PRINT LAST ADDRESS
;
								;COMPUTE REMAINING SPACE
		LHLD	SYTOP
		XCHG
		LHLD	SYBAS
		CALL	DIFF			;DIFFERENCE TO H,L
		PUSH	H				;SYTOP-SYBAS TO STACK
		LHLD	SYMAX
		XCHG
		LHLD	SYBAS
		CALL	DIFF			;SYMAX-SYBAS TO H,L
		MOV		E, H
		MVI		D, 0			;DIVIDED BY 256
		POP		H				;SYTOP-SYBAS TO H,L
		CALL	DIVF			;RESULT TO DE
		XCHG
		CALL	PADDR			;PRINT H,L TO PBUFF
		LXI		H, PBUFF+5		;MESSAGE
		LXI		D, EMSG			;END MESSAGE
ENDA0:
		LDAX	D
		ORA		A				;ZERO?
		JZ		ENDA1
		MOV		M, A
		INX		H
		INX		D
		JMP		ENDA0
;
EMSG:
		DB		'H USE FACTOR', CR, 0
;
ENDA1:
		LXI		H, PBUFF+2		;BEGINNING OF RATIO
		CALL	PCON
		LHLD	EPC
		SHLD	FPC				;END PROGRAM COUNTER
		JMP		EOR
;
;		UTILITY SUBROUTINES
COMDH:							;COMPARE D,E WITH H,L FOR EQUALITY (NZ FLAG IF NOT EQUAL)
		MOV		A, D
		CMP		H
		RNZ
		MOV		A, E
		CMP		L
		RET
;
SETAS:							;ASPC=FPC
		LHLD	PPC
		SHLD	ASPC
		RET
;
SETLA:							;SYADR-SYLAB, FOLLOWED BY CHECK FOR ZERO
		LHLD	SYLAB
		SHLD	SYADR
		CALL	FOUND
		RET
:
FILAB:							;FILL LABEL VALUE WITH CURRENT ASPC, IF LABEL FOUND
		CALL	SETLA
		RZ						;RETURN IF NO LABEL DETECTED
;
								;LABEL FOUND, MUST BE DEFINED ON PASS-1
		LXI		H, 0
		SHLD	SYLAB			;TO MARK NEXT STATEMENT WITH NO LABEL
		LDA		PASS
		ORA		A
		JNZ		FIL1
;
								;PASS 0
		CALL	GETTY
		PUSH	PSW				;SAVE A COPY OF TYPE
		ANI		111B			;CHECK FOR UNDEFINED
		CNZ		ERRL			;LABEL ERROR
		POP		PSW				;RESTORE TYPE
		ORI		PLABT			;SET TO LABEL TYPE
		CALL	SETTY			;SET TYPE FIELD
		LHLD	ASPC			;GET CURRENT PC
		CALL	SETVAL			;PLACE INTO VALUE FIELD
		RET
;
FIL1:							;CHECK FOR DEFINED VALUE
		CALL	GETTY
		ANI		111B
		CZ		ERRP			;PHASE ERROR
								;GET VALUE AND COMPARE WITH ASPC
		CALL	GETVAL			;TO H,L
		XCHG
		LHLD	ASPC
		CALL	COMDH
		CNZ		ERRP			;PHASE ERROR IF NOT THE SAME
		RET
;
FILHEX:							;WRITE HEX BYTE IN REGISTER A TO MACHINE CODE FILE IF PASS
		MOV		B, A
FILHB:
		LDA		PASS
		ORA		A
		MOV		A, B
		JZ		FILHI
;
								;PASS - 1, WRITE HEX AND PRINT DATA
		PUSH	B				;SAVE A COPY
		CALL	DHEX			;INTO MACHINE CODE FILE
								;MAY BE COMPLETELY EMPTY LINE, SO CHECK ADDRESS
		LDA		PBUFF+1
		CPI		' '
		LHLD	ASPC
		CZ		PADDR			;PRINT ADDRESS FIELD
;
		LDA		NBP
		CPI		NBMAX			;TRUNCATE CODE IF TOO MUCH ON THIS LINE
		POP		B				;RECALL HEX DIGIT
		JNC		FILHI
								;ROOM FOR DIGIT ON THIS LINE
		MOV		A, B
		CALL	WHEXB			;WRITE HEX BYTE TO PRINT LINE
FILHI:
		LHLD	FPC
		INX		H
		SHLD	FPC				;READY FOR NEXT BYTE
		RET
;
FILADR:							;EMIT DOUBLE PRECISION VALUE FROM H,L
		PUSH	H				;SAVE A COPY
		MOV		B, L
		CALL	FILHB			;LOW BYTE EMITTED
		POP		H				;RECOVER A COPY OF H,L
		MOV		B, H
		JMP		FILHB			;EMIT HIGH BYTE AND RETURN
;
								;UTILITY FUNCTIONS FOR PRINTING HEX ADDRESSES AND DATA
CHEX:							;CONVERT TO HEX
		ADI		'0'
		CPI		'0'+10
		RC
		ADI		'A'-'0'-10
		RET
;
WHEXN:							;WRITE HEX NIBBLE
		CALL	CHEX			;CONVERT TO ASCII FROM HEX
		LXI		H, NBP
		MOV		E, M			;NEXT POSITION TO PRINT
		MVI		D, 0			;DOUBLE PRECISION
		INR		M				;NBP=NBP+1
		LXI		H, PBUFF
		DAD		D
		MOV		M, A			;STORE IN PRINT BUFFER
		RET
;
WHEXB:							;WRITE HEX BYTE TO PRINT BUFFER
		PUSH	PSW
		RAR
		RAR
		RAR
		RAR
		ANI		0FH				;HIGH ORDER NIBBLE NORMALIZE IN A
		CALL	WHEXN			;WRITE IT
		POP		PSW
		ANI		0FH
		JMP		WHEXN			;WRITE AND RETURN
;
PADD:
		LHLD	ASPC
PADDR:							;PRINT ADDRESS FIELD OF PRINT LINE FROM H,L
		XCHG
		LXI		H, NBP			;INITIALIZE NEXT TO FILL
		PUSH	D				;SAVE A COPY OF NBP 'S' ADDRESS
		MOV		A, D			;PRINT HIGH BYTE
		PUSH	D				;SAVE A COPY
		CALL	WHEXB
		POP		D
		MOV		A, E
		CALL	WHEXB
		POP		H				;ADDRESSING NBP
		INR		M				;SKIP A SPACE AFTER ADDRESS FIELD
		RET
;
ERRR:							;EMIT REGISTER ERROR
		PUSH	PSW
		PUSH	B
		MVI		A, 'R'
		CALL	PERR
		POP		B
		POP		PSW
		RET
;
ERRV:							;EMIT VALUE ERROR
		PUSH	PSW
		PUSH	H
		MVI		A, 'V'
		CALL	PERR
		POP		H
		POP		PSW
		RET
;
ERRD:
		PUSH	PSW
		MVI		A, 'D'			;DATA ERROR
		JMP		ERR
;
ERRP:
		PUSH	PSW
		MVI		A, 'P'
		JMP		ERR
;
ERRL:
		PUSH	PSW
		MVI		A, 'L'			;LABEL ERROR
		JMP		ERR
;
ERRN:
		PUSH	PSW
		MVI		A, 'N'			;NOT IMPLEMENTED
;
ERR:
		CALL	PERR
		POP		PSW
		RET
;
SYLAB:
		DS		2				;ADDRESS OF LINE LABEL
EPC:
		DS		2				;END PC VALUE
NBP:
		DS		1				;NEXT BYTE POSITION TO WRITE FOR MACHINE CODE
		END
