;							>>B/S<<
;	LOGICAL DEVICE FUNCTIONS
;
; rev 02.10	6/22/80 krs
; REV 02.11	6/25/80 KRS
; rev 02.14	7/80 atrib byte
; rev 02.20	7/80 krs cp/2 et al
; REV 02.32	11/14/80 RLR SMALL SYS ERA ERR/big: free dir on 17
; Rev 02.33	12/22/80 KRS fix X-Disk Rename
; Rev 02.35	10/14/81 DEW macros added
; REV 02.37	2/82 KRS CLEANUP
; REV 02.39	6/82 SBW - Handle ? in disk byte (DOS 17 call)
;			   also defeat new block logic in NEWIDX
;
	icl	pdef		;02.39
	icl	df		;02.39
	df.dos			;02.39
	df.cpu			;02.39
	df.sys			;02.39
;
	NAM	FL237
;
C3VER	EQU	0	; 0 = NOT C3
;
	ENT	NAMFB,MULX,DIVX,ATBFL
	ENT	NMTCH,FCBDK,DRSCH
	ENT	NXDIR,DELFL,RENFL			;02.20
	ENT	CRFIL,XMTCH,GETDK,TRANS,ATRIX		;02.20
	ENT	NEWIDX					;02.37
;
	ext	getdre,xgetat,getatb,GETATX		;02.20
	EXT	SDT,DIRSIZ,ASDTE
	EXT	DIV16,MUL16,SETLOG
	EXT	DIRRD,URREG,DIRWR			;02.35
	EXT	SAVAF,MOVE,FREBK,GETCLS
	EXT	DIRCLR					;02.00
	EXT	FOPND					;02.01
	EXT	ZEROBY,ZMOVE				;02.01
	EXT	GETBK,CDKBK				;02.01
	EXT	FOPNDE					;02.03
	EXT	NEGHL,CLXBLK				;02.07
	EXT	GTSDT					;02.07
	EXT	BS2GFRE,BS2MBLK				;02.37
	ext	setdcd,cmphl				;02.20
	EXT	NEWBLK					;02.39
;
SPC	EQU	20H
DRLEN	EQU	32	; LEN OF DIR. ENTRY
;
    ifc SYSUCB=SINGLE					;02.35
	EXT	?UDEV,?USFB,?UDRB,?UBF1,?UDBF,?UBC	;02.35
	EXT	?UHL,?UDE,?UFCB
    elsec						;02.35
	EXT	ADUCB,SVCRG,RDUCB			;02.35
    endc						;02.35
;
FREEL	EQU	FCBEX	; FILE REEL (EXTENT)
FNXREC	EQU	FCBNR	; NEXT RECORD
	EJECT
;
; FORMAT FCB FROM STRING
;	@DE=FCB,@HL=NAME
;	=,/ ARE TERM. AS IS 0..20H
;
NAMFB:	PUSH	D	; SAVE FOR USER
;
	XCHG		; BLANK NAME INITIALLY
	PUSH	H
	MVI	M,0
	INX	H	; DISK:=0
	LXI	B,200BH	; B=SPC,C=11 CHARS
NAM1:	MOV	M,B
	INX	H
	DCR	C
	BRNZ	NAM1					;02.35
	POP	H
	XCHG
;
	MVI	B,8	; NAME HAS 8 CHARS
	MOV	A,M	; (**1.02**) IF NUL 
	ORA	A
	BRZ	NAM3	;THEN NONAME (DONE)		;02.35
	INX	H
	MOV	A,M
	CALL	TRANS	;* TRANSLATE TO UPPER CASE
	DCX	H
	CPI	':'
	BRNZ	NAM2	; IF NAME(2)=":"		;02.35
	MOV	A,M	; THEN PROCESS DISK NAME
	CALL	TRANS	;* TRANSLATE TO UPPER CASE
	SUI	'A'-1	; A=1,B=2..
	STAX	D
	INX	H
	INX	H
NAM2:	INX	D	; SKIP DISK NAME
	MVI	B,8	; 8 CHAR IN FILE NAME
NAM2A:	MOV	A,M
	CALL	TRANS	;* TRANSLATE TI UPPER CASE
	CPI	SPC+1
	JM	NAM3	; DONE IF <=SPC
	CPI	'/'
	BRZ	NAM3	; OR IF OPTION			;02.35
	CPI	'='
	BRZ	NAM3	; OR IF COMMAND			;02.35
	CPI	','
	BRZ	NAM3	; OR IF DELIMTER		;02.35
	CPI	'.'
	BRZ	NAM4	; HANDLE FILE TYPE		;02.35
	CPI	'*'
	BRZ	NAM5	; EXPAND ABIGIOUS REFERENCE	;02.35
;
	STAX	D	; JUST A LITTLE OLE CHAR
	INX	H
	INX	D
	DCR	B
	JP	NAM2A
;		NAME TOO LONG
NAM1E:	STC		; CY=1
	BR	NAM3A	; BUT DONE			;02.35
;
;	'.'=START OF FILE TYPE
NAM4:	INX	H	; SKIP '.'
	LXI	B,9	; MOVE PAST NAME
	XCHG
	POP	H
	PUSH	H	; GET & SAVE FCB
	DAD	B
	XCHG		; DE=FCB.FILE TYPE
	MVI	B,3	; TYPE IS 3 CHAR MAX
	BR	NAM2A					;02.35
;
;	*=ABIGIOUS REFERENCE
;
NAM5:	INX	H	; SKIP *
	MVI	A,'?'	; ACTUAL CHAR
	INR	B	; IN CASE=0
NAM5A:	DCR	B
	BRZ	NAM2A					;02.35
	STAX	D
	INX	D	; FILL REST OF NAME IN
	BR	NAM5A					;02.35
;
;	DONE
;
NAM3:	ORA	A	; CY=0 , OK
NAM3A:	POP	D
	PUSH	H
	LXI	H,FREEL
	DAD	D
	MVI	M,0	; EXTENT ZERO (PROBABLY)
	INX	H	;   2 BYTES
	MVI	M,0
	INX	H
	MVI	M,0	; DIR NUMBER TOO.
;
	LXI	H,FNXREC
	DAD	D
	MVI	M,0	; RECORD 0 (PROBABLY)
	POP	H
	SHLUCB	HL				;02.37
	RET					;02.37
;
;	USEFULL MATH MULT,DIV
;
DIVX:	CALL	DIV16
	SHLUCB	HL				;02.37
	SHLUCB	BC	; WHY??			;02.37
	SDEUCB	DE				;02.37
	RET					;02.37
;
MULX:	CALL	MUL16
	SDEUCB	DE				;02.37
	RET					;02.37
;
	EJECT
;
DERA	EQU	0E5H	; ERASED DISK VALUE
;
; NAME MATCH
;  ENTRY: @DE=FCB, A=0 START OF DIRECTORY
;		,A=N, BUFFER PRE-FILLED BLOCK(N-1)MOD 4
;         ( NMTCX WILL DO A:=A+1 BEFORE ACCESS)
;	USER BUFFER USED
;  EXIT: @HL=DIR ENTRY, A=BLOCK FND (-1=EOD)
;	@DE=FCB(UNCHANGED)
; ENTRY POINTS:
;	 XMTCH -* MATCH FOR EXISTING, EXTENT
;	 NMTCHN-* MATCH FOR EXISTING, NON PERMANENT
;	 NMTCH -* MATCH FOR EXISTING , NAME ONLY
;	 NMTCX - MATCH FOR NAME ONLY (ERASED OR NOT)
;
;  * = ONLY MATCHS ON FILES (ATRIB BYTE AND 7)=0
;
XMTCH:	CALL	NMTCH
	CPI	-1
	RZ		; NOT FOUND
;	TEST FOR PROPER EXTENT
; @DE=FCB / @HL=DIR ENTRY
	PUSH	D
	PUSH	H
	PUSH	PSW	; AF
	LXI	B,FCBEX
	DAD	B
	XCHG
	DAD	B
	LDAX	D	; IF FCB.EXTENT
	CMP	M	;  = DIR.EXTENT
XMTCH1:	POP	H
	MOV	A,H	; RESTORE A W/O FLAGS
	POP	H
	POP	D
	RZ		; THEN FOUND MATCH
	BR	XMTCH	; ELSE SEARCH ON, MACBETH	;02.35
;
NMTCHN:	CALL	NMTCX	; NON-PERMANENT FILES ONLY
	CPI	-1
	RZ
	PUSH	PSW
	MOV	A,M
	RLC
	BRNC	NMTH1	; EXIT IF NON-PERMAMENT		;02.35
	POP	PSW
	BR	NMTCHN					;02.35
;
NMTCH:	CALL	NMTCX	; FILES ONLY
	CPI	-1
	RZ		; NOT FOUND AT ALL/GIVE UP
	PUSH	PSW
	MOV	A,M
	ANI	1
	BRZ	NMTH1					;02.35
	POP	PSW	; IF NOT FILE
	BR	NMTCH	; THEN KEEP SEARCHING		;02.35
;
NMTH1:	POP	PSW	; ELSE GOOD
	RET
;
NMTCX:	INR	A
	MOV	B,A	;##00.31
	CALL	DIRSIZ	; NUMBER OF DIR ENTRIES
	CMP	B
	BRGE	NMTC4					;02.35
	MVI	A,-1	;A:=-1, NOT FOUND
	RET
;   NEXT ENTRY
NMTC4:	MOV	A,B
	PUSH	PSW	;SAVE ENTRY NO.
	PUSH	D	;AND BLOCK
	CALL	FCBDK	; REAL READ (B:= DISK FROM FCB)	 02.01
	CALL	DIRRD					;02.01
;
;  RETURNS @HL= DIRECTORY ENTRY
;	ACCEPT ANY ERASED ENTRIES
;
	POP	D
NMT2:		; NEXT ENTRY/SAME BLOCK
	PUSH	D
	PUSH	H
	INX	H	;SKIP 1ST BYTES
	INX	D
; DE=@FCB; HL=@DIR ENTRY
	MVI	B,11	;11 CHARS
NMT3:	LDAX	D
	ANI	7FH	; FCB LSB'S ONLY		 02.01
	CPI	'?'
	BRZ	NMT3A	;AMBIGUOUS REFERENCE		;02.35
	MOV	C,A	; DIR LSB'S ONLY		 02.01
	MOV	A,M					;02.01
	ANI	7FH					;02.01
	CMP	C					;02.01
	BRNZ	NMT3B	;NO MATCH			;02.35
NMT3A:	INX	H
	INX	D
	DCR	B
	BRNZ	NMT3					;02.35
;
;  FALL THRU ONLY ON MATCH
;
	POP	H	;HL:= DIR. ENTRY
	POP	D	;DE:=FCB
	POP	PSW	;A:=DIR ENTRY NUMBER
	RET
;
NMT3B:	POP	H
	POP	D
	POP	PSW	;DO NEXT ENTRY
	MOV	B,A	; IF (NEXT ENTRY-1)MOD 4=0
	MVI	C,3
NMT3C:	ANA	C
	MOV	A,B
	BRZ	NMTCX	; THEN READ NEXT NEW BLOCK	;02.35
; SAME DIRECTORY BLOCK
	INR	A
	PUSH	PSW
	LXI	B,DRLEN	; @ HL:=
	DAD	B	;   NEXT ENTRY
	BR	NMT2					;02.35
; GET DISK FROM A TO 'B'
; INPUT - A CONTAINS DISK NUMBER
; OUTPUT - B CONTAINS DISK NUMBER
;
GETDK:	PUSH	PSW	;SAVE PSW
	BR	FCD3					;02.35
;
;  GET DISK FROM FCB (@DE) TO 'B'
;
FCBDK:	PUSH	PSW
	LDAX	D
	CPI	'?'	; Question mark for 17 call?	;02.39
	BRNZ	..1					;02.39
	XRA	A	; Yes: use current.		;02.39
..1:							;02.39
;
FCD3:	ANI	0FH	;#.32 CLEAR PROTECT FLAGS
	MOV	B,A
	LDA	SDT	; (@SDT=# OF DRIVES)
	CMP	B	; ##00.31
	BRLT	FCD2	; AND < # OF DSKS		;02.35
;
	MOV	A,B
	DCR	B	;1=A, 2=B SHIFT TO 0=A...
	ORA	A
	BRNZ	FCD1	;EXPLICIT DISK REQ		;02.35
FCD2:	PUSH	H
	PUSH	B
	LHLUCB	DEV	;ELSE GET CURRENT DISK			;02.35
	POP	B
	MOV	B,L
	POP	H
FCD1:	POP	PSW
	RET
	EJECT	
;
;  DIRECTORY SEARCH FOR NAME (17) FROM BEGINNING
;  ENTRY: @DE=FCB
;  EXIT:  A= DIR ENTRY OR 255, @HL=ENTRY
;   (17)/(18) WILL FIND DELETED ENTRIES
;	SYSTEM USES -1,1..64 BUT RETURNS
;  -1..63 FOR CPM COMPATABILITY
;  IF BYTE 0='?' THEN MATCH DELETED
;  IF BYTE 12='?' THEN MATCH ANY EXTENT
;
DRSCH:	CALL	SETLOG	;(*01.01*) SETUP DISK & A:=0
	SDEUCB	SFB	;SAVE FCB FOR 'SEARCH NEXT'
	lhld	urreg	; for comparison on big		;02.15
	lxi	b,urfcb+33	;directory		;02.15
	dad	b	; searches			;02.15
	mvi	m,0ffh	;null out chain fcb entry #	;02.15
;
; SET UP CSDTE POINTER FOR SEARCH
;	(REV 1.01)
; A:=NEXT ENTRY TO SEARCH AT
;
DRSC0:	CALL	FCBDK	; B:=DISK SPECIFIED
	CALL	ASDTE	; CSDTE:=SDT[DISK]
;
DRSC1:	CALL	NMTCX
	PUSH	H
	ADRUCB	DRB						;02.35
	MOV	M,A	;UCB.DRB:=CURRENT DIRECTORY ENTRY
	POP	H
	CPI	-1	; EXIT IF -1 (EO DIR)
	jeq	savaf	;02.32    if no more entries
	PUSH	PSW
; IF @FCB='?' OR (DIR.MSBY AND 7)=0
	LDAX	D
	CPI	'?'
	BREQ	DRSC2					;02.35
	MOV	A,M
	ANI	1
	BRZ	DRSC2					;02.35
	POP	PSW	; NEXT
	BR	DRSC1					;02.35
; IF EXTENT(12) MATCH OR FCB.EXT='?'
DRSC2:	PUSH	H
	PUSH	D
;	code moved down several lines			 02.15
	LXI	B,FCBEX	
	XCHG
	DAD	B
	MOV	A,M	
	CPI	'?'
	BREQ	DRSC4					;02.35
	XCHG
	DAD	B
	CMP	M
	BREQ	DRSC4					;02.35
	POP	D
	POP	H	; ELSE NEXT
	POP	PSW
	BR	DRSC1					;02.35
;
;
; THEN MATCH
DRSC4:
	POP	D
	POP	H
	SHLUCB		HL				;02.37
	pop	psw	;rel to zero			 02.15
	dcr	a	; and 0-3 only			;02.15
	ani	3	;now all regs ready		;02.15
	SAFUCB						;02.37
;
; MOVE BLK TO USER BUFFER
	LHLUCB	BF1					;02.35
	XCHG
	LHLUCB	DBF					;02.35
	PUSH	H	;SAVE USER BUFF ->		 02.07
	PUSH	D	;SAVE SYS  BUFF ->		 02.07
	LXI	B,128
	CALL	MOVE
	LHLUCB	HL					;02.37
	XCHG						;02.37
	POP	H	;OUR BUFF ->			 02.07
	CALL	NEGHL	;FOR SUBTRACTING		 02.07
	DAD	D	;				 02.07
	POP	D	;HIS POINTER			 02.07
	DAD	D	;ADJUSTED			 02.07
	XCHG			;02.37
	LDAX	D		;02.37
	MOV	H,A		;02.37
	ANI	1		;02.37
	BRNZ	NOXGT		;02.37
	MVI	L,0		;02.37
	CALL	XGETAT		;02.37
	XRA	A		;02.37
	STAX	D		;02.37
NOXGT:	JSDEUCB	HL		;02.37
	EJECT
;
;  NEXT DIRECTORY ENTRY (18)
;  PARAMETERS AS PER 'DRSCH'
;   USE PREV FCB (FOR CPM COMPAT.)
;	SAVE IN UCB.SFB BY SEARCH
;
NXDIR:	LHLUCB	SFB	; READ PREVIOUS ENTRY RETURNED		;02.35
	XCHG		; DE:=UCB.LAST SERACH FCBFCB
	LHLUCB	DRB
	MOV	A,L	; A:=UCB.DIR BLK LAST FND
	JMP	DRSC0
;
;  UPDATE DIRECTORY ENTRY (80H+7)
;	@DE=DISK(AS PER FCB)
;
;	ROUTINE REMOVED AND CALL MADE ILLEGAL		 02.20
;
	EJECT
;
;  DELETE FILE (19)
;  ENTRY:  @DE=FCB
;  EXIT: A = NUMBER OF DIRECTORY ENTRIES DELETED
DELFL:	CALL	SETLOG	; (*01.02*) SET DISK & A:=0
	PUSH	PSW	; INIT COUNT
DELF1:	CALL	NMTCHN
	CPI	-1
	BRNZ	DELFA	; NOT THRU YET			;02.35
; RECOVER COUNTER
RCVCNT:	CALL	FCBDK	;GET DISK			 02.07	
	CALL	DIRCLR	; CLEAR DIR FUNCTIONS		 02.00
	POP	PSW	; GET last one found or 0	 02.20
; a is 0 or dir rec entry number
	dcr	a	;from 0 to -1, or to entry #	 02.20
	cpi	0ffh	;return if failure		 02.20
	jz	savaf					;02.20
	ani	3	;else return 0,1,2,3		 02.20
	JMP	SAVAF	; WHICH WILL RETURN TO CALLER	 02.20
;
DELFA:	PUSH	D	;SAVE FCB
	PUSH	PSW	;SAVE ENTRY NO.
	MOV	A,M	;GET DIR FLAGS
	MVI	M,DERA	;MARK BLOCK DELETED
	LXI	B,16
	DAD	B	;TO DM
	CALL	FCBDK	;B=DISK
	MVI	C,16	;NO. ENTRIES TO DEALLOCATE
DELF1A:	MOV	E,M	;GET LOW CLUSTER BYTE
	XRA	A	:02.32 CLEAR A FOR TEST AND
	MOV	D,A	;CLEAR HIGH
	ORA	E	;ALLOCATED?
	BRNZ	DELF2	;YES...				;02.35
	BR	DELF2A	;NO...				;02.35
DELF2:	PUSH	H	; SAVE DM
	CALL	FREBK	; FREE THE CLUSTER
	POP	H
DELF2A:	INX	H	; NEXT DM
	DCR	C
	BRNZ	DELF1A					;02.35
	POP	PSW
	POP	D
	PUSH	D
	PUSH	PSW
	CALL	DIRWR	; UPDATE DIR			 02.00
	POP	PSW
	POP	D
	POP	B	; last one found
	PUSH	psw	; SAVE dir entry number		 02.20
	BR	DELF1	; FIND NEXT EXTENT		;02.35
	EJECT
;
;  RENAME FILE (23)
;  ENTRY: @DE=FCB WHERE:0..15 = OLD NAME
;		16..32= NEW NAME
; EXIT: A = NUMBER OF DIRECTORY ENTRIES RENAMMED
;
; ALLOWS AMBIGIOUS RENAME BY NOT MOVING '?'
;   IN NEW NAME TO OLD NAME (BUT SEARCHS ON OLD NAME!)
; TESTS FOR GLOBAL NEW NAME EXISTANCE
;
;
RENFL:	CALL	SETLOG	; (*01.02*) SET DISK & A:=0
	PUSH	PSW	; INIT COUNTER
; TEST FOR EXISTING NEW NAME (##00.32)
	PUSH	D
	LDAX  	D	; 02.33
	LXI	H,16
	DAD	D
	XCHG
	STAX	D	; 02.33
   	XRA	A	; 02.33
	CALL	NMTCH
	POP	D
	CPI	-1	; IF FOUND
	BRNZ	RCVCNT	; THEN NO RENAME		;02.35
	XRA	A
;
RENF1:	CALL	NMTCHN
	CPI	-1	; IF END OF DIR
	BREQ	RCVCNT	; THEN RECOVER CNTR & FINISH	;02.35
;
RENFA:	PUSH	D
	PUSH	PSW
	LXI	B,17
	XCHG
	DAD	B
	XCHG		; @DE=NEW NAME
	INX	H	; @HL=OLD DIR ENTRY
	MVI	B,11
; @DE->@HL , BUT DON'T MOVE '?' (FOR AMBIGIOUS REF)
RENF2:	LDAX	D	; REPEAT
	CPI	'?'
	BRZ	RENF3	; IF @DE<>'?'			;02.35
	MOV	M,A	; THEN @HL:=@DE
RENF3:	INX	H
	INX	D	; HL+1,DE+1
	DCR	B
	BRNZ	RENF2	; UNTIL B=0			;02.35
;
	POP	PSW	;  ONLY NAME.TYP [1..11]
	POP	D
	PUSH	D	; RESTORE FCB/TO SET DISK
	PUSH	PSW
	CALL	DIRWR	;02.00: UPDATE ENTRY
; TRY FOR NEXT EXTENT
	POP	PSW
	POP	D
	POP	B	; get previous one		 02.20
	PUSH	psw	; save dir pointer		 02.20
	BR	RENF1					;02.35
	EJECT
; SET ATRIBUTES - CP/M-TYPE 30 CALL -NAME HIGH BITS	 02.20
;							;02.20
ATRIX:	LXI	H,9	; ADDRESS T1			 02.20
	DAD	D	; IN FCB			 02.20
	MOV	A,M					;02.20
	RRC		; W BIT TO POSITION		 02.20
	ANI	40H	; CLEAR REST			 02.20
	MOV	C,A	; SAVE IT			 02.20
	INX	H					;02.20
	MOV	A,M					;02.20
	RRC						;02.20
	RRC						;02.20
	RRC						;02.20
	RRC		; S BIT TO POSITION		 02.20
	ANI	08H	; CLEAR REST			 02.20
	ORA	C	; ADD R BIT			 02.20
	MOV	B,A	; FOR FALL THRU			 02.20
; FALL THRU TO ATBFL ENTRY POINT			 02.20
;							 02.20
; SET ATTRIBUTE (##00.32)
;
; ENTRY: @DE=FCB, B=NEW ATRIB
; ATRIB ARE [PWRU/S00+]
; IF '+' SET THEN 'OR' NEW ATRIB
;	INSTEAD OF REPLACE
;
ATBFL:	CALL	SETLOG	; (*01.02*) SET DISK & A:=0
	MOV	C,B	; C:=NEW ATRIB
	MOV	B,A	; B=COUNT(0)
	PUSH	B	; INIT CNT
;
ATBFL1:	CALL	NMTCH	; GET A FILE
	CPI	-1	; IF END OF DIR
	JZ	RCVCNT	; THEN RECV CNT & FINISH
;
	POP	B
	push	b					;02.21
	PUSH	AF	; SAVE DIR PTR
	MOV	A,C					;02.10
	RRC
	MOV	A,C
	BRNC	ATBFL2					;02.35
; IF LSB=SET THEN OLD 'OR' NEW
	ORA	M
ATBFL2:	ANI	0FEH	;CLEAR 'OR' BIT
	MOV	M,A
	POP	PSW	; A - DIR PTR
	pop	b					;02.21
	mov	b,a	; put in b as needed		 02.20
	PUSH	B	; SAVE CNT / ATRIB
	PUSH	PSW
	PUSH	D	; DIR PTR ANS FCB
	CALL	DIRWR	; UPDATE DIR			 02.00
	POP	D
	POP	PSW
	BR	ATBFL1					;02.35
	EJECT
;
;
;  CREATE DIRECTORY ENTRY (22)
;  ENTRY:  @FCB=DE
;  EXIT:  A=DIR ENTRY OR 255
;	255=NO ROOM OR DUPLICATE ENTRY
;
CRFIL:	CALL	SETLOG	; (*01.02*) SET DISK & A:=0
	CALL	FOPND	; OPEN DIR ENTRY		 02.01
	BRNC	CRFI1	;	BC=USER EXTENT REQ.	 02.01	;02.35
;		c=z is found, so error			 02.10
;		c set not found hl=0, no dir entry	 02.10
;			hl not 0, entry but no extent	 02.10
;IF NOT FOUND THEN CREATE EXTENT (02.01)
	PUSH	B					;02.01
	CALL	CRFDRE					;02.01
	POP	B					;02.01
	RC		; IF CAN'T THEN ERROR		 02.01
;
	BR	CRFLOK					;02.10	;02.35
; ELSE (FOUND) THEN					 02.01
;	code deleted here			     rev 02.10
CRFI1:	MVI	A,-1	; THEN ERROR			 02.01
	STC						;02.01
	BR	CRFLDN					;02.01	;02.35
;
CRFLOK:	XRA	A	;  CREATE WAS OK		 02.01
;
CRFLDN:	PUSH	AF	;  CREATE DONE (A,CY=STATE)	 02.01
	CALL	FCBDK					;02.07
	CALL	DIRCLR	; (LET DIR BUFF GO)		 02.01
	POP	AF	; GET FLAGS			 02.01
	RET						;02.01
	EJECT
;
; CREATE DIRECTORY ENTRY(02.01)
;
;
CRFDRE:	PUSH	D					;02.01
	MVI	A,1
	CALL	FCBDK
CRF1:							;02.01
	PUSH	B
	PUSH	PSW
	CALL	DIRRD	;READ DIRECTORY BLOCK
CRF2:	MOV	A,M
	CPI	DERA
	BRZ	CRF3	;DELETED ENTRY FOUND		;02.35
	LXI	B,32
	DAD	B
CRF2B:	POP	B	; B=DIR ENTRY #
	INR	B
	CALL	DIRSIZ	;##00.31
	CMP	B
	BRGE	CRF4					;02.35
; AT THE END OF DIR (NO ROOM)
	POP	B
;	EXTRANEOUS POP H DELETED			 02.29
	POP	D	;*
;
CRF2A:	CALL	DIRCLR	; CLEAR DIR FUNCS.		 02.00
	MVI	A,-1	; NO ROOM
	SAFUCB						;02.35
	STC		; CY=ERROR			 02.01
	RET
; NEXT ENTRY
CRF4:	PUSH	B
	MVI	C,3
CRF4A:	MOV	A,B	;RESTORE ENTRY NO.
	DCR	A
	ANA	C
	BRNZ	CRF2	;TRY NEXT ENTRY/SAME BLK	;02.35
	POP	PSW
	POP	B	;NEXT BLK
	BR	CRF1					;02.01	;02.35
;  @HL= ENTRY FOUND/CLEAR FCB
CRF3:	POP	PSW
	CALL	setdcd	;UCB.AF:=DIR ENTRY		 02.20
	POP	B
	POP	D	; @DE:=FCB			 02.01
	PUSH	B	:B=DISK
;	push deleted here				 02.14
;  CLEAR ENTRY
	PUSH	H
	PUSH	PSW	;A=DIR ENTRY			 02.14
	PUSH	D
;
	MVI	M,0	; DIR ENTRY[0]:=0
	INX	H
;	DIR ENTRY.NAME..EXTENT:=FCB.NAME..EXTENT
	INX	D	;DIR ENTRY (1..12):=
	LXI	B,12
	CALL	MOVE	;FCB.NAME (1..12)
;	CLEAR FCB,DIR ENTRY[13..32] / EXT+1 .. DM'S
;----------02.36 MOVE IN OWNER NUMBER ------
CLR$LEN	EQU	32-13	; [13..32] (ORIGINAL)		;02.01
;-----------END 02.36------------------------
;	CLEAR FCB,DIR ENTRY[13..32] / EXT+1 .. DM'S
	MVI	B,CLR$LEN				;02.36
	CALL	ZEROBY	; CLEAR DIR.DM			 02.01
	XCHG						;02.01
	MVI	B,33-13	; CLEAR FCB.DM			 02.01
	CALL	ZEROBY	;   AND FCB.NR			 02.01
	XCHG		; PUT PTRS BACK RIGHT		 02.01
;  IF BIG DIR CLEAR THE REST OF THE DM			 02.01
;
	CALL	DIRWR	; UPDATE DIRECTORY		 02.01
	POP	D	; DE=@FCB			 02.01
	pop	h	; get psw - dir entry # in h	 02.14
	mov	l,h	; and now in l			 02.14
	mvi	h,0	; say no attributes		 02.14
	call	xgetat	; go get slot			 02.14
	POP	H	; @DIR ENTRY			 02.01
	POP	B	; B=DISK NUMBER			 02.01
	ORA	A	;				 02.01
;
; DE=@FCB, A=DIR ENTRY#, HL=@DIR ENTRY, B=DISK NUMBER	 02.01
	RET		; zero, NO ERROR
	EJECT
;
;	GET A NEW INDEX CLUSTER				 02.01
;	ENTER B=DISK					 02.01
;	RTNS:	A=0,NO CY  OK				 02.01
;		HL=BUFFER WITH BLOCK(IN SYS BUFF 2)	 02.01
;		BC=CLUSTER NUMBER			 02.01
;		A=-1,CY    NO MORE SPACE		 02.01
;
NEWIDX:							;02.01
	PUSH	B					;02.01
	CALL	GETBK					;02.01
	POP	B					;02.01
	ORA	A					;02.01
	STC		;  CY=1 ERROR			 02.01
	RNZ		; NO MORE ROOM			 02.01
; SET UP UCB.FCB LIKE 1 CLUSTER FCB WITH		 02.01
;  NEW CLUSTER IN IT TO CLEAR IT.			 02.01
NEWSML:	PUSH	D					;02.01
	PUSH	D	; SAVE CLUSTER IN ACTION	 02.01
	ADRUCB	FCB					;02.35
	INR	B					;02.01
	MOV	M,B	; DISK NUMBER(FCB FORMAT)	 02.01
	XCHG						;02.01
	LXI	H,FCBEX					;02.01
	DAD	D	; FCB.EXTENT .. DM[3]	 	 02.01
	MVI	B,8	;  (8 BYTES)			 02.01
	CALL	ZEROBY	; := 0'S			 02.01
	LXI	H,FCBRC	;  FCB.RC:=128			 02.01
	DAD	D					;02.01
	MVI	M,128	; (FULL EXTENT)			 02.01
	INX	H					;02.01
	POP	B	; FCB.DM[0..1]			 02.01
	MOV	M,C	;  := CLUSTER BEING CLR'D	 02.01
	INX	H					;02.01
	MOV	M,B					;02.01
	LXI	H,FCBNR	; FCB.NXT REC :=1		 02.01
	DAD	D					;02.01
	MVI	M,1					;02.01
	CALL	BS2GFRE ; GET A FREE BUFFER		 02.01
	PUSH	H	; SAVE TOP=BUFF, NEXT=CLUSTER	 02.01
	MVI	B,128					;02.01
	CALL	ZEROBY	; ZERO BLK BUFFER		 02.01
	EJECT	
;
;02.01 ZERO OUT WHOLE CLUSTER, DO 1..N THEN BLK 0 LAST
;02.01  USING MRK AND DELAYED WRITE
;02.01  MARK WILL FLUSH PREVIOUS MODIFIED BLOCK
;02.01  BUT LAST TIME THRU LEAVES BLOCK UNWRITTEN
;02.01  SO CAN ADD DATA CLUSTERS POINTERS & NOT WRITE IT TWICE
;02.01  MUST USE BS2RLSE OR BS2WRTE WHEN DONE.
;
	LXI	H,FCBNR	;02.01
	DAD	D	;02.01 HL=@FCB.NR
     .DO		;02.01
	PUSH	H	;02.01
	PUSH	D	;02.01 SAVE FCB
	CALL	CDKBK	;02.01 GET DISK BLK NUMBER
	POP	D	;02.01	EXIT ON NEXT CLUSTER
	BRNC	.NEXT	;02.01  =0 SO UN ALLOCATED	;02.35
;
	POP	H	;02.01 THEN DO REC=0
	MVI	M,0	;02.01
	PUSH	H	;02.01
	PUSH	D	;02.01
	CALL	CDKBK	;02.01	 AND RECALC BLK NUM
	POP	D	;02.01
;
     .NEXT
	PUSH	D	;02.01	DO ACTUAL MARK & DWRT
	CALL	FCBDK	;02.01 UNIT=B
	XCHG		;02.01 BLK=(C,D,E)
;
	XRA	A	; Make extra sure that NEWBLK doesn't	;02.39
	STA	NEWBLK	; screw up flushes			;02.39
;
	CALL	BS2MBLK	;02.01  MARK NULLED BLK AS VALID/MODIFIED
;
	POP	D	;02.01 GET FCB BACK
	POP	H	;02.01  AND FCB.NR +=1
	MOV	A,M	;02.01 LAST TIME THRU
	INR	M	;02.01
	ORA	A	;02.01  IS REC=0
	BRNZ	.DO	;02.01				;02.35
     .UNTIL		;02.01
;
	POP	H	;02.01 HL=BUFF (ALSO SYS BUF 2)
	POP	B	;02.01 BC=CLUSTER NUM
	XRA	A	;02.01 A=0,NOT CY:  OK
	RET		;02.01 DONE
	EJECT
;
;02.01	SHUFFLE TO BIG FILE
;02.01		PARM:	DE=FCB
;02.01		RTN:	SAME (A=-1,CY OUT OF SPACE), HL=BUFF
	EJECT
;*
;* TRANSLATE LOWER CASE TO UPPER CASE
;* INPUT - A CONTAINS CHARACTER
;* OUTPUT - A CONTAINS CHARACTER
;*
TRANS:	ANI	7FH	;02.00: LSB'S ONLY
	CPI	'a'	;* Q, UPPER CASE		;02.37
	rlt		;* YES, DO NOT TRANSLATE	;02.37
	cpi	'z'+1					;02.37
	rge						;02.37
	ANI	5FH	;* FORCE TO UPPER CASE
	RET		;*
	EJECT
; FREE CLUSTERS POINTED TO BY INDEX CLUSTER	02.07K
; ROUTINE ADDED AT CHANGE LEVEL 02.07K
;
	END
