;-----------------------------------------------;
;	Z80 RESIDENT ASSEMBLER			;
;-----------------------------------------------;
;						;
;(C) 1977 LEHMAN CONSULTING SERVICES		;
;	ALL RIGHTS RESERVED			;
;						;
;-----------------------------------------------;
;						;
;	SUBROUTINE PACKAGE			;
;						;
;-----------------------------------------------;
;						;
;	REV 0	14-JULY-77	MGL		;
;						;
;-----------------------------------------------;
;
;	EJECT
;-----------------------------------------------;
;						;
;	CPMUTIL COMMUNICATIONS AREA		;
;						;
;-----------------------------------------------;
;
	ORG	103H
;
;	JUMP TABLE EQUATES
;
WLINE	DS	3	;WRITE PRINTER LINE
WMSG	DS	3	;WRITE CONSOLE MSG
DSKSEL	DS	3	;SELECT DISK
OPNFIL	DS	3	;OPEN FILE
CLSFIL	DS	3	;CLOSE FILE
DELFIL	DS	3	;DELETE FILE
DREAD	DS	3	;DISK READ
DWRITE	DS	3	;DISK WRITE
CREFIL	DS	3	;CREATE FILE
DMASET	DS	3	;SET DMA ADDRESS
MOVE	DS	3	;MOVE BYTES
CMPCHR	DS	3	;COMPARE CHARACTERS
CMPHD	DS	3	;COMPARE HL:DE
MUL16	DS	3	;HL <= HL * DE
GNB	DS	3	;GET NEXT BYTE (1K BLOCKING)
WNB	DS	3	;WRITE NEXT BYTE
GNB2	DS	3	;GET NEXT BYTE (FCB2)
WNB2	DS	3	;WRITE NEXT BYTE (FCB2)
CNV2HX	DS	3	;CONVERT TO HEX - BUF => HL REG
;
;
FCB1	DS	33
FCB2	DS	33
IBP	DS	2
IBP2	DS	1
OBP	DS	1
OBP2	DS	1
IBUF	DS	2
OBUF	DS	2
IBUF2	DS	2
OBUF2	DS	2
INBUF	DS	1024
OUTBUF	DS	128
INBUF2	DS	128
OUTBF2	DS	128
;
;	EJECT
;-----------------------------------------------;
;	COMMON DATA AREA (CDA)			;
;-----------------------------------------------;
;
	ORG	980H	;LEAVE SPACE FOR CPMUTIL
;
HDRBUF	DS	16	;MUST FOLLOW ORG
REC	DS	80	;MUST FOLLOW HDRBUF
PC	DS	2	;CURRENT PROGRAM COUNTER
OBJ	DS	32	;OBJECT CODE BUFFER
OBJCNT	DS	1	;LEN OF DATA IN OBJ
LEN	DS	1	;LEN OF CURRENT INSTRUCTION
VAL	DS	2	;RETURN FROM EVAL ROUTINE
INST	DS	80	;CURRENT INSTRUCTION (OR DATA FROM DB)
EOM	DB	0	;END OF BUFFER CHARACTER (FOR WLINE)
PTR1	DS	2	;POINTS TO NEXT CHAR IN REC
PASSNO	DS	1	;CURRENT PASS  =0 PASS1   =FF PASS2
IDBUF	DS	16	;CURRENT ID
INTBUF	DS	2	;RETURNED VALUE FROM INT ROUTINE
CURLNE	DS	1	;CURRENT LINE NUMBER FOR PAGING OUTPUT
LEN2	DS	2	;FOR DEFS
LBLADR	DS	2	;LAST LBL ADDR IN SYM (FOR EQU)
EQUFLG	DS	1	;IF NON-ZERO EQUVAL IS USED INSTEAD OF PC FOR PRINT
EQUVAL	DS	2	;VALUE OF LAST EQU
ENDADR	DS	2	;EXPRESSION VALUE ON END STATEMENT
EFLG	DS	1	;END OF PROGRAM FLAG (TO ALLOW PRINTING OF END STMT)
OPCODE	DS	2	;CURRENT OPCODE FROM SYMBOL TABLE
SAVVAL	DS	2	;SAVED CONTENTS OF VAL
LFLAG	DS	1	;LISTING FLAG =N NO LISTING, =' ' OR 'Y' LISTING
HFLAG	DS	1	;HEX OBJ FLAG =N NO HEX OBJ, =' ' OR 'Y' HEX OBJ OUTPUT
ERRFLG	DS	1	;ERROR CHARACTER FOR THIS LINE
TEMP	DS	2	;TEMP 2 BYTE AREA
MULT	DS	2	;BASE OF NUMBER IN INT CONVERT LOOP
SYMPTR	DS	2	;ADDRESS OF NEXT SYMBOL TABLE ENTRY
SYMPT	DS	2	;ADDRESS OF BEGINING OF SYMBOL TABLE
UFLAG	DS	1	;UNDEFINED FLAG FROM EVAL, =0 ALL OK, =1 >1 UNDEFINED
EVFLGS	DS	1	;FLAG FIELD FROM LAST SYMLUK
;
;	EJECT
;
;	JUMP TABLE FOR ROUTINES IN THIS ASSEMBLY
;
	JMP	EVAL
	JMP	ID
	JMP	INT
	JMP	SETUP	;INIT FILES FOR ASSEMBLER
	JMP	SYMENT
	JMP	SYMLUK
	JMP	GNR	;GET NEXT RECORD
	JMP	GNC	;GET NEXT CHARACTER
	JMP	BACKUP	;BACKUP TO LAST CHARACTER
;
;	EJECT
;
;
;	EXPRESSION EVALUATOR
;
;	VALID OPERATORS ARE: +, - AND *
;
;	VALID ELEMENTS ARE: ID'S, NUMBERS, AND '$' FOR PC
;
;
EVAL	EQU	$
	MVI A,0	! STA OP ! STA UFLAG ;DEFAULT OP TO +, UFLAG=0
	STA EVFLGS	;RESET FLAGS FROM LAST SEARCH
	LXI H,0	! SHLD VAL ;SET VAL TO 0000
EVAL1	EQU	$
	CALL	GNC	;GET NEXT ELEMENT OR OPERATOR
	CPI '0'	! JC EVAL3 ! CPI '9'+1 ! JC EVAL9 ;BRANCH IF NUMBER
EVAL3	EQU	$
	CPI '$'	! JZ EVAL11 ;BRANCH IF PC REF
	CPI 'A'	! JC EVAL5 ! CPI 'Z'+1 ! JC EVAL13 ;BRANCH IF ID
EVAL5	EQU	$
	CPI '+'	! JZ EVAL22
	CPI '-'	! JZ EVAL24
	CPI '*'	! JZ EVAL26
	CPI 27H	! JZ EVAL29	;PROCESS SINGLE BYTE QUOTED STRING
	RET		;GET OUT OF HERE WE ARE DONE
;
;	PROCESS NUMBER
;
EVAL9	EQU	$
	CALL BACKUP ! CALL INT ! JMP EVAL28
;
;
;	PROCESS '$' REF
;
EVAL11	EQU	$
	LHLD PC	! SHLD INTBUF !	JMP EVAL28
;
;
;	PROCESS ID
;
;
EVAL13	EQU	$
	CALL BACKUP ! CALL ID
	CALL BACKUP ;BACKUP SO AS TO NOT IGNORE OPERATOR OR COMMA
	LXI H,IDBUF ! CALL SYMLUK ! JNZ	EVAL19 ;BRANCH IF UNDEFINED
	MOV A,M	! STA INTBUF ! INX H ! MOV A,M ! STA INTBUF+1 !	JMP EVAL28
EVAL19	EQU	$	;PROCESS UNDEFINED ID
	LXI H,0	! SHLD INTBUF ;SET VALUE TO 0000
	LDA UFLAG ! ORI	1 ! STA	UFLAG ;SET UNDEFINED FLAG
	JMP EVAL28
;
;	PROCESS OPERATORS
;
EVAL22	EQU	$
	MVI A,0	! JMP EVAL27
;
EVAL24	EQU	$
	MVI A,1	! JMP EVAL27
;
EVAL26	EQU	$
	MVI A,2
EVAL27	EQU	$
	STA OP
	JMP EVAL1
;
;
;	PROCESS VALUE USING CURRENT OPERATOR
;
;
EVAL28	EQU	$	;VAL = VAL OP INTBUF
	LDA OP
	CPI 1 !	JZ EVAL28A ;BRANCH IF SUBTRACT
	CPI 2 !	JZ EVAL28B ;BRANCH IF MULTIPLY
	LHLD VAL ! XCHG	! LHLD INTBUF !	DAD D !	SHLD VAL ;+
	JMP EVAL1
;
EVAL28A	EQU	$	;SUBTRACT
	LHLD VAL ! XCHG	! LHLD INTBUF
	MOV A,E	! SUB L	! MOV L,A ! MOV	A,D ! SBB H ! MOV H,A !	SHLD VAL
	JMP EVAL1
;
EVAL28B	EQU	$	;MULTIPLY
	LHLD VAL ! XCHG	! LHLD INTBUF !	CALL MUL16 ! SHLD VAL
	JMP EVAL1
;
;
;	PROCESS SINGLE BYTE IN QUOTES
;
EVAL29	EQU	$
	CALL GNC ;GET CHARACTER
	STA INTBUF ! XRA A ! STA INTBUF+1 ;FAKE 2 BYTE VALUE
	CALL GNC ;BYPASS TRAILING QUOTE
	JMP EVAL28	;AND GO PROCESS VALUE NORMALLY
;
;
OP	DS	1	;CURRENT OPERATOR FOR EVAL
;
;	EJECT
;
;
;	ID - COLLECT ID AND PLACE IN IDBUF
;
ID	EQU	$
	PUSH H ! PUSH D	! PUSH B ;SAVE REGS
	MVI A,' ' ! STA	IDBUF
	LXI H,IDBUF+1 !	LXI D,IDBUF ! LXI B,15 ! CALL MOVE ;BLANK IDBUF
	LXI H,IDBUF
	CALL GNC
ID2	EQU	$
	CPI 'A'	! JC ID1 ! CPI 'Z'+1 ! JNC ID1 ;IF NOT A LETTER THEN BRANCH
ID3	MOV M,A	! INX H
	PUSH H ! LHLD PTR1 ! MOV A,M ! INX H ! SHLD PTR1 ! POP H
	JMP ID2
;
ID1	CPI '.'	! JZ ID3 ; ALLLOW LABELS WITH '.' IN THEM (E.G.  LAB.01)
	CPI '$'	! JZ ID2 ; ALLOW $ FILLERS (E.G.  SQR$ROOT)
	CPI '0'	! JC ID4 ! CPI '9'+1 ! JC ID3 ;ALLOW DIGITS
ID4	POP B !	POP D !	POP H
	RET
;
;	EJECT
;
;
;	INT - CONVERT CHARACTERS TO BINARY
;
;	ALLOW TRAILING 'H' FOR HEX AND 'B' FOR BINARY
;	DEFAULT TYPE IS DECIMAL (BASE 10)
;
INT	EQU	$
	LHLD PTR1 ! SHLD TEMP  ;SAVE POINTER
	LXI H,10 ! SHLD	MULT ;SET DEFAULT BASE TO 10
	MVI B,0	;SET UP LENGTH COUNTER
	CALL GNC	;SKIP BLANKS
INT1	EQU	$
	CPI '+'	! JZ INT1A ;BRANCH IF A TERMINATOR
	CPI '-'	! JZ INT1A
	CPI '*'	! JZ INT1A
	CPI 0DH	! JZ INT1A
	CPI ';'	! JZ INT1A
	CPI ')'	! JZ INT1A
	CPI ','	! JZ INT1A
	CPI 20H	! JZ INT1A
	LHLD PTR1 ! MOV	A,M ! INX H ! SHLD PTR1	;GET NEXT CHARACTER
	INR B !	JMP INT1 ;INCREMENT COUNTER AND CONTINUE LOOP
INT1A	EQU	$
	DCX H !	SHLD PTR1 ! DCX	H ! MOV	A,M
INT2	CPI 'H'	! JNZ INT3 ;BRANCH IF NOT HEX
	DCR B	;DECREMENT COUNTER
	LXI H,16 ! SHLD	MULT ;SET UP BASE 16
	JMP INT4
;
INT3	CPI 'B'	! JNZ INT4 ;BRANCH IF NOT BINARY
	DCR B		;DECREMENT COUNTER
	LXI H,2	! SHLD MULT  ;SET UP BASE 2
INT4	LHLD PTR1 ! XCHG ! LHLD	TEMP ! SHLD PTR1 ! XCHG	! SHLD TEMP ;SAVE PTR
	LXI D,0	;SET UP ACCUMULATOR
	CALL GNC ! CALL	BACKUP
INT5	EQU	$
	LHLD PTR1 ! MOV	A,M
	INX H !	SHLD PTR1
	CPI 'A'	! JC $+5 ! ADI 9 ;FOR A-F
	ANI 0FH	! PUSH PSW ;GET BINARY VALUE OF THIS DIGIT
	PUSH B	;SAVE COUNTER
	LHLD MULT ! CALL MUL16
	POP B	;RESTORE COUNTER
	POP PSW	! MOV E,A ! MVI	D,0 ! DAD D ;ADD IN NEW DIGIT
	XCHG ! DCR B ! JNZ INT5	;GO BACK IF MORE TO DO
INT6	LHLD TEMP ! SHLD PTR1
	XCHG ! SHLD INTBUF ;SAVE VALUE
	RET
;
;	EJECT
;
;	SETUP - SET UP FILES FOR Z80ASM
;
;	INPUT FROM CONSOLE IS FILENAME.AB
;
;	A= Y OR N FOR LISTING
;	B= Y OR N FOR HEX FILE
;
SETUP	EQU	$
	LXI H,FCB1 ! LXI D,5CH ! LXI B,33 ! CALL MOVE ;GET DEFAULT FCB
	LXI H,FCB1+9 ! LXI D,ASMEXT ! LXI B,3 !	CALL MOVE ;SET UP EXTENSION
	LXI H,FCB2 ! LXI D,5CH ! LXI B,33 ! CALL MOVE ;GET DEFAULT FCB
	LXI H,FCB2+9 ! LXI D,HEXEXT ! LXI B,3 !	CALL MOVE ;SET UP EXTENSION
	LDA 5CH+9 ! STA	LFLAG ;SET UP LISTING FLAG
	LDA 5CH+10 ! STA HFLAG ;SET UP HEX FLAG
	LXI D,FCB1 ! CALL OPNFIL ! JZ SETER1 ;BRANCH IF SOURCE FILE NOT FOUND
	LDA HFLAG ! CPI	'N' ! JZ SETUP1	;BRANCH IF NO HEX FILE SETUP
	LXI D,FCB2 ! CALL DELFIL ;DELETE FILE
	LXI D,FCB2 ! CALL CREFIL ! JZ SETER2 ;BRANCH IF UNABLE TO CREATE
	LXI D,FCB2 ! CALL OPNFIL ! JZ SETER2 ;BRANCH IF UNABLE TO OPEN
SETUP1	EQU	$
	LXI H,INBUF+1024 ! SHLD	IBP ! XRA A ! STA OBP2 ;SET UP POINTERS
	RET ;AND GET OUT OF HERE
;
SETER1	LXI D,SM1 ! CALL WMSG !	JMP 0 ;MSG AND REBOOT
;
SETER2	LXI D,SM2 ! CALL WMSG !	JMP 0 ;MSG AND REBOOT
;
SM1	DB	13,10,'SOURCE (.ASM) FILE NOT FOUND',13,10,'$'
;
SM2	DB	13,10,'UNABLE TO CREATE/OPEN OBJECT (.HEX) FILE',13,10,'$'
;
ASMEXT	DB	'ASM'
HEXEXT	DB	'HEX'
;
;	EJECT
;
;	SYMENT - ENTER A SYMBOL INTO THE SYMBOL TABLE
;
;	UPON ENTRY HL POINTS TO NEW ENTRY
;
;	ENTRY FORMAT:	FLAGS/LENGTH (EACH 4 BITS)
;			N A M E ...  (UP TO 11 BYTES)
;			VALUE LOW    (1 BYTE)
;			VALUE HIGH   (1 BYTE)
;			TYPE BYTE    (1 BYTE)
;
;	ON RETURN HL POINTS TO VALUE LOW BYTE IN NEW ENTRY FOR POSSIBLE
;	FURTHER UPDATE (USED BY EQU PSEUDO OPERATOR)
;
;
SYMENT	EQU	$
	MOV A,M	! PUSH B ! XCHG	! ANI 0FH ! MOV	C,A ! MVI B,0 ;GET LEN
	LHLD SYMPTR ! CALL MOVE	;MOVE INTO SYMBOL TABLE
	SHLD SYMPTR ! MVI M,0 ; SET UP NEW POINTER AND NEW END MARKER
	DCX H !	DCX H !	DCX H ;BACKUP TO POINT TO VALUE LOW FIELD
	POP B
	RET
;
;	EJECT
;
;
;	SYMLUK - LOOK UP SYMBOLS IN TABLE
;
;	ON RETURN Z=0 MEANS SYMBOL NOT FOUND.
;		  Z=1 SYMBOL FOUND, HL POINTS TO VALUE LOW BYTE IN TABLE ENTRY
;
;
SYMLUK	EQU	$
	XCHG
	LHLD SYMPT ;GET POINTER TO BEGINING OF TABLE
	XCHG
SYML1	LDAX D ! CPI 0 ! JZ SYMNF ;BRANCH IF END OF TABLE
	STA EVFLGS ;SAVE FOR MAIN PROCESSOR
	ANI 0FH	! SUI 4	! MOV B,A ! INX	D ;SET UP FOR COMPARE
	CALL CMPCHR ! JZ SYML2 ;BRANCH IF MATCH
	DCX D	;BACK UP LENGTH BYTE AGAIN
SYML3	EQU	$
	LDAX D ! ANI 0FH ! MOV C,A ! MVI B,0 ! XCHG ! DAD B ! XCHG
	JMP SYML1 ;ADVANCE POINTER AND CONTINUE TO LOOP
;
SYML2	EQU	$	;NOW SEE IF EXACT MATCH
	DCX D !	LDAX D ! ANI 0FH ! SUI 4  ;GET LENGTH
	PUSH H ! MOV C,A ! MVI B,0 ! DAD B ! MOV A,M
	CPI ' '	! POP H	! JNZ SYML3 ;IF NXT CHR NOT BLANK THEN NOT EXACT MATCH
	LDAX D ! ANI 0FH ! DCR A ! DCR A ! DCR A ! MOV C,A ! MVI B,0
	XCHG ! DAD B ! XRA A ! RET ;POINT TO VALUE LOW AND EXIT
;
SYMNF	XRA A !	INR A !	RET ;SET Z=0 AND RETURN
;
;	EJECT
;
;	GNR - GET NEXT RECORD - FILL REC UNTIL 0AH OR 1AH (CTRL/Z) IS FOUND
;
GNR	LXI H,REC ! SHLD PTR1 ;RESET POINTER
	MVI M,' ' ! XCHG ! LXI H,REC+1 ! LXI B,79 ! CALL MOVE ;BLNK BUFFER
	LXI H,REC	;GET ADDRESS OF RECORD BACK AGAIN
GNR1	CALL GNB ! CPI 1AH ! RZ	;RETURN IF EOF MARKER (CTRL/Z) IF FOUND
	CPI 09H	! JZ GNR2	;BRANCH IF TAB CHARACTER
	MOV M,A	! INX H	! CPI 0AH ! JNZ	GNR1 ;BRANCH IF NOT LF
	RET
GNR2	EQU	$	;PROCESS TAB
	LXI D,8	! DAD D	! MOV A,L ! ANI	0F8H ! MOV L,A ;PROCESS TAB STOP
	JMP GNR1
;
;	EJECT
;
;
;	GNC - GET NEXT CHARACTER
;	USE PTR1 TO INDEX INTO REC, SKIP BLANKS
;
GNC	EQU	$
	PUSH H ! LHLD PTR1
	MOV A,M	! CPI ' ' ! INX	H ! JZ $-4 ;SKIP BLANKS
	CPI 09H	! JZ $-9 ;BRANCH IF TAB CHARACTER
	SHLD PTR1 ! POP	H
	RET
;
;
;	BACKUP - BACKUP PTR1 AND RETURN CHARACTER
;
;
BACKUP	PUSH H ! LHLD PTR1
	DCX H !	MOV A,M
	SHLD PTR1 ! POP	H
	RET
;
;	EJECT