;==============================================================
;               ASM2ASSM by Martin Eberhard
; Converts an assembly language source code program that was
; written to assemble with Digital Research's ASM to a
; Processor Technology ASSM-compatible source code file.
;
; Usage:
;
; ASM2ASSM <source>[.ASM] [<dest>[.<ext>]]
;
;
; If no .ASM on the source file, then it is assumed to be .ASM
; If no <dest> then the detination will be named <source>.AS2
; If no <ext> on the destination file, then it will be '.AS2'.
;
;==============================================================
;
; 1. Line comments that begin with any combination of spaces
;    and tabs followed by a ';' are converted to ASSM line
;    comments with a ';' as the first character, with the
;    leading white space deleted. (page 2-6)
;
; 2. An XEQ line is created immediately following the first
;    ORG line found, with the execution address the same as
;    that ORG's address. (Page 3-2). The XEQ address is
;    announced on the CP/M console.
;
; 3. Line feeds, nulls, and CP/M EOF characters are stripped.
;
; 4. Any line beginning with anything but a semicolon, tab or
;    space is assumed to begin with a label. The labels are all
;    put into a table for later examination for uniqueness.
;    Colons (within or at the end of labels) are not stripped,
;    but they are also not considered part of the label, for
;    the uniqueness test.
;
; 5. The next item following an initial white space, or a label
;    then whitespace, is treated as an Opcode, unless it begins
;    with ';'. The next item after an Opcode is treated as an
;    Operand string, unless it begins with a ';'.
;
; 6. Any line that has a label but no Opcode (with or without
;    a comment) gets ' EQU $' appended after the label.
;
; 7. If a line has an Opcode but no Operand string, then a
;    dummy Operand ( a '.' character) is inserted, if that line
;    has a comment.
;
; 8. Any combination of spaces and tabs before the Opcode and
;    between the Opcode and the Operand string are replaced by
;    a single space.
;
; 9  Any combination of spaces and tabs after the Operand
;    string and before a comment (which starts with a ';') are
;    replaced by two spaces.
;
;10. If any line without a comment ends with any combination of
;    tabs and/or spaces, these tabs and/or spaces are deleted.
;
;11. All alphabetic characters in the Opcode field or Operand
;    string field are converted to uppercase, except characters
;    enclosed in single quotes within the Operand string.
;
;12. Exclamation points are treated as CR's (end of line)
;    unless they are within quotes in an Operand string.
;
;13. 'ENDIF' Operands get replaced by 'ENDF'
;
;14. On lines with 'DB' as the opcode, any quoted text longer
;    than one character is split off to a seperate line, with
;   'ASC' as its Opode. New 'DB' lines are created as needed.
;
;15. Syntax errors are reported on the console and in the
;    output file. Syntax errors are detected when parsing the
;    Operator string when 'DB' is the Opcode.
;
;16. All labels are checked to see that they are unique within
;    the first 5 characters. If not, conflicting label pairs
;    are reported to the console and at the end of the output
;    file.
;==============================================================
;Revision history
; 12 March 2015   M. Eberhard
;   Created
;==============================================================
;**************
; CP/M Equates
;**************

;---------------
;Program Equates
;---------------
RBSIZE	equ	8	;128-Byte records in the read buffer
WBSIZE	equ	8	;128-Byte records in the write buffer
MAXOPC	equ	8	;maximum allowed opcode length
MAXOPR	equ	64	;maximum allowed operand string length
DUMYOP	equ	'.'	;dummy operand for opcodes w/o operands

;------------------------------------------
;BDOS Entry Points and low-memory locations
;------------------------------------------
WBOOT	equ	0000H		;Jump to BIOS warm boot
;WBOOTA	equ	WBOOT+1		;Address of Warm Boot
;IOBYTE	equ	WBOOT+3
;CDISK	equ	WBOOT+4		;Login drive
BDOS	equ	WBOOT+5		;BDOS Entry Point
;BDOSA	equ	WBOOT+6		; First address of BDOS
				;(can overlay up to here)

;File Control Block
FCB1	equ	WBOOT+5CH	;CP/M file control blk
FCBDR	equ	0		;Offset to drive Descriptor
FCBFN	equ	1		;Offset to file name (8 chrs)
FCBFT	equ	9		;Offset to file Type (3 chrs)
;FCBEX	equ	12		;Offset to file extent

FNAME2	equ	WBOOT+6Ch	;CP/M puts 2nd file name here
FCPLEN	equ	16		;length of name copy

;COMBUF	equ	WBOOT+80H	;cmd line buffer
USAREA	equ	WBOOT+100H	;User program area

;-----------------------------------------
;BDOS Function Codes, passed in register C
;-----------------------------------------
;BRESET	equ	0	;System Reset
;BCONIN	equ	1	;Read Console Chr
BCONOT	equ	2	;Type Chr on Console
;BRDRIN	equ	3	;Read Reader Chr
;BPUNOT	equ	4	;Write Punch Chr
;BPRINT	equ	9	;Print $-terminated String
;BRDCON	equ	10	;Get Line from Console
;BCONST	equ	11	;Console Status (<>0 IF CHR)
;BDRST	equ	13	;Reset Disk
;BSDISK	equ	14	;select disk
BOPEN	equ	15	;Disk File Open
BCLOSE	equ	16	;Close disk file, FCB at de
;BSERCH	equ	17	;Search dir for file, FCB at de
;BDELET	equ	19	;delete file, FCB at (de)
BREAD	equ	20	;Read from Disk, 0=OK, <>0=EOF
BWRITE	equ	21	;Write next record, 0=OK, <>0=ERR
BMAKE	equ	22	;Make new file, 0FFH=BAD
;BCDISK	equ	25	;get current disk
BSTDMA	equ	26	;Set disk buffer to (de)

;----------------
;ASCII Characters
;----------------
;CTRLC	equ	3		;Control-C
TAB	equ	09h		;tab
LF	equ	0AH		;Linefeed
CR	equ	0DH		;Carriage return
EOFCHR	equ	1Ah		;CP/M EOF character
QUOTE	equ	27H		;single quote

;*********************
;* Beginning of Code *
;*********************
	org	USAREA		;normal place for CP/M programs

	lxi	SP,STACK	;local stack

	xra	a		;no labels yet
	sta	LBLBUF

;------------------------------------------------
;Get and validate the source and destination file
;names. Set up File Control Blocks for both.
;------------------------------------------------

;Check for a valid file name in FCB1

	lda	FCB1+FCBFN
	cpi	' '
	jz	HLPEXT		;no name: just help

;Copy the second given file name, extension, etc. to FCB2.

	lxi	h,FNAME2
	lxi	d,FCB2
	mvi	b,FCPLEN
	call	MOVBLK

;Write 0's into FCB1, where CP/M had put NAME2.

	xchg			;use 0's in FCB2
	lxi	d,FNAME2
	mvi	b,FCPLEN
	call	MOVBLK

;The dest name is in FCB2, and the source name is in FCB1.
;Did the source file have an extension? If not, make it .ASM

	lxi	h,ASMSTR	;'ASM'
	lxi	d,FCB1+FCBFT

	push	h
	push	d

	ldax	d
	cpi	' '		;any file type provided?
	cz	MOVE3		;n: make it ASM

	pop	d		;de=FCB1+FCBFT (src file type)
	pop	h		;hl=ASMSTR ('ASM' string)

;Check that the source file is type .ASM

	mvi	b,3		;3-byte extension

CELOOP:	ldax	d
	cmp	m		;match?
	jnz	STPERR		;n: file type error	

	inx	h
	inx	d
	dcr	b
	jnz	CELOOP		;check all 3 bytes

;If no destination file name was given, then it will be the
;same as the source.

	lxi	h,FCB1+FCBFN
	lxi	d,FCB2+FCBFN
	mvi	b,8

	ldax	d		;any name?
	cpi	' '
	cz	MOVBLK

;If the destination file has no file type, then make it 'AS2'

	lxi	h,AS2STR	;'AS2'
	lxi	d,FCB2+FCBFT
	ldax	d
	cpi	' '
	cz	MOVE3

;-----------------------------------------------
;The complete source FCB is set up in FCB1.
;The complete destination FCB is set up in FCB2.
;-----------------------------------------------

;Open the source file

	lxi	d,FCB1		;Input file control block

	mvi	c,BOPEN		;Open file function
	call	BDOS
	inr	a		;test for ff=file not found
	jz	FNFERR

;Create the destination file

	lxi	d,FCB2
	mvi	c,BMAKE		;Make file function
	call	BDOS
	inr	a		;test for FF=error
	jz	MAKERR		;Make error?

;*******************************************************
;Main Loop: Parse each line of the input file,
;and write converted lines to the output file.
;Along the way:
;  Remember every label found, for later uniqueness test
;  Keep track of the line number, for error messages
;*******************************************************
LINLUP:	lxi	h,LINLUP	;create return address
	push	h

	lhld	LINNUM		;next line number
	inx	h
	shld	LINNUM

	lxi	h,0FFh		;new line: clear EOL flag
	shld	EOLFLG		;also clears OPEFLG

;Look at the 1st character of the line to see if this is a
;blank line, a labeled line, a comment line, or a normal line

	mvi	c,0		;not within quotes now
	call	RDSRCE		;get 1st chr of line
	jz	DOEOL		;end of line already?

	cpi	';'		;comment?
	jz	GETCOM		;y: just move it over

	call	GETLBL		;Get a label, if there is one
	jz	DOEOL		;end of line already?

	cpi	';'		;comment-only line?
	jz	GETCOM		;y: just do a comment

;Read the opcode into the opcode buffer

	mov	b,a		;use uppercase version

	lxi	h,OPCBUF
	mvi	c,MAXOPC+1

	call	GETITM

;Unless end of line, read the operand into the operand buffer

	call	SKIPWS		;skip whitespace
	lxi	h,0
	shld	OPRBUF		;clears 2 bytes

	jz	SKPOPR		;end of line?

	lxi	h,OPRBUF	;if the next item is a comment
	mvi	m,DUMYOP	;..then install a dummy operand

	cpi	';'		;comment instead of operand?

	mvi	c,MAXOPR+1	;limit the operand length
	cnz	GETITM		;get the operand string, if any
SKPOPR:

;-------------------------------------------
;Test the opcode for those we must adjust:
; DB --> peel out the strings into ASC lines
; ENDIF --> change to ENDF
; ORG --> add XEQ after first ORG found
;-------------------------------------------
	lxi	h,OPTABL	;table of opcodes we fix

OSPCL1:	lxi	d,OPCBUF	;opcode is in the opcode buffer

OSPCL2:	ldax	d		;test a chr
	cmp	m		;match?

	jnz	OSPCL3		;n: try the next special opcode

	inx	h
	inx	d

	ora	a		;null terminator?
	jnz	OSPCL2		;n: test another chr

;This opcode matches one of the special opcodes
;dispatch to the special opcode processing subroutine

	mov	e,m		;get special processing address
	inx	h
	mov	d,m		;de = routine address

	lxi	h,FINLIN	;create return address
	push	h		;..on the stack

	xchg			;routine address to hl
	pchl			;go deal with special opcode

;No match. Try the next special opcode

OSPCL3:	mov	a,m		;search for end of opcode in
	inx	h		;..the special opcode table
	ora	a		;end?
	jnz	OSPCL3		;n: next opcode byte

	inx	h		;skip over address
	inx	h		;..in the table

	mov	a,m		;end of the table?
	ora	a
	jnz	OSPCL1		;n: try this opcode

;-----------------------------------------------------
;Done with special opcode processing. Copy the Opcode,
;Operand string, and comment to the destination file
;-----------------------------------------------------
FINLIN:	call	COPOPS

	lda	OPEFLG		;any opcode error?
	ora	a
	rz			;return to LINLUP	

;Error: the opcode string was too long.
;Report error and continue

	call	DPRINT
	db	'<---Too lon','g'+80h

;Fall into SYNERR and return to LINLUP

;***Subroutine*************
;Print syntax error message
;**************************
SYNERR:	call	DPRINT

	db	'---ASM2ASSM SYNTAX ERROR',CR,LF+80h

	ret

;--------------------------
;End of line or end of file
;--------------------------
DOEOL:	push	psw		;remember carry
	call	DPRINT		;write the line's CR
	db	CR+80h
	pop	psw

	rnc			;End of file? n: Ret to LINLUP

;End of file.

	pop	h		;chuck LINLUP return address

;-----------------------------
;Report number of errors found
;-----------------------------

	call	CILPRT
	db	'Total syntax errors:',' '+80h
	lhld	ERRCNT
	call	PDEC16

;-------------------------------------------------
;Scan the label list, looking for and printing any
;pairs that are not unique to 5 digits
;-------------------------------------------------
	lxi	h,LBLBUF

LHUNT:	mov	d,h
	mov	e,l
	push	h	;hl points to current label under test
	push	d

;hunt for de=beginning of next label

NXTLBL:	pop	d
	pop	h	;reset hl

	call	SCANL	;scan to next
	jz	NEXT1	;end of labels?

	push	h	;same old hl
	push	d	;de points to next label

;compare to label at de to label at hl

	mvi	b,5	;must be unique to 5

CHKLBL:	ldax	d
	cmp	m
	inx	d
	inx	h
	jnz	NXTLBL

	cpi	' '
	jz	MATCH

	dcr	b	;same first 5 chrs?
	jnz	CHKLBL

;report matching label

MATCH:	lxi	h,EOFFLG	;reuse this flag
	mov	a,m
	ora	a
	jnz	MATCH1

	inr	m		;remember we printed the message

	call	DPRINT
	db	'Label Conflicts detected by ASM2ASSM:',CR,LF+80h
	
	call	CILPRT
 db 'WARNING: ASSM requires the first 5 characters of labels to'
 db CR,LF
 db 'be unique. The following pairs of labels are not unique:'
 db CR,LF+80h
MATCH1:

	call	ILPRNT		;make it pretty
	db	' '+80h

	pop	d		;start of 2nd label
	pop	h		;start of 1st label
	push	h
	push	d

	call	PRINTL		;print ' ' terminated label
	xchg
	call	PRINTL

	call	ILPRNT		;CRLF to the console
	db	CR,LF+80h

	mvi	a,CR
	call	WRDEST		;and to the file

	jmp	NXTLBL

;Bump the label-under-test

NEXT1:	xchg
	call	SCANL
	xchg
	jnz	LHUNT

;Label scanning is done.

;----------------------
;Flush the write buffer
;----------------------

	call	FLSHWR		;flush the write buffer

;Fall into CL2EXT

;***Exit*********************************
;Close both disk files and return to CP/M
;****************************************
CL2EXT:	lxi	d,FCB2		;close the destination
	mvi	c,BCLOSE	;CP/M CLOSE FILE funct.
	call	BDOS
	inr	a		;-1 meant close error
	jz	DCERR		;destination close error

;Fall into CL1EXT

;***Exit**************************************
;Close the source disk file and return to CP/M
;*********************************************
CL1EXT:	lxi	d,FCB1		;close the source
	mvi	c,BCLOSE	;CP/M CLOSE FILE funct.
	call	BDOS
	inr	a		;-1 meant close error
	jz	SCERR		;source close error

;Fall into EXIT

;***Exit*****
;Exit to CP/M
;************
EXIT:	jmp	WBOOT

;***Subroutine*************
;Move 3 characters
;On Entry:
;  hl = source address
;  de = destination address
;**************************
MOVE3:	mvi	b,3

;Fall into MOVBLK

;***Subroutine*************
;Move a block of memory
;On Entry:
;  hl = source address
;  de = destination address
;   b = byte count
;**************************
MOVBLK:	mov	a,m
	stax	d
	inx	h
	inx	d
	dcr	b
	jnz	MOVBLK

	ret

;***Subroutine*****************************************
;Write inline string to destination file
;  The call to DPRINT is followed by a message string.
;  The last message chr has its msb set.
; On Exit:
;  Z and Carry cleared
; Trashes psw
;******************************************************
DPRINT:	xthl			;Save hl, get msg addr

DPLOOP:	mov	a,m
	ani	7Fh		;strip end marker

	call	WRDEST		;print byte
	mov	a,m		;end?
	inx	h		;Next byte
	ora	a		;msb set? (clears carry)
	jp	DPLOOP		;Do all bytes of msg

	xthl			;Restore hl,
				;..get return address
	ret

;***Subroutine*****************************************
;Write byte to destination file
;On Entry:
;  a = byte to write
;  WRBBC = number of free bytes in the write buffer >0
;  WRBPTR = next free location in the write buffer
;
;On Exit:
;  WRBPTR and WRBBC updated
;  Write buffer flushed if it became full
;
;trashes psw
;Rude exit (in FLSHWR on disk error
;******************************************************
WRDEST:	push	h
	lhld	WRBPTR
	mov	m,a
	inx	h
	shld	WRBPTR

	lhld	WRBBC		;free space counter
	dcx	h
	shld	WRBBC

	mov	a,h		;full?
	ora	l

	pop	h
	rnz			;n: done

;Fall into FLSHWR to flush the buffer

;***Subroutine*****************************************
;Write entire contents of write buffer to disk
;On entry:
;  WRBPTR = next free location in the write buffer
;  WRBBC = number of free bytes in the write buffer >0
;
;On Exit:
;  WRBPTR = WRBUF
;  WRBBC = WBSIZ*128
;
;trashes psw
;******************************************************
FLSHWR:	push	h
	push	d
	push	b

	lhld	WRBPTR		;Pointer into buffer
	xchg			;..into de

	lhld	WRBBC		;Free byte count

	mov	a,l		;Need to round up?
	ani	7Fh
	jz	FLWRB2		;Jump if on boundary

;Fill up to 128-byte boundary with nulls

	mov	b,a		;number of bytes to fill
	xra	a		;Clears carry too

FLWRB1:	stax	d
	inx	d
	dcr	l		;Adjust free-byte count
	dcr	b
	jnz	FLWRB1

;Compute b = number of free 128-byte records

FLWRB2:	mov	a,l
	ral
	mov	a,h		;High byte of free records
	ral			;a= # of free 128-byte records

	mov	b,a

;Compute number of 128-byte records to write

	mvi	a,WBSIZE
	sub	b		;a= # of 128-byte recs to write
	jz	FWDONE		;Quit if none	

	mov	b,a		;Write b 128-byte records

	lxi	h,WRBUF		;Start at buffer beginning
	shld	WRBPTR		;fix for return
	xchg			;..BDOS wants DMA address in de

	mvi	c,BSTDMA	;CP/M SET DMA function

;Loop to write b 128-byte records to disk

FLWRB3:	push	b		;count and BSTDMA
	push	d		;DMA address=buffer address
	call	BDOS

	lxi	d,FCB2		;Destination file control block
	mvi	c,BWRITE	;Write sequential
	call	BDOS
	pop	d		;buffer address

	ora	a		;Disk full error?
	jnz	ERRWRT

	lxi	b,128		;Bump de = next address
	xchg
	dad	b
	xchg
		
	pop	b		;count and BSTDMA
	dcr	b		;next record
	jnz	FLWRB3

	lxi	h,128*WBSIZE	;All bytes are free
	shld	WRBBC

FWDONE:	pop	b
	pop	d
	pop	h
	ret

;***Subroutine****************************************
;Get and remember a source file label, if there is one
;If the label is on a line by itself, or with just
;a comment, then make it '<label> EQU $'
;Each label goes in the list separated by a space.
;The last label has a null following its space.
;On Entry:
;  a = 1st chr of the line
;  c = 0 (not within quotes)
;
; On Exit:
;   Case 1 - EOF detected:
;     Carry set
;     Z set
;     RDBBC and RDBPTR no longer valid
;   Case 2 - CR (end of line):
;     Carry clear
;     Z set
;     a=b=CR
;     RDBBC and RDBPTR updated
;   Case 3 - anything else:
;     Carry clear
;     Z clear
;     a = new chr, converted to uppercase
;     b = new chr as it came
;     RDBBC and RDBPTR updated
;*****************************************************
GETLBL:	cpi	' '		;is 1st character whitespace?
	jz	SKIPWS		;y: there is no label here

LBLLUP:	cpi	':'		;not part of the label
	jz	LBL1

	lhld	LBLPTR
	mov	m,a		;remember label chr
	inx	h
	shld	LBLPTR
LBL1:
	call	WRDEST		;send uppercase version

	call	RDSRCE		;get another chr
	jz	GL0		;label with no more?

	cpi	' '		;end of label?
	jnz	LBLLUP		;n: get another chr

GL0:	lhld	LBLPTR
	mvi	m,' '		;end-of-label mark
	inx	h
	shld	LBLPTR
	mvi	m,0		;end-of-list mark

	call	SKIPWS		;skip following whitespace
	jz	GL2		;EOF or EOL?

	cpi	';'		;comment?
	jz	GL1		;y: need EQU $

	ora	a		;clear Z and carry
	ret

GL1:	ora	a		;clear Z and carry
	
;label with nothing after it

GL2:	push	psw		;save flags
	call	DPRINT		;y: make it <label> EQU $
	db	' EQU ','$'+80h

	pop	psw
	ret

;***Subroutine*******************************
;Copy the opcode and operand to the dest file
;and advance to comment, if there is one
; On Exit:
;   Case 1 - EOF detected:
;     Carry set
;     Z set
;     RDBBC and RDBPTR no longer valid
;   Case 2 - CR (end of line):
;     Carry clear
;     Z set
;     a=b=CR
;     RDBBC and RDBPTR updated
;********************************************
COPOPS:	call	DPRINT
	db	' '+80h		;ASSM-style whitespace

	lxi	h,OPCBUF
	call	PUTITM

;copy the operand (if there was one) to the destination file

	lda	OPRBUF		;was there an operand?
	ora	a
	mvi	a,' '
	cnz	WRDEST		;y: print a space

	lxi	h,OPRBUF
	call	PUTITM		;copy operand, if there was one

	lda	OPRBUF		;did we find the ; already?
	cpi	DUMYOP
	jz	SGTCOM		;y: ready for the comment

;Fall into GTSCOM

;***Subroutine************************************
;copy a comment from the source to the destination
;if there is one
; On Exit:
;   Case 1 - EOF detected:
;     Carry set
;     Z set
;     RDBBC and RDBPTR no longer valid
;   Case 2 - CR (end of line):
;     Carry clear
;     Z set
;     a=b=CR
;     RDBBC and RDBPTR updated
;*************************************************
GTSCOM:	call	SKIPWS		;skip whitespace before comment
	jz	COPOP1		;end of line?

;The rest of the line is a comment.

SGTCOM:	call	DPRINT
	db	' ',' '+80h	;ASSM pre-comment whitespace

;Fall into GETCOM

;***Subroutine************************************
;copy a comment from the source to the destination
; On Exit:
;   Case 1 - EOF detected:
;     Carry set
;     Z set
;     RDBBC and RDBPTR no longer valid
;   Case 2 - CR (end of line):
;     Carry clear
;     Z set
;     a=b=CR
;     RDBBC and RDBPTR updated
;*************************************************
GETCOM:	mvi	a,';'

COMLUP:	call	WRDEST
	mvi	c,0		;not within quotes
	call	RDSRCE
	mov	a,b		;lowercase is ok
	jnz	COMLUP		;go until CR

COPOP1:	push	psw		;remember carry flag
	call	DPRINT
	db	CR+80h
	pop	psw
	ret

;***Subroutine**********************
;Put an item in the destination file
;On Entry:
;  hl=address of 0-terminated item
;***********************************
PUTITM:	mov	a,m
	ora	a		;null termination?
	rz

	call	WRDEST
	inx	h
	jmp	PUTITM

;***Subroutine**********************************
;Get one item from the source file
;convert to uppercase, unless it's in quotes
;On Entry:
;    a = 1st character of the item (not a space)
;   hl = destination buffer address
;    c = max allowed bytes
;On Exit:
;   null-terminated string is in buffer
;   Z and carry set if EOF found
;   Z set, Carry cleared if end of line
;   Z cleared otherwise
;   OPEFLG set if item was too long
;trashes a,bc
;***********************************************
GETITM:	push	d
	mov	d,c		;d counts bytes
	mvi	c,0		;quote memory

	jmp	GIL0

QGILUP:	mov	m,b		;install as-received chr

GILOOP:	dcr	d		;too many chrs?
	jz	ILERR		;Item length error

	inx	h
	call	RDSRCE
	jz	GOTOP		;end of line or file?

GIL0:	mov	m,a		;uppercase version

	cpi	QUOTE		;was it a quote?
	jnz	GIL1
	inr	c		;toggle lsb
GIL1:
	mov	a,c
	rrc			;within quotes?
	jc	QGILUP		;y: ignore all

	mov	a,m
	cpi	' '		;end of item?
	jnz	GILOOP

	ora	a		;clear Z flag

GOTOP:	mvi	m,0		;0 marks the end
	pop	d
	ret

ILERR:	pop	d

	mvi	a,1		;remember opcode/operand error
	sta	OPEFLG

;Fall into KILLIN, return from there

;***Subroutine*************************
;Kill the rest fo the current line
;On Exit:
;   Z and carry set if EOF found
;   Z set, Carry cleared if end of line
;trashes a,b
;**************************************
KILLIN:	call	RDSRCE		;look for end of line
	jnz	KILLIN

	lhld	ERRCNT		;bump error count
	inx	h
	shld	ERRCNT

	call	CILPRT
	db	'Syntax error on line',' '+80h

	lhld	LINNUM
	call	PDEC16

	ret

;***Subroutine*************************************
;Scan the label list to the start of the next label
;On Entry:
;  de = address of a label character
;On Exit:
;  de = 1st address of next label
;  Z set if end of labels
;**************************************************
SCANL:	ldax	d
	ora	a	;end of all labels?
	rz

	cpi	' '	;end of this label?
	inx	d
	jnz	SCANL

	ora	a	;clear Z
	ret

;***Subroutine***************************
;Print space-terminated label both to the
;console and into the destination file
;On Entry:
;  hl = address of label
;****************************************
PRINTL:	mov	a,m
	call	PRINTA		;to the console
	mov	a,m
	call	WRDEST		;and to the destination file	
	mov	a,m
	inx	h
	cpi	' '		;done?
	jnz	PRINTL
	ret	

;***Subroutine*********************************
;Convert 'ENDIF' to 'ENDF' in the Opcode buffer
;**********************************************
DOENDF:	lxi	h,'F'		;also null terminator is in h
	shld	OPCBUF+3
	ret			;..to FINLIN

;***Subroutine**********************************
;Add XEQ line after an ORG line and announce
;XEQ address, only if this is the first ORG line
;***********************************************
DOORG:	lxi	h,ORGFLG	;already seen an ORG?
	mov	a,m
	ora	a
	rnz			;only one XEQ please

	inr	m		;we've seen one now

	call	COPOPS		;put  original opcode, operand
				;..and comment in dest file

	lxi	h,XEQSTR	;create XEQ line
	lxi	d,OPCBUF	;just like the ORG line
	call	MOVE3		;..but with no comment

;Announce XEQ address on the console

	call	CILPRT
	db	'XEQ address set to',' '+80h

	lxi	h,OPRBUF

XPLUP:	mov	a,m		;print XEQ address
	ora	a
	rz			;done with DOORG?
	call	PRINTA
	inx	h
	jmp	XPLUP	

;***Subroutine*******************************************
;Parse DB line in the Operand buffer, breaking out quoted
;strings that are longer than one character. These go on
;separate 'ASC' lines. This subroutine chucks the return
;address on the top of the stack, returning instead to
;LINLUP, which is next on the stack.
*********************************************************
DODB:	pop	h		;chuck return to FINLIN

	lxi	h,OPRBUF-1
	xra	a		;no db line open yet
	sta	DBFLAG

DBLOOP:	inx	h		;parse operand string
	mov	a,m
	cpi	' '		;skip spaces after commas
	jz	DBLOOP

	cpi	QUOTE		;quoted item?
	jnz	DODB1

	inx	h
	inx	h		;single-character?
	cmp	m
	dcx	h
	dcx	h
	jz	DODB1		;y: not ASC item

;----------------------------------------
;create ASC line from part of the DB line
;----------------------------------------
	lda	DBFLAG		;db line open?
	ora	a
	cnz	GTSCOM		;y: print comment, if there
				;..was one, and then a CR
	xra	a
	sta	DBFLAG		;no more open db line	

	call	DPRINT
	db	' ASC ',QUOTE+80h

ASCLUP:	inx	h		;copy the quoted string
	mov	a,m
	ora	a		;missing quote?
	jz	DBERR		;y: quote missing error

	call	WRDEST
	mov	a,m

	cpi	QUOTE		;end quote yet?
	jnz	ASCLUP		;n: copy another chr

	inx	h		;skip over the quote

	call	GTSCOM		;print comment, if there was one
	jmp	NEXTDB		;keep on parsing the DB line

;Error: the operand string ended without a close quote

DBERR:	call	DPRINT
 db CR,LF,'<---Missing end quot','e'+80h
	call	SYNERR

	jmp	KILLIN		;kill line, return to LINLUP

;----------------------------------------------------
;create a new DB line or add to an incomplete DB line
;----------------------------------------------------
DODB1:	mvi	c,0		;quote flag

	lda	DBFLAG		;already open db line?
	ora	a
	jz	DODB2		;n: open it

	call	DPRINT		;install seperator
	db	','+80h
	jmp	DODB3

DODB2:	inr	a
	sta	DBFLAG		;remember open DB line

	call	DPRINT
	db	' DB',' '+80h
DODB3:

;Loop to write the next DB item to the destination file

DODB4:	mov	a,m
	cpi	QUOTE
	jnz	DODB5
	inr	c		;toggle lsb

DODB5:	call	WRDEST		;write chr

	inx	h
	mov	a,m
	ora	a		;end?
	jz	NEXTDB		;n: keep going

	mov	a,c		;within quotes?
	rrc
	mov	a,m
	jc	DODB4		;y: commas are ok
	
	cpi	','		;seperator?
	jnz	DODB4

;----------------------------------------------------
;Finished one DB operand string item. Look for either
;a comma seperator or the end of the field. If
;niether, then this is a malformed operand string.
;----------------------------------------------------
NEXTDB:	mov	a,m		;another item?
	cpi	','		;seperator?
	jz	DBLOOP		;y: do it

	ora	a		;end of field?
	jz	GTSCOM		;print comment, if we haven't already
				;then return to LINLUP

;-----------------------------------------------------------
;Malformed DB Operand string: no comma after the close-quote
;and before another item wirthin the DB's operand string
;-----------------------------------------------------------
	call	DPRINT
	db	'<---Missing comm','a'+80h
	call	SYNERR

	jmp	KILLIN		;and return to LINLUP

;***Subroutine**************************************
;Skip over spaces in input file. (RDSRCE converts
;tabs into spaces and also eats nulls and LFs.)
; On Entry:
;   RDBBC = available bytes in the read buffer
;   RDBPTR = address of next buffer item
;
; On Exit:
;   Case 1 - EOF detected:
;     Carry set
;     Z set
;     RDBBC and RDBPTR no longer valid
;   Case 2 - CR (end of line):
;     Carry clear
;     Z set
;     a=b=CR
;     RDBBC and RDBPTR updated
;   Case 3 - anything else:
;     Carry clear
;     Z clear
;     a = new chr, converted to uppercase
;     b = new chr as it came
;     RDBBC and RDBPTR updated
;***************************************************
SKIPWS:	mvi	c,0		;not within quotes
	call	RDSRCE		;get a character, convert
				;..tabs to spaces
	rz			;EOF or EOL?

	cpi	' '		;space?
	jz	SKIPWS		;y: skip it

	ora	a		;clear carry and Z
	ret

;****Subroutine**********************************************
;Read one source file byte
;   Translations:
;     Tab are translated into spaces
;     Nulls are eaten
;     Linefeeds are eaten
;     exclamation points not within quotes are the same as CR
;
; On Entry:
;   lsb of c is 1 if within quotes
;   RDBBC = available bytes in the read buffer
;   RDBPTR = address of next buffer item
;
; On Exit:
;   Case 1 - EOF detected:
;     Carry set
;     Z set
;     RDBBC and RDBPTR no longer valid
;   Case 2 - CR (end of line):
;     Carry clear
;     Z set
;     a=b=CR
;     RDBBC and RDBPTR updated
;   Case 3 - anything else:
;     Carry clear
;     Z clear
;     a = new chr, converted to uppercase
;     b = new chr as it came
;     RDBBC and RDBPTR updated
;*************************************************************
RDSRCE:	lda	EOFFLG		;EOF already?
	ora	a		;0 means yes
	stc
	rz

	lda	EOLFLG
	ora	a
	rz

	push	h

RDSAGN:	lhld	RDBBC		;Buffer byte count
	mov	a,l		;Anything there?
	ora	h
	cz	FILRDB		;n: go fill the buffer
	jz	RDS4		;Z set if EOF, else hl=byte count

	dcx	h
	shld	RDBBC

	lhld	RDBPTR
	mov	a,m		;Actually get data
	inx	h
	shld	RDBPTR

	cpi	EOFCHR		;EOF in the file?
	jz	RDS4

	ora	a		;null?
	jz	RDSAGN		;y: eat it

	cpi	LF		;Linefeed?
	jz	RDSAGN		;y: eat it

	pop	h

	cpi	TAB		;translate tabs into spaces
	jnz	RDS1
	mvi	a,' '
RDS1:
	mov	b,a		;save original
	cpi	CR		;end of line?
	jz	RDS2

	mov	a,c		;within quotes?
	rrc
	mov	a,b
	jc	RDS3		;y: bang is text

	cpi	'!'		;bang?
	jnz	RDS3		;n: not eol

RDS2:	xra	a		;y: remember EOL
	sta	EOLFLG
	ret			;Z set, carry cleared

RDS3:	cpi	'a'		;lowercase?
	cmc
	rnc			;carry and z cleared
	ani	('a'-'A') xor 0FFh	;make it uppercase
	ret			;carry and z cleared

;EOF detected

RDS4:	xra	a
	sta	EOFFLG		;remember EOF found
	pop	h
	stc			;EOF
	ret			;ret with Carry and Z set			

;***Subroutine*****************************
;Read as many 128-byte disk sectors as will
;fit in the read bufffer, or until EOF
; ON EXIT:
;   RDBPTR = RDBUF
;   HL = NUMBER OF BYTES IN RDBUF
;   Z SET IF NO MORE DATA (EOF AND RDBBC=0)
;Trashes a
;******************************************
FILRDB:	push	d
	push	b

	mvi	b,WBSIZE	;WBSIZE 128-byte records
	lxi	h,RDBUF		;Reset file pointer
	shld	RDBPTR

	xchg			;de=buffer address
	mvi	c,BSTDMA	;CP/M SET DMA function

	lxi	h,0		;hl counts bytes

;Loop to read up to WBSIZE 128-byte records from disk into RBUFF

FLRDB1:	push	b		;record count and BSTDMA
	push	h		;byte count
	push	d		;buffer address=DMA Address
	call	BDOS		;Set DMA

	lxi	d,FCB1		;SOURCE FILE COTROL BLOCK
	mvi	c,BREAD		;Read sequential
	call	BDOS
	pop	d		;Buffer address
	pop	h		;Byte count

	ora	a
	jnz	FLRDB2		;EOF found?

	lxi	b,128		;bump de=buffer address
	xchg
	dad	b
	xchg

	dad	b		;hl has new byte count
		
	pop	b		;Count and BSTDMA
	dcr	b		;next 128-byte record
	jnz	FLRDB1

	push	b		;compensate for following pop

;Deterine of we got any data, and return

FLRDB2:	pop	b		;b=record count
	mvi	a,WBSIZE
	sub	b		;Set Z if b=WBSIZE

	pop	b
	pop	d

	ret

;***Subroutine*****************************************
;Print CR, LF, then In-line Message
;On Entry:
;  The call to ILPRNT is followed by a message string.
;  The last message chr has its msb set.
;Trashes psw
;******************************************************
CILPRT:	call	ILPRNT
	db	CR,LF+80h

; fall into ILPRNT

;***Subroutine*****************************************
;Print In-line Message
;On Entry:
;  The call to ILPRNT is followed by a message string.
;  The last message chr has its msb set.
;On Exit:
;  Z cleared
;Trashes psw
;******************************************************
ILPRNT:	xthl			;Save hl, get msg addr

IPLOOP:	mov	a,m
	ani	7Fh		;strip end marker
	call	PRINTA		;print byte
	mov	a,m		;end?
	inx	h		;Next byte
	ora	a		;msb set?
	jp	IPLOOP		;Do all bytes of msg

	xthl			;Restore hl,
				;..get return address
	ret

;***Subroutine*********************
;Print hl in decimal on the console
;with leading zeros suppressed
;On Entry:
;  de = value to print
;Trashes all registers
;**********************************
PDEC16:	mvi	d,0		;Suppress leading 0's

	lxi	b,-10000
	call	DECDIG
	lxi	b,-1000
	call	DECDIG
	lxi	b,-100
	call	DECDIG
	lxi	b,-10
	call	DECDIG

	mov	a,l		;last digit is simple
	jmp	DECDG0		;with leading 0's

;---Local Subroutine------------------------------
;Divide HL by power of 10 in bc and print result,
;unless it's a leading 0.
;On Entry:
;  hl=Dividend
;  bc=divisor (a negative power of 10)
;  d=0 if all prior digits were 0
;On Exit:
;  Quotent is printed, unless it's a leading 0
;  hl=remainder
;  d=0 iff this and all prior digits are 0
;-------------------------------------------------
DECDIG:	mvi	a,0FFh		;will go 1 too many times
	push	d		;leading zero state

DIGLP:	mov	d,h		;de gets prev value
	mov	e,l
	inr	a
	dad	b		;subtract power of 10
	jc	DIGLP

	xchg			;hl has remainder
	pop	d		;leading 0 state

	mov	e,a		;e has digit to print
	ora	d		;leading 0 to suppress?
	rz			;yes: digit is done

	mov	d,a		;don't suppress next digit
 
	mov	a,e	

DECDG0:	adi	'0'		;make digit ASCII

; fall into PRINTA

;***Subroutine*********************
;Print chr in a on the CP/M console
;**********************************
PRINTA:	push	h
	push	d
	push	b
	mvi	c,BCONOT
	mov	e,a
	call	BDOS
	pop	b
	pop	d
	pop	h
	ret

;***Error Exit***
;Disk write error
;****************
ERRWRT:	call	CILPRT
	db	'Write erro','r'+80h

	jmp	CL2EXT		;close both files and exit

;***Error Exit************
;Error closing source file
;*************************
SCERR:	call	ERROR
	db	' Can',QUOTE,'t close source fil','e'+80h

	jmp	EXIT

;***Error Exit*****************
;Error closing destination file
;******************************
DCERR:	call	ERROR
	db	' Can',QUOTE,'t close destination fil','e'+80h

	jmp	CL1EXT		;close the source and exit

;***Error Exit******
;File creation error
;*******************
MAKERR:	call	ERROR
	db	' Can',QUOTE,'t create fil','e'+80h

	jmp	CL1EXT		;close the source and exit

;***Error Exit*******
;File not found error
;********************
FNFERR:	call	ERROR
	db	'File not foun','d'+80h

	jmp	EXIT

;***Error Exit*********
;Source file type error
;**********************
STPERR:	call	ERROR
	db	'Source must be .AS','M'+80h

	jmp	EXIT

;***Subroutine*******************
;Print beginning of error message
;********************************
ERROR:	call	CILPRT
	db	'Error:',' '+80h
	jmp	ILPRNT		;print the rest of the error

;*********
;Help Exit
;*********
HLPEXT:	call	CILPRT

;    1234567890123456789012345678901234567890123456789012345678901234
 db '          ASM2ASSM 1.00 by M. Eberhard'
 db CR,LF,LF
 db 'Converts an ASM file to a PTDOS ASSM file'
 db CR,LF,LF
 db 'Usage:',CR,LF
 db ' ASM2ASSM <source>[.ASM] [<dest>[.<typ>]]'
 db CR,LF,LF
 db 'The source file must be .ASM, which will be assumed if'
 db CR,LF
 db 'ommitted. The destination will be <source>.AS2 if ommitted.'
 db CR,LF+80h

	jmp	EXIT

;***Table*****************************
;Opcodes that merit special processing
;*************************************	
OPTABL:	db	'ENDIF',0
	dw	DOENDF

	db	'ORG',0
	dw	DOORG

	db	'DB',0
	dw	DODB

	db	0		;end of table

;***Table*********
;3-letter strings
;*****************
ASMSTR:	db	'ASM'		;source file type
AS2STR:	db	'AS2'		;default destination file type
XEQSTR:	db	'XEQ'		;opcode that follows ORG line

;*********************
;Initialized Variables
;*********************
EOFFLG:	db	0FFh		;0 means EOF found
EOLFLG:	db	0FFh		;0 means End of Line found
OPEFLG:	db	0		;nz means opcode/operand error
				;must follow EOLFLG
ORGFLG:	db	0		;nz means ORG found
DBFLAG:	db	0		;nz means active DB field
LINNUM:	dw	0		;current line number
ERRCNT:	dw	0		;count of errors
RDBBC:	dw	0		;read buffer available byte count
RDBPTR:	dw	RDBUF		;read buffer pointer

WRBBC:	dw	128*WBSIZE	;write buffer free byte count
WRBPTR:	dw	WRBUF		;write buffer pointer

LBLPTR:	dw	LBLBUF		;label buffer pointer

;*************
; Buffers
;*************
;Initialized destination file control block

FCB2:	db	0		;(dr) use default drive
	db	'        '	;(f1-f8)
	db	'   '		;(t1-t3)
	db	0,0,0,0		;(ex,s1,s2,rc)
	dw	0,0,0,0,0,0,0,0	;(d0-d15)
	db	0,0,0,0		;(cr,r0,r1,r2)

;Opcode Buffer

OPCBUF:	ds	MAXOPC

;Operand buffer

OPRBUF:	ds	MAXOPR

;Local stack

	ds	64
STACK:

;Disk read data buffer

RDBUF:	ds	RBSIZE*128

;Disk write buffer

WRBUF:	ds	WBSIZE*128

;label buffer

LBLBUF:	ds	16384		;lots of labels

	END

