;==============================================================
;         MAKETAPE: a PTDOS Program by Martin Eberhard
;
; Writes multiple Solos/Cuter compatible tape files from
; PTDOS Image files.
;
; Usage:
;   MAKETAPE ?
;
; Prints a help screen
;
; MAKETAPE <listfile>[,U=<unit>]
;
; Reads <listfile> and writes the listed files to tape.
; U=<unit> specifies the tape unit (1 or 2) and defaults to 1.
; Each line of <listfile> has the following format:
;
; <ifile>[,N=<tfile>][,C=<n>][,T=<type>]
;
; Comments begin with ';'.
;
; <ifile> is the name of a PTDOS Image file. The file will be
; named <tfile> when written to tape. If <tfile> is not
; specified, then the tape file will be named with the first
; 5 characters of <ifile>.  n copies will be written, and n
; defaults to 1. The file sizes, load addresses, and execution
; addresses on the tape will be the same as found in the Image
; files. <type sets the tape file type, which defaults to the
; same file type as the disk file.
;
; Setting <n> to zero creates a 0-length file (and no disk file
; is opened). e.g. 'END,C=0' will create a normal end record.
;
; The Image file may contain only one PTDOS segment.
;==============================================================
; NOTES
;
; Written to assemble with Digital Research's ASM.
;
; Page references in the comments refer to the PTDOS ver. 1.5
; USer's Manual unless stated otherwise.
;
; The Image File Buffer overlays all of the code that is not
; needed once the command line has been parsed and the list
; file has been opened.
;
; This program uses all RAM below PTDOS, mostly for the Image
; file buffer. Any Image file that does not fully fit within
; the buffer will generate an error.
;
; SOLOS/CUTER TAPE FORMAT
;
; File Header format:
;   Bytes     Function     Notes
;    10+     Leader Nulls  00h
;     1      Sync Byte     01h
;     5      File Name     ASCII
;     1      File Type     msb set means not executable
;     2      Length        Number of data bytes in file
;     2      Load Address
;     2      Exec Address
;     3      Spare
;
; Tape Block format (The tape file will contain as many blocks
; as needed for all its data bytes):
;
;    256     Data          The last block will have...
;                          ...(Length AND 0FFh) bytes
;     1      CRC
;
; Note that calls to PTDOS's SYS are a little weird: SYS will
; return to the next instruction after the call to SYS only if
; it finds an error. Otherwise, it returns 3 bytes later. (See
; page 6-5.)
;  
;==============================================================
; Revision History
;
; 1.00  26 March 2015  M.Eberhard
;   Created
;
; 1.01  7 April 2015 M. Eberhard
;   Fix user-abort so MODE works. Allow user to set the tape
;   file type. Allow creation of 0-length files (for creating
;   an END marker).
;
;==============================================================
FALSE	equ	0
TRUE	equ	not FALSE

VERBOS	equ	FALSE

;----------------
;ASCII Characters
;----------------
TAB	equ	09h		;horizontal tab
CR	equ	0Dh		;carriage return
LF	equ	0Ah		;Linefeed
QUOTE	equ	27H		;single quote
MODE	equ	80h		;Sol-20 Mode/Select key
ESC	equ	1Bh		;Escape

;---------------
;Program Equates
;---------------
DNLEN	equ	10		;max PTDOS name, with drive
THLEN	equ	16		;Tape header byte count
TNULLS	equ	50		;tape leader nulls
TLEADR	equ	6		;tape leader (0.5 second units)
TTRALR	equ	6		;tape trailer (0.5 second units)
TNLEN	equ	5		;Tape file name max byte count
THLEN	equ	16		;tape header length
STKSIZ	equ	32		;local stack size
MAXLIN	equ	80		;max command file line length
DEFCOP	equ	1		;default number of copies
ABTKEY	equ	MODE		;user abort key (Mode/Select)
				;note: code hardwired for MODE

;----------------------------------------------
;Sol-20 and CUTS standard Tape I/O Port Equates
;----------------------------------------------
TAPPT	equ	0FAH		;Tape status port
TDATA	equ	0FBH		;Tape data
TFE	equ	8		;Tape framing error
TOE	equ	10h		;Tape overrun error
TDR	equ	40h		;Tape receive data ready
TTBE	equ	80h		;Tape transmit buffer empty

;Control bits for TAPPT

TAPE1	EQU	80H		;Turn on tape drive 1
TAPE2	EQU	40H		;Turn on tape drive 2

;-----------------------------
;PTDOS definitions from PTDEFS
;-----------------------------
;1) MAIN ENTRY POINTS  (EP AREA)

SYS	EQU	0BCBCh
RB	EQU	SYS-3	;READ SINGLE BYTE
WB	EQU	SYS-6	;WRITE SINGLE BYTE
UTIL	EQU	SYS-9	;UTILITY HANDLER
RESET	EQU	SYS-12	;RESET TO SYSTEM
ERRL0	EQU	SYS-15	;ERROR LEVEL 0 RETURN FROM DRIVER
ERRL1	EQU	SYS-18	;ERROR LEVEL 1 RETURN FROM DRIVER
ERRL2	EQU	SYS-21	;ERROR LEVEL 2 RETURN FROM DRIVER
SYSGLO	EQU	SYS-23	;POINTER TO SYSTEM GLOBAL AREA
CONIN	EQU	SYS-26	;CONSOLE INPUT ONE CHARACTER
CONOUT	EQU	SYS-29	;CONSOLE OUTPUT ONE CHARACTER
CONTST	EQU	SYS-32	;CONSOLE INPUT READY TEST
PSCAN	EQU	SYS-35	;PARAMETER SCANNER ENTRY
INTDN	EQU	SYS-38	;INTERRUPT DONE ENTRY POINT
INTDK	EQU	SYS-41	;INTERRUPT PROCESSING ENTRY

; 2) SYS CALL OPERATIONS  (CODE FOR OPERATION BYTE)

CREOP	EQU	0	;CREATE FILE  (DE -> PARMS)
OPEOP	EQU	1	;OPEN FILE  (DE -> NAME, HL = BUFF OPT)
KILOP	EQU	2	;KILL FILE  (DE -> NAME)
RBLOP	EQU	3	;READ BLOCK OF DATA
WBLOP	EQU	4	;WRITE BLOCK OF DATA
SPAOP	EQU	5	;MOVE FILE CURSOR
EOFOP	EQU	6	;ENDFILE A FILE
CLOOP	EQU	7	;CLOSE A FILE
CHTOP	EQU	8	;CHANGE TYPE OF FILE
CHAOP	EQU	9	;CHANGE ATTRIBUTES OF A FILE
CHNOP	EQU	10	;CHANGE NAME OF A FILE
INFOP	EQU	11	;GET INFO ABOUT A FILE
SUNOP	EQU	12	;SET DEFAULT UNIT
RETOP	EQU	13	;RETURN TO CI
RESOP	EQU	14	;RESET
ABTOP	EQU	15	;ABORT, THEN RETURN TO CI
SEKOP	EQU	16	;SET FILE CURSOR TO ARBITRARY POINT (SEEK
RNDOP	EQU	17	;MAKE FILE RANDOMLY ACCESSIBLE
CAOP 	EQU	18	;CLOSE ALL FILES (OR ALL ON A UNIT)
CTLOP	EQU	19	;CONTROL/STATUS OF DRIVER
SREOP	EQU	20	;SHORT RESET TO CI
DRDOP	EQU	21	;DELIMITED READ
DWROP	EQU	22	;DELIMITED WRITE
DSPOP	EQU	23	;DELIMITED SPACE
RTROP	EQU	24	;RETURN AND SET TRAP

; 3) FILE PROTECTION ATTRIBUTES

PKIL	EQU	1	;DELETE PROTECT
PWRI	EQU	2	;WRITE PROTECTION
PREA	EQU	4	;READ PROTECTION
PFINF	EQU	8	;INFORMATION PROTECT (FILES WON'T LIST)
PATR	EQU	10h	;ATTRIBUTE CHANGE PROTECTION
PNAT	EQU	20h	;NAME AND TYPE CHANGE PROTECTION
PALO	EQU	40h	;DISK ALLOCATION PROHIBITION
PUSR	EQU	80h	;USER ATTRIBUTE

; 4) SYSTEM GLOBAL AREA

SGA	equ	0	;System Global Area base
GLCIF	EQU	SGA	;CI INPUT FILE #
GLCOF	EQU	SGA+1	;CI OUTPUT FILE #
GLUTF	EQU	SGA+2	;UTILITY FILE #
GLECF	EQU	SGA+3	;CI ECHO FILE #
GLUNI	EQU	SGA+4	;DEFAULT UNIT #
GLPRM	EQU	SGA+5	;# OF PERMANENTLY OPEN FILES
GLMXU	EQU	SGA+6	;MAX UNIT NUMBER (= # DRIVES+1)
GLSWI	EQU	SGA+7	;SYSTEM SWITCHES
GLERS	EQU	SGA+9	;SOFT (LEVEL 2) ERROR WORD
GLERM	EQU	SGA+11	;MODERATE (LEVEL 1) ERROR WORD
GLERH	EQU	SGA+13	;HARD (LEVEL 0) ERROR WORD
GLTRP	EQU	SGA+15	;CI RETURN TRAP WORD
GLPRO	EQU	SGA+17	;USER MEMORY PROTECT WORD
GLFLG	EQU	SGA+19	;CHARACTER WAITING FLAG
GLBYT	EQU	SGA+20	;THE CHARACTER
GLRCH	EQU	SGA+21	;FILE #0 READ CHARACTER ROUTINE POINTER
GLWCH	EQU	SGA+23	;FILE #1 WRITE CHARACTER ROUTINE POINTER
GLTCH	EQU	SGA+25	;CONSOLE TEST CHARACTER READY ROUTINE PTR
GLNCT	EQU	SGA+27	;NULL COUNT FOLLOWING CR
GLVER	EQU	SGA+28	;SYSTEM VERSION
GLDAT	EQU	SGA+29	;DATE (MM,DD,YY)
GLNAM	EQU	SGA+32	;DISK NAME (8 ASCII CHARACTERS)
GLPAS	EQU	SGA+40	;PASSWORD
GLBD1	EQU	SGA+48	;WAIT FOR INTERRUPT ROUTINE ADDRESS
GLBD2	EQU	SGA+50	;RESERVED FOR FUTURE USE
GLIF1	EQU	SGA+52	;INTERRUPT ENABLE FLAG
GLIF2	EQU	SGA+53	;DISK INTERRUPT PROCESSING COMPLETE FLAG
GLLOW	EQU	SGA+54	;LOW ADDRESS OF BUFFER AREA
GLECH	EQU	SGA+56	;ECHO DISABLE SWITCH
GLLOK	EQU	SGA+57	;DISK WRITE LOCK SWITCH
GLUPS	EQU	SGA+58	;UPSHIFT SWITCH
GLRBC	EQU	SGA+59	;READ-BACK CHECK SWITCH
GLBIO	EQU	SGA+60	;BINARY CONSOLE I/O SWITCH
GLLOG	EQU	SGA+61	;LOG FILE SWITCH
GLVRB	EQU	SGA+62	;VERBOSE SWITCH
GLFTR	EQU	SGA+63	;SWITCH RESERVED FOR FUTURE USE

; 6) CXBUF AND OLBUF

CXBUF	EQU	0BCC0H	;COMMAND EXECUTION BUFFER
OLBUF	EQU	0BDC0H 	;OVERLAY BUFFER

; 7) STATUS BITS IN USER DEVICE WORD

SBPRO	EQU	1	;SETTABLE PROMPT MESSAGE
SBINT	EQU	2	;INTERRUPT DRIVEN
SBATB	EQU	4	;DOES ABSOLUTE TABS
SBFF	EQU	8	;DOES FORM-FEEDS
SBSTB	EQU	10h	;SETTABLE TABS
SBTAB	EQU	20h	;DOES TAB'S (CONTROL-I)
SBIAT	EQU	40h	;INTERACTIVE
SBDUP	EQU	80h	;DUPLICATIVE

; 8)  ERROR NUMBERS

ERNEX	EQU	1	;NONEXISTENT FILE
ERAEX	EQU	2	;FILE ALREADY EXISTS
ERUFN	EQU	3	;UNASSIGNED FILE NUMBER
ERPRO	EQU	4	;PROTECTION VIOLATION
ERNIF	EQU	5	;FILE NOT TYPE IMAGE
ERMOP	EQU	6	;ILLEGAL OPERATION ON MULTIPLY OPEN FILE
ERRAC	EQU	7	;RANDOM ACCESS TO NON-RANDON FILE
ERRDV	EQU	8	;RANDOM ACCESS TO DEVICE FILE
ERZBC	EQU	9	;ZERO BLOCK COUNT IN DEVICE IMAGE FILE

ERIOP	EQU	10	;ILLEGAL PTDOS OPERATION
ERIBF	EQU	11	;ILLEGAL BUFFER ADDRESS
ERIBS	EQU	12	;ILLEGAL BLOCK SIZE
ERINM	EQU	13	;ILLEGAL CHARACTER IN NAME
ERICU	EQU	14	;ILLEGAL CHARACTER IN UNIT
ERIUN	EQU	15	;ILLEGAL UNIT
ERNTL	EQU	16	;NAME TOO LONG
ERMEM	EQU	17	;USER MEMORY PROTECT VIOLATION
ERSMP	EQU	18	;SYSTEM MEMORY PROTECT VIOLATION
ERUCN	EQU	19	;UNIT CONFLICT
ERIUP	EQU	20	;ILLEGAL UTILITY OPERATION
ERDRI	EQU	21	;DRIVER ERROR
ERIDA	EQU	22	;ILLEGAL DRIVER ACCESS
ERNCT	EQU	23	;DRIVER NOT PARTICIPATING IN THIS CTRL

EREOF	EQU	24	;END OF FILE ENCOUNTERED (OR BOF)
ERSEK	EQU	25	;SEEK ADDRESS OUT OF RANGE

ERTOP	EQU	26	;TOO MANY FILES OPEN
ERMOV	EQU	27	;MEMORY OVERFLOW
ERNID	EQU	28	;NO FILE ID'S LEFT
ERDFL	EQU	29	;DISK FULL
ERDIR	EQU	30	;DIRECTORY FULL

ERFSB	EQU	32	;FILE STRUCTURE BAD
ERFIC	EQU	33	;FILE ID CONFLICT
ERBSC	EQU	34	;BLOCK SIZE CONFLICT
ERSCC	EQU	35	;SECTOR CONFLICT
ERCFS	EQU	36	;CAN'T FIND SECTOR
ERCRC	EQU	37	;CRC ERROR OR READ/WRITE ABORTS
ERCFT	EQU	38	;CAN'T FIND TRACK
ERRBC	EQU	39	;READ-BACK-CHECK FAILED
ERLOK	EQU	40	;DISK IS WRITE LOCKED
ERXXX	EQU	41	;CATESTROPHIC ERROR
ERSYN	EQU	42	;COMMAND SYNTAX ERROR
ERNAX	EQU	43	;NAME EXPECTED
ERNUX	EQU	44	;FILE NUMBER EXPECTED
ERBCX	EQU	45	;BYTE COUNT EXPECTED
ERADX	EQU	46	;ADDRESS EXPECTED
ERVAX	EQU	47	;VALUE EXPECTED
EROPX	EQU	48	;OPTIONAL PARAMETER EXPECTED
ERINA	EQU	49	;ILLEGAL FILE NAME
ERIFI	EQU	50	;ILLEGAL FILE NUMBER
ERIAD	EQU	51	;ILLEGAL ADDRESS
ERIBC	EQU	52	;ILLEGAL BYTE COUNT
ERIVA	EQU	53	;ILLEGAL VALUE
ERIOS	EQU	54	;ILLEGAL OPTION SPECIFIER
ERITY	EQU	55	;ILLEGAL TYPE
ERIAT	EQU	56	;ILLEGAL ATTRIBUTES
ERRED	EQU	57	;DRIVE NOT READY

; 9) PARAMETER SCANNER OPERATIONS

PSCO	EQU	0	;CREATE IF NONE EXIST AND OPEN
PSOP	EQU	1	;OPEN FILE
PSFCO	EQU	2	;FORCE CREATE AND OPEN FILE
PSC	EQU	4	;CREATE FILE IF NONE EXIST
PSN	EQU	5	;READ NAME TO REG DE
PSFC	EQU	6	;FORCE CREATE FILE
PSOPT	EQU	8 	;READ ALL CHRS UNTIL , ; cr 0
PSV	EQU	85H	;CONVERT VALUE INTO REG DE
PSONE	EQU	0A5H	;READ SINGLE BYTE

;NOTE: ABOVE VALUES + 40H = USER INPUT BUFFER IN REG HL

PSCN	EQU	0D5H	;CONVERT MY VALUE TO DE, BASE IN REG B

; 10) UTILITIES

UXOP	EQU	0	;EXPLAIN ERROR
UXOP1	EQU	1	;DATA FOR UXOP
UXOP2	EQU	2	;DITTO, PART 2
UCAT	EQU	3	;CATALOG ROUTINE

;======================
;= Start of Execution =
;======================
	org	0
;-------------------------------------
;Set up a local stack just below PTDOS
;-------------------------------------
	lhld	SYSGLO		;find PTDOS's lowest address
	lxi	d,GLLOW
	dad	d		;hl=GLLOW address
	mov	a,m
	inx	h
	mov	h,m
	mov	l,a		;hl=PTDOS's lowest address

	sphl			;..is the top of the stack

;-------------------------------------------
;Get and open the list file, using code that
;gets wiped out by the image buffer
;-------------------------------------------
	call	INIT		;hl= (GLLOW)

;========================================================
;Main loop: each pass reads one line from the list file
;to determine which Image file to load and write to tape,
;what to name it on tape, and how many copies to write.
;========================================================
MAIN:	call	CHKABT		;let user abort

	lxi	h,MAIN		;create return address
	push	h

;Initialize the tape header to nulls.

	lxi	h,TAPHDR
	mvi	b,THLEN

TNZLUP:	mvi	m,0
	inx	h
	dcr	b
	jnz	TNZLUP

;Set the default number of copies

	mvi	a,DEFCOP
	sta	COPCNT

;Get one complete line from the list file into the list buffer

	lxi	d,LSTBUF	;destination address
	lxi	b,MAXLIN	;max number of chrs
	lda	LFNUM		;list file number
	mvi	l,CR		;the delimiter
	call	SYS		;read until end of line
	db	DRDOP		;delimited read (page7-8)
	call	CHKEOF		;EOF means we are done
				;otherwise, report error

;Check for comment line (1st chr is ';'), or a blank line

	lxi	h,LSTBUF-1
	call	GETLFC		;get a character
	rc			;ignore blank and comment lines

	jz	LSTERR		;1st chr ',' is an error

;Copy the first TNLEN characters of the disk file name to the
;tape file header, and find the end of the disk file name.
;a = 1st character here.

	lxi	d,TFNAME	;put name in tape header
	mvi	b,TNLEN		;max tape name length

INLOOP:	stax	d
	inx	d

INTRNC:	call	GETLFC		;get a character
	jz	ILDON

	dcr	b		;truncate after TNLEN chrs
	jm	INTRNC		;but find end when truncating

	jmp	INLOOP

;Install null at the end of the image file name in LSTBUF, so it
;can be used to open the PTDOS file.
;Carry will have been set if CR or ';' was found.

ILDON:	mvi	m,0		;terminate name
	jc	PARSDN		;done if EOL or comment already

;=======================================================
;Loop to scan this list file line for supported options:
; "N=<name>" sets the tape file name
; "C=<n>" sets the number of copies
; "T=<t>" sets the tape file type
;=======================================================
OPTLUP:	call	GETLFC		;get e.g. 'N='
	jc	PARSDN		;done if EOL or comment

	lxi	d,OPTLUP	;create return address
	push	d		;..for option routines

	mov	b,a		;b= first chr

	call	GETLFC		;get 2nd chr
	cpi	'='		;2nd chr must be '='
	jnz	LSTERR		;otherwise it's junk

;hunt for valid option in b, and execute the right routine

	mov	a,b
	cpi	'N'
	jz	OPTNAM
	cpi	'C'
	jz	OPTCOP
	cpi	'T'
	jz	OPTTYP

;Bogus option

LSTERR:	call	CILPRT
	db	'Unrecognized junk for ',0
	jmp	ERREXT

;====================================================
;Done parsing one line of the list file. Now copy the
;requested file to tape, with the specified options.
;====================================================
PARSDN:

;--------------------------------------
;No file to open if the copy count is 0
;--------------------------------------
	lda	COPCNT
	ora	a
	jz	HDONLY		;header only

;---------------------------------------------
;Open the specified Image file, and check that
;it is actually an image file.
;---------------------------------------------
 if VERBOS
	call	CILPRT
	db	'Opening Image file: ',0
	lxi	h,LSTBUF
	push	b
	call	PRINTF
	pop	b
 endif

	lxi	d,LSTBUF	;null-terminated name is here
	lxi	h,0		;static buffering
	call	SYS
	db	OPEOP		;open file op (page 7-12)
	call	PTDER		;Let PTDOS explain any error

	sta	IFNUM		;remember the PTDOS file number

	mov	a,b		;PTDOS tells us the file type
	ora	a		;msb clear means image file
	jm	DFTERR		;must be an image file

;-----------------------------------------------------------
;Unless the user specified a file type for the tape file,
;set the file type in the tape header to the disk file type.
;-----------------------------------------------------------
	lxi	h,TFTYPE
	mov	a,m
	ora	a		;user supplied file type?
	jnz	USFT		;y: keep it
	mov	m,b		;n: use file type from disk file
USFT:

;----------------------------------------------------------
;Read the entire Image file into the buffer. If PTDOS fills
;IMGBUF without reaching the end of file, then the file is
;too big for us, which is an error.
;----------------------------------------------------------
	lhld	BUFMAX		;max bytes we can take
	mov	b,h		;..to bc
	mov	c,l
	lxi	d,IMGBUF
	lda	IFNUM

	call	SYS
	db	RBLOP		;read the header
	jmp	SBEOF		;see if error is EOF
	jmp	FTLERR		;no EOF: file too long

SBEOF:	cpi	EREOF		;error due to EOF?
	jnz	PTDER		;n:let PTDOS explain error

;---------------------------------------------------------
;See if this file has an execution address. If so, get it
;from the Image file's end, and put it in the tape header

;de = address of the 1st byte past the data bytes. If this
;equals IMGDAT+(BYTCNT) then this is a data file (without
;an execution address). Otherwise, it's either a multi-
;segment file (unsupported) or a file with an execution
;address. There are 2 types of execution addresses. If
;there are just 2 bytes left in the file, then these bytes
;are the execution address. If there are 4 bytes, and the
;first 2 are both zero, then the subsequent 2 bytes are
;the execution address. Anything else is an error.
;---------------------------------------------------------
	lhld	BYTCNT
	lxi	b,IMGDAT	;compute the address of
	dad	b		;..the end of the data

	mov	a,e		;de has the last address
	sub	l		;..of the file.
	mov	c,a		;compute the difference
	mov	a,d
	sbb	h		;the high byte better be 0
	jnz	IFERR		;else it's a bad image file
	
;c=0 means data file
;c=2 means normal executable file
;c=4 means executable, with 0-byte last segment

	ora	c		;no bytyes past the data?
	jz	DATFIL		;y: this is a data file

	rrc
	dcr	a		;exactly 2 more bytes?
	jz	GETEXA		;y: they are the exec address

	dcr	a		;exactly 4 more bytes?
	jnz	IFERR		;n: bad image file

	mov	b,m		;Segmet byte cout=0?
	inx	h
	ora	m
	jnz	IFERR		;n: bad image file

	inx	h		;hl points to execution address
;-------------------------------------------------------------
;This is a valid  single-segment executable file. The last 2
;bytes of the file (where hl point) are the execution address.
;(page 5-8) Put this address in ther tape file header.
;-------------------------------------------------------------
GETEXA:

 if VERBOS
	call	CILPRT
	db	'executable file',0
 endif

	mov	a,m		;low byte of address
	inx	h
	mov	h,m		;high byte
	mov	l,a		;hl=execution address
	shld	TEADDR		;save as execution address
	jmp	TYPDON

;-------------------------------------------------
;This is a data file. Set the msb of the file type
;in the tape header. (Solos manual page 20)
;-------------------------------------------------
DATFIL:

 if VERBOS
	call	CILPRT
	db	'data file',0
 endif
	lda	TFTYPE
	ori	80h		;make it a data file
	sta	TFTYPE

;--------------------
;Close the Image file
;--------------------
TYPDON:

 if VERBOS
	call	CILPRT
	db	'CLosing file',0
 endif

	lda	IFNUM		;data file number
	call	SYS		;close file
	db	CLOOP		;(page 7-5)
	call	PTDER		;Let PTDOS explain any error

;-----------------------
;Announce tape operation
;-----------------------
	call	CILPRT
	db	'Writing ',0

	lda	COPCNT
	cpi	1
	jz	NTCOP

	adi	'0'
	call	CONOUT
	call	ILPRNT
	db	' copies of ',0
NTCOP:

	lxi	h,TFNAME
	call	PRINTF
	call	ILPRNT
	db	' to tape',0

;---------------------------------------
;Set up the rest of the tape file header
;---------------------------------------

;Get the byte count from the beginning of the Image file

	lhld	BYTCNT
	shld	TFSIZE

;Get the load address from the beginning of the Image file

	lhld	IMGADR
	shld	TLADDR

;-----------------------------------------------
;Loop to write COPCNT copies of the file to tape
; TAPHDR = the complete tape header
; IMGDAT = the complete file data
;-----------------------------------------------
COPLUP:	call	CHKABT		;let user abort

 if VERBOS
	mvi	a,' '
	call	CONOUT
	lda	COPCNT
	adi	'0'
	call	CONOUT		;trashes b
 endif

	call	WTAPE		;write the entire file
	lda	COPCNT		;as many as requested
	dcr	a
	sta	COPCNT
	jnz	COPLUP

	ret			;next list file entry

;--------------------------------------------
;Write just a header - no data (for e.g. END)
;--------------------------------------------
HDONLY:	call	CILPRT
	db	'Writing 0-length ',0

	lxi	h,TFNAME
	call	PRINTF
	call	ILPRNT
	db	' to tape',0

	jmp	WTAPE		;just writes header
				;returns to MAIN

;***List File Option Subroutine*************
;User-specified tape file name
;On Entry:
;  hl points to previous list file chr
;On Exit:
;  user-supplied file name is in tape header
;  hl points to delimiter
;  carry set if delimiter was CR
;trashes a,b,de
;*******************************************
OPTNAM:	lxi	d,TFNAME	;put name in tape header
	mvi	b,TNLEN		;max tape name length

TFNLP1:	call	GETLFC		;get a character
	jz	TFNPAD		;done if delimiter

	stax	d		;install chr in header
	inx	d
	dcr	b		;max name length?
	jnz	TFNLP1		;n: get another chr

	call	GETLFC		;should be no more
	rz			;good name if no more

;Error: tape file name is too long

	call	CILPRT
	db	'Bad tape file name for: ',0
	jmp	ERREXT

;Pad the rest of the name with nulls

TFNPAD:	xra	a

TFNLP2:	stax	d
	inx	d
	dcr	b
	jnz	TFNLP2

	ret

;***List File Option Subroutine*********
;User-specified number of copies to tape
;On Entry:
;  hl points to previous list file chr
;On Exit:
;  COPCNT = copy count
;  hl points to delimiter
;  carry set if delimiter was CR
;trashes a
;***************************************
OPTCOP:	call	GETLFC		;get copy count
	sui	'0'		;un-ASCII, 0 not allowed
	cpi	10
	jnc	CNTERR		;bad copy count

	sta	COPCNT		;remember copy count

	call	GETLFC		;should be no more
	rz

;Bad copy count

CNTERR:	call	CILPRT
	db	'Bad copy count for: ',0
	jmp	ERREXT

;***List File Option Subroutine*******
;User-specified tape file type
;On Entry:
;  hl points to previous list file chr
;On Exit:
;  hl points to delimiter
;*************************************
OPTTYP:	call	GETLFC		;get file type
	jz	FTERR		;must be something

	sta	TFTYPE		;must be printable

	call	GETLFC		;should be no more
	rz

;Bad file type

FTERR:	call	CILPRT
	db	'Bad file type for: ',0
	jmp	ERREXT

;***Subroutine*************************
;Write one complete file to tape
;On Entry:
;  TAPHDR contains complete tape header
;  data is at IMGDAT
;**************************************
WTAPE:	mvi	d,TLEADR	;create leader
	call	DELAY

	mvi	d,TNULLS	;Write leader nulls
LNULLS:	xra	a
	call	WRTAP
	dcr	d
	jnz	LNULLS

	mvi	a,1		;write sync byte
	call	WRTAP

	lxi	h,TAPHDR	;write tape header
	mvi	b,THLEN		;header length
	call	WTBL		;write b-byte block

	lhld	TFSIZE
	xchg			;de=file size

	lxi	h,IMGDAT	;hl=source address

;Write de bytes to tape, from memory at hl. Slice the
; data into 256-byte blocks as needed.

WTAP2:	xra	a		;Clear for later tests
	mov	b,a		;Assume 256-byte block
	ora	d		;More than 256 bytes left?
	jnz	DCRC2		;Y: reduce by 256

	ora	e		;Is entire count 0?
	jz	WTAP3		;y: done

	mov	b,e		;This block is the remainder
	mov	e,d		;and the count will be 0
	inr	d		;done, compensate for dcr d

DCRC2:	dcr	d		;Reduce count by 256

	call	WTBL		;Write b-byte block
	jmp	WTAP2		;Loop 'till done

WTAP3:	mvi	d,TTRALR	;Write trailer

;Fall into DELAY to write trailer, and return from WTAPE

;***Subroutine******************
;Delay for d/2 seconds
;On Entry:
;  d = delay in 0.5 second units
;Trashes a,d,hl
;*******************************
DELAY:	lxi	h,42604

DELUP:	dcx	h		;(5)
	mov	a,h		;(5)
	ora	l		;(4)
	jnz	DELUP		;(10)

	dcr	d
	jnz	DELAY

	ret

;***Subroutine***********************
;Write b-byte block to tape, with CRC
;On Entry:
;   b=byte count (0 means 256)
;  hl = address of data
;On Exit:
;   b = 0
;   c = CRC
;  hl = address of next byte
;************************************
WTBL:	mvi	c,0		;reset the CRC byte

WLOOP:	mov	a,m		;get a byte
	call	WRTAP		;and write it to tape
	dcr	b
	inx	h
	jnz	WLOOP

	mov	a,c		;Get the CRC byte

;Fall into WRTAP to write the CRC

;***Subroutine*******
;Write a byte to tape
;On Entry:
;   a=chr to write
;   c=CRC so far
;On Exit:
;   c=updated CRC
;********************
WRTAP:	push	psw
WRWAT:	in	TAPPT		;Tape status
	ani	TTBE		;Ready for a byte?
	jz	WRWAT		;n: keep waiting

	pop	psw
	out	TDATA		;Send byte to tape

;Compute the CRC a la Solos

	sub	c
	mov	c,a
	xra	c
	cma
	sub	c
	mov	c,a

	ret

;***Subroutine***************************************
;Get next List File Character
;On Entry: 
;   hl points to next character
;On Exit:
;    a = chr
;   hl advanced unless previous chr was CR or ';'
;   Z set if delimiter (CR, comma, or ';') found
;   Carry set if chr is CR or ';'
;****************************************************
GETLFC:	mov	a,m

	cpi	CR		;was previous chr a CR?
	stc
	rz

	cpi	';'		;was previous chr a comment?
	stc
	rz

	inx	h
	mov	a,m		;next chr

	cpi	','		;delimiter?
	rz

	cpi	CR		;end of line?
	stc
	rz

	cpi	';'		;comment?
	stc
	rz

	ora	a		;not CR or comment: clear carry
	ret

;***Subroutine*************************************
;Print CR,LF, null-terminated inline string
;The call to CILPRT is followed by an ASCII string.
;trashes psw
;**************************************************
CILPRT:	call	ILPRNT
	db	CR,LF,0

;Fall into ILPRNT

;***Subroutine*************************************
;Print inline null-terminated string
;The call to ILPRNT is followed by an ASCII string.
;trashes psw
;**************************************************
ILPRNT:	xthl			;Save hl, get msg addr
	push	b
	call	PRINTF
	pop	b
	xthl			;Restore hl,
				;..get return address
	ret

;***Subroutine***************
;Print null-terminated string
;On Entry:
;  hl=address of string
;trashes a,b,hl
;****************************
PRINTF:	mov	a,m
	ora	a
	rz

	call	CONOUT		;(trashes b)
	inx	h
	jmp	PRINTF

;***Subroutine*******
;Check for user abort
;********************
CHKABT:	call	CONTST
	rz

	call	CONIN		;what did the user type
	ani	7Fh		;strip parity, test for MODE
	rnz			;n:ignore if not MODE

	call	CILPRT
	db	'Abort',0
	jmp	CLEXIT		;close files and exit

;***Exit************************************
;Check for EOF or other error
;(EOF is the normal exit)
;On Entry:
;   a = error code from PTDOS
;   c = number of characters parsed by PSCAN
;  de = address of next location in LSTBUF
;*******************************************
CHKEOF:	cpi	EREOF		;error due to EOF?
	jnz	PTDER		;n:let PTDOS explain error

 if VERBOS
	call	CILPRT
	db	'List processing done',0
 endif

;close the list file

	lda	LFNUM		;list file number
	call	SYS		;close file
	db	CLOOP		;(page 7-5)
	call	PTDER		;Let PTDOS explain any error

;Turn off the tape deck

	call	CILPRT
	db	'Stop the tape now',0

	xra	a
	out	TAPPT		;Stop that tape

;Exit normally

	call	SYS		;Return to PTDOS
	db	RETOP		;(page 7-16)

;***Exit*****************************************************
;Get PTDOS to explain a SYS error, close all open files,
;and return (with reset) to PTDOS
;(Pages 6-8, 7-6, and 8-1)
;On Entry:
;  a = error code
;  top of stack = address of routine that generated the error
;************************************************************
MTEMSG:	db	'MAKETAPE',0

PTDER:	sta	ERMCD		;Store error code for UTIL

	pop	h		;Get calling address
	dcx	h		;Back up and get SYS opcode
	dcx	h
	dcx	h
	dcx	h
	mov	a,m		;a=SYS opcode
	sta	COMCD		;Give SYS opcode to UTIL

	lxi	h,MTEMSG	;'Called from' message
	mvi	a,82h		;UTIL ctrl word (see page 8-1)
				;Returns when done

	call	UTIL
	db	UXOP		;Explain error
	jmp	UERROR		;UTIL Error return
COMCD:	db	0FFh
ERMCD:	db	0FFh
				;UTIL normally returns here
UERROR:

;Fall into CLEXIT

;***Exit***********************************************
;Close all files, and Reset-Exit to PTDOS
;******************************************************
CLEXIT:	mvi	a,255		;all files (page 7-6)
	call	SYS		;close all open files
	db	CAOP
	nop
	nop
	nop			;always exit

;Fall into REXIT

;***Exit***********************************************
;Reset-Exit to PTDOS
;******************************************************
REXIT:	call	SYS		;Reset-Return to PTDOS
	db	RESOP		;(page 7-16)

;===Exit=================
;Non-image file requested
;========================
DFTERR:	call	CILPRT
	db	'Not an Image file: ',0
	jmp	ERREXT

;===Exit=================
;Non-image file requested
;========================
IFERR:	call	CILPRT
	db	'Bad Image file: ',0
	jmp	ERREXT

;===Exit=================
;File is too long
;========================
FTLERR:	call	CILPRT
	db	'File is too long: ',0

;Fall into ERREXT

;===Exit=================================================
;General error: print offending source file name and exit
;========================================================
ERREXT:	lxi	h,LSTBUF	;file name is here
	call	PRINTF		;print null-terminated string
	jmp	CLEXIT

;===================================
;= Initialized flags and Variables =
;===================================
LFNUM:	db	0	;list file num assigned by PTDOS
IFNUM:	db	0	;data file num assigned by PTDOS
COPCNT:	db	0	;copy count for writing to tape
BUFMAX:	dw	0	;max bytes allowed in data buffer

;=================================
;= Initialized data structures   =
;= Overwrite the following code. =
;=================================

;-----------------------
;Solos/Cuter Tape Header
;-----------------------
TAPHDR:	equ	$
TFNAME:	equ	TAPHDR		;Tape file name
TFTYPE:	equ	TAPHDR+6	;Tape file type
TFSIZE:	equ	TAPHDR+7	;Tape file size
TLADDR:	equ	TAPHDR+9	;Tape file load address
TEADDR:	equ	TAPHDR+11	;Tape file execute address

;=====================
;List file line buffer
;=====================
LSTBUF:	equ	TAPHDR+THLEN

;==========================================================
; Image File Buffer. Note that the execution address
; (if any) will be at the end of the data.
;==========================================================
IMGBUF:	equ	LSTBUF+MAXLIN
BYTCNT:	equ	IMGBUF		;Image file byte count
IMGADR:	equ	IMGBUF+2	;Image file start address
IMGDAT:	equ	IMGBUF+4	;Actual data from the Image file

;================================================
;= The following code all gets wiped out by     =
;= the data structures when the tape gets read. =
;================================================

;===Init Subroutine=============================================
;Initialization
;On Entry:
;  hl= (GLLOW), the lowest address of PTDOS
;On Exit:
;  LFNUM = the list file's number
;  The list file is open and ready for reading
;  The tape drive is on and recording
;
;Rude jump to HLPEXT if '?' typed instead of tape file name
;Rude exit with error message if bogus input
;===============================================================

;-------------------------------------------------------
;Get PTDOS's lowest address, and use it to compute the
;buffer size, adjusting for the bese address of the
;buffer, and leaving room for the stack and for the
;(optional) 2 bytes of execution address.
;-------------------------------------------------------
INIT:	lxi	d,-2-IMGBUF-STKSIZ
	dad	d		;16-bit subtract
	shld	BUFMAX

;--------------------------------------------------------
;Tell PTDOS to send level 1 and level 2 errors back to us
;--------------------------------------------------------
	lhld	SYSGLO		;find PTDOS's global variables
	lxi	d,GLERS
	dad	d		;hl=GLERS address

	mvi	d,4		;4 bytes for 2 16-bit -1's
SERLUP:	mvi	m,0FFh		;(page 6-12)
	inx	h
	dcr	d
	jnz	SERLUP

;----------------------------------------------------------
;Get the list file's name, open the file and check its type
;----------------------------------------------------------
	mvi	a,PSOPT		;Scan one item
	lxi	d,LFNBUF	;put result here

	push	d		;buffer address
	call	PSCAN		;c=number of chrs(page 6-10)
	pop	d		;de=buffer address
	jc	CMDERR		;error if too many characters

	push	psw		;remember delimiter

	ldax	d		;1st chr of this item
	cpi	'?'		;Help?
	jz	HLPEXT

;check for list file name error

	mov	a,c
	cpi	DNLEN+1		;max PTDOS filename, with drive #
				;..leaves room for a unit number
	jnc	CMDERR

;See if the user specified a tape unit number

	pop	psw		;recover delimiter

	mvi	b,TAPE1		;default to tape 1
	push	b

	cpi	','		;another command line item?
	jnz	DEFTU		;n: default tape unit

	mvi	a,PSOPT		;Scan one item
	lxi	d,TUBUF	
	call	PSCAN		;c=number of chrs(page 6-10)
	jc	CMDERR		;PSCAN error?

	cpi	','		;even more command line items?
	jz	CMDERR		;y: bogus

	dcx	d		;last digit is unit number
	ldax	d		;get the digit
	sui	'1'
	jz	TU1		;1 is already the default

	dcr	a		;only 1 or 2 allowed		

	pop	b
	mvi	b,TAPE2		;change to tape unit 2 value
	push	b

TU1:	mov	c,a		;should be 0

	dcx	d		;get "U=" and check it
	ldax	d
	xri	'='
	ora	c		;test for {0/1}
	mov	c,a

	dcx	d
	ldax	d
	xri	'U'
	ora	c
	jnz	CMDERR		;not 'U={0/1}'
DEFTU:

 if VERBOS
	call	CILPRT
	db	'Opening list file ',0
	lxi	h,LFNBUF
	call	PRINTF
 endif

	lxi	d,LFNBUF
	lxi	h,0		;static buffering
	call	SYS
	db	OPEOP		;open file op (page 7-12)
	call	PTDER		;Let PTDOS explain any error

	sta	LFNUM		;remember the file number

	mov	a,b		;file type
	rlc			;msb clear means image file
	jnc	LFTERR		;must not be an image file

	pop	psw		;a=tape unit value
	out	TAPPT		;Get that tape moving

ASKAGN:	call	CILPRT
	db	'Start recording now. Ready (Y/N)?',0

	call	CONIN
	cpi	'Y'
	rz			;done with INIT
	cpi	'N'
	jnz	ASKAGN		;Y or N only
	jmp	CLEXIT		;n means user abort here
	
;*************
;Command error
;*************
CMDERR:	call	CILPRT
	db	'Huh?',0

;Fall into HLPEXT

;*********
;Help Exit
;*********
HLPEXT:	call	CILPRT

;    1234567890123456789012345678901234567890123456789012345678901234
 db '  MAKETAPE 1.01 by M. Eberhard'
 db CR,LF,LF
 db 'MAKETAPE <listfile>[,U=<unit>]'
 db CR,LF
 db 'Reads <listfile> writes the listed files to tape.'
 db CR,LF
 db '<unit> specifies the tape unit (1 or 2), and defaults to 1.'
 db CR,LF
 db 'Each line of <listfile> writes n copies of an Image file to'
 db CR,LF
 db 'tape, and has the following format:'
 db CR,LF
 db '<ifile>[,N=<tfile>][,C=n][,T=<type>]'
 db CR,LF
 db 'The tape file will be named <tfile>, which defaults to <ifile>.'
 db CR,LF
 db 'The max value for n is 9, and defaults to 1. n=0 creates a 0-'
 db CR,LF
 db 'byte file (e.g. END,C=0 creates an end record). The tape file'
 db CR,LF
 db 'type will be the same as the disk file type, unless <type> is'
 db CR,LF
 db 'specified. A semicolon begins a comment.',0

	jmp	REXIT

;********************
;File type error exit
;********************
LFTERR:	call	CILPRT
	db	'Error: list file may not be an Image file',0

	jmp	 CLEXIT

;=====================
;List file name buffer
;=====================
LFNBUF:	ds	20
;========================
;Tape Unit buffer
;========================
TUBUF:	ds	20
