;==============================================================
; POLYTAPE
; Poly-88 Cassette Tape Utility
; This program runs under CP/M, and uses the POLEX ROM in a
; Poly-88 to access the casette tape hardware.
;
; This program provides the following functions:
;
;  CA [/B or /P]
;       Catalog files on tape, listing the header info for each
;       tape record found, as well as the text messages within
;       comment records
;
;  HP <ofile>.POL=<ifile>.HEX or
;  HP <file>
;       Converts .HEX file to .POL file. The file begins with a
;       comment record and ends with an auto-execute record.
;       The auto-exec address comes from the address field of
;       the terminating type 01 hex record, if there is one.
;       Otherwise,it is the address of the first data (type 00)
;       hex record.
;
;  LD <file>.POL or
;  LD <file>
;       Load & execute a .POL file from disk
;
;  LT <tfile> [/B or /P]
;        Load & execute tape file. /B selects Byte Format, /P
;        selects Polyphase Format tapes. The default is Byte
;        format.
;
;   PX   Quit to Polex
;
;   QU   Quit to CP/M
;
;   RT <file>.POL=<tfile> [/B or /P] or
;   RT <file> [/B or /P]
;        Read tape file to disk.  /B selects Byte Format, /P
;        selects Polyphase Format tapes. The default is Byte
;        format.
;
;   WT <tfile>=<file>.POL [/B or /P] or
;   WT <file>
;        Write disk file to tape. /B selects Byte Format, /P
;        selects Polyphase Format tapes. The default is Byte
;        format.
;==============================================================
; Revision History
;
; Rev 1.00  M. Eberhard  8 Jan 2014
;   Created
;
; to do:
;  allow data files to be created
;  allow load-without-execute
;  load the 'next' tape file
;  command-line load-and-execute
;======================================================
FALSE	equ	0
TRUE	equ	-1

DEBUG	equ	TRUE
;*************************
; Program Equates
;*************************
LBSIZE	equ	64		;input line buffer size
MAXDRV	equ	16		;max CP/M drives

;*******************
; Memory Allocation
;*******************
CPMLOC	equ	0CE00h		;beginning of 60K CP/M
RAMLOC	equ	0C000h		;code location in RAM
				;..as high as possible
				;..low byte must be 00

DBSIZE	equ	1024		;disk buffer size
				;..must be mult. of 256

;DSTBUF must follow SRCBUF

DSTBUF	equ	RAMLOC-DBSIZE	;disk source buffer
				;..low byte must be 00
DBMAX	equ	DSTBUF+DBSIZE	;max DSTBUF address+1
				;..low byte must be 00

SRCBUF	equ	DSTBUF-DBSIZE	;disk source buffer
				;..low byte must be 00
SBMAX	equ	SRCBUF+DBSIZE	;max DSTBUF address+1
				;..low byte must be 00

TRBUF	equ	SRCBUF-256	;256-byte tape record
				;... data buff -
				;..low byte must be 00

DSTFCB	equ	TRBUF-36	;second FCB for HEX2POL
DFCBDR	equ	DSTFCB		;Drive Descriptor
DFCBFN	equ	DSTFCB+1	;File name (8 chrs)
DFCBFT	equ	DSTFCB+9	;File Type (3 chrs)
DFCBEXT	equ	DSTFCB+12	;File extent within FCB

TBMAX	equ	RAMLOC		;tape buffer max address+1
				;..low byte must be 00, may
				;..overwrite other buffers

;**************
; CP/M Equates
;**************
;------------------------------------------
;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

SRCFCB	equ	WBOOT+5CH	;CP/M file control blk
SFCBDR	equ	SRCFCB		;Drive Descriptor
SFCBFN	equ	SRCFCB+1	;File name (8 chrs)
SFCBFT	equ	SRCFCB+9	;File Type (3 chrs)
SFCBEXT	equ	SRCFCB+12	;File extent within FCB
FCBCLR	equ	36		;# of bytes to clear


COMBUF	equ	WBOOT+80H	;disk & cmd line buffer
USAREA	equ	WBOOT+100H	;User program area

BLKSIZ	equ	128		;std CP/M block size

;-------------------------------------------
; BDOS Function Codes, passed in register C
; Note: CON:, RDR:, and PUN: I/O is done via
; direct BIOS calls, not BDOS calls.
;-------------------------------------------
;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)

;---------------------------------------------------------
; BIOS Entry Points, relative to the base address in WBOOT
;---------------------------------------------------------
CONST	equ	06h	;Console Status
CONIN	equ	09h	;Console Input
CONOUT	equ	0Ch	;Console output
;PUNCH	equ	12h	;punch output
;READER	equ	15h	;reader input

;**************************************
;POLY-88 CPU BOARD UART ASSIGNMENTS
;**************************************
;USARTD	EQU	00H	;SERIAL DATA
USARTS	EQU	01H	;SERIAL STATUS PORT
;UTXRDY	  EQU	  01H	  ;TRANSMITTER READY
;URXRDY	  EQU	  02H	  ;RECEIVER READY
;UTXMTY	  EQU	  04H	  ;TRANSMITTER EMPTY
;UMOD16	  EQU	  4EH	  ;8 BITS, 1 STOP, NO PARITY, X16
UMODSN	  EQU	  0CH	  ;Sync mode, 2 sync chrs, 8 bits
UCMDRE	  EQU	  40H	  ;RESET USART
UCRXEN	  EQU	  96H	  ;ENABLE hunt, RX, DTR, RTS ON, reset
UCTXEN	  EQU	  21H	  ;ENABLE TX, RTS on

;***********************************
; POLEX ENTRY POINTS
;***********************************
PBASE	equ	0F400h		;Polex base address
PXINIT	EQU	PBASE		;RESTART POLEX
;PXCSTA	EQU	PBASE+03H	;CONSOLE STATUS
;PXCIN	EQU	PBASE+06H	;CONSOLE INTO A
;PXCOUT	EQU	PBASE+09H	;CONSOLE OUT C. A=C ON ret
PXSSTA	EQU	PBASE+0CH	;SERIAL PORT STATUS
PXSIN	EQU	PBASE+0FH	;SERIAL PORT IN
PXSOUT	EQU	PBASE+12H	;SERIAL PORT OUT
PXSOST	EQU	PBASE+15H	;SERIAL PORT OUTPUT STATUS
PXBAUD	EQU	PBASE+18H	;SET SERIAL PORT BAUD RATE
;PXIHEX	EQU	PBASE+1BH	;SCAN PAST BLANKS, GET HEX VAL
				;HL=VALUE
				;DE ADVANCED PAST CHR
				;Z SET, CARRY CLEAR IF VALUE
				;CARRY SET IF NO VALUE FOUND
;PXOHEX	EQU	PBASE+1EH	;PRINT A AS HEX ON THE CONSOLE
;PXWARM	EQU	PBASE+21H	;WARM-START RE-ENTRY
;PXCIN2	EQU	PBASE+24H	;TEST KBD STATUS, RZ IF NO CHR
				;IF CHR, ABORT IF CABKEY
				;ELSE ret WITH CHR IN A, NZ
 if not debug
PXOFBD	EQU	PBASE+27H	;Select offboard memory
PXONBD	EQU	PBASE+2AH	;Select onboard memory
 endif

;*********************
; Poly-88 Tape Equates
;*********************
SYNC	equ	0E6h
SOH	equ	01h

;******************
; ASCII Characters
;******************
ESC	equ	1Bh	;Escape for user-abort
LF	equ	0AH	;Linefeed
CR	equ	0DH	;Carriage return

;*********************
;* Beginning of Code *
;*********************
	ORG	USAREA	;normal place for CP/M programs

;-----------------------------------------
;Copy code to high memory, so that Poly-88
;onboard memory may be selected
;-----------------------------------------

	lxi	b,RAMEND-RAMSRC		;BYTE COUNT
	lxi	d,RAMEND		;END OF RAM SOURCE
	LXI	h,RAMEND-RAMSRC+RAMLOC	;END OF DEST

MOVER:	dcx	d
	dcx	h

	ldax	d			;GET A BYTE
	mov	m,a			;PUT A BYTE

	dcx	b			;BUMP COUNT
	mov	a,b
	ora	c			;DONE?
	jnz	MOVER

;hl=execution address

;--------------------------------------------------
;Get and save BIOS address, so it will be available
;even when onboard memory is enabled
;--------------------------------------------------
	lda	WBOOTA+1	;get BIOS base address
	sta	BIOS+ROF	;..just the high byte

;--------------------
;Print sign-on banner
;--------------------
	call	CILPRT+ROF
 db '=============================================',CR,LF
 db '=   POLYTAPE Tape Utility for the Poly-88   =',CR,LF
 db '= Vers. 1.00  By M. Eberhard  January, 2014 =',CR,LF
 db '=============================================',CR,LF
 db 'Type ? for command','s'+80h

;Go to moved code

	pchl

;**************************************************
; Low memory buffer space
; Not available of ONBRD
;**************************************************
TAPBUF	equ	$		;tape file buffer
				;as big as possible,

;-----------------------------------------------
;All the following code executes in high memory,
;with addresses offset by ROF
;-----------------------------------------------
RAMSRC:
ROF	EQU	RAMLOC-RAMSRC	;RAM OFFSET

;*************************************************
; COMMAND PROCESSOR MAIN ENTRY POINT
; GETS AND PROCESS COMMANDS
; SP GETS FIXED, IN CASE OF RE-ENTRY FROM AN ERROR
;**************************************************
MAIN:	lxi	sp,STACK+ROF	;SP=local stack

;Re-enable offboard memory

	call	PXOFBD

;Clear counters

	lxi	h,0
	shld	RECCNT+ROF	;record count
	shld	CSECNT+ROF	;checksum error count

;Clear both FCBs

	mvi	b,FCBCLR
	lxi	h,SRCFCB
	LXI	D,DSTFCB
	xra	a

FCBCLP:	mov	m,a
	stax	d
	inx	h
	inx	d
	dcr	b
	jnz	FCBCLP+ROF

;Clear flags
	sta	FIRSTR+ROF	;1st record flag
	sta	EOFFLG+ROF	;EOF flag

;Default file name characters to space

	lxi	h,SFCBFN
	lxi	d,DFCBFN
	mvi	b,8+3		;file name & extension
	mvi	a,' '

FCNCLP:	mov	m,a
	stax	d
	inx	h
	inx	d
	dcr	b
	jnz	FCNCLP+ROF

;Initialize buffer pointers

	lxi	h,DSTBUF
	shld	DBPTR+ROF	;beginning of dest
	shld	SBPTR+ROF	;..is the end of source too

	lxi	h,TRBUF
	shld	TRBPTR+ROF

;Print the prompt, and get a line of user input

	call	CILPRT+ROF
	db	'%'+80h

	lxi	h,MAIN+ROF	;create return address
	push	h		;..on the stack

	mvi	c,BRDCON	;input line from console
	lxi	d,COMBUF
	mvi	a,LBSIZE
	stax	d
	call	BDOS

	lxi	d,COMBUF+1	;byte count
	ldax	d		;byte count
	mov	b,a		;b=input buffer byte count
	inx	d		;de=input characters

	call	SKIPB+ROF	;find 1st command chr
	rz			;none: done

	call	GETUC+ROF	;get uppercase chrs
	mov	l,a		;1st chr

	call	GETUC+ROF	;get uppercase chrs
	mov	h,a		;2nd chr	

	push	d
	lxi	d,COMTAB+ROF-2	;point to command table

;Search through table at de for 2-chr match of hl

NXTCOM:	inx	d		;skip routine address
	inx	d

	ldax	d
	inx	d
	ora	a		;table end?
	jz	ERROR+ROF	;error:not in table

	xra	l		;compare first chr
	mov	c,a		;remember result

	ldax	d
	inx	d
	xra	h		;compare second chr
	ora	c		;both chrs match?
	
	jnz	NXTCOM+ROF	;No match: keep looking

;Got a match. Get routine address and go there

	ldax	d		;low byte of routine addr
	mov	l,a
	inx	d
	ldax	d		;high byte
	mov	h,a		;hl=address of routine

	pop	d		;de=input pointer
				;b=byte count

	call	SKIPB+ROF	;skip blanks

; b=remaining input byte count
; de=address of 1st parameter character
; hl=address of command routine
; Z set if no parameters

	pchl			;go execute command

 if debug
PXONBD:
PXOFBD:	ret
 endif

;******Command Routine******
; ? (Help)
;***************************
HELP:	call	CILPRT
;    1234567890123456789012345678901234567890123456789012345678901234
 db '               Polytape Commands',CR,LF,CR,LF
 db 'CA [/B or /P]                    Catalog files on tape'
 db CR,LF
 db 'HP <ofile>.POL=<ifile>.HEX       Convert .HEX file to .POL file'
 db CR,LF
 db 'LD <file>.POL                    Load & execute .POL file'
 db CR,LF
 db 'LT <tfile> [/B or /P]            Load & execute tape file'
 db CR,LF
 db 'PX                               Quit to Polex'
 db CR,LF
 db 'QU                               Quit to CP/M'
 db CR,LF
 db 'RT <file>.POL=<tfile> [/B or /P] Read tape file to disk'
 db CR,LF
 db 'WT <tfile>=<file>.POL [/B or /P] Write disk file to tape'
 db CR,LF,CR,LF
 db '/B selects Byte Format tape; /P selects Poly Format tape'
 db CR,LF+80h

	ret		;to main

;******Command Routine*****************************************
; HP (Convert .HEX file to .POL file)
;
; Command Forms:
;   HP <CP/M file>.POL=<CP/M file>.HEX
;   HP <CP/M file>
;
; File format:
;  Comment record
;  Data records as needed
;  Auto-Execute record
;     if a type-1 record is found, then the auto-exec address
;     is the address from that record. Otherwise, the auto-exec
;     address is the address from the 1st record
;
; Use SRCFCB for the source (.HEX) file, reading disk data to
; fill SRCBUF when it is empty. SBPTR is the data-out pointer
; for SRCBUF.
;
; Use DSTFCB for the destination (.POL) file, writing completed
; Poly-88 records there, and emptying it to disk when it is
; full. DBPTR is the data-in pointer for DSTBUF.
;
; Use TRBUF to gather record data as the Poly-88 records are
; being built. TRBPTR is the data-in pointer for TRBUF.
;
; On Entry:
;  de points to next command line chr
;**************************************************************
HX2POL:	lxi	h,DSTFCB
	call	GETFIL+ROF	;get dest file name
	jnz	H2P1+ROF	;2nd command form?

;Z set means 2nd form of command

;Copy file name from DSTFCB into SRCFCB

	lxi	h,SRCFCB+1
	lxi	d,DSTFCB+1

	mvi	c,8		;8 letters in name

H2PNLP:	ldax	d
	mov	m,a
	inx	h
	inx	d
	dcr	c
	jnz	H2PNLP+ROF

;Make source file .HEX

	mvi	m,'H'
	inx	h
	mvi	m,'E'
	inx	h
	mvi	m,'X'

;Make dest file .POL

	xchg			;hl=DFCBFT
	call	MAKPOL+ROF
	jmp	H2P2+ROF

;1st form of command: get source file name

H2P1:	lxi	h,SRCFCB
	call	GETFIL+ROF	;get source file name

;Validate file names

	lxi	h,DSTFCB+9	;make sure dest is .POL
	call	CHKPOL+ROF

	lxi	h,SRCFCB+9	;make sure source is .HEX
	cz	CHKHEX+ROF
	jnz	ERROR+ROF

;Create file name in TAPNAM for tape, used in every
;Poly-88 record

H2P2:	call	CTNAME+ROF

;Open the source file for reading

	call	FOPEN+ROF

;Create destination file for writing. If file exists,
;ask before deleting.

	call	CREATE+ROF

;-----------------------------------------
;Create a Poly-88 comment record in DSTBUF
;-----------------------------------------

;Create comment characters in TRBUF

	lxi	h,PCOMNT+ROF	;0-terminated comment
	lxi	d,TRBUF

CCOPY:	mov	a,m
	stax	d
	inx	h
	inx	d

	ora	a
	jnz	CCOPY+ROF

	dcx	d		;delete null terminator

	mvi	b,8
	lxi	h,SFCBFN	;file name

NCOPY:	mov	a,m
	cpi	' '
	jz	NCDONE+ROF

	stax	d
	inx	h
	inx	d
	dcr	b
	jnz	NCOPY+ROF
NCDONE:

	mvi	a,'.'		;dot before file type
	stax	d
	inx	d

	mvi	b,3
	lxi	h,SFCBFT	;file type

TCOPY:	mov	a,m
	stax	d
	inx	h
	inx	d
	dcr	b
	jnz	TCOPY+ROF

;Use data in TRBUF to create Poly-88 comment record in DSTBUF

	mov	c,e		;e is byte count
	inr	b		;b=1: comment record

	lxi	h,0		;blank address field
	call	MAKP88+ROF	;write comment record

;----------------------------------------------
;Read hex records from SRCBUF, and write their
;data to TRBUF.Whenever TRBUF has enough data,
;create a Poly-88 record in DSTBUF.
;----------------------------------------------

;Eat all chrs until we get a record-start colon

GETCOL:	call	DGBYTE+ROF
	cpi	':'
	jnz	GETCOL+ROF

;restart checksum, then get 4-byte record header
; c gets 1st byte = data byte count
; h gets 2nd byte = address high byte
; l gets 3rd byte = address low byte
; b gets 4th byte = Hex record type

	lxi	d,4		;init cksum, count 4 bytes

;Shift in the 4 header bytes: c <- h <- l <- b

HEDRLP:	mov	c,h		;c=byte 1: byte count
	mov	h,l		;h=byte 2: address MSB
	mov	l,b		;l=byte 3: address LSB
	call	GDHEX+ROF	;Get a hex byte, do checksum
	dcr	e
	jnz	HEDRLP+ROF
	mov	e,b		;e=byte 4=record type

; c = data byte count
; hl = record address
; e = record type
; d = checksum so far

;Save auto-exec address, if this is the 1st record

	lda	FIRSTR+ROF
	ora	a
	jnz	NOT1ST+ROF

	shld	EXADR+ROF	;execution address
	shld	RECADR+ROF	;record address too

	inr	a		;no longer 1st record
	sta	FIRSTR+ROF

	jmp	IS1ST+ROF	;no need to flush

NOT1ST:

;See if this record immediately follows the previous record
;(compare PRVADR to hl). close out previous record and
;start a new one if not sequential

	push	d
	xchg
	lhld	PRVADR+ROF	;previous last address+1
	xchg
	mov	a,h
	xra	d
	mov	b,a
	mov	a,l
	xra	e
	pop	d
	ora	b		;continuing from previous rec?

	cnz	P88NSD+ROF	;n: close out old rec, start new

IS1ST:	mvi	b,0		;compute last address
	dad	b		;this record's address + c
	shld	PRVADR+ROF

	lhld	TRBPTR+ROF	;buffer pointer for data

;Bump c to account for the checksum byte, and test for either
;kind of end record: type 0 with no data will cause the auto-
;exec address to be the address from the first data record.
;Type 1 (with no data) will set the auto-exec address according
;to its address field.

	mov	a,c		;C=BYTE COUNT + 1
	inr	c		;..TO GET CHECKSUM TOO

	ora	a		;0-BYTE RECORD?
	jnz	DLENTR+ROF	;NO: GO GET DATA

;0-byte record. if type 0, the execution address is already
;set to the address of the 1st record. if type 1 record,
;set the execution address accordong to the record
	
	dcr	e		;type 1 record?
	mov	e,c		;make any record type 1
	jnz	TYPE0+ROF

	lhld	PRVADR+ROF	;this record's address
	shld	EXADR+ROF	;..is the exec address

TYPE0:	db	21h		;'LXI H' OPCODE SKIPS 2
				;..BYTES TO ENTER BYTLE

;Loop to get hex data and store it in the buffer at hl.
;also compute checksum, and load checksum at the end.

DATALP:	mov	m,b
	inx	h

	mov	a,h		;record data buffer full?
	sui	TRBUF/256+1
	cz	P88DAT+ROF	;y:go create a data record

DLENTR:	call	GDHEX+ROF
	dcr	c
	jnz	DATALP+ROF

	shld	TRBPTR+ROF	;save buffer pointer

	ora	a		;checksum should be 0
	jnz	HCSERR+ROF	;nz means error

;All done with record. Check record type.

	mov	a,e		;record type
	ora	a		;RECORD TYPE 0 IS NORMAL DATA
	jz	GETCOL+ROF	;YES: GO GET ANOTHER RECORD

	dcr	a		;RECORD TYPE 1 IS EOF
	jnz	HRTERR+ROF

;Create auto-execute record

	lhld	EXADR+ROF	;hl get exec address
	lxi	b,3*256		;0 bytes, auto-execute record
	call	MAKP88+ROF

	jmp	FLSHDB+ROF	;flush the disk buffer

;===Local Subroutine==================
; Get 2-digit hex value from disk file
; also add result to checksum in d
; On Entry:
;   d=checksum so far
; On Exit:
;   b=new byte
;   a=d=d+a
;   z set if checksum is 0
;=====================================
GDHEX:	call	GHXNIB+ROF
	add	a		;shift up 4
	add	a
	add	a
	add	a
	mov	b,a		;temp save

	call	GHXNIB+ROF
	add	b
	mov	b,a		;temp save

	add	d		;compute checksum
	mov	d,a

	ret

;===Local Subroutine==============================
; Get an ASCII hex digit and convert it to binary
; On Exit:
;   a=result
;   abort if bad hex
;=================================================
GHXNIB:	call	DGBYTE+ROF	;get nibble
	sui	'0'		;Remove ASCII bias
	cpi	10
	rc			;if 0-9 then we're done

	sui	'A'-'9'-1	;Subtract gap to ASCII A
	cpi	10		;Gap character?
	jc	ASCERR+ROF	;y: error
	cpi	10H		;Above ASCII F?
	rc			;n: return with good result

;Fall into ASCERR

;===HEX Error Routine======
; ASCII ERROR
;==========================
ASCERR:	call	CILPRT+ROF
	db	'Abort: ASCI','I'+80h
	jmp	HABORT+ROF

;===HEX Error Routine======
; Record type error
;==========================
HRTERR:	call	CILPRT+ROF
	db	'Abort: Record Typ','e'+80h
	jmp	HABORT+ROF

;===HEX Error Routine======
; Hex Checksum Error
;==========================
HCSERR:	call	CILPRT+ROF
	db	'Abort: Checksu','m'+80h

;Fall into HABORT

HABORT:	call	ILPRNT+ROF
	db	' Erro','r'+80h

	call	FLSHDB+ROF	;flush buffer, close file

	jmp	MAIN+ROF

;-----------------------------
;Initial comment record phrase
;-----------------------------
PCOMNT:	db	'Created by POLYTAPE.COM from ',0

;******Command Routine***********************
; CA (Catalog Tape Files)
;
; Command Form:
;   CT [/B or /P]
;
; On Entry:
;  de points to next command line chr
;********************************************
CATTAP:	call	TAPSPD+ROF	;get tape speed, set up USART
	mvi	a,UCRXEN	;enable receiver
	out	USARTS

	call	TSTART+ROF	;ask user to start tape

	call	CILPRT+ROF
	db	'Esc to qui','t'+80h

;Spin reading tape headers until user types Escape.
;Print all header specifics, as well as the contents
; of any comment (type 1) records

CTLOOP:	lxi	h,HDRBUF+ROF
	call	GHEAD+ROF
	dcr	b		;record type=1?
	cz	TCOMNT+ROF	;y: display comment

	jmp	CTLOOP+ROF

;******Command Routine**************************************
; RT (Read Tape to disk)
;
;   Reads specified tape file and writes it to disk. Records
;   that do not have the specified name are ignored.
;
; Command Forms:
;   RT <CP/M file>.POL=<tapefile> [/B or /P]
;   RT <filename> [/B or /P]
;
; On Entry:
;  de points to next command line chr
;***********************************************************
RDTAPE:	lxi	h,DSTFCB
	call	GETFIL+ROF	;get the file name
	jnz	RDTP1+ROF	;2nd command form?

;Z set means 2nd form of command

	lxi	h,DFCBFT
	call	MAKPOL+ROF	;make it .POL

;copy file name from DSTFCB into TAPNAM

	call	CTNAME+ROF

	jmp	RDTP2+ROF	;2nd form of command

;NZ means 1st form of command

RDTP1:	call	GETTFN+ROF	;get tape file name
	jnz	ERROR+ROF	;no '=' allowed

	lxi	h,DFCBFT
	call	CHKPOL+ROF	;is disk file type .POL?
	jnz	ERROR+ROF	;n: error

RDTP2:	call	TAPSPD+ROF	;get tape speed, set up USART
	mvi	a,UCRXEN	;enable receiver
	out	USARTS

;Tell user to start the tape

	call	TSTART+ROF

;-----------------------------------------------
;load all records with matching file name, until
;end record or autoexec record is found
;-----------------------------------------------

	lxi	h,TAPBUF	;store it all in RAM

;Write sync

RDTP3:	mvi	b,16		;16 sync chrs into buffer

SFLOOP:	mvi	m,SYNC		;write 16 sync chrs
	inx	h
	dcr	b
	jnz	SFLOOP+ROF

	mvi	m,SOH		;write the SOH
	inx	h

;Search for record with matching name

RDTP4:	call	GHEAD+ROF	;matching name?
	jnz	RDTP4+ROF	;n: keep looking

	lxi	d,15		;skip over header
	dad	d		;..and checksum

;What kind of record?
; c=record byte count
; b=record type:
;   0 = absolute binary (c data bytes)
;   1 = comment (c comment chrs, don't care about cksum)
;   2 = end (no data bytes)
;   3 = auto-execute (no data bytes)
;   4 = data (c data bytes)
; hl = buffer address

	mov	a,b
	sui	2		;end record?
	cpi	2		;..or autoexec record?
	jc	RDTP5+ROF	;y:done

	mov	a,b
	cpi	5		;legal record type?
	jnc	PRTERR+ROF	;record type error

	call	TGBLOK+ROF	;get c bytes into (hl)

	mov	m,a		;checksum into buffer
	inx	h

	jz	RDTP3+ROF	;cksum okay: go get another

	dcr	b		;type 1 may have bad cksum
	cnz	CSERR+ROF	;checksum error.
				;ask if we should continue
	jmp	RDTP3+ROF

;End record. turn off tape motor, disable USART (a=0 here)	
	
RDTP5:	out	USARTS

;------------------------------------
;Write all data in the buffer to disk
;------------------------------------

;hl=last data address+1
;Compute hl=the number of 128-byte sectors to write

	lxi	d,-TAPBUF
	call	SECCNT+ROF	;hl=sectors, rounded up

;Write hl sectors from buffer to .POL file on disk

	call	CREATE+ROF	;create file

	lxi	d,TAPBUF	;data source
	call	DWRITE+ROF	;write data
	call	FCLOSE+ROF	;close file

;-----------------------------
;Report record and error count
;-----------------------------

	call	CILPRT+ROF
	db	'Matching records found:',' '+80h
	lhld	RECCNT+ROF
	call	PHEXHL+ROF

	call	CILPRT+ROF
	db	'Checksum errors:',' '+80h

	lhld	CSECNT+ROF
	call	PHEXHL+ROF

;Fall into TXCOMP

;***Subroutine************
; Report complete transfer
; and stop the tape
;*************************
TXCOMP:	call	CILPRT+ROF
	db	'Transfer complet','e'+80h
	ret

;******Command Routine*************************
; WT (Write Tape from Disk)
;
; This just copies the contents of the .POL
; disk file to tape, without any interpretation
;
;   Writes specified .POL file to tape
;
; Command Forms:
;   WT <tapefile>=<CP/M file>.POL [/B or /P]
;   WT <filename> [/B or /P]
;
; On Entry:
;  de points to next command line chr
;**********************************************
WRTAPE:	call	GETTFN+ROF	;get tape file name
	jnz	WRTP1+ROF	;2nd command form?

;Z set means 2nd form of command

	lxi	h,SFCBFT
	call	MAKPOL+ROF	;make it .POL

;Copy file name into FCB

	push	d
	lxi	h,TAPNAM+ROF
	lxi	d,SFCBFN
	mvi	c,8		;8 letters in name

WRTNLP:	mov	a,m
	stax	d
	dcr	c
	jnz	WRTNLP+ROF

	pop	d

	jmp	WRTP2+ROF	;2nd form of command

;NZ means 1st form of command

WRTP1:	lxi	d,SRCFCB
	call	GETFIL+ROF	;get the file name
	jnz	ERROR+ROF	;no '=' allowed

	lxi	h,SFCBFT	;file type
	call	CHKPOL+ROF	;is disk file type .POL?
	jnz	ERROR+ROF	;n: error

WRTP2:	call	TAPSPD+ROF	;get tape speed, set up USART

;---------------------------------------------------
;Read disk file into the source buffer, using SRCFCB
;---------------------------------------------------

	call	FOPEN+ROF
	xra	a		;clear EOF flag
	sta	EOFFLG+ROF
	mvi	b,TBMAX/256	;max address high byte+1
	lxi	d,TAPBUF	;de=address for data

	push	d
	call	DREAD+ROF	;not necessary to close
				;c=0 if no data read
				;de=end address
	pop	h		;hl=starting address

	lda	EOFFLG+ROF	;did we reach the EOF?
	ora	a
	jz	OVERR+ROF	;no EOF: address overflow

	mov	a,e		;compute de=bytes read
	sub	l
	mov	e,a
	mov	a,d
	sbb	h
	mov	d,a

	ora	e		;any bytes read?
	jnz	EOFERR+ROF	;n:unexpected EOF

;-------------------------
;Write entire file to tape
;-------------------------

;Tell user to start the tape, wait for user

	call	TSTART+ROF

;Send de bytes from TAPBUF to USART

	lxi	h,TAPBUF

WRTDL:	mov	c,m
	call	PXSOUT
	inx	h
	dcx	d
	mov	a,d
	ora	e
	jnz	WRTDL+ROF

;---------------------------------------------------
;Transfer complete. Tidy up, report details & return
;---------------------------------------------------

;Stall so transmit buffer and USART can empty

	lxi	h,0		;stall 0.95 S
WRTSTL:	dcx	h		;(7)
	mov	a,l		;(5)
	ora	h		;(4)
	jnz	WRTSTL+ROF	;(11)27 cycles=14.6 uS

	out	USARTS		;stop the tape

	jmp	TXCOMP+ROF	

;******Command Routine***********************
; LT (Load & execute a tape file)
;
; Command Forms:
;   LT <tapefile> [/B or /P]
;   (LT [/B or /P] in the future?)
;
; On Entry:
;  de points to next command line chr
;********************************************
LDTAPE:	call	GETTFN+ROF	;get tape file name
	jnz	ERROR+ROF	;no '=' allowed

	call	TAPSPD+ROF	;get tape speed, set up USART
	mvi	a,UCRXEN	;enable receiver
	out	USARTS

;tell user to start the tape

	call	TSTART+ROF

;-----------------------------------
;Load all records with matching file
;anme, until the end marker is found
;-----------------------------------

;Hunt for header

LTHUNT:	lxi	h,LTHUNT+ROF	;create loop return address
	push	h

	lxi	h,HDRBUF+ROF
	call	GHEAD+ROF	;get & test a tape header
	rnz			;hunt for correct header

;Check record type

	call	CHEKRT+ROF	;also sets hl to HDRADR
	rnz			;if not binary or comment

	jc	TCOMNT+ROF	;print comment of type 1

;Binary data record: load record into memory at hl

	call	PXONBD		;enable onboard memory
	call	TGBLOK+ROF	;load c data bytes into (hl)
				;z set if checksum ok
	call	PXOFBD		;disable onboard memory

	cnz	CSERR+ROF	;NZ means checksum error.
				;ask if we should continue

	ret			;keep going if no cksum error

;******Command Routine***********************
; LD (Load & execute a disk .POL file)
;
; Command Form:
;   LD <CP/M file>.POL
;
; On Entry:
;  de points to next command line chr
;********************************************
LDDISK:	lxi	H,SRCFCB
	call	GETFIL+ROF	;get the file name
	jnz	ERROR+ROF	;no = allowed

	lxi	h,SFCBFT	;file type
	mov	a,m
	cpi	' '
	cz	MAKPOL+ROF	;y:make it .POL

	lxi	h,SFCBFT	;file type
	call	CHKPOL+ROF	;error if not .POL
	jnz	ERROR+ROF

;Open disk file using SRCFCB

	xra	a		;clear EOF flag
	sta	EOFFLG+ROF

	call	FOPEN+ROF

;---------------------------------
;Get disk data and process records
;---------------------------------

;Get record header

LDHEAD:	lxi	h,LDHEAD+ROF	;create loop return
	push	h

	call	DGBYTE+ROF	;get disk chr
LDSYNC:	cpi	SYNC		;Sync chr?
	rnz			;n: keep looking

	call	DGBYTE+ROF	;get disk chr
	cpi	SOH		;SOH Chr
	jnz	LDSYNC+ROF	;n: keep looping

;Read & report the 14-byte header plus checksum
;into HDRBUF. This assumes all records belong to
;the file, regardless of name.
	
	lxi	h,HDRBUF+ROF
	push	h
	mvi	c,14		;14-byte header
	call	DGBLOC+ROF	;get header
	pop	h		;header address

	call	REPHDR+ROF	;report header, check cksum

	lhld	RECCNT+ROF	;bump record count
	inx	h
	shld	RECCNT+ROF

;Check record type

	call	CHEKRT+ROF	;z means binary record
				;hl=address from record
	rnz			;returns to LDHEAD

	jnc	DGBLOC		;go get absolute data

;Comment record c bytes long.
;Note that comments don't require correct checksum

	mov	h,c		;byte count

	call	CILPRT+ROF
	db	'  ','"'+80h

DCOMLP:	call	DGBYTE+ROF	;get a disk byte
	mov	c,a
	call	TYPEC+ROF	;print it
	dcr	h
	jnz	DCOMLP+ROF

	call	ILPRNT+ROF
	db	'"'+80h
	ret			;to LDHEAD	

;***Subroutine***************************************
; Get c data bytes from the disk source buffer, write
; them into (onboard) memory starting at hl
; On Entry:
;   c = number of bytes to get
;  hl = starting address in onboard memory
; On Exit:
;  hl = hl+c
;  Error-abort if EOF before c bytes found
; trashes a
;****************************************************
DGBLOC:	push	d
	xra	a		;clear checksum
	mov	d,a

DGLOOP:	call	DGBYTE+ROF	;get a disk byte
	mov	e,a		;temp save chr
	add	d		;compute checksum
	mov	d,a

	call	PXONBD		;enable onboard memory
	mov	m,e		;write to memory
	call	PXOFBD		;disable onboard memory

	inx	h		;point to next
	dcr	c
	jnz	DGLOOP+ROF	;go till done

	call	DGBYTE+ROF	;get checksum
	add	d		;compute checksum

	pop	d

	cnz	CSERR+ROF	;nz means checksum error.
				;report & bump error count
	ret

;***Subroutine***********************************
; Get one byte from the disk buffer. First refill
; the buffer from disk, if it's empty.
; on entry:
;   SBPTR = address of next buffer byte
;   this assumes buffer is n X 256 bytes
;   and the buffer is 256 byte aligned
; On Exit:
;   a=next chr
;   error abort if no data left in file
;   buffer gets cleared as it gets read
;   SBPTR points to the next buffer chr in DSKBUF
; trashes a
;************************************************
DGBYTE:	push	h

	lhld	SBPTR+ROF
	mov	a,h		;anything in the buffer?
	cpi	SBMAX/256
	cz	FILLSB+ROF
	jz	EOFERR+ROF	;unexpected EOF

	mov	a,m		;get buffer chr
	mvi	m,0		;clear buffer

	inx	h		;point next
	shld	SBPTR+ROF

	pop	h
	ret			;z cleared

;***Subroutine*****************************************
;Compute hl=the number of 128-byte sectors to write,
;and pad last incomplete sector with 00's if necessary
; ---> Entry is at SECCNT <---
; On Entry:
;   hl = last data address+1
;   de = 0-first data address
; On exit:
;   hl = number of 128-byte records, rounded up
;    z set if hl is zero
; trashes a
;******************************************************

;Pad last sector with 00's if necessary
;(Subroutine entry is at SECCNT.)

PADLP:	mvi	m,0		;pad
	inx	h

SECCNT:	mov	a,l		;end on a sector's end?
	add	a		;shift left 1
	jnz	PADLP+ROF	;n: pad another byte

;Compute hl= number of 128-byte sectors

	dad	d		;hl = byte count

	mov	a,l		;compute sectors
	ral
	mov	a,h
	ral
	mov	l,a		;low byte done
	mvi	a,0
	ral			;any high-byte carry?
	mov	h,a		;high byte done
	ora	l		;zero sectors?
	ret	

;***Subroutine*************************
;copy file name from DSTFCB into TAPNAM
; trashes a,c,de
;**************************************
CTNAME:	push	d
	lxi	d,TAPNAM+ROF
	lxi	h,DFCBFN
	mvi	c,8		;8 letters in name

CTNLP:	mov	a,m
	stax	d
	inx	h
	inx	d
	dcr	c
	jnz	CTNLP+ROF

	pop	d
	ret

;***Subroutine******************************************
;Check Record type
; On Entry:
;   b = record type
;  HDRADR+ROF = address field from header
; On return:
;   hl = address from HDRADR
;    if b=0, (absolute binary record)
;       then return with carry clear, z set
;    if b=1 (comment record)
;       then return with carry set, z set
;    if b=2 (end record)
;       then report status on console and jump to MAIN
;    if b=3 (auto-execute record)
;       if CSECNT=0, then execute at hl
;       if CSECNT<>0 then report error & jump to MAIN
;    if b>3 then ret z and carry cleared
; trashes a
;*******************************************************
CHEKRT:	lhld	HDRADR+ROF	;get header address

	mov	a,b		;get record type

	sui	2		;end or autoexec?
	cpi	2		;(type 2 or 3)
	jc	LEND

	inr	a	
	stc
	rz			;1=comment record?

	cmc			;clear carry
	inr	a		;0=absolute binary record?
	ret			;set Z if so

;End record or autoexec record

LEND:	push	h		;record addr is exec addr

	call	CILPRT+ROF
	db	'Records loaded:',' '+80h

	lhld	RECCNT+ROF
	call	PHEXHL+ROF

	lhld	CSECNT+ROF	;any checksum errors?
	mov	a,h
	ora	l
	jz	LTEND1+ROF	;execute, if exec record

	call	CILPRT+ROF
	db	'Load failed with ',' '+80h
	call	PHEXHL+ROF
	call	ILPRNT+ROF
	db	'Checksum error','s'+80h

	xra	a
	mov	b,a		;don't execute if errors
	out	USARTS		;stop tape

LTEND1:	mov	a,b		;auto-exec record?
	cpi	3
	jnz	MAIN+ROF	;n: was an end record

;Auto-exec record: enable onboard memory and execute code
 if debug
	jmp	MAIN+ROF
 endif

	jmp	PXONBD		;enable onboard memory
				; execute at requested address
	
;***Subroutine**********************************************
; Load tape comment record's text, and display it on the
; console. Note that comments don't require correct checksum
; On Entry:
;  c = comment byte count
; Trashes a,c,h
;***********************************************************
TCOMNT:	mov	h,c		;byte count	

	call	CILPRT+ROF
	db	'  ','"'+80h

TCOMLP:	call	TGBYTE+ROF	;get a USART byte
				;lets user abort, trashes de
	mov	c,a
	call	TYPEC+ROF	;print it

	dcr	h
	jnz	TCOMLP+ROF

	call	ILPRNT+ROF
	db	'"'+80h

	ret

;***Subroutine************************************
; Ask user to start tape, answer ready
; trashes a,c
;*************************************************
TSTART:	call	CILPRT+ROF
	db	'Start the tape now. Read','y'+80h

;Fall into ASKYN

;***Subroutine************************************
; Ask user Y or N
; return if Y, abort if N
; trashes a,c
;*************************************************
ASKYN:	call	ILPRNT+ROF
	db	' (Y/N)','?'+80h

	mvi	a,CONIN		;get user input
	call	GOBIOS+ROF

	mov	c,a
	call	TYPEC+ROF	;echo
	mov	a,c
	ani	'y' xor 'Y' xor 0FFh
	cpi	'Y'
	rz

	jmp	ABORT+ROF	;abort if anything but Y

;***Subroutine***************************************
; Get Tape Record Header, report results, and
; compare name to desired header name
; On Entry:
;   hl = address for header
;   TAPNAM = desired file name
; On Exit:
;       b=record type
;       c=record byte count
;   (hl) got the following data:
;       8 bytes file name
;       2 bytes record number
;       1 byte data byte count
;       2 bytes address
;       1 byte record type
;       1 byte header checksum
;
;  If record match:
;    hl = address of next byte after header checksum
;     z set
;
;  if no record match:
;    z cleared
;    hl unchanged
;
;   Record info has been written to console
;   trashes a,de
;  
;****************************************************
GHEAD:
;Start the USART

SYNCU:	mvi	a,UCRXEN	;Enabe USART Rx and hunt
	out	USARTS		;Also start motor

;Search for the beginning of the block

GTSYNC:	call	TGBYTE+ROF	;get a USART byte
				;lets user abort, trashes de
GTSYN1:	cpi	SYNC		;Sync chr?
	jnz	SYNCU+ROF	;Resync USART

	call	TGBYTE+ROF	;get a USART byte
				;lets user abort, trashes de
	cpi	SOH		;SOH Chr
	jnz	GTSYN1+ROF

;Read the 14-byte header plus checksum

	push	h		;remember address
	mvi	c,14		;14-byte header
	call	TGBLOK+ROF	;get header
	cnz	CSERR+ROF	;NZ means checksum error.
				;ask if we should continue

	mov	m,a		;checksum into buffer

	pop	h		;beginning of header
	call	REPHDR+ROF	;report header on console

;Compare name in header to desired name

	push	h		;save header address
	push	b		;save results

	lxi	d,TAPNAM+ROF	;desired name
	mvi	c,8		;8-byte names

TNCOMP:	ldax	d
	cmp	m
	jnz	GTHDON+ROF	;No match: ret NZ

	inx	d
	inx	h
	dcr	c
	jnz	TNCOMP+ROF	;check the whole name

;Bump record count

	lhld	RECCNT+ROF	;bump record count
	inx	h
	shld	RECCNT+ROF

GTHDON:	pop	b		;recover results
	pop	h		;restore address
	ret			;with Z correct

;***Subroutine*******************************
;report header to console
; abort if header checksum error
; On Entry:
;   hl = address of header
; On exit:
;    b = record type
;    c = byte count (unless type 2 or 3)
;   hl = unchanged
;********************************************
REPHDR:	push	h		;save for ret

;Print the record number

	lxi	d,8		;point to record number
	dad	d
	call	CILPRT+ROF
	db	'RCD ','#'+80h

	mov	e,m		;get 2-byte record number
	inx	h
	mov	d,m		;..into de

	xchg			;print de in hex
	call	PHEXHL+ROF
	xchg

;Print the file name

	pop	h		;name is at beginning
	push	h

	call	ILPRNT+ROF
	db	' NAME',':'+80h

	mvi	b,8		;8-byte name
ECHONM:	mov	c,m
	call	TYPEC+ROF
	inx	h
	dcr	b
	jnz	ECHONM+ROF

;Then the record type

	lxi	d,5
	dad	d

	call	ILPRNT+ROF
	db	' TP',':'+80h
	mov	a,m
	call	PHEXA+ROF	;print a in hex
	mov	b,m		;save for ret

;The address field if record not type 1 or 2

	dcx	h
	dcx	h

	mov	a,b
	dcr	a
	cpi	2
	jc	RPHD1+ROF

	call	ILPRNT+ROF
	db	' ADDR',':'+80h

	mov	e,m		;get 2-byte record number
	inx	h
	mov	d,m		;..into de
	dcx	h

	xchg			;print de in hex
	call	PHEXHL+ROF
	xchg
RPHD1:

;Then the byte count, unless types 2 or 3


	mov	a,b
	sui	2
	cpi	2
	jc	RPHD2+ROF

	call	ILPRNT+ROF
	db	' LN',':'+80h

	dcx	h
	mov	a,m		;is it a 00?
	ora	a
	mvi	c,'1'
	cz	TYPEC+ROF	;y: it's really 100
	mov	a,m
	call	PHEXA+ROF
	mov	c,m		;save for ret

RPHD2:	pop	h

	ret

;***Subroutine***********************************
; Read Tape data block with checksum
; On Entry:
;   hl= destination address for data
;    c= number of bytes, counting checksum
; On Exit:
;   hl=hl+c
;   a=checksum byte from received data
;   e=computed checksum
;   Z set if checksum correct
;   c,d trashed
;************************************************
TGBLOK:	mvi	e,0		;initial checksum

;Loop to get all data bytes

TGBLK1:	mov	a,h		;overflow?
	cpi	TBMAX/256
	jz	OVERR+ROF	;overflow error
	call	TGBYTE+ROF
	mov	m,a		;save byte
	inx	h
	dcr	c
	jnz	TGBLK1+ROF

;Fall into TGBYTE to get & test checksum

;***Local Subroutine***********************
; get one USART byte and add it to checksum
; Abort if user presses Escape
; On entry:
;   e=checksum so far
; On Exit:
;   a=USART byte
;   e=computed checksum
; trashes d
;******************************************
TGBYTE:	call	CHKESC+ROF	;user abort?
	call	PXSSTA		;anything in USART?
	jz	TGBYTE+ROF	;spin, checking user too

	call	PXSIN		;get a USART byte
	mov	d,a		;temp store
	add	e		;compute checksum
	mov	e,a
	mov	a,d
	ret

;*****Subroutine***************************************
;Check for Escape on the console, and quit if so
; trashes a
;******************************************************	
CHKESC:	mvi	a,CONST		;anything on console?
	call	GOBIOS
	ora	a		;0 means no chr waiting
	rz

;Chr waiting: Take a look

	mvi	a,CONIN		;read the typed chr
	call	GOBIOS
	cpi	ESC
	rnz			;ignore everything else

;Fall into Abort due to Escape

;***Abort***********************
; Print Abort and return to Main
;*******************************
ABORT:	call	CILPRT+ROF
	db	'Abor','t'+80h
	jmp	MAIN
	
;***SUBROUTINE*********************************
; Get tape speed from input buffer
; Set up BRG
; Set the USART up for sync mode if P 
; On Exit:
;  c=06h and z clear for Byte mode (default)
;  c=05h and z set for poly mode
;  BRG is set up correctly
;  USART has been set up
;**********************************************
TAPSPD:	mvi	c,06h		;default Byte mode
	call	SKIPB+ROF	;skip blanks
	rz

	cpi	'/'
	jnz	ERROR+ROF
	call	GETUC+ROF	;skip over /
	call	GETUC+ROF	;get chr
	cpi	'B'
	jz	TPASP1+ROF
	dcr	c		;Poly mode
	cpi	'P'
	jnz	ERROR+ROF

TPASP1:	call	SKIPB		;no more allowed
	jnz	ERROR+ROF	

;Set up USART and baud rate based on C

	mov	a,c		;set baud rate and
	call	PXBAUD		;..select cassette interface

	mov	a,c
	cpi	6		;Poly Format?
	rz			;z correct for ret

;Set the USART up for sync mode 

	lxi	h,SYNTAB+ROF

TAPSP2:	mov	a,m
	out	USARTS
	inx	h
	ora	a		;last byte is a 0
	jnz	TAPSP2+ROF

	ret

;USART setup table for Poly-format synchronous mode

SYNTAB:	db	0AAh		;fake sync chr
	db	UCMDRE		;select control port
	db	UMODSN		;8 bit 2-sync mode
	db	SYNC		;1st sync chr
	db	SYNC		;2nd sync chr
	db	0		;tx & rx off for now

;***Subroutine***********************************
; Get tape file name
; On Entry:
;    b = # of remaining bytes in input buffer
;    c = max allowed characters + 1
;   de = input buffer pointer
; On Exit:
;   file name in TAPNAM
;   Z set, Carry clear if end of line or space
;   Z & carry clear if end with =
;************************************************
GETTFN:	lxi	h,TAPNAM+ROF
	mvi	c,9		;8 chr max

GETN2:	call	GETNAM+ROF
	rnc
	jmp	ERROR+ROF	;no file type allowed

;***SUBROUTINE*********************************
; Make file type in FCB .POL
; On Entry:
;   hl=address of file type within FCB
; On Exit:
;   a,hl trashed
;   z flag unchanged
;**********************************************
MAKPOL:	mvi	m,'P'
	inx	h
	mvi	m,'O'
	inx	h
	mvi	m,'L'

	ret

;***SUBROUTINE*********************************
; check for .HEX file
; On Entry:
;   hl=address of file type within FCB
; On Exit:
;   Z set of .POL
;   a,hl trashed
;**********************************************
CHKHEX:	mov	a,m
	cpi	'H'
	rnz
	inx	h
	mov	a,m
	cpi	'E'
	rnz
	inx	h
	mov	a,m
	cpi	'X'
	ret

;***SUBROUTINE*********************************
; check for .POL file type in FCB
; On Entry:
;   hl=address of file type within FCB
; On Exit:
;   z set if file is .POL
;   a,hl trashed
;**********************************************
CHKPOL:	mov	a,m
	cpi	'P'
	rnz
	inx	h
	mov	a,m
	cpi	'O'
	rnz
	inx	h
	mov	a,m
	cpi	'L'
	ret

;***SUBROUTINE**************************************
; Get disk file name from user, store it in the FCB
; On Entry:
;   b=remaining bytes in LINBUF
;  de=address of next input chr
;  hl=FCB address
;  name and type in FCB are filled with ' '
; On Exit:
;   Z set, Carry clear if end of line or space
;   Z & carry clear if end with =
;   File name and type are in FCB 
;   rude exit to ERROR if too many chrs
;***************************************************
;test to see if a drive has been specified

GETFIL:	push	h		;remember FCB address

	inx	d		;test 2nd chr
	ldax	d
	cpi	':'
	dcx	d
	cz	GETDR+ROF

;get file name

	mvi	c,9		;8 chrs for a file name
	inx	h		;file name after drive disc.

	call	GETNAM+ROF
	pop	h		;recover FCB address
	rnc			;done if no '.'
	
;get file type

	push	d
	lxi	d,9		;point to extension
	dad	d
	pop	d
	mvi	c,4		;3 chrs for file type
	jmp	GETN2+ROF	;Recycle some code

;***Local Subroutine**************************
;Get Drive Descriptor and save it in the FCB
; On entry:
;   b=remaining bytes in LINBUF
;  de=address of next input chr
;   hl=address for drive descriptor in the FCB
;   (de+1) is know to be a ':'
; ON Exit:
;  (de)=drive descriptor from input
;   de = de+2
;**********************************************
GETDR:	call	GETUC+ROF	;get drive descriptor
	sui	'A'
	cpi	MAXDRV+1
	jnc	ERROR+ROF
	inr	a		;since 0 means default
	mov	m,a		;drive descriptor into FCB

;Fall into GETUC to skip over colon

;***SUBROUTINE****************************
;Get input chr, convert to upper case
; On Entry:
;   b=remaining bytes in LINBUF
;  de=address of next input chr
; On Exit:
;   a= uppercase chr
;   a=0 and Z set if no chr available
;  if chr, de incremented & b decremented
;*****************************************
GETUC:	mov	a,b
	ora	a		;any characters left?
	rz			;n: done

	ldax	d		;get next chr
	inx	d
	dcr	b

	cpi	'A'		;below letters?
	rc			;y:done

	ani	'A' xor 'a' xor 0FFh
				;make it uppercase
				;clears Z too
	ret

;***Subroutine***********************************
; Get File Name
; On Entry:
;    b = # of remaining bytes in input buffer
;    c = max allowed characters + 1
;   de = input buffer pointer
;   hl = address of destination for the file name
; On Exit:
;    b = # of remaining bytes in input buffer
;   de = updated input buffer pointer
;   found name is at (hl)
;   Carry set if ended with '.'
;   Z set, Carry clear if end of line or space
;   Z & carry clear if end with =
;   rude jump to ERROR if too many chrs
;************************************************
GETNAM:	call	GETUC+ROF
	rz			;end of input?

	cpi	' '		;end
	rz

	cpi	'.'		;separator?
	stc
	rz			;y: ret with carry

	cpi	'='		;also legal
	jz	GETN1+ROF

	dcr	c
	jz	ERROR+ROF	;error if > max chrs	

	mov	m,a
	inx	h

	jmp	GETNAM+ROF

GETN1:	ora	a		;clear Z flag
	ret

;***SUBROUTINE************************
; Scan past spaces in COMBUF, looking
; for the first non-space character 
; On Entry:
;  b=remaining bytes in COMBUF
; de=address of next input chr 
; ON EXIT:
;   Z set if end of input
;   a=next non-blank byte, if any
;*************************************
SKIPB:	mov	a,b
	ora	a		;any characters left?
	rz			;n: done

	ldax	d		;get next chr
	cpi	' '		;space?
	rnz			;ret if we're past them

	inx	d		;next buffer chr
	dcr	b
	jmp	SKIPB+ROF	;keep skipping

;*****Subroutine********************************
;Call BDOS while preserving de and hl
;a,bc trashed
;***********************************************
GOBDOS:	push	d
	push	h
	call	BDOS
	pop	h
	pop	d
	ret

;***SUBROUTINE****************************
; Print hl as 4 hex digits on the console
; trashes a,c
;*****************************************
PHEXHL:	mov	a,h
	call	PHEXA+ROF
	mov	a,l

;Fall into PHEXA

;***EXTERNAL SUBROUTINE******************
; Print A as 2 hex digits on the console
; trashes a,c
;****************************************
PHEXA:	push	psw		;GET THE CHARACTER
	rrc			;movE THE HIGH FOUR DOWN
	rrc
	rrc
	rrc
	call	PNIBLE+ROF	;PUT THEM OUT
	pop	psw		;THIS TIME THE LOW FOUR

;Fall into PNIBLE

;===LOCAL SUBROUTINE=========================
; Print low nibble of A in hex on the console
; trashes a,c
;============================================
PNIBLE:	ani	0FH		;FOUR ON THE FLOOR
	adi	'0'		;WE WORK WITH ASCII HERE
	cpi	'9'+1		;0-9?
	jc	PNIB2+ROF	;YUP: PRINT & retURN

	adi	'A'-'9'-1	;MAKE IT A LETTER

PNIB2:	mov	c,a

;Fall into TYPEC

;*****Subroutine******************
; Print character in c on console
; trashes a
;*********************************
TYPEC:	mvi	a,CONOUT	;BIOS WR Console func

;Fall into GOBIOS

;*****Subroutine**********************
; Call a BIOS driver directly
; On Entry:
;   c=value for BIOS routine, if any
;   a = BIOS call address offset
; On Return:
;   a is as BIOS returned it
;   all other regs preserved
;*************************************
GOBIOS:	push	b
	push	d
	push	h

	call	GOBIO2+ROF

	pop	h
	pop	d
	pop	b
	ret

GOBIO2:	lhld	BIOS+ROF-1	;h= BIOS base address
	mov	l,a		;a has jump vector
	pchl

;*****Subroutine***************************************
; Print CRLF, then In-line Message
;  The call to CILPRT is followed by a message string.
;  The last chr of the string has its msb set
;  Note: this routine still works when ONBRD
; Trashes c
;******************************************************
CILPRT:	call	ILPRNT+ROF		;CR,LF first
	db	CR,LF+80h

;Fall into ILPRNT

;*****Subroutine***************************************
; Print In-line Message
;  The call to ILPRNT is followed by a message string.
;  The last chr of the string has its msb set
;  Note: this routine still works when ONBRD
; Trashes c
;******************************************************
ILPRNT:	xthl			;Save hl, get msg addr

IPLOOP:	mvi	a,7Fh		;strip end marker
	ana	m
	mov	c,a
	call	TYPEC+ROF	;print byte
	mov	a,m
	rlc			;end of string?
	inx	h		;point past message
	jnc	IPLOOP+ROF	;Do all bytes of msg

	xthl			;Restore hl,
				;..get return address
	ret

;***Subroutine**************************************
; Fill SRCBUF from the open disk file
; on entry:
;   this assumes buffer is n X 256 bytes
;   and the buffer is 256 byte aligned
; On Exit:
;   hl=SRCBUF
;   Buffer is full unless EOF
;   EOFFLG set if EOF encountered
;   z set if no data read
;   Error-abort if EOF encountered and no data read
;***************************************************
FILLSB:	push	b
	push	d

	mvi	b,SBMAX/256	;max address
	lxi	d,SRCBUF	;starting addr
	mov	h,d		;hl=DSKBUF for ret
	mov	l,e 

	call	DREAD+ROF	;read 'til buffer full or EOF

	mov	a,c		;any data read?

	pop	d
	pop	b

	ora	a
	ret			;z set if no data read

;*****Subroutine***************************************
; read disk sectors into memory
; stop reading when EOF or max address
; On Entry:
;    b = high byte of max address+1
;   de = starting address for data
; On Exit:
;    EOFFLG=0 if no EOF, <>0 if EOF encountered
;    z set if b address reached
;    z clear if EOF caused exit before reaching b
;   de=last address written+1
;    c=0 if no sectors read
; trashes a
;******************************************************
DREAD:	mvi	c,0		;in case no read

	lda	EOFFLG+ROF	;EOF already?
	ora	a
	rnz

	push	h
	push	d		;dma address

DRLOOP:	push	b		;flag & max
	mvi	c,BSTDMA	;Set CP/M DMA address to de
	call	BDOS		;trashes no registers

	lxi	d,SRCFCB
	mvi	c,BREAD
	call	BDOS		;trashes all registers
	pop	b		;flag & max
	sta	EOFFLG+ROF	;remember <>0 means EOF
	ora	a
	jnz	DREND+ROF

	mvi	c,1		;we received data

	pop	d		;dma address
	lxi	h,BLKSIZ	;CP/M block size
	dad	d 		;next block address in hl

	xchg			;next block address to de
	push	d		;dma address onto stack

	mov	a,d		;address too big?
	cmp	b
	jnz	DRLOOP+ROF	;n: keep going

DREND:	pop	d
	pop	h
	ret			;z clear

;*****Subroutine***************************************
; Write DSTBUF buffer to disk using DSTFCB
; On Entry:
;   hl = # of sectors to write
;   DSTFCB is set up apready
; trashes a,bc,de,hl
;******************************************************
DSTWRT:	lxi	d,DSTBUF

;Fall into DWRITE

;*****Subroutine***************************************
; Write data starting at de to disk using DSTFCB
; On Entry:
;   de = address of data
;   hl = # of sectors to write
;   DSTFCB is set up apready
; trashes a,bc,de,hl
;******************************************************
DWRITE:
DWLOOP:	mvi	c,BSTDMA	;CP/M SET DMA function
	call	GOBDOS+ROF	;de = DMA address

	push	d		;address
	lxi	d,DSTFCB	;Write from buf to disk
	mvi	c,BWRITE
	call	GOBDOS+ROF
	pop	d		;address

	ora	a		;return 0 if okay
	jnz	DWRERR+ROF	;oops, error

;Bump address by the sector size

	push	h		;sector count
	lxi	h,BLKSIZ	;de=block size
	dad	d
	xchg			;addr to de for BSTDMA
	pop	h		;sector count

;Next sector

	dcx	h
	mov	a,h
	ora	l
	jnz	DWLOOP+ROF

	ret

;***Subroutine***************************************
; Make a non-sequential Poly-88 data record in DSTBUF
; On Entry:
;   hl = address for next record
;   TRBPTR-TRBUF = data byte count, <256
;   RECADR = address for address field
; data starts at TRBUF
; On Exit:
;  TRPBTR=TRBUF
;  RECADR=hl
; trashes a
;****************************************************
P88NSD:	push	h		;next record address
	lda	TRBPTR+ROF	;buffer pointer for data
	sui	TRBUF and 0FFh	;a=byte count

	cnz	P88DAT+ROF	;don't write 0-byte record

	pop	h		;next rec addr
	shld	RECADR+ROF
	ret	

;***Subroutine***********************************
; Make a sequential Poly-88 data record in DSTBUF
; On Entry:
;   a = data byte count
;  RECADR = address for address field
; data starts at TRBUF
; On Exit:
;  TPBTR=hl=TRBUF
;  RECADR=RECADR+data byte count
; trashes a
;************************************************
P88DAT:	push	b
	push	d

	mov	c,a		;byte count
	mvi	b,0		;0=binary record type

	lhld	RECADR+ROF	;data field address

	push	h
	dad	b		;compute and save
	shld	RECADR+ROF	;..next record address
	pop	h

	call	MAKP88+ROF

	lxi	h,TRBUF
	shld	TRBPTR+ROF	;reset data pointer

	pop	d
	pop	b
	ret

;***Subroutine*****************************
; Make a Poly-88 record in DSTBUF
; On Entry:
;   c = data byte count
;   b = record type
;  TRBUF = data address
;  hl = address for address field
;   DBPTR=address for next buffer chr
; trashes a,bc,de,hl
;******************************************
MAKP88:	push	h		;save address
	push	b		;save record type, byte count

;Write the sync

	mvi	b,16		;16 sync chrs

MPSLP:	mvi	a,SYNC
	call	WRITEB+ROF
	dcr	b
	jnz	MPSLP+ROF

	mvi	a,SOH		;then an SOH
	call	WRITEB+ROF
	
;Write the header

	xra	a		;init checksum
	mov	e,a

	mvi	c,8		;8-byte name
	lxi	h,TAPNAM+ROF

MPNLP:	mov	a,m
	call	WRITEB+ROF
	inx	h
	dcr	c
	jnz	MPNLP+ROF

	lhld	RECCNT+ROF	;record number
	mov	a,l	
	call	WRITEB+ROF
	mov	a,h
	call	WRITEB+ROF
	inx	h		;bump record number
	shld	RECCNT+ROF

	pop	b		;byte count & rec type
	mov	a,c		;byte count
	call	WRITEB+ROF

	pop	h		;recover address
	mov	a,l		;write address	
	call	WRITEB+ROF
	mov	a,h
	call	WRITEB+ROF

	mov	a,b		;record type
	call	WRITEB+ROF

	mov	a,e		;header checksum
	cma
	inr	a		;must be neg
	call	WRITEB+ROF

				;e should be clear now

;If binary or comment record type, write b bytes of data

	lxi	h,TRBUF		;data address

	mov	a,b		;record type
	cpi	2		;only 0 or 1 have data
	rnc

;Write c bytes from (hl) for data field

MPDLP:	mov	a,m
	call	WRITEB+ROF
	inx	h
	dcr	c
	jnz	MPDLP+ROF

;Compute data checksum

	mov	a,e		;data checksum
	cma
	inr	a		;must be negative

;Fall into WRITEB to write the checksum

;***Subroutine*****************************************
; Write a byte to DSTBUF, flush the buffer if it's full
; On Entry:
;   a = byte to write
;   e = checksum so far
;   DBPTR=address for next buffer chr
; On Exit:
;   e=updated checksum
; trashes a
;******************************************************
WRITEB:	push	h
	lhld	DBPTR+ROF
	mov	m,a		;put byte in buffer
	add	e		;do checksum
	mov	e,a

	inx	h		;bump pointer
	shld	DBPTR+ROF

	mov	a,h		;buffer full?
	pop	h
	cpi	DBMAX/256
	rnz			;n: done

;DSTBUF is full. Flush the buffer to disk.

	push	h
	push	d
	push	b

	lxi	h,DSTBUF	;reset the pointer
	shld	DBPTR+ROF

	xchg			;this is the source
	lxi	h,DBSIZE/BLKSIZ	;hl = sector count
	call	DSTWRT+ROF	;write hl sectors

	pop	b
	pop	d
	pop	h
	ret
		
;***Subroutine*************************
; flush the destination buffer to disk
; and close the disk file
;**************************************
FLSHDB:	lhld	DBPTR+ROF
	lxi	d,-DSTBUF	;compute bytes in buffer
	call	SECCNT+ROF	;rounds up to even sector
	cnz	DSTWRT+ROF	;>0: flush the rest

;Fall into FCLOSE to close the file & return from there

;*****Subroutine***************************************
; Close CP/M disk file specified by DSTFCB 
; This is required after writing to a file
; On Exit:
;   de = FCB
;   Trashes a,bc
;******************************************************
FCLOSE:	lxi	d,DSTFCB
	mvi	c,BCLOSE	;CP/M CLOSE FILE funct.
	call	GOBDOS+ROF
	inr	a		;-1 means close error
	rnz

;Error closing file: abort with message

	call	CILPRT+ROF
	db	'Error closing fil','e'+80h

	jmp	CORUPT+ROF	;corrupt abort

;*****Subroutine***************************************
;Open CP/M disk file (for reading), and reports success
; or failure to console. File specified in SRCFCB.
; On successful Exit:
;   File is open
;   File-open message has been printed on the console
;   de=SRCFCB
; On failure:
;   Relevent error msg has been printed on the console
;   abort to MAIN
; trashes a,bc
;******************************************************
FOPEN:	lxi	d,SRCFCB
	mvi	c,BOPEN		;CP/M FILE OPEN function
	call	GOBDOS+ROF
	inr	a		;-1 means open failure
	rnz

;Error opening file: Abort with message

	call	CILPRT+ROF
	db	'File not foun','d'+80h

	jmp	MAIN+ROF

;*****Subroutine***************************************
;Create file specified by DSTFCB, and report
; Uses DSTFCB
; On successful Exit:
;   File is created and open
;   de=DSTFCB
; On failure:
;   Relevent error msg has been printed on the console
;   jump to CP/M
; trashes a,bc
;******************************************************
;See if file already exists, and abort if so

CREATE:	lxi	d,DSTFCB
	mvi	c,BSERCH	 ;Search directory for file
	call	GOBDOS+ROF
	inr	a		;-1 means not there
	cnz	FILEX+ROF	;ask to replace if so

;Create file on CP/M disk
;de still points to FCB

	mvi	c,BMAKE		;CP/M CREATE FILE func
	call	GOBDOS+ROF
	inr	a		;-1 means create error
	rnz

;Error: File create failed

	call	CILPRT+ROF
	db	'File create error',CR,LF
	db	'Write prot? Dir full','?'+80h
	jmp	MAIN+ROF

;Attempt to write to existing file

FILEX:	call	CILPRT+ROF
	db	'File already exists. Replac','e'+80h

	call	ASKYN+ROF	;abort if no
	mvi	c,BDELET
	call	GOBDOS+ROF
	inr	a		;-1 means not there
	rnz			;successful delete

;Error: file delete failed

	call	CILPRT+ROF
	db	'File delete erro','r'+80h
	jmp	MAIN+ROF

;***Subroutine*********************
; Checksum Error
; Report, bump error count
;**********************************
CSERR:	call	CILPRT+ROF
	db	'Checksum Erro','r'+80h
	push	h

	lhld	CSECNT+ROF	;checksum error count
	inx	h
	shld	CSECNT+ROF

	pop	h
	ret

;***Abort***************************
;Unrecognized Poly-88 Record Type
;***********************************
PRTERR:	call	CILPRT+ROF
	db	'Unrecognized record typ','e'+80h
	jmp	MAIN+ROF

;***Abort*******************************
;Unexpected EOF
; close dstination file, if one is open
;***************************************
EOFERR:	call	CILPRT+ROF
	db	'Unexpected EO','F'+80h

	lda	DSTFCB+1	;open dest file?
	cpi	' '
	cnz	FLSHDB+ROF	;y: flush buffer and close	
	jmp	MAIN+ROF

;***Abort***************************
; Disk write failure
;***********************************
DWRERR:	call	CILPRT+ROF
	db	'File write erro','r'+80h

;Fall into CORUPT

;***Abort**************************
; Report currupt file
;**********************************
CORUPT:	call	CILPRT+ROF
	db	'File is probably corrupt','.'+80h
	jmp	MAIN+ROF

;***Abort**************************
; Buffer overflow error
;**********************************
OVERR:	call	CILPRT+ROF
	db	'Buffer overflo','w'+80h
	jmp	MAIN+ROF

;***Abort**************************
; Generic error handler
;**********************************
ERROR:	call	CILPRT+ROF
	db	'Huh','?'+80h
	jmp	MAIN+ROF

;--------------
; Command Table
;--------------
COMTAB:	db	'?',0		;help
	dw	HELP+ROF
	db	'RT'		;read tape to disk
	dw	RDTAPE+ROF
	db	'WT'		;write tape from disk
	dw	WRTAPE+ROF
	db	'LT'		;load & exec tape file
	dw	LDTAPE+ROF
	db	'LD'		;load & execute disk file
	dw	LDDISK+ROF
	db	'CA'		;catalog tape files
	dw	CATTAP+ROF
	db	'HP'		;Hex to .POL conversion
	dw	HX2POL+ROF
	db	'QU'		;quit to CP/M
	dw	WBOOT
	db	'PX'		;go to POLEX
	dw	PXINIT
	db	0		;table end	

RAMEND	equ	$

;-----------------
; Variables
;-----------------

BIOS	ds	1	;high byte of BIOS address	
TAPNAM	ds	8	;desired tape file name
EXADR	ds	2	;execute address
RECADR	ds	2	;tape record address
PRVADR	ds	2	;previous record last address+1
TRBPTR	ds	2	;TRBUF pointer
DBPTR	ds	2	;DSTBUF pointer
SBPTR	ds	2	;SRCBUF pointer
CSECNT	ds	2	;Checksum error count
RECCNT	ds	2	;Record count
FIRSTR	ds	1	;0 means 1st record of hex file
EOFFLG	ds	1	;EOF encountered

;15-byte header buffer

HDRBUF	ds	8	;header buffer - 1st 8 are name
HDRRN	ds	2	;next 2 are record number
HDRBC	ds	1	;next 1 is byte count
HDRADR	ds	2	;next 2 are address
HDRRT	ds	1	;next 1 is record type
HDRCS	ds	1	;finally the checksum

;Local stack
	ds	64
STACK	equ	$
