;							>>B/S<<
;	LOGICAL DEVICE FUNCTIONS
;
; 02.10 06/22/80 krs
; 02.11 06/25/80 KRS
; 02.14 07/??/80 atrib byte
; 02.20 07/??/80 krs cp/2 et al
; 02.32 11/14/80 RLR SMALL SYS ERA ERR/big: free dir on 17
; 02.33 12/22/80 KRS fix X-Disk Rename
; 02.35 10/14/81 DEW macros added
; 02.37 02/??/82 KRS CLEANUP
; 02.39 06/??/82 SBW Handle ? in disk byte (DOS 17 call)
;			   also defeat new block logic in NEWIDX
; 02.42 12/08/82 sbw 8MB bug, break into FL and FL1
;
	icl	pdef		;02.39
	icl	df		;02.39
	df.dos			;02.39
	df.cpu			;02.39
	df.sys			;02.39
;
	NAM	FL1242
;
C3VER	EQU	0	; 0 = NOT C3
;
	ENT	CRFIL,TRANS			;02.20		;02.42
	ENT	NEWIDX					;02.37
;
	ext	getdre,xgetat,getatb,GETATX		;02.20
	EXT	DIRSIZ						;02.42
	EXT	MUL16,SETLOG					;02.42
	EXT	DIRRD,URREG,DIRWR			;02.35
	EXT	SAVAF,MOVE,FREBK				;02.42
	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	fcbdk,sysdir,bldatr				;02.42
	IFC	C3VER					;02.37
	EXT	OWNRNO					;02.36
	ENDC
	EXT	NEWBLK					;02.39
;
    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
;
	EJECT
;
;
;  CREATE DIRECTORY ENTRY (22)
;  ENTRY:  @FCB=DE
;  EXIT:  A=DIR ENTRY OR 255
;	255=NO ROOM OR DUPLICATE ENTRY
;
CRFIL:
	call	sysdir		; Does FCB refer to SYS.DIR?	;02.42
	mvi	a,-1						;02.42
	jz	savaf		; Indicate duplicate if so	;02.42
;
	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)
;
DERA	EQU	0E5H	; ERASED DISK VALUE
;
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	;*
;
	CALL	DIRCLR	; CLEAR DIR FUNCS.		 02.00	;02.42
	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
;
	call	bldatr	; Get attribute byte reflected by FCB	;02.42
	ani	^atra	; (clear archive bit)			;02.42
	mov	m,a	; Put attribute byte into dir entry	;02.42
	push	af						;02.42
;								;02.42
	mvi	b,12						;02.42
  .do								;02.42
	inx	d						;02.42
	inx	h						;02.42
	ldax	d	; Move filename into			;02.42
	ani	7fh	;	directory entry, clearing	;02.42
	mov	m,a	;	attribute high bits.		;02.42
	dbrnz	.do						;02.42
  .until							;02.42
	ldax	d	; Move extent number into directory	;02.42
	mov	m,a	;	entry, assuming high byte 0!	;02.42
	inx	d						;02.42
	inx	h						;02.42
;
;	CLEAR FCB,DIR ENTRY[13..32] / EXT+1 .. DM'S
;----------02.36 MOVE IN OWNER NUMBER ------
      IFC	C3VER					;02.37
	LDA	OWNRNO					;02.36
	MOV	M,A					;02.36
	INX	H					;02.36
CLR$LEN	EQU	32-14	; [14..32] / DIR,RC,DM'S	;02.36
      ELSEC						;02.36
CLR$LEN	EQU	32-13	; [13..32] (ORIGINAL)		;02.01
      ENDC						;02.36
;-----------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
;
	CALL	DIRWR	; UPDATE DIRECTORY		 02.01
	pop	af	; AF = Attribute byte			;02.42
	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
	mov	h,a	; Attribute byte			;02.42
	call	xgetat	; Go expand attributes into FCB		;02.42
	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
;*
;* 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		;*
;
	END
