;==============================================================
;FORMAT - a full-featured disk formatter for PTDOS
; by Martin Eberhard
;
;USAGE:
;   FORMAT {{/}<src>,}{/}<dst>{,L=<n>}{,S={R}{-V}]{,N=<name>}
;          {,D=<date>}
;
; Formatting is on Unit <dst>, which must be specified. The
; source unit for system files is <src>, which defaults to 0.
; the source unit must not be equal to the destination unit.
; <src> and <dst> must be specified before any other options.
;
; File Installation Level:
;  L=0 creates a (non-bootable) data disk
;  L=1 Just loads BOOTLOAD, RESIDENT and SUTIL (bootable)
;  L=2 a minimally useful bootable disk
;  L=3 creates a reasonable bootable disk (default)
;  L=4 creates a reasonable development disk
;      (adds assembler, editor, debugger, etc.)
;  L=5 creates a fully-loaded disk
;      (adds languages, trek80, etc.)
;  (Note that files missing on the source disk don't cause a
;  problem. Their absence is noted on the console and FORMAT
;  moves on to the next file.)
;
;  S= 0ptions:
;     R reinstalls PTDOS on a disk that already contains PTDOS.
;       All files of the specified level are rewritten.
;
;    -V Prevents read-back verify for all writes after the
;       initial format. (FORMAT defaults to verifying writes.)
;
;  N=<name> sets the disk's name. <name> is truncated to 8
;     characters. The default name is "PTDOS1.x" where x is
;     from the version number in SYSGLO (usually 4 or 5).
;
;  D=<date> sets the disk's date. Dates are enterred as
;     mm/dd/yy, for example, 05/15/78 for May 15, 1978. If
;     unspecified, the date will come from the system
;     parameters in memory.
;
; Use the PTDOS SET command prior to running FORMAT to set
; any other system parameters and switches.
; 
; FORMAT always creates a START.UP file and enables Verbose
; mode, so that START.UP will be displayed during PTDOS boot.
;
; Type 'S' during formatting to skip the rest of the format
;
;==============================================================
VERSION	equ	108h	;BCD encoding
;
;REVISION HISTORY
; 1.08  20 July 2023  M. Eberhard
;  Display file number and total during copy phase. If the user
;  did not provide a date, then use PTDOS's date. Move more
;  code into INIT to increase bufffer size.
; 1.07  16 July 2023  M. Eberhard
;  Print file names (instead of file count) on console while
;  copying files to destination disk. Announce when verify is
;  off (as well as when on). Retry failed boot at end. Put
;  disk name in START.UP. Remove RXMODEM from copied files.
; 1.06  14 July 2023  M. Eberhard
;  Fix default disk name
; 1.05  23 April 2018  M. Eberhard
;  Make options more like other PT programs. More info in
;  START.UP file.
; 1.04  22 April 2018  M. Eberhard
;  Default to verifying writes. Cold boot (instead of calling
;  SRESET) when done. Require CR after Y/N response.
; 1.03 16 April 2018 M. Eberhard
;  Fix bugs specifying source unit and specifying verify.
;  initialize CURBLK & CURTRK in case if error during Erase
;  track 0. Add ACOPY to files in L=3 group
; 1.02 8 March 2018 M. Eberhard
;  Don't optimize block size for system files
; 1.01  5 March 2018
;  Optimize block size for files, but only if the entire file
;  fits in our buffer. Allow user to specify the source disk,
;  and require the destination disk to be specified. Allow
;  formatting on unit 0, and increase amount of confirmation
;  required from the user. Move init code so that it gets
;  overwritten by the data structures and buffers, maximizing
;  space for the data copy buffer.
; 1.00  29 May 2015  M.Eberhard
;   Created
;==============================================================
;HELIOS "FIRM SECTORING" DISK FORMAT
;
; The controller ignores every other hard sector mark, dividing
; the disk into 16 "sectors," numbered 0 to 15. The sector that
; follows the index hole is sector 0.
;
; The disk is divided into "blocks", where a block may be any
; number of bytes from 1 up to 4095, with certain restrictions
; (see below). As such, a block may span up to 13 sectors.
;
; A block must begin at the beginning of a sector, and no block
; may span across from sector 15 to sector 0. (In other words,
; sector 0 must be the beginning of a block.)
;
; One poorly-documented "feature" of the Helios controller is
; that the last sector of a block cannot end fewer than 108
; bytes after a sector mark. Special code in the BW command
; pads blocks to meet this requirement (similar to PTDOS).
;
; Note that the Helios "Erase" command violates this rule,
; creating 1-byte block data fields. FORMAT fixes this by
; writing 256-byte data fields. However, fixing this problem
; requires writing the disk one piece at a time: header 0,
; block 0, header 1, block 1, etc. This requires a full disk
; revolution for each piece, so a track format will require
; 2 revolutions to "Erase" the track, plus 32 revolutions to
; format it. A whole-disk format will thus take about 8
; minutes to complete. (This seems outrageous, but PTDOS's disk
; initialization routine within its DISKCOPY program does the
; same thing.) (If the target disk is already formatted, then
; you can skip the format phase by typing 'S' while FORMAT is
; formatting tracks.)
;
; Each block begins with a block header, which contains 13
; bytes of data that may be used by the operating system. PTDOS
; uses these bytes to indicate the track and sector number,
; as well as for other PTDOS functions. The controller does not
; interpret any bytes within this header. Hexer's HE command
; displays the contents of the header, interpreting its bytes
; as PTDOS does.
;
; The block header and block data fields are bracketed by
; preambles/postambles that include special sync marks, which
; are recognizeable by the controller. The headers and data
; fields are written by separate controller commands.
;
; TRACK 25 (DITRK) is the PTDOS directory track. (See page
; 5-5.) This track is the only track that has interleaved
; sector numbers written into its block headers.  The
; interleave pattern is: 0,8,1,9,2,10,3,11,4,12,5,13,6,14,7,15.
; (See FRONE routine in PTDOS's DISKCOPY program.)
;--------------------------------------------------------------
;PTDOS DISK LAYOUT
;
; Everything on a PTDOS disk is a file. All files have unique
; 16-bit file IDs, which are sequentially assigned as files are
; created. File IDs below 15h are reserved for PTDOS's own
; files. Most files may be any place on the disk, though a few
; system files have hard-coded disk locations, as well as hard-
; coded file IDs. PTDOS requires 4 files to be present in order
; to use a disk as a data disk: DIRECTRY, FSMAP, NEXTID, and
; SYSGLOBL. Additionally, BOOTLOAD, RESIDENT and SUTIL must be
; present for a disk to be bootable. All PTDOS commands are
; implemented as executable files, so each command file must be
; present on the disk for that command to be available.
;
; File: BOOTLOAD
;
; Track 0, Block 0, occupies 3 sectors. The Solos BOOT command
; loads exactly 832 bytes from this block into RAM at address 0
; and begins execution there. This block normally contains 
; BOOTLOAD, which is also an executable image file. When not
; loaded on the disk, these 3 sectors are still reserved as
; a block called BOOTLOAD, but contain a dummy file that just
; halts if run. The normal File ID of BOOTLOAD is 6.
;
; File: RESIDENT
;
; On a bootable disk, BOOTLOAD loads two 0FFFh-byte blocks into
; memory starting at address A002h. These two blocks normally
; contain the file RESIDENT, which is PTDOS's main program. The
; first block is track 0, block 1 (which occupies the last 13
; sectors of track 0), and the second block is block 0 of track
; 1 (which occupies the first 13 sectors of track 1). Bootload
; inspects the headers of both blocks, and will refuse to
; execute if any of the following is not right: 
;   Track = 0, Block = 1 (for the first block)
;   Track = 1, Block = 0 (for the second block)
;   Block size = 0FFFh bytes (only the least-significant byte
;     is actually checked.)
;   File ID = 4
;   Sector count = 13d
; If satisfied, BOOOTLOAD will begin execution at address
; 0BCC0h.
;
; File: DIRECTRY
;
; The directory occupies sixteen 256-byte blocks on track 25.
; The directory itself is a file called DIRECTRY, and contains
; at a minimum 5 files: BOOTLOAD, DIRECTRY, FSMAP, NEXTID, and
; SYSGLOBL. The normal File ID for the Directory is 2.
;
; File: FSMAP
;
; The Free Sector Map is a 154-byte block that contains 1 bit
; for each sector on the disk. If the bit is set, the sector is
; free. The normal File ID for the Free Sector Map is 1, and
; this file is normally located at track 26, sector 0.
;
; File: NEXTID
;
; This is a 2-byte file that contains the next sequential ID to
; be assigned to a file. When this counter reaches 0FFFFh, no
; more files can ever be created on the disk. The normal File
; ID for the Next ID file is 3, and it is normally located
; track 26, sector 1.
;
; File: SYSGLOBL
;
; This file contains an image of PTDOS's System Global Area,
; preceeded by 170 bytes (AAh bytes) of PTDOS buffer area. The
; file is 616 bytes ( 268h bytes) long, requiring 3 disk
; sectors. It normally located on track 1, block 1, which
; occupies the last 3 sectors of this track. Its File ID is 5.
;
; File: SUTIL
;
; PTDOS's System Utility file usually has File ID = 14h on a
; bootable disk. SUTIL is a random-access file, meaning that it
; has an index sector associated with the file, which must be
; recreated when the file is copied. The disk location of
; SUTIL, as well as the location of its index sector and its
; File ID all are coded into the File Descriptors that live
; in the first 170 bytes of SYSGLOBL. FORMAT updates the
; required bytes in SYSGLOBL when it copies SUTIL.
;
; File: START.UP
;
; If the Verbose Mode flag (GLVRB) in the System Global area is
; set, then PTDOS will look for and execute a command file
; called START.UP. FORMAT installs such a file and sets the
; GLVRB bit. The START.UP file contains a brief message that
; says the disk was created by FORMAT, and the disk's name.
;--------------------------------------------------------------
;ZAPping PTDOS
;
; Among PTDOS's file protection attributes is PATR, attribute
; change protection. This particular protection is usually set
; on many of  PTDOS's system files, along with PREA - read
; protection. A file with both of these attributes set cannot
; normally be copied by PTDOS, except via DISKCOPY.
;
; Eventually, Processor Technology provided a workaround that
; would allow such files to be copied. The workaround was a
; little program called ZAP, which would overwrite a particular
; byte  within PTDOS in RAM (the PATR bit mask in the
; protection test routine), and override the PATR protection.
; (They also provided UNZAP, which put this bit mask back.)
;
; The exact RAM address of this attribute test within PTDOS
; changed from PTDOS 1.4 to PTDOS 1.5, and so ZAP had to check
; which version was running, by inspecting the two possible
; locations to see which one was in fact PATR.
;
; This program ZAPs the operating system the same way before
; it copies the system files, and reboots PTDOS from disk when
; done. As with the real ZAP program, this program will abort
; with an error if PATR is not found in either of the two
; possible addresses.
;==============================================================
;Program Notes
; This is written to assemble with Digital Research's ASM.
;
; In order to minimize its RAM footprint, this program overlays
; its initialization code with data structures and buffers,
; once the command line has been parsed.
;==============================================================
FALSE	equ	0
TRUE	equ	not FALSE

;Program equates

FGLLOW	equ	6800h	;lowest PTDOS address while we work
			;leaving room for big buffers
STKSIZ	equ	32	;stack size (bytes)
MAXLEV	equ	5	;L=0 through L=5 allowed
RTRIES	equ	6	;reboot retry max

LDEFLT	equ	3	;default L mode
;NOTE: See FCDFLT below. (Must match LDEFLT)

;--------------
;Boot constants
;--------------
BOTADR	equ	0		;boot load/execute address
BOTLEN	equ	340h		;boot block size

;-------------
;ZAP addresses
;-------------
PATR15	equ	0A890h	;Address of PATR mask in PTDOS 1.5
PATR14	equ	0A8B1h	;Address of PATR mask in PTDOS 1.4

;--------------------------
;Helios Disk format equates
;--------------------------
MAXDRV	equ	7	;max unit number
MAXTRK	equ	76	;disk max track #
MAXSEC	equ	15	;max Helios sector #
HELEN	equ	13	;total bytes in block header
MINSEC	equ	108	;Minimum last sector length
			;See PTDOS BLKLN subroutine, F14#14
FULSIZ	equ	320	;bytes for each block's sector
			;..except the first one
MAXBLK	equ	0FFFh	;max block size
MXIBLK	equ	9C0h	;max "ideal" allowed block size

;----------------
;PTDOS File Types
;----------------
SYSIM	equ	00h		;SYSTEM IMAGE TYPE --(I00)
BNTYP	equ	80h		;BINARY DATA FILE --(00)

;----------------
;ASCII Characters
;----------------
CR	equ	0Dh
QUOTE	equ	27h		;single quote
SOLDEL	equ	5Fh		;Solos destructive delete
MODE	equ	80h		;MODE select

;-------------------------
;Helios Controller Equates
;-------------------------
;Helios Controller Ports (page 7-10)

HEBASE	equ	0F0h		;Helios controller base address
HESTAT	equ	HEBASE		;Status input
HETCMD	equ	HEBASE+1	;Transfer Command output
HETLL	equ	HEBASE+3	;Transfer Length Low output
HETLH	equ	HEBASE+4	;Transfer Length High output
HETAL	equ	HEBASE+5	;Transfer Address High output
				;also clears HESTAT
HETAH	equ	HEBASE+6	;Transfer Address High output
HEDCMD	equ	HEBASE+7	;Drive Command output

;Helios Status bits (page 7-4)

HSTC	equ	01h		;High=Transfer Complete
HSSRDY	equ	02h		;High=SREADY	
HSABRT	equ	04h		;High=Abort
HSCRCE	equ	08h		;High=CRC Error
HSCRCC	equ	10h		;High=CRC Checked
HSRDYN	equ	20h		;Low=Disk Ready
				;(selected, loaded, spinning)
HSSKCN	equ	40h		;Low=Seek Complete
HSIDXN	equ	80h		;Low=Index Hole Present

HTXDON	equ	HSTC+HSSRDY+HSABRT+HSCRCE

;Helios Transfer Command Bits, all active low (page 7-4)

HTNONE	equ	0FFh		;no command
HTERAN	equ	0FEh		;Low=Erase (page 7-36)
HTWRN	equ	0FDh		;Low=Write, High=Read
HTDATN	equ	0FBh		;Low=Data, High=header
HTENN	equ	0F7h		;Low=enable transfer

HRHDR	equ	HTENN				;read header
HRDATA	equ	HTENN and HTDATN		;read data
HWHDR	equ	HTENN and HTWRN			;write header
HWDATA	equ	HTENN and HTWRN and HTDATN	;write data

;Helios Drive Command Bits, all active low (page 7-5)

HDSTPN	equ	0FEh		;Low=step
HDSIN	equ	0FDh		;Low = step in, high=step out
HDDS1N	equ	0FBh		;Drive Select 1, active low
HDDS2N	equ	0F7h		;Drive Select 2, active low
HDRSTN	equ	0EFh		;Restore Disk, active low
HDHL0N	equ	0DFh		;Load Even Head, active low
HDHL1N	equ	0BFh		;Load Odd Head, active low
HDDSN	equ	07Fh		;Select Odd Disk, active low

;-----------------------------
;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
SRESET	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
			;(trashes b)
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 THIS 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 CHRR ROUTINE POINTER
GLWCH	equ	SGA+23	;FILE #1 WRITE CHR ROUTINE POINTER
GLTCH	equ	SGA+25	;CONSOLE TEST CHR 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 INT 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 OP 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

;******************************************************
;Parameters for files that are contained within this
;FORMAT program, and are loaded onto disk during format
;phase 2. Note: START.UP parameters are far below.
;******************************************************
;Boot loader Parameters
;(only a dummy BOOTLOAD file is in FORMAT.)

BLTYP	equ	BNTYP		;File type (Binary for now)
IDBOT	equ	6		;File ID
BLNDX	equ	0		;Index block (none)
DABOS	equ	0		;Sector
DABOT	equ	0		;track
BLBBC	equ	380h		;Block byte count
BLDBC	equ	340h		;data byte count
BLCNT	equ	1		;Blocks
BLBPB	equ	0		;Block Protection bit (msb)
BLSPB	equ	(BLBBC+179h)/140h ;Sectors/block
BLFPA	equ	PKIL+PWRI+PATR+PNAT+PFINF+PALO
				;File protection attributes

;RESIDENT Parameters (PTDOS itself)
;(only a dummy RESIDENT file is in FORMAT.)

RESTYP	equ	BNTYP		;File type (Binary for now)
IDRES	equ	4		;File ID
RSNDX	equ	0		;Index block (none)
DARSS1	equ	3		;1st Sector
DARST1	equ	0		;1st track
DARSS2	equ	0		;2nd sector
DARST2	equ	1		;2nd track
RESBBC	equ	0FFFh		;Block byte count
RESDBC	equ	RESBBC		;Block data byte count
RESCNT	equ	2		;Blocks
RESBPB	equ	0		;Block Protection bit (msb)
RESSPB	equ	(RESDBC+179h)/140h ;Sectors/block

;System Global Area Parameters

SGATYP	equ	BNTYP		;File type (binary)
IDSPA	equ	5		;File ID
SGNDX	equ	0		;Index block (none)
DASPS	equ	13		;Sector
DASPT	equ	1		;track
SGADBC	equ	268h		;Data byte count
SGABBC	equ	SGADBC		;Block byte count
SGACNT	equ	1		;Blocks
SGABPB	equ	0		;Block Protection bit (msb)
SGASPB	equ	(SGABBC+179h)/140h ;Sectors/block
SGAFPA	equ	PKIL+PWRI+PATR+PNAT+PFINF+PALO+PUSR
				;File protection attributes

;Directory's first block Parameters

DIRTYP	equ	BNTYP		;File type (binary)
IDDIR	equ	2		;File ID
DRNDX	equ	0		;Index block (none)
DIRDS	equ	0		;Sector
DIRDT	equ	25		;track
DIRDBC	equ	256		;Data byte count
DIRBBC	equ	DIRDBC		;Block byte count
DIRCNT	equ	16		;Blocks
DIRBPB	equ	0		;Block Protection bit (msb)
DIRSPB	equ	(DIRBBC+179h)/140h ;Sectors/block
DIRFPA	equ	PKIL+PWRI+PATR+PNAT+PFINF
				;File protection attributes

;Free Sector Map Parameters

FSMTYP	equ	BNTYP		;File type (binary)
IDFSM	equ	1		;File ID
FSNDX	equ	0		;Index block (none)
DAFSS	equ	0		;Sector
DAFST	equ	26		;Track
FSMDBC	equ	2*77		;Data byte count
FSMBBC	equ	FSMDBC		;Block byte count
FSMCNT	equ	1		;Blocks
FSMBPB	equ	0		;Block Protection bit (msb)
FSMSPB	equ	(FSMBBC+179h)/140h ;Sectors/block
FSMFPA	equ	PKIL+PWRI+PATR+PNAT+PFINF+PALO
				;File protection attributes

;Next ID file Parameters

NIDTYP	equ	BNTYP		;File type (binary)
IDNID	equ	3		;File ID
NINDX	equ	0		;Index block (none)
DANIS	equ	1		;Sector
DANIT	equ	26		;Track
NIDDBC	equ	2		;Data byte count
NIDBBC	equ	NIDDBC		;Block byte count
NIDCNT	equ	1		;Blocks
NIDBPB	equ	0		;Block Protection bit (msb)
NIDSPB	equ	(NIDBBC+179h)/140h ;Sectors/block
NIDFPA	equ	PKIL+PWRI+PATR+PNAT+PFINF
				;File protection attributes

;SUTIL File ID. Note that this could be as low as 7, but PTDOS
;normally has it at 14h. I have not seen anything that expects
;SUTIL to have ID=14h (so long as SYSGLOBL is set up right),
;but there is no harm in sticking with 14h.

IDSUT	equ	14h		;file IDs start here too

;*************
;Start of Code
;*************
	org	0

	lxi	sp,FGLLOW	;stack at top of user memory
	call	INIT		;parse command line, etc. with
				;..code that gets overwritten

;-----------------------------------------------------
;Create an empty Free Sector Map. (Each bit represents
;a sector, where set bits mean free sectors.) Occupied
;sectors will be flagged with 0 bits in FSMAP as they
;are written to disk.
;-----------------------------------------------------
	lxi	h,FSMAP
	lxi	b,FSMDBC*256+0FFh

FSMCLP:	mov	m,c		;c=0FFh
	inx	h
	dcr	b
	jnz	FSMCLP

;-------------------------------------------
;Create dummy file for BOOTLOAD and RESIDENT
;  b=0 here
;-------------------------------------------
	lxi	h,DUMYBF
	mvi	c,4		;4 nulls first

DMYLP1:	mov	m,b		;b=0
	inx	h
	dcr	c
	jnz	DMYLP1

	lxi	b,MAXBLK	;count (0FFFh)
DMYLP2:	mvi	m,76h		;halt instruction
	inx	h
	dcx	b
	mov	a,b
	ora	c
	jnz	DMYLP2

;-----------------------------------------
;Read the SYSGLO file from the source disk
;into the System Global data structure
;  b=0 here
;-----------------------------------------
	mov	h,b		;set hl=0
	mov	l,b		;..for static buffering
	lxi	d,SGANAM
	call	SYS
	db	OPEOP		;file open
	call	FIXERR		;Error return point

;Read SYSGLO into our SGA buffer
;  a=file number from SYS

	lxi	b,SGADBC	;max bytes in our buffer
	lxi	d,SGABUF	;beginning of buffer
	call	SYS
	db	RBLOP		;read
	call	FIXERR		;Error return point

	call	CLOSAL		;close any open disk files

;-------------------------------------------------------
;Move new disk date, name, and password into the SYSGLO
;image in SGABUF. This is done here (instead of in INIT)
;because the data structure overlays the INIT code.
;-------------------------------------------------------
	lxi	b,DDNLEN	;length of date+name+password
	lxi	h,DDDATE	;source
	lxi	d,SGAIMG+GLDAT	;destination
	call	LDIR		;returns bc=0

;If the user did not provide a disk name, then finish the
;PTDOS version number within the default disk name in the
;SYSGLO image, based on the source disk's PTDOS version
;  b=0 here

	lda	CUSTNM		;Did the user provide a name?
	ora	a
	jnz	CNAME

	lda	SGAIMG+GLVER	;get PTDOS version number

	rar			;get high nibble
	rar			;e.g.52h means PTDOS 1.5.2
	rar
	rar
	ani	0Fh
	adi	'0'		;make it ASCII

	sta	SGAIMG+GLNAM+7	;becomes last digit of disk name
CNAME:

;--------------------------------------
;Install the default or user-supplied
;disk name into START.UP file RAM iamge
;  b=0 here
;--------------------------------------
	mvi	c,8		;(b=0 already)
	lxi	h,SGAIMG+GLNAM	;source
	lxi	d,SUNAME	;destination
	call	LDIR		;returns a=0

;-----------------------------------------
;Set "verbose mode" flag, so that START.UP
;will be run at boot time on the new disk.
;  a=0 here
;-----------------------------------------
	inr	a		;a=1
	sta	SGAIMG+GLVRB

;------------------------------------------
;Make the destination disk the default disk
;------------------------------------------
	lhld	SYSGLO		;PTDOS's System Global area
	lxi	d,GLUNI
	dad	d
	lda	DSTDSK
	mov	m,a		;default=destination disk

;=====================
;Format or reinstall?
;=====================
	lda	RIFLAG		;Reinstall flag
	ora	a		;reinstalling PTDOS?
	jz	PHASE1		;n: fresh format

;===========================================================
;Phase 1R: Reinstall PTDOS. No basic format. Rewrite
;SYSGLOBL, and check that BOOTLOAD and RESIDENT can be
;rewritten. The destination unit is the default unit here.
;===========================================================
;-----------------
;Rewrite SYSGLOBAL
;-----------------
	mvi	h,PALO		;just protect disk allocation
	lxi	d,SGANAM	;..for SYSGLBL
	call	SYS
	db	CHAOP
	call	FIXERR		;let PTDOS explain errors

	lxi	d,SGANAM	;SYSGLOBL
	lxi	h,0		;static buffering
	call	SYS
	db	OPEOP		;file create
	call	FIXERR		;Error-return point

;  a=SYSGLO file number

	lxi	b,SGADBC	;byte count
	lxi	d,SGABUF	;fresh System Global Area
	call	SYS
	db	WBLOP		;write block
	call	FIXERR		;Error-return point

	call	CLOSAL		;close file (close all)

	mvi	h,SGAFPA	;correct attributes
	lxi	d,SGANAM	;..for SYSGLBL
	call	SYS
	db	CHAOP
	call	FIXERR		;let PTDOS explain errors

;If LMODE=0 then we just repair SYSGLOBAL and quit

	lda	LMODE
	ora	a
	jz	NEXIT

;-----------------------------------------------	
;Make sure BOOTLOAD and RESIDENT are repairable:
;* Exist in the directory
;* Are at the correct locations on disk
;* have the correct file IDs
;* Have the correct block count
;* Have correct block sizes
;-----------------------------------------------
;Remove most protections from BOOTLOAD

	lxi	d,BLNAME	;BOOTLOAD
	mvi	h,PALO		;just protect disk allocation
	call	SYS
	db	CHAOP
	call	FIXERR		;let PTDOS explain errors

;Check BOOTLOAD's info

	lxi	h,INFOBF	;place to put file info

	call	SYS
	db	INFOP		;get info
	call	BADBOT		;Error return point

;right location on disk?

	lhld	IFBS		;sector and track
	mov	a,l		;sector must be 0
	ora	h		;track must be 0

;just one block?

	lhld	IFBCNT		;should be 1 block
	dcx	h
	ora	l		;accumulated error
	ora	h
	jnz	BADBOT		;if not, can't fix

;The byte count must be such that the block takes 3 sectors

	lhld	IBSIZE		;correct size?
	lxi	d,-(256+FULSIZ+1)
	dad	d		;subtract the minimum size

	lxi	d,-FULSIZ
	dad	d
	jc	BADBOT

;Remove most protections from RESIDENT

	lxi	d,RESNAM	;RESIDENT
	mvi	h,PALO		;just protect disk allocation
	call	SYS
	db	CHAOP
	call	FIXERR		;let PTDOS explain errors

;Check RESIDENT's first block from the File Info result

	lxi	h,INFOBF	;place to put file info

	call	SYS
	db	INFOP		;get info
	call	BADRES		;Error return point

	lhld	IFILID		;check file ID
	mov	a,l
	xri	IDRES
	ora	h
	mov	b,a		;accumulate error

	lhld	IFBS		;check first block location
	mov	a,l		;sector
	xri	DARSS1
	ora	h		;must be track 0

	ora	b
	mov	b,a		;accumulate error

	lhld	IFBCNT		;block count
	mov	a,l
	xri	RESCNT
	ora	h		;high byte 0
	ora	b		;combine errors
	jnz	BADRES

;Need to look at RESIDENT's first block header, to see
;if the second block is in the right place

	call	RESTOR		;restore the disk to track 0

	call	WINDEX		;wait for index

	lxi	h,HDRBUF
	mvi	b,1		;read 2nd header
	call	RHEADN
	jnz	BADRES

	lhld	HBFCP		;forward chaining pointer
	mov	a,h		;forward chain track
	xri	DARST2
	ora	l		;forward chain sect should be 0
	mov	b,a		;accumulate errors

;Also check sectors/block from the header

	lda	HBSCNT
	ani	7Fh		;remove protection
	xri	RESSPB

	ora	b		;combine errors
	jz	PHASE3		;ok: go repair RESIDENT

;RESIDENT file is too corrupt to repair

BADRES:	lxi	d,RESMSG	;'RESIDENT',0
	jmp	CBRERR

;====================================================
;Phase 1: Erase, and write basic format on all tracks
;On Entry:
;  DELCNT = 0 (initialized variable)
;====================================================
PHASE1:	call	CILPRT
	db	'Formatting track ',' '+80h

;Restore the disk to track 0
;(also selects the destination unit)

	call	RESTOR		;restore the disk

;Erase & Format each track on the disk

	mvi	b,0FFh		;start with track 0
				;account for initial inc in IDISPB

EFDLUP:	call	IDISPB		;inc, then display track number
				;with user abort opportunity
	push	b
	call	SEEK		;seek track b
	call	TFRMAT		;format the track

	pop	b		;done all tracks?
	mov	a,b
	cpi	MAXTRK
	jnz	EFDLUP		;n: do another
EFDONE:

;===========================================================
;Phase 2: Copy the necessary files from RAM onto the disk to
;create a data disk, updating the free sector map as we go.
;This cannot be done via PTDOS calls because the necessary
;files (the directory, the free sector map etc.) do not yet
;exist on disk, where PTDOS expects them.
;===========================================================
	call	CILPRT
	db	'Writing format block ',' '+80h

	lxi	h,FILLST	;list of files to write

	xra	a
	sta	DELCNT		;no initial backing up in DISPB
	mov	b,a		;block count for display

WFLOOP:	mov	e,m
	inx	h
	mov	d,m		;de = block data address
	inx	h		;hl points to block header

	mov	a,e		;end of table?
	ora	d
	jz	FDLDON		;y:out of loop

	call	IDISPB		;inc then display block count
				;with user abort opportunity

	push	b
	push	h
	call	WBLOCK		;write block to disk, and
				;..update Free Sector Map
	pop	h
	pop	b

	lxi	d,HELEN		;next header
	dad	d
	jmp	WFLOOP	
FDLDON:

;---------------------------------------------------
;Write the remaining 15 directory track blocks, also
;updating the Free Sector Map in the FSMAP buffer as
;we go. hl points to the directory header prototype.
;---------------------------------------------------
	mvi	c,1		;logical sector number

	mov	e,m
	inx	h
	mov	d,m		;de points to block data
	inx	h		;hl points to block header

WDLOOP:	call	IDISPB		;inc then display block count
				;with user abort opportunity

;Put sector number and chaining links in prototype header

	mov	a,c
	dcr	a
	sta	DFBACK		;backwards link
	mov	m,c		;(DFSECT)sector number

	inr	c
	mov	a,c
	sta	DFFORE		;forward link

	cpi	DIRCNT		;last one?
	jnz	WDL1

	push	h
	lxi	h,8000h+DIRDBC	;end link is sector & track
	shld	DFFORE
	pop	h
WDL1:

;Write directory sector to disk.
; b = block count
; c = sector number
; de = data address
; hl = header address

	push	h
	push	d
	push	b
	call	WBLOCK		;Write block to disk, and
				;..update Free Sector Map
	pop	b
	pop	d
	pop	h

;Next directory sector

	mov	a,c		;sector number
	cpi	DIRCNT		;did the last one?
	jnz	WDLOOP

;-----------------------------------------
;Write the updated Free Sector Map to disk
;-----------------------------------------
	call	IDISPB		;bump then display block number
				;with user abort opportunity

	lxi	d,FSMAP		;constructed free sector map
	lxi	h,FSMHDR	;..and its header
	call	WBLOCK		;write block to disk, after
				;..updating the Free Sector Map
				;..with itself

;-------------------------------------------------------------
;The disk is now a complete PTDOS disk, with all the necessary
;files for PTDOS to manage the disk. From this point forward,
;all disk operations are performed using PTDOS functions.
;-------------------------------------------------------------

;=========================================================
;Phase 3: If this is to be a bootable disk, then copy the
;system files from the source disk to the destination disk
;=========================================================
PHASE3:	lda	LMODE		;Make Bootable?
	ora	a
	jz	L0EXIT		;L=0 means no: cleanup & exit

;------------------------------------------------------------
;Loop to read each listed file from the source disk and write
;it to the destination disk. If it is a device driver, then
;convert it to an Image file before copying it, and convert
;it and the copy back, once copied. If copy protected,
;unprotect it, and put the protection back when done. Make
;the block size the same for the destination. The "file
;sequence number" here is the file number displayed on
;screen as the copy progresses.
;On Entry:
;  FILSEQ = 1 (an initialized variable)
;  FCOUNT = total number of files to be copied
;------------------------------------------------------------
	lda	SRCDSK		;set source disk as default
	call	SYS
	db	SUNOP
	call	FIXERR		;error return

	call	PCFMSG		;'Copying  ', sets DELCNT=0

	lxi	d,SYSLST	;file name list

FCLOOP:

;(Re)print the file count and name on the screen
;The printout looks like this:
;   'Copying 2/37 MYFILE '

;1) Delete tail of previous string, e.g. : '2/37 MYFILE '

	call	DELM		;delete DELCNT+1 characters
				;returns hl=DELCNT

;2) Print the new file sequence number

	push	d		;pointer to next file name

	lda	FILSEQ		;display file number
	call	PADEC		;trashes c,de. returns b=chr count
	mov	m,b		;remember chrs in count in DELCNT
	
;3) Print the slash

	call	ILPRNT
	db	'/'+80h

;4) (Re)print the total file count

	lda	FCOUNT		;file count
	call	PADEC		;trashes c,de. returns b=chr count

	mov	a,m
	add	b
	mov	m,a

	pop	d		;pointer to file name

;5) Print a seperator space

	call	ILPRNT		;space before file name
	db	' '+80h

;6) Print the new file name

	push	d		;pointer to file name
	call	PRINTF		;print file name at de,
				;..returns c=chr count+2
	pop	d		;pointer to file name

;7) Finish computing, and remember the number of chrs
;   to delete for the next pass through, in 1) above

	mov	a,m		;chr count so far
	add	c		;plus file name length+2
	mov	m,a		;back into DELCNT

;8) One more space, so the cursor is moved over (to be pretty)

	call	ILPRNT		;move the cursor over one for beauty
	db	' '+80h

;Ask PTDOS to get the file info and put it in INFOBF. If the
;file does not exist, then INFERR will return to SKPFIL below.
;  de points to the file name

	lxi	h,INFOBF	;place to put file info

	call	SYS
	db	INFOP		;get info
	call	INFERR		;Error return point

;Remember the source file's protection attributes and file type
;because we may change them temporarily

	lda	IFTYPE		;File type from INFOBF
	sta	FTSAVE
	mov	c,a		;temp save

	lxi	h,IPATTR
	mov	a,m		;prot. attributes from INFOBF
	sta	PASAVE

;If the file is read-protected, then unprotect it in the INFOBF
;structure, and remember to change the source file protection
;attributes later by setting the flag to 1.

	mvi	a,PREA		;read protection bit
	call	CHKFPA

;Device drivers cannot be copied, because PTDOS will invoke the
;driver to get data, rather than copying the driver. So here
;we temporarily convert the device driver to an Image file of
;type 'I$', and remember that we did, so we can put it back.

	inr	c		;test for 0FFh: device driver?
	jnz	TYPOK		;n: file is already copiable

;If changing the file type is blocked, then change the
;protection attributes first in the INFOBF buffer and remember
;to change the source file protection attributes later.

	mvi	a,PNAT		;file type change protection
	call	CHKFPA

;Now change the file type in the INFOBF structure. Remember
;that we need to change source file's file type, by setting the
;flag to 1.

	mvi	a,'$'		;temporary file type
	sta	IFTYPE		;file type in INFOBF

	mvi	a,1		;file type must be changed	
	sta	FTFLAG
TYPOK:

;Make the destination file writeable etc. in INFOBF,
;and remember the modified attributes from CHKFPA above,
;in h for CHNGPA

	lxi	h,IPATTR
	mov	a,m		;modified attributes
	mvi	m,0		;no protection yet
	mov	h,a		;modified attributes

;Change the source file attributes, if flagged for change
;by CHKFPA above. de points to the file name in SYSLST.

	lda	PAFLAG		;PAFLAG=1 means we need to
	ora	a		;change the attributes
	cnz	CHNGPA		;h=new attributes

	lxi	h,PAFLAG	;PAFLAG incrementing to 2 means
	inr	m		;..attributes have now changed

;Convert the source file type, if flagged for change above.
;de still points to the file name.

	mvi	h,'$'		;temp new file type

	lda	FTFLAG		;need to change file type?
	ora	a
	cnz	CHNGFT

	lxi	h,FTFLAG	;FTFLAG incrementing to 2 means
	inr	m		;..the file type has changed

;Open the source file
;de still points to the file name.

	lxi	h,0		;static buffering
	call	SYS
	db	OPEOP		;file open (trashes b)
	call	FIXERR		;Error return point

	sta	SRCFN		;remember source file number

;----------------------------------------------------
;Loop to copy the source file to the destination file
;one buffer-full at a time
;----------------------------------------------------
	push	d		;pointer to file name in SYSLST

	lxi	h,100h		;h: no EOF yet,
				;l: dest file not yet open

COPLUP:	lxi	b,DBSIZE	;max bytes in our buffer
	lxi	d,DATBUF	;beginning of buffer

;Read up to bc bytes from the source, and save them at de

	lda	SRCFN		;source file number
	call	SYS
	db	RBLOP		;read
	call	TRBERR		;Error-return: a=either EOF or
				;..real error. Will return
				;..(with h=0) only on EOF

;Compute bc=the number of bytes actually read
;  bc := DBSIZE-bc
;Return here from TRBERR to write a short last buffer-full

	mvi	a,DBSIZE and 0FFh
	sub	c		;16-bit subtract
	mov	c,a
	mvi	a,DBSIZE/256
	sbb	b
	mov	b,a

;Create and open the destination file if it's not already
;open. Compute ideal block size if the entire file fit in
;the buffer. Otherwise use the source file's block size.
;(If the file already exists on the destination disk, then
;its block size will not be changed.)
;  bc = number of bytes read
;  h = 0 if EOF encountered, 1 if not
;  l = 1 if destination file is open, 0 if not

	dcr	l
	cnz	DOPEN

;Write from the buffer to the destination disk
;  bc = number of bytes to write
;  h = 0 if EOF encountered, 1 if not

	lxi	d,DATBUF	;beginning of source buffer

	lda	DSTFN		;destination file number
	call	SYS
	db	WBLOP		;write
	call	DFIXER		;Error-return

	dcr	h		;0 means EOF, 1 means not yet
	lxi	h,101h		;h: no EOF yet
				;l: dest file is open
	jz	COPLUP		;no EOF: read more

;----------------------------------------------------------
;All data is copied. If the source file has an index block,
;then create one for the destination file
;----------------------------------------------------------
	lhld	IINDBS		;Source file index pointer
	mov	a,h
	ora	l
	jz	NOINDX

	lda	DSTFN		;destination file number
	call	SYS
	db	RNDOP		;make file random access
	call	DFIXER		;Error-return
NOINDX:

;Close source and destination files by closing all files

	call	CLOSAL		;close all files

;Install the file type from the source disk onto the
;destination disk. Do this always so it is right for reinstalls.

	lxi	d,IFNAME	;destination file name

	lhld	FTFLAG		;h=source file type
	call	CHNGFT

;If this file was SUTIL (File count is 3) then update SYSGLOBL
;with the correct pointers to this permanently-open file
;  de = IFNAME

	lda	FILSEQ		;is this the third file?
	cpi	3
	cz	FIXSGA		;y: it's SUTIL

;Install the protection attributes from the source disk onto the
;destination disk.
;  de = IFNAME

	lhld	PAFLAG		;h=source prot. attributes
	call	CHNGPA		;apply to destination

;Restore the source disk file's type and protection attributes
;if they were changed, and clear the change flags

	pop	d		;source file name in SYSLST
	call	TARSTR		;restore type and attributes

;Next file. Re-enter here if a file was not found on the
;source disk.
;  FILSEQ = file sequence number
;  (de) = source file name in SYSLS

SKPFIL:	call	CHKABT		;user-abort opportunity

	lxi	h,FILSEQ	;bump file number
	inr	m

NAMEND:	ldax	d		;hunt for end of file name
	inx	d
	ora	a		;end marker?
	jnz	NAMEND		;n: keep looking

	ldax	d		;end of file list?
	ora	a
	jnz	FCLOOP

;Next group of files, if requested by the "L=" level

	inx	d
	lxi	h,LMODE
	dcr	m
	jnz	FCLOOP

;----------------------------------
;Formatting completed successfully.
;Announce, and return to PTDOS
;----------------------------------
	jmp	NEXIT

;---Local Subroutine-------------------------------------
;Error return from RBLOP call to SYS. If this is the EOF,
;then return to copying loop with  h=0 (to indicate EOF).
;If not, abort with a real error.
;On entry:
;  a=either EOF or an error codes from PTDOS
;  top of stack = "return" address for error routine
;  next on stack = pointer to file name
;On normal exit:
;  h = 0
;On Error exit to FIXERR:
;  a = error codes
;  top-of-stack = "return" address of SYS call
;  de = pointer to file name 
;--------------------------------------------------------
TRBERR:	mvi	h,0		;remember EOF
	cpi	EREOF		;end of file?
	rz			;y: carry on

;Fall into DFIXER
	
;---Local Subroutine-------------------------------------
;Error return from WBLOP call to SYS.
;On entry:
;  a = error codes
;  top of stack = "return" address for error routine
;  next on stack = pointer to file name
;On exit to FIXERR:
;  a = error codes
;  top-of-stack = "return" address of SYS call
;  de = pointer to file name 
;--------------------------------------------------------
DFIXER:	pop	h		;hl = "return" address
	pop	d		;get de=file name pointer
	push	h		;replace return address

	jmp	FIXERR

;---Local Subroutine----------------------------
;Error creating the file on the destination disk
;If the error is that the file already exists
;and either it's one of the first 2 files (B<3)
;or the Reinstall flag RIFLAG is set, then just
;return, to overwrite the existing file.
;Otherwise, it's an error
;On Entry:
;  a = error code
;  FILSEQ = FORMAT's file number
;Trashes psw,de,h
;-----------------------------------------------
CREERR:	lxi	d,IFNAME	;file name with /n for unit n

	cpi	ERAEX		;file alreade exist?
	jnz	FIXERR		;n: fix source disk, exit

	lda	FILSEQ		;RESIDENT or BOOTLOAD?
	cpi	MAXSYS
	rc			;y: okay to overwrite

	lda	RIFLAG		;Reinstalling PTDOS?
	ora	a

	mvi	a,ERAEX		;n: let PTDOS explain
	jz	FIXERR

;We are overwriting a file that's not BOOTLOAD or RESIDENT.
;Remove any protection attributes it might have, and set it's
;file type to something innocuous...

	mvi	h,0		;no protection
	call	CHNGPA

;...and change its file type, in case it's a device driver.
;The file type will be restored later.

	mvi	h,'$'		;file type
	jmp	CHNGFT

;---Local Subroutine---------------------------
;Error getting file info.
;If the file does not exist, announce this fact
;and carry on.
;On Entry:
;  a = error code from SYS
;  b = file sequence number
;  de points to 0-terminated file name string
;  top of stack = "return" address for PTDER
;Note: this "returns" to SKPFIL.
;Trashes psw,hl
;----------------------------------------------
INFERR:	cpi	ERNEX		;Nonexistant file error?
	jnz	FIXERR		;n: fix source disk, exit

	lxi	h,SKPFIL	;replace return address
	xthl

	call	ILPRNT
	db	'<--Not foun','d'+80h

;Fall into PCFMSG

;***Subroutine******************
;(Re-)print Copying message
;On Exit:
;  DELCNT = 0
;  A=0
;Trashes psw
;*******************************
PCFMSG:	call	CILPRT
	db	'Copying ',' '+80h
	xra	a		;0 means delete just 1
	sta	DELCNT

	ret

;***Subroutine*****************************
;Check file protection attribute
;and clear it if set.
;On Entry:
;  a = protection attribute bit mask
;  hl = IPATTR
;On Exit if protection attribute bit was 0:
;  Protection bits are 0
;  PAFLAG = 1 
;trashes psw
;******************************************   
CHKFPA:	ana	m
	rz			;no changes needed

	xra	m		;turn bit(s) off
	mov	m,a
	mvi	a,1		;set PAFLAG to 1 so that
	sta	PAFLAG		;..prot. attributes will change

	ret

;***Subroutine************
;Close all open files
;*************************
CLOSAL:	mvi	a,255		;close all files
	call	SYS		;..on all units
	db	CAOP
	nop			;CAOP generates no errors
	nop
	nop

	ret

;***Subroutine*****************************
;Install SUTIL pointer in SYSGLOBL image,
;and write SYSGLOBL to the destination disk
;On Entry:
;  de = IFNAME
;  (IFNAME) = 'SUTIL/<n>',0
;  SUTIL's info is no INFOBF
;TRashes psw, hl
;******************************************
FIXSGA:	push	d		;IFNAME = SUTIL
	push	b

;Update SYSGLOBL with pointers to SUTIL. Use JNKBUF
;since we still need the file name in INFOBUF on return

	lxi	h,JNKBUF	;place to put file info
	call	SYS
	db	INFOP		;get info about SUTIL
	call	FIXERR		;Error return point

	lhld	JNKBUF-INFOBF+IINDBS	;Index pointer
	shld	F2INDX			;into FCB2

	lhld	JNKBUF-INFOBF+IFBS	;1st block pointer
	shld	F2FBA			;into FCB2

	lhld	JNKBUF-INFOBF+IFILID	;File ID
	shld	F2ID			;into FCB2

;Remove any protection from SYSGLOBL

	lxi	d,SGANAM	;'SYSGLOBL'
	call	SELDU		;..on destination drive
	push	d

	mvi	h,0		;no protection for now
	call	CHNGPA

;Open SYSGLOBL

	lxi	h,0		;static buffering
	call	SYS
	db	OPEOP		;file create (trashes b)
	call	FIXERR		;Error-return point

;Rewrite SYSGLOBL from the System Global buffer buffer
;a=file number

	lxi	b,SGADBC	;Size if SGA file
	lxi	d,SGABUF	;beginning of buffer
	call	SYS
	db	WBLOP		;write block
	call	DFIXER		;Error return point

	call	CLOSAL		;close all open disk files

	pop	d		;'SYSGLOBL/n',0
	mvi	h,SGAFPA	;correct protection attributes
	call	CHNGPA		;..for SYSGLOBL

	pop	b
	pop	d		;IFNAME
	ret

;***Subroutine**************************************
;Add destination unit specifier to a file name
;On Entry:
;  de points to the first character of the file name
;  DSTDSK = (binary) destination unit number
;Trashes psw
;***************************************************
SELDU:	push	d
	push	h

	xchg			;address to hl
	mvi	d,8		;max name length
	xra	a

;Hunt for either null at end of name or 8 chrs

SELUL:	inx	h
	cmp	m		;search for name end
	jz	SUNEND

	dcr	d		;max chrs?
	jnz	SELUL

SUNEND:	mvi	m,'/'		;tack on "/n"
	inx	h

	lda	DSTDSK		;n is DSTDSK
	adi	'0'		;make it ASCII
	mov	m,a
	inx	h
	mvi	m,0		;install null delimiter

	pop	h
	pop	d
	ret

;***Subroutine*****************************************
;Open destination file with "ideal" block size. (The
;block size will not be changed unless the entire file
;fit within FORMAT's buffer.)
;   if (EOF encountered) then
;      calculate ideal BLOCK SIZE
;   else
;      BLOCK SIZE = source file block size
;   endif
;   CREATE file with BLOCK SIZE
;   if CREATE error=file exists then
;       BLOCK SIZE will be destination file block size
;   endif
;   open destination file
;On Entry:
;  bc = number of bytes read from the source
;  h = 0 if EOF encountered, 1 if not
;  IBSIZE=Source file block size
;  DSTDSK=destination drive
;  FILSEQ is the file sequence number
;On Exit:
;  IBSIZE=block size, per above algorithm
;  File is created unless it already existed
;  File is open
;Trashes psw,de
;******************************************************
DOPEN:	push	h		;h=EOF flag
	push	b		;number of bytes read

	dcr	h		;EOF encountered?
	jz	DCREAT		;n: use source file block size

	lda	FILSEQ		;type 0 file?
	cpi	MAXSYS+1
	jc	DCREAT		;don't re-block system files

;-----------------------------
; Calculate "ideal" block size
;-----------------------------
	lxi	d,-1		;negative divisor
	push	d

;Calculate the minimum block size to fit the file into
;-de blocks. If the file fits, we are done.

DBSL1:	lxi	d,140h

	lxi	h,100h-140h	;calculate a good block size

DBSL2:	dad	d		;next block size
	mov	a,l		;16-bit compare hl-bc
	sub	c
	mov	a,h
	sbb	b		;hl-bc
	jnc	GOTDBS		;loop 'til block size>=file size

	mvi	a,(MXIBLK-140h) and 0FFh ;16-bit compare
	sub	l
	mvi	a,(MXIBLK-140h)/256
	sbb	h		;(MXIBLK-140)-hl
	jnc	DBSL2		;loop until we reach max size

;The file is too big to do with this many blocks.
;Try again with one more block.

	pop	d		;de= -(last block size try)
	pop	h		;hl=file size
	push	h
	dcx	d		;next -divisor
	push	d

;  hl = file size
;  de = -(number of blocks to try)
;Compute bc = hl/(-de) rounded up

	lxi	b,0		;result will be in bc

DBSL3:	inx	b
	dad	d		;loop to divide hl by de
	jc	DBSL3

	jmp	DBSL1		;try again with more blocks

;  hl = computed block size. Clean up stack and carry on

GOTDBS:	shld	IBSIZE		;remember new block size

	pop	d		;remove junk from stack

;--------------------------------------------
;Block size is set in IBSIZE. Create the file
;(unless it already exists).
;--------------------------------------------
DCREAT:

;Specify DSTDSK as destination by appending '/<dest>' onto the
;file name in INFOBF


	lxi	d,IFNAME	;file name in INFOBF
	call	SELDU

;Create the destination file using the File Info.

	lxi	d,IFTYPE	;file type in INFOBF
				;followed by block size,
				;protection attributes, and
				;file name, with /n for unit n
	call	SYS
	db	CREOP		;file create
	call	CREERR		;Error-return point

;Open the (perhaps) newly-created destination file, using the
;File Info that we just got and modified.
;CREERR (SYS's error return) will return here if SYS's error is
;that the file already exists and either the file is one of the
;first 2 files (BOOTLOAD and RESIDENT, which already exist
;on the destination disk as dummy files) or the Reinstall flag
;is set (in which case all the files will be rewritten).

	lxi	d,IFNAME	;file name with /n for unit n
	lxi	h,0		;static buffering
	call	SYS
	db	OPEOP		;file open
	call	FIXERR		;Error return point (trashes b)

	sta	DSTFN		;remember file number

	pop	b		;file size
	pop	h		;h=EOF flag
	ret

;***Subroutine**********************************************
;Basic-Format one track
;Note: The directory track sectors get interleaved here.
;On Entry:
;  head is on the desired track and loaded
;On Exit:
;  All headers have:
;    Correct track number
;    Correct logical sector number
;       (logical=physical sector, except directory track)
;    Correct chaining links for empty sectors
;    bytes/block=256
;    sectors/block=1
;    File ID = 0
;  All data blocks have:
;    256 bytes of valid data
;    valid CRC
;Aborts on error
;Trashes all registers
;***********************************************************
TFRMAT:	out	HETAL		;clear errors

;--------------------
;Erase selected track
;--------------------
	mvi	a,HTERAN	;issue erase command
	out	HETCMD		;This kicks off the erase

;Erase for up to 2 full revs

	call	WINDEX		;wait for next INDEX
	cz	WINDEX		;wait for another if ok
	jnz	TERERR		;any errors?


;End the Helios erase command

	mvi	a,HTNONE
	out	HETCMD		;This ends the erase

;-------------------------------------------------
;Install current track number in the format header
;-------------------------------------------------
	lda	CURTRK		;current track number
	sta	HDRBUF+1

;----------------------------------------------------------
;Loop through all 16 sectors, writing first the header,
;and then the data. This will spin the disk a rev between
;each operation. This is quite slow, but works. (It is also
;how DISKCOPY formats.)
;---------------------------------------------------------
	mvi	c,0		;init physical sector number

TFLOOP:

;Prepare and write the block header to disk. Interleave the
;sector numbers to create and write logical sector numbers
;for the directory track.
;c=physical sector number here.

	call	INTRLV		;compute logical block number
	lxi	h,HDRBUF
	mov	m,a		;..and put it in the header

	push	b		;save c=physical sector number
	call	FHWRIT		;write block header c from (hl)
				;..based on rotational position
	pop	b
	jnz	FHWERR		;any errors?

;Re-seek the sector and write the block data to disk

	mov	a,c		;remember block number
	sta	CURBLK		;..for error reporting

	call	WINDEX		;wait for index pulse
				;Timeout: ret with Z cleared
				;..and error code in a

;If index found, read c+1 block headers into the same header buffer.
;ignore CRC errors except on the last block - the one we want

	mov	b,c		;b counts blocks
	cz	RHEADN		;(202+17)read bth header
	jnz	FHRERR		;(10)errors?

;Write the block data immediately

	mvi	b,HWDATA	;(7)write block data command
				;   c=physical block number	
	lxi	d,256		;(10)block byte count
	lxi	h,FMTDAT	;(10)block data source
	call	HELIOS		;(17+75)Write block data
	jnz	FDWERR		;any errors?

;Check for unexpected index pulse

	mov	a,c		;Writing block 15?
	cpi	MAXSEC
	jz	INDXOK		;y: an index pulse is expected

	mov	a,b		;index pulse save from HELIOS
	ora	a		;any index pulse seen?
	jnz	FDWERR		;y:error
INDXOK:

;Delay for write-to-read turnaround

	call	W2RDEL		;write-read turnaround delay

;Next sector until done

	mov	a,c		;next physical sector
	inr	c
	cpi	MAXSEC		;done?
	jnz	TFLOOP		;n: do another sector

	ret

;***Subroutine***********************************************
;Wait for the end of the next index pulse, timeout after
;about 2 revolutions' time.
;Note: the Persci drive generates a 1 mS index pulse.
;On Exit:
;  Z set, carry clear, a=0 if the end of the index was found.
;  a=40h, carry and Z cleared if timeout waiting for index
;************************************************************
WINDEX:	push	d

;Wait up to 2 rev times or so for an index pulse
;51 cycles >= 25 uS/pass
;1 rev = 166667 uS, so timeout = 2 * (166667/25) = 13334

	lxi	d,13500		;>=2-rev timeout, < 32K

WINDX2:	dcx	d		;(5)
	mov	a,d		;(5)
	ora	e		;(4)timeout?
	jz	WINDX3		;(10)y: ret with Z cleared

	in	HESTAT		;(10)
	ani	HSIDXN		;(7)
	jnz	WINDX2		;(10)

;Wait for the end of the 1 mS index pulse

	mov	d,a		;d=0: >=5.2 ms timeout

NONDX1:	dcr	d		;(5)timeout?
	jz	WINDX3		;(10) y: error exit

	in	HESTAT		;(10)
	ani	HSIDXN		;(7)
	jz	NONDX1		;(10)

;Success: end of index found. ret with Z set, a=0

	xra	a
	pop	d
	ret			;with Z set, a=0

;-------------
;Index timeout
;On Entry:
;   a=0
;-------------
WINDX3:	ori	40h		;index timeout flag, clear Z
	pop	d		;..and clear carry
	ret

;***Subroutine***********************************************
;Find and read nth block header based on rotational position
;
;==> Entry is at RHEADN <==
;
;On Entry:
;  b = number of headers to read minus 1 (b>=0)
;  hl = address of buffer for header data
;On Exit:
;  If no errors:
;    Z set
;    a = 0
;    header data is in buffer (where entry hl specified)
;    203 cycles from CRC checked through ret
;
;  Timeout Errors:
;    Z and carry clear
;    a<0> = 1 if timeout waiting for data
;    a<1> = 1 if timeout waiting for SREADY
;    a<6> = 1 if timeout waiting for index pulse
;
;  All other Errors:
;    Z and carry clear
;    a<2> = 1 if controller abort
;    a<3> = 1 if CRC error
;    a<5> = 1 for track from header does not match CURTRK
;    header data is in buffer (where entry hl specified)
;
; trashes b,de.
;
;Note: a read or write data command must occur within
;300 uS (600 cycles at 2MHz) of the completion of the header.
;************************************************************
RHDN0:	call	WTSRDY		;wait for SREADY (keeps head loaded)
	rnz			;SREADY timeout?

;==>Subroutine Entry <==
RHEADN:	push	b
	lxi	d,HELEN		;bytes/header
	lxi	b,HRHDR*256+7h	;see HELIOS routine for error bits
 				;b=read header command
				;c=error mask for later
				;does not catch CRC errors
	call	HELIOS		;(17+85)read the next header

;Check for timeout or abort errors on intermediate blocks

	mov	e,a		;(5)save errors for final test
	ana	c		;(4)any timeout or abort errors?
	pop	b		;(11)
	rnz			;(5)y: return with Z cleared

	dcr	b		;(5)the block we wanted?
	jp	RHDN0		;(10)n: look for another

;See if the track number in the header is correct
;(e=controller errors here)

	inx	h		;(5)point to track in header
	lda	CURTRK		;(13)Hexer's track number
	xra	m		;(7)correct track in header?
	dcx	h		;(5)undo inx h
	jz	RHDN1		;(10)y: okay

	mvi	a,20h		;(7)n: flag track mismatch error
RHDN1:	ora	e		;(4)combine, test errors, clear carry
	ret			;(10)With error codes in a

;***Subroutine*************************************************
;Write a complete block (header and data), finding the block on
;disk based on block header info. Clear the associated bits in
;the Free Sector MAP (in the Data Buffer) for all sectors of
;this block.
;On Entry:
;  de = address of block data
;  hl = address of block header
;  FSMAP = free sector map
;On Exit:
;  Free Sector Map is updated
;  Block header is written
;  Block data is written
;Error scause rude abort, with error codes:
; a = 00 no error
;     01 timeout waiting for data
;     02 timeout waiting for SREADY
;     04 Helios abort (HSABRT)
;     08 CRC error (HSCRCE)
;     80 Index found while c<>0
;trashes all registers
;**************************************************************
WBLOCK:	push	d		;save block data address

;------------------------
;Seek the requested track
;------------------------
	push	h		;remember pointer to header

	inx	h		;point to track number
	mov	b,m
	call	SEEK
	call	WTSRDY		;wait for controller ready
	jnz	FDWERR		;SREADY timeout?

	pop	h

;--------------------------------------------
;Add this block to the free sector map in RAM
;--------------------------------------------
	push	h		;header address
	mov	c,m		;logical sector number
	call	UNINTV		;get physical sector number
	mov	c,a		;c=physical sector number

	inx	h
	mov	b,m		;b=track number

	lxi	d,HBSCNT-HBTRAC	;offset to sector count in header
	dad	d
	mov	a,m		;a = block sector count with
				;..protection bit in msb
	ani	0Fh		;remove protection bit, etc.
	mov	e,a		;e = block sector count

	mov	a,b		;a=track number
	mov	b,e		;b = block sector count

;Point to Free Sector Map entry for this track
;(16 sectors per track means 2 bytes per entry)
	
	lxi	h,FSMAP		;compute byte number in Map
	rlc			;16 sectors = 2 bytes per track	
	mov	e,a		;de=offset
	dad	d		;hl=address of 1st byte

;Compute bit mask for this Free Sector Map entry
;  hl = address of first byte of this track's entry
;  c = sector number
;  b = number of sectors in this block

	mvi	a,0FEh		;carry is clear here
	dcx	h		;account for initial inx

FSMLUP:	rrc			;compute bit mask
	jc	FSML1
	inx	h		;next FSM byte
FSML1:
	dcr	c		;compute sector bit mask
	jp	FSMLUP

;Clear a bit in the Free Sector Map

	mov	e,a		;temp save bit mask
	ana	m		;combine & clear carry
	mov	m,a		;mark sector used
	mov	a,e		;recover bit mask

;Keep clearing sequential bits until b bits have been cleared

	inr	c		;every bit from now on
	dcr	b		;more sectors in this block?
	jnz	FSMLUP		;y: do it

	pop	h		;pointer to header	

;---------------------------------------------------
;Hunt for the header for the prior block
;  hl = address of header. 1st byte is sector number
;---------------------------------------------------
	xra	a		;writing a header
	sta	RHFLAG

	mov	c,m		;sector number

	push	h		;header address
	call	HNTBLK		;find prior block header
	pop	h		;header address

;-----------------------------
;Write the next block header
;  hl = address of header data
;-----------------------------
	call	HWRITE

;Find this block's sector number and byte count while the disk
;spins around to this same block header

	mov	c,m		;c=sector number
	mvi	b,HWDATA	;write block data command

	lxi	d,HBBCNT-HDRBUF ;de=offset to byte count
	dad	d		;d=0 here
	mov	a,m		;get byte count LSB
	inx	h		;point to MSB
	mov	h,m		;..a 16-bit number
	mov	l,a		;hl=block byte count

	pop	d		;block data address
	push	h		;byte count for verify
	push	d		;put data address back

	push	b		;..preparing for HELIOS

;A block must end at least MINSEC (108) bytes after the occurance
;of its last sector mark. The first sector of a block has 256
;bytes, all others have 320 (FULSIZ) bytes. If the last sector
;would be less than MINSEC bytes, then increase it to MINSEC
;bytes. (See BLKLN subroutine in PTDOS, F14#14)

	push	h		;byte count

	dcr	h		;the first sector is 256 bytes
	jm	PAD1		;is the block < 256 bytes?

;hl = byte count minus 256 (which is the size of the 1st sector)

	lxi	d,-FULSIZ	;all other sectors are this big

PAD0:	mov	a,h		;exact sector end?
	ora	l
	jz	PAD2		;y: no padding needed

	dad	d		;subtract FULSIZ
	jc	PAD0		;..until borrow

	lxi	d,FULSIZ	;undo the last one
	dad	d		;..to compute remainder

	dcr	h		;compensate for upcoming inr h

;hl = the remainder in the last sector of the block, minus 256

PAD1:	inr	h		;de=remainder now. >=256?
	jnz	PAD2		;y: no padding necessary

	lxi	d,MINSEC
	mov	a,l		;l=last sector byte count

	sub	e		;must we pad?	
	jnc	PAD2		;n: the remainder is > MINSEC

;de = padding factor, which is not 0

	pop	h		;hl=byte count from header
	dad	d		;add the padding
	push	h		;padded byte count onto stack	
PAD2:

;------------------------------------------
;Find the same block header, with sector=c
;-----------------------------------------
	mvi	a,1		;now reading a header
	sta	RHFLAG

	call	HNTBLK		;find this block header again

;--------------------------------
;Immediately write the block data
;--------------------------------
	pop	d		;de=padded block byte count

	pop	b		;b=write block data command		
				;c=physical sector number

	pop	h		;hl=block data address

	call	HELIOS		;(17+75)Write the block
	jnz	FDWERR		;errors?

	call	W2RDEL		;write-read turnaround delay

	pop	d		;unpadded block byte count

;----------------------------------------
;Verify write, if write-verify is enabled
;  c = block number
;  de = unpadded block byte count
;  hl = write-data address
;  RHFLAG = 1
;----------------------------------------
	lda	VMODE
	ora	a		;verify?
	rz			;n: done

	push	h		;write-data address
	push	d		;byte count

	call	HNTBLK		;find block c yet again
	pop	d		;byte count
	push	d

	mvi	b,HRDATA	;read command
	lxi	h,JNKBUF	;verify buffer
	call	HELIOS		;read-back block data
	jnz	VERERR		;any errors?

;Compare read-back block to written block, fail on
;any mismatches

	pop	b		;byte count
	pop	h		;source data address
	lxi	d,JNKBUF	;verify data is here

VERLUP:	ldax	d
	cmp	m
	jnz	VERERR		;verify fail
	inx	h
	inx	d
	dcx	b
	mov	a,b
	ora	c
	jnz	VERLUP

	ret			;verify success

;***Subroutine********************************************
;Hunt for block header based on block header info
;  Verify track number in headers, and abort if ever wrong
;  If reading, return when specified header is read
;  If writing, return when prior header is read
;  Account for interleaved sectors on directory track
;  spin for up to 3 revs, looking for the right header
;On Entry:
;  c = physical sector number for desired block
;  RHFLAG = 0 for writing, 1 for reading
;On Exit:
;  If preparing to write a header, then the  next header
;    will be the one we want
;  If reading a header, the header is in HDRBUF
;trashes psw,b,de,hl
;*********************************************************
HNTBLK:	call	UNINTV		;get a=physical sector number

	sta	CURBLK		;save for error reporting

	mov	c,a		;c=desired physical sector

;If we are planning to write sector 0's header, then just
;wait for the index mark

	lda	RHFLAG		;planning to write?
	ora	c		;..and write sector 0's header?
	jz	WINDEX		;y: just wait for index

;Loop to hunt for the desired sector header

	mvi	b,3*MAXSEC+1	;max hunts (3 full revs)
	lxi	h,HDRBUF	;put headers in this buffer

HBLOOP:	push	b		;b=header count-down,
				;c=target physical sector
	mvi	b,0		;tell RHEADN to read just 1
	call	RHEADN		;read the next header

;If we got an error reading a header, then just keep looking
;for the sector we want, until we have tried too many times.
;Put error codes in e in case we have tried too many times.

	mov	e,a		;remember error codes
	mvi	a,10h		;fail HBTEST
	jnz	HBTEST		;error abort

	mov	e,a		;potential block-not-found error

;Un-interleave the logical sector number from the header

	mov	c,m		;sector number from header
	call	UNINTV
	mov	b,a		;b=physical sector number

;Reading or writing a header?

	lda	RHFLAG		;writing or reading header?
	ora	a

	mov	a,b		;phys. sector from header
	jnz	HBTEST		;reading: find this header

;Writing a header: return when the *next* header will be the
;one we want. Compute the physical sector number for the next
;header, which equals this header's physical sector number plus
;the number of sectors in this block. (Blocks never wrap around
;sector 0.)

	lda	HBSCNT		;sectors/block from header
	ani	7Fh		;strip protection bit

	add	b		;b=physical sector number
				;a=next physical sector number

HBTEST:	pop	b

; Reading: a = this sector's physical sector number
; Writing: a = the next sector's physical sector number
; Both:    b = count-doun of header reads
; Both:    c = desired physical sector
; both:    e = error code in case b counts down to 0

	cmp	c		;Found the header we want?
	rz			;y: done hunting

	dcr	b		;enough hunting?
	jnz	HBLOOP		;n: look again

;-----------------------------------------
;Error: header not found
;  e = error codes
;  CURBLK is the block we were looking for
;  CURTRK is the current track
;-----------------------------------------
	mov	a,e		;error codes
	jmp	FHRERR

;***Subroutine**************************************
;Write block header based on rotational position
;(Use rotation position after raw format, to install
;headers with correct track & sector numbers.)
;This assumes the blocks on this track are still
;all only 1 sector long.
;On Entry:
;  c = block number
;  hl = source address
;On Exit:
;  Z set if no errors
;  Z clear and a=error bits otherwise
;  Carry set if error was during header read
;Trashes a,bc,de,JNKBUF
;***************************************************
FHWRIT:	mov	a,c		;remember block number
	sta	CURBLK		;..for error reporting

	call	WINDEX		;wait for index
	stc
	rnz			;error waiting for index?

;Spin to the block before the requested block,
;unless we are looking for block 0.

	dcr	c		;look for one before

	jm	HWRITE		;looking for block 0?

	push	h		;remember source address
	lxi	h,JNKBUF	;header data to junk buffer
	mov	b,c		;b counts blocks
	call	RHEADN		;find and read block header b
	pop	h		;data source

	ani	47h		;timeout or abort errors?
	mov	b,a		;save errors

	call	WTSRDY		;wait for SREADY
	ora	b		;combine errors
	stc			;signal read error
	rnz			;SREADY timeout?

;Fall into HWRITE

;***Subroutine**********************************
;Issue a write header command for the next block
;On Entry:
;  hl = source address
;On Exit:
;  Z set if no errors
;  Z clear and a=error bits otherwise
;  Carry set if error was during header read
;Trashes a,bc,de
;***********************************************
HWRITE:	mvi	b,HWHDR		;write header command
	lxi	d,HELEN		;bytes/header

	call	HELIOS		;write next block header
	rnz			;errors?

	call	WTSRDY		;wait for controller ready
	rnz			;timeout waiting for SREADY?

;Fall into W2RDEL for normal exit

;***Subroutine********************************************
;Write-to-Read turn-around delay (about 56 mS)
;The R/W head is saturated for max 1 sector time (10.4 mS)
;after writing. Attempting to read while the head is
;saturated may result in aborts. (See page 7-50.) However,
;PTDOS waits about 1/3 rev time (55 mS).
;  a = de = 0
;  Z set
;*********************************************************
W2RDEL:	lxi	d,5000

W2RLUP:	dcx	d		;(5)
	mov	a,d		;(5)
	ora	e		;(4)
	jnz	W2RLUP		;(10)

	ret

;***Subroutine************************************************
;Issue Helios Transfer Command and wait for it to complete, or
;timeout if it does not complete within 1 disk rev time
;On Entry:
;  b=transfer command
;  de=transfer byte count
;  hl=transfer memory address
;  unit is selected already
;  head is loaded and settled
;  head is on desired track and  just before the right location
;On Normal Exit:
;  Z set
;  Carry clear
;  a=0
;  b=0 if no index pulses were seen
;  b=80h if an index pulse was seen
;On Error Exit:
;  Z clear
;  Carry clear
;  a = 01 timeout waiting for data
;      02 timeout waiting for SREADY
;      04 Helios abort (HSABRT)
;      08 CRC error (HSCRCE)
; 
;85 cycles max from CRC complete through return 
;75 cycles from entry until transfer command issued  
;trashes de
;*************************************************************
HELIOS:	mov	a,l		;(5)transfer address
	out	HETAL		;(10)also clears status
	mov	a,h		;(5)
	out	HETAH		;(10)

	mov	a,e		;(5)transfer length
	out	HETLL		;(10)
	mov	a,d		;(5)
	out	HETLH		;(10)

	mov	a,b		;(5)issue transfer command
	out	HETCMD		;(10)this kicks off the transfer

;Wait for transfer to complete, with timeout, index check
;81 cycles = 40 uS per pass
;One revolution = 166,667 uS
;1 rev timeout: (166,667/38.5) = 4166

	lxi	d,1100h		;>1 disk rev's time timeout
	mov	b,e		;b=0:no index pulses so far

HWLOOP:	dcx	d		;(5)timeout?
	mov	a,d		;(5)
	ora	e		;(4)
	jz	HABORT		;(10)y: Disk transfer timeout

	in	HESTAT		;(10)check for index pulse
	cma			;(4)so 1 means present
	ani	HSIDXN		;(7)
	ora	b		;(4)remember if we ever saw one
	mov	b,a		;(5)

	in	HESTAT		;(10)controller status
	ani	HTXDON		;(7)Ready, tx complete,
				;..abort or CRC error
	jz	HWLOOP		;(10)wait for *something*

	ani	HSABRT+HSCRCE	;(7)CRC error or abort?
	rz			;(10)done if no error

	dcr	a		;compensate for upcoming inr a
	jmp	HABORT		;abort the command

;***Subroutine*************************
;Wait for SREADY, with timeout
;On exit if SREADY detected:
;  a=0
;  Z set
;  head-load timer has been reset
;On exit if timeout waiting for SREADY:
;  a=2
;  Z and carry cleared
;  command is aborted
;trashes de
;**************************************
WTSRDY:	lxi	d,800		;about 20 mS timeout

WTSRD1:	in	HESTAT		;(10)also resets head-load timer
	cma			;(4)so 0 means true
	ani	HSSRDY		;(7)
	rz			;(5)Z set if SREADY detected

	dcx	d		;(5)timeout?
	mov	a,d		;(5)
	ora	e		;(4)
	jnz	WTSRD1		;(10)n: keep waiting

	inr	a		;clear Z, a=1
	
;Fall into HABORT

;***Subroutine Exit***************************
;Timeout error
;On Entry:
;  a=0 for disk transfer timeout
;  a=1 for timeout waiting for SREADY
;  a=error code minus 1 for CRC error or abort
;On Exit:
;  Helios command has been cancelled
;  a = 01 disk transfer timeout
;      02 timeout waiting for SREADY
;      04 Helios abort (HSABRT)
;      08 CRC error (HSCRCE)
;  Z cleared
;*********************************************
HABORT:	inr	a		;a=1, Z cleared
	push	psw		;save error code, Z flag
	mvi	a,HTNONE
	out	HETCMD		;this cancels the transfer
	pop	psw		;error code & Z flag for return
	ret

;***Subroutine****************************************
;Select destination disk and restore it to track 0
;On Entry:
;  DSTDSK=destination disk number
;On Exit:
;  CURTRK=0
;  Destination disk is selected and its head is loaded
;  Rude exit if timeout
;Trashes psw,bc,hl
;*****************************************************
RESTOR:	call	DSTSEL		;get the dest disk select bits
	mov	b,a		;remember for end
	ani	HDRSTN		;make it a restore command
	out	HEDCMD		;To Helios

	lxi	h,0		;about 2.5 seconds

RESTLP:	inx	h		;(5)bump timer
	mov	a,h		;(5)
	ora	l		;(4)timeout?
	jz	RESTTO		;(10)y:abort

	mov	a,b		;(5)delay

	in	HESTAT		;(11)wait for seek complete
	ani	HSSKCN		;(7)active low: Z set when there

	sta	CURTRK		;(13)will be on track 0 when done
				;..(here for delay)

	mov	a,b		;(5)prepare to end restore
				;..(here for delay)
	jnz	RESTLP		;(10)

	out	HEDCMD		;actually end the restore pulse
	ret

;***Subroutine***********************************************
;Seek target track & wait for seek to complete, with timeout.
;This routine assumes the unit is the destination unit.
;On Entry
;  b=target track
;  CURTRK=current track
;  DSTDSK=destintion unit number
;On Exit:
;  Destination disk is selected and its head is loaded
;  CURTRK=new current track
;  Trashes psw,c,de,hl
;Rude exit with message if timeout
;************************************************************
SEEK:	call	DSTSEL		;get the select bits
	ani	HDSTPN and HDSIN ;make it a step-in command
	mov	e,a

	mov	a,b		;target track
	lxi	h,CURTRK	;current track
	sub	m		;compute number of of steps
				;..positive means step in
	rz			;already on track?

	mov	c,a		;signed number of steps
	mov	m,b		;update CURTRK, assume success

;a=signed number of steps
;carry set if negative (meaning step out)
;Adjust the direction of the seek command in c, and compute
;the absolute value of the number of steps required.

	jnc	SKSTP0		;direction?

	cma			;..and make a positive
	inr	a		;..complement and add 1
	mov	c,a		;c=absolute value step count

	mov	a,e		;step-in command
	ori	HDSIN xor 0FFh	;make it step-out instead
	mov	e,a

SKSTP0:	mvi	d,100		;de=1/2 second timeout

;Step in or out the requested number of times, not waiting for
;The seek to complete between steps. Step time is about 13 uS.
;  c=number of steps
;  de = timeout value
;  e=directional step command

	mov	a,e		;a=step command & select bits

VSEEK1:	out	HEDCMD		;(10+1)issue seek command
	dcr	c		;(5) send as many as required
	jnz	VSEEK1		;(10)

;Now, wait until seek complete or timeout, 47 cycles/pass

VSEEK2:	in	HESTAT		;(10+1)drive status
	ani	HSSKCN		;(7)0=seek complete
	rz			;(5)

	dcx	d		;(5)bump timer
	mov	a,d		;(5)
	ora	e		;(4)timeout?
	jnz	VSEEK2		;(10)

;Seek timeout: print message and then abort

	jmp	REPTTO		;finish reporting error

;***Subroutine***********************************
;Compute select value for the destination disk
;On Entry:
;  DSTDSK=disk <0:7>
;On Exit:
;  a=HEDCMD value with drive delect, disk select,
;    and head-load bits set correctly
;************************************************
DSTSEL:	lda	DSTDSK

;Fall into DSKSEL

;***Subroutine*******************************************
;Compute HEDCMD (select) value for the specified Unit
;(Page 7-5)
;On Entry:
;  a=unit (0-7) (Bit 0 is the odd/even disk bit)
;On Exit:
;  a=HEDCMD value:
;    Bits <1:0> = 11b
;    Bits <3:2> are the drive select value, active low
;    Bit <4> = 1b
;    Bit <5> is head-load 0 (even), active low
;    Bit <6> is head-load 1 (odd), active low
;    Bit <7> is low for odd (right) disk within the drive
;Trashes b,c
;********************************************************
DSKSEL:	push	b

	mov	c,a		;temp save unit

	ani	1		;lsb is left/right
	rrc			;head select bit to <7>
	mov	b,a		;b=0/80h for even/odd unit

	mov	a,c		;unit
	ani	06h		;drive select bits
	rlc			;drive select bits to <3:2>
	ora	b		;combine with left/right in bit 7
	cma			;all are active low
	mov	c,a		;drive select and disk select

	mvi	a,HDHL0N	;active-low even-disk head load
	dcr	b		;b=FF/7F for even/odd
				;(minus if even)
	jm	SELCT1
	rlc			;active-low HDHL1N for odd disk
SELCT1:	ana	c		;a=drive select, disk select
				;..and correct head load
	pop	b
	ret

;***Subroutine*******************************
;Restore file type and protection attributes
;On Entry:
;  de points to 0-terminated file name string
;     which may include unit number
;  PAFLAG = 2 if file protection
;           attributes must be restored
;  PASAVE = original protection attributes
;  FTFLAG = 2 if file type must be restored
;  FTSAVE = original file type
;On Exit:
;  PAFLAG = 0
;  FTFLAG = 0
;Rude abort if PTDOS error
;trashes psw,hl
;********************************************
TARSTR:	lhld	FTFLAG		;l=flag, h=original value		
	mov	a,l
	cpi	2		;was the file type changed?
	cz	CHNGFT		;y: put it back

	xra	a
	sta	FTFLAG

	lhld	PAFLAG		;l=flag, h=original value
	mov	a,l
	cpi	2		;were attributes changed?
	cz	CHNGPA		;y: put them back

	xra	a
	sta	PAFLAG

	ret

;***Subroutine*********************************
;Change protection attributes on a file
;On Entry:
;  de points to 0-terminated file name string
;  h = protection attributes
;trashes psw
;**********************************************
CHNGPA:	call	SYS
	db	CHAOP		;change prot. attributes
	call	FIXERR		;error-return point

	ret			;successful exit

;***Subroutine*******************************
;Change file type on a file
;On Entry:
;  de points to 0-terminated file name string
;  h = file type
;trashes psw
;********************************************
CHNGFT:	call	SYS
	db	CHTOP		;change file type
	call	FIXERR		;error-return point

	ret			;successful exit

;***Subroutine*********************************************
;Compute logical (interleaved) block only if on index track
;(See FRONE routine in DISKCOPY.)
;Interleave:
; 0,8,1,9,2,10,3,11,4,12,5,13,6,14,7,15
;On Entry:
;  c=physical sector number
;  CURTRK=current track number
;On Exit:
;  a=logical block number
;**********************************************************
INTRLV:	lda	CURTRK
	cpi	DIRDT		;directory track?
	mov	a,c
	rnz			;n: logical=physical

	rar			;interleave
	rnc
	ori	08h
	ret

;***Subroutine**************************************************
;Compute physical (non-interleaved) block only if on index track
;(See FRONE routine in DISKCOPY.)
;Interleave:
; 0,8,1,9,2,10,3,11,4,12,5,13,6,14,7,15
;On Entry:
;  c=logical sector number
;  CURTRK=current track number
;On Exit:
;  a=physical block number
;***************************************************************
UNINTV:	lda	CURTRK
	cpi	DIRDT		;directory track?
	mov	a,c
	rnz			;n: logical=physical

	ral
	cpi	16
	rc

	sui	15
	ret	

;***Subroutine*****************************
;Copy block
;On Entry:
;  bc = byte count
;  de = destination address
;  hl = source address
;On Exit:
;  a=bc = 0
;  hl and de have been incremented bc times
;******************************************
LDIR:	mov	a,m
	stax	d
	inx	d
	inx	h
	dcx	b
	mov	a,b
	ora	c
	jnz	LDIR

	ret

;***Subroutine***********************************
;Increment b, Back up on the console, and display
;b in decimal, with user abort opportunity
;On Entry:
;  b=value to display
;  DELCNT = chr count of previous value printed
;   (0 means delete 1 chr)
;On Exit:
;  b = b+1
;  DELCNT = chr count of the number just printed
;Rude exit on user abort
;trashes psw
;************************************************
IDISPB: inr	b

	push	h
	push	d
	push	b

DBLUP1:	call	DELM		;deletes DELCNT+1
				;returns hl=DELCNT

	mov	a,b		;number to print
	call	PADEC		;returns b=digit count
				;trashes c,de

	mov	m,b		;DELCNT=new file count length

	pop	b
	pop	d
	pop	h

	call	ILPRNT		;beauty space
	db	' '+80h

;Fall into CHKABT for user abort opportunity

;***Subroutine********************************
;Check for user abort
;On Exit:
;  a = chr received, if any, with MSB stripped
;*********************************************
CHKABT:	call	CONTST
	rz

	call	CONIN		;what did the user type
	ani	7Fh		;strip parity, test for MODE
	rnz			;n:ignore if not MODE

	jmp	ABEXIT

;===Subroutine=============================
;Delete (hl) characters
;On Entry 
;  DELCNT = the number of chrs to delete -1
;On Exit:
;  DELCNT = 0FFh
;  HL = DELCNT
;==========================================
DELM:	lxi	h,DELCNT

DELMLP:	call	ILPRNT
	db	SOLDEL+80h
	dcr	m
	jp	DELMLP

	ret

;===Subroutine==========
;Print a as 2 hex digits
;On Entry
;  a = value to print
;Trashes psw,b
;=======================
PAHEX:	push	psw		;save digit
	rrc			;hi nibble 1st
	rrc
	rrc
	rrc
	call	PHXNIB
	pop	psw		;recover low nibble

;Fall into PHXNIB

;===Subroutine=========
;Print one hex nibble
;On Entry:
;  Nibble in low 4 of a
;Trashes psw,b
;======================
PHXNIB:	ani	0Fh		;get low
	cpi	0Ah		;A-F?
	jc	PASCII		;(trashes b)
	adi	'A'-'9'-1
	jmp	PASCII		;(trashes b)

;***Subroutine******************
;Print destination disk as ASCII
;Trashes psw
;*******************************
PDEST:	lda	DSTDSK

;Fall into PASCII

;***Subroutine***
;Print a as ASCII
;Trashes psw
;****************
PASCII:	push	b
	adi	'0'
	call	CONOUT	;trashes b
	pop	b
	ret

;***Subroutine*****
;Print a in decimal
;On Exit:
;  b=digit count
;Trashes psw,c,de
;******************
PADEC:	lxi	b,100		;c=divisor,b=no leading zeros
	call	PDDIG		;print high digit

	mov	a,e		;remainder becomes dividend
	mvi	c,10		;middle digit divisor
	call	PDDIG


	mov	a,e		;remainder is lsb
	jmp	PDIG0		;print lsb always

;---Local subroutine--------------
;Compute and print decimal digit
;On Entry:
;  a=divisor
;  b=0 means don't print leading 0
;  c=dividend
;On Exit:
; b incremented if digit printed
;  e=remainder
;---------------------------------
PDDIG:	mvi	d,0FFh		;accumulate dividend

PDDLUP:	inr	d		;this loop goes once too many
	sub	c
	jnc	PDDLUP

	add	c		;compute a=remainder
	mov	e,a		;remainder for return

	mov	a,d		;dividend
	ora	b		;leading 0?
	rz			;y: done

	mov	a,d		;dividend	

PDIG0:	inr	b		;bump digit count
	jmp	PASCII		;print & return

;***Subroutine*************************************
;Print CR, LF, then inline string
;The call to ILPRNT is followed by an ASCII string.
;The last string byte has its msb set.
;Note: PTDOS adds a LF after a CR
;All registers preserved
;**************************************************
CILPRT:	call	ILPRNT
	db	CR+80h

;Fall into ILPRNT

;***Subroutine*************************************
;Print inline string
;The call to ILPRNT is followed by an ASCII string.
;The last string byte has its msb set.
;All registers preserved
;**************************************************
ILPRNT:	xthl			;Save hl, get msg addr
	push	b
	push	psw

IPLOOP:	mov	a,m
	ani	7Fh		;strip end marker
	call	CONOUT		;print byte (trashes b)
	mov	a,m		;end?
	inx	h		;Next byte
	ora	a		;msb set?
	jp	IPLOOP		;Do all bytes of msg

	pop	psw
	pop	b
	xthl			;Restore hl,
				;..get return address
	ret

;***Subroutine***************************
;Print 0-terminated string
;On Entry:
;  de points to 0-terminated string
;On Exit:
;  a = 0
;  c = number of chrs printed+2
;  de points to chr after null terminator
;trashes psw,b
;****************************************
PRINTF:	mvi	c,2

PFLOOP:	ldax	d
	inx	d
	ora	a
	rz

	inr	c
	call	CONOUT		;trashes b
	jmp	PFLOOP

;***Exit*******************
;Normal exit for L=0 option
;**************************
L0EXIT:

;Install correct BOOTLOAD protection attributes
;on dummy BOOTLOAD file

	lxi	d,BLNAME	;BOOTLOAD name
	call	SELDU		;on unit DSTDSK

	mvi	h,BLFPA
	call	CHNGPA

;Delete dummy RESIDENT file

	lxi	d,RESNAM	;RESIDENT name
	call	SELDU		;..on unit DSTDSK

	call	SYS
	db	KILOP		;(page 7-11)
	call	PTDER		;error-return point

;Fall into NEXIT

;***Exit****
;Normal exit 
;***********
NEXIT:	call	CILPRT
	db	'Format complet','e'+80h

;Fall into REXIT

;***Exit******************************************
;Reboot PTDOS from disk 0
;*************************************************
REXIT:	MVI	A,HTNONE	;end any previous command
	OUT	HETCMD		;..in case of an abort

	xra	a		;select disk 0 in RESTOR
	sta	DSTDSK

	inr	a		;a=1
	sta	RHFLAG		;reading mode for HNTBLK

	mvi	c,RTRIES

;-------------------------------------------------
;Ask user to put PTDOS disk back, and reboot PTDOS
;(Disk 0 is already selected and restored)
;-------------------------------------------------
EXTAGN:	call	CILPRT
	db	'Insert PTDOS disk in Unit 0. Ready?',' '+80h
	call	ASKYN
	jnz	EXTAGN

;Cold-boot PTDOS

BORTRY:	push	b		;c=retry counter

	call	RESTOR		;restore to track 0, actually select

	mvi	c,0
	call	HNTBLK		;find block 0

	lhld	HBBCNT		;found block size
	xchg			;..to de

	mvi	b,HRDATA	;read command
	lxi	h,BOTADR	;load address

; b=read block command
; de=transfer byte count
; hl=transfer memory address
; unit is selected already
; head is loaded and settled
; head is on desired track and just before the right location

	call	HELIOS		;read the disk block
	pop	b		;c=retries
	jnz	BOTERR		;can't boot?

	jmp	BOTADR		;success: execute loaded code

BOTERR:	dcr	c		;retry failed boot if not too many
	jnz	BORTRY

	call	CILPRT
	db	'Boot Erro','r'+80h
	jmp	EXTAGN

;***Error Exit*****************************
;Error hunting for Index during track erase
;******************************************
TERERR:	call	CILPRT
	db	'Eras','e'+80h

	jmp	FMTERR		;explain error bits in a

;***Error Exit********
;Write verify mismatch
;*********************
VERERR:	call	CILPRT
	db	'Write-verif','y'+80h
	xra	a		;no error bits
	jmp	FMTERR

;***Error Exit***********
;Error during header read
;On Entry:
;  a=error code
;************************
FHRERR:	call	CILPRT
	db	'Header rea','d'+80h
	jmp	FMTERR

;***Error Exit************
;Error during header write
;On Entry:
;  a=error code
;*************************
FHWERR:	call	CILPRT
	db	'Heade','r'+80h

	jmp	FHDWER

;***Error Exit************
;Error writing format data
;On Entry:
;  a=error code
;*************************
FDWERR:	call	CILPRT
	db	'Dat','a'+80h

;Fall into FHDWER

;***Error Exit**********************
;Error writing format data or header
;On Entry:
;  a=error code
;***********************************
FHDWER:	call	ILPRNT
	db	' writ','e'+80h

;Fall into FMTERR

;***Error Exit********************************
;Error during format phase. End any command,
;announce disk position, explain errors, abort
;On Entry:
;  a = error code
;*********************************************
FMTERR:	push	psw		;save error codes

	mvi	a,HTNONE
	out	HETCMD		;end the failed command

	call	ILPRNT
	db	' error, unit',' '+80h

	call	PDEST		;print dest disk in ASCII

	call	ILPRNT
 	db	', track',' '+80h

	lda	CURTRK		;track number
	call	PADEC

	call	ILPRNT
	db	', sector',' '+80h

	lda	CURBLK		;block number
	call	PADEC

	pop	psw		;error codes

;Fall into EXPERR to explain error bits in a

;***Error Exit***************************
;Explain error during data transfer
;On Entry:
;  a<0> = 1 if timeout waiting for data
;  a<1> - 1 if timeout waiting for SREADY
;  a<2> = 1 if controller abort
;  a<3> = 1 if CRC error
;  a<4> = 1 if block not found
;  a<5> = 1 for track mismatch
;  a<6> = 1 for index timeout
;  a<7> = 1 for unexpected index pulse
;****************************************
EXPERR:	call	CILPRT
	db	'Error code:',' '+80h

	call	PAHEX
	jmp	ABEXIT		;abort

;***Error Exit***************
;BOOTLOAD file is too corrupt
;****************************
BADBOT:	lxi	d,BLMSG		;'BOOTLOAD',0

;Fall into CBRERR

;***Error Exit*******************
;file is too corrupt to reinstall
;On Entry: de points to string
;********************************
CBRERR:	call	ILPRNT
	db	CR+80h

	call	PRINTF

	call	ILPRNT
	db	' can',QUOTE,'t be repaire','d'+80h

	jmp	ABEXIT

;***Error Exit*******************************
;Report restore timeout.
;End the restore pulse, print timeout message
;and abort to PTDOS
;On Entry:
;   a=end-restore command
;********************************************
RESTTO:	out	HEDCMD

;Fall into REPTTO to report the error

;***Error Exit***************************
;Report seek timeout.
;Print timeout message and abort to PTDOS
;****************************************
REPTTO:	call	ILPRNT
	db	'Disk timeou','t'+80h
	jmp	ABEXIT

;***Error Exit***********************************************
;Put source disk back together, explain errors, exit to PTDOS
;On Entry:
;  a = error code
;  de = address of file name string
;  top of stack = address of routine that generated the error
;  PAFLAG = 2 means the source file protection attributes
;             have been changed
;  FTFLAG = 2 means the source file type has been changed
;  PASAVE = original protection attributes
;  FTSAVE = original file type
;************************************************************
FIXERR:	push	psw		;save error code

	push	d
	call	CILPRT
	db	'Error copying',' '+80h
	call	PRINTF		;print file name at de
	pop	d

	lxi	h,TARFLG	;been here before?
	dcr	m
	cnz	TARSTR		;restore file type & attributes

	lda	FTFLAG		;did we successfully restore
	lxi	h,PAFLAG	;..the attributes and file
	ora	m		;..name on the source disk?
	jz	FERR1

	call	CILPRT		;n: say so
	db	'Disk',' '+80h
	lda	SRCDSK
	call	PASCII
	call	ILPRNT
	db	' may be corrupt','!'+80h
FERR1:

;Recover error code from entry, and let PTDOS explain it

	pop	psw		;recover error code

;Fall into PTDER

;***Error Exit***********************************************
;Get PTDOS to explain a SYS error, close the open file,
;and reboot PTDOS
;(Pages 6-8 and 8-1)
;On Entry:
;  a = error code
;  top of stack = address of routine that generated the error
;  4 bytes before this is the system opcode
;************************************************************
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,FMTMSG	;string for '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:	call	CLOSAL		;close all open files

;Fall into ABEXIT

;***Error Exit****
;Error exit 
;*****************
ABEXIT:	call	CILPRT
	db	'Abor','t'+80h

	jmp	REXIT		;fix SYSGLO and return

;***Subroutine*********************************************
;Get Y/N answer from user, echoing, and allowing characters
;to be deleted until CR is typed. (See page 9-8) Note that
;CONIN strips the parity bit, but the MODE key is 80h.
;On Exit:
;  a='N' and Z set if 'Y'
;  a='Y' and Z clear if 'N'
;Trashes hl
;**********************************************************
ASKYN:	push	b

ASKYN1:	call	ILPRNT		;trashes b
	db	' (Y/N)?',' '+80h

ASKYN2:	lxi	h,0FFh		;h=1st chr, l=chr count-1

ASKYN3:	inr	l		;character count

	mov	c,h		;previous chr
	call	CONIN		;get chr
	ani	('a'-'A')xor 0FFh ;uppercase
				  ;also converts DEL to SOLDEL

	mov	h,a		;this chr
	cpi	SOLDEL
	jnz	ASKYN4

	dcr	l		;backup
	jm	ASKYN2		;unless we can't

	dcr	l		;account for inr e
	
ASKYN4:	call	CONOUT		;echo, trashes b

	cpi	CR
	jnz	ASKYN3

	dcr	l		;1 chr +CR?

	jnz	ASKYN1

	mov	a,c

	pop	b
	cpi	'Y'
	rz			;Z set for Yes

	cpi	'N'
	jnz	ASKYN

	ora	a		;clear Z for No
	ret

;***File Image*******************************
;Next ID File. This is SUTIL's ID, which will
;be copied onto the destination disk first.
;********************************************
NIFILE:	dw	IDSUT		;Initialized next File ID

;***File Image***************
;Embryonic Directory, Block 0
;****************************
D0FILE:	db	(D0END-D0FILE-2)/21 ;Number of directory entries
	db	D0END-D0FILE	;Next Entry Displacement

	db	'DIRECTRY'	;8-byte name
	db	DIRTYP		;Type
	dw	DIRBBC		;Block Size
	db	DIRFPA		;File Protection attributes
	dw	IDDIR		;ID
	dw	DRNDX		;Index File Pointer
	db	DIRDS		;First block Sector
	db	DIRDT		;First block Track
	dw	DIRCNT		;Block count
	db	'P'		;Spare (Spells PTCOR)

NINAME:	db	'NEXTID',0,0	;8-byte name
	db	NIDTYP		;Type
	dw	NIDBBC		;Block Size
	db	NIDFPA		;File Protection attributes
	dw	IDNID		;ID
	dw	NINDX		;Index File Pointer
	db	DANIS		;First block Sector
	db	DANIT		;First block Track
	dw	NIDCNT		;Block count
	db	'T'		;Spare (Spells PTCOR)

	db	'FSMAP',0,0,0	;8-byte name
	db	FSMTYP		;Type
	dw	FSMBBC		;Block Size
	db	FSMFPA		;File Protection attributes
	dw	IDFSM		;ID
	dw	FSNDX		;Index File Pointer
	db	DAFSS		;First block Sector
	db	DAFST		;First block Track
	dw	FSMCNT		;Block count
	db	'C'		;Spare (Spells PTCOR)

BLNAME:	db	'BOOTLOAD'	;8-byte name
	db	BLTYP		;Type
	dw	BLBBC		;Block Size
	db	PALO		;File Protection attributes
				;initially just disk allocation
	dw	IDBOT		;ID
	dw	BLNDX		;Index File Pointer
	db	DABOS		;First block Sector
	db	DABOT		;First block Track
	dw	BLCNT		;Block count
	db	'O'		;Spare (Spells PTCOR)

SGANAM:	db	'SYSGLOBL'	;8-byte name
	db	SGATYP		;Type
	dw	SGABBC		;Block Size
	db	0		;no File Protection attr's yet
	dw	IDSPA		;ID
	dw	SGNDX		;Index File Pointer
	db	DASPS		;First block Sector
	db	DASPT		;First block Track
	dw	SGACNT		;Block count
	db	'R'		;Spare (Spells PTCOR)

RESNAM:	db	'RESIDENT'	;8-byte name
	db	RESTYP		;Type
	dw	RESBBC		;Block Size
	db	PALO		;File Protection attributes
				;initially just disk allocation
	dw	IDRES		;ID
	dw	RSNDX		;Index File Pointer
	db	DARSS1		;First block Sector
	db	DARST1		;First block Track
	dw	RESCNT		;Block count
	db	'P'		;Spare (Spells PTCORP)

	db	'START.UP'	;8-byte name
	db	STFTYP		;Type
	dw	STFBBC		;Block Size
	db	STFFPA		;File Protection attributes
	dw	IDSTF		;ID
	dw	STNDX		;Index File Pointer
	db	DASTS		;First block Sector
	db	DASTT		;First block Track
	dw	STFCNT		;Block count
	db	0		;Spare

D0END:				;End of Directory

;Fall into D1FILE to stuff message in unused directory space

;***File Image*******************
;Embryonic Directory, Blocks 1-15
;Follows D0file
;********************************
D1FILE:	db	0		;Number of Entries
	db	2		;Next Entry Displacemnt
	dw	0

;Fall into FMTDAT to stuff message in unused directory space

;***File Image***************************************
;Data for unused space on the disk
;This is what "DISKCOPY /1,S=F" writes.
;Follows D1FILE
;****************************************************
FMTDAT:	
 db '(C) 1978  Processor Technology Corp' ;35 bytes
 db CR				;2 bytes
 db 'This is a system created '		;25 bytes
BOOTGH:					;("BOOT" may go here)
 db 'DATA'				;4 bytes
 db ' DISK'				;5 bytes
 db CR				;2 bytes
 db 'All rights to code on this disk'	;31 bytes
 db ' which is provided by Processor'	;31 bytes
 db ' Technology Corp are reserved'	;29 bytes
 db ' by Processor Technology Corp.'	;30 bytes
					;(194 bytes to here)

;Overflow into SUFILE for my personal advertisement

;***File Image*****
;START.UP File
;Follows FMTDAT
;******************
STFILE:
 db '$PR ^M^JCreated by FORMAT vers. '
 db ((VERSION AND 0F00h)/256)+'0','.'
 db ((VERSION AND 0F0h)/16)+'0',(VERSION AND 0Fh) +'0'
 db ', by M. Eberhard'
 db CR

 db '$PR Disk Name: '
SUNAME:
 db '        ',CR
 db '$PR Edit START.UP to change this message.'
 db CR
 db 'SETIN #0'
 db CR,0

;START.UP file parameters (Needs to be after SUFILE to satify
;2-pass assembler.)

STFTYP	equ	BNTYP		;File type (binary)
IDSTF	equ	13h		;File ID (just before SUTIL)
STNDX	equ	0		;Index block (none)
DASTS	equ	0		;Sector
DASTT	equ	3		;Track
STFDBC	equ	$-STFILE	;START.UP file length
STFBBC	equ	STFDBC		;Block byte count
STFCNT	equ	1		;Blocks
STFBPB	equ	0		;Block Protection bit (msb)
STFSPB	equ	(STFBBC+179h)/140h ;Sectors/block
STFFPA	equ	PKIL+PNAT	;File protection attributes

;***Data Structure******************************************
;List of Descriptors for blocks to be loaded during Phase 2
;   Each entry is the address where the block data can be
;   found followed by a complete disk block header. These
;   are in disk order, to reduce seek time.
;***********************************************************
FILLST:

;Boot loader header

	dw	DUMYBF		;address of dummy bootload file

BLHDR:	db	DABOS		;Sector
	db	DABOT		;track
	dw	8000h+BLDBC	;Forward chain pointer
	dw	0FFFFh		;Backward chain pointer
	dw	IDBOT		;File ID
	db	BLSPB or BLBPB	;Sectors/Block, protection
	dw	BLBBC		;Block length, bytes
	dw	'PT'		;spare

;RESIDENT headers (PTDOS itself)

	dw	DUMYBF		;address of dummy resident file

REHDR1:	db	DARSS1		;1st Sector
	db	DARST1		;1st track
	db	DARSS2		;Forward chain pointer, sector
	db	DARST2		;Forward chain pointer, track
	dw	0FFFFh		;Backward chain pointer
	dw	IDRES		;File ID
	db	RESSPB or RESBPB ;Sectors/Block, protection
	dw	RESBBC		;Block length, bytes
	dw	0		;spare as found on PT disks

	dw	DUMYBF		;address of dummy resident file

REHDR2:	db	DARSS2		;2nd Sector
	db	DARST2		;2nd track
	dw	8000h+RESBBC	;Forward chain pointer
	db	DARSS1		;Backward chain pointer, sector
	db	DARST1		;Backward chain pointer, track
	dw	IDRES		;File ID
	db	RESSPB or RESBPB ;Sectors/Block, protection
	dw	RESBBC		;Block length, bytes
	dw	380h		;spare as found on PT disks

;System Global Area header

	dw	SGABUF		;prototype system global file

SHHDR:	db	DASPS		;Sector
	db	DASPT		;track
	dw	8000h+SGADBC	;Forward chain pointer
	dw	0FFFFh		;Backward chain pointer
	dw	IDSPA		;File ID
	db	SGASPB or SGABPB ;Sectors/Block, protection
	dw	SGABBC		;Block length, bytes
	db	'PT'		;spare a la PT

;START.UP file

	dw	STFILE		;address of START.UP file
	db	DASTS		;Sector
	db	DASTT		;Track
	dw	8000h+STFDBC	;Forward chain pointer
	dw	0FFFFh		;Backward chain pointer
	dw	IDSTF		;File ID
	db	STFSPB or STFBPB ;Sectors/Block, protection
	dw	STFBBC		;Block length, bytes
	db	'ME'		;spare

;Directory's first block header

	dw	D0FILE		;directory sector 0 file

	db	DIRDS		;Sector
	db	DIRDT		;track
	db	DIRDS+1		;Forward chain pointer sector
	db	DIRDT		;Forward chain pointer track
	dw	0FFFFh		;Backward chain pointer
	dw	IDDIR		;File ID
	db	DIRSPB or DIRBPB ;Sectors/Block, protection
	dw	DIRBBC		;Block length, bytes
	db	'PT'		;spare a la PT

;Next ID file header

	dw	NIFILE		;address of Next ID file

	db	DANIS		;Sector
	db	DANIT		;track
	dw	8000h+NIDDBC	;Forward chain pointer
	dw	0FFFFh		;Backward chain pointer
	dw	IDNID		;File ID
	db	NIDSPB or NIDBPB ;Sectors/Block, protection
	dw	NIDBBC		;Block length, bytes
	db	'PT'		;spare a la PT

	dw	0		;End of table marker

;------------------------------------------------------
;Empty directory block header
;This gets modified and written to 15 directory blocks.
;This must follow FILLST
;------------------------------------------------------
	dw	D1FILE		;directory sector 1-15 file

DFSECT:	db	1		;Sector (gets overwritten)
	db	DIRDT		;track
DFFORE:	db	2		;Forward chain pointer sector
	db	DIRDT		;Forward chain pointer track
DFBACK:	db	0		;Backward chain pointer sector
	db	DIRDT		;Backward chain pointer track
	dw	IDDIR		;File ID
	db	DIRSPB or DIRBPB ;Sectors/Block, protection
	dw	DIRBBC		;Block length, bytes
	db	'PT'		;spare a la PT

;-------------------------------------------------------
;Free Sector Map header (Must be written last because it
;gets updated as each of the other files gets written.)
;-------------------------------------------------------
FSMHDR:	db	DAFSS		;Sector
	db	DAFST		;track
	dw	8000h+FSMDBC	;Forward chain pointer
	dw	0FFFFh		;Backward chain pointer
	dw	IDFSM		;File ID
	db	FSMSPB or FSMBPB ;Sectors/Block, protection
	dw	FSMBBC		;Block length, bytes
	db	'PT'		;spare a la PT

;***Data Structure****************************************
;Level 1 (L=1)
;File list for installing just PTDOS itself
;(Absent files on the source disk will just not be loaded)
;RESIDENT and BOOTLOAD already exist (possibly as dummy
;files) on the the destination disk. For this reason, the
;copy routine skips the Create operation for the first 2
;files in this list. The order of these 3 matters.
;*********************************************************
FCOUNT1	equ	3		;number of level 1 files

SYSLST:
RESMSG:	db	'RESIDENT',0	;will overwrite dummy file
BLMSG:	db	'BOOTLOAD',0	;will overwrite dummy file
	db	'SUTIL',0	;Must be the 3rd file here

	db	0		;end of list

MAXSYS	equ	3		;Number of system files
				;..(won't optimize block
				;..size for these files)

;***Data Structure****************************************
;Level 2 (L=2)
;Additional files for a barely usable bootable disk
;(Absent files on the source disk will just not be loaded)
;*********************************************************
FCOUNT2	equ	16		;number of level 2 files

	db	'$PR',0
	db	'CONFIGR',0
	db	'COPY',0
	db	'DISKCOPY',0
	db	'FILES',0
	db	'FREE?',0
	db	'KILL',0
	db	'OUT',0
	db	'PRINT',0
	db	'REATR',0
	db	'RENAME',0
	db	'RETYPE',0
	db	'SET',0
	db	'SETIN',0
	db	'SETOUT',0
	db	'SYST',0

	db	0		;end of list

;***Data Structure****************************************
;Level 3 (L=3)
;Additional files for a reasonable bootable disk
;(Absent files on the source disk will just not be loaded)
;*********************************************************
FCOUNT3	equ	37		;number of level 3 files

	db	'$CREATE',0
	db	'$ESC',0
	db	'$LST',0
	db	'$NLST',0
	db	'$REM',0
	db	'$STOP',0
	db	'$WAIT',0
	db	'CLOSE',0
	db	'CREATE',0
	db	'DO',0
	db	'DCHECK',0
	db	'DUMP',0
	db	'EDIT',0
	db	'ENDF',0
	db	'EXEC',0
	db	'EXTRACT',0
	db	'GET',0
	db	'IMAGE',0
	db	'NULL',0
	db	'OPEN',0
	db	'OPEN?',0
	db	'RANDOM',0
	db	'READ',0
	db	'RECOVER',0
	db	'SAVE',0
	db	'SEEK',0
	db	'SPACE',0
	db	'WRITE',0
	db	'ZIP',0

	db	'ACOPY',0
FMTMSG:	db	'FORMAT',0	;String also used by PTDER
	db	'GETTAPE',0
	db	'HEX2IMG',0
	db	'RUNSOLOS',0
	db	'SERIAL',0
	db	'TXTMODEM',0
	db	'XMODEM',0

	db	0		;end of list

;***Data Structure****************************************
;Level 4 (L=4)
;Additional files for a decent bootable development disk
;(Absent files on the source disk will just not be loaded)
;*********************************************************
FCOUNT4	equ	12		;number of level 4 files

	db	'ASSM',0
	db	'BLDUTIL',0
	db	'DEBUG',0
	db	'EDT3',0
	db	'PTDEFS',0
	db	'RNUM',0
	db	'UNZAP',0
	db	'XREF',0
	db	'ZAP',0

	db	'HEXER',0
	db	'IMG2HEX',0
	db	'MAKETAPE',0

	db	0		;end of list

;***Data Structure****************************************
;Level 5 (L=5)
;Additional files for a fully-loaded bootable disk
;(Absent files on the source disk will just not be loaded)
;*********************************************************
FCOUNT5	equ	6		;number of level 5 files

	db	'DBASIC',0
	db	'FOCAL',0
	db	'HELP',0
	db	'HELP:D',0
	db	'TARGET',0
	db	'TREK80',0

	db	0		;end of list

FCDFLT	equ	FCOUNT1+FCOUNT2+FCOUNT3	;Must match LDEFLT...

;***Data Structure***************
;Block header buffer
;Initialized for the format phase
;********************************
HDRBUF:
HBSECT:	db	0	;sector
HBTRAC:	db	0	;Track
HBFCP:	dw	8000h	;Forward chain pointer (see page 5-4)
	dw	0FFFFh	;Backward chain pointer
HBFID:	dw	0	;file ID
HBSCNT:	db	1	;block length in sectors, no protect
HBBCNT:	dw	256	;block length in bytes
HRESRV:	db	'PT'	;reserved (This is what PT writes here)

;=========================
;= Initialized Variables =
;=========================
LMODE:	db	LDEFLT	;'L=' option from user
FILSEQ:	db	1	;File sequence number
PAFLAG:	db	0	;1: source attributes need to be changed
			;2: source attributes have been changed
PASAVE:	db	0	;Source file original prot. atr's
			;(must follow PAFLAG)
FTFLAG:	db	0	;1: source file type needs to be changed
			;2: source file type has been changed
FTSAVE:	db	0	;Source file original type
			;(must follow FTFLAG)
RIFLAG:	db	0	;Reinstall PTDOS flag
TARFLG:	db	2	;prevent infinite loops restoring source
DELIM:	db	','	;command line delimiter
DSTDSK:	db	80h	;destination drive (80h=uninitialized)
SRCDSK:	db	80h	;Source drive (80h=uninitialized)
			;SRCDSK must follow DSTDSK
CURTRK:	db	0	;Current track
CURBLK:	db	0	;Current/target block
VMODE:	db	0FFh	;Verify mode
FCOUNT:	db	FCDFLT	;total file count
DELCNT:	db	0	;Number of chrs to delete - 1 (0 means 1)
CUSTNM:	db	0	;NZ means user-supplied name in DDNAME

;*************************************
;Default data for the new SYSGLO image
;*************************************
DDDATE:	db	0,0,0
DDNAME:	db	'PTDOS1.x'	;must follow DDDATE
	db	'PTDOS',0,0,0	;8-character CONFIGR password
				;("PTDOS" is PTDOS's default)
DDNLEN	equ	$-DDDATE

;==================================================
;Initialization Code. This code gets overwritten by
;data once the command line parsing is complete.
;==================================================

;***Init Subroutine************************
;Initialization
;On Exit:
; The command line has been scanned and
;    all variables set accordingly
; The source disk is the PTDOS default disk
; SYSGLO parameters that we will change
;    have been saved and then changed
;******************************************
INIT:

;------------------------------------------------
;Test to see if PTDOS is locked, and abort if so.
;------------------------------------------------
	lhld	SYSGLO		;PTDOS's System Global area	
	lxi	d,GLLOK 	;Point to lock
	dad	d
	mov	a,m
	ora	a		;nz means locked

	mvi	a,ERLOK		;system write-locked error
	mvi	h,0FFh		;put 0FFh in place for PTDER
	cnz	PTDER		;let PTDOS explain error

;------------------------------------------------------
;Install the PTDOS system date as the default disk date
;------------------------------------------------------
	lhld	SYSGLO		;PTDOS's System Global area
	lxi	d,GLDAT		;System date
	dad	d		;hl=sourse

	lxi	b,3		;# of bytes for date
	lxi	d,DDDATE	;destination
	call	LDIR

;----------------------------------------------------
;Scan command line for options and set up accordingly
;----------------------------------------------------
SCNLUP:	lda	DELIM		;more options?
	cpi	','
	jnz	SCNDON

	lxi	d,SCNBUF
	push	d	
	mvi	a,PSOPT		;Scan one item
	call	PSCAN		;(page 6-10)
	jc	CMDERR		;error if too many characters

	sta	DELIM		;remember delimiter

	mov	a,c		;a=byte count
	ora	a		;another command line item?
	jnz	SCL0		;y: go look at it

	lda	DSTDSK		;no input?
	rlc			;msb means uninitialized
	jnc	SCNDON		;dest specified: scanning done

;Nothing on the line: print help screen

	call CILPRT

;    123456789012345678901234567890123456789012345678901234567890123
 db 'FORMAT Version '
 db ((VERSION AND 0F00h)/256)+'0','.'
 db ((VERSION AND 0F0h)/16)+'0',(VERSION AND 0Fh) +'0'
 db ' by M. Eberhard'
 db CR
 db 'FORMAT {{/}su,}{/}du{,L=<n>}{,S={R}{-V}}{,N=<name>}{,D=<date>}'
 db CR
 db 'Formats disk su using system parameters from RAM and system'
 db CR
 db 'files from disk su (which defaults to 0). (Use SET command set'
 db CR
 db 'system parameters prior to FORMAT.) su must not equal du.'
 db CR
 db ' L=0: Non-bootable data disk'
 db CR
 db ' L=1: Barely bootable disk, just PTDOS itself'
 db CR
 db ' L=2: Minimal bootable disk'
 db CR
 db ' L=3: Reasonable bootable disk (default)'
 db CR
 db ' L=4: Development disk (adds ASSM, DEBUG, etc.)'
 db CR
 db ' L=5: Complete disk (adds HELP, DBASIC, etc.)'
 db CR
 db ' S=R: Reinstall files on a disk without formatting'
 db CR
 db ' S=-V: Write-verify off'
 db CR
 db ' N=<name> names the disk'
 db CR
 db ' D=MM/DD/YY sets the disk',QUOTE,'s dat','e'+80h
 db CR
	call	SRESET		;Reset-Return to PTDOS


SCL0:	lxi	h,SCNLUP	;create return address
	xthl			;..for option subroutines
				;hl=SCNBUF

;Get source and destination drive numbers

	mov	a,m
	cpi	'/'		;optional slash?
	jnz	SCL1

	inx	h
	mov	a,m
	sui	'0'		;un-ASCII
	cpi	MAXDRV+1
	jnc	CMDERR		;slash only preceeds a drive

SCL1:	mov	a,m
	sui	'0'		;un-ASCII
	cpi	MAXDRV+1

	jnc	SCL3		;not a drive letter

;We have a drive. If we already got one drive number then
;that one was actually the source and this new one is the
;destination. Otherwise, assume this is the destination. If
;we've already set the source drive then it's an error.

	push	h
	lxi	h,DSTDSK

	mov	b,a		;new drive number in b
	mov	a,m		;already have a dest?
	ora	a		;msb means no
	jm	SCL2		;..this is probably the dest

				;this is the dest
				;the previous one was the source
	inx	h		;point to SRCDSK
	add	m		;SRCDSK was init'd to 80h
	jp	CMDERR		;too many drives spec'd?

	xra	m		;strip flag
	mov	m,a		;it was really the source
	dcx	h		;point to DSTDSK

SCL2:	mov	m,b		;remember destination
	pop	h
	ret			;to SCNLUP
SCL3:

;Unit(s) must be specified before any other options. A
;destination unit must be specified. The source will be
;Unit 0 if none is specified. hl points to DSTDSK here.

	mov	b,m		;b=option chr

	inx	h
	mov	a,m
	cpi	'='		;all options must have =
	jnz	CMDERR		;..otherwise error

	inx	h		;point past equal sign
	dcr	c
	dcr	c		;account for n=

	mov	a,b		;which option?

	cpi	'D'		;Set date option?
	jz	DOPTN

	cpi	'L'		;set format level option?
	jz	LOPTN

	cpi	'N'		;Set name option?
	jz	NOPTN

	cpi	'S'		;set option switch?
	jz	SOPTN

;Fall into CMDERR for bogus command

;***Init Error Exit****
;Bad command line input
;Just print help screen
;**********************
CMDERR:	call	CILPRT
	db	'Huh?',' '+80h

	lxi	d,SCNBUF	;print offending string
	call	PRINTF

	call SRESET

;-----------------------
;Validate unit selection
;-----------------------
SCNDON:	lxi	h,DSTDSK
	mov	a,m		;did a dest drive get specified?
	ora	a		;msb means no
	jm	CMDERR

	inx	h		;point to SRCDSK
	mov	a,m
	ani	7Fh		;in case no source was specified
	mov	m,a

	dcr	h		;source cannot be dest too
	cmp	m
	jnz	SCD1

	lda	LMODE		;no source for mode 0 (data disk)
	ora	a
	jnz	CMDERR
SCD1:

;--------------------------------------------
;COnfirm format or repair operation with user
;--------------------------------------------
	lda	RIFLAG		;repair PTDOS?
	ora	a
	lda	LMODE
	mov	c,a
	jz	CONFMT

	call	CILPRT
	db	'Reinstall',' '+80h

	ora	a		;a=LMODE
	jnz	CONF0

	call	ILPRNT
	db	'SYSGLOBL o','n'+80h
	jmp	CONF1

CONF0:	call	ILPRNT
	db	'PTDOS o','n'+80h

	jmp	CONF1

CONFMT:	call	CILPRT
	db	'Forma','t'+80h

CONF1:	call	ILPRNT
	db	' disk',' '+80h
	call	PDEST		;print ASCII dest drive number
				;(trashes b)

	mov	a,c		;c=LMODE
	ora	a
	jz	NOSYS		;system files too?

	call	ILPRNT
	db	' with disk',' '+80h

	lda	SRCDSK
	call	PASCII		;ASCII source disk number
				;(trashes b)

	call	ILPRNT
	db	QUOTE,'s system file','s'+80h

NOSYS:
	call	ASKYN		;(trashes hl)
	cnz	SRESET		;not Y: just quit

;Ask for for disks

ASKAGN:	mov	a,c		;c=LMODE
	ora	a		;any source disk needed?
	jz	SREADY		;no for L=0

	call	CILPRT
	db	'Insert source disk in Unit',' '+80h
	lda	SRCDSK
	call	PASCII		;(trashes b)
SREADY:

	call	CILPRT
	db	'Insert destination disk in Unit',' '+80h
	call	PDEST		;print ASCII dest drive number
				;(trashes b)

	call	CILPRT
	db	'Read','y'+80h

	call	ASKYN		;(trashes hl)
	cnz	SRESET		;not Y: just quit

;See if disks are actually ready

	mov	a,c		;c=LMODE
	ora	a		;any source disk needed?
	jz	SRDY2		;no for L=0

	lda	SRCDSK		;Source disk ready?
	call	DSKSEL		;select the source disk	
	out	HEDCMD

	in	HESTAT		;get Helios status
	ani	HSRDYN		;disk selected, loaded, spinning?
	jnz	ASKAGN		;n: ask again


SRDY2:	call	DSTSEL		;select the destination disk	
	out	HEDCMD

	in	HESTAT		;get Helios status
	ani	HSRDYN		;disk selected, loaded, spinning?
	jnz	ASKAGN		;n: ask again

;-----------------------------------------------
;Remember SYSGLO parameters that we may change,
;so we can restore them when done.
;Change the ones we need to change.
;-----------------------------------------------
;PTDOS's memory limit (GLLOW)
;Give PTDOS lots of RAM so that it can buffer 2 files that
;each has a 4K (FFFh) block size

	lhld	SYSGLO		;PTDOS's System Global area

	lxi	d,GLLOW
	dad	d
	mov	e,m
	mvi	m,FGLLOW and 0FFh
	inx	h
	mov	d,m
	mvi	m,FGLLOW/256	;GLLOW = FGLLOW

;Set default disk to disk to the source disk, so we can
;later read the SYSGLO file

	lxi	d,GLUNI-(GLLOW+1)
	dad	d
	lda	SRCDSK
	mov	m,a

;Tell PTDOS to send level 1 and level 2 errors back to us,
;and to send level 0 errors to PTDOS. Do this before any
;SYS calls.

	lxi	d,GLERS-GLUNI
	dad	d		;hl=GLERS address

	lxi	b,4*256+0FFh	;4 bytes for 2 16-bit -1's

SERLUP:	mov	m,c		;(page 6-12)
	inx	h
	dcr	b
	jnz	SERLUP

	mov	m,b		;level 0 errors go to PTDOS
	inx	h
	mov	m,b

;------------------------------------------------
;ZAP PTDOS so we can change protection attributes
;------------------------------------------------
	lxi	h,PATR15	;Attribute test for PTDOS 1.5
	mov	a,m
	sui	PATR		;This is the "A" attribute bit.
	jz	P15		;maybe it's 1.4 DOS

	lxi	h,PATR14	;Atrtribute test for PTDOS 1.4
	mov	a,m
	sui	PATR		;This is the "A" attribute bit.
	jnz	VRSERR		;Unrecognized PTDOS: Error exi

P15:	mov	m,a		;ZAP now

;-----------------------
;Announce verify setting
;-----------------------
	call	CILPRT
	db	'Verify ','o'+80h

	lda	VMODE		;Verify on?
	ora	a
	jz	NOVRFY

	call	ILPRNT
	db	'n'+80h
	jmp	VMDONE

NOVRFY:	call	ILPRNT
	db	'f','f'+80h
VMDONE:

;--------------------------
;Return from initialization
;--------------------------
	ret

;***INIT Error Exit********
;Unrecognized PTDOS version
;**************************
VRSERR:	call	CILPRT
 db 'Unrecognized PTDO','S'+80h
	
	call SRESET		;restart PTDOS

;***Init Subroutine*********************
;S={{+/-}R}{{+/-}V}
;Allows '+' too
;On Entry:
;  hl = pointer to 1st chr after 'S='
;   c = character count after 'S='
;On Exit:
;  R causes RIFLAG = 0 or 1
;  V causes VMODE to be 0 or 1
;trashes psw,hl
;***************************************
SOPTN:	mvi	b,1		;assume + for now

	mov	a,m
	inx	h
	cpi	'+'
	jz	SOPTN1

	cpi	'-'
	jnz	SOPTN2

	dcr	b		;- means disable option

SOPTN1:	mov	a,m		;skip - or +
	inx	h

	dcr	c
	jz	CMDERR		;nothing after +/-?

SOPTN2:	cpi	'R'		;reinstall flag?
	jnz	SOPTN3

	mov	a,b
	sta	RIFLAG		;remember reinstall mode
	jmp	SOPTN4

SOPTN3:	cpi	'V'		;Verify flag?
	jnz	CMDERR		;n: bogus

	mov	a,b
	sta	VMODE		;remember verify mode

SOPTN4:	dcr	c
	jnz	SOPTN

	ret

;***Init Subroutine***************************
;L=<n> set format level option
;On Entry:
;  hl = pointer to 1st chr after 'L='
;   c = character count after 'L='
;On Exit:
;  LMODE is set appropriately
;  'BOOT' is pasted into the blank-sector data
;  FCOUNT is updated
;trashes psw,hl
;*********************************************
LOPTN:	dcr	c		;one more byte?
	jnz	CMDERR		;n: error

	mov	a,m		;get L= value
	sui	'0'		;un-ASCII
	cpi	MAXLEV+1	;bounds-check
	jnc	CMDERR

	sta	LMODE		;remember L= option

	lxi	h,LCTABL	;get file count for this level
	add	l
	mov	l,a
	jnc	LOPTN1
	inr	h
LOPTN1:
	mov	a,m
	sta	FCOUNT

	lxi	h,'O'*256+'B'	;'BO'
	shld	BOOTGH		;'BOOT' goes here
	lxi	h,'T'*256+'O'	;'OT'
	shld	BOOTGH+2

	ret

LCTABL:	db	0
	db	FCOUNT1
	db	FCOUNT1+FCOUNT2
	db	FCOUNT1+FCOUNT2+FCOUNT3
	db	FCOUNT1+FCOUNT2+FCOUNT3+FCOUNT4
	db	FCOUNT1+FCOUNT2+FCOUNT3+FCOUNT4+FCOUNT5

;***Init Subroutine*************************
;N=<name> set file name option. Truncate
;name to 8 characters.
;On Entry:
;  hl = pointer to 1st chr after 'N='
;  c = character count after 'N='
;  DDNAME has the default disk name
;On Exit:
;  the provided name is installed in DDNAME
;  CUSTNM <> 0
;trashes all registers
;*******************************************
NOPTN:	lxi	d,DDNAME	;temp name storage

	mvi	b,8		;max chrs allowed
	mov	a,b
	sta	CUSTNM		;remember custom name exists

NOPLUP:	xra	a		;pad with 0's
	dcr	c		;next character
	jm	NCHR		;y: done

	mov	a,m		;get a name chr
	inx	h

NCHR:	stax	d		;write to DDNAME
	inx	d

	dcr	b		;truncate after 8 chrs
	jnz	NOPLUP

	ret	

;***Init Subroutine*****************************
;D=mm/dd/yy option and convert to packed binary.
;Both the month and the day may be 1 digit. The
;year must be 2 digits.
;On Entry:
;  hl = pointer to 1st chr after 'D='
;  DDDATE already has the PTDOS system date
;On Exit:
;  the provided date is converted to 3-byte
;  packed BCD and installed in DDDATE
;trashes all registers
;***********************************************
DOPTN:	lxi	d,DDDATE	;destination

	call	GETBCD		;get month
	stax	d		;..and save it

	call	CSLASH		;mandatory slash
				;followed by day
	inx	d
	stax	d		;..and save it

	call	CSLASH		;mandatory slash
				;followed by year
	inx	d
	stax	d		;..and save it

	ret

;***Init Subroutine*******************************
;Check next character for "/", then get subsequent
;2-digit number and convert to packed BCD
;On Entry:
;  hl points to the first digit
;On Exit:
;  a = packed BCD value
; hl = hl + 3
; rude abort on missing '/' or invalid digit
;trashes b
;*************************************************
CSLASH:	mov	a,m
	inx	h
	cpi	'/'
	jnz	CMDERR

;fall into GETBCD

;***Init Subroutine**************************
;Get 2-digit number and convert to packed BCD
;single-digit entry is allowed for MM and DD
;On Entry:
;  hl points to the first digit
;On Exit:
;  a = packed BCD value
; hl = hl + 2
; rude abort on invalid digit
;trashes b
;********************************************
GETBCD:	xra	a		;initial value
	call	BCDNIB		;get high nibble
	mov	b,a

	mov	a,m		;peak at next digit
	cpi	'/'		;1 digit allowed on MM and DD
	mov	a,b
	rz
				;carry cleared for numbers
	rlc			;move digit it up
	rlc
	rlc
	rlc

;Fall into BCDNIB to get & combine low nibble

;---Local Subroutine-----------------------------------
;Get digit, convert to binary, combine with prior digit
;On Entry:
;  a = prior digit
;  hl pints to next digit
;On exit:
;  a = combined result
; hl = hl + 1
;------------------------------------------------------
BCDNIB:	mov	b,a

	mov	a,m
	sui	'0'		;un-ASCII
	cpi	10		;valid decimal digit?
	jnc	CMDERR

	ora	b		;combine with previous digit
	inx	h		;point to next digit
	ret

;=========================================================
;The following uninitialized variables and data structures
;overwrite the above initialization code.
;=========================================================
	org	INIT

;===========================
;= Uninitialized Variables =
;===========================
RHFLAG:	ds	1	;1 when reading headers, 0 when writing
SRCFN:	ds	1	;Source file number
DSTFN:	ds	1	;Destination file number
RBCSAV:	ds	1	;original GLRBC value

;***Uninitialized Data Structure***
;Buffer for reading File Info
;**********************************
INFOBF:
	
IFILID:	ds	2	;File ID
IINDBS:	ds	1	;Index block sector
IINDBT:	ds	1	;Index block track
IFBS:	ds	1	;First block sector
IFBT:	ds	1	;First block track
IFBCNT:	ds	2	;File block count
IRESV1:	ds	1	;reserved
IOFLAG:	ds	1	;Open flag
IRESV2:	ds	1	;reserved
IFTYPE:	ds	1	;File type
IBSIZE:	ds	2	;Block size
IPATTR:	ds	1	;Protection attributes
IFNAME:	ds	8	;File name
ZERO:	ds	1	;always zero

	ds	2	;leave room to tack on "/n"

;***Uninitialized Data Structure*****************************
;System Global File buffer
;The SYSGLOBL file on disk includes 5 File ContrOl Blocks,
;all of the System Parameters (see page 6-3), as well as
;another 383 bytes (containing what?) that follow the system
;paramters in RAM. (See file D14P#3.ALS, search for "FCBORG")

;This file gets created during INIT, based on the source
;disk's SYSGLOBL file, as well as user input and a few
;default values, and then written to the destination disk as
;the new SYSGLOBL file during Phase 2. File Control Block 2
;(here) gets updated if/when SUTIL is written to disk during
;Phase 3 - in which case, this file get rewritten to the
;destination disk.
;************************************************************
SGABUF:

;File Control BLock 0 (Console Input file)

F0TYPE:	ds	1	;FILE TYPE
F0BLKS:	ds	2	;BLOCK SIZE
F0PROT:	ds	1	;PROTECTION
F0ID:	ds	2	;FILE ID
F0INDX:	ds	2	;INDEX ADDRESS
F0FBA:	ds	2	;FIRST BLOCK ADDRESS
F0UNIT:	ds	1	;UNIT
F0BUFA:	ds	2	;BUFFER ADDRESS/UNBUFFERED FLAG
F0DLTA:	ds	2	;DELTA ALLOCATION IN BLOCKS
F0DRIV:	ds	2	;DRIVER POINTER
F0AIND:	ds	2	;MEMORY ADDRESS OF FILE INDEX BLOCK OR -1
F0NBD:	ds	2	;NEXT BYTE DISPLACEMENT
F0BDL:	ds	2	;BYTE DISPLACEMENT LIMIT
F0FLAG:	ds	1	;DIRTY BLOCK FLAG
F0CRSC:	ds	2	;CURRENT SECTOR ADDRESS
F0GSPR:	ds	1	;GARYS SPARE
F0FORE:	ds	2	;FORE POINTER
F0BACK:	ds	2	;BACK POINTER
F0HID:	ds	2	;ID FROM HEADER
F0PRST:	ds	1	;PROTECTION/STATUS

;File Control BLock 1 (Console Output file)

F1TYPE:	ds	1	;FILE TYPE
F1BLKS:	ds	2	;BLOCK SIZE
F1PROT:	ds	1	;PROTECTION
F1ID:	ds	2	;FILE ID
F1INDX:	ds	2	;INDEX ADDRESS
F1FBA:	ds	2	;FIRST BLOCK ADDRESS
F1UNIT:	ds	1	;UNIT
F1BUFA:	ds	2	;BUFFER ADDRESS/UNBUFFERED FLAG
F1DLTA:	ds	2	;DELTA ALLOCATION IN BLOCKS
F1DRIV:	ds	2	;DRIVER POINTER
F1AIND:	ds	2	;MEMORY ADDRESS OF FILE INDEX BLOCK OR -1
F1NBD:	ds	2	;NEXT BYTE DISPLACEMENT
F1BDL:	ds	2	;BYTE DISPLACEMENT LIMIT
F1FLAG:	ds	1	;DIRTY BLOCK FLAG
F1CRSC:	ds	2	;CURRENT SECTOR ADDRESS
F1GSPR:	ds	1	;GARYS SPARE
F1FORE:	ds	2	;FORE POINTER
F1BACK:	ds	2	;BACK POINTER
F1HID:	ds	2	;ID FROM HEADER
F1PRST:	ds	1	;PROTECTION/STATUS

;File Control BLock 2, (SUTIL - System Utility program)

F2TYPE:	ds	1	;FILE TYPE
F2BLKS:	ds	2	;BLOCK SIZE
F2PROT:	ds	1	;PROTECTION
F2ID:	ds	2	;FILE ID
F2INDX:	ds	2	;INDEX ADDRESS
F2FBA:	ds	2	;FIRST BLOCK ADDRESS
F2UNIT:	ds	1	;UNIT
F2BUFA:	ds	2	;BUFFER ADDRESS/UNBUFFERED FLAG
F2DLTA:	ds	2	;DELTA ALLOCATION IN BLOCKS
F2DRIV:	ds	2	;DRIVER POINTER
F2AIND:	ds	2	;MEMORY ADDRESS OF FILE INDEX BLOCK OR -1
F2NBD:	ds	2	;NEXT BYTE DISPLACEMENT
F2BDL:	ds	2	;BYTE DISPLACEMENT LIMIT
F2FLAG:	ds	1	;DIRTY BLOCK FLAG
F2CRSC:	ds	2	;CURRENT SECTOR ADDRESS
F2GSPR:	ds	1	;GARYS SPARE
F2FORE:	ds	2	;FORE POINTER
F2BACK:	ds	2	;BACK POINTER
F2HID:	ds	2	;ID FROM HEADER
F2PRST:	ds	1	;PROTECTION/STATUS

;File Control BLock 3 (SYST.LOG file, if logging is enabled)

F3TYPE:	ds	1	;FILE TYPE
F3BLKS:	ds	2	;BLOCK SIZE
F3PROT:	ds	1	;PROTECTION
F3ID:	ds	2	;FILE ID
F3INDX:	ds	2	;INDEX ADDRESS
F3FBA:	ds	2	;FIRST BLOCK ADDRESS
F3UNIT:	ds	1	;UNIT
F3BUFA:	ds	2	;BUFFER ADDRESS/UNBUFFERED FLAG
F3DLTA:	ds	2	;DELTA ALLOCATION IN BLOCKS
F3DRIV:	ds	2	;DRIVER POINTER
F3AIND:	ds	2	;MEMORY ADDRESS OF FILE INDEX BLOCK OR -1
F3NBD:	ds	2	;NEXT BYTE DISPLACEMENT
F3BDL:	ds	2	;BYTE DISPLACEMENT LIMIT
F3FLAG:	ds	1	;DIRTY BLOCK FLAG
F3CRSC:	ds	2	;CURRENT SECTOR ADDRESS
F3GSPR:	ds	1	;GARYS SPARE
F3FORE:	ds	2	;FORE POINTER
F3BACK:	ds	2	;BACK POINTER
F3HID:	ds	2	;ID FROM HEADER
F3PRST:	ds	1	;PROTECTION/STATUS

;File Control BLock 4

F4TYPE:	ds	1	;FILE TYPE
F4BLKS:	ds	2	;BLOCK SIZE
F4PROT:	ds	1	;PROTECTION
F4ID:	ds	2	;FILE ID
F4INDX:	ds	2	;INDEX ADDRESS
F4FBA:	ds	2	;FIRST BLOCK ADDRESS
F4UNIT:	ds	1	;UNIT
F4BUFA:	ds	2	;BUFFER ADDRESS/UNBUFFERED FLAG
F4DLTA:	ds	2	;DELTA ALLOCATION IN BLOCKS
F4DRIV:	ds	2	;DRIVER POINTER
F4AIND:	ds	2	;MEMORY ADDRESS OF FILE INDEX BLOCK OR -1
F4NBD:	ds	2	;NEXT BYTE DISPLACEMENT
F4BDL:	ds	2	;BYTE DISPLACEMENT LIMIT
F4FLAG:	ds	1	;DIRTY BLOCK FLAG
F4CRSC:	ds	2	;CURRENT SECTOR ADDRESS
F4GSPR:	ds	1	;GARYS SPARE
F4FORE:	ds	2	;FORE POINTER
F4BACK:	ds	2	;BACK POINTER
F4HID:	ds	2	;ID FROM HEADER
F4PRST:	ds	1	;PROTECTION/STATUS

;System Global Area parameters image (see page 6-3)

SGAIMG:	ds	63	

;Room for the rest of the SYSGLOBL file

	ds	SGADBC-(SGAIMG-SGABUF)

;***Buffer******************************************
;Buffer for reading/writing file data during Phase 3
;Overwrites all the other buffers beyond here
;***************************************************
DATBUF:	equ	$
DBSIZE	equ	FGLLOW-STKSIZ-$

;***Buffer**************************************
;Free sector Map
;Gets created during Phase 2 and written to disk
;at the end of phase 2
;***********************************************
FSMAP:	ds	FSMDBC

;***Buffer****************************
;Buffer for dummy files during Phase 2
;*************************************
DUMYBF:	ds	MAXBLK

;***Buffer************************************************
;Buffer for scanning command line options prior to Phase 1
;Overwrites JNKBUF
;*********************************************************
SCNBUF:

;***Buffer*********************************
;Junk buffer for:
;  Hunting for blocks during Phase 2
;  Verifying writes during Phase 2
;  Reading SUTIL's File Info during Phase 3
;******************************************
JNKBUF:	ds	MAXBLK

	END



















