TITLE	'Crowe Z80 assembler'
;COPYRIGHT 1978 BY PAT CROWE
;**********************************************************************
;                   Z80 ASSEMBLER VERSION 1.2
;            		WRITTEN BY PAT CROWE
;                       22 RINGSBURY CLOSE
;                       PURTON
;                       SWINDON
;                       SN5 9DE
;                       ENGLAND

;		THE 'LBFSZ-1' AND
;		THE "EX AF,AF'" BUGS FIXED BY
;		THOMAS HAMEENAHO
;		DJAKNEGATAN 7
;		S-754 23 UPPSALA
;		SWEDEN
;*************************************************************************
;CONSTANTS
;*************************************************************************
CR	EQU	0DH			; ASCII CARRIAGE RETURN
LF	EQU	0AH			; ASCII LINE FEED
HT	EQU	09H			; ASCII HORIZ. TAB
FORMFD	EQU	0CH			; ASCII FORM FEED
NUL	EQU	0			; ASCII NULL
SPACE	EQU	20H			; ASCII SPACE
DEL	EQU	0FFH			; ASCII DELETE
CTOK	EQU	71H			; TOKEN FOR UNCONDIT. OPND KW 'C'
CCOND	EQU	8BH			; TOKEN FOR CONDITIONAL OPND KW 'C'
XYMASK	EQU	0FBH			; MASK TO RECOGNISE IX/IY TOKENS
IXORIY	EQU	1AH			; COMMON VALUE OF IX/IY TOKENS
INTTOK	EQU	90H			; OPERAND TOKEN FOR 'INTEGER'
ORGTOK	EQU	1			; TOKEN FOR 'ORG' PSEUDO-OP
EQUTOK	EQU	2			; TOKEN FOR 'EQU' PSEUDO-OP
DEFLTK	EQU	3			; TOKEN FOR 'DEFL' PSEUDO-OP
DEFSTK	EQU	7			; TOKEN FOR 'DEFS' PSEUDO-OP
TITTOK	EQU	09H			; TOKEN FOR 'TITLE' PSEUDO-OP
DEFMTK	EQU	08H			; TOKEN FOR 'DEFM' PSUEDO-OP
PLUTOK	EQU	07H			; TOKEN FOR MONADIC PLUS
MINTOK	EQU	0FH			; TOKEN FOR MONADIC MINUS
LBTOK	EQU	0B0H			; TOKEN FOR '('
EXPTOK	EQU	35H			; TOKEN FOR EXPONENTIATION
ASKTOK	EQU	3DH			; TOKEN FOR MULTIPLY 
MAXFSK	EQU	10D			; MAX SIZE OF ARITHMETIC
					; FUNCTION STACK
MAXASK	EQU	20D			; MAX SIZE OF ARITH STACK
PLINES	EQU	66			; NO OF LINES ON LIST DEVICE PAGE
LBFSZ	EQU	64			; LINE BUFFER CAPACITY
ACBSIZ	EQU	32			; SIZE OF ASSD CODE BUFFER
TITSIZ	EQU	32			; SIZE OF TITLE BUFFER
RECSIZ	EQU	16			; MAX NO OF DATA BYTES PER OBJ RECORD
SPERL	EQU	5			; NO OF SYMBOLS PER LINE
					; IN SYMBOL TABLE LISTING
STKSIZ	EQU	68			; SIZE OF STACK

;	CP/M LINKS

CPM	EQU	5		;FDOS ENTRY
BOOT	EQU	0		;WARM START
SETDMA	EQU	26		;CP/M FUNCTION
OPNFIL	EQU	15		;OPEN FILE
CLSFIL	EQU	16		;CLOSE FILE
DELFIL	EQU	19		;DELETE FILE
MAKFIL	EQU	22		;CREATE FILE
RDNR	EQU	20		;READ NEXT RECORD
WRNR	EQU	21		;WRITE NEXT RECORD
PRBUF	EQU	9		;PRINT STRING ON CONSOLE
DFCB	EQU	5CH		;DEFAULT FCB
DEFBUF	EQU	80H		;DEFAULT BUFFER
GETCON	EQU	0F009H		;PFM-80 CONSOLE INPUT
PUTCON	EQU	0F00CH		;PFM-80 CONSOLE OUTPUT
CTLZ	EQU	1AH		;EOF CHARACTER
 
;****************************************************************************
;START OF PROGRAM.
;I/O ROUTINE JUMP TABLE.
;THE USER SHOULD PLACE THE ADDRESSES OF HIS
;OWN I/O SUBROUTINES IN THE LOCATIONS IN
;THIS TABLE CONTAINING THE DESTINATIONS OF
;JP INSTRUCTIONS. ALL I/O IS PERFORMED VIA
;THIS TABLE.
;****************************************************************************
	ORG	100H
START:	JR MAIN				; JUMP PAST JUMP TABLE
CI:	JP CONIN 			; JUMP TO USER CONSOLE IN SUBR
CO:	JP CONOUT			; JUMP TO USER CONSOLE OUT SUBR
LO:	JP LSTO  			; JUMP TO USER LIST OUT SUBR
RI:	JP RDRIN 			; JUMP TO USER READER IN SUBR
PCHO:	JP PCHOUT			; JUMP TO USER PUNCH OUT SUBR
MEMCHK:	JP MEMCK 			; JUMP TO USER MEM CHECK SUBR
EXEC:	JP BOOT  			; JUMP TO USER MONITOR ENTRY POINT
;MAIN PROGRAM LOOP.
;****************************************************************************
MAIN:   LD SP,0F900H			; SET STACK POINTER
	CALL INITA			; INITIALIZE ASSEMBLER
	CALL PHRLD			; PRINT HERALD
MAIN1:	CALL GTPNO			; GET PASS NO.
	JR Z,EXEC			; RETURN TO SYSTEM MONITOR
	LD A,(PASSNO)			; IS IT PASS 1?
	CP 1
	CALL Z,INITA			; IF SO, INITIALIZE
	CALL PASS			; PERFORM 1 PASS
	LD HL,AFLAGS			; TEST SYMB TAB OVERFLOW FLAG
   	BIT 2,(HL)			; 
	JR Z,MAIN1			; JUMP IF NOT SET
	LD HL,WARNNG			; ELSE PRINT WARNING ON CONSOLE
	CALL CONST
	JR MAIN1			; GO DO ANOTHER PASS 
;................................................
WARNNG:	DEFB CR				; SYMTAB OVERFLOW WARNING MESSAGE
	DEFB LF
	DEFM 'SYMBOL TABLE OVERFLOW'
	DEFB CR
	DEFB LF
	DEFB 0
;****************************************************************************
;PRINT HERALD ON CONSOLE DEVICE.
;****************************************************************************
PHRLD:	PUSH HL				; SAVE REG
	LD HL,HERALD			; SET POINTER TO HERALD MESSAGE
	CALL CONST
	POP HL				; REPLACE REG
	RET
HERALD:	DEFB CR
	DEFB LF
	DEFM 'CROWE Z80 ASSEMBLER V1.2'
    	DEFB CR
	DEFB LF
	DEFM 'COPYRIGHT PAT CROWE 1978'
	DEFB CR
	DEFB LF
	DEFB 0
;..............................................
;PRINT STRING ON CONSOLE DEVICE
;ON ENTRY HL POINTS AT STRING
;END OF STRING MARKER IS 0
;..............................................
CONST:	PUSH BC				; SAVE REG
CONST1:	LD A,(HL)
	AND A
	JR Z,CONST2
	LD C,A
	CALL CO
	INC HL
	JR CONST1
CONST2:	POP BC				; REPLACE REG
	RET
;**********************************************************************
;GET PASS NUMBER
;ZERO FLAG SET IF 'Q' TYPED
;**********************************************************************
GTPNO:	PUSH HL				; SAVE REGISTERS
	PUSH BC
GTPNO1:	LD HL,CRLF			; POINT TO CR LF STRING
	CALL CONST			; OUTPUT STRING TO CONSOLE DEVICE
	LD HL,PASNO?			; POINT TO 'PASS NO.?' STRING
	CALL CONST			; OUTPUT STRING TO CONSOLE
	CALL CI				; GET CHAR FROM CONSOLE KEYBOARD
	LD C,A				; SAVE IN B AND C REGISTERS
	LD B,A
	CALL CO				; ECHO CHAR TO CONSOLE
	LD A,B
	CP 'Q'				; QUIT?
	JR Z,GTPNO2			; JUMP IF SO
	CP '1'				; INPUT IN RANGE 1-4 ?
	JR C,GTPNO1			; NO, GO ASK FOR ANOTHER
	CP '5'
	JR NC,GTPNO1			; DITTO 
	AND 7				; MASK TO GET BINARY PASS NO.
	LD (PASSNO),A			; SAVE IN PASS NO. STORE
	LD HL,CRLF			; OUTPUT ANOTHER CR LF TO CONSOLE
	XOR A      			; CLEAR ZERO FLAG
	INC A
GTPNO2:	POP BC				; REPLACE REGISTERS
	POP HL
	RET				; AND RETURN
CRLF:	DEFB CR
	DEFB LF
	DEFB 0
PASNO?:	DEFM 'PASS NO. = '
	DEFB 0
;****************************************************************************
;PERFORM A PASS
;****************************************************************************
PASS:	CALL INITP			; INITIALIZE FOR PASS
PASS1:	CALL INITL     			; INITIALIZE FOR LINE
	CALL GLIN			; GET A LINE
	CALL GLAB   			; GET LABEL
        JR Z,PASS4   			; JMP IF NO MORE PROC. REQD.
	CALL GETOR			; GET OPERATOR TOKEN
	JR Z,PASS4			; JUMP IF NO MORE PROC. REQD.
	LD A,(ORTKBF)  			; IS OPERATOR 'TITLE'?
	CP TITTOK 			; TOKEN FOR TITLE?
	JR NZ,PASS2			; NO, IS OPERATOR 'DEFM'?
	CALL TITL 			; YES, PROCESS ITS OPERAND 
	JR PASS5
PASS2:	CP DEFMTK			; TOKEN FOR 'DEFM'?
	JR NZ,PASS3
	CALL DM				; YES, PROCESS ITS OPERAND
	JR PASS5
PASS3:	CALL GTOD			; NEITHER, PROCESS NORMAL OPERANDS
	JR Z,PASS4			; JMP IF NO MORE PROC. REQD.
PASS5:	CALL PTOK 			; PROCESS TOKENS
PASS4:	CALL PFRLO			; PERFORM RELEVANT OUTPUT
	LD A,(AFLAGS)			; TEST FOR END STATEMENT
	BIT 1,A
	JR Z,PASS1  			; GO PROCESS ANOTHER LINE IF NOT
	RET
;**************************************************************************
;INITIALIZE ASSEMBLER
;**************************************************************************
INITA:	PUSH HL				; SAVE REGS
	PUSH	BC			; 
	XOR	A			; CLEAR ACC
 	LD	(TITBUF),A		; EMPTY TITLE BUFFER
	LD	(SYMTAB),A		; CLEAR SYMBOL TABLE
	LD	HL,SYMTAB		; PUT SYMBOL TABLE START ADDR
	LD	(SYMEND),HL		; INTO 'END OF SYMBOL TABLE' STORE
	LD	HL,AFLAGS		; CLEAR SYMTAB OVERFLOW FLAG
	RES	2,(HL)
	CALL	MEMCHK			; GET HIGHEST AVAIL MEM IN B-A
	LD	HL,MEMTOP		; SAVE IN MEMTOP
	LD	(HL),A
	INC	HL
	LD	(HL),B
	POP	BC			; REPLACE REGS
	POP	HL
	RET
;****************************************************************************
;INITIALIZE PASS
;****************************************************************************
INITP:	PUSH	BC			; SAVE REG
	XOR	A			; CLEAR ACC.
	LD	(OBJCNT),A		; CLEAR OBJECT BUFFER COUNT
	LD	(ADREFC),A		; SET ADDR REF CNTR = 0
	LD	(ADREFC+1),A
	LD	(PAGE+1),A		; SET PAGE NO. = 1
	INC	A
	LD	(PAGE),A
	LD	A,PLINES-9		; SET LINE NO. = MAX SIZE
	LD	(LINE),A
	LD	A,(PASSNO)		; GET PASS NO.
	CP	3
	JR	NZ,INITP1		; JUMP IF NOT
	CALL	RUNOUT			; PUNCH 30 CM RUNOUT
	LD	C,CR			; PUNCH CR
	CALL	PCHO
	LD	C,LF			; PUNCH LF
	CALL	PCHO
	JR	INITP3
INITP1:	CP	2			; PASS 2?
	JR	Z,INITP2		; JUMP IF SO
	CP	4			; PASS 4?
	JR	NZ,INITP3		; JUMP IF NOT
INITP2:	LD	C,FORMFD		; LIST FORM FEED
	CALL	LO
	LD	C,CR			; LIST CR
	CALL	LO
	LD	C,LF			; LIST 3 LF'S
	LD	B,3
	CALL	OUTC
	CALL	LFEED			; LIST PAGE HEADER
INITP3:	POP	BC			; REPLACE REG
	RET
;**************************************************************************
;INITIALIZE LINE
;***************************************************************************
INITL:	PUSH	BC			; SAVE REGS
	PUSH	HL
	XOR	A			; CLEAR ACC
	LD	HL,ASSCOD		; SET PNTR TO ASSD CODE BUFFER
	LD	B,ACBSIZ		; LOAD CNTR WITH SIZE OF BUFFER
INITL1:	LD	(HL),A			; CLEAR A LOCATION
	INC	HL			; INCR PNTR
	DJNZ	INITL1			; LOOP UNTIL DONE
	LD	(ASCDNO),A		; SET 'BYTES ASSD CODE' = 0
	LD	(ODBT1),A		; CLEAR OPERAND TOKEN BUFFERS
	LD	(ODBT2),A
	LD	HL,0			; CLEAR OPERAND INTEGER BUFFERS
	LD	(ODINT1),HL
	LD	(ODINT2),HL
	LD	(ORTKBF),HL		; CLEAR OPERATOR TOKEN BUFFER
	LD	HL,(ADREFC)		; COPY ADDR REF CNTR
	LD	(ADDISR),HL		; INTO ADDR DIS REG
	LD	HL,AFLAGS		; SET PNTR TO ASSEMBLER FLAGS
	RES	0,(HL)			; CLEAR ADDR DISCONTINUITY FLAG
	RES	1,(HL)			; CLEAR 'END' FLAG
	POP	HL
	POP	BC
	RET
;************************************************************************
;GET LINE FROM READER
;COPIES LINE OF SOURCE TEXT INTO LINBUF
;ECHOES TO PRINTER IF PASS2
;*************************************************************************
GLIN:	PUSH	HL			; SAVE REGS
	PUSH	DE
	PUSH	BC
	LD	B,LBFSZ-1		; SET LINE BUFFER SIZE
	LD	HL,LINBUF		; SET POINTER TO LINE BUFFER
	LD	DE,0			; CLEAR TAB COUNTER (E) & STATUS REG
	LD	A,SPACE			; PUT SPACE CHAR IN ERROR BUFFER
	LD	(ERRBUF),A
	LD	A,(PASSNO)		; SET 'PASS2' FLAG IF PASS 2
	CP	2
	JR	NZ,GLIN1
	SET	0,D
GLIN1:	CALL	RI			; GET CHAR FROM READER
	LD	C,A			; SAVE IT IN C
	CP	CR			; IS IT CR?
	JR	Z,GLIN2
	CP	HT			; IS IT TAB?
	JR	Z,GLIN3
	CP	LF			; IS IT LINE FEED?
	JR	Z,GLIN1			; IGNORE
	CP	NUL			; IS IT A NULL CHAR?
	JR	Z,GLIN1			; IGNORE
	CP	DEL			; IS IT A DELETE CHAR?
	JR	Z,GLIN1			; IGNORE
	AND	60H			; IS IT ANY OTHER CONTROL CHAR?
	JR	NZ,GLIN5
	LD	C,'I'			; PUT 'ILLEGAL CHAR'IN ERROR DISP 
	CALL	ERROR
	JR	GLIN1
GLIN5:	LD	A,C			; GET CHAR BACK
	CP	';'			; SET COMMENT FLAG IF ';'
	JR	NZ,GLIN7
	SET	1,D
GLIN7:	LD	(HL),A			; PUT IN BUFFER
	INC	HL			; INCREMENT BUFFER POINTER
	BIT	0,D			; IF PASS 2 FLAG SET,
	CALL	NZ,LO			; OUTPUT CHAR TO LIST DEVICE
	INC	E			; INCREMENT TAB COUNTER
GLIN11:	DEC	B			; BUFFER FULL?
	JR	NZ,GLIN1
GLIN9:	CALL	RI			; SCAN TO NEXT CR FROM READER
	CP	CR
	JR	NZ,GLIN9
	LD	(HL),A			; PUT CR IN BUFFER
	LD	C,A			; IF PASS 2 FLAG SET
	BIT	0,D
	CALL	NZ,LO			; OUTUT CR TO LIST DEVICE
	BIT	1,D			; REACHED COMMENT BEFORE BUFFER FULL?
	JR	NZ,GLIN4
	LD	C,'L'			; PUT 'LINE TOO LONG' IN ERROR DISP
	CALL	ERROR
	JR	GLIN4
GLIN2:	LD	(HL),A			; PUT CR IN BUFFER
	BIT	0,D			; IF PASS 2 FLAG SET
	CALL	NZ,LO			; OUTPUT TO LIST DEVICE
	JR	GLIN4
GLIN3:	LD	C,SPACE			; TAB. PUT SPACE IN BUFFER
	LD	(HL),C
	INC	HL
	BIT	0,D			; IF PASS 2 FLAG SET,
	CALL	NZ,LO			; OUTPUT TO LIST DEVICE
	INC	E			; REACHED NEXT TAB POSITION?
	LD	A,7
	AND	E
	JR	Z,GLIN11
	DEC	B			; BUFFER FULL?
	JR	Z,GLIN9
	JR	GLIN3
GLIN4:	POP	BC			; REPLACE REGS
	POP	DE
	POP	HL
	RET
;**********************************************************************
;GET LABEL
;LOCATES LABEL (IF ANY) IN LINBUF AND PUTS IT IN LABBUF.
;LEAVES POINTER TO CHARACTER AFTER LABEL IN LINPNT.
;ZERO SET IF NOTHING ELSE TO PROCESS
;**********************************************************************
GLAB:	PUSH	HL			; SAVE REGS
	PUSH	DE
	PUSH	BC
	LD	HL,LINBUF		; SET POINTER TO LINE BUFFER
	LD	DE,LABBUF		; SET POINTER TO LABEL BUFFER
	LD	B,0			; CLEAR STATUS REG
GLAB1:	LD	A,(HL)			; SCAN TO FIRST NON SPACE CHAR
	CP	SPACE
	JR	NZ,GLAB2
	SET	2,B			; SET 'NOT FIRST COL' FLAG
	INC	HL			; POINT TO NEXT CHAR
	JR	GLAB1
GLAB2:	CP	CR			; NULL LINE?
	JR	Z,GLAB8
	CP	';'			; COMMENT?
	JR	Z,GLAB8
	CP	'A'			; IT IS A-Z?
	JR	C,GLAB5
	CP	'Z'+1
	JR	NC,GLAB5
	CALL	GSYM			; PUT SYMBOL IN BUFFER
	LD	A,(HL)			; FOLLOWED BY ':'?
	CP	':'
	JR	Z,GLAB3			; JUMP IF FOLLOWED BY ':'
					; I.E. IT'S A LABEL
	BIT	2,B			; STARTED IN FIRST COLUMN?
	JR	NZ,GLAB6		; JUMP IF NOT LABEL
	JR	GLAB7
GLAB3:	INC	HL
	LD	A,(HL)
GLAB7:	CP	SPACE			; FOLLOWED BY SP/CR/;?
	JR	Z,GLAB4
	CP	CR
	JR	Z,GLAB4
	CP	';'
	JR	Z,GLAB4
GLAB5:	CALL	DNOPS			; RESERVE 4 DEFAULT NOP'S
	CALL	ADJARC			; ADJUST ADDRESS REF COUNTER
	XOR	A			; SET ZERO FLAG
	JR	GLAB8
GLAB6:	LD	HL,LINBUF		; SET POINTER TO START OF LINBUF
	XOR	A			; SET 'NO LABEL IN BUFFER'
	LD	(LABBUF),A
GLAB4:	LD	(LINPNT),HL		; DEPOSIT LINE POINTER
	XOR	A			; CLEAR ZERO FLAG
	INC	A
GLAB8:	POP	BC			; REPLACE REGS
	POP	DE
	POP	HL
	RET
;*********************************************************************
;GET OPERATOR TOKEN, 
;LOCATES OPERATOR (IF ANY) AND PUTS TOKEN AND VALUE FOR IT IN ORTKBF.
;LEAVES POINTER TO CHARACTER AFTER OPERATOR IN LINPNT
;ZERO FLAG SET IF NOTHING ELSE TO PROCESS.
;**********************************************************************
GETOR:	PUSH	HL			; SAVE REGISTERS
	PUSH	DE
	PUSH	BC
	EXX
	PUSH	HL
	PUSH	DE
	PUSH	BC
	LD	HL,(LINPNT)		; FETCH POINTER TO LINE BUFFER
GETOR1:	CALL	SCNSP			; SCAN TO FIRST NON SPACE CHAR
GETOR5:	CP	CR			; IS IT CR?
	JR	Z,GETOR2
	CP	';'			; IS IT ';'?
	JR	Z,GETOR2
	CALL	ALPHA			; IS IT A LETTER?
	JR	NC,GETOR3		; NO, SYNTAX ERROR
	LD	DE,SYMBUF+1		; SET POINTER TO SYMBOL BUFFER
	LD	B,0			; SET COUNT = 0
GETOR4:	LD	(DE),A			; PUT CHAR IN OPERATOR BUFFER
	INC	HL			; INCR LINBUF POINTER
	INC	DE			; INCREMENT SYMBUF POINTER
	INC	B			; INCR CHAR COUNT
	LD	A,5			; GREATER THAN 5?
	CP	B
	JR	C,GETOR3		; YES, SYNTAX ERROR
	LD	A,(HL)			; GET NEXT CHAR
	CALL	ALPHA			; IS IT A LETTER
	JR	C,GETOR4		; YES, LOOP
	LD	A,B			; SAVE # OF OPR CHARS IN SYMBUF
	LD	(SYMBUF),A
	LD	A,(HL)			; FETCH NEXT CHAR AGAIN
	CP	SPACE
	JR	Z,GETOR6
	CP	CR
	JR	Z,GETOR6
	CP	';'
	JR	NZ,GETOR3		; INVALID SYNTAX
GETOR6:	EXX				; SET UP PARAMETERS FOR OPTOK
	LD	HL,ORLSTP
	LD	DE,ORTKBF
	LD	C,2
	CALL	OPTOK			; GET TOKENS FROM LIST
	EXX
	JR	Z,GETOR3		; INVALID SYNTAX, NOT IN LIST
GETOR2:	LD	(LINPNT),HL		; DEPOSIT LINE BUFFER POINTER
	XOR	A			; CLEAR ZERO FLAG
	INC	A
GETOR7:	POP	BC			; RECOVER REGISTERS
	POP	DE
	POP	HL
	EXX
	POP	BC
	POP	DE
	POP	HL
	RET
GETOR3:	CALL	DNOPS			; RESERVE 4 DEFAULT NOP'S
	CALL	ADJARC			; ADJUST ADDRESS REF COUNTER
	XOR	A			; SET ZERO FLAG
	JR	GETOR7
;**********************************************************************
;GET OPERAND TOKENS AND VALUES
;LOCATES OPERANDS (IF ANY) AND SETS TOKENS FOR THEM IN ODBT1/ODBT2
;AND CORRESPONDING INTEGER VALUES (IF ANY) IN ODINT1/ODINT2.
;ZERO FLAG SET IF NOTHING ELSE TO PROCESS
;**********************************************************************
GTOD:	PUSH	IX			; SAVE REGISTERS
	PUSH	IY
	PUSH	HL
	PUSH	DE
	PUSH	BC
	EXX
	PUSH	HL
	PUSH	DE
	PUSH	BC
	LD	HL,(LINPNT)		; GET LINE BUFFER POINTER
	LD	B,0			; CLEAR B (OPERAND COUNTER,
					; 'BRACKETS' FLAG & 'QUOTE' FLAG)
GTOD1:	CALL	SCNSP			; SCAN TO FIRST NON SPACE CHAR
	CP	','			; IS IT A COMMA?
	JR	NZ,GTOD2
	BIT	0,B			; YES, FOUND 1 OPERAND?
	JP	Z,GTOD25		; NO, SYNTAX ERROR
	INC	HL			; YES, SCAN TO NEXT NON SP CHAR
	CALL	SCNSP
	JR	GTOD3
GTOD2:	CP	';'			; IS IT A ';'?
	JP	Z,GTOD24
	CP	CR			; OR A CR?
	JP	Z,GTOD24
GTOD3:	PUSH	HL			; NO, SET POINTER TO START
	POP	IX			; OF OPERAND IN IX
					; SCAN TO NEXT DELIMITER
	RES	6,B			; CLEAR QUOTE FLAG
GTOD4:	LD	A,(HL)			; GET CHAR IN A
	CP	''''			; IS IT A '?
	JR	NZ,GTOD18		; JUMP IF NOT
	BIT	6,B			; QUOTE FLAG SET?
	JR	NZ,QUOTE		; IF SO, QUOTE
	PUSH	HL			; PREP TO CHECK IF AF'
	DEC	HL			; POINT TO PREV CHAR
	LD	A,(HL)
	POP	HL			; RESTORE POINTER
	CP	'F'			; IS IT 'F'?
	JR	Z,GTOD28		; YES, THEN NO QUOTE
QUOTE:	LD	A,B			; COMPLEMENT QUOTE FLAG
	XOR	01000000B
	LD	B,A
	JR	GTOD28			; AND CONTINUE TO SCAN
GTOD18:	CP	CR			; IS IT CR?
	JR	Z,GTOD5			; FOUND DELIMITER, JUMP
	CP	SPACE			; IS IT SPACE
	JR	Z,GTOD27		; JUMP IF SO
	CP	','			; IS IT A COMMA?
	JR	Z,GTOD27		; JUMP IF SO
	CP	';'			; IS IT ; ?
	JR	NZ,GTOD28		; CONTINUE SCAN OF NONE OF THESE
GTOD27:	BIT	6,B			; IS QUOTE FLAG SET?
	JR	Z,GTOD5			; JUMP IF NOT, FOUND DELIMITER
GTOD28:	INC	HL			; POINT TO NEXT CHAR
	JR	GTOD4			; AND LOOP
					; FOUND DELIMITER
GTOD5:	PUSH	HL			; SET POINTER (IY) TO CHAR
	POP	IY			; AFTER END OF OPERAND
	INC	B			; INCR # OF OPERANDS FOUND
	LD	A,B			; IS IT > 2 ?
	AND	3
	CP	3
	JP	Z,GTOD25		; YES, SYNTAX ERROR
	RES	7,B			; CLEAR BRACKETS FLAG
	LD	A,(IX)			; DOES IT START WITH ( ?
	CP	'('
	JR	NZ,GTOD6
	LD	A,(IY-1)		; DOES IT END WITH ) ?
	CP	')'
	JR	NZ,GTOD6
	SET	7,B			; SET BRACKETS FLAG IN B
	INC	IX			; AND CLOSE IN POINTERS
	DEC	IY
GTOD6:	PUSH	IX			; GET POINTER TO START OF OPERAND
	POP	HL
	LD	DE,SYMBUF+1		; SET POINTER TO SYMBUF
	LD	C,0			; ZERO CHAR COUNT
GTOD10:	LD	A,(HL)			; FETCH A CHAR
	CALL	ALPHA			; IS IT A LETTER?
	JR	NC,GTOD7
	LD	(DE),A
	INC	C			; INCR COUNT
 	INC	HL			; AND POINTERS
	INC	DE
	LD	A,C
	CP	3
  	JR	NZ,GTOD10
	JR	GTOD9			; MORE THAN 2 LETTERS, GO
					; EVALUATE EXPRESSION
GTOD7:	CP	''''			; NOT LETTER, IS IT '?
	JR	NZ,GTOD8		  
	LD	(DE),A			; SAVE IT IN BUFFER
	INC	HL			; POINT TO CHAR FOLLOWING
	INC	C			; INCREMENT COUNT
GTOD8:	LD	A,C			; PUT COUNT IN SYMBUF
	LD	(SYMBUF),A
	AND	A			; IF COUNT=0 THEN
	JR	Z,GTOD9			; GO TO EVAL EXPRESSION
	EXX				; GET OPERAND KEYWORD TOKEN
	LD	HL,OPKLST
	LD	DE,TEMP
 	LD	C,1			; 1 BYTE PER TOKEN
	CALL	OPTOK
	EXX
	JR	Z,GTOD9			; JUMP IF NO KEYWORD FOUND
	LD	C,A			; SAVE TOKEN IN C
	CP	CTOK			; TOKEN FOR C?
	JR	NZ,GTOD12
	LD	A,(ORTKBF)
	BIT	7,A			; IS OPERATOR CONDITIONAL?
	JR	Z,GTOD12
	LD	C,CCOND			; TOKEN FOR CONDITIONAL 'C'
GTOD12:	LD	A,C			; GET TOKEN
	AND	XYMASK			; IS IT IX/IY ?
	CP	IXORIY
	JR	NZ,GTOD14
	LD	A,(HL)			; GET FOLLOWING CHAR
	CP	'+'
	JR	Z,GTOD13
	CP	'-'
	JR	NZ,GTOD14
GTOD13:	LD	A,C			; CONVERT TOKEN TO DUMMY VALUE
	AND	0FH			  
	OR	0C0H
	LD	C,A
	PUSH	HL			; CLOSE POINTER IN TO START OF EXPRESS
	POP	IX
	CALL	EVAL			; GET VALUE OF EXPRESSION IN HL
	JR	Z,GTOD25		; SYNTAX ERROR
	BIT	0,B			; FOUND 1 OPERAND?
	JR	Z,GTOD15
	LD	(ODINT1),HL		; SAVE VALUE IN 1ST OPERAND BUFFER
	JR	GTOD11
GTOD15:	LD	(ODINT2),HL		; SAVE VALUE IN 2ND OPND BUFF
	JR	GTOD11
GTOD14:	PUSH	IY			; END OF OPERAND?
	POP	DE
	AND	A			; CLEAR CARRY FLAG
	SBC	HL,DE
	JR	NZ,GTOD25		; SYNTAX ERROR
	JR	GTOD11
GTOD9:	CALL	EVAL			; EVALUATE EXPRESSION
					; RESULT IN HL
	JR	Z,GTOD25		; SYNTAX ERROR
	BIT	0,B			; FOUND 1 OPERAND?
	JR	Z,GTOD17
	LD	(ODINT1),HL		; SAVE VALUE IN FIRST OPERAND BUFFER
	JR	GTOD16
GTOD17:	LD	(ODINT2),HL		; SAVE VALUE IN 2ND OPND BUFF
GTOD16:	LD	C,INTTOK		; SET TOKEN FOR 'INTEGER'
GTOD11:	BIT	7,B			; WAS IT IN BRACKETS?
	JR	Z,GTOD21		; NO
	LD	HL,BKLST		; YES, CHECK IF VALID, POINT TO LIST
GTOD20:	LD	A,(HL)			; GET A TOKEN
	INC	HL			; POINT TO REPLACEMENT TOKEN
	AND	A			; IS TOKEN 0 ?
	JR	Z,GTOD25		; YES, NOT IN LIST, SYN. ERR.
	CP	C			; IS IT EQUAL TO ACTUAL TOKEN?
	JR	Z,GTOD19		; YES, GO REPLACE IT
	INC	HL			; POINT TO NEXT TOKEN
	JR	GTOD20
GTOD19:	LD	C,(HL)			; REPLACE TOKEN WITH
					; BRACKETTED VERSION.
	INC	IY			; OPEN OUR FINAL POINTER AGAIN
GTOD21:	LD	A,C			; SAVE TOKEN IN RELEVANT BUFFER
	BIT	0,B			; FOUND 1 OPERAND?
	JR	Z,GTOD22
	LD	(ODBT1),A		; SAVE TOKEN IN 1ST OPND BUFF
	JR	GTOD23
GTOD22:	LD	(ODBT2),A		; SAVE TOKEN IN 2ND OPND BUFF
GTOD23:	PUSH	IY			; POINT AT NEXT THING
	POP	HL
	JP	GTOD1			; GO PROCESS NEXT TOKEN
GTOD24:	XOR	A			; CLEAR ZERO FLAG
	INC	A
GTOD26:	POP	BC			; REPLACE SAVED REGISTERS
	POP	DE
	POP	HL
	EXX	
	POP	BC
	POP	DE
	POP	HL
	POP	IY
	POP	IX
	RET
GTOD25:	CALL	DNOPS			; APPEND DEFAULT NOP'S
	CALL	ADJARC			; ADJUST ADDRESS REF COUNTER
	XOR	A
	JR	GTOD26
;************************************************************************
;EVALUATE AN EXPRESSION
;ON ENTRY AND EXIT:
;	IX POINTS AT FIRST CHAR OF EXPRESSION
;	IY POINTS AT CHAR AFTER END OF EXPRESSION
;ON EXIT:
;	HL CONTAINS VALUE OF EXPRESSION
;	AND ZERO FLAG IS SET IF SYNTAX ERROR
;************************************************************************
EVAL:	PUSH	DE			; SAVE REGISTERS
	PUSH	BC
	EXX
	PUSH	BC
	XOR	A			; CLEAR ROUTINE FLAG REGISTER
	LD	B,A
	EXX
	LD	(ARCNT),A		; CLEAR STACKS
	LD	(FCNT),A
	PUSH	IX			; POINT TO START OF EXPR.
	POP	HL
EVAL1:	PUSH	IY			; END OF EXPRESSION?
	POP	DE			; I.E. HL=IY ?
 	EX	DE,HL
	AND	A			; CLEAR CARRY
 	SBC	HL,DE
	EX	DE,HL
	JP	Z,EOEX			; END OF EXPRESSION
	JP	C,EVAL6			; END OF EXPRESSION ERROR
	LD	A,(HL)			; GET A CHAR
	CALL	DIGIT			; IS IT A DIGIT?
	JR	C,LIT			; YES, GO PROCESS LITERAL
	CALL	ALPHA			; IS IT A LETTER?
	JR	C,SYMB			; YES, GO PROCESS SYMBOL
	CP	'.'			; IS IT A '.'?
	JR	Z,MCF			; YES, GO PROCESS M/CHAR FUNCTION
	CP	''''			; IS IT A '?
	JR	Z,ASC			; YES, GO PROC. ASCII CHAR
	CP	'('			; IS IT A '('?
	JP	Z,LBKT			; YES, GO PROC. LEFT BRKT
	CP	')'			; IS IT ')'?
	JP	Z,RBKT			; YES, GO PROC. R.H. BRKT
	CP	'$'			; IS IT '$'?
	JR	Z,CURLC			; YES, GO PROC. CURR. LOC.
SCHF:	CALL	PSCF			; PROCESS AS SINGLE CHAR. FUNCTION
	JP	Z,EVAL3			; INVALID CHAR ERROR
	JR	FUN
LIT:	CALL	PLIT			; PROCESS AS LITERAL
	JR	OPND
SYMB:	CALL	PSYMB
	JR	OPND
ASC:	CALL	PASC			; PROCESS OS ASCII STRING
	JR	OPND
CURLC:	LD	DE,(ADREFC)		; CURRENT VALUE OF ADDR REF
					; COUNTER REQUIRED
	INC	HL			; POINT TO NEXT EXPR CHAR
	JR	OPND1
OPND:	JP	C,EVAL4			; 'VALUE' ERROR
OPND1:	CALL	PUDE			; PUSH VALUE (IN DE) ONTO
					; ARITHMETIC STACK
	JP	Z,EVAL5			; STACK OVERFLOW ERROR
	EXX				; SET 'LAST UNIT' FLAG
	SET	0,B
	EXX
	JR	EVAL1
MCF:	CALL	PMCF
	JP	Z,EVAL6			; SYNTAX ERROR
FUN:	LD	A,(FTOKR)		; GET FUNCTION TOKEN
	CP	PLUTOK			; IS IT TOKEN FOR +?
	JR	Z,FUN1
	CP	MINTOK			; IS IT TOKEN FOR -?
	JR	NZ,FUN2
					; +/-
FUN1:	EXX				; WAS LAST UNIT START/(/FUNCTION ?
 	BIT	0,B
	EXX
	JR	Z,FUN3
	ADD	A,5DH			; CHANGE TOKEN TO DIADIC
	LD	(FTOKR),A
	JR	FUN3
FUN2:	CP	3DH			; DIADIC FUNCTION
	JR	C,FUN3
	EXX				; WAS LAST UNIT START/(/FUNCTION?
	BIT	0,B
	EXX
	JP	Z,EVAL6			; SYNTAX ERROR
FUN3:	CALL	POFU			; GET PREVIOUS FUNCTION
	JR	Z,FUN4			; NO PREVIOUS FUN, PUSH NEW ONE
	LD	E,A			; SAVE TOP OF STACK IN E
	LD	A,(FTOKR)		; GET NEW FUNCTION TOKEN
	AND	7			; MASK OFF PRIORITY BITS IN NEW OPR
	LD	B,A			; SAVE IN B
	LD	A,E
	AND	7			; MASK OFF PRIORITY BITS OF TOS
	CP	B			; COMPARE PRIORITIES
	JR	NC,FUN5			; GO DO A FUNCTION
					; NEW FUNCTION HAS HIGHER
					; PRIORITY SO PUSH IT ON
					; STACK.
	LD	A,E			; FIRST PUSH BACK TOP OF STACK
	CALL	PUFU
FUN4:	LD	A,(FTOKR)		; THEN PUSH NEW FUNCTION
	CALL	PUFU
	JR	Z,EVAL5			; STACK OVERFLOW ERROR
	EXX	  			; CLEAR 'LAST UNIT' FLAG
	RES	0,B
	EXX
	JP	EVAL1
FUN5:	LD	A,E			; PUT T O S IN ACC
	CALL	FUNC			; PERFORM A FUNCTION
	JR	Z,EVAL6			; SYNTAX ERROR
	JR	FUN3			; GO TRY NEXT FUNCTION ON STACK
;..................................................
LBKT:	INC	HL			; POINT TO NEXT EXPR CHAR
	LD	A,LBTOK			; SET TOKEN FOR '('
	CALL	PUFU			; PUSH ON FUNCTION STACK
	JR	Z,EVAL5			; STACK OVERFLOW ERROR
	EXX				; CLEAR 'LAST UNIT' FLAG
	RES	0,B
	EXX	
	JP	EVAL1
;..................................................
RBKT:	INC	HL
RBKT2:	CALL	POFU			; POP FUNCTION STACK
	JR	Z,EVAL7			; EMPTY, BALANCE ERROR
	CP	LBTOK			; IS IT A (?
	JR	Z,RBKT1
	CALL	FUNC			; PERFORM THE FUNCTION
	JR	Z,EVAL6			; SYNTAX ERROR
	JR	RBKT2			; MORE OPS TO DO ?
RBKT1:	EXX				; SET 'LAST UNIT' FLAG
	SET	0,B
	EXX
	JP	EVAL1
;.................................................
					; END OF EXPRESSION
EOEX:	CALL	POFU			; POP FUNCTION STACK
	JR	Z,EOEX1			; NO MORE FUNCTIONS
	CP	LBTOK
	JR	Z,EVAL7			; BALANCE ERROR
	CALL	FUNC			; PERFORM THE FUNCTION
	JR	Z,EVAL6			; SYNTAX ERROR
	JR	EOEX
EOEX1:	CALL	PODE			; GET EXPR VALUE IN DE
	JR	Z,EVAL6			; SYNTAX ERROR (STACK EMPTY)
	LD	A,(ARCNT)		; CHECK IF STACK NOW EMPTY
	AND	A
	JR	NZ,EVAL6		; SYNTAX ERROR
	EX	DE,HL
	EXX
	BIT	1,B			; TEST FOR ARITH OVERFLOW
	EXX
	JR	Z,EOEX2
	LD	C,'A'
EOEX4:	CALL	ERROR			; INDICATE ARITH OVERFLOW
EOEX2:	XOR	A			; CLEAR ZERO FLAG
	INC	A
EOEX3:	EXX
	POP	BC
	EXX
	POP	BC
	POP	DE
	RET
EVAL3:	LD	C,'I'
	JR	EVAL8
EVAL4:	LD	C,'V'			; VALUE ERROR
	LD	HL,0			; SET RESULT=0
	JR	EOEX4			; NOT FATAL
EVAL5:	LD	C,'O'			; STACK OVERFLOW ERROR
	JR	EVAL8
EVAL6:	LD	C,'S'			; SYNTAX ERROR
	JR	EVAL8
EVAL7:	LD	C,'B'			; BALANCE ERROR
EVAL8:	CALL	ERROR			; SET ERROR INDICATOR
	XOR	A			; SET ZERO (ERROR) FLAG
	JR	EOEX3			; AND PREPARE TO EXIT
;**********************************************************************
;PROCESS LITERAL.
;THIS SUBROUTINE INCLUDES PBIN, PDEC,
;PHEX, POCT.
;ON ENTRY:
;	HL POINTS TO FIRST CHAR OF LITERAL
;ON EXIT:
;	HL POINTS TO CHAR AFTER LITERAL
;	DE CONTAINS VALUE OF LITERAL
;	CARRY FLAG IS SET FOR VALUE ERROR
;**********************************************************************
PLIT:	PUSH	HL			; SAVE POINTER TO START OF LIT.
PLIT1:	LD	A,(HL)			; GET CHAR
	CALL	HEXDG			; IS IT VALID DIG FOR LIT.?
	JR	NC,PLIT2
	INC	HL			; YES, POINT TO NEXT CHAR
	JR	PLIT1
PLIT2:	DEC	HL			; NO, GO BACK TO LAST CHAR
	LD	A,(HL)			; FETCH IT TO ACC.
	POP	HL			; REPLACE POINTER TO START OF LIT.
	CP	'B'			; WAS FINAL CHAR 'B'
	JR	Z,PBIN			; BINARY LITERAL
	CP	'D'			; 'D'?
	JR	Z,PDEC			; DECIMAL LITERAL
	CP	'H'			; 'H'?
	JP	Z,PHEX			; HEX LITERAL
	CP	'O'			; 'O'?
	JR	Z,POCT			; OCTAL LITERAL
	CP	'Q'			; 'Q'?
	JR	Z,POCT			; OCTAL LITERAL
	JR	PDEC			; DECIMAL LITERAL
;**********************************************************************
;PROCESS BINARY LITERAL.
;**********************************************************************
PBIN:	PUSH	BC			; SAVE REGISTERS
	LD	DE,0			; CLEAR 16 BIT ACC.
PBIN1:	LD	A,(HL)			; GET CHAR
	CALL	HEXDG			; VALID IN A LITERAL?
	JR	NC,PBIN2
	CP	'1'+1			; VALID IN BINARY LIT.?
	JR	NC,PBIN2		  
	SUB	'0'			; CONVERT ASCII TO BINARY
	LD	C,A
	CALL	SHLDE			; SHIFT DE LEFT
	CALL	ADCDE			; & ADD NEW DIG. TO DE
	INC	HL			; INCREMENT POINTER TO NEXT CHAR.
	JR	PBIN1
PBIN2:	CP	'B'			; CHAR NOT BIN. DIG.. IS IT 'B'?
	JR	NZ,PBIN4
	INC	HL			; YES, POINT TO NEXT CHAR
	LD	A,(HL)			; GET IT IN ACC
	CALL	HEXDG			; VALID CHAR FOR A LIT.?
PBIN3:	POP	BC
	RET
PBIN4:	SCF				; SET CARRY FOR ERROR
	JR	PBIN3
;**********************************************************************
;PROCESS OCTAL LITERAL
;**********************************************************************
POCT:	PUSH	BC
	LD	DE,0			; CLEAR 16 BIT ACC.
POCT1:	LD	A,(HL)			; GET CHAR
	CALL	HEXDG			; VALID IN LITERAL?
	JR	NC,POCT3
	CP	'7'+1			; VALID IN OCTAL LIT.?
	JR	NC,POCT3
	SUB	'0'			; CONVERT ASCII TO BINARY
	LD	C,A
	LD	B,3			; SHIFT DE LEFT 3 TIMES
POCT2:	CALL	SHLDE
	DEC	B			; DONE 3 SHIFTS YET?
	JR	NZ,POCT2
	CALL	ADCDE			; ADD NEW DIGIT TO DE
	INC	HL			; INCR POINTER TO NEXT CHAR
	JR	POCT1
POCT3:	CP	'O'			; CHAR NOT OCT DIG. IS IT 'O'?
	JR	Z,POCT4
	CP	'Q'			; IS IT 'Q'?
	JR	NZ,POCT6
POCT4:	INC	HL			; YES, POINT TO NEXT CHAR
 	LD	A,(HL)			; GET IT IN ACC
	CALL	HEXDG			; VALID CHAR IN A LIT.?
POCT5:	POP	BC
	RET
POCT6:	SCF				; SET CARRY FOR ERROR
	JR	POCT5
;*********************************************************************
;PROCESS DECIMAL LITERAL.
;*********************************************************************
PDEC:	PUSH	BC
	LD	DE,0			; CLEAR 16 BIT ACC.
PDEC1:	LD	A,(HL)			; GET CHAR
	CALL	HEXDG			; VALID IN A LIT.?
	JR	NC,PDEC2
	CP	'9'+1			; VALID IN A DEC. LIT.?
	JR	NC,PDEC2
	SUB	'0'			; CONVERT ASCII TO BINARY
	LD	C,A
	LD	B,0
	PUSH	BC
	LD	B,D
	LD	C,E
	CALL	SHLDE			; DE X 2
	CALL	SHLDE			; DE X 4
	CALL	ADCDE			; DE X 5
	CALL	SHLDE			; DE X 10
	POP	BC			; RECOVER NEW DIGIT
	CALL	ABCDE			; ADD IN NEW DIGIT
	INC	HL			; POINT TO NEXT CHAR
	JR	PDEC1
PDEC2:	CP	'D'
	JR	NZ,PDEC3
	INC	HL
	LD	A,(HL)			; GET IT IN ACC
PDEC3:	CALL	HEXDG
	POP	BC
	RET
;*******************************************************************
;PROCESS HEXADECIMAL LITERAL.
;*******************************************************************
PHEX:	PUSH	BC
	LD	DE,0			; CLEAR 16 BIT ACC.
PHEX1:	LD	A,(HL)			; GET CHAR
	CALL	HEXDG			; VALID IN A LITERAL?
	JR	NC,PHEX4
	CP	'F'+1			; VALID IN A HEX LIT.?
	JR	NC,PHEX4
	SUB	'0'			; CONVERT ASCII TO BINARY
	CP	10D
	JR	C,PHEX2
	SUB	'A'-'0'-10D
PHEX2:	LD	C,A
	LD	B,4			; SHIFT DE LEFT 4 TIMES
PHEX3:	CALL	SHLDE
	DEC	B			; DONE4 SHIFTS YET?
	JR	NZ,PHEX3
	CALL	ADCDE			; ADD NEW DIGIT TO DE
	INC	HL			; INCREMENT POINTER TO NEXT CHAR
	JR	PHEX1
PHEX4:	CP	'H'			; CHAR NOT HEX. IS IT 'H'?
	JR	NZ,PHEX6		; NO
	INC	HL			; YES, POINT TO NEXT CAR
	LD	A,(HL)			; GET IT IN ACC
	CALL	HEXDG			; VALID CHAR FOR A LIT.?
PHEX5:	POP	BC
	RET
PHEX6:	SCF				; SET CARRY FOR ERROR
	JR	PHEX5
;*******************************************************************
;HEXDG. IS CHAR IN ACC VALID IN A LITERAL.
;CARRY SET IF HEX DIGIT OR H/O/Q.
;*******************************************************************
HEXDG:	CALL	DIGIT			; CARRY SET IF 0-9
	RET	C
	CP	'A'
	JR	C,HEXDG1
	CP	'F'+1
	RET	C
	CP	'H'
	JR	Z,HEXDG2
	CP	'O'
	JR	Z,HEXDG2
	CP	'Q'
	JR	Z,HEXDG2
HEXDG1:	AND	A			; NOT HEX DIG., CLEAR CARRY
	RET
HEXDG2:	SCF				; HEX DIGIT, SET CARRY
	RET
;*********************************************************************
;SHIFT DE LEFT 1 BIT - ENTER 0 FROM RIGHT.
;SET 'VALUE' ERROR IF OVERFLOW.
;*********************************************************************
SHLDE:	EX	DE,HL			; DO SHIFT BY ADDITION IN HL
	ADD	HL,HL
	EX	DE,HL
	RET	NC			; NO CARRY, SO RETURN 
	PUSH	BC			; CARRY, SO INDICATE 'V' ERROR
	LD	C,'V'
	CALL	ERROR
	POP	BC
	RET
;*********************************************************************
;ADD BC TO DE - SET 'VALUE' ERROR IF OVERFLOW.
;*********************************************************************
ABCDE:	PUSH	BC
	EX	DE,HL			; DO ADDITION IN HL
	ADD	HL,BC			; DO ADDITION
	EX	DE,HL			; GET RESULT BACK TO DE
	JR	NC,ABCDE1
	LD	C,'V'			; CARRYOUT SO INDICATE 'V' ERROR
	CALL	ERROR
ABCDE1:	POP	BC
	RET
;*********************************************************************
;ADD C TO DE - NO OVERFLOW INDICATION
;*********************************************************************
ADCDE:	PUSH	BC
	EX	DE,HL
	LD	B,0
	ADD	HL,BC
	EX	DE,HL
	POP	BC
	RET
;*********************************************************************
;PROCESS SYMBOL. 
;GET SYMBOL AND FETCH ITS VALUE FROM THE SYMBOL TABLE. RETURN VALUE
;IN DE.
;********************************************************************
PSYMB:	PUSH	BC			; SAVE REGISTERS
	LD	DE,SYMBUF		; SET PNTR TO SYMBOL BUFFER
	CALL	GSYM			; GET SYMB FROM LINE TO SYMBUF
	PUSH	HL			; SAVE PNTR TO CHAR AFTER SYMB
	CALL	LOCATE			; FIND SYMB IN SYMTAB
	JR	NZ,PSYMB1		; NOT IN TABLE?
	LD	E,(HL)			; MOVE VALUE TO DE
	INC	HL
	LD	D,(HL)
	JR	PSYMB2
PSYMB1:	LD	C,'U'			; INDICATE 'UNDEFINED' ERROR
	CALL	ERROR
	LD	DE,0			; SET DE=0 DEFAULT VALUE
PSYMB2:	POP	HL			; REPLACE REGISTERS
	POP	BC
	AND	A			; CLEAR CARRY FLAG SO
	RET				; AS NOT TO INDICATE 'VALUE' ERROR
;*********************************************************************
;PROCESS ASCII LITERAL.
;RETURN VALUE OF 1 OR 2 ASCII CHARACTERS.
;ON ENTRY:
;          HL POINTS TO START QUOTE
;ON EXIT:
;          HL POINTS TO CHAR AFTER CLOSE QUOTE
;          DE CONTAINS VALUE
;          CARRY FLAG SET IF ERROR
;***********************************************************************
PASC:	LD	DE,0			; CLEAR 16 BIT ACC. DE
	INC	HL			; POINT TO CHAR AFTER QUOTE
	CALL	DOUBQ			; IS NEXT CHAR CLOSING QUOTE?
	JR	NZ,PASC2		; JUMP IF SO
	LD	E,(HL)			; OTHERWISE SAVE CHAR IN E
	INC	HL			; POINT TO NEXT CHAR
	CALL	DOUBQ			; NEXT CHAR CLOSE QUOTE?
	JR	NZ,PASC2		; JUMP IF SO
	LD	D,(HL)			; OTHERWISE SAVE IN D
	INC	HL			; POINT TO NEXT CHAR
	CALL	DOUBQ			; NEXT CHAR CLOSE QUOTE?
	JR	NZ,PASC2		; JUMP IF SO
PASC1:	SCF				; ERROR, SET CARRY
	RET
PASC2:	AND	A			; NO ERROR, CLEAR CARRY
	RET
;......................................................
;DOUBLE QUOTE.
;IS NEXT ITEM IN STRING A CHARACTER OF THE END OF THE ASCII
;LITERAL? ON ENTRY: HL POINTS AT THE NEXT ITEM, ON EXIT: HL
;HAS BEEN INCREMENTED IF DOUBLE QUOTE. ZERO SET IF CHAR.
;......................................................
DOUBQ:	LD	A,(HL)			; GET CHAR
	CP	''''			; IS IT A QUOTE?
	JR	NZ,DOUBQ1		; JUMP IF NOT
	INC	HL			; POINT TO NEXT CHAR
 	LD	A,(HL)			; GET IT
	CP	''''			; IS IT A QUOTE?
	RET				; ZERO SET FOR CHAR
					; CLEARED IF LAST QUOTE WAS
					; CLOSE QUOTE.
DOUBQ1:	XOR	A			; LIT CHAR. SET ZERO.
	RET
;********************************************************************
;PROCESS MULTI-CHAR FUNCTION.
;ON ENTRY:
;	HL POINTS TO FIRST CHAR OF FUNCTION STRING
;ON EXIT:
;	HL POINTS TO CHAR AFTER FUNCTION STRING
;	FTOKR CONTAINS TOKEN FOR FUNCTION
;	ZERO FLAG SET FOR ERROR
;********************************************************************
PMCF:	PUSH	BC			; SAVE REGISTERS
	PUSH	DE
	INC	HL			; POINT TO CHAR AFTER '.'
	LD	A,(HL)			; GET IT
	CALL	ALPHA			; IS IT A LETTER?
	JR	NC,PMCF1		; NO, SYNTAX ERROR
	LD	DE,SYMBUF		; SET POINTER TO SYMBUF
	CALL	GSYM			; GET FUNCTION IN SYMBUF
	INC	HL			; INCR PNTR
	PUSH	HL			; AND SAVE IT ON STACK
	CP	'.'			; WAS CHAR AFT. FUN. '.'?
	JR	NZ,PMCF2		; JUMP IF NOT
	LD	A,(SYMBUF)		; GET NO OF CHARS
	CP	5			; MORE THAN 4?
	JR	NC,PMCF2		; JUMP IF SO
	LD	DE,FTOKR		; PNTR TO TOKEN REG.
	LD	HL,MFLSTP		; PNTR TO OPR LIST
	LD	C,1			; 1 TOKEN/ENTRY IN LIST
	CALL	OPTOK			; GET TOKEN
	JR	PMCF3
PMCF1:	XOR	A			; SET ZERO TO INDICATE ERR.
	JR	PMCF4
PMCF2:	XOR	A			; SET ZERO TO INDICATE ERROR
PMCF3:	POP	HL
PMCF4:	POP	DE
	POP	BC
	RET
;***********************************************************************
;PROCESS SINGLE CHAR FUNCTION.
;ON ENTRY:
;	HL POINTS AT FUNCTION CHAR
;ON EXIT:
;	HL POINTS TO CHAR AFTER FUNCTION CHAR(S)
;	FTOKR CONTAINS TOKEN FOR FUNCTION
;	ZERO FLAG SET IF ERROR
;***********************************************************************
PSCF:	PUSH	BC			; SAVE REGISTERS
	PUSH	DE
	LD	B,(HL)			; GET POTENTIAL FUNCTION
	INC	HL			; & INCR PNTR
	LD	DE,SCF1			; SET UP POINTER TO LIST
PSCF1:	LD	A,(DE)			; GET LIST ENTRY
	AND	A			; IS IT ZERO?
	JR	Z,PSCF3			; END OF LIST, INVAL. CHAR
	CP	B			; MATCH?
	INC	DE			; INCR. PNTR. TO TOKEN
	JR	Z,PSCF2			; JUMP IF MATCH
	INC	DE			; OTHERWISE POINT TO NEXT ENTRY
 	JR	PSCF1			; LOOP
PSCF2:	LD	A,(DE)			; GET THE TOKEN
	LD	(FTOKR),A		; & PUT IN TOKEN REG.
	CP	ASKTOK			; IS IT * ?(MAYBE **) 
	JR	NZ,PSCF4		; JUMP IF NOT
	LD	A,(HL)			; GET NEXT CHAR
	CP	'*'			; IS IT '*'?
	JR	NZ,PSCF4		; JUMP IF NOT
	LD	A,EXPTOK		; PUT TOKEN FOR ** IN REG
	LD	(FTOKR),A
	INC	HL			; AND INCR PNTR
	AND	A			; CLEAR ZERO FLAG
	JR	PSCF4
PSCF3:	XOR	A			; SET ZERO TO INDICATE ERROR
PSCF4:	POP	DE			; REPLACE REGS
	POP	BC
	RET
;***********************************************************************
;PUSH ACC TO FUNCTION STACK.
;BYTE IN A IS PUSHED ONTO THE FUNCTION
;STACK (FSTK). IF NOT POSSIBLE OWING TO 
;THE STACK BEING FULL, THEN THE ZERO FLAG
;IS SET ON EXIT.
;***********************************************************************   
PUFU:	PUSH	HL			; SAVE REGISTERS
	PUSH	BC
	EX	AF,AF'			; SAVE FUNCTION
	LD	HL,FSTK			; LOAD START OF STACK ADDR
	LD	A,(FCNT)		; GET STACK COUNTER
	CP	MAXFSK			; IS STACK FULL?
	JR	NC,PUFU2
	LD	C,A			; COMPUTE TOP OF STACK
	LD	B,0
	ADD	HL,BC			; TOP OF STACK IN HL
	INC	A			; INCREMENT STACK COUNTER
	LD	(FCNT),A		; AND STORE NEW VALUE
	EX	AF,AF'			; GET FUNCTION BACK
	LD	(HL),A			; PUSH ONTO FUNCTION STACK
	XOR	A			; CLEAR ZERO FLAG
	INC	A
PUFU1:	POP	BC			; REPLACE REGISTERS
	POP	HL
	RET
PUFU2:	XOR	A			; SET ZERO FLAG (STACK FULL)
	JR	PUFU1
;***********************************************************************
;POP FROM FUNCTION STACK TO ACC
;THE TOP BYTE ON THE FUNCTION STACK IS
;POPPED INTO THE A REG. IF THE STACK WAS
;ALREADY EMPTY, THE ZERO FLAG IS SET ON
;EXIT
;***********************************************************************
POFU:	PUSH	HL			; SAVE REGS.
	PUSH	BC
	LD	HL,FSTK			; LOAD START OF STACK ADDR
	LD	A,(FCNT)		; GET STACK COUNTER
	AND	A			; TEST FOR EMPTY STACK
	JR	Z,POFU1
	DEC	A
	LD	(FCNT),A
	LD	C,A
	LD	B,0
	ADD	HL,BC
	XOR	A			; CLEAR ZERO FLAG
	INC	A
	LD	A,(HL)			; GET STACK TOP TO ACC
POFU1:	POP	BC			; REPLACE REGS.
	POP	HL
	RET
;***********************************************************************
;PUSH FROM DE TO ARITHMETIC STACK
;THE WORD IN DE IS PUSHED ONTO THE
;ARITHMETIC STACK. IF NOT POSSIBLE
;OWING TO THE STACK BEING FULL, THEN
;THE ZERO FLAG IS SET ON EXIT.
;***********************************************************************
PUDE:	PUSH	HL			; SAVE REGS.
	PUSH	BC
	LD	HL,ARSTK		; LOAD START OF STACK ADDR
	LD	A,(ARCNT)		; GET STACK COUNTER
        CP	MAXASK			; IS STACK FULL?
	JR	NC,PUDE2
	LD	C,A			; COMPUTE TOP OF STACK
	LD	B,0
	ADD	HL,BC			; TOP OF STACK IN HL
	ADD	A,2			; INCREMENT COUNTER BY 1 WORD
	LD	(ARCNT),A		; STORE NEW VALUE OF COUNTER
	LD	(HL),E			; PUSH DE ONTO STACK
	INC	HL
	LD	(HL),D
	XOR	A			; CLEAR ZERO FLAG
	INC	A
PUDE1:	POP	BC
	POP	HL
	RET
PUDE2:	XOR	A			; SET ZERO FLAG (ERROR)
	JR	PUDE1
;**********************************************************************
;POP FROM ARITHMETIC STACK TO DE
;THE TOP WORD ON THE ARITHMETIC STACK
;IS POPPED INTO THE DE REG PAIR. IF
;THE STACK WAS EMPTY, THEN THE ZERO
;FLAG IS SET ON EXIT
;**********************************************************************
PODE:	PUSH	HL			; SAVE REGS
	PUSH	BC
	LD	HL,ARSTK		; LOAD START OF STACK ADDR
	LD	A,(ARCNT)		; GET STACK COUNTER
	AND	A			; IS STACK EMPTY?
	JR	Z,PODE1
	SUB	2			; DECR STACK COUNTER
	LD	(ARCNT),A		; AND SAVE NEW VALUE
	LD	C,A			; COMPUTE TOP OF STACK
	LD	B,0
	ADD	HL,BC
	LD	E,(HL)			; POP STACK TO DE
	INC	HL
	LD	D,(HL)
	XOR	A			; CLEAR ZERO FLAG
	INC	A
PODE1:	POP	BC			; REPLACE REGS
 	POP	HL
	RET
;*********************************************************************
;PERFORM A FUNCTION
;ON ENTRY:
;	A CONTAINS THE COMBINED FUNCTION
;	TOKEN/PRIORITY VALUE.
;ON EXIT:
;	THE REQUIRED ASSEMBLY TIME FUNCTION
;	HAS BEEN PERFORMED USING VALUE(S)
;	ON THE ARITHMETIC STACK AND LEAVING
;	THE RESULT THERE.
;	IF THE STACK DID NOT CONTAIN ENOUGH
;       VALUES THEN THE ZERO FLAG IS SET.
;
;THE FOLLOWING SUBROUTINES STARTING WITH
;THE LETTER F ARE ALL ASSEMBLY TIME
;ARITHMETIC/LOGIC FUNCTIONS, OPERATING ON
;THE ARITHMETIC STACK, AND BEING CALLED
;INDIRECTLY BY FUNC
;********************************************************************
FUNC:	PUSH	HL			; SAVE REGS.
	PUSH	DE
	PUSH	BC
	SRL	A			; GET (FUNC TOKEN)*2
	SRL	A
	AND	0FEH
	LD	C,A			; COMPUTE POINTER TO SUBROUTINE
	LD	B,0			; START ADDR POINTER
	LD	HL,FUNLST
	ADD	HL,BC
	LD	E,(HL)			; PUT SUBR START ADDR IN HL
	INC	HL
	LD	D,(HL)
	EX	DE,HL
	LD	DE,FUNC1		; CALL RELEVANT FUNCTION INDIRECTLY
	PUSH	DE
	JP	(HL)
FUNC1:	POP	BC
	POP	DE
	POP	HL
	RET
;.............................................................
;FUNCTION LIST.
;CONTAINS POINTERS TO THE FUNCTION
;SUBROUTINES, USED BY SUBR 'FUNC'
;FOR AN INDIRECT SUBR CALL BASED ON
;THE VALUE OF THE ARITHMETIC
;FUNCTION TOKEN.
;.............................................................
FUNLST:	DEFW	FMNPL
	DEFW	FMNMN
 	DEFW	FNOT
	DEFW	FHIGH
	DEFW	FLOW
	DEFW	FRES
	DEFW	FEXP
	DEFW	FMULT
	DEFW	FDIV
	DEFW	FMOD
	DEFW	FSHR
	DEFW	FSHL
	DEFW	FDIPL
	DEFW	FDIMN
	DEFW	FAND
	DEFW	FOR
	DEFW	FXOR
	DEFW	FEQ
	DEFW	FGT
	DEFW	FLT
	DEFW	FUGT
	DEFW	FULT
;**************************************************************
;FUNCTION MONADIC PLUS.
;**************************************************************
FMNPL:	PUSH	DE			; SAVE REG
	CALL	PODE			; SEE IF VALUE AVAILABLE ON STACK
	JR	Z,FMNPL1		; JUMP IF NOT (ZERO SET)
	CALL	PUDE			; PUSH BACK ON STACK
FMNPL1:	POP	DE			; REPLACE REG
	RET
;**************************************************************
;FUNCTION MONADIC MINUS.
;**************************************************************
FMNMN:	PUSH	DE			; SAVE REGS.
	PUSH	HL
	CALL	PODE			; GET VALUE OFF ARITH STACK
	JR	Z,FMNMN1		; JUMP IF EMPTY
	LD	HL,0			; PUT 0 INTO HL
	AND	A			; CLEAR CARRY
	SBC	HL,DE			; SUBTRACT VALUE FROM 0
	EX	DE,HL			; GET RESULT IN DE
	CALL	PUDE			; PUSH BACK ON STACK
FMNMN1:	POP	HL			; REPLACE REGS.
	POP	DE
	RET
;**************************************************************
;FUNCTION NOT
;**************************************************************
FNOT:	PUSH	DE			; SAVE REG.
	CALL	PODE			; GET VALUE FROM ARITH STACK
	JR	Z,FNOT1			; JUMP IF EMPTY
	LD	A,D			; COMPLEMENT DE
	CPL
	LD	D,A
	LD	A,E
	CPL
	LD	E,A
	CALL	PUDE			; PUSH BACK ON ARITH STACK
FNOT1:	POP	DE			; REPLACE REG.
	RET
;**************************************************************
;FUNCTION HIGH.
;RETURNS HIGH BYTE OF ARGUMENT AS RESULT.
;**************************************************************
FHIGH:	PUSH	DE			; SAVE REGISTERS
	CALL	PODE			; GET VALUE FROM ARITH STACK
	JR	Z,FHIGH1		; ERROR IF EMPTY
	LD	E,D			; PUT HIGH BYTE IN DE
	LD	D,0
	CALL	PUDE			; PUSH RESULT ON ARITH STACK
FHIGH1: POP	DE
	RET
;**************************************************************
;FUNCTION LOW.
;RETURNS LOW BYTE OF ARGUMENT AS RESULT.
;**************************************************************
FLOW:	PUSH	DE			; SAVE REGISTERS
	CALL	PODE			; GET VALUE FROM ARITH STACK
	JR	Z,FLOW1			; ERROR IF EMPTY
	LD	D,0			; LOW BYTE ONLY REQD
	CALL	PUDE			; PUSH BACK RESULT
FLOW1:	POP	DE			; REPLACE REGS
	RET
;***************************************************************
;FNCTION RESULT
;CLEARS ARITHMETIC OVERFLOW FLAG
;***************************************************************
FRES:	EXX				; CLEAR OVERFLOW FLAG
	RES	1,B			; BIT 1 IN REG B
	EXX
	RET
;***************************************************************
;FUNCTION EXPONENTIATE
;***************************************************************
FEXP:	PUSH	HL			; SAVE REGS
	PUSH	DE
	CALL	PODE			; GET EXPONENT FROM STACK
	JR	Z,FEXP5			; JMP IF ARITH STACK EMPTY
	EX	DE,HL			; PUT EXPONENT IN HL
	CALL	PODE			; GET OTHER NUMBER IN DE
	JR	Z,FEXP5			; JUMP IF STACK EMPTY
	LD	A,H			; EXPONENT ZERO?
	OR	L
	JR	NZ,FEXP1		; JUMP IF NOT
	LD	DE,1			; RESULT = 1
	CALL	PUDE			; PUSH IT ON STACK
	JR	FEXP5
FEXP1:	BIT	7,H			; EXPONENT NEGATIVE?
	JR	Z,FEXP2			; JUMP IF NOT
	LD	DE,0			; RESULT = 0
	CALL	PUDE			; PUSH IT ON STACK
	JR	FEXP5
FEXP2:	CALL	PUDE			; PUSH THE NUMBER
FEXP3:	DEC	HL			; DECR EXPONENT
	LD	A,H			; IS IT ZERO NOW?
	OR	L
	JR	Z,FEXP4			; JUMP IF SO
	CALL	PUDE			; PUSH THE NUMBER
	CALL	FMULT			; & MULTIPLY
	JR	FEXP3			; LOOP
FEXP4:	XOR	A			; CLEAR ZERO FLAG
	INC	A
FEXP5:	POP	DE			; REPLACE REGISTERS
	POP	HL
	RET

; *******************************************************************
; FUNCTION MULTIPLY
; *******************************************************************
FMULT:	PUSH	HL			; SAVE REGISTERS
	PUSH	DE			
	PUSH	BC
	EXX
	PUSH	DE
	LD	E,0			; CLEAR E' (SIGN FLAG)
	EXX
	CALL	PODE			; GET A VALUE FROM ARITH STACK
	JR	Z,FMULT6		; JUMP IF EMPTY
	BIT	7,D			; IS IT NEGATIVE?
	CALL	NZ,NEGDE		; IF SO, NEGATE, AND COMPLEMENT
					; SIGN FLAG
	EX	DE,HL
	CALL	PODE			; GET ANOTHER VALUE FROM STACK
	JR	Z,FMULT6		; JUMP IF EMPTY
	BIT	7,D			; IS IT -VE
	CALL	NZ,NEGDE		; IF SO, NEGATE, AND COMPL.
					; SIGN FLAG
	AND	A			; CLEAR CARRY
	SBC	HL,DE			; TEST FOR LARGER NO.
	ADD	HL,DE			; MULTIPLIER SHOULD BE SMALLER
	JR	NC,FMULT1		; JUMP IF CORRECT
	EX	DE,HL			; OTHERWISE SWAP NOS.
FMULT1:	LD	B,H			; PUT MULTIPLICAND IN BC
	LD	C,L
	LD	HL,0			; CLEAR HL FOR ACCUMALATOR
FMULT2:	LD	A,D			; IS MULTIPLIER 0?
	OR	E
	JR	Z,FMULT5		; JUMP IF FINISHED
	SRL	D			; SHIFT DE RIGHT INTO CARRY
	RR	E
	JR	NC,FMULT4		; JUMP IF ZERO CARRY
	AND	A			; CLEAR CARRY
	ADC	HL,BC			; ADD MULTIPLICAND TO RUNNING TOTAL
	JP	M,FMULT3		; JUMP IF OVERFLOW TO BIT 15
	JR	NC,FMULT4		; JUMP IF NO O/F TO BIT 16
FMULT3:	EXX				; SET OVERFLOW FLAG
	SET	1,B
	EXX
FMULT4:	SLA	C			; SHIFT MULTIPLICAND LEFT
	RL	B
	JR	FMULT2			; LOOP
FMULT5:	EX	DE,HL			; GET RESULT BACK IN DE
	EXX				; SHOULD RESULT BE -VE?
	BIT	0,E			; (PRODUCT SIGN IN E')
	EXX
	CALL	NZ,NEGDE
	CALL	PUDE			; PUSH PRODUCT ONTO ARITH STACK
FMULT6:	EXX				; REPLACE REGS.
	POP	DE
	EXX
	POP	BC
	POP	DE
	POP	HL
	RET
;***********************************************************************
;FUNCTION DIVIDE
;***********************************************************************
FDIV:	PUSH	HL			; SAVE REGISTERS
	PUSH	DE
	CALL	PODE			; GET DIVISOR FROM ARITH STACK
	JR	Z,FDIV1			; JUMP IF EMPTY
	EX	DE,HL			; PUT IN HL
	CALL	PODE			; GET DIVIDEND FROM ARITH STACK
	JR	Z,FDIV1			; JUMP IF EMPTY
	CALL	DIV			; DO THE DIVISION
        CALL    PUDE			; PUSH QUOTIENT (IN DE) ONTO STACK
FDIV1:	POP	DE			; REPLACE REGISTERS
	POP	HL
	RET
;**********************************************************************
;FUNCTION MODULO
;**********************************************************************
FMOD:	PUSH	HL			; SAVE REGISTERS
	PUSH	DE
	CALL	PODE			; GET DIVISOR FROM ARITH STACK
	JR	Z,FMOD1			; JUMP IF EMPTY
	EX	DE,HL			; PUT IN HL
	CALL	PODE			; GET DIVIDEND FOM ARITH STACK
	JR	Z,FMOD1			; JUMP IF EMPTY
	CALL	DIV			; DO THE DIVISION
	EX	DE,HL			; GET REMAINDER IN DE
	CALL	PUDE			; PUSH ONTO ARITH STACK
FMOD1:	POP	DE			; REPLACE REGISTERS
	POP	HL
	RET
;**********************************************************************
;DIVIDE
;THIS SUBROUTINE IS USED BY FDIV AND FMOD
;IT DIVIDES DE BY HL, LEAVING THE QUOTIENT
;IN DE AND THE REMAINDER IN HL.
;SIGNED 16 BIT ARITHMETIC IS USED.
;**********************************************************************
DIV:	PUSH	BC			; SAVE REGISTERS
	EXX
	PUSH	DE
	LD	DE,0			; CLEAR DE' (D'=PLACE COUNT)
					; (E'=SIGN COUNT)
	EXX
	BIT	7,D			; IS DIVIDEND -VE?
	JR	Z,DIV1			; JUMP IF NOT
	EXX				; OTHERWISE FLAG IN E', BIT 7
	SET	7,E			; TO GIVE SIGN OF REMAINDER
	EXX
DIV1:	BIT	7,D			; IS DIVIDEND -VE?
	CALL	NZ,NEGDE		; IF SO NEGATE, AND INCR
					; QUOTIENT SIGN BIT (E' BIT 0)
	EX	DE,HL			; SWAP NOS.
	BIT	7,D			; IS DIVISOR -VE?
	CALL	NZ,NEGDE		; IF SO NEGATE AND
					; INCR QUOTIENT SIGN FLAG
	LD	A,D			; IS DIVISOR ZERO?
	OR	E
	JR	NZ,DIV2			; JUMP IF NOT
	LD	C,'Z'			; FLAG 'DIV BY ZERO' ERROR
	CALL	ERROR
	LD	HL,0			; RETURN ZERO RESULTS
	LD 	DE,0			   
	JR	DIV6			; GO TO END
DIV2:	EXX				; INCR PLACE COUNT
	INC	D
	EXX
	SLA	E			; SHIFT DIVISOR LEFT UNTIL SIGN
	RL	D			; SET, COUNTING NO. OF PLACES
	JP	P,DIV2
	LD	BC,0			; CLEAR QUOTIENT REG BC
DIV3:	SLA	C			; SHIFT QUOTIENT LEFT
	RL	B
	SRL	D
	RR	E
	AND	A			; CLEAR CARRY
	SBC	HL,DE			; SUBTRACT DIVISOR FROM DIVIDEND
	JR	C,DIV4			; JUMP IF TOO MUCH SUBTRACTION
	INC	BC			; OTHERWISE INCR QUOTIENT
	JR	DIV5
DIV4:	ADD	HL,DE			; REPLACE EXCESSIVE SUBTRACTION
DIV5:	EXX				; DECR PLACE COUNT
	DEC	D
	EXX
	JR	NZ,DIV3			; LOOP IF NOT FINISHED
	LD	D,B			; TRANSFER QUOTIENT TO DE
	LD 	E,C
	EX	DE,HL			; SWAP WITH REMAINDER
	EXX				; GET SIGN FLAGS INTO C
	LD	A,E			  
	EXX
	LD	C,A
	BIT	7,C			; WAS DIVIDEND -VE?
	CALL	NZ,NEGDE		; NEGATE REMAINDER IF SO
	EX	DE,HL			; SWAP BACK NOS.
	BIT	0,C			; IS QUOTIENT -VE?
	CALL	NZ,NEGDE		; NEGATE IF SO
DIV6:	EXX				; REPLACE REGISTERS
	POP	DE
	EXX
	POP	BC
	RET
;*************************************************************************
;NEGATE DE
;USED BE FMULT AND DIV TO NEGATE CONTENTS OF DE
;AND COMPLEMENT A SIGN FLAG HELD IN E' BIT 0
;*************************************************************************
NEGDE:	PUSH	HL			; SAVE HL
	LD	HL,0			; NEGATE SIGNED NO. IN DE
	AND	A			; CLEAR CARRY
	SBC	HL,DE			; SUBTRACT DE FROM 0
	EX	DE,HL			; GET RESULT INTO DE
	EXX				; COMPLEMENT PRODUCT SIGN
					; BIT IN E'
	RR	E
	CCF
	RL	E
	EXX
	POP	HL
	RET
;************************************************************************
;FUNCTION SHIFT RIGHT.
;************************************************************************
FSHR:	PUSH	DE			; SAVE REGS.
	PUSH	HL
	CALL	PODE			; GET VALUE FROM ARITH STACK
	JR	Z,FSHR3			; ERROR IF EMPTY
	EX	DE,HL			; OTHERWISE PUT IN HL
	CALL	PODE			; GET VALUE TO BE SHIFTED
	JR	Z,FSHR3			; JUMP IF EMPTY, ERROR
FSHR1:	LD	A,H			; TEST HL FOR ZERO
	OR	L			; AND CLEAR CARRY
	JR	Z,FSHR2			; JUMP IF NO MORE SHIFTING
	SRL	D			; SHIFT DE RIGHT ONE BIT
	RR	E
	DEC	HL			; DECR NO. OF SHIFTS REQD
	JR	FSHR1			; LOOP
FSHR2:	CALL	PUDE			; PUSH RESULT BACK ON STACK
FSHR3:	POP	HL			; REPLACE REGS
	POP	DE
	RET
;***********************************************************************
;FUNCTION SHIFT LEFT
;***********************************************************************
FSHL:	PUSH	DE			; SAVE REGS.
	PUSH	HL
	CALL	PODE			; GET VALUE FROM ARITH STACK
	JR	Z,FSHL3			; JUMP IF EMPTY, ERROR
	EX	DE,HL			; GET VALUE IN HL
	CALL	PODE			; GET VALUE TO BE SHIFTED
	JR	Z,FSHL3			; ERROR IF EMPTY
FSHL1:	LD	A,H			; TEST HL FOR ZERO
	OR	L			; AND CLEAR CARRY
	JR	Z,FSHL2			  
	SLA	E			; SHIFT DE LEFT 1 BIT
	RL	D
	DEC	HL			; DECR NO. OF SHIFTS REGD.
	JR	FSHL1			; LOOP
FSHL2:	CALL	PUDE			; PUSH RESULT ON ARITH STACK
FSHL3:	POP	HL			; REPLACE REGS.
	POP	DE
	RET
;*********************************************************************
;FUNCTION DIADIC ADDITION
;*********************************************************************
FDIPL:	PUSH	HL			; SAVE REGISTERS
	PUSH	DE
	CALL	PODE			; GET 1ST VALUE TO BE ADDED
	JR	Z,FDIPL6		; STACK EMPTY- ERROR
	EX	DE,HL			; PUT 1ST VALUE IN HL
	CALL	PODE			; GET 2ND VALUE
	JR	Z,FDIPL6		; STACK EMPTY ERROR
	EXX				; CLEAR +VE/-VE FLAGS IN B'
	RES	6,B			; (-VE)
	RES	7,B			; (+VE)
	EXX
	LD	A,H			; BOTH VALUES -VE?
	AND	D
	JP	P,FDIPL1
	EXX				; YES, SET 'BOTH -VE' FLAG
	SET	6,B
	EXX
	JR	FDIPL2
FDIPL1:	LD	A,H			; BOTH VALUES +VE?
	OR	D
	JP	M,FDIPL2
	EXX				; YES, SET BOTH +VE FLAG
	SET	7,B
	EXX
FDIPL2:	AND	A			; CLEAR CARRY FLAG
	ADC	HL,DE			; ADD THE 2 VALUES
	EXX
	JP	M,FDIPL3
	BIT	6,B			; RESULT +VE
	JR	Z,FDIPL5
	JR	FDIPL4			; SET OVERFLOW FLAG
FDIPL3:	BIT	7,B
	JR	Z,FDIPL5
FDIPL4:	SET	1,B			; SET OVERFLOW FLAG
FDIPL5:	EXX
	EX	DE,HL			; GET RESULT IN DE
	CALL	PUDE			; PUSH RESULT ON STACK
FDIPL6:	POP	DE
	POP	HL
	RET
;********************************************************************
;FUNCTION DIADIC MINUS.
;********************************************************************
FDIMN:	PUSH	HL			; SAVE REGS.
	PUSH	DE
	CALL	PODE			; GET MINUEND FROM STACK
	JR	Z,FDIMN6		; JUMP IF EMPTY, ERROR
	EX	DE,HL			; PUT IN HL
	CALL	PODE			; GET SUBTRAHEND
	JR	Z,FDIMN6		; JUMP IF EMPTY
	EXX				; CLEAR +VE/-VE FLAGS IN B'
	RES	6,B			; (-VE EXPECTED FLAG)
	RES	7,B			; (+VE EXPECTED FLAG)
	EXX
	LD	A,D
	AND	A			; TEST SIGN OF SUBTRAHEND
	JP	M,FDIMN1		; JUMP IF -VE
	LD	A,H
	AND	A			; TEST SIGN OF MINUEND
	JP	P,FDIMN2		; JUMP IF OF OPPOSITE SIGN
					; NO OVERFLOW POSSIBLE
	EXX     		        ; OTHERWISE SET		  
	SET	7,B			; +VE EXPECTED FLAG
	EXX
	JR	FDIMN2
FDIMN1:	LD	A,H			; TEST SIGN OF MINUEND
	AND	A
	JP	M,FDIMN2		; JUMP IF OF OPPOSITE SIGN 
					; NO OVERFLOW POSSIBLE
	EXX				; SET '-VE EXPECTED' FLAG
	SET	6,B
	EXX
FDIMN2:	EX	DE,HL			; GET SUBTRAHEND IN HL
	AND	A			; CLEAR CARRY
	SBC	HL,DE			; DO THE SUBTRACTION
	EX	DE,HL			; GET THE RESULT IN DE
	EXX				; PREPARE TO EXAMINE B'
	JP	M,FDIMN3		; JUMP IF -VE RESULT
	BIT	6,B			; RESULT +VE, WAS -VE EXPECTED?
	JR	NZ,FDIMN4		; JUMP IF SO
	JR	FDIMN5			; OTHERWISE NO OVERFLOW
FDIMN3:	BIT	7,B			; RESULT -VE, WAS +VE EXPECTED?
	JR	Z,FDIMN5		; JUMP IF NOT
FDIMN4:	SET	1,B			; SET OVERFLOW FLAG (1,B')
FDIMN5:	EXX				; SWITCH REGS BACK
	CALL	PUDE			; PUSH RESULT ON ARITH STACK
FDIMN6:	POP	DE			; REPLACE REGS
	POP	HL
	RET
;**********************************************************************
;FUNCTION AND
;**********************************************************************
FAND:	PUSH	DE			; SAVE REGISTERS 
	PUSH	HL
	CALL	PODE			; GET VALUE FROM STACK
	JR	Z,FAND1			; JUMP IF EMPTY
	EX	DE,HL
	CALL	PODE			; GET THE OTHER VALUE
	JR	Z,FAND1			; JUMP IF STACK EMPTY
	LD 	A,D			; DO 16 BIT LOGICAL AND
	AND	H
	LD	D,A			; WITH RESULT IN DE
	LD	A,E
	AND	L
	LD	E,A
	CALL	PUDE			; PUSH RESULT ON STACK
FAND1:	POP	HL			; REPLACE REGS
	POP	DE			  
	RET
;*********************************************************************
;FUNCTION OR
;*********************************************************************
FOR:	PUSH	DE			; SAVE REGS.
	PUSH	HL
	CALL	PODE			; GET VALUE FROM ARITH STACK
	JR	Z,FOR1			; JUMP IF STACK EMPTY
	EX	DE,HL			; PUT IN HL
	CALL	PODE			; GET THE OTHER VALUE
	JR	Z,FOR1			; JUMP IF STACK EMPTY
	LD	A,D			; DO 16 BIT LOGICAL OR
	OR	H			; ON HL AND DE
	LD	D,A			; RESULT IN DE
	LD	A,E
	OR	L
	LD	E,A
	CALL	PUDE			; PUSH RESULT ON STACK
FOR1:	POP	HL			; REPLACE REGS
	POP	DE
	RET
;********************************************************************
;FUNCTION EXCLUSIVE OR
;********************************************************************
FXOR:	PUSH	DE			; SAVE REGS
	PUSH	HL
	CALL	PODE			; GET VALUE FROM ARITH STACK
	JR	Z,FXOR1			; JUMP IF STACK EMPTY
	EX	DE,HL			; PUT IT IN HL
	CALL	PODE			; GET THE OTHER VALUE
	JR	Z,FXOR1			; JUMP IF STACK EMPTY
	LD	A,D			; DO 16 BIT XOR ON HL AND DE
	XOR	H
	LD	D,A			; RESULT IN DE
	LD	A,E
	XOR	L
	LD	E,A
	CALL	PUDE			; PUSH RESULT ON ARITH STACK
FXOR1:	POP	HL			; REPLACE REGS
	POP	DE
	RET
;*******************************************************************
;FUNCTION EQUALS
;*******************************************************************
FEQ:	PUSH	DE			; SAVE REGS
	PUSH	HL
	CALL	PODE			; GET VALUE FROM ARITH STACK
	JR	Z,FEQ2			; JUMP IF STACK EMPTY
	EX	DE,HL			; PUT IT IN HL
	CALL	PODE			; GET ANOTHER VALUE IN DE
	JR	Z,FEQ2			; JUMP IF STACK EMPTY
	AND	A			; CLEAR CARRY
	SBC	HL,DE			; COMPARE VALUES
	LD	DE,0			; RESULT IN DE (0 OR 1)
	JR	NZ,FEQ1			; JUMP IF VALUES NOT EQUAL
	DEC	DE			; OTHERWISE LET RESULT= -1
FEQ1:	CALL	PUDE			; PUSH RESULT ON STACK
FEQ2:	POP	HL			; REPLACE REGS 
	POP	DE
	RET
;*********************************************************************
;FUNCTION GREATER THAN
;*********************************************************************
FGT:	PUSH	DE			; SAVE REGS.
	PUSH	HL
	CALL	PODE			; GET VALUE FROM ARITH STACK
	JR	Z,FGT2			; JUMP IF STACK EMPTY
	EX	DE,HL
	CALL	PODE			; GET THE OTHER VALUE IN DE
	JR	Z,FGT2			; JUMP IF STACK EMPTY
	LD	A,D			; ADD 8000H TO EACH NO.
	ADD	A,80H
	LD	D,A
	LD	A,H
	ADD	A,80H
	LD	H,A
	AND	A			; CLEAR CARRY
	SBC	HL,DE			; COMPARE VALUES
	LD	DE,0			; RESULT IN DE (0 OR 1)
  	JR	NC,FGT1			; JUMP IF NOT GREATER THAN 
	DEC	DE			; OTHERWISE RESULT= -1
FGT1:	CALL	PUDE			; PUSH RESULT ON STACK
FGT2:	POP	HL			; REPLACE REGS
	POP	DE
	RET
;*********************************************************************
;FUNCTION LESS THAN
;*********************************************************************
FLT:	PUSH	DE			; SAVE REGS
	PUSH	HL
	CALL	PODE			; GET VALUE FROM ARITH STACK
	JR	Z,FLT2			; JUMP IF STACK EMPTY
	EX	DE,HL			; PUT VALUE IN HL
	CALL	PODE			; GET THE OTHER VALUE IN DE
	JR	Z,FLT2			; JUMP IF STACK EMPTY
	LD	A,D			; ADD 8000H TO EACH NO.
	ADD	A,80H
	LD	D,A
	LD	A,H
	ADD	A,80H
	LD	H,A
	EX	DE,HL			; SWAP NOS.
	AND	A			; CLEAR CARRY
	SBC	HL,DE			; COMPARE VALUES
	LD	DE,0			; RESULT IN DE (0 OR 1)
	JR	NC,FLT1			; JUMP IF NOT LESS THAN
	DEC	DE			; OTHERWISE RESULT= -1
FLT1:	CALL	PUDE			; PUSH RESULT ON STACK
FLT2:	POP	HL			; REPLACE REGS
	POP	DE
	RET
;********************************************************************
;FUNCTION UNSIGNED GREATER THAN
;********************************************************************
FUGT:	PUSH	DE			; SAVE REGS
	PUSH	HL
	CALL	PODE			; GET VALUE FROM ARITH STACK
	JR	Z,FUGT2			; JUMP IF STACK EMPTY
	EX	DE,HL
	CALL	PODE			; GET THE OTHER VALUE IN DE
	JR	Z,FUGT2			; JUMP IF STACK EMPTY
	AND	A			; CLEAR CARRY
	SBC	HL,DE			; COMPARE VALUES
	LD	DE,0			; RESULT IN DE (0 OR 1)
	JR	NC,FUGT1		; JUMP IF NOT GREATER THAN
	DEC	DE			; OTHERWISE RESULT= -1
FUGT1:	CALL	PUDE			; PUSH RESULT ON STACK
FUGT2:	POP	HL			; REPLACE REGS
	POP	DE
	RET
;********************************************************************
;FUNCTION UNSIGNED LESS THAN
;********************************************************************
FULT:	PUSH	DE			; SAVE REGS.
	PUSH	HL
	CALL	PODE			; GET VALUE FROM ARITH STACK
	JR	Z,FULT2			; JUMP IF STACK EMPTY
	EX	DE,HL			; PUT VALUE IN HL
	CALL	PODE			; GET THE OTHER VALUE IN DE
	JR	Z,FULT2			; JUMP IF STACK EMPTY
	EX	DE,HL			; SWAP NOS.
	AND	A			; CLEAR CARRY
	SBC	HL,DE			; COMPARE VALUES
   	LD	DE,0			; RESULT IN DE (0 OR 1)
	JR	NC,FULT1		; JUMP IF NO LESS THAN
	DEC	DE			; OTHERWISE RESULT= -1
FULT1: 	CALL	PUDE			; PUSH RESULT ON STACK
FULT2:	POP	HL			; REPLACE REGS
	POP	DE
	RET
;*******************************************************************
;GET TITLE TO TITLE BUFFER.
;ON ENTRY:
;	(LINPNT) POINTS AT CHAR AFTER THE		        
;       'TITLE' PSEUDO-OPERATOR.
;ON EXIT:
;       THE OPERAND (A STRING BETWEEN SINGLE
;       QUOTES) HAS BEEN TRANSFERED TO THE TITLE BUFFER.
;*******************************************************************   
TITL:	PUSH	HL			; SAVE REGISTERS
	PUSH	DE
	PUSH	BC
	LD	HL,TITBUF		; CLEAR TITLE BUFFER
	LD	C,TITSIZ+1
	XOR	A
TITL1:	LD	(HL),A
	INC	HL
	DEC	C
	JR	NZ,TITL1
 	LD	HL,(LINPNT)		; GET LINE POINTER
	CALL	STR			; FIND STRING
	JR	Z,TITL5			; NOT FOUND
	LD	A,C			; GET COUNT OF STRING
	CP	TITSIZ+1		; MORE CHARS THAN SIZE OF TITBUF?
	JR	C,TITL2
	LD	C,TITSIZ		; YES, FORCE TO TITBUF SIZE
	JR	TITL3
TITL2:	AND	A			; IS IT 0 CHARS?
	JR	Z,TITL5
TITL3:	EX	DE,HL			; DO TRANSFER
	LD	DE,TITBUF
TITL4:	CALL	DOUBQ			; SKIP CHAR IF COUBLE QUOTE
	LDI				; TRANSFER A CHAR
	JP	PE,TITL4		; JUMP IF TRANSFER NOT COMPLETE  
TITL5:	POP	BC			; REPLACE REGISTERS
	POP 	DE
	POP	HL
	RET
;************************************************************************
;GET DEFM OPERAND.
;ON ENTRY:
;	(LINPNT) POINTS AT CHAR AFTER
;	DEFM PSEUDO-OPERATOR.
;ON EXIT:
;       THE OPERAND (A STRING BETWEEN QUOTES)
;       HAS BEEN TRANSFERED INTO THE
;       ASSEMBLED CODE BUFFER.
;************************************************************************
DM:	PUSH	HL			; SAVE REGISTERS
	PUSH	DE
	PUSH	BC
	LD	HL,(LINPNT)		; GET LINE POINTER
	CALL	STR			; FIND STRING
	JR	Z,DM4			; NOT FOUND
	LD	A,C			; GET COUNT OF STRING
	CP	ACBSIZ+1		; MORE CHARS THAN SIZE OF A.C. BUFF?
	JR	C,DM1			; NO
	LD	C,ACBSIZ		; YES, FORCE TO SIZE OF BUFFER
	JR	DM2
DM1:	AND	A
	JR	Z,DM4
DM2:	LD	A,C			; SET NO. OF ASSD BYTES
	LD	(ASCDNO),A
	NOP				; ROOM FOR SPARE INSTRUCTION
	NOP
	NOP
	EX	DE,HL			; DO TRANSFER
	LD	DE,ASSCOD
DM3:	CALL	DOUBQ			; SKIP CHAR IF DOUBLE QUOTE
	LDI				; TRANSFER A CHAR
	JP	PE,DM3			; JUMP IF TRANSFER NOT COMPLETE
DM4:	POP	BC			; REPLACE REGISTERS
	POP	DE
	POP	HL
	RET
;**************************************************************************
;LOCATE STRING
;ON ENTRY:
;       HL POINTS TO CHAR AFTER OPERAND
;ON EXIT:
;       HL POINTS TO FIRST CHAR OF ACTUAL STRING.
;       BC CONTAINS NO OF CHARS IN THAT STRING
;          (COUNTING 2 QUOTES AS 1 CHAR)
;       ZERO FLAG IS SET FOR SYNTAX ERROR
;************************************************************************** 
STR:	CALL	SCNSP			; SCAN TO NEXT NON SP CHAR
	CP	''''			; IS IT A ' ?
	JR	NZ,STR4			; SYNTAX ERROR, STRING NOT FOUND
	INC	HL			; POINT TO NEXT CHAR
	LD	D,H			; SAVE POINTER IN DE
	LD	E,L
	LD	BC,0			; CLEAR BC
STR1:					; COUNT CHARS TO NEXT 7
	CALL	DOUBQ			; END OF STRING QUOTE?
	JR	NZ,STR2			; JUMP IF SO
	LD	A,(HL)			; GET CHAR
	CP	CR			; IS IT CR?
	JR	Z,STR4			; JUMP IF SO, ERROR
	INC	HL			; INCR PNTR
	INC	C			; AND CNTR
	JR	STR1			; LOOP
STR2:	CALL	SCNSP			; FIND NEXT NON SP CHAR
	CP	CR			; MUST BE CR/;
	JR	Z,STR3
	CP	';'
	JR	Z,STR3
	PUSH	BC			; SYNTAX ERROR, BUT STRING FOUND
	LD	C,'S'
	CALL	ERROR			; INDICATE SYNTAX ERROR
	POP	BC
STR3:	XOR	A
	INC	A
	RET
STR4:	LD	C,'S'			; SYNTAX ERROR, STRING NOT FOUND 
	CALL	ERROR			; INDICATE ERROR
	XOR	A			; SET ZERO FLAG (FOR ERROR)
	RET				; AND RETURN
;***********************************************************************
;PROCESS TOKENS
;PRODUCE ASSEMBLED CODE IN BUFFER BASED ON OPERATOR
;AND OPERAND TOKENS.
;***********************************************************************
PTOK:	PUSH	IX			; SAVE REGS
	PUSH	HL
	PUSH	DE
	PUSH	BC
	LD	A,(ODBT1)		; PUT OPD BYTE 1 IN B
	LD	B,A
	LD	A,(ODBT2)		; PUT OPD BYTE 2 IN C
	LD	C,A
	LD	HL,(ODINT1)		; PUT OPD INTEGER IN HL
 	LD	DE,(ODINT2)		; PUT OPD INTEGER IN DE
	LD	A,(ORTKBF)		; GET OPERATOR TOKEN
	CP	ORGTOK			; TOKEN FOR ORG?
	JR	Z,PTOK4			; JUMP IF SO
	CALL	PLAB			; PROCESS LABEL
	EXX
	PUSH	HL			; SAVE REGS
	PUSH	DE
	PUSH	BC
	LD	A,(ORTKBF)		; GET TOKEN AGAIN
	AND	7FH			; MASK OFF CONDITIONAL FLAG BIT
	ADD	A,A			; DOUBLE IT
	LD	E,A			; PUT INTO DE
	LD	D,0
	LD	HL,PORL			; PUT 'PROCESS OPR' LIST PNTR IN HL
        ADD	HL,DE			; ADD DE TO GET PNTR TO PNTR TO ROUTIN
 	LD	E,(HL)			; GET POINTER IN DE
	INC	HL
	LD	D,(HL)
	EX	DE,HL			; PUT IN HL
	CALL	ODPBT			; GET OPD PAIR BYTE
	LD	B,A			; SAVE IN B
PTOK1:	LD	A,(HL)			; GET VALID TOKEN FROM LIST
	INC	HL			; INCR LIST POINTER
	CP	0FFH			; COMPARE WITH END OF LIST FLAG
	JR	Z,PTOK3			; END OF LIST, NOT VALID COMBINATION
	CP	0FEH			; E.O.L. - NO NOP'S, NO ERROR IND
	JR	Z,PTOK8
	CP	0FDH			; END OF LIST - ERROR IND ONLY
	JR	NZ,PTOK9
	LD	C,'S'			; INDICATE SYNTAX ERROR
	CALL	ERROR
	JR	PTOK8
PTOK9:	CP	B			; COMPARE TOKEN
	JR	Z,PTOK2			; JUMP IF MATCH
	INC	HL			; POINT TO NEXT TOKEN
	INC	HL
	JR	PTOK1			; AND LOOP
PTOK2:	LD	C,(HL)			; GET ADDR OF SUBROUTINE FROM LIST
	INC	HL			    
	LD	H,(HL)
	LD	L,C
	PUSH	HL			; GET ADDR IN IX
	POP	IX
	LD	HL,PTOK8		; PUSH RETURN ADDR
	PUSH	HL
	EXX				; SWAP REGISTER BANKS
	JP	(IX)			; AND CALL INDIRECT
PTOK3:	CALL	DNOPS			; SYNTAX ERROR, APPEND NOP'S
	JR	PTOK8
PTOK4:	CALL	PORG			; PROCESS ORG
	JR	PTOK7
PTOK8:	CALL	ADJARC			; ADJUST ADDR REF CNTR
	EXX				; REPLACE REGS
	POP	BC
	POP	DE
	POP	HL
	EXX
PTOK7:	POP	BC
	POP	DE
	POP	HL
	POP	IX
	RET
;*********************************************************************
;SYNTAX ERROR
;ALL THE FOLLOWING PROCESS SUBROUTINES
;RETURN VIA THIS SUBROUTINE IF THEY
;NEED TO APPEND NOP'S IF THE CASE OF
;A SYNTAX ERROR.
;*********************************************************************
SYNERR:	CALL	DNOPS			; ERROR, APPEND DEFAULT NOP'S
	RET
;...................................................
;PROCESS OPERATOR LIST
;CONTAINS ADDRESSES OF SUBROUTINES
;TO PROCESS VARIOUS OPERATOR GROUPS.
;...................................................
PORL:	DEFW	LSTNUL			; NULL ROUTINE FOR NO OPERATOR
	DEFW	LSTNUL			; NULL ROUTINE FOR ORG
	DEFW	LSTNUL			; NULL ROUTINE FOR EQU
	DEFW	LSTNUL			; NULL FOUTINE FOR DEFL
	DEFW	LST04			; END
	DEFW	LST05			; DEFB
	DEFW	LST06			; DEFW
	DEFW	LST07			; DEFS
	DEFW	LSTNUL			; NULL ROUTINE FOR DEFM
	DEFW	LSTNUL			; NULL ROUTINE FOR TITLE
	DEFW	LST0B			; SINGLE BYTE, NO OPERAND
	DEFW	LST0B			; DOUBLE BYTE, NO OPERAND
	DEFW	LST0C			; AND OR XOR CP SUB
	DEFW	LST0D			; INC DEC
	DEFW	LST0E			; IM
	DEFW	LST0F			; RLC RL SLA RRC RR SRA SRL
	DEFW	LST10			; BIT SET RES
	DEFW	LST11			; JP
	DEFW	LST12			; JR
	DEFW	LST13			; DJNZ
	DEFW	LST14			; CALL
	DEFW	LST15			; RET
	DEFW	LST16			; RST
	DEFW	LST17			; IN
	DEFW	LST18			; OUT
	DEFW	LST19			; PUSH POP
	DEFW	LST1A			; EX
	DEFW	LST1B			; ADC SBC
	DEFW	LST1C			; ADD
	DEFW	LST1D			; LD
;.........................................................
LSTNUL:	DEFB	0FEH
;.........................................................
LST04:	DEFB	0			; NO OPD
	DEFW	GP04
	DEFB	90H			; SINGLE INTEGER
	DEFW	GP04
	DEFB	0FDH
;.........................................................
LST05:	DEFB	90H			; DEFB N
	DEFW	GP05
        DEFB	0FFH
;.........................................................            
LST06:	DEFB	90H			; DEFW NN
	DEFW	GP06
	DEFB	0FFH
;.........................................................
LST07:	DEFB	90H			; DEFS N
	DEFW	GP07
	DEFB	0FDH
;.........................................................
LST0B:	DEFB	0			; NO OPERAND
	DEFW	GP0B
	DEFB	0FFH
;.........................................................
LST0C:	DEFB	70H			; OPR R
	DEFW	GP0C1
        DEFB	90H			; OPR N
	DEFW	GP0C2
	DEFB	40H			; OPR (HL)/(IX)/(IY)
	DEFW	GP0C3
	DEFB	0B0H			; OPR (IX+D)/(IY+D)
	DEFW	GP0C3
	DEFB	0FFH
;.........................................................
LST0D:	DEFB	70H			; OPR R
	DEFW	GP0D1
	DEFB	40H			; OPR (HL)/(IX)/(IY)
	DEFW	GP0D2
	DEFB	0B0H			; OPR (IX+D)/(IY+D)
	DEFW	GP0D2
	DEFB	10H			; OPR RP
	DEFW	GP0D3
	DEFB	0FFH
;..........................................................
LST0E:	DEFB	90H			; IM N
	DEFW	GP0E
	DEFB	0FFH
;..........................................................
LST0F:	DEFB	70H			; OPR R
	DEFW	GP0F1
	DEFB	40H			; OPR (HL)/(IX)/(IY)
	DEFW	GP0F2			  
	DEFB	0B0H			; OPR (IX+D)/(IY+D)
	DEFW	GP0F2
	DEFB	0FFH
;..........................................................
LST10:	DEFB	97H			; OPR B,R
	DEFW	GP101
	DEFB	94H			; OPR B,(HL)/(IX)/(IY)
	DEFW	GP102
	DEFB	9BH			; OPR B,(IX+D)/(IY+)
	DEFW	GP102
	DEFB	0FFH
;...........................................................
LST11:	DEFB	40H			; JP (HL)/(IX)/(IY)
	DEFW	GP111
	DEFB	89H			; JP CC,NN
	DEFW	GP112
	DEFB	90H			; JP NN
	DEFW	GP113
	DEFB	0FFH
;............................................................
LST12:	DEFB	89H			; JR CC,E
	DEFW	GP121
	DEFB	90H			; JR E
	DEFW	GP122
	DEFB	0FFH
;............................................................
LST13:	DEFB	90H			; DJNZ NN
	DEFW	GP13
	DEFB	0FFH
;...........................................................
LST14:	DEFB	89H 			; CALL CC,NN    
	DEFW	GP141
	DEFB	90H			; CALL NN
	DEFW	GP142
	DEFB	0FFH
;............................................................
LST15:	DEFB	00H			; RET
	DEFW	GP151
	DEFB	80H			; RET CC
	DEFW	GP152
	DEFB	0FFH
;............................................................
LST16:	DEFB	90H			; RST N
	DEFW	GP16
	DEFB	0FFH
;............................................................
LST17:	DEFB	7DH			; IN A,(N)
	DEFW	GP171
	DEFB	7AH			; IN R,(C)
	DEFW	GP172
	DEFB	0FFH
;............................................................
LST18:	DEFB	0A7H			; OUT (C),R
	DEFW	GP181
	DEFB	0D7H			; OUT (N),A
	DEFW	GP182
	DEFB	0FFH
;.............................................................
LST19:	DEFB	10H			; OPR RP
	DEFW	GP19
	DEFB	0FFH
;.............................................................
LST1A:	DEFB	51H			; EX (SP),HL/IX/IY
	DEFW	GP1A1
	DEFB	1EH			; EX AF,AF'
	DEFW	GP1A2
	DEFB	11H			; EX DE,HL
	DEFW	GP1A3
	DEFB	0FFH
;.............................................................
LST1B:	DEFB	77H			; OPR A,R
	DEFW	GP1B1
	DEFB	79H			; OPR A,N
	DEFW	GP1B2
	DEFB	74H			; OPR A,(HL)/(IX)/(IY)
	DEFW	GP1B3
	DEFB	7BH			; OPR A,(IX+D)/(IY+D)
	DEFW	GP1B3
	DEFB	11H			; OPR HL,SS
	DEFW	GP1B4
	DEFB	0FFH
;...............................................................
LST1C:	DEFB	77H			; ADD A,R
	DEFW	GP1C1
	DEFB	79H			; ADD A,N
	DEFW	GP1C2
	DEFB	74H			; ADD A,(HL)/(IX)/(IY)
	DEFW	GP1C3
	DEFB	7BH			; ADD A,(IX+D)/(IY+D)
	DEFW	GP1C3
	DEFB	11H			; ADD HL/IX/IY,RP
    	DEFW	GP1C4
	DEFB	0FFH
;...............................................................           
LST1D:	DEFB	76H			; LD A,(BC)/(DE)
	DEFW	GP1D1
	DEFB	72H			; LD A,I/R
	DEFW	GP1D2
	DEFB	7DH			; LD A,(NN)
	DEFW	GP1D3
	DEFB	67H			; LD (BC)/(DE),A
	DEFW	GP1D4
	DEFB	49H			; LD (HL)/(IX)/(IY),N
	DEFW	GP1D5
	DEFB	19H			; LD RP,NN
	DEFW	GP1D6
	DEFB	1DH			; LD RP,(NN)
	DEFW	GP1D7
	DEFB	47H			; LD (HL)/(IX)/(IY),R
	DEFW	GP1D8
	DEFB	27H			; LD I/R,A
	DEFW	GP1D9
	DEFB	0B9H			; LD (IX+D)/(IY+D),N
	DEFW	GP1D5
	DEFB	0B7H			; LD (IX+D)/(IY+D),R
	DEFW	GP1D8
	DEFB	0D7H			; LD (NN),A
	DEFW	GP1DA
    	DEFB	0D1H			; LD (NN),RP
	DEFW	GP1DB
	DEFB	74H			; LD (HL)/(IX)/(IY)
	DEFW	GP1DC
	DEFB	7BH			; LD R,(IX+D)/(IY+D)
	DEFW	GP1DC
	DEFB	79H			; LD R,N
	DEFW	GP1DD
	DEFB	77H			; LD R,R
	DEFW	GP1DE
	DEFB	11H			; LD SP,HL/IX/IY
	DEFW	GP1DF
	DEFB	0FFH
;**********************************************************************
;ENTRY AND EXIT CONDITIONS FOR PORG, PLAB AND
;ALL GP... SUBROUTINES.
;
;ON ENTRY:
;       B CONTAINS OPERAND-1 TOKEN BYTE
;	C CONTAINS OPERAND-2 TOKEN BYTE
;       HL CONTAINS OPERAND-1 INTEGER	
;       DE CONTAINS OPERAND-2 INTEGER
;ON EXIT:
;	ASSEMBLED CODE HAS BEEN PLACED IN ASSEMBLED
;         CODE BUFFER (ASSCOD).
;       ADDRESS REFERENCE COUNTER HAS BEEN ADJUSTED. 
;**********************************************************************
;
;**********************************************************************
;PROCESS ORG
;**********************************************************************
PORG:	PUSH	HL			; SAVE REGS
	PUSH	BC
	CALL	ODPBT			; GET OPERAND PAIR BYTE IN A
	CP	90H			; SINGLE INTEGER?
	JR	NZ,PORG1		; JUMP OTHERWISE
	LD	HL,(ODINT1)		; GET OPERAND-1 INTEGER
	LD	(ADREFC),HL		; PUT IN ADDR REG CNTR
	LD	(ADDISR),HL		; AND ADDR DISP REG              
   	LD	HL,AFLAGS		; SET ADDR DISCONTINUITY FLAG
	SET	0,(HL)
	JR	PORG2
PORG1:	LD	C,'S'			; INDICATE SYNTAX ERROR
	CALL	ERROR
PORG2:	POP	BC			; REPLACE REGS
	POP	HL
	RET
;**********************************************************************
;PROCESS LABEL (INCLUDES EQU AND DEFL)
;**********************************************************************
PLAB:	PUSH	HL			; SAVE REGS
	PUSH	DE
	PUSH	BC
	LD	A,(ORTKBF)		; GET OPR TOKEN
	PUSH	AF			; SAVE ON STACK
	CP	DEFLTK			; IS IT DEFL?
	JR	Z,PLAB1
	CP	EQUTOK			; OR EQU?
	JR	NZ,PLAB2
PLAB1:	LD	(ADDISR),HL		; DISPLAY VALUE IF SO
	CALL	ODPBT			; GET OPD PAIR BYTE
	CP	90H			; SINGLE INTEGER?
	JR	Z,PLAB3			; JUMP IF SO, OK
	LD	C,'S'			; ELSE INDICATE SYNTAX ERROR
	CALL	ERROR
	JR	PLAB3			  
PLAB2:	LD	HL,(ADREFC)		; GET CURRENT ADDR (LABEL VALUE)
PLAB3:	LD	B,H			; COPY LABEL VALUE INTO BC
	LD	C,L
	CALL	LBSYM			; PUT LABEL AND VALUE IN SYMBUF
	JR	Z,PLAB13		; JUMP IF NO LABEL PRESENT
	CALL	SYMCH			; CHECK IF SYMBOL IS RESERVED WORD
	JR	NC,PLAB5		; JUMP IF NOT
PLAB13:	POP	AF			; GET OPR TOKEN
	PUSH	AF
	CP	DEFLTK			; IS IT DEFL?
	JR	Z,PLAB4
	CP	EQUTOK			; OR EQU?
	JR	NZ,PLAB12
PLAB4:	LD	C,'S'			; INDICATE SYNTAX ERROR IF SO
	CALL	ERROR
	JR	PLAB12
PLAB5:	POP	AF			; GET OPR TOKEN
	PUSH	AF
	CP	DEFLTK			; IS IT DEFL?
	JR	NZ,PLAB6		; JUMP IF NOT
	SET	0,(HL)			; SET DEFL FLAG IN ATTRIB
PLAB6:	CALL	LOCATE			; LOCATE IN SYMBOL TABLE
	JR	Z,PLAB8			; JUMP IF ALREADY IN TABLE
	LD	A,(PASSNO)		; IS THIS PASS 1?
	CP	1
	JR	Z,PLAB7			; JUMP IF SO
	LD	C,'P'			; OTHERWISE INDICATE PHASE ERROR
	CALL	ERROR
	JR	PLAB12
PLAB7:	CALL	INSERT			; INSERT IN SYMBOL TABLE
	JR	PLAB12
					; ALREADY IN TABLE
PLAB8:	LD	A,(PASSNO)		; IS THIS PASS 1?
	CP	1
	JR	Z,PLAB11		; JUMP IF SO
	INC	HL			; MULT DEFN FLAG SET? 
	INC	HL
	BIT	1,(HL)
	JR	Z,PLAB9			; JUMP IF NOT
	LD	C,'M'			; INDICATE MULT DEFN ERROR
	CALL	ERROR
	JR	PLAB12
PLAB9:	POP	AF			; GET OPR TOKEN
	PUSH	AF
	CP	DEFLTK			; IS IT DEFL?
	JR	NZ,PLAB10		; JUMP IF NOT
	DEC	HL			; INSERT NEW VALUE
	LD	(HL),B
	DEC	HL
	LD	(HL),C
	JR	PLAB12
PLAB10:					; HAS VALUE CHANGED?
	DEC	HL			; GET OLD VALUE IN DE
	LD	D,(HL)			
	DEC	HL
	LD	E,(HL)
	EX	DE,HL			; GET IT INTO HL
	AND	A			; CLEAR CARRY
	SBC	HL,BC			; AND COMPARE OLD AND NEW VALUES
	JR	Z,PLAB12		; JUMP IF EQUAL
	EX	DE,HL			; ELSE INSERT NEW VALUE
	LD	(HL),C
	INC	HL
	LD	(HL),B
	LD	C,'P'			; AND INDICATE PHASE ERROR
	CALL	ERROR
	JR	PLAB12
PLAB11:	INC	HL			; POINT TO ATTRIBUTE BYTE
	INC	HL
	POP	AF			; GET OPR TOKEN
	PUSH	AF
	CP	DEFLTK			; IS IT DEFL?
	JR	NZ,PLAB14		; JUMP IF NOT
	BIT	0,(HL)			; TEST DEFL FLAG
	JR	NZ,PLAB12		; JUMP IF SET
PLAB14:	SET	1,(HL)			; SET MULT DEFN FLAG
PLAB12:	POP	AF			; REPLACE REGS
	POP	BC
	POP	DE
	POP	HL
	RET
;*******************************************************************
;PROCESS END (GROUP 04)
;*******************************************************************
GP04:	LD	(STADDR),HL		; LOAD START ADDR WITH INTEGER
	LD	(ADDISR),HL		; LOAD ADDR DIS REG WITH INTEGER
	LD	HL,AFLAGS		; SET 'END' FLAG
	SET	1,(HL)
	RET
;********************************************************************
;PROCESS DEFB
;********************************************************************
GP05:	CALL	CHKOF			; CHECK FOR OVERFLOW BEYOND
					; 8 BIT VALUE (AND FLAG IF SO)
	LD	A,L			; APPEND 1 BYTE TO ASSD CODE BUFF
	CALL	APPBT			; APPEND BYTE TO ASSD CODE BUFF
	RET
;********************************************************************
;PROCESS DEFW
;********************************************************************
GP06:	CALL	APPWD			; APPEND TO ASSD CODE BUFF
	RET
;********************************************************************
;PROCESS DEFS (GROUP 07)
;********************************************************************
GP07:	LD	DE,(ADREFC)		; ADD INTEGER TO ADDR REF CNTR
	ADD	HL,DE
	LD	(ADREFC),HL
	LD	HL,AFLAGS		; SET ADDR DISCONT. FLAG
	SET	0,(HL)
	RET
;********************************************************************
;PROCESS NO OPERAND.
;********************************************************************
GP0B:	LD	A,(ORTKBF)		; GET OPR GROUP 
	CP	0AH			; IS IT GROUP 0A?
	JR	Z,GP0B1			; SKIP PREFIX BYTE IF SO
	LD	A,0EDH			; LOAD PREFIX BYTE TO ASSD CODE BUFF
	CALL	APPBT			; APPEND TO ASSD CODE BUFFER
GP0B1:	LD	A,(ORTKBF+1)		; GET OPCODE IN A
	CALL	APPBT			; AND APPEND TO ASSD CODE BUFF
	RET
;********************************************************************
;PROCESS AND/OR/XOR/CP/SUB (GROUP 0C)
;********************************************************************
;GROUP 0C - R
;********************************************************************
GP0C1:	LD	A,(ORTKBF+1)		; GET OPR DISTING BITS
	LD	C,B			; COMBINE REG BITS
	CALL	ISREG
	OR	10000000B		; BUILD OP-CODE
	CALL	APPBT			; APPEND RESULT TO ASSD CODE BUFFER
	RET
;********************************************************************
;GROUP 0C - N
;********************************************************************
GP0C2:	LD	A,(ORTKBF+1)		; GET OPR DISTING BITS
	OR	11000110B		; BUILD OP-CODE
	CALL	APPBT			; APPEND IT TO ASSD CODE BUFF
	CALL	CHKOF			; INDICATE OVERFLOW ERROR IF ANY
	LD	A,L			; PUT INTEGER IN ASSD CODE BUFFER
	CALL	APPBT
	RET
;*******************************************************************
;GROUP 0C - (HL)/(IX+D)/(IY+D)
;*******************************************************************
GP0C3:	CALL	INDPF			; GENERATE INDEX PREFIX, IF REQD
	LD	A,(ORTKBF+1)		; GET OPR DISTING BITS
	OR	10000110B		; BUILD OP-CODE
    	CALL 	APPBT 			; APPEND TO ASSD CODE BUFF
	CALL	DISBT			; APPEND DISP. IF REQD
	RET
;*******************************************************************
;PROCESS INC/DEC (GROUP 0D)
;*******************************************************************
;GROUP 0D - R
;*******************************************************************
GP0D1:	LD	C,B
	LD	A,(ORTKBF+1)		; GET OPR DISTING. BIT
	AND	00000001B
  	OR	00000100B		; BUILD OP-CODE
	CALL	IDREG			; INSERT REGISTER BITS
	CALL	APPBT			; APPEND OPCODE TO BUFFER
	RET
;******************************************************************
;GROUP 0D - (HL)/(IX+D)/(IY+D)
;******************************************************************
GP0D2:	CALL	INDPF			; GENERATE INDEX PREFIX IF REGD
	LD	A,(ORTKBF+1)		; GET OPERATOR DISTING. BIT
	AND	00000001B
	OR	00110100B		; GENERATE OP-CODE
	CALL	APPBT			; APPEND TO BUFFER
	CALL	DISBT			; APPEND DISP. IF REQD
	RET
;******************************************************************
;GROUP 0D - IX/IY/BC/DE/HL/SP
;******************************************************************
GP0D3:	LD	A,B			; GET OPERAND BYTE-1
	CP	17H			; CHECK IF AF REFERENCE
	JP	Z,SYNERR		; JUMP IF IT IS, ERROR
	CALL	INDPF			; GENERATE INDEX PREFIX IF REQD
	LD	C,B			; PUT OPERAND BYTE IN C
	LD	A,(ORTKBF+1)		; GET OPR DISTING. BIT
	AND	00001000B
	OR	00000011B		; BUILD OP-CODE
	CALL	IREGP			; INSERT REGISTER PAIR BITS
	CALL	APPBT			; APPEND THIS OPCODE TO BUFFER
	RET
;******************************************************************
;PROCESS IM (GROUP 0E)
;******************************************************************
GP0E:	LD	A,H			; GET HIGH BYTE
	AND	A			; CHECK IT IS 0
	JP	NZ,SYNERR		; ERROR IF NOT, SO JUMP
	LD	A,L			; GET LOW BYTE
	CP	3			; IS IT 0,1 OR 2?
	JP	NC,SYNERR		; JUMP IF NOT, ERROR
	AND	A			; IS IT ZERO?
	JR	Z,GP0E1			; JUMP IF SO
	INC	A			; OTHERWISE INCREMENT
GP0E1:	LD	C,A			; PUT IT IN C
	LD	A,0EDH			; APPEND PREFIX BYTE
	CALL	APPBT			; TO ASSD CODE BUFFER
	LD	A,01000110B		; GENERATE OP-CODE
	CALL	IDREG			; INSERT PARAMETER BITS
	CALL	APPBT			; APPEND TO ASSD CODE BUFF
	RET
;******************************************************************
;PROCESS RLC/RL/SLA/RRC/RR/SRA/SRL (GROUP 0F)
;******************************************************************
;GROUP 0F - R
;****************************************************************
GP0F1:	LD	A,0CBH			; APPEND PREFIX BYTE
	CALL	APPBT			; TO ASSD CODE BUFF
	LD	C,B			; PUT OPD BYTE 1 IN C
	LD	A,(ORTKBF+1)		; GET OPD DISTING. BITS
	CALL	ISREG			; INSERT REGISTER BITS
	CALL	APPBT
	RET
;******************************************************************
;GROUP OF - (HL)/(IX+D)/(IY+D)
;******************************************************************
GP0F2:	CALL	INDPF			; APPEND INDEX PREFIX BYTE IF REQD
	LD	A,0CBH
	CALL	APPBT			; APPEND PREFIX BYTE
	CALL	DISBT			; APPEND DISPLACEMENT BYTE IF REQD
	LD	A,(ORTKBF+1)		; GET OPR DISTING. BITS
	OR	00000110B		; BUILD OP-CODE
	CALL	APPBT			; APPEND TO ASSD CODE BUFF
	RET
;*************************************************************************
;PROCESS BIT/SET/RES (GROUP 10)
;*************************************************************************
;GROUP 10 - B,R
;*************************************************************************
GP101:					; OPD INTEGER
					; MUST BE IN RANGE 0-7
	LD	A,L			; SEE IF ANY BITS OTHER THAN 
	AND	11111000B		; 3 L.S. BITS ARE 1
	OR	H
	JP	NZ,SYNERR		; JUMP IF SO, ERROR
	LD	A,0CBH			; APPEND PREFIX BYTE TO BUFFER
	CALL	APPBT
	LD	A,(ORTKBF+1)		; GET OPD DISTING. BITS
	CALL	ISREG			; COMBINE REGISTER BITS
	LD	C,L			; GET INTEGER IN C
	CALL	IDREG			; COMBINE INTEGER BITS
	CALL	APPBT			; APPEND OP-CODE TO BUFFER
	RET
;************************************************************************
;GROUP 10 - B,(HL)/(IX+D)/(IY+D)
;************************************************************************
GP102:					; OPD INTEGER
					; MUST BE IN RANGE 0-7
	LD	A,L			; SEE IF ANY BITS OTHER THAN
	AND	11111000B		; 3 L.S. BITS ARE 1
	OR	H			  
	JP	NZ,SYNERR		; JUMP IF SO, ERROR
	LD	B,C
	CALL	INDPF			; APPEND INDEX PREFIX IF REQD
	LD	A,0CBH			; APPEND OP-CODE PREFIX
	CALL	APPBT
	LD	C,L			; GET INTEGER IN C
	EX	DE,HL			; GET DISPLACEMENT INTEGER
	CALL	DISBT			; APPEND IF REQD
	LD	A,(ORTKBF+1)		; GET OPD DISTING. BITS
	OR	00000110B		; BUILD OP-CODE
	CALL	IDREG			; COMBINE INTEGER BITS
	CALL	APPBT
	RET
;***********************************************************************
;PROCESS JP (GROUP 11)
;***********************************************************************
;***********************************************************************
;GROUP 11 - (HL)/(IX)/(IY)
;***********************************************************************
GP111:	CALL	INDPF			; APPEND INDEX PREFIX IF REQD
	LD	A,0E9H			; APPEND OP-CODE PREFIX TO BUFFER
	CALL	APPBT
	RET
;***********************************************************************
;GROUP 11 - CC,NN
;*********************************************************************** 
GP112:	LD	C,B			; GET OPD BYTE 1 IN C
	LD	A,11000010B		; BUILD OP-CODE
	CALL	IDREG			; COMBINE CONDITION BITS
	CALL	APPBT			; APPEND OP-CODE TO BUFFER
	EX	DE,HL			; GET INTEGER
	CALL	APPWD			; APPEND LOW BYTE
	RET
;**********************************************************************
;GROUP 11 - NN
;**********************************************************************
GP113:	LD	A,0C3H			; APPEND OP-CODE TO BUFFER
	CALL	APPBT
	CALL	APPWD			; APPEND INTEGER
	RET
;**********************************************************************
;PROCESS JR (GROUP 12)
;**********************************************************************
;**********************************************************************
;GROUP 12 CC,E
;**********************************************************************
GP121:	BIT	2,B			; CHECK IF PO/PE/P/M
	JP	NZ,SYNERR		; JUMP IF SO, ERROR
	LD	C,B			; PUT OPR BYTE 1 IN C
	EX	DE,HL			; GET OPD INTEGER 2
	CALL	CDIS			; CALCULATE DISPLACEMENT
	NOP				; ROOM FOR SPARE INSTRUCTION
	NOP
	NOP
	LD	A,00100000B		; BUILD OP-CODE
	CALL	IDREG			; COMBINE CONDITION BITS 
	CALL	APPBT			; APPEND OP-CODE TO BUFFER
	LD	A,L			; GET DISPLACEMENT
	CALL	APPBT			; APPEND TO BUFFER
	RET
;*********************************************************************
;GROUP 12 - E
;*********************************************************************
GP122:	CALL	CDIS			; CALCULATE DISPLACEMENT
	NOP				; ROOM FOR SPARE INSTRUCTION
	NOP
	NOP
	LD	A,18H			; APPEND OP-CODE TO BUFFER
	CALL	APPBT
	LD	A,L			; APPEND DISP TO BUFFER
	CALL	APPBT
	RET
;*********************************************************************
;PROCESS DJNZ (GROUP 13)
;*********************************************************************
GP13:	CALL	CDIS			; CALCULATE DISPLACEMENT
	NOP	    			; ROOM FOR SPARE INSTRUCTION
	NOP
	NOP
	LD	A,10H			; APPEND OP-CODE TO BUFFER
	CALL	APPBT
	LD	A,L			; APPEND DISP TO BUFFER
	CALL	APPBT
	RET
;*********************************************************************
;CALCULATE DISPLACEMENT
;*********************************************************************
CDIS:	PUSH	DE			; SAVE REGS
	PUSH	BC
	LD	DE,(ADREFC)		; GET ADDR REF CNTR
	INC	DE			; ADD 2 (ALLOW FOR INCRD PC)
	INC	DE
	AND	A			; CLEAR CARRY
	SBC	HL,DE			; GET DISPLACEMENT FROM CURR LOC.
	LD	A,L			; CHECK FOR 8 BIT OVERFLOW
	AND	10000000B
	OR	H
	JR	Z,CDIS2			; JUMP IF NO OVERFLOW
	LD	A,L			; CHECK -VE OVERFLOW
	OR	01111111B
	AND	H
	CPL				  
	AND	A
	JR	Z,CDIS2			; JUMP IF NO OVERFLOW
CDIS1:	LD	C,'R'			; INDICATE RANGE ERROR
	CALL	ERROR
	XOR	A			; CLEAR ZERO FLAG
	INC	A
CDIS2:	POP	BC			; REPLACE REGS
	POP	DE
	RET
;********************************************************************
;PROCESS CALL (GROUP 14)
;********************************************************************
;********************************************************************
;GROUP 14 - CC,NN
;********************************************************************
GP141:	LD	C,B			; GET OPD BYTE 1 IN C
	LD	A,11000100B		; BUILD OP-CODE
	CALL	IDREG			; COMBINE CONDITION BIT
	CALL	APPBT			; APPEND OP-CODE TO BUFFER
	EX	DE,HL			; GET INTEGER
	CALL	APPWD			; APPEND INTEGER
	RET
;********************************************************************
;GROUP 14 - NN
;********************************************************************
GP142:	LD	A,0CDH			; APPEND OP-CODE TO BUFFER
	CALL	APPBT
	CALL	APPWD			; APPEND INTEGER
	RET
;********************************************************************
;PROCESS RET (GROUP 15)
;********************************************************************
;********************************************************************
;GROUP 15 - NO OPERAND
;********************************************************************
GP151:	LD	A,0C9H			; APPEND OP-CODE TO BUFFER
	CALL	APPBT
	RET
;********************************************************************
;GROUP 15 - CC
;********************************************************************
GP152:	LD	C,B			; GET OPD BYTE 1 IN C
	LD	A,11000000B		; BUILD OP-CODE
	CALL	IDREG			; COMBINE CONDITION BITS
	CALL	APPBT			; APPEND OP-CODE TO BUFFER
	RET
;********************************************************************
;PROCESS RST (GROUP 16)
;********************************************************************
GP16:					; INTEGER MAY ONLY BE 0/08H/
					; 10H/18H/20H/28H/30H/38H
	LD	A,L			; CHECK FOR INVALID VALUE
	AND	11000111B
	OR	H
	JP	NZ,SYNERR		; JUMP IF INVALID
	LD	A,L			; BUILD OP-CODE
	OR	11000111B
	CALL	APPBT			; APPEND TO BUFFER
	RET
;********************************************************************
;PROCESS IN (GROUP 17)
;********************************************************************
;********************************************************************
;GROUP 17 - A,(N)
;********************************************************************
GP171:	LD	A,B			; GET OPD BYTE 1
	CP	77H			; MUST BE 'A' REG
	JP	NZ,SYNERR		; JUMP IF NOT, ERROR
	LD	A,D			; INTEGER MUST BE < 256
	AND	A
	NOP				; ROOM FOR SPARE INSTRUCTION
	NOP
	NOP
	LD	A,0DBH			; APPEND OP-CODE TO BUFFER
	CALL	APPBT
	LD	A,E			; APPEND INTEGER TO BUFFER
	CALL	APPBT
	RET
;********************************************************************
;GROUP 17 - R,(C)
;********************************************************************
GP172:	LD	A,0EDH			; APPEND OP-CODE PREFIX TO BUFFER
	CALL	APPBT
	LD	C,B			; GET OPD BYTE 1 IN C
	LD	A,01000000B		; BUILD OP-CODE
 	CALL	IDREG			; COMBINE REG BITS
	CALL	APPBT			
	RET
;********************************************************************
;PROCESS OUT (GROUP 18)
;********************************************************************
;********************************************************************
;GROUP 18 - (C),R
;********************************************************************
GP181:	LD	A,0EDH			; APPEND OP-CODE PREFIX TO BUFFER
	CALL	APPBT			
	LD	A,01000001B		; BUILD OP-CODE
	CALL	IDREG			; COMBINE REG BITS
	CALL	APPBT			; APPEND TO BUFFER
	RET
;*******************************************************************
;GROUP 18 - (N),A
;*******************************************************************
GP182:	LD	A,C			; GET OPD BYTE 2
	CP	77H			; MUST BE 'A' REG
	JP	NZ,SYNERR		; JUMP IF NOT
	LD	A,H			; MUST BE < 256
	AND	A
	NOP				; ROOM FOR SPARE INSTRUCTION
	NOP
	NOP
	LD	A,0D3H			; APPEND OP-CODE TO BUFFER
	CALL	APPBT
	LD	A,L			; APPEND INTEGER TO BUFFER
	CALL	APPBT
	RET
;*******************************************************************
;PROCESS PUSH/POP (GROUP 19)
;*******************************************************************
GP19:	LD	A,(ODBT1)		; GET OPD BYTE 1
	CP	13H			; SP NOT PERMITTED
	JP	Z,SYNERR
	LD	C,B			; GET OPD BYTE 1 IN C
	CALL	INDPF			; APPEND INDEX PREFIX IF REQD
	LD	A,(ORTKBF+1)		; GET APR DISTING. BITS
	CALL	IREGP			; COMBINE REG PAIR BITS
	CALL	APPBT			; APPEND TO BUFFER
	RET
;********************************************************************
;PROCESS EX (GROUP 1A)
;********************************************************************
;********************************************************************
;GROUP 1A - (SP),HL/IX/IY
;********************************************************************
GP1A1:	LD	B,C			; GET OPR BYTE 2 IN C
	LD	A,C
	AND	3			; MUST BE HL/IX/IY
	CP	2
	JP	NZ,SYNERR		; JUMP IF NOT, ERROR
	CALL	INDPF			; APPEND INDEX PREFIX IF REQD
	LD	A,0E3H			; APPEND AP-CODE TO BUFFER
 	CALL	APPBT			
	RET
;********************************************************************	
;GROUP 1A - AF,AF'
;********************************************************************
GP1A2:	LD	A,B			; GET OPD BYTE 1
	CP	17H			; MUST BE AF
	JP	NZ,SYNERR		; JUMP IF NOT, ERROR
	LD	A,08H			; APPEND OP-CODE TO BUFFER
	CALL	APPBT
	RET
;********************************************************************
;GROUP 1A - DE,HL
;********************************************************************
GP1A3:	LD	A,B			; GET SPD BYTE 1
	CP	11H			; MUST BE DE
	JP	NZ,SYNERR		; JUMP IF NOT, ERROR
	LD	A,C			; GET OPD BYTE 2
	CP	12H			; MUST BE HL
	JP	NZ,SYNERR		; JUMP IF NOT, ERROR
	LD	A,0EBH			; APPEND OP-CODE TO BUFFER
	CALL	APPBT
	RET
;********************************************************************
;PROCESS ADC/SBC (GROUP 1B)
;********************************************************************
;GROUP 1B - A,R
;********************************************************************
GP1B1:	LD	A,B			; GET OPD BYTE 1
	CP	77H			; MUST BE 'A' REG
	JP	NZ,SYNERR		; JUMP IF NOT, ERROR
	LD	A,(ORTKBF+1)		; GET OPD DISTING BITS
	AND	00010000B		; AND MASK IT
	OR	10001000B		; BUILD OP-CODE
	CALL	ISREG			; COMBINE REGISTER BITS
	CALL	APPBT			; APPEND BYTE TO BUFFER
	RET
;*******************************************************************	
;GROUP 1B - A,N
;*******************************************************************
GP1B2:	LD	A,B			; GET OPD BYTE 1
	CP	77H			; MUST BE 'A' REG
	JP	NZ,SYNERR		; JUMP IF NOT, ERROR
	LD	A,(ORTKBF+1)		; GET OPR DISTING BITS
	AND	00010000B		; AND MASK IT
	OR	11001110B		; BUILD OP-CODE
	CALL	APPBT			; APPEND TO BUFFER
	EX	DE,HL			; GET INTEGER IN HL
	CALL	CHKOF			; FLAG OVERFLOW FROM L IF ANY
	LD	A,L			; APPEND INTEGER TO BUFFER
	CALL	APPBT
	RET
;*******************************************************************
;GROUP 1B A,(HL)/(IX+D)/(IY+D)
;*******************************************************************
GP1B3:	LD	A,B			; GET OPD BYTE 1
	CP	77H			; MUST BE 'A' REG
	JP	NZ,SYNERR		; JUMP IF NOT, ERROR
	LD	B,C			; PUT OPD BYTE 2 IN B
	CALL	INDPF			; APPEND INDEX PREFIX IF ANY
	LD	A,(ORTKBF+1)		; GET OPR DISTING BIT
	AND	00010000B		; AND MASK IT
	OR	10001110B		; BUILD OP-CODE
	CALL	APPBT			; APPEND IT TO BUFFER
	EX	DE,HL			; GET DISP. INTEGER
	CALL	DISBT			; APPEND DISPLACEMENT INTEGER IF REQD
	RET
;********************************************************************
;GROUP 1B - HL,BC/DE/HL/SP
;********************************************************************
GP1B4:	LD	A,B			; GET OPD BYTE 1
	CP	12H			; MUST BE HL
	JP	NZ,SYNERR		; JUMP IF NOT, ERROR
	LD	A,C			; GET OPD BYTE 2
	CP	14H			; MUST BE BC/DE/HL/SP
	JP	NC,SYNERR		; JUMP IF NOT, ERROR
	LD	A,0EDH			; APPEND PREFIX BYTE TO BUFFER
	CALL	APPBT			
	LD	A,(ORTKBF+1)		; GET OPR DISTING BIT
	AND	00001000B		; MASK IT
	OR	01000010B		; BUILD OP-CODE
	CALL	IREGP			; COMBINE REG PAIR BITS
	CALL	APPBT			; APPEND IT TO BUFFER
	RET
;*******************************************************************
;PROCESS ADD (GROUP 1C)
;*******************************************************************
;*******************************************************************
;GROUP 1C - A,R
;*******************************************************************
GP1C1:	LD	A,B			; GET OPD BYTE 1
	CP	77H			; MUST BE 'A' REG
	JP	NZ,SYNERR		; JUMP IF NOT, ERROR
	LD	A,10000000B		; BUILD OP-CODE
	CALL	ISREG			; COMBINE REG BITS
	CALL	APPBT			; APPEND TO BUFFER
	RET
;*******************************************************************
;GROUP 1C - A,N   
;*******************************************************************
GP1C2:	LD	A,B			; GET OPD BYTE 1
	CP	77H			; MUST BE 'A' REG
	JP	NZ,SYNERR		; JUMP IF NOT, ERROR
	LD	A,0C6H			; APPEND OP-CODE
	CALL	APPBT			
	EX	DE,HL			; GET INTEGER IN HL
	CALL	CHKOF			; FLAG ANY OVERFLOW FROM L
	LD	A,L			; APPEND INTEGER TO BUFFER
	CALL	APPBT
	RET
;********************************************************************	
;GROUP 1C - A,(HL)/(IX+D)/(IY+D)
;********************************************************************
GP1C3:	LD	A,B			; GET OPD BYTE 1
	CP	77H			; MUST BE 'A' REG
	JP	NZ,SYNERR
	LD	B,C			; PUT OPD BYTE 2 IN B
	CALL	INDPF			; APPEND INDEX PREFIX IF REQD
	LD	A,86H			; APPEND OP-CODE TO BUFFER
	CALL	APPBT
	EX	DE,HL			; GET DISP INTEGER IN HL
	CALL	DISBT			; APPEND IT IF REQD
	RET
;********************************************************************
;GROUP 1C - HL/IX/IY,RP
;********************************************************************
GP1C4:	LD	A,B			; GET OPD BYTE 1 
	AND	11B			; MUST BE HL/IX/IY
	CP	10B
	JP	NZ,SYNERR		; JUMP IF NOT, ERROR
	LD	A,C			; GET OPD BYTE 2
	AND	11B			; IS IT BC/DE/SP
	CP	10B
	JR	NZ,GP1C41		; JUMP IF SO
	LD	A,C			; IS IT SAME AS OPD 1?
	CP	B
	JP	NZ,SYNERR		; JUMP IF NOT, ERROR
GP1C41:	CALL	INDPF			; APPEND INDEX PREFIX IF REQD
	LD	A,00001001B		; BUILD OP-CODE
	CALL	IREGP			; COMBINE REG PAIR BITS
	CALL	APPBT
	RET
;********************************************************************
;PROCESS LD (GROUP 1D)
;********************************************************************
;********************************************************************
;GROUP 1D - A,(BC)/(DE)
;********************************************************************
GP1D1:	LD	A,B			; GET OPD BYTE 1
	CP	77H			; MUST BE 'A' REG
	JP	NZ,SYNERR		; JUMP IF NOT, ERROR
	LD	A,00001010B		; BUILD OP-CODE
	CALL	IREGP			; COMBINE REG BITS
	CALL	APPBT			; APPEND OP-CODE TO BUFFER
	RET
;********************************************************************
;GROUP 1D - A,I/R
;********************************************************************
GP1D2:	LD	A,B			; GET OPD BYTE 1
	CP	77H			; MUST BE 'A' REG
	JP	NZ,SYNERR		; JUMP IF NOT, ERROR
	LD	A,0EDH			; APPEND PREFIX BYTE TO BUFFER
	CALL	APPBT			
	LD	A,01010111B		; BUILD OP-CODE
	CALL	IDREG			; COMBINE REG BIT
	CALL	APPBT			; APPEND OP-CODE TO BUFFER
	RET
;********************************************************************	
;GROUP 1D - A,(NN)
;********************************************************************
GP1D3:	LD	A,B			; GET OPD BYTE 1
	CP	77H			; MUST BE 'A' REG
	JP	NZ,SYNERR		; JUMP IF NOT, ERROR
	EX	DE,HL			; GET INTEGER IN HL
	LD	A,3AH			; APPEND OP-CODE TO BEFFER
	CALL	APPBT
	CALL	APPWD			; APPEND INTEGER
	RET
;********************************************************************	
;GROUP 1D - (BC)/(DE),A
;********************************************************************
GP1D4:	LD	A,C			; GET OPD BYTE 2
	CP	77H			; MUST BE 'A' REG
	JP	NZ,SYNERR		; JUMP IF NOT, ERROR
	LD	C,B			; PUT OPD BYTE 1 IN C
	LD	A,00000010B		; BUILD OP-CODE
	CALL	IREGP			; COMBINE REG PAIR BITS
	CALL	APPBT			; APPEND OP-CODE TO BUFFER
	RET
;*******************************************************************
;GROUP 1D - (HL)/(IX+D)/(IY+D),N
;*******************************************************************
GP1D5:	CALL	INDPF			; APPEND INDEX PREFIX TO BUFFER
	LD	A,36H
	CALL	APPBT			; APPEND OP-CODE
	CALL	DISBT			; APPEND DISP BYTE IF REQD
	EX	DE,HL			; GET INTEGER IN HL
	CALL	CHKOF			; FLAG OVERFLOW FROM L
	LD	A,L			; APPEND INTEGER TO BUFFER
	CALL	APPBT
	RET
;*******************************************************************
;GROUP 1D - BC/DE/HL/SP/IX/IY,NN
;*******************************************************************
GP1D6:	LD	A,B			; GET OPD BYTE 1
	CP	17H			; MUST NOT BE AF REG PAIR
	JP	Z,SYNERR		; JUMP IF IT IS, ERROR
	LD	C,B			; GET OPD BYTE 1 IN C
	CALL	INDPF			; APPEND INDEX PREFIX IF REQD
	LD	A,00000001B		; BUILD OP-CODE
	CALL	IREGP			; COMBINE REG PAIR BITS
	CALL	APPBT			; APPEND OP-CODE
	EX	DE,HL			; GET INTEGER IN HL
	CALL	APPWD			; APPEND INTEGER
	RET
;*******************************************************************
;GROUP 1D - BC/DE/HL/SP/IX/IY,(NN)
;*******************************************************************
GP1D7:	LD	A,B			; GET OPD BYTE 1
	LD	C,B			; PUT IN C
	CP	17H			; MUST NOT BE AF
	JP	Z,SYNERR		; JUMP IF IT IS, ERROR
	AND	11B			; TEST FOR HL/IX/IY
	CP	10B			; TREAT HL/IX/IY SEPARATELY
	JR	Z,GP1D71		; JUMP IF HL/IX/IY
	LD	A,0EDH			; APPEND PREFIX BYTE
	CALL	APPBT
	LD	A,01001011B		; BUILD OP-CODE
	CALL	IREGP			; COMBINE REG PAIR BITS
	JR	GP1D72
GP1D71:	CALL	INDPF			; APPEND INDEX PREFIX IF REQD
	LD	A,2AH			; APPEND OP-CODE TO BUFFER
GP1D72:	CALL	APPBT
	EX	DE,HL			; GET INTEGER IN HL
	CALL	APPWD			; APPEND INTEGER
	RET
;********************************************************************
;GROUP 1D - (HL)/(IX+D)/(IY+D),R
;********************************************************************
GP1D8:	CALL	INDPF			; APPEND INDEX PREFIX IF REQD
	LD	A,01110000B		; BUILD OP-CODE
	CALL	ISREG			; COMBINE REG BITS
	CALL	APPBT			; APPEND OP-CODE TO BUFFER
	CALL	DISBT			; APPEND TO BUFFER IF REQD
	RET
;********************************************************************
;GROUP 1D - I/R,A
;********************************************************************
GP1D9:	LD	A,C			; GET OPD BYTE 2
	CP	77H			; MUST BE 'A' REG
	JP	NZ,SYNERR		; JUMP IF NOT, ERROR
	LD	C,B			; PUT OPD BYTE 1 IN C
	LD	A,0EDH			; APPEND PREFIX BYTE
	CALL	APPBT
	LD	A,01000111B		; BUILD OP-CODE
	CALL	IDREG			; COMBINE REG BIT
	CALL	APPBT			; APPEND OP-CODE
	RET
;********************************************************************
;GROUP 1D - (NN),A
;********************************************************************
GP1DA:	LD	A,C			; GET OPD BYTE 2
	CP	77H			; MUST BE 'A' REG
	JP	NZ,SYNERR		; JUMP IF NOT, ERROR
	LD	A,32H			; APPEND OP-CODE TO BUFFER
	CALL	APPBT
	CALL	APPWD			; APPEND INTEGER
	RET
;********************************************************************
;GROUP 1D = (NN),BC/DE/HL/SP/IX/IY
;********************************************************************
GP1DB:	LD	A,C			; GET OPD BYTE 2
	LD	B,C			; PUT IN B
	CP	17H			; MUST NOT BE AF
	JP	Z,SYNERR		; JUMP IF IT IS, ERROR
	AND	11B			; TEST FOR HL/IX/IY
	CP	10B
	JR	Z,GP1DB1		; JUMP TO TREAT HL/IX/IY SEPARATELY
	LD	A,0EDH			; APPEND PREFIX BYTE
	CALL	APPBT
	LD	A,01000011B		; BUILD OP-CODE
	CALL	IREGP			; COMBINE REG PAIR BITS
	JR	GP1DB2
GP1DB1:	CALL	INDPF			; APPEND INDEX PREFIX IF REQD
	LD	A,22H			; PUT OP-CODE IN A
GP1DB2:	CALL	APPBT			; APPEND OP-CODE
	CALL	APPWD			; APPEND INTEGER
	RET
;**********************************************************************
;GROUP 1D - R,(HL)/(IX+D)/(IY+D)
;**********************************************************************
GP1DC:	LD	A,B			; SWAP B AND C
	LD	B,C
	LD	C,A
	CALL	INDPF			; APPEND INDEX PREFIX IF REQD
	LD	A,01000110B		; BUILD OP-CODE
	CALL	IDREG			; COMBINE REG BITS
	CALL	APPBT			; APPEND OP-CODE
	EX	DE,HL			; GET INTEGER IN HL
	CALL	DISBT			; APPEND DISP BYTE IF REQD
	RET
;**********************************************************************
;GROUP 1D - R,N
;**********************************************************************
GP1DD:	LD	C,B			; PUT OPD BYTE 1 IN C
	LD	A,00000110B		; BUILD OP-CODE
	CALL	IDREG			; COMBINE REG BITS
	CALL	APPBT			; APPEND OP-CODE TO BUFFER
	EX	DE,HL			; GET INTEGER IN HL
	CALL	CHKOF			; FLAG OVERFLOW FROM L
	LD	A,L			; APPEND INTEGER TO BUFFER
	CALL	APPBT
	RET
;**********************************************************************
;GROUP 1D - R,R
;**********************************************************************
GP1DE:	LD	A,01000000B		; BUILD OP-CODE
	CALL	ISREG			; COMBINE SOURCE REG BITS
	LD	C,B
	CALL	IDREG			; COMBINE DEST REG BITS
	CALL	APPBT			; APPEND OP-CODE
	RET
;*********************************************************************
;GROUP 1D - SP,HL/IX/IY
;*********************************************************************
GP1DF:	LD	A,B			; GET OPD BYTE 1
	CP	13H			; MUST BE SP
	JP	NZ,SYNERR		; JUMP IF NOT, ERROR
	LD	A,C			; GET OPD BYTE 2
	LD	B,C			; PUT IN B
	AND	11B			; MUST BE HL/IX/IY
	CP	10B
	JP	NZ,SYNERR		; JUMP IF NOT, ERROR
	CALL	INDPF			; APPEND INDEX PREFIX IF REQD
	LD	A,0F9H			; APPEND OP-CODE TO BUFFER
	CALL	APPBT
	RET
;*******************************************************************
;GET OPERAND PAIR BYTE
;THE M.S. NIBBLE OF AN OPERAND TOKEN BYTE
;SIGNIFIES THE OPERAND GROUP (0-E). THIS
;SUBROUTINE BUILDS A BYTE WHOSE M.S. NIBBLE
;IS THE GROUP OF OPERAND 1 AND WHOSE L.S.
;NIBBLE IS THE GROUP OF OPERAND 2.
;THIS COMPOSITE BYTE IS CALLED THE OPERAND
;PAIR BYTE AND IS USED TO DETERMINE WHICH
;PROCESSING SUBROUTINE (GP...) TO USE TO
;GENERATE THE ASSEMBLED CODE.
;
;ON EXIT:
;       A CONTAINS THE OPERAND BYTE PAIR
;*******************************************************************
ODPBT:	PUSH	BC			; SAVE BC
	LD	A,(ODBT1)		; GET 1ST OPERAND BYTE
	AND	0F0H			; MASK OPERAND GROUP NIBBLE  
	LD	B,A			; SAVE IN B
	LD	A,(ODBT2)		; GET 2ND OPERAND BYTE
	AND	0F0H			; MASK OPERAND GROUP NIBBLE
	RRCA				; SHIFT INTO LOWER 4 BITS
	RRCA
	RRCA
	RRCA
	OR	B			; CONSTRUCT COMPOSITE OPERAND
					; GROUP BYTE IN A
	POP	BC			; REPLACE BC
	RET
;******************************************************************
;GENERATE INDEX REGISTER PREFIX BYTE
;ON ENTRY:
;       B CONTAINS OPERAND TOKEN
;PREFIX IS APPENDED TO ASSD CODE BUFFER IF
;OPERAND IS IX OR IY.
;******************************************************************
INDPF:	BIT	3,B			; IS OPERAND IX OR IY?
	RET	Z			; NO PREFIX IF NOT, RETURN
	LD	A,0DDH			; PUT PREFIX BYTE FOR IX IN A
	BIT	2,B			; IS OPERAND IY?
	JR	Z,INDPF1		; JUMP IF NOT
	LD	A,0FDH			; PUT PREFIX BYTE FOR IY IN A
INDPF1:	CALL	APPBT			; APPEND BYTE TO ASSD CODE BUFFER
	RET
;******************************************************************
;GENERATE DISPLACEMENT BYTE
;USE NO. IN HL FOR DISPLACEMENT
;B CONTAINS OPERAND BYTE
;******************************************************************
DISBT:	BIT	3,B			; IS OPERAND IX OR IY?
	RET	Z			; IF NOT, NO DISP. BYTE REQD
	CALL	CHKOF			; CHECK NO. IN HL FOR 8 BIT OVERFLOW
	LD	A,L			; GET L.S. BYTE IN ACC.
	CALL	APPBT			; AND APPEND TO ASSD CODE BUFFER
	RET
;******************************************************************
;CHECK OVERFLOW FROM L
;VALUE ERROR INDICATED IF SO
;******************************************************************
CHKOF:	PUSH	BC			; SAVE BC
	LD	A,H			; GET REG CONTAINING POSSIBLE OVERFLOW
	AND	A			; IS IT ZERO?
	JR	Z,CHKOF1		; IF SO, NO OVERFLOW
	INC	A			; WAS IT -1? (FF)
	JR	Z,CHKOF1		; IF SO, NO OVERFLOW
	LD	C,'V'			; OTHERWISE INDICATE 'VALUE' ERROR
	CALL	ERROR
CHKOF1:	POP	BC			; REPLACE BC
	RET
;*****************************************************************
;INSERT SOURCE REG
;ON ENTRY:
;       C CONTAINS OPERAND BYTE
;       A CONTAINS CODE BYTE BEING BUILT
;ON EXIT:
;       A HAS HAD THE REGISTER VALUE INSERTED
;       TO BITD 0,1 & 2
;*****************************************************************
ISREG:	PUSH	BC			; SAVE REG
	LD	B,A			; SAVE CODE BEING BUILT IN B
	LD	A,C			; GET OPERAND BYTE FROM C
	AND	00000111B		; MASK REGISTER VALUE
	OR	B			; COMBINE WITH CODE BEING BUILT
	POP	BC			; REPLACE REG
	RET
;******************************************************************
;INSERT DESTINATION REGISTER
;ON ENTRY:
;       C CONTAINS OPERAND BYTE
;       A CONTAINS CODE BYTE BEING BUILT
;ON EXIT:
;       A HAS HAD THE REGISTER VALUE INSERTED
;         TO BITS 3,4 & 5
;******************************************************************
IDREG:	PUSH	BC			; SAVE BC
	LD	B,A			; SAVE CODE BEING BUILT IN B
	LD	A,C			; GET OPERAND BYTE FROM C
	AND	00000111B		; MASK REGISTER VALUE
	RLCA				; SHIFT TO DESTINATION REG POSITION
	RLCA
	RLCA
	OR	B			; COMBINE WITH CODE BEING BUILT
	POP	BC			; REPLACE BC
	RET
;******************************************************************
;INSERT REGISTER PAIR
;ON ENTRY:
;       C CONTAINS OPERAND BYTE
;       A CONTAINS CODE BYTE BEING BUILT
;ON EXIT:
;       A HAS HAD THE REGISTER PAIR VALUE
;         INSERTED TO BITS 4 & 5.
;******************************************************************
IREGP:	PUSH	BC			; SAVE BC
	LD	B,A			; SAVE CODE BEING BUILT IN B
	LD	A,C			; GET OPERAND BYTE FROM C
	AND	00000011B		; MASK REGISTER PAIR VALUE
	RLCA				; SHIFT TO CORRECT REG PAIR POSITION
	RLCA
	RLCA
	RLCA
	OR	B			; COMBINE WITH CODE BEING BUILT
	POP	BC			; REPLACE BC
	RET
;*******************************************************************
;APPEND WORD TO ASSEMBLED CODE BUFFER
;*******************************************************************
APPWD:	LD	A,L			; APPEND LOW BYTE
	CALL	APPBT
	LD	A,H			; APPEND HIGH BYTE
	CALL	APPBT
	RET
;*******************************************************************
;APPEND BYTE TO ASSEMBLED CODE BUFFER
;*******************************************************************
APPBT:	PUSH	HL			; SAVE REGISTERS
	PUSH	DE
	EX	AF,AF' 			; SAVE NEW BYTE IN A'
	LD	HL,ASSCOD		; SET POINTER TO ASSD CODE BUFF
	LD	A,(ASCDNO)		; GET 'NO. BYTES ASSD CODE'
	LD	E,A			; TO E
	LD	D,0			; CLEAR D
	ADD	HL,DE			; ADD TO POINTER
	EX	AF,AF'			; RECOVER NEW BYTE
	LD	(HL),A			; AND PUT IN ASSD CODE BUFF
	INC	E			; INCR CNTR
	LD	A,E			; AND REPLACE
	LD	(ASCDNO),A		; IN 'NO. BYTES ASSD CODE'
	POP	DE			; REPLACE REGS
	POP	HL
	RET
;*******************************************************************
;ADJUST ADDRESS REFERENCE COUNTER
;*******************************************************************
ADJARC:	PUSH	HL			; SAVE REGS
	PUSH	DE
	LD	HL,(ADREFC)		; GET ADDR REF CNTR
	LD	A,(ASCDNO)		; ADD TO THIS VALUE THE NO.
	LD	E,A
	LD	D,0			; OF BYTES OF ASSD CODE
	ADD	HL,DE			; AND PUT BACK INTO
	LD	(ADREFC),HL		; ADDR REF CNTR
	POP	DE			; REPLACE REGS
	POP	HL
	RET
;******************************************************************
;DEFAULT NOP'S
;******************************************************************
DNOPS:	PUSH	BC			; SAVE BC
	LD	C,'S'			; INDICATE SYNTAX ERROR
	CALL	ERROR			
	LD	A,4			; RESERVE 4 BYTES NOP'S
	LD	(ASCDNO),A
	POP	BC			; REPLACE BC
	RET
;******************************************************************
;PERFORM RELEVANT OUTPUT
;******************************************************************
PFRLO:	LD	A,(PASSNO)		; WHICH PASS?
	CP	1
	RET	Z			; NO OUTPUT ON PASS 1
	CP	2
	JR	Z,PFRLO1		; JUMP IF PASS 2
	CP	3
	JR	Z,PFRLO2		; JUMP IF PASS 3
	LD	A,(ERRBUF)
	CP	SPACE
	RET	Z
	CALL	OLNBF			; OUTPUT LINE BUFFER TO LIST DEV.
	CALL	LSTLN			; LIST RESULTS OF ASSEMBLY
	RET
PFRLO1:	CALL	LSTLN			; LIST RESULTS OF ASSEMBLY
	LD	A,(AFLAGS)		; TEST 'END' FLAG
	BIT	1,A
	RET	Z			; LOOP IF NOT END
	CALL	LSYMT			; LIST SYMBOL TABLE
	RET
PFRLO2:	CALL	OBJO			; DO OBJECT FILE OUTPUT
	RET
;*****************************************************************
;OUTPUT CONTENTS OF LINE BUFFER TO LIST DEV.
;*****************************************************************
OLNBF:	PUSH	HL			; SAVE REGS
	PUSH	BC
	LD	HL,LINBUF		; SET POINTER TO LINE BUFFER
OLNBF1:	LD	C,(HL)			; GET A CHAR
	CALL	LO			; OUTPUT TO LIST DEVICE
	LD	A,C			; WAS IT CR?
	CP	CR
	JR	Z,OLNBF2		; JUMP IF SO
	INC	HL
	JR	OLNBF1
OLNBF2:	POP	BC			; REPLACE REGS
	POP	HL
	RET
;****************************************************************
;LIST RESULT OF ASSEMBLY OF 1 LINE.
;****************************************************************
LSTLN:	PUSH	HL			; SAVE REGS
	PUSH	DE
	PUSH	BC
	PUSH	IX
	LD	A,(ERRBUF)		; PRINT CONTENTS OF ERROR BUFFER
	LD	C,A			
	CALL	LO
	LD	C,SPACE			; PRINT SPACE
	CALL	LO
	LD	HL,(ADDISR)		; GET CONT. OF ADDR DISP. REG
	LD	A,(ASCDNO)		; GET NO. OF BYTES OF ASSD. CODE
	LD	D,A			; INTO D
	LD	IX,ASSCOD		; SET POINTER TO ASSD. CODE
LSTLN3:	LD	E,4			; MAX. NO. OF BYTES/LINE
	PUSH	DE			; PRESERVE D
	CALL	LISTAD			; PRINT ADDR REF.
	POP	DE
	LD	C,SPACE			; PRINT SPACE
	CALL	LO
	LD	A,D			; ANY BYTES TO PRINT
	AND	A
	JR	Z,LSTLN4		; JUMP IF NOT
LSTLN1:	LD	A,(IX)			; GET BYTE
	PUSH	DE			; PRESERVE D
	CALL	LISTBT			; PRINT 1 BYTE
	POP	DE
	INC	IX			; INCR POINTER TO NEXT BYTE
	INC	HL			; INCR CORRES. ADDR. REF.
	DEC	E
	DEC	D			; DECR NO OF BYTES
	JR	Z,LSTLN4		; JUMP IF NONE LEFT
	LD	A,E			; PRINTED 4 ON THIS LINE?
	AND	A
	JR	NZ,LSTLN1		; JUMP IF NOT
LSTLN2:	CALL	LFEED
	LD	C,CR			; PRINT CR CR SP SP
	LD	B,2
	CALL	OUTC
	LD	C,SPACE
	LD	B,2			   
	CALL	OUTC
	JR	LSTLN3
LSTLN4:	RLC	E			; PRINT SPACES UP TO BEGINNING OF TEXT
	INC	E
	LD	B,E
	LD	C,SPACE
	CALL	OUTC			; OUTPUT CHAR N TIMES
	CALL	LFEED			; PRINT LF OR NEW PAGE HEADER
	POP	IX			; REPLACE REGS
	POP	BC
	POP	DE
	POP	HL
	RET
;*******************************************************************
;OUTPUT CHAR N TIMES TO LIST DEVICE
;*******************************************************************
OUTC:	CALL	LO			; COUNT IN B
	DJNZ	OUTC
	RET
;*******************************************************************
;LIST BYTE
;CONVERTS BYTE IN ACC TO 2 ASCII
;HEXADECIMAL CHARACTERS AND OUTPUTS THEM
;TO LIST OR PUNCH DEVICE DEPENDING ON PASS.
;THE BYTE IS ALSO SUBTRACTED FROM D TO
;HELP COMPUTE CHECKSUMS.
;*******************************************************************
LISTBT:	PUSH	BC			; SAVE REGS
	LD	B,A			; SAVE BYTE IN B
	AND	0F0H			; GET M.S. NIBBLE
	RRCA
	RRCA
	RRCA
	RRCA
	CALL	BINHX			; CONVERT TO ASCII HEXADECIMAL
	LD	C,A			; OUTPUT TO RELEVANT DEVICE
	CALL	XO
	LD	A,B			; GET BYTE AGAIN
	AND	0FH			; GET L.S. NIBBLE
	CALL	BINHX			; CONVERT TO ASCII HEX
	LD	C,A			; OUTPUT TO RELEVANT DEVICE
	CALL	XO
	LD	A,D			; GET CUMULATIVE CHECKSUM
	SUB	B			; SUBTRACT NEW BYTE
	LD	D,A			; REPLACE CHECKSUM
	POP	BC			; REPLACE REG
	RET
;.................................................................
BINHX:	CP	10D			; CONVERT VALUE IN A TO ASCII HEX
	JR	NC,BINHX1
	ADD	A,'0'
	RET
BINHX1:	ADD	A,'A'-10D
	RET
;**********************************************************************
;OUTPUT TO DEVICE RELEVANT TO PASS NO.
;**********************************************************************
XO:	LD	A,(PASSNO)
	CP	3
	JP	Z,PCHO
	JP	LO
;**********************************************************************
;LIST ADDRESS
;**********************************************************************
LISTAD:	LD	A,H
	CALL	LISTBT
	LD	A,L
	CALL	LISTBT
	RET
;**********************************************************************	
;LINE FEED.
;**********************************************************************
LFEED:	PUSH	BC			; SAVE REGS
	LD	A,(LINE)		; TIME FOR A NEW PAGE?
	CP	PLINES-9-1
	JR	NC,LFEED1
	INC	A			; INCREMENT LINE NO.
	LD	(LINE),A
	LD	C,LF			; PRINT LF
	CALL	LO
	JR	LFEED2
LFEED1:	CALL	HEADR			; PRINT PAGE HEADER
	LD	C,SPACE
	LD	B,16D
	CALL	OUTC
LFEED2:	POP	BC			; REPLACE REGS
	RET
;*********************************************************************
;PRINT PAGE HEADER ON LIST DEVICE
;*********************************************************************
HEADR:	PUSH	HL			; SAVE REGS
	PUSH	BC
	LD	C,CR			; PRINT CR, 5 X LF
	CALL	LO
	LD	C,LF
	LD	B,5
	CALL	OUTC
  	LD      HL,PHEAD		; POINTER TO PAGE HEADING
	CALL	LSTST
	JR	HEADR1
PHEAD:	DEFM	'CROWE Z80 ASSEMBLER V1.2 PAGE '
	DEFB	0
HEADR1:	CALL	PRNTP			; PRINT PAGE NO.
	CALL	INCP			; INCREMENT PAGE NO.
	XOR	A			; ZERO LINE NO.
	LD	(LINE),A
	LD	C,CR			; PRINT CR LF
	CALL	LO
	LD	C,LF
 	CALL	LO
	LD	HL,TITBUF		; PRINT CONTENTS OF TITLE BUFFER
	CALL	LSTST
	LD	C,CR			; PRINT CR, 3 X LR, 16 X SP
	CALL	LO
	LD	C,LF
	LD	B,3
	CALL	OUTC
	POP	BC			; REPLACE REGS
	POP	HL
	RET
;**********************************************************************
;LIST STRING
;**********************************************************************
LSTST:	PUSH	BC			; SAVE REG
LSTST1:	LD	A,(HL)			; GET A CHAR
	AND	A			; TEST FOR TERMINATOR CHAR
	JR	Z,LSTST2
	LD	C,A			; IF NOT, PRINT IT
	CALL	LO
	INC	HL			; INCREMENT POINTER
	JR	LSTST1			; LOOP
LSTST2:	POP	BC			; REPLACE REGS
	RET
;**********************************************************************
;PRINT PAGE NO.
;**********************************************************************
PRNTP:	PUSH	HL			; SAVE REGS
	PUSH	DE
	LD	DE,0			; CLEAR DIGIT CNTR AND NON ZERO FLAG
	LD	HL,PAGE+1
	CALL	PNT2DG
	DEC	HL
	CALL	PNT2DG
	POP	DE			; REPLACE REGS
	POP	HL
	RET
;....................................................................
;PRINT 2 DIGITS
;....................................................................
PNT2DG:	RLD				; ROTATE NIBBLES
	CALL	PNTDG			; PRINT A DIGIT
	RLD				; ROTATE NIBBLES
	CALL	PNTDG			; PRINT A DIGIT
	RLD				; ROTATE NIBBLES
	RET
;...................................................................
;PRINT A DIGIT
;...................................................................
PNTDG:	PUSH	BC			; SAVE REG
	LD	B,A			; INCR DIGIT COUNT
	INC	E
	AND	0FH
	JR	NZ,PNTDG1		; IS IT 0?
	BIT	0,D			; LEADING ZERO?
	JR	NZ,PNTDG2
	JR	PNTDG3
PNTDG1:	SET	0,D			; NON ZERO, SET FLAG
PNTDG2:	OR	30H			; CONVERT TO ASCII
	LD	C,A			; PRINT IT
	CALL	LO
PNTDG3:	LD	A,B
	POP	BC			; REPLACE REG
	RET
;*******************************************************************
;INCREMENT PAGE NO.
;*******************************************************************
INCP:	PUSH	HL			; SAVE REG
	LD	HL,(PAGE)		; GET PAGE NO (4 DIG BCD)
	LD	A,L			; INCREMENT L.S. BYTE
	ADD	A,1
	DAA	       			; DECIMAL ADJUST
	LD	L,A			
	LD	A,H			; CARRY TO M.S. BYTE
	ADC	A,0			
	DAA				; DECIMAL ADJUST
	LD	H,A
	LD	(PAGE),HL		; REPLACE PAGE NO.
	POP	HL			; REPLACE REG
	RET
;*******************************************************************
;LIST SYMBOL TABLE
;*******************************************************************
LSYMT:	PUSH	HL			; SAVE REGS
	PUSH	DE
	PUSH	BC
	LD	C,CR			; OUTPUT CR
	CALL	LO
	LD	A,(LINE)		; GET LINE NO.
LSYMT1:	CP	PLINES-9-1		; BOTTOM OF PAGE?
	JR	NC,LSYMT3		; JUMP IF SO
	INC	A			; ELSE INCR LINE NO.
	LD	B,A			; SAVE IN B
	LD	C,LF			; OUTPUT LF
	CALL	LO
	LD	A,B			; GET LINE NO. IN A
	JR	LSYMT1			; LOOP
LSYMT3:	CALL	HEADR			; PRINT PAGE HEADER
	LD	HL,SYMTAB		; POINT AT SYMBOL TABLE
LSYMT4:	LD	D,SPERL			; LOAD NO OF SYMBOLS PER LINE
LSYMT5:	LD	A,(HL)			; GET CHAR COUNT
	AND	A			; IS IT ZERO?
	JR	Z,LSYM10		; JUMP IF SO, END OF TABLE
	LD	B,A			; PUT COUNT IN B
	LD	E,7			; SPACES COUNT IN E
	INC	HL			; INCR PNTR
					; PRINT SYMBOL
LSYMT6:	LD	C,(HL)			; GET CHAR IN C
	CALL	LO			; OUTPUT TO LIST DEVICE
	INC	HL			; INCR PNTR
	DEC	E			; DECR SPACE CNTR
	DEC	B			; DECR CHAR CNTR
	JR	NZ,LSYMT6		; LOOP IF NOT FINISHED
	LD	B,E			; GET SPACES COUNT
	LD	C,SPACE			; AND OUTPUT THAT NO.
	CALL	OUTC			; OF SPACES
	INC	HL			; INCR PNTR TO VALUE
	LD	A,(HL)			; GET M.S. BYTE
	PUSH	DE			; SAVE DE
	CALL	LISTBT			; OUTPUT IN HEX
	DEC	HL			; POINT AT L.S. BYTE
	LD	A,(HL)			; GET IT
	CALL	LISTBT			; OUTPUT IN HEX
	POP	DE			; REPLACE DE
	INC	HL			; POINT TO ATTRIBUTE BYTE
	INC	HL
	LD	C,SPACE			; OUTPUT A SPACE
	CALL	LO
	LD	C,SPACE			; SET UP A FURTHER SPACE
	BIT	1,(HL)			; M FLAG SET?
	INC	HL			; (INCR POINTER)
	JR	Z,LSYMT7		; JUMP IF NOT
	LD	C,'M'			; CHANGE SPACE TO 'M'
LSYMT7:	CALL	LO			; OUTPUT CHAR
	DEC	D			; DECR SYM/LINE CNT
	JR	Z,LSYMT8		; JUMP IF DONE
	LD	C,SPACE			; ELSE OUTPUT 2 SPACES
	LD	B,2
	CALL	OUTC
	JR	LSYMT5			; AND LOOP
LSYMT8:	LD	A,(LINE)		; GET LINE NO.
	CP	PLINES-9-1		; BOTTOM OF PAGE?
	JR	NC,LSYMT9		; JUMP IF SO
	INC	A			; ELSE INCR LINE NO.
	LD	(LINE),A			
	LD	C,CR			; LIST CR/LF
	CALL	LO
	LD	C,LF
	CALL	LO
	JR	LSYMT4			; AND LOOP
LSYMT9:	CALL	HEADR			; PRINT PAGE HEADER
	JR	LSYMT4			; AND LOOP 
LSYM10:	POP	BC			; REPLACE REGS
	POP	DE
	POP	HL
	RET
;***************************************************************
;OBJECT OUTPUT.
;PERFORM OUTPUT OF OBJECT CODE USING THE INTEL
;HEXADECIMAL OBJECT FORMAT WITH RECORD LENGTH
;OF 'RECSIZ'
;***************************************************************
OBJO:	PUSH	HL			; SAVE REGS
	PUSH	DE
	PUSH	BC
	LD	HL,AFLAGS		; END FLAG SET?
	BIT	1,(HL)
	JR	Z,OBJO2			; JUMP IF NOT
	CALL	ODREC			; PUNCH DATA RECORD
	CALL	OEREC			; PUNCH EOF RECORD
	CALL	RUNOUT			; PUCH TAPE RUNOUT
	JR	OBJO7
OBJO2:	BIT	0,(HL)			; ADDR DISCONTINUITY FLAG SET?
	JR	Z,OBJO3			; JUMP IF NOT
	CALL	ODREC			; PUNCH DATA RECORD
	JR	OBJO7
OBJO3:	LD	C,0			; CLEAR PNTR TO ASSD CODE BUFFER
	LD	A,(ASCDNO)		; ANY BYTES OF ASSD CODE?
	LD	B,A			; SAVE NO. IN B
	AND	A			; ZERO?
OBJO4:	JR	Z,OBJO7			; JUMP IF ZERO
	LD	HL,(ADDISR)		; GET ADDR DISP REG IN HL
	LD	A,(OBJCNT)		; ANY BYTES IN OBJECT BUFFER?
	AND	A			
	JR	NZ,OBJO5		; JUMP IF SO
	LD	(RECADR),HL		; ELSE COPY ADDR DISP REG
					; INTO RECORD ADDR
OBJO5:	INC	HL			; INCR ADDR DISP REG
	LD	(ADDISR),HL		
					; TRANSFR BYTE FROM ASSD CODE BUFF
					; TO OBJECT BUFFER
	LD	HL,ASSCOD		; POINT AT ASSD CODE BUFF
	LD	E,C			; PUT ASSD CODE BUFF CNTR IN DE
	LD	D,0
	ADD	HL,DE			; COMPUTE PNTR TO BYTE FOR TRANSFER
	LD	A,(HL)			; GET BYTE
	EX	AF,AF'			; SAVE IN A'
	LD	HL,OBJBUF		; POINT AT OBJECT BUFF
	LD	A,(OBJCNT)		; PUT OBJ BUFF CNTR IN DE
	LD	E,A
	ADD	HL,DE			; COMPUTE PNTR TO INSERT POSITION
	EX	AF,AF'			; GET BACK BYTE
	LD	(HL),A			; AND APPEND TO OBJECT BUFFER
	LD	A,E			; GET OBJ COUNT
	INC	A			; INCREMENT IT
	LD	(OBJCNT),A		; REPLACE COUNT IN OBJCNT
	CP	RECSIZ			; ENOUGH BYTES FOR A RECORD
	JR	NZ,OBJO6		; JUMP IF NOT
	CALL	ODREC			; ELSE OUTPUT DATA RECORD
OBJO6:	INC	C			; INCREMENT ASD CODE BUFF CNTR
	DEC	B			; DECR NO OF BYTES
	JR	OBJO4			; AND LOOP
OBJO7:	POP	BC			; REPLACE REGS
	POP	DE
	POP	HL
	RET
;***********************************************************************
;OUTPUT DATA RECORD
;OUTPUTS DATA RECORD USING INTEL'S HEXADECIMAL
;OBJECT CODE FORMAT
;***********************************************************************
ODREC:	PUSH	HL			; SAVE REGS
	PUSH	DE
	PUSH	BC
	LD	A,(OBJCNT)		; GET NO OF BYTES IN OBJ BUFF
	AND	A			; IS IT ZERO?
	JR	Z,ODREC2		; JUMP IF SO 
	LD	B,A			; PUT COUNT IN B
	LD	C,':'			; OUTPUT RECORD MARK
	CALL	PCHO			; TO PUNCH DEVICE
	LD	D,0			; CLEAR CHECKSUM REG D
	LD	A,B			; OUTPUT BYTE COUNT
	CALL	LISTBT			  
	LD	HL,(RECADR)		; OUTPUT RECORD ADDR
	CALL	LISTAD
	XOR	A			; OUTPUT RECORD TYPE (0)
	CALL	LISTBT
	LD	HL,OBJBUF		; SET PNTR TO OBJECT BUFFER
ODREC1:	LD	A,(HL)			; OUTPUT DATA BYTE
	CALL	LISTBT
	INC	HL			; INCR PNTR
	DEC	B			; DECR COUNT
	JR	NZ,ODREC1		; LOOP IF NOT ZERO
	LD	A,D			; OUTPUT CHECKSUM
	CALL	LISTBT
	LD	C,CR			; OUTPUT CR
	CALL	PCHO
	LD	C,LF			; OUTPUT LF
	CALL	PCHO
	XOR 	A  			; SET NO. OF BYTES IN OBJBUF=0
	LD	(OBJCNT),A
ODREC2:	POP	BC			; REPLACE REGS
	POP	DE
	POP	HL
	RET
;********************************************************************
;OUTPUT END OF FILE RECORD
;OUTPUTS END OF FILE RECORD TO PUNCH DEVICE
;USING INTEL'S HEXADECIMAL OBJECT FORMAT
;********************************************************************
OEREC:	PUSH	HL			; SAVE REGS
	PUSH	DE
	PUSH	BC
	LD	C,':'			; OUTPUT RECORD MARK
	CALL	PCHO
	XOR	A			; CLEAR A AND CHECKSUM (IN D)
	LD	D,A
	CALL	LISTBT			; OUTPUT ZERO BYTE COUNT
	LD	HL,(STADDR)		; GET START ADDR
	CALL	LISTAD			; AND OUTPUT IT
	LD	A,1			; OUTPUT RECORD TYPE (1)
	CALL	LISTBT
	LD	A,D			; OUTPUT CHECKSUM
	CALL	LISTBT
	LD	C,CR			; OUTPUT CR
	CALL	PCHO
	LD	C,LF			; OUTPUT LF
	CALL	PCHO
	POP	BC			; REPLACE REGS
	POP	DE
	POP	HL
	RET
;*******************************************************************
;RUNOUT
;OUTPUTS 30 CM OF BLANK TAPE FOR PUNCHED TAPE
;LEADER AND TRAILER.
;IF NOT REQUIRED PUT 'RET' IN FIRST LOCATION
;OF SUBROUTINE.
;*******************************************************************
RUNOUT:	RET;PUSH	BC			; SAVE REG
	LD	B,120			; PUT COUNT IN B
	LD	C,NUL			; PUT NULL CHAR IN C
RUN1:	CALL	PCHO			; OUTPUT CHAR TO PUNCH
	DJNZ	RUN1			; LOOP UNTIL DONE
	POP	BC			; REPLACE REG
	RET
;*******************************************************************
;GET SYMBOL
;ON ENTRY:
;	HL POINTS AT 1ST CHAR OF SYMBOL	
;       DE POINTS AT BUFFER
;ON EXIT:
;       HL POINTS AT CHAR AFTER SYMBOL
;       BUFFER CONTAINS SYMBOL		
;*******************************************************************
GSYM:	PUSH	IX			; SAVE REGISTERS
	PUSH	BC
	LD	B,0			; CLEAR CHAR COUNT
	PUSH	DE			; SAVE START OF BUFFER POINTER
	POP	IX
	INC	DE			; LEAVE SPACE IN BUFF FOR CHAR COUNT
GSYM1:	LD	(DE),A			; PUT CHAR IN BUFFER
	INC	DE			; INCREMENT POINTERS
	INC	HL
	INC	B			; AND COUNTER
	LD	A,B			; IS THAT 6 CHARS?
	CP	6
	JR	Z,GSYM2			  
	LD	A,(HL)			; FETCH NEXT CHAR
	CALL	VALID			; IS IT VALID IN A SYMBOL?
	JR	C,GSYM1			; JUMP IF SO
GSYM3:	LD	(IX),B			; NO, END OF SYMBOL
	POP	BC			; REPLACE SAVED REGISTERS
	POP	IX
	RET
GSYM2:	LD	A,(HL)			; SCAN TO FIRST NON VALID CHAR
	CALL	VALID
	JR	NC,GSYM3
	INC	HL
	JR	GSYM2
;**********************************************************************	
;VALID LABEL CHAR?
;ON ENTRY:
;       A CONTAINS CHARACTER
;ON EXIT:
;       A CONTANS CHARACTER
;       CARRY FLAG IS SET IF VALID.	
;************************************************************************
VALID:	CP	'A'
	JR	C,VALID1
	CP	'Z'+1
	RET	C			; VALID
VALID1:	CP	'0'
	JR	C,VALID2
	CP	'9'+1
	RET	C			; VALID
VALID2:	CP	'?'
	JR	Z,VALID3
	CP	'_'
	JR	Z,VALID3
	SCF	   			; NOT VALID, CLEAR CARRY FLAG.
	CCF
	RET
VALID3:	SCF	     			; VALID, SET CARRY FLAG
	RET

;*********************************************************************
;GET TOKEN(S) FROM LIST
;ON ENTRY:
;       SYMBUF CONTAINS SYMBOL
;       HL CONTAINS POINTER TO LIST POINTER TABLE
;       DE POINTS AT DESTINATION FOR TOKENS
;       C CONTAINS NO. OF TOKEN BYTES PER LIST ENTRY.
;ON EXIT:
;       TOKEN(S) ARE IN DESTINATION.
;       LAST ONE IS ALSO IN A
;       ZERO FLAG SET IF NOT IN LIST.
;**********************************************************************
OPTOK:	PUSH	DE			; SAVE PTR TO DEST FOR TOKENS.
	LD	A,(SYMBUF)		; GET NO. OF BYTES IN STRING
	LD	B,A
	PUSH	BC			; SAVE TOKEN BYTE COUNT (C)
					; AND STRING CHAR COUNT (B)
	SUB	1			; (BYTES IN STRING - 1)
	RLCA				; *2
	LD	E,A
	LD	D,0
	ADD	HL,DE			; POINTER TO CORRECT WORD OF PNTR TABL
	LD	A,(HL)
	INC	HL
	LD	H,(HL)
	LD	L,A			; HL POINTS TO CORRECT SECTION OF LIST
OPTOK3:	LD	DE,SYMBUF+1
	POP	BC
	PUSH	BC			; B CONTAINS NO. OF CHARS IN STRING
	LD	A,(HL)			; GET FIRST CHAR OF LIST ENTRY
	OR	A			; IS IT 0?
	JR	Z,OPTOK4		; YES, END OF LIST
OPTOK1:	EX	DE,HL			; NO, COMPARE A CHAR
	CP	(HL)
	EX	DE,HL
	INC	HL			; INCR POINTERS
	INC	DE
	JR	NZ,OPTOK2		; CHARS NOT EQU, GO TO NEXT ENTRY
	DEC	B			; CHARS EQU, DECR COUNT
	LD	A,(HL)			; GET A CHAR
	JR	NZ,OPTOK1		; MORE CHARS TO COMPARE
	POP	BC			; NO MORE CHARS TO COMPARE
	POP	DE			; MATCH FOUND, GET POINTER AND
					; COUNT FOR TOKEN BUFFER.
OPTOK5:	LD	A,(HL)
	LD	(DE),A			; TRANSFER A BYTE
	INC	HL
	INC	DE
	DEC	C
	JR	NZ,OPTOK5
	INC	C			; CLEAR ZERO FLAG
	RET				; AND RETURN
OPTOK4:	POP	BC			; ADJUST STACK
	POP	DE
	RET				; AND RETURN
OPTOK2:	LD	A,B			; ADD REMAINING COUNT+
					; (NO OF TOKENS)-1 TO LIST PNTR
	POP	BC
	PUSH	BC
	ADD	A,C
	DEC	A
	LD	E,A
	LD	D,0
	ADD	HL,DE			; HL POINTING TO NEXT LIST ENTRY
	JR	OPTOK3			; GO CHECK NEXT ENTRY
;*************************************************************************
;LOCATE A GIVEN SYMBOL IN THE SYMBOL TABLE,
;OR THE CORRECT ALPHABETIC LOCATION FOR IT.
;ON ENTRY:
;       SEARCHED SYMBOL IS IN SYMBOL BUFFER.
;ON EXIT:
;       DE CONTAINS PNTR TO START OF ENTRY
;          OR ALPHABETIC INSERTION POSITION.
;       HL POINTS AT VALUE IF PRESENT
;       ZERO FLAG SET IF FOUND IN TABLE.
;*************************************************************************
LOCATE:	PUSH	BC			; SAVE REGISTERS
	PUSH	IX
	LD	HL,SYMTAB		; SET POINTER TO SYMBOL TABLE
LOC1:	PUSH	HL			; SAVE POINTER TO START OF ENTRY
	POP	DE			; IN DE
	LD	C,(HL)			; SAVE NO OF CHARS IN SYM IN C
	INC	C			; TEST C FOR ZERO
	DEC	C
	JR	Z,LOC3			; IF ZERO THEN END OF TABLE
	LD	IX,SYMBUF		; SET POINTER TO SYMBOL BUFFER
	LD	B,(IX)			; SAVE NO OF CHARS IN SEARCHED SYM
	INC	HL			; MOVE BOTH POINTERS TO 1ST
	INC	IX			; CHARS OF SYMBOLS
LOC2:	LD	A,(IX)			; COMPARE A CHAR 
	CP	(HL)
	JR	C,LOC3			; TOO FAR
	JR	NZ,LOC5			; NOT FAR ENOUGH   
					; CHARS EQUAL SO FAR
	INC	HL			; MOVE BOTH POINTERS ON 1
	INC	IX
	DEC	C			; DECR TABL SYM CHAR COUNT
	JR	Z,LOC6
	DEC	B			; DECR SEARCHED SYM CHAR COUNT
	JR	Z,LOC3			; TOO FAR
	JR	LOC2			; EQUAL SO FAR
LOC6:	DEC	B
	JR	Z,LOC4			; MATCH FOUND, RETURN WITH ZERO
					; FLAG SET, DE POINTING AT
					; ENTRY, & HL AT VALUE
LOC5:	LD	A,3			; SET POINTER TO NEXT ENTRY
					; (ADD COUNTER+3 TO TABLE POINTER)
	ADD	A,C
	LD	C,A
	LD	B,0
	ADD	HL,BC
	JR	LOC1
LOC3:	INC 	C			; TOO FAR, RESET ZERO FLAG
LOC4:	POP	IX			; REPLACE REGS & RETURN
	POP	BC			; WITH ZERO FLAG=0
	RET				; DE CONTAINS START OF ENTRY
;***********************************************************************
;TRANSFER LABEL (AND VALUE) TO SYMBOL BUFFER
;ON ENTRY:  HL CONTAINS VALUE OF LABEL
;ON EXIT:  HL CONTAINS POINTER TO ATTRIBUTE BYTE
;             IN SYMBOL BUFFER
;***********************************************************************
LBSYM:	PUSH	BC			; SAVE REGS
	PUSH	DE
	LD	A,(LABBUF)		; HOW MANY CHARS IN LABEL?
	AND	A			; IS IT ZERO?
	JR	Z,LBSYM1		; JUMP IF SO, NO LABEL
	INC	A			; ADD 1 TO NUMBER
	LD	C,A			; AND PUT IT IN BC
	LD	B,0
	PUSH	HL			; SAVE VALUE OF LABEL
	LD	HL,LABBUF		; SET SOURCE PNTR = LABEL BUFFER
	LD	DE,SYMBUF		; SET DEST PNTR = SYMBOL BUFFER
	LDIR				; TRANSFER LABEL TO SYMBOL BUFFER
	EX	DE,HL			; PUT SYMBOL BUFF PNTR IN HL
	POP	DE			; GET VALUE IN DE
	LD	(HL),E			; AND PUT IN SYMBUF
	INC	HL
	LD	(HL),D
	INC	HL
	LD	(HL),0			; CLEAR ATTRIBUTES BYTE
	XOR	A			; CLEAR ZERO FLAG
	INC	A
LBSYM1:	POP	DE			; REPLACE REGS
	POP	BC
	RET
;***********************************************************************
;CHECK SYMBOL IS NOT RESERVED WORD
;ON ENTRY SYMBOL IS IN SYMBUF
;CARRY FLAG SET IF RESERVED WORD.
;***********************************************************************
SYMCH:	PUSH	HL			; SAVE REGISTERS
	PUSH	DE
	PUSH	BC
					; CHECK IF SYMB = RESERVED WORD
	LD	A,(SYMBUF)		; GET NO OF CHARS IN SYMB
	CP	6			; MORE THAN 5 ?
	JR	NC,SYMCH3		; IF SO NOT RESERVED WORD
	LD	DE,TEMP			; CHECK IF IN OPERATOR LIST
	LD	HL,ORLSTP		; PNTR TO OPR LIST PNTR TABLE
	LD	C,2			; 2 TOKENS/ENTRY IN LIST
	CALL	OPTOK			; IN LIST?
	JR	NZ,SYMCH1		; JUMP IF SO
	LD	A,(SYMBUF)		; GET NO OF CHARS IN SYMB
	CP	4			; MORE THAT 3?
	JR	NC,SYMCH3		; IF SO NOT RESERVED WORD
	LD	DE,TEMP			; CHECK IF IN OPND KW LIST
	LD	HL,OPKLST		; PNTR TO LIST PNTR TABLE
	LD	C,1			; 1 TOKEN/ENTRY IN LIST
	CALL	OPTOK			; IN LIST?
	JR	Z,SYMCH2		; JUMP IF NOT
					; RESERVED WORD USED
SYMCH1:	LD	C,'W'			; INDICATE ERROR
	CALL	ERROR
	SCF				; SET CARRY FLAG
	JR	SYMCH3
SYMCH2:	AND	A			; NOT RESERVED WORD, CLEAR CARRY
SYMCH3:	POP	BC			; REPLACE REGISTERS
	POP	DE
	POP	HL
	RET
;**********************************************************************
;INSERT SYMBOL INTO SYMBOL TABLE
;ON ENTRY DE POINTS AT INSERTION POSITION
;SYMBOL IS IN SYMBOL BUFFER (SYMBUF)
;**********************************************************************
INSERT:	EXX				; SAVE REGS
	PUSH	HL
	PUSH	DE
	PUSH	BC
	EXX
	PUSH	HL
	PUSH	BC
	PUSH	DE
	LD	HL,(MEMTOP)		; GET POINTER TO TOP OF
	LD	DE,-10			; AVAILABLE RAM (WITH ROOM FOR ANOTHER
	ADD	HL,DE			; ENTRY)
	LD	DE,(SYMEND)		; GET PNTR TO END OF SYMBOL TABLE
	AND	A			; CLEAR CARRY
	SBC	HL,DE			; IS TABLE FULL?
	JR	NC,INSRT1		; JUMP IF NOT
	LD	HL,AFLAGS		; SET SYM TAB OVERFLOW FLAG
	SET	2,(HL)
	POP	DE			; ADJUST STACK
	JR	INSRT2			  
INSRT1:	POP	DE			; LEAVE PNTR TO INSERT POS IN DE'
	PUSH	DE
	EXX
	POP	DE			; GET PNTR TO INSERT POS
					; OPEN UP A GAP IN TABLE USING
					; BLOCK MOVE. DE WILL CONTAIN DEST.
					; HL THE SOURCE AND BC THE NO.
					; OF BYTES
	AND	A			; CLEAR CARRY
	LD	HL,(SYMEND)		; FIND NO OF BYTES BETWEEN INSERTION
	SBC	HL,DE			; POSITION AND END OF SYMBOL
	INC	HL			; TABLE
	PUSH	HL			; SAVE NO OF BYTES ON STACK
	LD	HL,(SYMEND)
	LD	D,H
	LD	E,L
	LD	A,(SYMBUF)		; CALCULATE NO OF BYTES FOR INSERTION
	ADD	A,4
	LD	C,A			; PUT IN BC
	LD	B,0
	PUSH	BC			; SAVE IN BC'
	EXX
	POP	BC
	EXX
	ADD	HL,BC
	LD	(SYMEND),HL		; SAVE NEW END OF SYMBOL TABLE
	EX	DE,HL
	POP	BC			; NO OF BYTES
	LDDR				; MOVE BLOCK TO OPEN GAP
					; INSERT NEW SYMBOL RECORD
					; INTO GAP
	EXX
	LD	HL,SYMBUF
	LDIR
INSRT2:	POP	BC			; REPLACE REGS
	POP	HL
	EXX
	POP	BC
	POP	DE
	POP	HL
	EXX
	RET
;*********************************************************************
;SCAN TO NEXT NON SPACE CHAR
;ON ENTRY:
;       HL CONTAINS POINTER
;ON EXIT:
;       HL POINTS AT FIRST NON-SPACE CHAR
;*********************************************************************
SCNSP:	LD	A,(HL)			; GET A CHAR
	CP	SPACE			; IS IT A SPACE?
	RET	NZ			; IF NOT RETURN
	INC	HL			; INCREMENT POINTER
	JR	SCNSP
;*********************************************************************
;CHECK IF ASCII CHAR IN ACC
;IS A LETTER. SET CARRY FLAG IF SO.
;*********************************************************************
ALPHA:	CP	'A'
	JR	C,ALPHA1
	CP	'Z'+1
	RET
ALPHA1:	OR	A			; NOT LETTER, CLEAR CARRY
	RET
;*********************************************************************
;CHECK IF DIGIT (0-9) IN ACC.
;IF SO, RETURN WITH CARRY SET.
;*********************************************************************
DIGIT:	CP	'0'
	JR	C,DIGIT1
	CP	'9'+1
	RET
DIGIT1:	OR	A			; NOT DIGIT, CLEAR CARRY
	RET
;********************************************************************
;ERROR ROUTINE. SET ERROR CHAR IF NOT
;ALREADY SET.
;ON ENTRY:
;       C CONTAINS ASCII ERROR CHAR
;ON EXIT:
;       ERRBUF CONTAINS ERROR CHAR
;*******************************************************************
ERROR:	LD	A,(ERRBUF)		; GET CONTENT OF ERROR DISPLAY REG.
	CP	SPACE			; IS IT A SPACE?
	RET	NZ
	LD	A,C			; YES, REPLACE WITH ERROR INDICATOR
	LD	(ERRBUF),A
	RET
;*******************************************************************
;OPERATOR LIST
;EACH SECTION OF LIST CONTAINS OPERATOR
;STRING FOLLOWED BY OPERATOR GROUP TOKEN
;(1-1D) FOLLOWED BY OPERATOR VALUE.
;*******************************************************************
ORLSTP:	DEFW	OR1			; POINTER LIST TO THE SECTIONS
	DEFW	OR2			; OF THE OPERATOR LIST WITH
	DEFW	OR3			; DIFFERENT NOS. OF CHARS
	DEFW	OR4
	DEFW	OR5
OR1:	DEFB 	0			; OPERATOR LIST ITSELF
OR2:	DEFM	'LD'
	DEFB	1DH
	DEFB	00H
	DEFM	'JP'
	DEFB	91H
	DEFB	00H
	DEFM	'CP'
	DEFB	0CH
	DEFB	38H
	DEFM	'IN'
	DEFB	17H
	DEFB	00H
	DEFM	'OR'
	DEFB	0CH
	DEFB	30H
	DEFM	'DI'
	DEFB	0AH
	DEFB	0F3H
	DEFM	'EI'
	DEFB	0AH
	DEFB	0FBH
	DEFM	'IM'
	DEFB	0EH
	DEFB	00H
	DEFM	'RL'
	DEFB	0FH
	DEFB	10H
	DEFM	'RR'
	DEFB	0FH
	DEFB	18H
	DEFM	'JR'
	DEFB	92H
	DEFB	00H
	DEFM	'EX'
	DEFB	1AH
	DEFB	00H
	DEFB	00H
OR3:	DEFM	'INC'
	DEFB	0DH
	DEFB	00H
	DEFM	'DEC'
	DEFB	0DH
	DEFB	09H
	DEFM	'OUT'
	DEFB	18H
	DEFB	00H
	DEFM	'AND'
	DEFB	0CH
	DEFB	20H
	DEFM	'ORG'
	DEFB	01H
	DEFB	00H
	DEFM	'EQU'
	DEFB	02H
	DEFB	00H
	DEFM	'END'
	DEFB	04H
	DEFB	00H
	DEFM	'EXX'
	DEFB	0AH
	DEFB	0D9H
	DEFM	'DAA'
	DEFB	0AH
	DEFB	27H
	DEFM	'CPL'
	DEFB	0AH
	DEFB	2FH
	DEFM	'CCF'
	DEFB	0AH
	DEFB	3FH
	DEFM	'SCF'
	DEFB	0AH
	DEFB	37H
	DEFM	'NOP'
	DEFB	0AH
	DEFB	00H
	DEFM	'RLA'
	DEFB	0AH
	DEFB	17H
	DEFM	'RRA'
	DEFB	0AH
	DEFB	1FH
	DEFM	'LDI'
	DEFB	0BH
	DEFB	0A0H
	DEFM	'LDD'
	DEFB	0BH
	DEFB	0A8H
	DEFM	'CPI'
	DEFB	0BH
	DEFB	0A1H
	DEFM	'CPD'
	DEFB	0BH
	DEFB	0A9H
	DEFM	'NEG'
	DEFB	0BH
	DEFB	44H
	DEFM	'RLD'
	DEFB	0BH
	DEFB	6FH
	DEFM	'RRD'
	DEFB	0BH
	DEFB	67H
	DEFM	'INI'
	DEFB	0BH
	DEFB	0A2H
	DEFM	'IND'
	DEFB	0BH
	DEFB	0AAH
	DEFM	'XOR'
	DEFB	0CH
	DEFB	28H
	DEFM	'RLC'
	DEFB	0FH
	DEFB	00H
	DEFM	'SLA'
	DEFB	0FH			  
	DEFB	20H
	DEFM	'RRC'
	DEFB 	0FH
	DEFB	08H
	DEFM	'SRA'
	DEFB	0FH
	DEFB	28H
	DEFM	'SRL'
	DEFB	0FH
	DEFB	38H
	DEFM	'BIT'
	DEFB	10H
	DEFB	40H
	DEFM	'SET'
	DEFB	10H
	DEFB	0C0H
	DEFM	'RES'
	DEFB	10H
	DEFB	80H
	DEFM	'RET'
	DEFB	95H
	DEFB	00H
	DEFM	'RST'
	DEFB	16H
	DEFB	00H
	DEFM	'POP'
	DEFB	19H
	DEFB	0C1H
	DEFM	'ADC'
	DEFB	1BH
	DEFB	08H
	DEFM	'SBC'
	DEFB	1BH
	DEFB	10H
	DEFM	'ADD'
	DEFB	1CH
	DEFB	00H
	DEFM	'SUB'
	DEFB	0CH
	DEFB	10H
	DEFB	00H
OR4:	DEFM	'CALL'
	DEFB	94H
	DEFB	00H
	DEFM	'DEFL'
	DEFB	03H
	DEFB	00H
	DEFM	'DEFB'
	DEFB	05H
	DEFB	00H
	DEFM	'DEFW'
	DEFB	06H
	DEFB	00H
	DEFM	'DEFS'
	DEFB	07H
	DEFB	00H
	DEFM	'DEFM'
	DEFB	08H
	DEFB	00H
	DEFM	'HALT'
	DEFB	0AH
	DEFB	76H
	DEFM	'RLCA'
	DEFB	0AH
	DEFB	07H
	DEFM	'RRCA'
	DEFB	0AH
	DEFB	0FH
	DEFM	'LDIR'
	DEFB	0BH			  
	DEFB	0B0H
	DEFM	'LDDR'
	DEFB	0BH
	DEFB	0B8H
	DEFM	'CPIR'
	DEFB	0BH
	DEFB	0B1H
	DEFM	'CPDR'
	DEFB	0BH
	DEFB	0B9H
	DEFM	'RETI'
	DEFB	0BH
	DEFB	4DH
	DEFM	'RETN'
	DEFB	0BH
	DEFB	45H
	DEFM	'INIR'
	DEFB	0BH
	DEFB	0B2H
	DEFM	'INDR'
	DEFB	0BH
	DEFB	0BAH
	DEFM	'OUTI'
	DEFB	0BH
	DEFB	0A3H
	DEFM	'OTIR'
	DEFB	0BH
	DEFB	0B3H
	DEFM	'OUTD'
	DEFB	0BH
	DEFB	0ABH
	DEFM	'OTDR'
	DEFB	0BH
	DEFB	8BH
	DEFM	'DJNZ'
	DEFB	13H
	DEFB	00H
	DEFM	'PUSH'
	DEFB	19H
	DEFB	0C5H
	DEFB	00H
OR5:	DEFM	'TITLE'
	DEFB	09H
	DEFB	00H
	DEFB	00H
;**********************************************************************
;OPERAND KEYWORD LIST
;CONTAINS OPERAND KEYWORDS FOLLOWED BY
;TOKENS FOR THEM.
;**********************************************************************
OPKLST:	DEFW	OPKW1			; POINTER LIST TO DIFFERENT
	DEFW	OPKW2			; SECTIONS OF OPERAND
	DEFW	OPKW3			; KEYWORD LIST.
OPKW1:	DEFB	'A'
	DEFB	77H
	DEFB	'B'
	DEFB	70H
	DEFB	'C'
	DEFB	71H
	DEFB	'D'
	DEFB	72H
	DEFB	'E'
	DEFB	73H
	DEFB	'H'
	DEFB	74H
	DEFB	'L'
	DEFB	75H
	DEFB	'Z'
	DEFB	89H
	DEFB	'P'
	DEFB	8EH
	DEFB	'M'
	DEFB	8FH
	DEFB	'I'
	DEFB	20H
	DEFB	'R'
	DEFB	21H
	DEFB	00H
OPKW2:	DEFM	'AF'
	DEFB	17H
	DEFM	'BC'
	DEFB	10H
	DEFM	'DE'
	DEFB	11H
	DEFM	'HL'
	DEFB	12H
	DEFM	'SP'
	DEFB	13H
	DEFM	'IX'
	DEFB	1AH
	DEFM	'IY'
	DEFB	1EH
	DEFM	'NC'
	DEFB	8AH
	DEFM	'NZ'
	DEFB	88H
	DEFM	'PE'
	DEFB	8DH
	DEFM	'PO'
	DEFB	8CH
	DEFB	00H
OPKW3:	DEFM	'AF'''
	DEFB	0E0H
	DEFB	00H
;*********************************************************************
;BRACKETABLE OPERAND LIST.
;*********************************************************************
BKLST:	DEFB	12H			; HL
	DEFB	40H			; (HL)
	DEFB	1AH			; IX
	DEFB	48H			; (IX)
	DEFB	1EH			; IY
	DEFB	4CH			; (IY)
	DEFB	13H			; SP
	DEFB	50H			; (SP)
	DEFB	11H			; DE
	DEFB	61H			; (DE)
	DEFB	10H			; BC
	DEFB	60H			; (BC)
	DEFB	71H			; C
	DEFB	0A0H			; (C)
	DEFB	0CAH			; IX+D
	DEFB	0BAH			; (IX+D)
	DEFB	0CEH			; IY+D
	DEFB	0BEH			; (IY+D)
	DEFB	90H			; N
	DEFB	0D0H			; (N)
	DEFB	00H			; END OF LIST
;*********************************************************************
;MULTI-CHARACTER FUNCTION LIST.
;*********************************************************************
MFLSTP:	DEFW	MCF1
    	DEFW	MCF2
	DEFW	MCF3
	DEFW	MCF4
MCF1:	DEFB	0
MCF2:	DEFM	'OR'
	DEFB	7AH
	DEFM	'EQ'
	DEFB	89H
	DEFM	'GT'
	DEFB	91H
	DEFM	'LT'
	DEFB	99H
	DEFB	0
MCF3:	DEFM	'NOT'
	DEFB	17H
	DEFM	'LOW'
	DEFB	27H
	DEFM	'RES'
	DEFB	2EH
	DEFM	'MOD'
	DEFB	4DH
	DEFM	'SHR'
	DEFB	55H
	DEFM	'SHL'
	DEFB	5DH
	DEFM	'AND'
	DEFB	73H
	DEFM	'XOR'
	DEFB	82H
	DEFM	'UGT'
	DEFB	0A1H
	DEFM	'ULT'
	DEFB	0A9H
	DEFB	0
MCF4:	DEFM	'HIGH'
	DEFB	1FH
	DEFB	0
;***********************************************************************
;SINGLE CHAR FUNCTION LIST.
;***********************************************************************
SFLSTP:	DEFW	SCF1			; POINTER TO LIST
SCF1:	DEFM	'+'
	DEFB	7H
	DEFM	'-'
	DEFB	0FH
	DEFM	'\'
	DEFB	17H
	DEFM	'*'
	DEFB	3DH
	DEFM	'/'
	DEFB	45H
	DEFM	'&'
	DEFB	73H
	DEFM	'^'
	DEFB	7AH
	DEFM	'='
	DEFB	89H
	DEFM	'>'
	DEFB	91H
	DEFM	'<'
	DEFB	99H
	DEFB	0
;
;******************************************************************
;	LINKAGES TO CP/M START HERE - J.P.J.  4/5/82
;******************************************************************
;
;
SRCFCB:	DEFB	0		;FCB STARTS WITH 0 FOR DEFAULT DRIVE
SRCFN:	DEFM	'        '	;RESERVE 8 CHARS FOR FILE NAME
	DEFM	'Z80'		;USE EXTENSION OF Z80
	DEFB	0		;START WITH EXTENT 0
	DEFS	23		;23 BYTES FOR CP/M
SRCPTR:	DEFS	2		;FOR CHARACTER POINTER
SRCOPN:	DEFM	'C'		;DECLARE CLOSED
;
LSTFCB:	DEFB	0		;LISTING FILE SETUP
LSTFN:	DEFM	'        '
	DEFM	'PRN'		;PRINT FILE
	DEFB	0		;EXTENT 0
	DEFS	23
LSTPTR:	DEFS	2
LSTOPN:	DEFM	'C'
;
HEXFCB:	DEFB	0		;SAME FOR HEX FILE
HEXFN: 	DEFM	'        '
	DEFM	'HEX'
	DEFB	0
	DEFS	23
HEXPTR:	DEFS	2
HEXOPN:	DEFM	'C'
;
MEMCK: 	LD A, (7H)		;GET HIGH ORDER BYTE OF BDOS ENTRY
	LD B,A			;XFER TO B
	LD A, (6H)		;LOW BYTE TO A
	RET
;
CONOUT:	PUSH 	BC		;NO REGISTERS MAY BE DESTROYED
	PUSH	DE
	PUSH	HL
OUT4:	LD A,C
	CALL	PUTCON
;
GENRET:	POP	HL		;GENERAL RETURN FOR ALL SUBR'S
	POP 	DE
	POP	BC
	RET
;
;
OPNOUT:	PUSH	DE		;OPEN (DE) FCB FOR OUTPUT
	LD C,DELFIL		;FIRST DELETE CURRENT
	CALL	CPM
	POP	DE
	LD C,MAKFIL		;THEN RE-CREATE
	JP	CPM
;
CONIN:	PUSH	BC		;CONSOLE INP IS ONLY COMMON
	PUSH	DE		; POINT FOR ALL PASSES SO DO
	PUSH	HL		; SETUP HERE
;
	LD A,(SRCOPN)		;IS SRC OPEN?
	CP 'O'
	CALL NZ,CPYFCB		;IF NOT, CREATE FCB'S
	LD HL,(NXTPAS)		;POINT TO PASS SEQUENCE
	LD A,(HL)		;GET NEXT PASS NUMBER
	INC HL			;UPDATE POINTER
	LD (NXTPAS),HL		;SAVE POINTER
	PUSH	AF
;
	CP 'Q'			;QUIT ?
	CALL Z,FLUSH		;YES,FLUSH BUFFERS
	POP	AF
	PUSH	AF
;
	CP '1'			;PASS 1?
	JR Z,PAS1  
	CP '2'			;PASS 2?
	JP Z,PAS2  
	CP '3'			;PASS 3?
	JP Z,PAS3  
	CP '4'			;PASS 4 USES CONSOLE OUTPUT 
	JR Z,PAS1  
INPRET:	POP	AF		;IF NONE OF ABOVE,EXIT
	JR	GENRET  
;
NXTPAS:	DEFW	SEQNO		;SEQUENCE # POINTER
SEQNO:	DEFM	'1423Q'		;DEFAULT SEQUENCE
CPYFCB: LD HL,DFCB+9		;POINT TO FILE EXTENSION
	LD DE,SEQNO+2		;POINT TO PASS 2 FLAG
	LD A,(HL)		;GET DRIVE/SKIP FLAG FOR LST
	CP	'N'
	JR Z,CPYF1		;IF N,SKIP THE SRC LIST
	CP 	'B'		;PUT ON DRIVE B?
	JR NZ,DOIT		;NO,PUT LISTING ON DRIVE A
	LD A,  2		;B IS DRIVE 2
	LD (LSTFCB),A		;SET DRIVE BYTE TO 'B'
	JR DOIT
CPYF1:	LD (DE),A		;SKIP IT
DOIT:	INC HL			;POINT TO HEX SWITCH
	INC DE			;POINT TO PASS 3 FLAG
	LD A,(HL)		;GET DRIVE/SKIP FOR HEX
	CP 'N'			;SKIP?
	JR Z,CPYF2		;IF Z,SKIP
	CP 'B'			;PUT ON DRIVE B?
	JR NZ,COPYIT		;IF NOT 'B' NO
	LD A,2			;B IS DRIVE 2
	LD (HEXFCB),A
	JR	COPYIT
CPYF2:	LD (DE),A		;DON'T DO IT
COPYIT:	LD BC,8H		;SETUP FOR LDIR
;
	LD DE,SRCFN		;DESTINATION
	PUSH	BC
	CALL	MOVFCB
;
	LD DE,LSTFN
	POP	BC
	PUSH	BC
	CALL	MOVFCB
;
	LD DE,HEXFN
	POP	BC
;
MOVFCB:	LD HL,DFCB+1		;FILE NAME STARTS IN POS 1
	LDIR
	RET
;
PAS1:	XOR A			;MAKE SURE OPEN FIRST 
	LD (SRCFCB+12),A 	; EXTENT
	LD DE,SRCFCB
	LD C,OPNFIL
	CALL 	CPM
	CP 0FFH			;SUCESSFUL?
	JR Z,NOSRC  		; NO,LET US KNOW
	LD A,'O'		; DECLARE OPEN
	LD (SRCOPN),A
	XOR A			;FIRST RECORD IS #0
	LD (SRCFCB+32),A
	LD HL,SRCBUF+1024
	LD (SRCPTR),HL
	JR	INPRET  
;
NOSRC:	LD DE,NFMSG		;NO FILE MESSAGE
ERROUT:	LD C,PRBUF		;PRINT STRING FUNCTION
	CALL 	CPM
	CALL	GETCON		;WAIT FOR KEYSTROKE TO EXIT
	JP	BOOT
;
NFMSG:	DEFB	CR
	DEFB	LF
	DEFM	'NO SOURCE FILE FOUND'
	DEFB	CR
	DEFB	LF
	DEFM	'$'
;
PAS2:	LD A,(HEXOPN)		;HEX FILE OPEN FROM PREV?
	CP 'O'
	CALL Z,FLUSH		;YES,FLUSH AND CLOSE
;
	LD DE,LSTFCB		;OPEN LISTING FILE
	CALL	OPNOUT
	CP 0FFH			;SUCESSFUL?
	JR Z,DSKERR  	;NO,ERROR MSG
	LD A,'O'
	LD (LSTOPN),A		;DECLARE OPEN
	XOR A			;START WITH RECORD 0
	LD (LSTFCB+32),A
	LD HL,LSTBUF		;DECLARE EMPTY
	LD (LSTPTR),HL
	JR	PAS1  		;GO OPEN SRC
;
DSKERR:	LD DE,ERRMSG
	JR	ERROUT  	;GOTO ERROR OUTPUT RTN
;
ERRMSG:	DEFB	CR
	DEFB	LF
	DEFM	'DISK ERROR,ASSEMBLY ABORTED'
	DEFB	CR
	DEFB	LF
	DEFM	'$'
;
PAS3:	LD A,(LSTOPN)		;LIST STILL OPEN?
	CP 'O'
	CALL Z,FLUSH		;YES,FLUSH AND CLOSE
	LD DE,HEXFCB
	CALL	OPNOUT		;OPEN HEX FILE FOR OUTPUT
	CP 0FFH			;SUCESS?
	JR Z,DSKERR  	;NO,ABORT
;
	LD A,'O'
	LD (HEXOPN),A		;DECLARE OPEN
	XOR A
	LD (HEXFCB+32),A
	LD HL,HEXBUF 		;DECLARE EMPTY
	LD (HEXPTR),HL
	JP	PAS1  		;GO OPEN SRC
;
FLUSH:	LD A,(HEXOPN)		;HEX FILE OPEN?
	CP 'O'			; IF O,YES
	JR Z,HEXFL  
;
	LD A,(LSTOPN)		;LIST FILE OPEN?
	CP 'O'			; IF O,YES
	RET NZ			; NO OPEN OUTPUT FILES,EXIT
;
	LD DE,LSTBUF		;DE POINTS TO START
	LD HL,(LSTPTR)		;HL POINTS TO CURRENT CHAR
	LD BC,LSTFCB		;NEED FCB PTR FOR CP/M
	JR	MTBUF  
;
HEXFL:	LD DE,HEXBUF		;COMMENTS AS FOR LST FILE
	LD HL,(HEXPTR)
	LD BC,HEXFCB
;
MTBUF:	LD A,L			;FIND IF ON RECORD BOUNDARY
	AND 127
	JR Z,MTBUF2  	;IF Z,YES
	LD (HL),CTLZ		;PUT ^Z AS EOF MARK
;
MTBUF2:	PUSH	BC		;SAVE FCB PTR
	OR A			;CLEAR CARRY
	SBC HL,DE		;CALC # BYTES IN BUFFER
	JR NZ,AREREC  	;IF NZ,ARE RECORDS TO WRITE
	POP BC			;ELSE EXIT
	RET
;
AREREC:	LD B,7			;B = SHIFT COUNTER
DIV128:	SRL H			; BYTES/128 = # RECORDS
	RR  L
	DJNZ	DIV128  	;LOOP TIL DONE
;
	LD B,L			;B = # RECORDS
	OR A			;FIND IF EVEN RECORD AGAIN
	JR Z,EVNREC  
;
	INC B			;DON'T WANT TO LOSE PARTIAL
EVNREC:	EX DE,HL		;HL = BUFFER POINTER
	POP	DE		;DE = FCB POINTER
;
	CALL	FLBUF		;WRITE BUFFER TO DISK
	LD C,CLSFIL		;CLOSE FUNCTION
	PUSH	DE
	CALL	CPM
	POP	DE
	LD HL,38		;(DE+38) = FILE OPEN FLAG
	ADD HL,DE
	LD (HL),'C'		;DECLARE CLOSED
	RET
;
FLBUF:	PUSH	BC		;B=#RECS,C=CHAR
	PUSH	HL		;HL=BUFFER POINTER
	PUSH	DE		;DE=FCB PTR
;
	EX DE,HL		;DE NOW = BUFFER PTR
	LD C,SETDMA
	CALL	CPM		;DMA NOW = BUFFER
;
	POP	DE		;GET FCB PTR BACK
	PUSH	DE
	LD C,WRNR		;WRITE NEXT REC FUNCTION
	CALL	CPM
;
	OR A			;SET FLAGS
	JP NZ,DSKERR
;
	POP	DE
	POP	HL
	POP	BC
;
	DEC B
	RET Z			;IF Z,ALL RECORDS WRITTEN
;
	LD A,L
	ADD A,128		;UPDATE DATA POINTER
	LD L,A
	JR NC,FLBUF  
	INC H
	JR	FLBUF  
;
PCHOUT:	PUSH	BC
	PUSH	DE
	PUSH	HL
	LD HL,(HEXPTR)		;BUFFER POINTER
	LD A,H			;GET HIGH ORDER
	CP (HEXBUF+1025)/256   	;FULL?
	JR Z,DMPHEX  	;IF Z,BUFFER FULL
;
HEXCHR:	LD (HL),C
	INC HL			;NOT FULL,JUST STORE CHAR
	LD (HEXPTR),HL
	JP	GENRET
;
DMPHEX:	PUSH	BC		;SAVE CHAR
	LD B,8			;8 RECORD BUFFER
	LD HL,HEXBUF		;SETUP FOR FLBUF
	LD DE,HEXFCB
	CALL	FLBUF
;
	POP	BC		;GET CHAR BACK
	LD HL,HEXBUF		;START AT BEGINNING AGAIN
	JR	HEXCHR  
;
LSTO:	PUSH	BC
	PUSH	DE
	PUSH	HL
	LD A,(PASSNO)		;GET CURRENT PASS
	CP 4			;IS IT PASS 4 ?
	JP Z,OUT4		;IF YES,OUTPUT TO CONSOLE
	LD HL,(LSTPTR)		;NO,OUTPUT TO .PRN
	LD A,H
	CP (LSTBUF+1025)/256	;FULL?
	JR Z,DMPLST  	;YES,FLUSH
;
LSTCHR:	LD (HL),C		;STORE CHAR IN I/O BUFFER
	INC HL			;UPDATE POINTER
	LD (LSTPTR),HL
	JP	GENRET
;
DMPLST:	PUSH	BC
	LD B,8			;BUFFER = 8 RECORDS
	LD HL,LSTBUF		;START AT BEGINNING
	LD DE,LSTFCB		;FCB FOR CP/M
	CALL	FLBUF
;
	POP	BC		;GET THIS OUTPUT CHAR BACK
	LD HL,LSTBUF		;RESTART AT BEGINNING
	JR	LSTCHR  
;
RDRIN:	PUSH	BC
	PUSH	DE
	PUSH	HL
	LD HL,(SRCPTR)		;GET SRC POINTER
	LD A,H
	CP (SRCBUF+1025)/256 	;PAST END? 
	JR Z,SRCRD  		;YES,GO GET MORE
;
NXTCHR:	LD A,(HL)		;GET CHAR
	INC HL
	LD (SRCPTR),HL		;SAVE POINTER
	JP	GENRET
;
SRCRD:	LD BC,0880H		;B=#RECS,C=BYTES/REC
	LD DE,SRCBUF		;DESTINATION
;
NXTREC:	PUSH	DE
	PUSH	BC
	LD C,SETDMA
	CALL	CPM
;
	LD DE,SRCFCB
	LD C,RDNR		;READ NEXT RECORD
	CALL	CPM
;
	POP	BC
	POP	DE
	CP 1			;1 MEANS FILE DONE
	JR Z,SRCDON  
;
	LD A,E			;UPDATE DESTINATION
	ADD A,C
	LD E,A
	JR NC,DOK  
	INC D
DOK:	DEC B			;DONE 8 RECORDS?
	JR NZ,NXTREC  	;NO,CONTINUE
;
SRCDON:	LD HL,SRCBUF		;START AT BEGINNING
	JR	NXTCHR  
;
;
;
;**********************************************************************
;RAM STORAGE AREA.
;**********************************************************************
MEMTOP:	DEFS	2			; HIGHEST AVAILABLE RAM LOC. ADDR
PASSNO:	DEFS	1			; PASS NUMBER
LINPNT:	DEFS	2			; POINTER TO LINE BUFFER
LINBUF:	DEFS	LBFSZ			; LINE BUFFER
LABBUF:	DEFS	7			; LABEL BUFFER
SYMBUF:	DEFS	10			; SYMBOL BUFFER
PAGE:	DEFS	2			; PAGE NO. (BCD)
LINE:	DEFS	1			; LINE NUMBER
ERRBUF:	DEFS	1			; ERROR INDICATOR BUFFER
ADREFC:	DEFS	2			; ADDRESS REFERENCE COUNTER
ADDISR:	DEFS	2			; ADDRESS DISPLAY REGISTER
ASCDNO:	DEFS	1			; NO. OF BYTES OF ASSEMBLED CODE
ASSCOD:	DEFS	ACBSIZ			; ASSEMBLED CODE BUFFER
TITBUF:	DEFS	TITSIZ+1		; TITLE BUFFER
SYMEND:	DEFS	2			; POINTER TO END OF SYMBOL TABLE
ORTKBF:	DEFS	2			; OPERATOR TOKEN BUFFER
TEMP:	DEFS	2			; DUMMY LOCATION
ODBT1:	DEFS	1			; OPERAND-1 TOKEN BUFFER
ODBT2:	DEFS	1			; OPERAND-2 TOKEN BUFFER
ODINT1:	DEFS	2			; OPERAND-1 VALUE
ODINT2:	DEFS	2			; OPERAND-2 VALUE
AFLAGS:	DEFS	1			; ASSEMBLY FLAGS
					; BIT 0 - ADDR DISCONT. FLAG
					; BIT 1 - END FLAG
					; BIT 2 - SYMB TABLE O/F FLAG
OBJCNT:	DEFS	1			; NO OF BYTES IN OBJ BUFF
RECADR:	DEFS	2			; TARGET ADDR OF 1ST BYTE OF RECORD
STADDR:	DEFS	2			; START ADDR BUFFER FOR 'END' OPD
OBJBUF:	DEFS	RECSIZ			; OBJECT CODE BUFFER
FTOKR:	DEFS	1			; FUNCTION TOKEN REGISTER
FCNT:	DEFS	1			; FUNCTION STACK COUNTER
FSTK:	DEFS	MAXFSK			; START OF FUNCTION STACK
ARCNT:	DEFS	1			; ARITHMETIC STACK COUNTER
ARSTK:	DEFS	MAXASK			; ARITHMETIC STACK
	DEFS	STKSIZ
STACK:	DEFS	0			; STACK FROM HERE BACK ^
;
	ORG	1F00H			; MUST START ON PAGE BOUNDARY
;
SRCBUF:	DEFS	1024
LSTBUF:	DEFS	1024
HEXBUF:	DEFS	1024
;
SYMTAB:	DEFS	0			; SYMBOL TABLE HERE TO MEMTOP

	END

DARY
;
SRCBUF:	DEFS	1024
LSTBUF:	DEFS	1024
HEXBUF:	DEFS	1024
;
SYMTAB:	DEFS	0			; SYM