;
; XLT80
; Translate ZILOG Z80 mnemonics to INTEL 8080 mnemonics
;
VERS	EQU	104
;
; See help messages below for info.
;
; Based on Richard Conn's XLATE2 which translates 8080
;  to Z80 mnemonics.
;
; Version 1.00 -- 10/28/84                Frank J. Zerilli
;
;	This version  will not split up unrecognized names
;	longer than 5 characters. It operates faster because
;	it uses larger buffers.  It handles long labels
;	properly.
;
;	It gives you the choice of converting instructions to
;	upper or lower case or to try to preserve the case
;	as much as possible.
;
;	This program will not translate Z80 intrinsic opcodes
;	(Z80 opcodes with no 8080 counterpart) but gives the
;	choice of flagging them and writing the line numbers
;	in which they are found to the output file. The omission
;	of the choice of translation of these intrinsic Z80
;	opcode mnemonics to TDL Z80 mnemonics was intentional,
;	since the program is envisioned as a tool to convert
;	Z80 programs to run on an 8080.
;

N00	EQU	0
N01	EQU	1
;
N07	EQU	7
N09	EQU	9	;tab every 8th col.
NF8	EQU	0F8H	;mod 8
;
LBUFLN	EQU	80	;line buffer length
OPBFLN	EQU	5	;opcode buffer length
MEMSIZ	EQU	4	;memory available in Kb
IBNUM	EQU	4*MEMSIZ
OBNUM	EQU	4*MEMSIZ
RECLEN	EQU	128	;
STCKLN	EQU	128	;stack size
IBFLEN	EQU	IBNUM*RECLEN
OBFLEN	EQU	OBNUM*RECLEN
;
CTRLC	EQU	3
EOT	EQU	4
BEL	EQU	7
HT	EQU	9
LF	EQU	0AH
CR	EQU	0DH
ESC	EQU	1BH
QUOTE	EQU	27H
;
ABORT	EQU	0000
BDOS	EQU	0005
DFCB1	EQU	005CH
DFCB2	EQU	006CH
;
FNLEN	EQU	8
EOS	EQU	EOT	; not used in this program
EOF	EQU	1AH
NFF	EQU	0FFH	; disk error return
;
; BDOS functions
;
nCIN	EQU	1
nCOUT	EQU	2
nCDAV	EQU	0BH
nOPEN	EQU	0FH
nCLOSE	EQU	10H
nDEL	EQU	13H
nRDNR	EQU	14H
nWRNR	EQU	15H
nCREAT	EQU	16H
nCDISK	EQU	19H
nDMA	EQU	1AH
;
	ORG	100H

	JMP	START
;
; flags
;
TCASFL:	DB	0	; 0 to preserve case
LCASFL:	DB	0	; 0 for upr case if TCASFL set
;
;  HELP MESSAGE
;
HMSG1:

 DB CR,LF
 DB CR,LF
 DB 'XLT80 translates Zilog Z80 assembly language source',CR,LF
 DB 'code into Intel 8080 assembly language source code.',CR,LF
 DB 'It is invoked by a command of the form:',CR,LF
 DB CR,LF
 DB '    XLT80 [d:]srcfile[.typ] [d:destfile.typ]',CR,LF
 DB CR,LF
 DB 'All parameters in brackets are optional, and,',CR,LF
 DB 'if omitted, the following values are assumed:',CR,LF
 DB CR,LF
 DB '   Source filetype       -- Z80',CR,LF
 DB '   Destination filetype  -- ASM',CR,LF
 DB '   Destination filename  -- same as source filename',CR,LF
 DB '   Drive                 -- current drive',CR,LF
 DB CR,LF
 DB 'Press any key to continue - ',0

HMSG2:

 DB CR,LF
 DB CR,LF
 DB 'Examples:',CR,LF
 DB CR,LF
 DB 'XLT80 PRGM1                {translates PRGM1.Z80 to PRGM1.ASM}',CR,LF
 DB 'XLT80 PRGM1 PRGM2          {translates PRGM1.Z80 to PRGM2.ASM}',CR,LF
 DB 'XLT80 PRGM1.MAC PRGM2.TXT  {translates PRGM1.MAC to PRGM2.TXT}',CR,LF
 DB CR,LF
 DB 'XLT80 also has the following features:',CR,LF
 DB CR,LF
 DB '  Case will be preserved as well as possible -- if an opcode has',CR,LF
 DB '  a lower case character, the translated opcode will be in lower',CR,LF
 DB '  case.',CR,LF
 DB CR,LF
 DB '  Asterisks at the beginning of lines will be replaced with',CR,LF
 DB '  semicolons.',CR,LF
 DB CR,LF
 DB '  User may choose to flag Z80 opcodes which do not have an 8080',CR,LF
 DB '  translation.',CR,LF
 DB CR,LF
 DB '  A dot is printed on the console for every 100 lines of input',CR,LF
 DB '  processed.',CR,LF
 DB CR,LF
 DB 0

;
; Program starts here.
;
START:
	LXI	H,0
	DAD	SP
	SHLD	SPBDOS

	LXI	SP,STACK

	LDA	DFCB1+1	; check for a file name
	CPI	' '	; print help if no name
	JNZ	BEGIN	; no help requested
	LXI	D,SIGNON
	CALL	PRTLIN
	LXI	D,HMSG1	; print help message
	CALL	PRTLIN
	MVI	C,nCIN	; wait for any character
	CALL	BDOS
	LXI	D,HMSG2	; print rest of help
	CALL	PRTLIN
	LHLD	SPBDOS	; retrieve system stack
	SPHL		;  pointer and pop
	RET		;  to PC

BEGIN:	CALL	HELLO	;signon, open in & out files
NXTLIN:	CALL	GETLIN	;get line from input file to buf
	CALL	PROCLIN	; process line
	JMP	NXTLIN

;*******************************************************
;
;	Print signon, open input
;	and output files.
;
HELLO:	LXI	D,SIGNON
	CALL	PRTLIN
HELLO0:	MVI	A,HT	; HT after opcode
	STA	PUTHT+1
	MVI	A,33	; tab comments to col 25
	STA	PUTND5+1
	XRA	A
	STA	TCASFL	; don't convert case
	STA	LCASFL	; reset lower case flag
	STA	JRJPFL	; don't trns JR to JMP
	STA	FLGSTR	; don't flag intrnsc Z80 opcodes
	MVI	A,0C9H
	STA	PUTUNK	; don't write their line nos.

	LXI	D,SPCMSG
	CALL	PRTLIN	; use space after
	CALL	CHKYES	; opcode ?
	CPI	ESC
	JZ	HELLO0
	CPI	CTRLC
	JZ	ABORT
	CPI	'Y'
	CZ	SETSPC

	LXI	D,COLMSG
	CALL	PRTLIN	;
	CALL	CHKYES	; start comment
	CPI	ESC
	JZ	HELLO0
	CPI	CTRLC
	JZ	ABORT
	CPI	'Y'
	CZ	SETCOL	; in column 33 ?

	LXI	D,JRJPMG
	CALL	PRTLIN	; translate JR
	CALL	CHKYES	;  to JMP ?
	CPI	ESC
	JZ	HELLO0
	CPI	CTRLC
	JZ	ABORT
	CPI	'Y'
	CZ	SETJRP

	LXI	D,FLGMSG
	CALL	PRTLIN	; flag intrinsic
	CALL	CHKYES	; Z80 opcodes ?
	CPI	ESC
	JZ	HELLO0
	CPI	CTRLC
	JZ	ABORT
	CPI	'Y'
	CZ	FLGZ80

	LXI	D,TRNMSG
	CALL	PRTLIN
	CALL	CHKYES
	CPI	ESC
	JZ	HELLO0
	CPI	CTRLC
	JZ	ABORT
	CPI	'L'
	CZ	SETLC
	CPI	'U'
	CZ	SETUC

	MVI	A,N01
	STA	COLNUM

	MVI	C,nCDISK
	CALL	BDOS
	INR	A
	STA	xCDISK

	CALL	MAKFNS

	CALL	OPENIN
	CALL	CREATO
	RET
;
SIGNON:	DB	'Z80-to-8080 Translator version '
	DB	VERS/100+'0','.',(VERS MOD 100)/10+'0'
	DB	(VERS MOD 10)+'0'
	DB	CR,LF,0

;
SPCMSG:	DB	'Use space (default TAB) after opcode ? '
	DB	'[Y/ret=N/esc/^C] ',0
;
SETSPC:	LXI	H,PUTHT+1
	MVI	A,' '
	MOV	M,A
	RET
;
COLMSG:	DB	'Start comment in column 33 (default 25) ? '
	DB	'[Y/ret=N/esc/^C] ',0
;
SETCOL:	LXI	H,PUTND5+1
	MVI	A,41
	MOV	M,A
	RET

;
JRJPMG:	DB	'Translate JR to absolute JMP ? '
	DB	'[Y/ret=N/esc/^C] ',0
;
SETJRP:	MVI	A,0FFH
	STA	JRJPFL
	RET

;
FLGMSG:	DB	'Flag intrinsic Z80 opcodes and write '
	DB	'line nos. to output file? '
	DB	'[Y/N/esc/^C] ',0
;
FLGZ80:
	MVI	A,'#'
	STA	FLGSTR
	MVI	A,21H	; LXI H,nn instruction
	STA	PUTUNK
	RET
;
TRNMSG:	DB	'Translate instructions to Upper/Lower '
	DB	'or preserve case ? '
	DB	'[U/L/ret/esc/^C] ',0
;
SETLC:	STA	TCASFL
	STA	LCASFL
	RET
;
SETUC:	STA	TCASFL
	RET

;*******************************************************
;
;	Gets line from input file to line
;	buffer until CR.  Filters out ctrl
;	chars except for HT.  Truncates
;	lines after LBUFLN chars.
;	Terminates line with CR, LF, 0.
;
GETLIN:	CALL	PDOT	; print activity dot
	CALL	CHKIN	; check for abort
	CPI	CTRLC
	JZ	JABORT
	XRA	A
	STA	QUOTFL
	STA	CMNTFL
	LXI	H,LBUFF	;line buffer
	MVI	B,LBUFLN ;max # of char
GETLN1:	XCHG
	LHLD	xIBUFF
	XCHG
	MOV	A,D
	CPI	(IBUFF+IBFLEN)/256
	JNZ	GETLN4
	MOV	A,E
	CPI	(IBUFF+IBFLEN) MOD 256

	JNZ	GETLN4

	PUSH	H
	PUSH	B
	LXI	D,IBUFF
GETLN2:	MVI	C,nDMA
	PUSH	D
	CALL	BDOS
	POP	D

	XCHG
	LXI	D,INFCB
	MVI	C,nRDNR
	PUSH	H
	CALL	BDOS
	POP	H
	DCR	A
	JNZ	GETLN3
	MVI	A,EOF
	MOV	M,A
GETLN3:	LXI	D,RECLEN
	DAD	D
	XCHG

	MOV	A,D
	CPI	(IBUFF+IBFLEN)/256
	JNZ	GETLN2
	MOV	A,E
	CPI	(IBUFF+IBFLEN) MOD 256
	JNZ	GETLN2

	POP	B
	POP	H
	LXI	D,IBUFF

GETLN4:	LDAX	D
	INX	D
	XCHG
	SHLD	xIBUFF
	XCHG
	MOV	M,A

	CPI	QUOTE	; set or reset
	JNZ	GTLN41	;  QUOTFL
	LDA	QUOTFL
	CMA
	STA	QUOTFL

GTLN41:	LDA	TCASFL	; Translate to upper or
	ORA	A	;  lower case ?
	JZ	GTLN46	; NO

	LDA	QUOTFL	; If in quote,
	ORA	A	;  do nothing
	JNZ	GTLN43
	MOV	A,M	; otherwise, ';' sets
	CPI	';'	;  CMNTFL
	JZ	GTLN42
	CPI	EOS	; and EOS resets it
	JNZ	GTLN43
	XRA	A
GTLN42:	STA	CMNTFL

GTLN43:	LDA	QUOTFL	; If in quote,
	ORA	A	;  do nothing
	JNZ	GTLN46
	LDA	CMNTFL	; If in comment,
	ORA	A	;  do nothing
	JNZ	GTLN46
	LDA	LCASFL	; Otherwise,
	ORA	A	;  if LCASFL set
	MOV	A,M
	JZ	GTLN44
	CALL	LCASE	;  trans to lower case
	JMP	GTLN45
GTLN44:	CALL	UCASE	;  else tran to upper case
GTLN45:	MOV	M,A

GTLN46:	MOV	A,M
	CPI	CR
	JZ	GETLN6
	CPI	HT	; filters out
	JZ	GETLN5	; all ctrl chars

	CPI	EOF
	JZ	GETLN7

	CPI	' '	; except tab
	JC	GETLN1
GETLN5:	DCR	B
	INX	H
	JNZ	GETLN1
	INR	B
	DCX	H
	JMP	GETLN1
;
GETLN6:	INX	H
	MVI	M,LF
	INX	H
	MVI	M,N00
	XCHG
	SHLD	xIBUFF
	LHLD	LINENO
	INX	H
	SHLD	LINENO
	RET
;
LINENO:	DW	0
QUOTFL:	DB	0
CMNTFL:	DB	0
;
;	Exit
;
GETLN7:	LHLD	xUNKTB
	CALL	CHKBDOS	;ret NC if HL<bdosbas-255
	JNC	GETLN8
	CALL	NOMEM

GETLN8:	XRA	A
	MOV	M,A
	INX	H
	MOV	M,A

GETLN9:
	CALL	PUTUNK
	CALL	CLOSEO
	CALL	PRTUNK

	LXI	D,UPSMSG
	CALL	PRTLIN

	LXI	D,ELSEFL
	CALL	PRTLIN

	LXI	D,MACRFL
	CALL	PRTLIN

	LXI	D,POEFLG
	CALL	PRTLIN

	CALL	CRLF
	LHLD	LINENO
	MVI	C,0	; suppress leading zeros
	CALL	PDNHL
	LXI	D,LINMSG
	CALL	PRTLIN

	LXI	D,EOJMSG
;
;	Print message at DE and abort
;
EREXIT:	PUSH	D
	LXI	D,CRLFMG
	CALL	PRTLIN
	POP	D
	CALL	PRTLIN
	JMP	ABORT
;
JABORT:	LXI	D,JABTMG
	CALL	PRTLIN
	JMP	GETLN7
;
JABTMG:	DB	CR,LF,'*** Job Cancelled ***',CR,LF,0

;
;	Prints "insufficient memory" message.
;
NOMEM:	LXI	D,MEMMSG
	JMP	PRTLIN
;
MEMMSG:	DB	CR,LF,'Ran out of memory for table '
	DB	'of line numbers of intrinsic Z80 '
	DB	'opcodes.',CR,LF,BEL,0

LINMSG:	DB	' lines in input file processed.'
	DB	CR,LF,0

EOJMSG:	DB	'*** Finished ***'

CRLFMG:	DB	CR,LF,0

UPSMSG:	DB	0,LF,BEL,'The following operands'
	DB	' have been used in your '
	DB	'source and have not'
	DB	CR,LF
	DB	'been fully translated.  You must '
	DB	'complete the translation using an '
	DB	'editor.'
	DB	CR,LF,0

ELSEFL:	DB	0,'ELSE',CR,LF,0
MACRFL:	DB	0,'MACRO',CR,LF,0

POEFLG:	DB	0,LF,'Condition code PO or PE found, '
	DB	'check 8080-Z80 difference.',CR,LF,0

;
;	Print list of line numbers in which
;	unknown or untranslatable Z80 opcodes found.
;
PRTUNK:
	LXI	H,UNKTBL
	SHLD	xUNKTB
	LXI	D,UNKMSG
	CALL	PRTLIN
	MVI	B,10

PRTUN1:	LHLD	xUNKTB
	MOV	E,M
	INX	H
	MOV	D,M
	INX	H
	SHLD	xUNKTB
	XCHG
	MOV	A,H
	ORA	L
	JZ	PRTUN2
	MVI	A,' '
	CALL	CONOUT
	PUSH	B
	MVI	C,'0'	; don't suppress leading zeros
	CALL	PDNHL
	POP	B
	DCR	B
	JNZ	PRTUN1
	CALL	CRLF
	MVI	B,10
	JMP	PRTUN1
;
PRTUN2:	MVI	A,10
	CMP	B
	JNZ	CRLF
	RET
;
UNKMSG:	DB	CR,LF
	DB	'Line numbers containing '
	DB	'untranslated opcodes:',CR,LF
	DB	CR,LF
	DB	0

;
;	Put to output file list of line numbers in which
;	unknown or untranslatable Z80 opcodes found.
;
PUTUNK:	LXI	H,UNKTBL
	SHLD	xUNKTB
	LXI	H,UNKMGF
	CALL	PUTLIN
	MVI	B,10

PUTUN1:	LHLD	xUNKTB
	MOV	E,M
	INX	H
	MOV	D,M
	INX	H
	SHLD	xUNKTB
	XCHG
	MOV	A,H
	ORA	L
	JZ	PUTUN2
	MVI	A,' '
	CALL	PUTCHR
	PUSH	B
	MVI	C,'0'	; don't suppress leading zeros
	CALL	FDNHL
	POP	B
	DCR	B
	JNZ	PUTUN1
	CALL	PCRLF
	MVI	A,';'
	CALL	PUTCHR
	MVI	B,10
	JMP	PUTUN1
;
PUTUN2:	MVI	A,10
	CMP	B
	JZ	PCRLF
	CALL	PCRLF
	MVI	A,';'
	CALL	PUTCHR

PCRLF:	MVI	A,CR
	CALL	PUTCHR
	MVI	A,LF
	CALL	PUTCHR
	RET
;
UNKMGF:	DB	';',CR,LF
	DB	'; Line numbers containing '
	DB	'untranslated opcodes:',CR,LF
	DB	';',CR,LF
	DB	';',0

xUNKTB:	DW	UNKTBL

;*******************************************************
;
;	Process line
;
PROCLIN:
	LXI	H,LBUFF
PROCLN0:
	CALL	FNDOPC
	JZ	PUTND6
PROCLN1:
	LXI	H,OPTLOG
	LXI	B,3*OPBFLN
	CALL	SCANOP
	JZ	DOLOG

	LXI	H,OPTADD
	LXI	B,3*OPBFLN
	CALL	SCANOP
	JZ	DOADD

	LXI	H,OPTADC
	LXI	B,3*OPBFLN
	CALL	SCANOP
	JZ	DOADC

	LXI	H,OPTEX
	LXI	B,2*OPBFLN
	CALL	SCANOP
	JZ	DOEX

	LXI	H,OPTPP
	LXI	B,2*OPBFLN
	CALL	SCANOP
	JZ	DOPP

	LXI	H,OPTINC
	LXI	B,3*OPBFLN
	CALL	SCANOP
	JZ	DOINC

	LXI	H,OPTLD
	LXI	B,3*OPBFLN
	CALL	SCANOP
	JZ	DOLD

	LXI	H,OPTONE
	LXI	B,2*OPBFLN
	CALL	SCANOP
	JZ	DO180

	LXI	H,OPTPSD
	LXI	B,2*OPBFLN
	CALL	SCANOP
	JZ	DOPSD

	LXI	H,OPT1Z80
	LXI	B,2*OPBFLN
	CALL	SCANOP
	JZ	DO1Z80

	LXI	H,OPT2Z80
	LXI	B,2*OPBFLN
	CALL	SCANOP
	JZ	DO2Z80

	LXI	H,OPTIO
	LXI	B,2*OPBFLN+2
	CALL	SCANOP
	JZ	EXEC

	LHLD	xOPCOD	; Unrecognized opcode, put
	JMP	PUTEND	;  out line as is

PUTOPR:	LHLD	xOPRND

PUTEND:	XRA	A
	STA	LCFLAG
	STA	LCDFLG

	MVI	C,N00	;  putout w/o
PUTND1:	MOV	A,M	;  change

	CPI	' '
	JZ	PUTND3
	CPI	HT
	JZ	PUTND3

	CPI	CR
	JZ	PUTLIN
	CPI	';'
	JZ	PUTND4

	CPI	EOS	; Process exclamation point
	JZ	PTND21	;  separator

	CPI	QUOTE
	JNZ	PUTND2
	DCR	C
	JZ	PUTND2
	MVI	C,N01
PUTND2:	CALL	PUTCHR
	INX	H
	JMP	PUTND1

; Process exclamation point.

PTND21:	CALL	SKSPHT
	INX	H	; inc past EOS
PTND22:	MOV	A,M
	CPI	';'
	JZ	PUTND5

PTND24:	LDA	TEMP
	CPI	' '
	JZ	PTND25
	CPI	HT
	JZ	PTND25
	MVI	A,' '
	CALL	PUTCHR
PTND25:	MVI	A,'!'
	CALL	PUTCHR
	JMP	PROCLN0


; Space or Tab comes here

PUTND3:	PUSH	H
	CALL	SKSPHT
	CPI	CR	; filters out
	JZ	PUTLNB	; trailing spaces or tabs
	POP	H

	CPI	EOS	; process exclamation point
	JZ	PTND21	;  statement separator

	CPI	';'
	MOV	A,M	;prevent blank being replaced
			;by ';' in string data
	JZ	PUTND4
	CALL	PUTSPT
	JMP	PUTND1
;
PUTND4:	DCR	C	;';' come here
	INR	C
	JNZ	PUTND2
	CALL	SKSPHT

; Tab comments to proper column

PUTND5:	MVI	B,33
PTND51:	LDA	COLNUM
	CMP	B	;colnum>=41?
	JNC	PTND54
	DCR	A	;no, insert
	ANI	NF8	;tabs to
	ADI	N09	;start output
	CMP	B	;at col. 33
	JZ	PTND54
	JC	PTND52
	MVI	A,' '
	JMP	PTND53
;
PTND52:	MVI	A,HT
PTND53:	CALL	PUTCHR
	JMP	PTND51

PTND54:	LDA	TEMP	; insure
	CPI	' '	; space
	JZ	PUTND6	; before
	CPI	HT	; semi-colon
	JZ	PUTND6	;
	MVI	A,' '	;
	CALL	PUTCHR	;
PUTND6:	MOV	A,M
	INX	H
	CPI	EOS
	JZ	PTND22
	ORA	A
	RZ
	CALL	PUTCHR
	JMP	PUTND6
;
;	Put line at HL to output file until 0
;	and reset colnum to 1.
;
PUTLNB:	XTHL		;filter trailing
	POP	H	;blanks or tabs

PUTLNC:	JMP	PUTLIN

;*******************************************************
;
;	Opcode tables
;
OPTONE:	DB	'CPL  CMA  '
	DB	'CCF  CMC  '
	DB	'SCF  STC  '
	DB	'HALT HLT  '
	DB	'RLA  RAL  '
	DB	'RRA  RAR  '
	DB	'RLCA RLC  '
	DB	'RRCA RRC  '
	DB	'DAA  DAA  '
	DB	'NOP  NOP  '
	DB	'DI   DI   '
	DB	'EI   EI   '
	DB	0

OPT1Z80:
	DB	'EXX  EXX  '
	DB	'LDIR LDIR '
	DB	'LDI  LDI  '
	DB	'LDDR LDDR '
	DB	'LDD  LDD  '
	DB	'CPI  CPI  '
	DB	'CPIR CPIR '
	DB	'CPD  CPD  '
	DB	'CPDR CPDR '
	DB	'INI  INI  '
	DB	'INIR INIR '
	DB	'IND  IND  '
	DB	'INDR INDR '
	DB	'OUTI OUTI '
	DB	'OTIR OTIR '
	DB	'OUTD OUTD '
	DB	'OTDR OTDR '
	DB	'NEG  NEG  '
	DB	'RLD  RLD  '
	DB	'RRD  RRD  '
	DB	'RETI RETI '
	DB	'RETN RETN '
	DB	'IM0  IM0  '
	DB	'IM1  IM1  '
	DB	'IM2  IM2  '
	DB	0

OPT2Z80:
	DB	'DJNZ DJNZ '
	DB	'BIT  BIT  '
	DB	'SET  SET  '
	DB	'RES  RES  '
	DB	'RLC  RCL  '
	DB	'RL   RL   '
	DB	'RRC  RRC  '
	DB	'RR   RR   '
	DB	'SLA  SLA  '
	DB	'SRA  SRA  '
	DB	'SRL  SRL  '
	DB	'IM   IM   '
	DB	0

OPTPSD:
	DB	'DB   DB   '
	DB	'DW   DW   '
	DB	'DS   DS   '
	DB	'DEFB DB   '
	DB	'DEFW DW   '
	DB	'DEFS DS   '
	DB	'EQU  EQU  '
	DB	'DL   SET  '
	DB	'DEFL SET  '
	DB	'ORG  ORG  '
	DB	0

OPTLOG:	DB	'OR   ORI  ORA  '
	DB	'AND  ANI  ANA  '
	DB	'XOR  XRI  XRA  '
	DB	'CP   CPI  CMP  '
	DB	'SUB  SUI  SUB  '
	DB	0

OPTADD:	DB	'ADD  ADI  ADD  '
	DB	0

OPTADC:	DB	'ADC  ACI  ADC  '
	DB	'SBC  SBI  SBB  '
	DB	0

OPTEX:	DB	'EX   XCHG '
	DB	0

OPTPP:	DB	'PUSH PUSH '
	DB	'POP  POP  '
	DB	0

OPTINC:	DB	'INC  INX  INR  '
	DB	'DEC  DCX  DCR  '
	DB	0

OPTLD:	DB	'LD   MVI  MOV  '
	DB	0

OPTIO:	DB	'IN   IN   '
	DW	DOIN
	DB	'OUT  OUT  '
	DW	DOUT
	DB	'RST  RST  '
	DW	DORST
	DB	'JP   JMP  '
	DW	DOJP
	DB	'JR   JMP  '
	DW	DOJR
	DB	'CALL CALL '
	DW	DOCAL
	DB	'RET  RET  '
	DW	DORET
	DB	'MEND ENDM '
	DW	DO180
	DB	'MACROMACRO'
	DW	DOMACR
	DB	'ELSE ELSE '
	DW	DOELSE
	DB	0

;*******************************************************
;
;	Process labels, find potential opcode.
;
FNDOPC:	MOV	A,M

	CPI	' '
	JZ	FNDOP3
	CPI	HT
	JZ	FNDOP3

	CPI	CR	;Pass blank
	RZ		; lines and
	CPI	';'	; comment lines
	RZ

	CPI	'*'	; asterisk in first column
	JNZ	FNDOP1	; is a comment line
	MVI	M,';'
	RET

; Come here to process label

FNDOP1:	MVI	C,N00	; C will have length of label
FNDOP2:	MOV	A,M

	CPI	':'
	JZ	FNDOP4

	CPI	HT
	JZ	FNDOP6
	CPI	' '
	JZ	FNDOP6

	CPI	CR
	RZ
	CPI	EOS
	RZ

	CPI	';'
	JZ	FNDOP7

	CALL	PUTCHR
	INX	H
	INR	C
	JMP	FNDOP2

; Comes here only if space or tab at beginning
; of line.

FNDOP3:
	PUSH	H
	CALL	SKSPHT	;Find first non-sp or tab
	CPI	CR	;Filter out tabs or
	JZ	FNDOP9	; spaces at end of line.
	CPI	EOS
	JZ	FNDOP9
	POP	H

	CALL	PUTSPT	;print until non-sp or ht
	PUSH	H
	CALL	FINDLM	;find ,:+-/*); CR HT or SP at HL
	CPI	':'
	POP	H
	JZ	FNDOP1	; found a label, process it

	JMP	FNDOP7
;
; colon terminating label comes here
;
FNDOP4:	INX	H
	MOV	A,M
	CPI	':'	; is it a double colon ?
	JNZ	FNDOP5
	CALL	PUTCHR
	INX	H
FNDOP5:	MVI	A,':'
	CALL	PUTCHR

; HT or SP comes here

FNDOP6:

; See if there is an opcode field

FNDOP7:
	PUSH	H

	CALL	SKSPHT
	MOV	A,M

	CPI	CR
	JZ	FNDOP9	; filter trailing SP or TAB
	CPI	EOS
	JZ	FNDOP9	; exclamation point separator

	CPI	';'
	JNZ	FNDOP8	; found opcode field

	XTHL		; found comment field
	POP	H
	POP	B	; clear return
	JMP	PUTND5	; tab to proper column

; Have located opcode field

FNDOP8:	POP	H
	CALL	PUTSPT

; Move potential opcode to OPCBUF

MOVOPC:	SHLD	xOPCOD
	MVI	B,OPBFLN
	LXI	D,OPCBUF
	CALL	MOVBDH	;move up to B char from HL to
	CALL	SKSPHT	;DE until ,:+-/*); CR HT SP
	SHLD	xOPRND
	SUB	A
	INR	A
	RET

; come here on CR to filter trailing SP or TAB

FNDOP9:	XTHL
	POP	H
	RET

;*******************************************************
;
;	Gets routine address  from
;	HL+2*OPBFLN and jumps to routine.
;
EXEC:	PUSH	H
	LXI	B,2*OPBFLN
	DAD	B
	MOV	C,M
	INX	H
	MOV	B,M
	POP	H
	PUSH	B	;address on stack
	RET		;go to it

;
;	Scan table at HL for match to OPBFLN
;	char string at OPCBUF.
;	Ret Z and HL-> entry if match.
;
SCANOP:	MOV	A,M
	ANA	A
	JZ	SCNOP1
	PUSH	B
	MVI	B,OPBFLN
	LXI	D,OPCBUF
	CALL	CBDEHL	;comp B bytes (DE)-(HL)
	POP	B
	RZ
	DAD	B
	JMP	SCANOP
;
SCNOP1:	INR	A
	RET

;
;	Scan table at HL for match to string pointed to
;	by DE.  Enter with A = string length and
;			  BC = offset to next entry.
;
;	Return Z and HL pointing to table entry if
;	match.
;
SCAN:	PUSH	B
	MOV	B,A
	MOV	A,M
	ORA	A
	JZ	NOTFND
	CALL	COMP	; comp B bytes (DE)-(HL)
	MOV	A,B
	POP	B
	RZ
	DAD	B
	JMP	SCAN
;
NOTFND:	INR	A
	POP	B
	RET

;
;	Compares B chars at DE with chars
;	at HL.
;	Ret Z if match.
;	Preserve HL, DE, BC
;
CBDEHL:	PUSH	H
	PUSH	D
	PUSH	B
CBDH1:	LDAX	D

	CPI	'a'
	JC	CBDH2
	STA	LCFLAG
	ANI	05FH
CBDH2:
	CMP	M
	JNZ	CBDH3
	INX	H
	INX	D
	DCR	B
	JNZ	CBDH1
CBDH3:	POP	B
	POP	D
	POP	H
	RET

LCFLAG:	DB	0

;
;	Compare B bytes at DE with B bytes at HL.
;	Set (LCDFLG) if any byte at DE is lower case.
;
COMP:	PUSH	H
	PUSH	D
	PUSH	B
COMP1:	LDAX	D
	CPI	'a'
	JC	COMP2
	STA	LCDFLG
	ANI	5FH
COMP2:	CMP	M
	JNZ	COMP3
	INX	H
	INX	D
	DCR	B
	JNZ	COMP1
COMP3:	POP	B
	POP	D
	POP	H
	RET
;
LCDFLG:	DB	0

;
;	Put up to OPBFLN char at HL+OPBFLN
;	to output file.  Stop at space,
;	and put tab to output file.
;
PUTOPHT:
	CALL	PUTOPC
PUTHT:	MVI	A,HT
	JMP	PUTCHR

;
;
;
PUTOPC:	LXI	B,OPBFLN
	DAD	B	;HL->new opcode
	MOV	B,C
PUTOP1:	MOV	A,M

	CPI	' '
	RZ

	CPI	HT
	RZ

	LDA	LCFLAG
	ORA	A
	MOV	A,M
	JZ	PUTOP2
	ORI	20H

PUTOP2:	CALL	PUTCHR
	INX	H
	DCR	B
	JNZ	PUTOP1
	RET

;
;	Put string at HL to output file until 0.
;	If (LCFLAG) set, convert to lower case.
;
PUTOPS:	MOV	A,M
	ORA	A
	RZ
	LDA	LCFLAG
	ORA	A
	MOV	A,M
	JZ	PUTOS0
	CALL	LCASE
PUTOS0:	CALL	PUTCHR
	INX	H
	JMP	PUTOPS

;
;	Put string at HL to output file until 0.
;	If (LCDFLG) set, convert to lower case.
;
PUTRND:	MOV	A,M
	ORA	A
	RZ
	LDA	LCDFLG
	ORA	A
	MOV	A,M
	JZ	PUTRN0
	CALL	LCASE
PUTRN0:	CALL	PUTCHR
	INX	H
	JMP	PUTRND

;
;	Put BC character string at HL to output file.
;
PUTSTR:	MOV	A,B
	ORA	C
	RZ
	MOV	A,M
	CALL	PUTCHR
	INX	H
	DCX	B
	JMP	PUTSTR

;
;	Put string at HL until End of Expression (EOE).
;	EOE is the first of the tabs or spaces before a
;	semicolon or CR.
;
;	Returns HL pointing to EOE.
;
PUTEOE:	PUSH	B
	PUSH	D
	PUSH	H	; HL -> start
	CALL	FNDEOE	; returns HL -> EOE
	MOV	B,M
	MVI	M,0
	POP	H	; HL -> start
	CALL	PUTLIN
	MOV	M,B	; restore original char
	POP	D
	POP	B
	RET

;
;	Put spaces or tabs at HL to output
;	file until non-(space or tab)
;
PUTSPT:	MOV	A,M
	CPI	' '
	JZ	PUTSP1
	CPI	HT
	RNZ
PUTSP1:	CALL	PUTCHR
	INX	H
	JMP	PUTSPT

;
;	Find '),' and return HL -> ')'.
;	Return NZ if not found.
;
FINDPR:	MOV	A,M
	CPI	CR
	JZ	FNDNPR
	CPI	','
	JZ	FNDPR1
	INX	H
	JMP	FINDPR
;
FNDPR1:	DCX	H
	MOV	A,M
	CPI	')'
	RET
;
FNDNPR:	ORA	A
	RET

;
;	Find End of Expression (EOE).
;	EOE is the first of the spaces or tabs before
;	a semicolon or CR.
;
;	Returns HL -> EOE.
;
FNDEOE:	MOV	A,M
	CPI	';'
	JZ	FNDEO1
	CPI	CR
	JZ	FNDEO1
	INX	H
	JMP	FNDEOE
;
FNDEO1:	DCX	H
	MOV	A,M
	CPI	' '
	JZ	FNDEO1
	CPI	HT
	JZ	FNDEO1
	INX	H
	RET

;
;	Find first ,:+-/*); CR HT SP or exclamation
;	point at HL,
;	return A = (HL).
;
FINDLM:	PUSH	B
	CALL	CHKDLM
	POP	B
	RZ
	INX	H
	JMP	FINDLM

;
;	Ret Z, A=(HL) if
;	HL is ,:+-/*); CR HT SP or exclamation point
;
CHKDLM:	MOV	A,M
	CPI	':'
	RZ
	CPI	'+'
	RZ
	CPI	'-'
	RZ
	CPI	'/'
	RZ
	CPI	'*'
	RZ
	CPI	')'
	RZ
	CPI	'!'
	RZ

;
;	Ret Z, A=(HL) if (HL) is CR, SP, HT,
;	comma, or semicolon.
;
CHKSEP:	MOV	A,M
	CPI	','
	RZ
	CPI	' '
	RZ
	CPI	HT
	RZ
	CPI	';'
	RZ
	CPI	CR
	RET

;
;	Fill B locations at DE with spaces.
;	Move up to B char from HL to DE until
;	,:+-/*); CR HT or SP encountered.
;	Return Z and HL->special char if found.
;	(search B+1 loc for special char.)
;
MOVBDH:	MOV	C,B
	MVI	B,N00
	PUSH	B
	PUSH	D
	PUSH	H	; fill BC locations
	CALL	FILLBD	; at DE with spaces
	POP	H	;
	POP	D
	POP	B
MOVBD1:	PUSH	B	; ret Z, A=(HL)
	CALL	CHKDLM	; if (HL) is
	POP	B	; ,:+-/*); CR HT or SP
	RZ
	MOV	A,M
	STAX	D
	INX	D
	INX	H
	DCX	B
	MOV	A,B
	ORA	C
	JZ	CHKDLM
	JMP	MOVBD1

;
;	Skip spaces and tabs.
;	Return HL->non-space or non-tab
;
SKSPHT:	MOV	A,M
	CPI	' '
	JZ	SKSPT1
	CPI	HT
	RNZ
SKSPT1:	INX	H
	JMP	SKSPHT

;
;	Subtract DE from HL, result in HL.
;
SBCHLDE:
	MOV	A,L
	SUB	E
	MOV	L,A
	MOV	A,H
	SBB	D
	MOV	H,A
	RET

;
;	Fill BC locations starting at
;	DE with spaces.
;	Returns A = space, DE -> next free
;	location, HL = DE - 1, BC = 0.
;
FILLBD:	MVI	A,' '
	STAX	D
	MOV	H,D
	MOV	L,E
	INX	D
	DCX	B
;
;	(DE)=(HL), INC HL, INC DE, DEC BC
;	Repeat until BC = 0.
;
MOVIR:	MOV	A,M
	STAX	D
	INX	H
	INX	D
	DCX	B
	MOV	A,B
	ORA	C
	JNZ	MOVIR
	RET

;*******************************************************
;
; TRANLATION ROUTINES
;
;*******************************************************
;
;	All untranslatable opcodes come here.
;	(Well, almost all -- completely unrecognized
;	 opcodes are passed through unprocessed.)
;
DOUNK:	POP	H
;
;	Untranslatable implied addressing Z80 opcodes
;
DO1Z80:
;
;	Untranslatable register addressing Z80 opcodes
;
DO2Z80:

	CALL	ADDLIN	; add line # to unk. table
	LXI	H,FLGSTR
	CALL	PUTLIN	; mark opcode
	LHLD	xOPCOD
	JMP	PUTEND
;
FLGSTR:	DB	'# ',0

;
;	Add current line number to UNKTBL
;
ADDLIN:	LHLD	LINENO
	XCHG
	LHLD	xUNKTB
	CALL	CHKBDOS	; ret NC if ok
	RC
	MOV	M,E
	INX	H
	MOV	M,D
	INX	H
	SHLD	xUNKTB
	RET

;
;	ELSE comes here.
;
DOELSE:	MVI	A,HT
	STA	ELSEFL
DOPSD1:	MVI	A,CR
	STA	UPSMSG

;
;	Translatable 8080 implied addressing opcodes
;
DO180:	CALL	PUTOPC
	JMP	PUTOPR

;
;	Untranslatable pseudo-ops come here.
;
DOMACR:	MVI	A,HT
	STA	MACRFL
DOPSD0:	MVI	A,CR
	STA	UPSMSG
;
;	Pseudo-opcodes come here
;
DOPSD:	CALL	PUTOPHT
	JMP	PUTOPR

;
;	Logical opcodes SUB, AND, OR, XOR, CP
;
DOLOG:	PUSH	H	; HL -> first translated opcode
	LHLD	xOPRND
	CALL	CHKAC
	SHLD	xOPRND
	CALL	CHKR	; A, B, C, D, E, H, L, (HL) ?
	JZ	DOLOGR
	CALL	CHKIXD	; (IX+d) or (IY+d) ?
	JZ	DOUNK
DOLOGL:	POP	H	; it's a label
DOLOG0:	CALL	PUTOPHT
	JMP	PUTOPR
;
; Register addressed
;
DOLOGR:	POP	D	; DE -> first translated opcode
	LXI	H,OPBFLN
	DAD	D	; HL -> second translation
	JMP	DOLOG0

;
;	Arithmetic ADD
;
DOADD:	PUSH	H
	LHLD	xOPRND
	CALL	CHKAC	; skip 'A,' in A,s form
	SHLD	xOPRND
	CALL	CHKR	; register ?
	JZ	DOLOGR
	CALL	CHKIXD	; (IX+d) or (IY+d) ?
	JZ	DOUNK
	CALL	CHKHL	; ADD HL,xx ?
	JZ	DOADDH
	CALL	CHKIXY	; ADD IX,xx ?
	JNZ	DOLOGL
	CPI	','
	JNZ	DOLOGL
	JMP	DOUNK
;
; ADD HL,ss
;
DOADDH:	CPI	','
	JNZ	DOUNK
	INX	H
	LDA	LCDFLG
	MOV	B,A
	LDA	LCFLAG
	ORA	B
	STA	LCFLAG
	XRA	A
	STA	LCDFLG
	CALL	CHKRP	;ret DE->reg.pair trans.,HL->nxt
	JNZ	DOUNK
	LDAX	D
	CPI	'P'
	JZ	DOUNK
	PUSH	H
	LXI	H,OPDAD
	CALL	PUTOPS
	CALL	PUTHT
	POP	H
	XCHG
	CALL	PUTRND
	XCHG
	POP	D
	JMP	PUTEND
;
OPDAD:	DB	'DAD',0

;
;	Arithmetic opcodes ADC, SBC
;
DOADC:	PUSH	H
	LHLD	xOPRND
	CALL	CHKAC	; skip A, in A,s form
	SHLD	xOPRND
	CALL	CHKR	; register ?
	JZ	DOLOGR
	CALL	CHKIXD	; (IX+d) or (IY+d) ?
	JZ	DOUNK
	CALL	CHKHL	; ADD HL,xx ?
	JZ	DOUNK
	CALL	CHKIXY	; ADD IX,xx ?
	JNZ	DOLOGL
	CPI	','
	JNZ	DOLOGL
	JMP	DOUNK

;
; Return Z set, HL pointing to delimiter if HL on entry
; points to 'A', 'B', 'C', 'D', 'E', 'H', 'L', or '(HL)'.
;
; If '(HL)' convert to 'M' and modify (xOPRND) to point
; to 'M'.
;
CHKR:	MOV	A,M
	ANI	5FH
CHKR0:	CPI	'A'
	JZ	CHKR2
	CPI	'B'
	JZ	CHKR2
	CPI	'C'
	JZ	CHKR2
	CPI	'D'
	JZ	CHKR2
	CPI	'E'
	JZ	CHKR2
	CPI	'H'
	JZ	CHKR2
	CPI	'L'
	JZ	CHKR2
	MOV	A,M
	CPI	'('
	JZ	CHKR3
	RET
;
CHKR2:	INX	H
	CALL	CHKDLM	; ret A=(HL) and Z if ,:+-/*);
	RZ		;  SP, CR, or HT
	DCX	H
	RET
;
CHKR3:	XCHG		; DE -> '('
	LXI	H,MREG
	MVI	B,4
	CALL	COMP	; comp. B bytes (DE)-(HL)
	XCHG		; HL -> '('
	RNZ
	PUSH	H
	INX	H
	INX	H
	INX	H
	INX	H	; HL -> d
	CALL	CHKDLM
	POP	H	; HL -> '('
	RNZ
	INX	H
	INX	H
	INX	H
	LDA	LCDFLG
	ORA	A
	MVI	A,'M'
	JZ	CHKR30
	ORI	20H	; convert to lower case
CHKR30:	MOV	M,A
	SHLD	xOPRND
	XRA	A	; return Z
	INX	H	; HL -> ','
	MOV	A,M
	RET
;
MREG:	DB	'(HL)'

;
;	If HL is pointing to 'A,'
;	then increment HL by 2 and
;	return Z.
;
CHKAC:	MOV	A,M
	ANI	5FH
	CPI	'A'
	RNZ
	INX	H
	MOV	A,M
	CPI	','
	INX	H
	RZ
	DCX	H
	DCX	H
	RET

;
;	If HL -> 'Ad' where d is a delimiter,
;	then return Z and HL -> d.
;	Otherwise, return NZ and HL unchanged.
;
CHKA:	MOV	A,M
	ANI	5FH
	CPI	'A'
	RNZ
	INX	H
	CALL	CHKDLM
	RZ
	DCX	H
	RET

;
;	If HL -> 'Id' or 'Rd' where d is a delimiter
;	then return Z and HL -> d.
;	Otherwise, return NZ and HL unchanged.
;
CHKIR:	MOV	A,M
	ANI	5FH
	CPI	'I'
	JZ	CHKR2
	CPI	'R'
	RNZ
	JMP	CHKR2

;
;	If HL is pointing to '(IX+d)' or '(IY+d)'
;	then return Z and HL pointing to '+' or
;	')'.
;
;	Else, return NZ and HL unchanged.
;
CHKIXD:	MOV	A,M
	CPI	'('
	RNZ
	INX	H
	CALL	CHKIXY
	JZ	CHKI1
	DCX	H
	RET
;
CHKI1:	CPI	'+'
	RZ
	CPI	')'
	RZ
	DCX	H
	DCX	H
	DCX	H
	RET

;
;	If HL is pointing to IXd or IYd where d is a
;	delimiter, then return Z and HL pointing to d.
;
;	Else, return NZ and HL unchanged.
;
CHKIXY:	MOV	A,M
	ANI	5FH
	CPI	'I'
	RNZ
	INX	H
	MOV	A,M
	ANI	5FH
	CPI	'X'
	JZ	CHKD
	CPI	'Y'
	JZ	CHKD
	DCX	H
	RET
;
CHKD:	INX	H
	CALL	CHKDLM
	RZ
	DCX	H
	DCX	H
	RET

;
;	If HL is pointing to 'HLd' where d is a
;	delimiter, then return Z and HL pointing to  d.
;
;	Otherwise, return NZ and HL unchanged.
;
CHKHL:	MOV	A,M
	ANI	5FH
	CPI	'H'
	RNZ
	INX	H
	MOV	A,M
	ANI	5FH
	CPI	'L'
	JZ	CHKD
	DCX	H
	RET

;
;	If HL -> '(HL)d' where d is a delimiter,
;	then return Z and HL -> d.
;	Otherwise, return NZ and HL unchanged.
;
CHKM:	MOV	A,M
	CPI	'('
	RNZ
	INX	H
	CALL	CHKHL
	JNZ	CHKM2
	CPI	')'
	JNZ	CHKM1
	INX	H
	CALL	CHKDLM
	RZ
	DCX	H
CHKM1:	DCX	H
	DCX	H
CHKM2:	DCX	H
	RET

;
;	If HL is pointing to one of the following
;	register pairs, return Z, HL pointing to d
;	where d is a delimiter, and DE pointing to
;	translation:
;
;	rp	translation
;
;	AFd	PSW
;	BCd	B
;	DEd	D
;	HLd	H
;	SPd	SP
;
;	Otherwise, return NZ and HL unchanged.
;
CHKRP:	XCHG
	LXI	H,RPTBL
	MVI	A,2	; string length
	LXI	B,6	; increment to next table entry
	CALL	SCAN
	XCHG
	RNZ
	INX	D
	INX	D	; DE points to translation
	INX	H
	INX	H	; HL points to d
	CALL	CHKDLM
	RZ
	DCX	H
	DCX	H
	RET
;
RPTBL:	DB	'BCB',0,0,0
	DB	'DED',0,0,0
	DB	'HLH',0,0,0
	DB	'SPSP',0,0
	DB	'AFPSW',0
	DB	0

;
;	If HL is pointing to '(BC)d' or '(DE)d',
;	then return Z, HL pointing to d, and
;	DE pointing to translation.
;
CHKBCDE:
	XCHG
	LXI	H,BCDETBL
	MVI	A,4	; string length
	LXI	B,6	; offset to next entry
	CALL	SCAN	; ret Z and HL->entry
	XCHG		;  if DE in table
	RNZ
	INX	D
	INX	D
	INX	D
	INX	D	; DE->translation
	INX	H
	INX	H
	INX	H
	INX	H	; HL->d
	CALL	CHKDLM
	RZ
	DCX	H
	DCX	H
	DCX	H
	DCX	H
	RET
;
BCDETBL:
	DB	'(BC)B',0
	DB	'(DE)D',0
	DB	0

;
;	EX
;
DOEX:	PUSH	H	; HL -> first translated opcode
	LHLD	xOPRND
	XCHG
	LXI	H,EXTBL1 ; EX DE,HL ?
	MVI	A,5	; string length
	LXI	B,10	; offset to nxt entry
	CALL	SCAN
	LXI	B,EXTBL1+5
	LXI	H,5
	JZ	DOXCHG
	LXI	H,EXTBL2 ; EX (SP),HL ?
	MVI	A,7
	LXI	B,12
	CALL	SCAN	; return HL -> entry
	LXI	B,EXTBL2+7
	JNZ	DOUNK
;
DOXTHL:	LXI	H,7
DOXCHG:	DAD	D
	PUSH	B
	CALL	CHKDLM	; preserves HL, DE
	POP	D	; DE->trans.
	JNZ	DOUNK
	XCHG		; HL->translated opcode
	LDA	LCDFLG
	MOV	B,A
	LDA	LCFLAG
	ORA	B
	STA	LCFLAG
	CALL	PUTOPS	; put string at HL
	XCHG
	POP	D	; clear stack
	JMP	PUTEND
;
EXTBL1:	DB	'DE,HL'
	DB	'XCHG',0
	DB	0
;
EXTBL2:	DB	'(SP),HL'
	DB	'XTHL',0
	DB	0

;
;	PUSH or POP
;
DOPP:	PUSH	H	; HL -> translated opcode
	LHLD	xOPRND
	CALL	CHKRP	; ret DE->transl., HL->nxt
	JNZ	DOUNK
	LDAX	D
	CPI	'S'
	JZ	DOUNK
DOOPR:	SHLD	xOPRND
	POP	H
	CALL	PUTOPHT
	XCHG
	CALL	PUTRND
	JMP	PUTOPR

;
;	INC or DEC
;
DOINC:	PUSH	H	; HL-> first translated opcode
	LHLD	xOPRND
	CALL	CHKR
	JZ	DOLOGR
	CALL	CHKRP	; ret DE->transl., HL->nxt
	JNZ	DOUNK
	LDAX	D
	CPI	'P'
	JZ	DOUNK
	JMP	DOOPR

;
;	LD
;
DOLD:	PUSH	H	; HL->first translated opcode
	LHLD	xOPRND
	CALL	CHKR
	JZ	DOLDR
	CALL	CHKRP	; ret HL->dlm, DE->tranl. RP
	JZ	DOLDRP
	MOV	A,M
	CPI	'('
	JNZ	DOUNK
	CALL	CHKIXD
	JZ	DOUNK
	CALL	CHKIXY
	JZ	DOUNK
	CALL	CHKIR
	JZ	DOUNK
	CALL	CHKBCDE
	JZ	DOSTAX
;
; Do LD (nn),HL or LD (nn),a
;
	INX	H
	PUSH	H
	CALL	FINDPR	; find '),'
	POP	D	; DE -> nn
	JNZ	DOUNK
	PUSH	H
	CALL	SBCHLDE
	XTHL		; (SP) = length
	INX	H	; HL -> ','
	INX	H	; HL -> 'A' or 'HL'
	CALL	CHKHL
	JZ	DOSHLD
	CALL	CHKA
	POP	B	; BC = length
	JNZ	DOUNK

;
; LD (nn),A -> STA nn
;
DOSTA:	PUSH	H	; DE->nn, HL->rest
	LXI	H,OPSTA
DOST1:	CALL	PUTOPS
	CALL	PUTHT	; put HT
	XCHG		; HL->nn
	CALL	PUTSTR	; put BC chars at HL
	POP	H	; HL->rest of line
	POP	D	; clean stack
	JMP	PUTEND

;
; LD (nn),HL -> SHLD nn
;
DOSHLD:	POP	B
	PUSH	H
	LXI	H,OPSHLD
	JMP	DOST1
;
OPSTA:	DB	'STA',0
OPSHLD:	DB	'SHLD',0
OPSTAX:	DB	'STAX',0

;
; LD (DE),A or LD (BC),A -> STAX D or B
;
DOSTAX:	CPI	','
	JNZ	DOUNK
	INX	H
	CALL	CHKA
	JNZ	DOUNK
	SHLD	xOPRND
	LXI	H,OPSTAX
	CALL	PUTOPS
	CALL	PUTHT
	XCHG		; HL-> translation
	CALL	PUTRND
	POP	D	; clean stack
	JMP	PUTOPR

;
;	LD BC,nn   -> LXI B,nn
;	LD DE,nn   -> LXI D,nn
;	LD HL,nn   -> LXI H,nn
;	LD HL,(nn) -> LHLD nn
;	LD SP,nn   -> LXI SP,nn
;	LD SP,HL   -> SPHL
;	LD SP,IX   -> unk
;	LD SP,IY   -> unk
;	LD dd,(nn) -> unk
;
;	HL -> delim, DE -> translated RP.
;
DOLDRP:	CPI	','
	INX	H
	JNZ	DOUNK
	LDAX	D
	CPI	'P'
	JZ	DOUNK
	CPI	'S'
	JZ	DOLDRS
	MOV	A,M
	CPI	'('
	JZ	DOLDPL

;
; LD dd,nn
;
DOLDLX:	PUSH	H	; HL -> nn
	LXI	H,OPLXI
	CALL	PUTOPS
	CALL	PUTHT
	XCHG		; HL -> translated RP
	CALL	PUTRND
	MVI	A,','
	CALL	PUTCHR
	POP	H	; HL -> nn
	CALL	PUTEOE	; put nn to output file
	POP	D	; clean stack
	JMP	PUTEND
;
OPLXI:	DB	'LXI',0

;
;	LD SP,xx
;
;	HL -> next, DE -> translated RP.
;
DOLDRS:	CALL	CHKIXY
	JZ	DOUNK
	CALL	CHKHL
	JNZ	DOLDLX
	SHLD	xOPRND
	LXI	H,OPSPHL
	CALL	PUTOPS
	POP	D	; clean stack
	JMP	PUTOPR
;
OPSPHL:	DB	'SPHL',0

;
; LD dd,(nn)
;
DOLDPL:	LDAX	D	; DE -> translated RP
	CPI	'H'
	JNZ	DOUNK
	INX	H	; HL -> nn
	PUSH	H
	CALL	FNDEOE	; find end of expression nn
	CPI	')'
	POP	D	; DE -> nn, HL -> EOE
	JNZ	DOUNK
	DCX	H	; HL -> ')'
	PUSH	H
	LXI	H,OPLHLD
DOLDPL1:
	CALL	PUTOPS
	CALL	PUTHT
	POP	H	; HL -> ')', DE -> nn
	MVI	M,0
	XCHG		; HL -> nn
	INX	D	; DE -> EOE
	CALL	PUTLIN
	XCHG		; HL -> EOE
	POP	D	; clean stack
	JMP	PUTEND
;
OPLHLD:	DB	'LHLD',0

;
; LD r,x
;
DOLDR:	CPI	','
	JNZ	DOUNK
	INX	H
	MOV	A,M
	CPI	'('
	JZ	DOLDR1
	CALL	CHKR
	JZ	DOLOGR
	CALL	CHKIR	; LD I,x or LD R,x
	JZ	DOUNK
	JMP	DOLOGL
;
DOLDR1:	CALL	CHKIXD
	JZ	DOUNK
	CALL	CHKBCDE
	JZ	DOLDAX
	INX	H	; HL-> nn)
	CALL	CHKHL
	JNZ	DOLDA
	CPI	')'
	JNZ	DOUNK
	DCX	H
	DCX	H
	DCX	H
	DCX	H
	MOV	B,M
	DCX	H
	MOV	A,M
	INX	H
	INX	H
	INX	H
	MOV	M,A
	SHLD	xOPRND
	INX	H
	MOV	M,B
	INX	H
	LDA	LCDFLG
	ORA	A
	MVI	A,'M'
	JZ	DOLDR2
	ORI	20H
DOLDR2:	MOV	M,A
	JMP	DOLOGR

;
; LD r,(nn)
;
;	HL -> '('
;
DOLDA:	PUSH	H
	LHLD	xOPRND
	MOV	A,M
	POP	H
	ANI	5FH
	CPI	'A'
	JNZ	DOUNK
	PUSH	H	; HL -> nn)
	CALL	FNDEOE
	CPI	')'
	POP	D	; DE -> nn, HL -> EOE
	JNZ	DOUNK
	DCX	H	; HL -> ')'
	PUSH	H
	LXI	H,OPLDA
	JMP	DOLDPL1
;
OPLDA:	DB	'LDA',0

;
; LD r,(BC) or LD r,(DE)
;
;	DE -> tranlated RP,  HL -> d
;
DOLDAX:	PUSH	H
	LHLD	xOPRND
	MOV	A,M
	POP	H
	ANI	5FH
	CPI	'A'
	JNZ	DOUNK
	PUSH	H
	LXI	H,OPLDAX
	CALL	PUTOPS
	CALL	PUTHT
	POP	H	; HL -> d
	XCHG		; HL -> translated RP
	CALL	PUTRND
	XCHG		; HL -> d
	POP	D	; clean stack
	JMP	PUTEND
;
OPLDAX:	DB	'LDAX',0

;
;	RST nn -> RST nn/8
;
DORST:	CALL	PUTOPHT
	LHLD	xOPRND
	CALL	PUTEOE
	MVI	A,'/'
	CALL	PUTCHR
	MVI	A,'8'
	CALL	PUTCHR
	JMP	PUTEND

;
;	IN r,(C) -> unk
;	IN A,(nn) or IN A,nn -> IN nn
;
DOIN:	PUSH	H
	LHLD	xOPRND
	CALL	CHKAC
	JNZ	DOUNK
	MOV	A,M
	CPI	'('
	JNZ	DOIN1
	INX	H
DOIN1:	XCHG		; DE -> nn
	POP	H	; HL -> translated opcode
	CALL	PUTOPHT
	XCHG		; HL -> nn
	PUSH	H
	CALL	FNDEOE
	CPI	')'
	JNZ	DOIN2
	DCX	H
	MVI	M,' '
DOIN2:	POP	H	; HL -> nn
	CALL	PUTEOE
	JMP	PUTEND

;
;	If HL -> '(C)d' where d is a delimiter,
;	then return Z and HL -> d.
;	Otherwise, return NZ and HL unchanged.
;
CHKC:	MOV	A,M
	CPI	'('
	RNZ
	INX	H
	MOV	A,M
	ANI	5FH
	CPI	'C'
	JNZ	CHKC2
	INX	H
	MOV	A,M
	CPI	')'
	JNZ	CHKC1
	INX	H
	CALL	CHKDLM
	RZ
	DCX	H
CHKC1:	DCX	H
CHKC2:	DCX	H
	RET

;
;	OUT (C),A -> unk
;	OUT (nn),A or OUT nn,A -> OUT nn
;
DOUT:	PUSH	H	; HL -> translated opcode
	LHLD	xOPRND
	CALL	CHKC
	JZ	DOUNK
	MOV	A,M
	CPI	'('
	JNZ	DOUT1
	INX	H
DOUT1:	PUSH	H	; HL -> nn
DOUT10:	MOV	A,M
	CPI	','
	JZ	DOUT11
	CPI	';'
	JZ	DOUT4
	CPI	CR
	JZ	DOUT4
	INX	H
	JMP	DOUT10
;
DOUT11:	DCX	H
	MOV	A,M
	CPI	')'
	JZ	DOUT2
	INX	H
	SHLD	XEND
	JMP	DOUT3
;
DOUT2:	SHLD	XEND
	INX	H
DOUT3:	INX	H	; HL -> 'A'
	CALL	CHKA
	JNZ	DOUT4
	SHLD	xOPRND
	POP	D	; DE -> nn
	POP	H	; HL -> opcode
	CALL	PUTOPHT
	LHLD	XEND
	MVI	M,0
	XCHG		; HL -> nn
	CALL	PUTLIN
	JMP	PUTOPR
;
DOUT4:	POP	H
	JMP	DOUNK
;
XEND:	DW	0

;
;	Translate JR to absolute JMP if requested
;
DOJR:	LDA	JRJPFL
	ORA	A
	JZ	DO2Z80

;
;	JP (HL)	-> PCHL		JP (IX) -> unk
;	JP nn	-> JMP nn	JP (IY) -> unk
;
;	JP NZ,nn -> JNZ nn	JP Z,nn -> JZ nn
;	JP NC,nn -> JNC nn	JP C,nn -> JC nn
;	JP PO,nn -> JPO nn	JP P,nn -> JP nn
;	JP PE,nn -> JPE nn	JP M,nn -> JM nn
;
DOJP:	PUSH	H	; HL -> translated opcode (JMP)
	LHLD	xOPRND
	CALL	CHKM	; '(HL)' ?
	JZ	DOPCHL
	CALL	CHKIXD	; '(IX)' or '(IY)'
	JZ	DOUNK
DOJP1:	CALL	CHKCC	; 'Z', 'C', 'P', or 'M' ?
	JZ	DOCC
	CALL	CHKNC	; 'NZ', 'NC' ?
	JZ	DONC
	CALL	CHKPOE	; 'PO', 'PE' ?
	JZ	DOPOE
	POP	H	; HL -> translated opcode
	CALL	PUTOPC
	CALL	PUTHT
	JMP	PUTOPR

JRJPFL:	DB	0

;
;	CALL
;
DOCAL:
	PUSH	H
	LHLD	xOPRND
	JMP	DOJP1

;
;	RET
;
DORET:	PUSH	H
	LHLD	xOPRND
DORET1:	CALL	CHKCC	; 'Z', 'C', 'P', or 'M' ?
	JZ	DORCC
	CALL	CHKNC	; 'NZ', 'NC' ?
	JZ	DORCC
	CALL	CHKPOE	; 'PO', 'PE' ?
	JZ	DORPOE
	POP	H	; HL -> translated opcode
	CALL	PUTOPC
	JMP	PUTOPR

;
; JP (HL)
;
DOPCHL:	PUSH	H
	LXI	H,OPPCHL
	CALL	PUTOPS
	POP	H
	POP	D	; clear stack
	JMP	PUTEND
;
OPPCHL:	DB	'PCHL',0

;
; Condition codes 'PO' or 'PE'
;
DOPOE:	INX	H
DORPOE:	MVI	A,CR
	STA	POEFLG
	PUSH	H
	PUSH	D
	CALL	ADDLIN
	POP	D
	POP	H
	JMP	DORCC
;
; Condition Codes 'Z', 'C', 'P', or 'M'
;
DOCC:
DONC:
	INX	H
DORCC:	PUSH	H	; HL -> nn
	LHLD	xOPCOD
	MOV	A,M
	CALL	PUTCHR
	XCHG		; HL -> cc
	CALL	PUTLIN
	LDAX	D	; DE -> opcode
	ANI	5FH
	CPI	'R'
	CNZ	PUTHT
	POP	H	; HL -> nn
	POP	D	; clean stack
	JMP	PUTEND

;
;	If HL -> 'Zs', 'Cs', 'Ps', or 'Ms',
;	where s is SP, HT, CR, comma, or semicolon
;	then return Z and HL -> s.
;	Otherwise, return NZ and HL unchanged.
;
CHKCC:	MOV	A,M
	ANI	5FH
	CPI	'Z'
	JZ	CHKCC1
	CPI	'C'
	JZ	CHKCC1
	CPI	'P'
	JZ	CHKCC1
	CPI	'M'
	JZ	CHKCC1
	RET
;
CHKCC1:	MOV	A,M
	LXI	D,OPCC
	STAX	D
	INX	H
	CALL	CHKSEP	; SP HT CR , ;
	JNZ	CHKCC2
	RET
;
OPNC:	DB	0
OPCC:	DB	0,0

;
;	If HL -> 'NCs' or 'NZs' where s is
;	SP, HT, CR, comma or semicolon then
;	return Z, HL -> s, DE -> cc string.
;	Otherwise, return NZ and HL, DE unchanged.
;
CHKNC:	MOV	A,M
	ANI	5FH
	CPI	'N'
	RNZ
	MOV	A,M
	LXI	D,OPNC
	STAX	D
	INX	H
	MOV	A,M
	ANI	5FH
	CPI	'Z'
	JZ	CHKNC1
	CPI	'C'
	JZ	CHKNC1
	DCX	H
	RET
;
CHKNC1:	MOV	A,M
	STA	OPCC
	INX	H
	CALL	CHKSEP
	RZ
;
CHKNC2:	DCX	H
CHKCC2:	DCX	H
	RET

;
;	If HL -> 'POs' or 'PEs' then
;	return Z, HL -> s, and DE -> cc.
;	Otherwise, return NZ and HL unchanged.
;
CHKPOE:	MOV	A,M
	ANI	5FH
	CPI	'P'
	RNZ
	MOV	A,M
	LXI	D,OPNC
	STAX	D
	INX	H
	MOV	A,M
	ANI	5FH
	CPI	'E'
	JZ	CHKNC1
	CPI	'O'
	JZ	CHKNC1
	DCX	H
	RET

;*******************************************************
;
;	Set up input and output FCB's from DFCB
;
MAKFNS:	LXI	H,DFCB1
	LXI	D,INFCB
	LXI	B,FNLEN+1
	CALL	MOVIR
	MOV	A,M	; typ specified ?
	CPI	' '
	JZ	MKFNS1
	CPI	'?'
	JZ	MKFNS1
	LXI	B,3
	CALL	MOVIR
MKFNS1:
	LXI	H,DFCB1
	LXI	D,OUTFCB
	LXI	B,FNLEN+1
	CALL	MOVIR

	LDA	DFCB2	;
	ORA	A	; allows output to
	JZ	MKFNS2	; different drive
	STA	OUTFCB	; than input
MKFNS2:
	LDA	DFCB2+1	;
	CPI	' '	;
	JZ	MKFNS3	; allows output
	LXI	B,8	; file to have
	LXI	D,OUTFCB+1 ; different name
	LXI	H,DFCB2+1 ; from input file
	CALL	MOVIR	;
MKFNS3:
	LDA	DFCB2+9
	CPI	' '
	JZ	MKFNS4
	LXI	B,3
	LXI	D,OUTFCB+9
	LXI	H,DFCB2+9
	CALL	MOVIR
MKFNS4:
	LXI	D,PRFNM1
	CALL	PRTLIN
	LXI	H,INFCB
	CALL	PRFNAM
	LXI	D,PRFNM2
	CALL	PRTLIN
	LXI	H,OUTFCB
	CALL	PRFNAM
	LXI	D,CRLFMG
	CALL	PRTLIN
	RET
;
;	Print Filenames
;
PRFNAM:	MOV	A,M	; disk number
	ORA	A
	JNZ	PRFN1
	LDA	xCDISK
PRFN1:	ADI	'@'
	CALL	CONOUT
	MVI	A,':'
	CALL	CONOUT
	INX	H
	MVI	B,8
	CALL	PRFN
	MVI	A,'.'
	CALL	CONOUT
	MVI	B,3
PRFN:	MOV	A,M
	INX	H
	CPI	' '
	CNZ	CONOUT
	DCR	B
	JNZ	PRFN
	RET
;
PRFNM1:	DB	'Source File: ',0
PRFNM2:	DB	',  Destination File: ',0
;
;	Open source file with ext Z80
;
OPENIN:

	LXI	D,INFCB
	MVI	C,nOPEN
	CALL	BDOS
	CPI	NFF
	JZ	NSFERR

	LXI	H,IBUFF+IBFLEN
	SHLD	xIBUFF

	RET
;
INFCB:	DB	0,0,0,0,0,0,0,0
	DB	0,'Z80',0,0,0,0
	DB	0,0,0,0,0,0,0,0
	DB	0,0,0,0,0,0,0,0
	DB	0
;
NSFERR:	LXI	D,NSFMSG ;'No Source File'
	JMP	EREXIT
;
NSFMSG:	DB	'No Source File Found'
	DB	CR,LF,BEL,0

;
;	Create output file with ext ASM
;
CREATO:
	LXI	D,OUTFCB
	MVI	C,nOPEN
	CALL	BDOS
	CPI	NFF
	JNZ	OFEERR
CREAT4:	LXI	D,OUTFCB
	MVI	C,nCREAT
	CALL	BDOS
	CPI	NFF
	JZ	NDSERR
	LXI	D,OUTFCB
	MVI	C,nOPEN
	CALL	BDOS
	MVI	A,RECLEN
	STA	OBUFCT
	LXI	H,OBUFF
	SHLD	xOBUFF
	RET
;
OUTFCB:	DB	0,0,0,0,0,0,0,0
	DB	0,'ASM',0,0,0,0
	DB	0,0,0,0,0,0,0,0
	DB	0,0,0,0,0,0,0,0
	DB	0
;
NDSERR:	LXI	D,NDSMSG ;'No directory space'
	JMP	EREXIT
;
NDSMSG:	DB	'No Directory Space'
	DB	CR,LF,BEL,0

;
OFEERR:	LXI	D,OFEMSG ;'Output file exists'

	CALL	PRTLIN
	CALL	CHKYES
	JNZ	ABORT
	LXI	D,OUTFCB
	MVI	C,nDEL
	CALL	BDOS
	JMP	CREAT4
;
OFEMSG:	DB	'Output File Already Exists'
	DB	' -- Delete it and Continue ? (Y/N) '
	DB	BEL,0

;
;	Put char in A to output file,
;	update column number.
;
PUTCHR:	PUSH	H
	PUSH	D
	PUSH	B
	PUSH	PSW

	STA	TEMP

	LHLD	xOBUFF
	MOV	M,A
	CPI	CR
	JZ	PUTCH0
	CPI	LF
	JZ	PUTCH0
	CPI	HT
	JNZ	PUTCH1
	LDA	COLNUM
	DCR	A
	ANI	NF8
	ADI	N09
	JMP	PUTCH2

TEMP:	DB	0
;
PUTCH0:	MVI	A,1
	JMP	PUTCH2
;
PUTCH1:	LDA	COLNUM
	INR	A
PUTCH2:	STA	COLNUM

	INX	H	;inc obuff ptr
	LDA	OBUFCT
	DCR	A	;dec obuff count
	JNZ	PTCH21
	MVI	A,RECLEN
PTCH21:	STA	OBUFCT

	MOV	A,H
	CPI	(OBUFF+OBFLEN)/256
	JNZ	PUTCH4
	MOV	A,L
	CPI	(OBUFF+OBFLEN) MOD 256
	JNZ	PUTCH4

	LXI	D,OBUFF
PUTCH3:
	MVI	C,nDMA
	PUSH	D
	CALL	BDOS
	POP	D

	XCHG

	LXI	D,OUTFCB
	CALL	WRTREC	;write record

	LXI	D,RECLEN
	DAD	D
	XCHG
	MOV	A,D
	CPI	(OBUFF+OBFLEN)/256
	JNZ	PUTCH3
	MOV	A,E
	CPI	(OBUFF+OBFLEN) MOD 256
	JNZ	PUTCH3

	LXI	H,OBUFF

PUTCH4:	SHLD	xOBUFF
	POP	PSW
	POP	B
	POP	D
	POP	H
	RET

;
;	Put line at HL to output file until 0.
;
PUTLIN:	MOV	A,M
	ORA	A
	RZ
	CALL	PUTCHR
	INX	H
	JMP	PUTLIN

;
;	Write record.
;
WRTREC:	MVI	C,nWRNR
	PUSH	H
	CALL	BDOS
	POP	H
	ANA	A
	RZ
	LXI	D,OFWMSG ;'output file write error'
	JMP	EREXIT
;
OFWMSG:	DB	'Output File Write Error'
	DB	CR,LF,BEL,0
;
;	Fill rest of obuff with EOF,
;	write record, and close file.
;
CLOSEO:	MVI	A,EOF
	CALL	PUTCHR
	LDA	OBUFCT
	CPI	RECLEN
	JNZ	CLOSEO
;
CLOSE1:
	LXI	D,OBUFF
	LHLD	xOBUFF
	MOV	A,H
	CMP	D
	JNZ	CLOSE3
	MOV	A,L
	CMP	E
	JNZ	CLOSE3
CLOSE2:
	LXI	D,OUTFCB
	MVI	C,nCLOSE
	JMP	BDOS
;
CLOSE3:	MVI	C,nDMA
	PUSH	D
	CALL	BDOS
	POP	D
	XCHG
	LXI	D,OUTFCB
	CALL	WRTREC
	LXI	D,RECLEN
	DAD	D
	XCHG
	LDA	xOBUFF+1
	CMP	D
	JNZ	CLOSE3
	LDA	xOBUFF
	CMP	E
	JNZ	CLOSE3
	JMP	CLOSE2

;*******************************************************

;
;	Print line at DE until 0
;	on console.
;
PRTLIN:	LDAX	D
	ANA	A
	RZ

	CALL	CONOUT

	INX	D
	JMP	PRTLIN
;
;	Console Output character in A.
;
CONOUT:	PUSH	PSW
	PUSH	B
	PUSH	D
	PUSH	H
	MOV	E,A
	MVI	D,N00
	MVI	C,nCOUT
	CALL	BDOS
	POP	H
	POP	D
	POP	B
	POP	PSW
	RET

;
;	Get char in A from CONSOLE and
;	return Z set if char.AND.5FH = 'Y'.
;
CHKYES:	MVI	C,nCIN
	CALL	BDOS
	PUSH	PSW
	CALL	CRLF
	POP	PSW
	ANI	0DFH
	CPI	'Y'
	RET

;
;	Return Z if no char available,
;	otherwise, get char in A.
;
CHKIN:	MVI	C,nCDAV
	CALL	BDOS
	ORA	A
	RZ
	MVI	C,nCIN
	CALL	BDOS
	RET

;
;
;
CRLF:	LXI	D,CRLFMG
	JMP	PRTLIN

;
;	If HL < base of bdos - 255
;	then return NC.
;	Otherwise, return C.
;
CHKBDOS:
	PUSH	D
	XCHG
	LHLD	BDOS+1
	DCR	H
	ORA	A
	CALL	SBCHLDE	; HL = ^bdos-^table
	XCHG
	POP	D
	RET

;
;	Convert upper case in A to lower case.
;
LCASE:	CPI	'A'
	RC
	CPI	'Z'+1
	RNC
	ORI	20H
	RET

;
;	Convert lower case in A to upper case.
;
UCASE:	CPI	'a'
	RC
	CPI	'z'+1
	RNC
	ANI	5FH
	RET

;
;	Prints the number in HL
;	as a decimal number.
;
PDNHL:
	LXI	D,10000
	CALL	PDDHL
	LXI	D,1000
	CALL	PDDHL
	LXI	D,100
	CALL	PDDHL
	LXI	D,10
	CALL	PDDHL
	MOV	A,L
	ADI	'0'
	JMP	CONOUT

;
;	Prints on console decimal digits of
;	the number in HL.  Call repetitively
;	with DE equal to 10000, 1000, 100, 10,
;	and 1.  Each call prints one digit.
;	Do not disturb HL between calls.
;	Enter with C = 0 to suppress leading
;	zeros or C = '0' to print leading zeros.
;
PDDHL:	MVI	B,'0'-1
PDD0:	INR	B
	ORA	A
	CALL	SBCHLDE
	JNC	PDD0
	DAD	D
	MOV	A,B
	CPI	'0'
	JNZ	PDD1
	CMP	C
	RNZ
PDD1:	MVI	C,'0'
	JMP	CONOUT

;
;
;	Puts to output file the number
;	in HL as a decimal number.
;
FDNHL:
	LXI	D,10000
	CALL	FDDHL
	LXI	D,1000
	CALL	FDDHL
	LXI	D,100
	CALL	FDDHL
	LXI	D,10
	CALL	FDDHL
	MOV	A,L
	ADI	'0'
	JMP	PUTCHR

;
;	Puts to output file decimal digits of
;	the number in HL.  Call repetitively
;	with DE equal to 10000, 1000, 100, 10,
;	and 1.  Each call prints one digit.
;	Do not disturb HL between calls.
;	Enter with C = 0 to suppress leading
;	zeros or C = '0' to print leading zeros.
;
FDDHL:	MVI	B,'0'-1
FDD0:	INR	B
	ORA	A
	CALL	SBCHLDE
	JNC	FDD0
	DAD	D
	MOV	A,B
	CPI	'0'
	JNZ	FDD1
	CMP	C
	RNZ
FDD1:	MVI	C,'0'
	JMP	PUTCHR

;
;	Print activity dot every 100 lines
;
PDOT:	LDA	LNCNT
	DCR	A
	STA	LNCNT
	RNZ
	MVI	A,'.'
	CALL	CONOUT
	MVI	A,100	; Dot every 100 lines
	STA	LNCNT

	LDA	DOTCNT
	DCR	A
	STA	DOTCNT
	JNZ	PDOT1
	MVI	A,' '
	CALL	CONOUT
	MVI	A,10	; Space every 10 dots
	STA	DOTCNT

PDOT1:	LDA	NLCNT
	DCR	A
	STA	NLCNT
	RNZ
	CALL	CRLF
	MVI	A,50	; 50 dots per line
	STA	NLCNT
	RET
;
LNCNT:	DB	100	; Dot every 100 lines
DOTCNT:	DB	10	; Space every 10 dots
NLCNT:	DB	50	; 50 dots per line

; Uninitialized data area

xCDISK:	DS	1
	DS	STCKLN
STACK:	EQU	$
SPBDOS:	DS	2
COLNUM:	DS	1
xOPCOD:	DS	2
OPCBUF:	DS	OPBFLN
xOPRND:	DS	2
xOBUFF:	DS	2
OBUFCT:	DS	1
OBUFF:	DS	OBFLEN
LBUFF:	DS	LBUFLN+3
xIBUFF:	DS	2
IBUFF:	DS	IBFLEN
UNKTBL:	DS	1

	END	START
