;
;  DISK OPEN ROUTINE
;
DKOPEN	JSR	WBITMP		;Fix nasty bug! [Bob Puff]
	JSR	SETUP		;SET UP BUF PTRS, ETC.
	JSR	GETFNM		;GET DRIVE ID OR FILE NAME FROM BUFFER
	LDA	ICAX1Z		;GET TYPE OF OPEN FROM IOCB
	STA	FCBOTC,X
	AND	#$02		;TEST DIRECTORY READ FLAG
	BEQ	DKOPN1
	JMP	LSTDIR		;IF SET, GO HANDLE DIRECTORY FORMATTING
;
DKOPN1	STA	SAVSEC,X
	STA	SAVSEC+1,X	;CLEAR SAVSEC
	JSR	SFDIR
	PHP			;SAVE STATUS RETURNED
	BCS	OPNEW
	LDA	#$10		;MAKE SURE THIS IS NOT A DIRECTORY
	JSR	GETFLAG
	BNE	DIROPN		;IF A DIRECTORY, GO HANDLE IT SEPERATELY
OPNEW	LDY	ICAX1Z
	CPY	#8
	BEQ	OPNOP		;IF OPEN FOR OUTPUT
	CPY	#4
	BEQ	OPNIN		;IF OPEN FOR INPUT
	CPY	#12
	BEQ	OPNUP		;IF OPEN FOR READ/WRITE (UPDATE)
	CPY	#9
	BEQ	OPNAP		;IF OPEN FOR OUTPUT/APPENDED
DIROPN	JMP	ERRCMD		;IF NONE OF THE ABOVE, IT IS AN ERROR!
;
OPNAP	PLP		;OPEN APPEND
	BCS	OPNCR0
	JSR	TSTLOK
	JSR	INITYP	;READ ALL THE SECTORS IN THE FILE
	LDA	DIRBUF+1,Y
	STA	SECCNT,X
	LDA	DIRBUF+2,Y
	STA	SECCNT+1,X
APPRD	JSR	RDNXTS
	BCC	APPRD	;IF NOT EOF, READ ANOTHER
	LDA	MAXLEN,X
	JSR	LENSET	;SET LENGTHS FOR OUTPUT
	LDA	SECCNT,X
	BNE	SGLDEC
	DEC	SECCNT+1,X
SGLDEC	DEC	SECCNT,X ;ALLOW FOR SECTOR REWRITTEN
	JMP	OPOUTX
;
OPNUP	PLP		;OPEN UPDATE (OUTPUT)
	BCS	OPNER1
	JSR	TSTLOK
OPNOWR	JSR	INSTRT
	JMP	DONE
;
OPNIN	PLP		;OPEN INPUT
	BCC	OPNOWR
OPNER1	LDA	#170	;FILE NOT FOUND
	BMI	EROXIT
;
OPNOP	PLP		;OPEN (NORMAL) OUTPUT
	BCS	OPNCR
	JSR	REMOVE
	JMP	GET1ST
;
OPNCR0	DEC	FCBOTC,X
OPNCR	LDA	HOLFN
	STA	CURFNO
	BMI	OPDIRF
GET1ST	JSR	ALLOC
;
	LDA	ICAX2Z	;IF OUTPUT, TYPE OF FILE
	AND	#$24	;SAVE LOCKED & FORMAT BITS (with 4.5, DOS I no-more)
	EOR	#$43	;MERGE IN DEFAULT CODE (DOS II, UNLOCKED)
	LDY	MAPBUF	;WHICH TYPE DISK?
	CPY	#3	;IF >2 THEN MYDOS
	BCC	LLINKS
	ORA	#$04
;
LLINKS	PHA
	JSR	RDCFNO	;SELECT PROPER SECTOR IN DIRECTORY
	SEC
	JSR	ENTNAME		;ENTER NAME INTO IT
	LDA	LNKSEC+1,X
	STA	DIRBUF+4,Y
	LDA	LNKSEC,X
	STA	DIRBUF+3,Y
	PLA
	JSR	SAVFLAG
	JSR	INITYP
	JSR	TONXT
OPOUTX	LDA	#$80
	STA	FCBFLG,X
	JSR	TSTDOS		;FILE NAME = DOS.SYS?
	BNE	JDONE
	LDY	CURSEC,X
	LDA	CURSEC+1,X
	JSR	SETDOS		;IF SO, UPDATE BOOT SECTORS
;
	LDA	DOSAD
	STA	FMSZPG
	LDA	DOSAD+1
	STA	FMSZPG+1
	BNE	OWTDOS		;NOTE: DOS CANNOT START ON ZERO-PAGE
;
OPDIRF	LDA	#169
EROXIT	JMP	AEXIT
;
LWTDOS	JSR	WRNXTS		;AUTOMATICALLY WRITE DOS.SYS OUT
OWTDOS	LDY	#0		;IF WE OPEN "DOS.SYS" FOR A WRITE
CDOSBF	LDA	(FMSZPG),Y	;(THIS IS BECAUSE DOS 2.0 WOULD BLOW
	STA	(FMSBPT),Y	; ITSELF AWAY IF A REAL WRITE FROM THE
	INY			; DOS AREA WAS ATTEMPTED, AND WE HAVE
	CPY	DLINK		; TO REMAIN COMPATIBLE).
	BCC	CDOSBF
	TYA
	STA	CURLEN,X
	JSR	MVBUFR
	CPY	DOSEND
	SBC	DOSEND+1
	BCC	LWTDOS
JDONE	JMP	DONE
;
; READ DATA FROM A FILE
;
DKREAD	JSR	SETUP		;SETUP BUFFER POINTERS, ETC.
	LDA	FCBOTC,X
	AND	#$02		;TEST THE DIRECTORY I/O FLAG
	BEQ	RDFILE
	JMP	DIRRD		;JUMP IF THE SPECIAL CASE OF A DIRECTORY READ
;
RDFILE	LDA	CURLEN,X
	CMP	MAXLEN,X
	BCC	RDSGBT		;IF NOT AT SECTOR BOUND., READ A BYTE AT A TIME
	BCS	RDASNT		;ELSE, CHECK FOR READ MODE AND BUFFER SIZE
;
RDASLP	LDA	ICCOMZ
	AND	#$02
	BEQ	RDSGBT		;IF NOT BINARY I/O READ A BYTE AT A TIME
	LDY	DLINK
	DEY
RDSCLP	LDA	(FMSBPT),Y	;SIMULATED BURST I/O (with unrolled loop)
	STA	(ICBALZ),Y
	DEY
	LDA	(FMSBPT),Y
	STA	(ICBALZ),Y
	DEY
	LDA	(FMSBPT),Y
	STA	(ICBALZ),Y
	DEY
	LDA	(FMSBPT),Y
	STA	(ICBALZ),Y
	DEY
	BNE	RDSCLP
	LDA	(FMSBPT),Y	;NUM OF DATA BYTES IS MULTIPLE OF 4 + 1
	STA	(ICBALZ),Y
	JSR	BUFADJ		;ADJUST BUFFER PTR BY 125 OR 253
RDASNT	JSR	RDNXTS		;READ IN THE NEXT SECTOR
	BCS	RETEOF		;REPORT EOF/ERROR IF NECESSARY
	LDA	ICBLLZ+1
	BNE	RDASLP		;AND REPEAT THE LOOP IF > 256 BYTES LEFT
;
RDSGBT	TAY
	LDA	(FMSBPT),Y	;FETCH A DATA BYTE FROM THE BUFFER
	STA	DATBYT		;AND RETURN IT TO CIO
	INY
	TYA
	STA	CURLEN,X	;BUMP CURRENT BUFFER LENGTH
	EOR	MAXLEN,X
	ORA	LNKSEC,X
	ORA	LNKSEC+1,X	;TEST FOR THE LAST BYTE OF THE FILE
	BNE	JDONE
	LDA	#3		;IF IT IS, REPORT THIS IS THE LAST BYTE
	DB	$2C
;
RETEOF	LDA	#136		;RETURN END OF FILE STATUS
	JMP	AEXIT
;
; WRITE DATA TO A FILE
;
DKWRIT	STA	DATBYT		;SAVE THE DATA BYTE (IF IT IS IN ACC)
	LDY	ICDNO,X
	STY	ICDNOZ		;INSURE ICDNOZ IS SET UP (BASIC DOES NOT!)
	JSR	SETUPW
	LDA	FCBOTC,X
	AND	#$08
	BEQ	CANTWR		;ERROR OUT IF ILLEGAL TO WRITE (BASIC AGAIN!)
	LDA	CURLEN,X
	TAY
	CMP	MAXLEN,X
	BCC	SKBURST		;SKIP AROUND IF NOT THE END OF THE SECTOR

WRASLP	JSR	WRNXTS		;WRITE A SECTOR OF DATA
	BCS	RETEOF		;ERROR OUT IF NO MORE DISK SPACE
	LDY	STKPSV
	LDA	$0102,Y
	CMP	#$C0		;IF FROM BASIC (RETURN ADDRESS < $C000)
	BCC	BASWRT		;PASS SINGLE BYTES
	LDA	FCBOTC,X	;Fix bug in open/update vs. burst I/O
	AND	#$04		;[Bob Puff, again!]
	BNE	BASWRT
	LDA	ICCOMZ		;IF RECORD I/O, PASS SINGLE BYTES ALSO
	AND	#$02
	BEQ	BASWRT
	LDY	ICBLLZ+1	;AND IF THE BUFFER HOLDS FEWER THAN 256 BYTES
	BEQ	BASWRT		;PASS SINGLE BYTES AS WELL
	LDY	MAXLEN,X
	DEY
WRSCLP	LDA	(ICBALZ),Y	;ELSE, DO SIMULATED BURST I/O
	STA	(FMSBPT),Y
	DEY
	LDA	(ICBALZ),Y
	STA	(FMSBPT),Y	;BUT ONLY UNROLL 2 ENTRIES FOR WRITES!
	DEY			;(WE GOT VERY LITTLE RAM TO WASTE!)
	BNE	WRSCLP
	LDA	(ICBALZ),Y
	STA	(FMSBPT),Y
	JSR	BUFADJ
	LDA	(ICBALZ),Y
	STA	DATBYT
	JMP	WRASLP
;
BASWRT	LDY	#0
SKBURST	LDA	DATBYT
	INC	CURLEN,X
	STA	(FMSBPT),Y
	LDA	#$40
	ORA	FCBFLG,X	;FOR UPDATE MODE, SAY THE SECTOR WAS MODIFIED
	STA	FCBFLG,X
	BNE	TODONE		;BRANCH ALWAYS!
;
CANTWR	JMP	ERRCMD
;
BUFADJ	CLC
	LDA	MAXLEN,X
	STA	CURLEN,X
	ADC	ICBALZ
	STA	ICBALZ
	BCC	RBAOK
	INC	ICBALZ+1
RBAOK	SEC
	LDA	ICBLLZ
	SBC	MAXLEN,X
	STA	ICBLLZ
	BCS	RBLOK
	DEC	ICBLLZ+1
RBLOK	RTS
;
; RETURN FILE STATUS
;
DKSTAT	JSR	SETUP		;SET UP RETURN ADDRESS, ETC.
	JSR	LFFILE		;FIND IF FILE IS THERE, ETC.
	JSR	TSTLOK		;IS IT LOCKED?
TODONE	JMP	DONE		;RETURN TO CALLER
;
; CLOSE FILE (WRITING ANY PENDING SECTOR)
;
DKCLOS	JSR	SETUP
	LDA	FCBOTC,X
	AND	#$08		;OUTPUT ALLOWED?
	BEQ	CLROTC		;IF NOT, JUST EXIT
	ROL	FCBFLG,X
	BCC	CKFLSC
	JSR	REWRIT		;REWRITE THE LAST SECTOR
	JSR	RRDIR
	LDA	SECCNT,X
	LDY	DIRDSP
	STA	DIRBUF+1,Y
	LDA	SECCNT+1,X
	STA	DIRBUF+2,Y
	LDA	DIRBUF,Y
	AND	#$FE		;NOT OPEN FOR OUTPUT ANY MORE
	JSR	SAVFLAG
	LDA	SAVSEC,X
	ORA	SAVSEC+1,X
	BEQ	CLROTC
	CPX	LSTIOCB
	BEQ	FAPPD
	JSR	INITYP	;READ ALL THE SECTORS AGAIN
APPLP	JSR	RDNXTS
	BCC	APPLP	;NOT EOF YET
	BCS	TIELNK
FAPPD	LDA	LSTSEC
	STA	CURSEC,X
	LDA	LSTSEC+1
	STA	CURSEC+1,X
TIELNK	CLC
	JSR	RWDISK
	LDA	DLINK
	STA	CURLEN,X
	LDA	SAVSEC,X
	LDY	SAVSEC+1,X
	JSR	SAVLNK
CLROTE	BPL	CLROTC
	LDA	#163		;FAILURE IS A SYSTEM ERROR
	JMP	AEXIT
CLROTC	LDA	#$FF
	STA	ICHID,X
	LDA	#0
	STA	FCBOTC,X
	JMP	FREDON
;
CKFLSC	ROL	FCBFLG,X
	BCC	CLROTC
	JSR	WRDISK
	JMP	CLROTE
;
INITYP	LDA	#$06
	JSR	GETFLAG
	LSR	A
	ROR	A
	ROR	A
	ROR	A
	ORA	FCBOTC,X
	STA	FCBOTC,X
	LDA	DIRBUF+3,Y
	STA	LNKSEC,X
	LDA	DIRBUF+4,Y
	STA	LNKSEC+1,X
	LDA	CURFNO
	STA	FCBFNO,X
	LDA	#0
	STA	FCBFLG,X
	STA	CURLEN,X
	STA	SECCNT,X
	STA	SECCNT+1,X
	RTS
;
; DOS XIO ROUTINES
;
;  Sorry about the lack of comments in some parts of this file,
;    I just never had to figure this code out after I wrote it (:-)!
;
NODIRF	LDA	#176		;FILE NOT A DIRECTORY
	JMP	AEXIT
;
PIKDIR	LDY	#0
	LDA	#':'
FDVND	INY
	CMP	(ICBALZ),Y
	BNE	FDVND
	INY
	LDA	(ICBALZ),Y
	CMP	#'@'
	BCC	SETRDIR
	CMP	#'Z'+1
	BCC	GFNDIR
	CMP	#'_'
	BCC	SETRDIR
	CMP	#'z'+1
	BCS	SETRDIR
GFNDIR	JSR	LFFILE		;FIND NEW DEFAULT DIRECTORY
	JSR	INITYP
	JSR	TONXDR
	BEQ	NODIRF		;IF NOT A DIRECTORY
	LDA	DIRBAS+1,X
	TAY
	LDA	DIRBAS,X
SAVDEF	STY	CDIREC+1	;UPDATE ADDRESS OF DIR.
	STA	CDIREC
	LDA	ICDNOZ
	STA	DEFAULT		;UPDATE UNIT NUMBER
	BPL	TOFDN
;
SETRDIR	LDA	#LOW[361]
	LDY	#HIGH[361]
	BPL	SAVDEF
;
RENAME	JSR	LFFILE		;GET OLD NAME, DRIVE, VALIDATE
	LDY	#11
STEMPL	LDA	FNAME-1,Y
	STA	MAPBUF+256,Y
	DEY
	BNE	STEMPL
RNLOOP	JSR	TSTLOK		;CANNOT RENAME IF LOCKED
	JSR	TDDOS		;TEST FOR DOS GONE!
	LDY	TMP2
	JSR	GETNAM		;GET NEW NAME
	CLC
	JSR	ENTNAME		;OVERWRITE NAME IN DIR.
	JSR	WDIRBK		;REWRITE DIRECTORY TO DISK
;
	JSR	TSTDOS		;NEW NAME DOS.SYS?
	BNE	REPLDS		;NO, LOOK AT NEXT

	LDY	DIRDSP
	LDA	DIRBUF+4,Y	;SAVE FILE LOCATION ON THE STACK
	PHA
	LDA	DIRBUF+3,Y
	PHA
;
;;;	JSR	SYSSET		;Use the MAP buffer [IS THIS NECESSARY???]
;
	CLC			; == READ
	LDX	#1		; == SECTOR SIZE CODE (1=128, 2=256)
	LDA	#0
	LDY	#1		; == SECTOR #1
	JSR	DKIO		;Read it
;
	LDA	SECDAT
	STA	MAPBUF+SECDAT-$0700
	PLA
	STA	MAPBUF+DOSLOC-$0700
	PLA
	STA	MAPBUF+DOSLOC+1-$0700
;
;;;	LDA	#$00		;[AND IS THIS REALLY NECESSARY???]
;;;	STA	MAPBUF+STATE-$0700
;
	SEC			; == WRITE
	LDX	#1		; == SECTOR SIZE CODE (1=128, 2=256)
	JSR	DKIO2		;Write it (same sector as I read before)
;
	LDA	#$FF		;Then make sure we reread the directory buffer
	STA	DIUNIT
;
REPLDS	LDY	#11
RTEMPL	LDA	MAPBUF+256,Y
	STA	FNAME-1,Y
	DEY
	BNE	RTEMPL
	JSR	CSFDIR		;TO RENAME
	BCC	RNLOOP
TOFDN	JMP	FREDON
;
DELETE	JSR	LFFILE
DELLP	JSR	REMOVE		;FLUSH THE SECTORS
	JSR	RRDIR		;REREAD DIRECTORY BLOCK
	JSR	TDDOS		;DOS.SYS DELETED?
	LDA	#$80
	JSR	SAVFLAG		;REWRITE DIRECTORY BLOCK
	JSR	CSFDIR
	BCC	DELLP		;IF ANOTHER FOUND,
	BCS	TOFDN		;ELSE, WRAP UP AND EXIT
;
REMOVE	JSR	TSTLOK		;ONCE HAD 'OPVTOC' CALL FIRST
	JSR	INITYP
	JSR	TONXDR
	BNE	DELDIR
	JSR	CHASE
;
FREELP	JSR	FREE
	JSR	RDNXTS
	BCC	FREELP
	RTS
;
INVDEL	LDA	#175		;DIRECTORY NOT DELETABLE
	JMP	AEXIT
;
LOCK	LDA	#$20
	DB	$2C		;BIT ABS (SKIP 2 BYTES)
;
UNLOCK	LDA	#$00
	STA	DATBYT
	JSR	LFFILE		;FIND FILE AND VERIFY WRITABLE
LKULKL	LDA	#$DF		;STRIP OFF OLD BIT 5
	JSR	GETFLAG
	ORA	DATBYT		;AND REPLACE WITH NEW
	JSR	SAVFLAG
	JSR	CSFDIR
	BCC	LKULKL
	BCS	TOFDN
;
DELDIR	LDY	#-11
	LDA	#'?'
DELSET	STA	FNAME+11-256,Y
	INY
	BNE	DELSET
	JSR	SFDIR
	BCC	INVDEL
;
	LDA	#8
	STA	DATBYT
	JSR	TONXT
DELDRL	JSR	FREE
	JSR	INCCSEC
	DEC	DATBYT
	BNE	DELDRL
	JMP	GETFNM
;
POINT	LDY	FCBFLG,X
	BMI	ERRCMD
;
	LDA	ICSPR+1,X
	CMP	CURSEC+1,X
	BNE	PNTREAD
	LDA	ICSPR,X
	CMP	CURSEC,X
	BEQ	PNTSME
PNTREAD	TYA
	BEQ	PNTCLN		;IF SECTOR UNMODIFIED
	JSR	WRDISK
	LDA	#0
	STA	FCBFLG,X
PNTCLN	LDA	ICSPR+1,X
	STA	LNKSEC+1,X
	LDA	ICSPR,X
	STA	LNKSEC,X
	JSR	CHASE		;READ SECTOR POINTED TO
	BCS	BADPNT
;
PNTSME	LDA	ICSPR+2,X
	CMP	MAXLEN,X
	BCS	PNTEQL
PNTLST	STA	CURLEN,X
	JMP	DONE
;
PNTEQL	BEQ	PNTLST		;IF POINTING AT LAST BYTE
BADPNT	LDA	#166		;INVALID POINT LOCATION
	DB	$AE
;
ERRCMD	LDA	#168		;INVALID IOCB PARAMETER
	JMP	AEXIT
;
NOTE	LDA	CURSEC,X
	STA	ICSPR,X
	LDA	CURSEC+1,X
	STA	ICSPR+1,X
	LDA	CURLEN,X
	STA	ICSPR+2,X
	JMP	DONE
;
DKXIO	JSR	SETUP
	LDA	ICCOMZ		;GET COMMAND BYTE
	CMP	#254
	BEQ	FORMAT
	CMP	#43		;ADD "MKDIR" CODE FOR SpartaDOS(?) [Bob Puff]
	BCS	ERRCMD		;IF INVALID COMMAND
	SBC	#32-1
	BCC	ERRCMD
	TAY
	LDA	VECTBH,Y
	PHA
	LDA	VECTBL,Y
	PHA
	RTS			;VECTOR TO PROPER ROUTINE
;
VECTBH	DB	HIGH[RENAME-1],HIGH[DELETE-1]
	DB	HIGH[MKDIR-1],HIGH[LOCK-1]
	DB	HIGH[UNLOCK-1],HIGH[POINT-1]
	DB	HIGH[NOTE-1],HIGH[DKLOAD-1]
	DB	HIGH[ERRCMD-1],HIGH[PIKDIR-1]
	DB	HIGH[MKDIR-1]	;extra vector to MKDIR [Bob Puff]
;
VECTBL	DB	LOW[RENAME-1],LOW[DELETE-1]
	DB	LOW[MKDIR-1],LOW[LOCK-1]
	DB	LOW[UNLOCK-1],LOW[POINT-1]
	DB	LOW[NOTE-1],LOW[DKLOAD-1]
	DB	LOW[ERRCMD-1],LOW[PIKDIR-1]
	DB	LOW[MKDIR-1]
;
; DOS FORMAT ROUTINES
;
FORMAT	JSR	WBITMP		;WRITE OUT ANY PENDING VTOC SECTORS
;
	ldy	#9		;Force format to match current density
WOTCP2	lda	WOTDCB,y	;set up DCB for specified density [Bob Puff]
	sta	DDEVIC+2,y
	dey
	bpl	WOTCP2
	ldx	ICDNOZ
	cpx	RAMDKU
	beq	WOTRAM		;don't do it for RAMdisks
;
	ldy	SECSIZ-1,x 
	lda	DRVDEF-1,x 
	jsr	SETDRV		;set density
WOTRAM  ldx	CURFCB		;restore X reg
;
	LDY	#0
	TYA			;THEN INITIALIZE NEW BIT MAP (VTOC)
CLRMAP	STA	MAPBUF,Y
	STA	MAPBUF+256,Y
	INY
	BNE	CLRMAP
;
	LDA	#2
	STA	MAPBUF		;start out as a DOS 2.0 disk
	LDA	#$FF
	STA	(FMSBPT),Y
	INY
	STA	(FMSBPT),Y	;PRESUME NO BAD SECTORS IF BUFFER IS UNMODIFIED
	LDY	ICDNOZ
	CPY	RAMDKU
	BEQ	RAMFMT		;IF RAMDISK, SKIP EVERYTHING
	LDA	FMSBPT+1
	LDY	FMSBPT
	JSR	BUFSET		;SET UP BUFFER POINTER FOR SIO CALL
	LDX	#1
	STX	TMP1		;ALLOW ONE TRY ONLY
	LDA	#$22		;PRESUME 1050 D/D FORMAT NEEDED
	LDY	ICAX2Z		;GET AUX2 BYTE
	BMI	FMTOK		;MINUS --> NO FORMAT REQUIRED
	BNE	NMLFMT		;AUX2 NONZERO, NORMAL FORMAT WITH SIZE DEFINED
	LDY	ICAX1Z		;(AUX2,AUX1) = 1?
	DEY
	BEQ	FT1050		;YES, FORMAT WITH A $22 COMMAND
;
NMLFMT	ldx	DUNIT
	lda	SECSIZ-1,X	;PUT SECTOR SIZE CODE (1 OR 2) INTO X
	tax
	lda	#FMTCMD		;AUX IS 0, must not be 1050 d/d
FT1050	STA	DAUX1		;MAKE SURE WE SECTOR > 3
	LDY	DSKTIM		;DISK TIMEOUT VALUE (RETURNED IN STATUS)
	JSR	DKFME		;ENTER DKIO AT FORMAT ENTRY
	BPL	FMTOK		;Accepting 144 errors here removed [Bob Puff]
	JMP	AEXIT		;RETURN ERROR CODE IF ANY OCCURRED
;
RAMFMT	STA	CURSEC,X	;STUFF PROPER NUMBER OF SECTORS INTO CURSEC
	CLC			;(256-BYTE PAGES * 2 SINCE SECTOR SIZE IS 128)
	ADC	RDKLMT
	LSR	A
	ROR	CURSEC,X
	BNE	NOTDEF		;FAIL IF NOT 256 SECTORS OR MORE (need 370)
;
;	SUCCESSFUL FORMAT, CREATE VTOC AND EMPTY DIRECTORY
;
FMTOK				;Bob Puff disabled the marginal format code
;	ldy	#0		;check for a bad format
;	lda	(FMSBPT),y 
;	and	(FMSBPT),y	;first two bytes $FF?
;	cmp	#$FF
;	beq	FMTOK2		;yep, continue
;	lda	#173		;otherwise format error
;	bne	FMEXIT
;
FMTOK2
	JSR	INVUNIT		;Can we do this (asks Bob Puff)
	JSR	DELDOS
	LDA	ICAX1Z
	STA	CURSEC,X
	LDA	ICAX2Z
	AND	#$7F		;DISK MUST HAVE 256 SECTORS
	BNE	NOTDEF		;IF SIZE SPECIFIED, USE IT
	LDY	ICDNOZ
	LDA	HDTAB-1,Y	;IF NOT AND THIS IS A HARD DISK
	STA	CURSEC,X	;USE THE SYSTEM DEFINED SIZE
	LDA	HDTAB+8-1,Y
	BNE	NOTDEF
	BIT	DVSTAT		;1050 DRIVE?
	BPL	FIGSIZ		;NO, FIGURE SIZE THEN
	LDA	#LOW[1040]	;YES, FORCE TO 1040 SECTORS
	STA	CURSEC,X
	LDA	#HIGH[1040]
	BNE	NOTDEF
;
FIGSIZ	LDA	DRVDEF-1,Y
	AND	#$31		;EXTRACT TRACK COUNT FLAGS
	LSR	A
	PHP
	LSR	A
	LSR	A
	TAY
	LDA	NOSECS,Y	;AND USE DRIVE DEFAULT SECTOR COUNT
	STA	CURSEC,X
	LDA	NOSECS+1,Y
	PLP
	BCC	NOTDEF		;IF NOT DOUBLE SIDED, THIS IS IT
	ASL	CURSEC,X
	ROL	A		;ELSE, DOUBLE IT
;
NOTDEF	STA	CURSEC+1,X
	CMP	#4		;NEED 16 BIT LINKS?
	BCC	SHORTS		;NO, SHORT FORMAT OK
	INC	MAPBUF		;YES, FORCE LONG FORMAT (DOS3)
SHORTS	JSR	FNDBIT		;FIND LAST BIT MAP SECTOR
	LDA	TMP2
	BNE	GT246		;IF PAST 256TH MAP BYTE
	BIT	DLINK		;SINGLE DENSITY?
	BMI	FDBDEN
	CPY	#0
	BPL	FDBDEN
GT246	STA	MAP2
	CLC
	ADC	#3
	STA	MAPBUF
FDBDEN	LDA	#HIGH[-9]
	STA	MAPBUF+4
	LDA	#LOW[-9]
	STA	MAPBUF+3	;START WITH 9 FREE SECTORS UN-FREE!
FLOOP	JSR	FMTFRE
	JSR	DECCSEC
	CMP	#4		;BOOT SECTORS YET?
	BNE	FLOOP		;IF NOT, CONTINUE DEALLOCATING
	LDA	CURSEC+1,X
	BNE	FLOOP
;
;	ALLOCATE BAD SECTORS
;	[Bob Puff replaced this with code to set FMSBPT to 1, since he
;	 disallows bad sectors]
;
	LDY	#0
CLRBDLP	LDA	(FMSBPT),Y
	STA	CURSEC,X
	INY
	LDA	(FMSBPT),Y
	STA	CURSEC+1,X
	INY
	AND	CURSEC,X
	CMP	#$FF
	CLC
	BEQ	MAPDONE
	STY	TMP1
	JSR	DECCNT
	JSR	FNDLBIT
	EOR	#$FF
	BCC	CLRBD1
	AND	MAPBUF+256,Y
	STA	MAPBUF+256,Y
	BCS	CLRBD2
CLRBD1	AND	MAPBUF,Y
	STA	MAPBUF,Y
CLRBD2	LDY	TMP1
	BNE	CLRBDLP
	SEC
	LDY	#173*2-256	;NO $FFFF => BAD FORMAT
MAPDONE	TYA
	ROR	A
	STA	FMSBPT		;POSITIVE VALUE = NUMBER OF BAD SECTORS
;
;	[End of code that can be optionally deleted]
;
	LDA	#$00
	STA	MAPBUF+55
	LDA	#$7F
	STA	MAPBUF+56
	LDY	#44		;START ALLOC. OF VTOC HERE
	LDA	MAPBUF
	SEC
	SBC	#2		;GET NUMBER OF SECTORS
	BIT	DLINK		;(SINGLE DENSITY?)
	BMI	MPNSD		;IF NOT, M-3
	ASL	A		;IF SO, M*2-5
MPNSD	TAX
	DEX			;MOVE COUNT TO X
;
ALCMPL	LDA	#$FF
ALCMAP	DEX
	BMI	SMBSIZ
	PHA
	JSR	DECCNT
	PLA
	ASL	A
	BNE	ALCMAP
	STA	MAPBUF+10,Y
	DEY
	BPL	ALCMPL		;BRANCH ALWAYS!
;
SMBSIZ	STA	MAPBUF+10,Y
	LDA	MAPBUF+3	;MARK EMPTY SIZE, TOO
	STA	MAPBUF+1
	LDA	MAPBUF+4
	STA	MAPBUF+2
	JSR	FMTMAP		;WRITE MAP TO DISK
;
;  CREATE AN EMPTY DIRECTORY
;
	LDA	#LOW[361]
	LDY	#HIGH[361]
CLRDIR	JSR	SETDIR		;RESET THE DIRECTORY BASE SECTOR
	TYA
CLRDLP	STA	DIRBUF,Y	;ZERO THE DIRECTORY BUFFER
	INY
	BNE	CLRDLP
;
	LDA	#7
	STA	DIRSEC
CLRDL2	JSR	WDIRBK		;THEN WRITE ALL 8 SECTORS OUT
	DEC	DIRSEC
	BPL	CLRDL2
	LDY	BUFNO,X
	LDA	#0
	STA	BUFNO,X
	STA	BUFFLG-1,Y	;FORMAT DONE, FREE THE INTERNAL BUFFER
	LDA	FMSBPT
	JMP	AEXIT
;
NOSECS	DW	35*18,40*18,80*18,77*26
;
SETDIR	STA	DIRBAS,X
	TYA
	STA	DIRBAS+1,X
	LDY	#0
	RTS
;
; DOS BINARY LOAD CODE (LOAD AND OPTIONALLY EXECUTE A PROGRAM)
;
DKLOAD	LDA	ICAX1Z
	STA	ICPTLZ		;SAVE PROGRAM NAME BUFFER POINTER
	CMP	#$08
	BCS	TOERRC		;IF WRITE, REPORT ERROR
;
	LDA	#LOW[TORTS]
	STA	RUNADR
	LDA	#HIGH[TORTS]	;ASSUME RUNN ADDRESS IS ABSENT
	STA	RUNADR+1
	LDA	#4
	STA	ICAX1Z
	LDA	ICHID,X		;IOCB OPEN?
	BPL	CCFILE
	JSR	DKOPEN		;IF NOT, OPEN IT
	BMI	DKLERV
	JSR	WDREAD		;READ ONE WORD OF THE HEADER
	BEQ	CCFILE
	LDY	#180		;NO $FFFF, HEADER ERROR CODE
	BMI	DKLERV
;
TOERRC	LDY	#168		;INVALID IOCB
	RTS
;
GETTXT	LDA	#LOW[TORTS]
	STA	INIADR
	LDA	#HIGH[TORTS]	;FOR EACH SEGMENT, RECLEAR THE INIT VECTOR
	STA	INIADR+1
TXTLP	JSR	DKREAD
DKLERV	BMI	DKLERR
	LDY	#0
	STA	(ICBALZ),Y
	INC	ICBALZ
	BNE	DECLEN
	INC	ICBAHZ
DECLEN	LDA	ICBLLZ
	BNE	DECLOW
	DEC	ICBLHZ
DECLOW	DEC	ICBLLZ
	BNE	TXTLP
	LDA	ICBLHZ
	BNE	TXTLP
	LDA	ICBAHZ
	CMP	#HIGH[INIADR]
	BNE	CCFILE
;
	LDA	ICPTLZ		;IF NO INITS,
	LSR	A
	BCS	CCFILE		;SKIP TO NEXT PAGE
	TXA			;ELSE SAVE IOCB
	PHA
	LDY	#256-12
CPSICB	LDA	ICHIDZ-256+12,Y
	STA	ICHID,X		;SAVE THE 12-BYTE IOCB ENTRY
	INX
	INY
	BNE	CPSICB
	PLA
	TAX
	PHA
	JSR	DOINIT		;AND CALL INIT FUNCTION
	PLA
	TAX
	PHA
	LDY	#256-12
CPRICB	LDA	ICHID,X		;THEN RESTORE THE 12-BYTE IOCB
	STA	ICHIDZ-256+12,Y
	INX
	INY
	BNE	CPRICB
	PLA
	TAX
;
CCFILE	JSR	WDREAD		;READ THE SEGMENT START ADDRESS
	BEQ	CCFILE
	STA	ICBALZ
	STY	ICBAHZ
	JSR	WDREAD		;READ THE SEGMENT END ADDRESS
	SEC
	ADC	#0
	BCC	CCSUBT
	INY
CCSUBT	SEC
	SBC	ICBALZ		;CALCULATE THE LENGTH TO LOAD INTO RAM
	STA	ICBLLZ
	TYA
	SBC	ICBAHZ
	STA	ICBLHZ
	BCS	GETTXT		;BRANCH IF VALID LENGTH (GET DATA BYTES)
	LDY	#181		;ELSE, MEMORY WRAP ERROR
	BMI	DKLERR
;
WDXIT	PLA
	PLA
DKLERR	TYA
	PHA
	JSR	DKCLOS		;CLOSE THE PROGRAM FILE
	PLA
	TAY			;AND RETURN ANY ERROR CODE
	RTS
;
;  READ A WORD FROM THE PROGRAM FILE AND COMPARE IT WITH $FFFF
;
WDREAD	LDA	#0
	STA	ICBLLZ
	STA	ICBLHZ		;SET LENGTH TO ZERO
	JSR	DKREAD		;READ A BYTE
	BMI	WDEOF
	PHA
	JSR	DKREAD		;READ THE SECOND BYTE
	BMI	WDEOF1
	TAY
	PLA
	CPY	#$FF		;UPPER BYTE $FF?
	BNE	TORTS		;NO, THEN WORD IS NOT $FFFF
	CMP	#$FF		;YES, IS LOWER BYTE $FF?
TORTS	RTS			;IF BOTH $FF, RETURN ZERO FLAG
;
WDEOF1	PLA
WDEOF	CPY	#136		;IS THIS END OF FILE?
	BNE	WDXIT		;IF NOT, RETURN ERROR CODE
	PLA
	PLA			;ELSE, GET RID OF RETURN ADDR
	LDA	ICPTLZ
	LSR	A
	LSR	A
	PHP
	JSR	DKCLOS		;CLOSE FILE AND SET Y=1
	PLP
	BCS	TORTS		;EXIT IF NO-RUN SPECIFIED
	JMP	(RUNADR)	;THEN GO TO RUN ADDRESS
;
;  INVOKE INIT FOR EVERY BLOCK OF INPUT CODE (USUALLY JUST AN RTS)
;
DOINIT	JMP	(INIADR)	;CALL INDIRECT
;
;  XIO FUNCTION TO CREATE A NEW DIRECTORY
;
;  PARSE DIRECTORY NAME
;
MKDIR	JSR	GETFNM
	JSR	SFDIR		;FIND FILE IN DIRECTORY
	BCS	MKDMRD
	LDA	#172		;FILE ALREADY EXISTS
	DB	$AE		;SKIP 2 BYTES
DISFUL	LDA	#169		;DIRECTORY FULL
	JMP	AEXIT
;
;  READ IN BIT MAP
;
MKDMRD	LDA	HOLFN
	BMI	DISFUL
	JSR	RBITMP
	LDY	MAPBUF
	DEY
	DEY
	STY	DATBYT
;
;  FIND EIGHT SECTORS FOR DIRECTORY
;
	LDA	#LOW[369]	;FIRST AVAILABLE SECTOR AFTER ROOT DIR.
	STA	CURSEC,X
	LDA	#HIGH[369]
	STA	CURSEC+1,X
	LDA	#0
	STA	TMP1
FDIRLP	INC	TMP1
	JSR	FNDLBIT		;IS THIS SECTOR FREE?
	BCS	FDIR2
	AND	MAPBUF,Y
	BCC	FDIR1
FDIR2	AND	MAPBUF+256,Y
FDIR1	BNE	FDIR3
	STA	TMP1
FDIR3	JSR	INCCSEC
	LDA	TMP1
	CMP	#8
	BNE	FDIRLP
;
;  ALLOCATE THE SECTORS USED
;
ALCDLP	JSR	DECCSEC
	JSR	FNDLBIT
	EOR	#$FF
	BCS	ALCPG2
	AND	MAPBUF,Y
	STA	MAPBUF,Y
	BCC	ALCPG1
ALCPG2	AND	MAPBUF+256,Y
	STA	MAPBUF+256,Y
	LSR	MAP2MOD
ALCPG1	JSR	DECCNT
	DEC	TMP1
	BNE	ALCDLP
;
;  WRITE ALLOCATION MAP BACK TO DISK
;
	JSR	FMTMAP
;
;  ENTER NAME AND TYPE INFO INTO PARENT DIRECTORY
;
	LDA	HOLFN
	JSR	SDIRBK
	SEC
	JSR	ENTNAME
	LDA	CURSEC+1,X
	STA	DIRBUF+4,Y
	LDA	CURSEC,X
	STA	DIRBUF+3,Y
	LDA	#0
	STA	DIRBUF+2,Y
	LDA	#8
	STA	DIRBUF+1,Y
	ASL	A
	JSR	SAVFLAG
;
;  THEN CLEAR NEW DIRECTORY
;
	LDA	#1
	STA	FMSBPT
	LDA	CURSEC,X
	LDY	CURSEC+1,X
	JMP	CLRDIR