;							>>B/S<<
;	FILE I/O
;	READ/WRITE FILES
; 02.20 krs 07/??/80
; 02.35 dew 10/??/81 Z80 CODE
; 02.37 krs 02/??/82 subdirs
; 02.38 KRS 04/??/82 XXUSER EXT CAPABILITY
; 02.39 SBW 06/??/82 PLINK bug, also NEWBLK logic
; 02.42 sbw 12/13/82 Comments, prevent extend of SYS.DIR
;
	icl	pdef		;02.39
	icl	df		;02.39
	df.dos			;02.39
	df.cpu			;02.39
	df.sys			;02.39
;
	NAM	FL3242
;
	ENT	RDFIL,WRFIL,PLINK
	ENT	NEGHL,CDKBK
	ENT	CLXBLK					;02.07
	ent	readnv,writnv				;02.20
	ent	ranrd,ranwr,cfsiz,ranst			;02.20
	ent	wrrzf					;02.37
;
	EXT	FOPN,FCLOS				;02.00
	EXT	DIRSIZ,DIRCLS,SETLOG
	EXT	XMTCH,MOVE,FCBDK
	EXT	GETBK,SAVAF,STCLC
	EXT	URREG,SYSBOT,CONPRY			;02.20
	EXT	DSKIO,LOGDK,CRFIL			;02.35
	EXT	GTSDT,ASDTE,GETCLS,MUL16
	EXT	CWPIM,ERMSG				;02.35
	EXT	DIV16,GDIRST
	EXT	DIRRD,DIRWR,DIV32,MUL32 		;02.00
	EXT	DIRCLR,ZMOVE,FCLOSL			;02.02
	ext	getdre,getath,getatb,getatx		;02.15
	EXT	NMTCH,CMPHL				;02.20
	ext	newidx,bs2wrt				;02.37
	EXT	XXUSER					;02.38
	ext	sysdir						;02.42
;
EOF	EQU	1AH	; FAKE FILL ON LAST FILE READ
;
    ifc SYSUCB=SINGLE
	EXT	?UDBF,?UDE,?UFCB,?UFCB1,?UFCB33,?UABT,?UPRC
	EXT	?UPSW,?UHL
    elsec
	EXT	RDUCB,ADUCB
    endc
;
RECNT	EQU	FCBRC
NXREC	EQU	FCBNR
	EJECT
;
RDINR	EQU	5	;READ(INTERLEAVED)
;
;  read without advance (98h) and			 02.20
;  READ FILE BLOCK (20)
;  ENTRY: @DE=FCB
;  EXIT:  A=0, OK READ
;		=1,EOF
;		=2, UNWRITTEN RANDOM DATA
readnv:	stc						;02.20
	BR	RDFILX					;02.20	;02.35
RDFIL:	stc						;02.20
	cmc	; zero carry				 02.20
RDFILX:	PUSH	PSW					;02.20
	lxi	h,8					;02.37
	dad	d	; access 'r' bit		 02.37
	mov	a,m					;02.37
	rlc						;02.37
	brc	RDF0A	;02.01 THEN ACT AS IF EOF	;02.37
;
	LXI	H,NXREC
	DAD	D
	MOV	A,M	; GET NXREC (DO-DO)
	CPI	80H	; IF NXREC=80H
	BRNZ	RDF0					;02.35
; THEN OPEN NEXT EXTENT
	MVI	M,0	; FCB.NR:=0
	CALL	NXEXT	; ADVANCE TO NEXT EXTENT	 02.00
	BRNC	RDF0	; IF ERROR			 02.01	;02.35
	MVI	A,-1	; THEN EXT. NOT FOUND		 02.01
	BR	RDF3					;02.01	;02.35
;
RDF0:	LXI	H,RECNT	;IF RECNT<NXREC
	DAD	D
	MOV	A,M
	DCR	A
	LXI	H,NXREC
	DAD	D	;(HL=@NXREC)
	CMP	M
	JP	RDF1	; THEN EOF PROC.		 02.01
RDF0A:	MVI	A,1	; EOF ERR(1)			;02.01
	BR	RDF3					;02.01	;02.35
;
RDF1:	PUSH	D
	CALL	CDKBK	;CALC. DISK BLK (HL)
	POP	D
	MVI	A,2	; A=FLAG UNWRITTEN
	BRC	RDF3	; IF NOT ALLOCATED		;02.35
;  	ACCESS DISK BLOCK (HL)
RDF2:	PUSH	D	;@DE=FCB
	MVI	A,RDINR
	CALL	ADKBK
	POP	D	; GET FCB
	push	psw					;02.37
	pop	h	; save return code		 02.37
	pop	psw	; get original call type	 02.20
	push	psw					;02.20
	push	h					;02.37
	BRc	rdf2a	; if carry, no advance		;02.20	;02.35
	LXI	H,FCBNR
	DAD	D
	INR	M	; FCB.NR+1
rdf2a:	pop	psw	; return code			 02.37
;
RDF3:	pop	h	; clear flag on stack		 02.20
	jSAFUCB		;02.01 SAVE RETURN CODE(FROM A)	;02.35
;
;02.01 LABEL RDF4 REMOVED
;
; ADVANCE TO NEXT EXTENT
;
NXEXT:	call	fclosl	; just in case of random-ish	 02.20
	LXI	H,FCBEX
	DAD	D
	MOV	C,M
	INX	H
	MOV	B,M
	INX	B	; FCB.EXT += 1
	MOV	M,B
	DCX	H
	MOV	M,C
	CALL	FOPN
	RET
;
; loaad original c reg into a			 	 02.20
;	
	eject
;****************************************************	 02.20
;*****						*****	 02.20
;*****  RANRD (READ RANDOM RECORD)	33	*****	 02.20
;*****	RANWR (WRITE RANDOM RECORD)	34	*****	 02.20
;*****	CFSIZ (COMPUTE FILE SIZE)	35	*****	 02.20
;*****	RANST (SET RANDOM RECORD)	36	*****	 02.20
;*****	wrrzf (write random 0 fill)	40	*****	 02.37
;*****						*****	 02.20
;****************************************************	 02.20
;
RANRD:	XRA	A	; TO SAY IT IS A READ		 02.23
	CALL	STNEW	; SET UP FCB FOR I/O
	ORA	A
	JNZ	SAVAF	; ERROR RETURN MUST BE
;		3 (CLOSE) OR 4 (UNWRITTEN EXTENT)
	CALL	READNV	; READ WITHOUT ADVANCE
	ORA	A	; SEE IF ANY ERROR
	RZ		; NO
	MVI	A,1	; FORCE 01 ON THIS TYPE CALL
	JMP	SAVAF	; SAVE ERROR AND GO HOME
;
wrrzf:	xra	a					;02.37
	dcr	a					;02.37
	br	ranwx					;02.37
;
RANWR:	XRA	A					;02.23
ranwx:	push	psw					;02.37
	xra	a					;02.37
	DCR	A	; -1 SAYS WRITE			 02.23
	CALL	STNEW
	CPI	3	; ACCEPT CLOSE ERROR
	brz	popsva	; AND GO HOME			 02.37
	BRLT	RANW01	; EXTENT OPENED
;		ELSE MUST CREATE NEW EXTENT
	PUSH	B	; C HAS REC NUMBER NEEDED
	CALL	CRFIL	; DO SO
	POP	B
	lxi	h,fcbnr					;02.21
	dad	d					;02.21
	MOV	M,C	; MAKE SURE REC NUM IS SET UP
	CPI	-1	; IF DIR FULL
	brnz	ranw01					;02.37
	MVI	A,5	; RETURN A 5 ERROR CODE
popsva:	pop	h	; fix stack			;02.37
	jmp	SAVAF	; (THAT IS THIS JMP)
;
RANW01:		; NEW EXTENT OPENED, NOW DO WRITE
	pop	psw					;02.37
	CALL	WRITNx	; WRITE WITHOUT ADVANCE		 02.37
	ORA	A
	RZ		; RETURN IF NO ERROR
;		MUST BE 1 (I/O ERROR) ---> 1
;		OR 2 (DISK IS FULL) -----> 6
	CPI	1
	RZ		; DO NOT CHANGE 1
	MVI	A,6	; ELSE A 6
	JMP	SAVAF	; SAVE AND GO HOME
;
STNEW:	PUSH	PSW	; SAVE READ/WRITE FLAG		 02.23
	; SET UP EXTENT IN FCB FOR I/O
	PUSH	D	; SAVE FCB
	LXI	H,FCBRR	; ADDRESS RANDOM RECORD POINTER
	DAD	D
	MOV	E,M	; GET 3-BYTE NUMBER
	INX	H
	MOV	D,M
	INX	H
	MOV	A,M
	XCHG
	MOV	E,A
	MVI	D,0	; TO DEHL!!!!!
	LXI	B,128	; RECORDS PER EXTENT
	CALL	DIV32	; RETURNS EXTENT IN DE, RECORD IN HL (L)
	POP	B	; HOLD FCB
	PUSH	H	; RECORD NUMBER
	PUSH	D	; EXTENT NUMBER
	PUSH	B	; AND FCB BACK AGAIN
	LXI	H,FCBEX
	DAD	B	; NOW LET'S SEE IF THIS IS THE RIGHT ONE
	MOV	A,E
	CMP	M
	BRNE	NOTSAM					;02.35
	INX	H
	MOV	A,D
	CMP	M
	BREQ	SAMEXT					;02.35
NOTSAM:	POP	D	; RETRIEVE FCB
	inx	d					;02.37
	ldax	d					;02.37
	dcx	d					;02.37
	ral						;02.37
	cc	FCLOSL	; CLOSE CURRENT EXTENT
	POP	B	; RETRIEVE EXTENT
	POP	H	; RETRIEVE RECORD NUMBER (L)
	CPI	-1	; CHECK FOR ERROR
	BRZ	RETER3	; RETURN TO READ OR WRITE IF ERROR	;02.35
	PUSH	H	; RNUM BAK
	LXI	H,FCBEX
	DAD	D
	mov	a,m	; save old extent		 02.21
	MOV	M,C	; SET UP NEW EXTENT
	mov	c,a	; in case of error		 02.21
	INX	H
	mov	a,m	; on the open			 02.21
	MOV	M,B
	mov	b,a					;02.21
	push	b	; save on the stack		 02.21
	CALL	FOPN	; AND GO OPEN IT
	POP	B	; RETRIEVE OLD EXTENT		 02.23
	BRnc	setrm	; no error			 02.21	;02.35
	POP	H	; GET RECORD NUMBER		 02.23
	POP	PSW	; AND READ/WRITE FLAG		 02.23
	BRNZ	WASWR	; JUMP IF WRITE			 02.23	;02.35
	PUSH	H	; PUT RECNUM BACK		 02.23
	lxi	h,fcbex					;02.21
	dad	d	; let us now put back		 02.21
	mov	m,c	; the original extent		 02.21
	inx	h					;02.21
	mov	m,b	; which we so carefully saved	 02.21
	pop	b					;02.21
	MVI	A,4	; SET NOT FOUND ERROR CODE
	ret		; IF FAILURE (NOT FOUND)	 02.21
;
WASWR:	MOV	C,L	; RECORD NUMBER			 02.23
	MVI	A,4	; ERROR CODE			 02.23
	RET		; NOW WE WILL DO CRFIL		 02.23
;
RETER3:	POP	PSW					;02.23
	MVI	A,3	; ERROR CODE 3			 02.23
	RET						;02.23
;
setrm:	pop	b	; RECORD NUMBER			;02.21
SETREC:	POP	PSW	; CLEAR READ/WRITE FLAG		 02.23
	LXI	H,FCBNR	; ADDRESS NEXT RECORD NUMBER
	DAD	D
	MOV	M,C	; SET UP FCB
	XRA	A
	RET		; READY
;
SAMEXT:	POP	D	; FCB
	POP	H	; EXTENT
	POP	B	; RECORD
	BR	SETREC					;02.35
;
	eject
;
;*******************************************************************
;*******************************************************************
;*******							****
;*******	System call 35					****
;*******	Compute file size				****
;*******							****
;*******************************************************************
;*******************************************************************
;
CFSIZ:		; COMPUTE FILE SIZE
	LXI	H,0		;INITIAL HIGH EXTENT
	MVI	C,0		;INITIAL HIGH RECORD
	xra	a		; start at dir rec 0		 02.23
CFSIZ1:	PUSH	D		;FCB
	PUSH	B		;RC
	PUSH	H		;HEX
	CALL	NMTCH
	CPI	-1		;FAILURE?
	BRZ	CFSIZ9						;02.35
	push	psw		; save dir rec #		 02.23
	LXI	D,FCBEX
	DAD	D		;EXTENT IN DIR REC
	MOV	E,M
	INX	H
	MOV	D,M
	LXI	B,FCBRC-FCBEX-1
	DAD	B		;GET RECORD COUNT
	MOV	A,M
	pop	b		; save dir rec # in b		 02.23
	POP	H		;HIGH EXTENT NOW IN HL
	PUSH	PSW		;RC TO STACK
	CALL	CMPHL		;DE IS this EXTENT
	BRGE	CFSIZ4						;02.35
	POP	PSW		;CLEAR OFF OF STACK
	mov	a,b		; dir rec # back to a		 02.23
	POP	B		;RC
CFSIZ3:	POP	D		;FCB
	BR	CFSIZ1						;02.35
;
CFSIZ4:	POP	h		;NEW HIGH REC			 02.23
	mov	a,b		; dir rec # to a		 02.23
	POP	B		;OLD ONE
	MOV	c,h		;SET NEW RC FOR SAVE		 02.27
	XCHG
	BR	CFSIZ3						;02.35
;
CFSIZ9:	POP	D		;HIGH EXTENT
	POP	B		;HIGH REC (C)
;
;		FCB STILL ON STACK - MERGE LOGIC
;
	pop	h		; HL points to FCB		;02.40
	br	cmprnm						;02.40
;
RANST:		; SET RANDOM RECORD
	PUSH	D	; SAVE FDB
	LXI	H,FCBEX
	DAD	D
	MOV	E,M	; GET CURRENT EXTENT
	INX	H
	MOV	D,M
	LXI	B,FCBNR-FCBEX-1
	DAD	B	; ADDRESS NEXT RECORD 
	MOV	C,M
	pop	h						;02.40
;			; Fall into CMPRNM			;02.40
;
; CMPRNM	C = NR, DE = EXT, HL = FCB			;02.40
;
CMPRNM:
	push	h						;02.40
	MVI	B,0
	PUSH	B	; SAVE FOR LATER ADDIRION
	LXI	B,128	; RECORDS PER EXTENT
	CALL	MUL32	; DE * BC > DEHL
	POP	B	; RETRIEVE INCREMENT
	DAD	B
	BRNC	NOOVFL	; JMP IF NO OVERFLOW			;02.35
	INX	D	; ADJUST
NOOVFL:	XCHG
	XTHL		; HIGH OF R NUM XCHG WITH FCB
	PUSH	D	; LOW OF R NUM
	XCHG		; FCB BACK TO D
	LXI	H,FCBRR	; THIS IS WHERE IT GOES
	DAD	D
	POP	B	; L AND H OF #
	MOV	M,C
	INX	H
	MOV	M,B
	INX	H
	POP	B	; HH OF # AND A 0
	MOV	M,C	; ALL READY
	XRA	A
	RET
;
;****************************************************	 02.20
;*****						*****	 02.20
;*****	END OF BLOCK OF CODE ADDED AT 02.20	*****	 02.20
;*****						*****	 02.20
;****************************************************	 02.20
	EJECT
;
WRINR	EQU	7	;WRITE (INTERLEAVED)
;
****************************************************************
****************************************************************
****							    ****
**** write without advance (99h) and			    ****
**** WRITE FILE BLOCK (21)				    ****
****							    ****
****************************************************************
****************************************************************
;
;  ENTRY:	@DE=FCB
;  EXIT:	A =0, WRITE OK
;		   1, EXTEND ERROR
;		   2, OUT OF SPACE
;	           -1, OUT OF DIRECTORY SPACE
;
	ENT	NEWBLK					;02.37
NEWBLK:	DB	0					;02.37
;
writnv:	xra	a	; Write with no advance		;02.37
writnx:	stc						;02.37
	BR	wrfilx					;02.35
WRFIL:	xra	a	; Standard write		;02.37
wrfilx:	push	psw					;02.20
	lxi	h,9	; Check for write protect	;02.37	;02.42
	dad	d	;	attribute		;02.37	;02.42
	mov	a,m					;02.37
	RLC
	jc	rdf0a	; THEN EXTEND ERR		;02.37
;
	XRA	A	; Set not new cluster to	;02.39
	STA	NEWBLK	;      begin with		;02.39
;
;	6 lines moved to after call of cdkbk		 02.10
WRF5:	LXI	H,NXREC	;* PT TO NEXT RECORD
	DAD	D
	PUSH	D	; IF NXREC NOT ALLOCATED
	CALL	CDKBK
	POP	D
;
	push	af					;02.10
	INX	D	; FLAG AS 'FCB MODIFIED'	 02.06
	LDAX	D	;  WITH CHAR MSB		 02.06
	ORI	80H					 02.06
	STAX	D					 02.06
	DCX	D					 02.06
	pop	af					;02.10
;
	BRNC	WRF3	; Jump if no error from CDKBK	;02.35
?ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÙ23				 Return extend error if so		;02.42
;
	pop	psw	; Restore mode flags		;02.37
	push	psw					;02.37
	PUSH	D
	PUSH	H
	push	psw					;02.37
	CALL	FCBDK
	pop	psw					;02.37
	brz	nozfil	; Jump if no zero fill		;02.37
;
	call	newidx	; Else use new index code to	;02.37
	brnz	nozfi2	; fill the cluster with zeros.	;02.37
;
	call	bs2wrt	; No error from NEWIDX: free	;02.37
;			;    the buffer used by NEWIDX
	mov	d,b					;02.37
	mov	e,c					;02.37
	br	WRF2B					;02.37	;02.39
;
;			; No zero fill:
nozfil:	CALL	GETBK	; Allocate the cluster
	CPI	-1
	BRNZ	WRF2B					;02.35	;02.39
;
;			; Error allocating or zeroing new cluster:
nozfi2:	POP	H
	POP	D
	XRA	A	; Clean up NEWBLK for error	;02.37
	STA	NEWBLK					;02.37
	MVI	A,2	;ERR=2, OUT OF SPACE
	jmp	rdf3	;				;02.37
;
WRF2B:							;02.39
	MVI	A,1	; Indicate a new cluster	 02.37
	STA	NEWBLK					;02.37
;
	POP	H	; DM POINTER
;
; Store the new cluster number:
;	type 2S system: 8 bits (0...)
;	type 2 system: 16 bits (1...)
;
	MOV	M,E	; SET CLUSTER NO.
WRF2A:	POP	D	; RESTORE FCB			 02.06
	BR	WRF5	; TRY WRITE AGAIN...		 02.06	;02.35
;
;  @DE=FCB, HL=DISK BLOCK
;
WRF3:	MVI	A,WRINR
	PUSH	D
	CALL	ADKBK
	POP	D
;
	PUSH	PSW		; Save return condition		;02.39
	XRA	A		; Clear NEWBLK for next		;02.39
	STA	NEWBLK		; I/O operation			;02.39
	POP	PSW						;02.39
;
	ORA	A
	jnz	rdf0a	; WRITE ERROR			;02.37
;
	LXI	H,NXREC
	DAD	D
	MOV	A,M
	PUSH	H
	LXI	H,RECNT	; IF RECNT<NXREC
	DAD	D
	CMP	M
	XTHL
	POP	B
	BRC	WRF1					;02.35
;
;	THEN EXTEND FILE
;		RECNT:=NXREC+1
;
	MOV	A,M
	INR	A
	STAX	B
;
;  SET UP FOR NEXT OPERATION				 02.03
;
WRF1:
	pop	psw	; get original carry		 02.20
	push	psw					;02.20
	BRC	WRFXX	; if no advance, do not		 02.37
	LXI	H,FCBNR
	DAD	D
	MOV	A,M	; IF FCB.NR			 02.03
	ANI	3FH	;  =3FH OR 7FH			 02.03
	CPI	3FH	;				 02.03
	BRNE	WRF1A	; THEN ON 8K BOUNDRY 		 02.03	;02.35
;02.03 CLOSE 8K PIECE					 02.03
	PUSH	H	;				 02.03
	CALL	FCLOSL	; CLOSE CURRENT EXTENT 		 02.03
	POP	H	;   (SAVE @FCB.NR)		 02.03
	CPI	-1	;				 02.03
	jz	rdf0a					;02.37

;
; ADVANCE FCB.NEXT RECORD				 02.03
WRF1A:	INR	M					;02.03
	MOV	A,M	; IF (++NR)=80H			 02.03
	CPI	80H	; THEN NEED NEXT EXTENT		 02.03
	BRNE	WRFXX					;02.37
; NEED NEXT EXTENT					 02.03
	MVI	M,0	; FCB.NR:=0 (FOR NEW EXTENT)
	CALL	NXEXT	; LOOK FOR NEXT EXTENT
	ORA	A
	jZ	rdf3	; FOUND IT/ KEEP ON CHUGING	;02.37
; MUST CREATE NEXT EXTENT
	CALL	CRFIL	; MAKE NEW EXTENT
	CPI	-1					;02.37
	JEQ	rdf3	; -1,OUT OF DIR SPACE		 02.37
;
WRFXX:	XRA	A					;02.37
	JMP	RDF3					;02.37
;
;  CALCULATE DISK BLOCK
;  ENTRY:  @DE=FCB
;  EXIT:  CY=0, HL=DISK BLOCK
;	  CY=1, @HL=DM BLK=0 (NOT ALLOCATED)
;	  BOTH @HL=DM BLK
CDKBK:	CALL	FCBDK	; B:=DISK #
	CALL	ASDTE	; CSDTE:=CURRENT SDT ENTRY
	LXI	H,FCBNR		;SMALL DISK
	DAD	D
	MOV	A,M	; A:=NEXT REC
	CALL	GETCLS	; A:=CLUSTER NUMBER
	ADI	RECNT+1
	MVI	B,0
	MOV	C,A
	XCHG		;DE=@FCB.NXREC
	DAD	B	;HL=@FCB.DM[NXREC BLK]
	MOV	A,M
	ORA	A	;IF DM=0
	STC
	RZ		;THEN RETURN (CY=1)
	CPI	-1	; IF DM=-1
	BRNE	CDKBK1					ITH CHAR MSB		 02.06
	ORI	80H					 02.06
	STAX	D					 02.06
	DCX	D					 02.06
	pop	af					;02.10
;
	BRNC	WRF3	; Jump if no,M
	POP	H
	MOV	D,H	; TOP,DE:=CLUSTER SIZE
	PUSH	D
	CALL	MUL16	; DE:=DATA BLOCK AT START OF CLUSTER
	POP	H	; HL=CLUSTER SIZE
	XTHL
	MOV	A,M	; HL:=NEX REC
	XTHL
	PUSH	D	; D=DATA BLOCK
	MOV	E,A
	MVI	D,0
	XCHG
	CALL	DIV16	; DE:=NEX REC MOD CLUSTER SIZE
	POP	H	; DM[NXREC]*CLUSTER
	DAD	D	; + NEXREC MOD CLUSTER
;
	MOV	A,D	; If rec mod cluster size is not zero,	;02.39
	ORA	E	; then clear NEWBLK. Thus NEWBLK will	;02.39
	JZ	..1	; be set only on accesses to the first	;02.39
	XRA	A	; block of the cluster.			;02.39
	STA	NEWBLK	;					;02.39
..1:								;02.39
;
	POP	D
	MOV	B,H
	MOV	C,L
	CALL	GDIRST	; + FIRST DIR BLK
	DAD	B	;HL=DISK BLOCK
	MVI	C,0	; CLEAR BLOCK(HIGH)
	RET		;NOTE:  CY=0
	EJECT
;
;02.02  CALCULATE BLOCK ON BIG DIR
CLXBLK:	PUSH	B	;DE=CLUSTER, BC=REL REC ;02.07
	DCX	D	; MAKE ORIGIN 0.
	MVI	L,SDTCSZ
	CALL	GTSDT
	MOV	C,M
	MVI	B,0
	CALL	MUL32
;
; At this point, DEHL == first logical block # of cluster, less
;					directory start.
;
	POP	B
	DAD	B
	BRNC	CDKB2					;02.35
	INX	D
CDKB2:	MOV	C,E
	MOV	B,D
	XCHG
	MVI	L,SDTDTY	;	SUBDIR		 02.37
	CALL	GTSDT		;	SUBDIR		 02.37
	MOV	A,M		;	SUBDIR		 02.37
	ANI	SUBDIR		;	SUBDIR		 02/ÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿWRF32.37
	MOV	L,M	; HL gets master directory start
	MVI	H,0		;	SUBDIR		 02.37
	BR	CXGOT		;	SUBDIR		 02.37
;
CXNOTS:	CALL	GDIRST
CXGOT:	DAD	D
;
; Return if allocated, BCDE = Requested logical block number, CY clear
;
	RNC
	INX	B
	CMC
	RET
;
;02.01 SET UP REGISTERS FOR DIR/FCB MOVE
;
	EJECT
; 
;  GET DISK & BUFFER
;  ENTRY:  @DE=FCB
;  EXIT:  B=DISK, HL=BUFFER
;
GDKBF:
	CALL	FCBDK	;B=DISK
	PUSH	B
;	MVI	C,URDBF
;	CALL	RDUCB	;HL=USER BUFFER
	LHLUCB	DBF	;HL=USER BUFFER			;02.35
	POP	B
	RET
;
;  ACT ON DISK BLOCK
;  ENTRY:  @DE=FCB, HL=DISK BLK, A=5(RD), 7(WR)
;  EXIT:  A= DISKIO RTN CODE
;
ADKBK:	PUSH	PSW
	PUSH	H
	CALL	GDKBF
	POP	D
	POP	PSW
	CALL	DSKIO
	RET		; LET DSKIO HANDLE ERR MSG
;
;  A=INT (A/B)
;
NEGHL:	MOV	A,H
	CMA
	MOV	H,A
	MOV	A,L
	CMA
	MOV	L,A
	INX	H	; HL:=-HL
	RET
	EJECT
;
;  LINK TO EXECUTE (MSB+8)
;  ENTRY:  @DE=PGM FCB (.COM, .PGM OR .OVL EXTENSION)
;  EXIT:   A =-1   (NOT FOUND OR BAD NAME)
;	   A = 0   (GOOD LOAD OF .OVL)
;  OTHERWISE EXECUTE .COM AT 100H
;	NOTE: FINDING THE FILE USES 100H AS DIR BUFFER
;
USERA	EQU	100H	; START OF USER AREA
;
PLINK:	MOV	L,E				;02.37
	MOV	H,D				;02.37
	MVI	A,-1
	SAFUCB
	MVI	C,12				;02.37
XLK0:	MOV	A,M				;02.37
	CPI	'?'				;02.37
	REQ					;02.37
	INX	H				;02.37
	DCR	C				;02.37
	BRNZ	XLK0				;02.37
;
	LXI	H,FCBFT				;02.37
	DAD	D				;02.37
	MOV	A,M				;02.37
	STA	SAVTYP				;02.37
	CPI	'C'				;02.37
	BRNE	PLOVLY				;02.37
	INX	H
	MVI	A,'O'
	CMP	M
	RNE
	INX	H
	MVI	A,'M'
	CMP	M
	RNE
;	<NAME> .COM OR .PGM = OK
CMPGM:	XRA	A				;02.38
	INX	H	; SET EXTENT		 02.37
	MOV	M,A	; TO ZERO		 02.37
	INX	H				;02.37
	MOV	M,A				;02.37
	LXI	H,FCBNR				;02.37
	DAD	D				;02.37
	MOV	M,A				;02.37
	MVI	A,-1	; PAGES			 02.37
	LXI	H,USERA	; LOAD ADDRESS		 02.37
PLMERG:	PUSH	H	; SAVE ADDR IF THERE	 02.37
	PUSH	PSW	; SAVE PAGES		 02.37
;
; NOW ALL VALIDATED, MOVE USITH CHAR MSB		 02.06
	ORI	80H					 02.06
	STAX	D					 02.06
	DCX	D					 02.06
	pop	af					;02.10
;
	BRNC	WRF3	; Jump if noL	MOVE
	POP	D				;02.37
;
	CALL	FOPN	;OPEN FILE
	CPI	-1
	BRZ	PLFAL0				;02.37
	LXI	H,8				;02.37
	DAD	D				;02.37
	MOV	A,M				;02.37
	ANI	7FH	; CLEAR ANY READ	 02.37
	MOV	M,A	; PROTECT FLAG		 02.37
	LXI	H,FCBRR	; FORCE FAKE FILE SIZE	 02.37
	DAD	D				;02.37
	POP	PSW	; PAGES			;02.37
	MOV	M,A				 02.37
	BR	PLLOAD				;02.37
;
PLFAL0:	POP	H	; ADJUST		 02.37
	POP	H				;02.37
	RET		; GONZO			 02.37
;
PLOVLY:	MVI	A,'O'				;02.37
	CMP	M				;02.37
	BRNE	TSTPGM				;02.38
	INX	H				;02.37
	MVI	A,'V'				;02.37
	CMP	M				;02.37
	RNE					;02.37
	INX	H				;02.37
	MVI	A,'L'				;02.37
	CMP	M				;02.37
	RNE					;02.37
	LHLUCB	PSW	; PAGES TO LOAD		;02.37
	MOV	A,H				;02.37
	LHLUCB	HL	; LOAD ADDRESS		;02.37
	BR	PLMERG				;02.37
;
TSTPGM:	MVI	A,'P'				;02.38
	CMP	M				;02.38
	RNE		; FAILURE		;02.38
	INX	H				;02.38
	MVI	A,'G'				;02.38
	CMP	M				;02.38
	RNE					;02.38
	INX	H				;02.38
	MVI	A,'M'				;02.38
	CMP	M				;02.38
	RNE					;02.38
	BR	CMPGM				;02.38
;
;  LOAD MODULE & DO IT
;
PLLOAD:	LDA	SAVTYP				;02.37
	CPI	'O'				;02.38
	BREQ	PLLD2				 02.37
; RESET USER ABORT ADDRESS ONLY IF NOT INACTIVE
	LHLUCB	ABT	; .COM AND .PGM		;02.38
	MOV	A,H
	ANA	L
	CPI	-1	; 0FFFFH=INACTIVE
	LXI	D,0
	CNE	STCLC	; SET SYSTEM ABORT/CONTROL-C
PLLD2:	LHLUCB	DBF	; SAVE USERS		 02.37
	POP	D	;LOAD ADDRESS		 02.37
	PUSH	H				;02.37
	XCHG					;02.37
XLK1:	SHLUCB	DBF				;02.37
;
	LXI	D,80H				;02.37
	DAD	D	; TEST FOR SYSTEM OVERWRITE
	PUSH	H	; Save next block to read		;02.39
	XCHG
	LHLD	SYSBOT
	MOV	A,L
	SUB	E
	MOV	A,H
	SBB	D
	BRGE	XLK2				;02.35
; TOO BIG ERROR
	ADRUCB	FCB1				;02.35
	MVI	E,11
XLK3A:	MOV	A,M
	CALL	CWPIM
	INX	H
	DCR	E
	BRNZ	XLK3A				;02.35
	LXI	H,LDERR
	CALL	ERMSG
	JMP	CONPRY				;02.20
;
LDERR:	DB	' Program too big',0
;
XLK2:	ADRUCB	FCB				;02.35
	XCHG
	CALL	RDFIL
;
; 6/82 SBW 02.39
; If error on read, or page count decre
	PUSH	H
	CALL	GDKBF
	POP	D
	POP	PSW
	CALL	DSKIO
	RET		; LET DSKIO HANDLE ERR MSG
;
;  A=INT (A/B)
;
NEGHL:	MOV	A,H
	C.37
	POP	B	; @BC = Next block to load		;02.39
;
	MOV	A,C	; Even page boundary?			;02.39
	ORA	A						;02.39
	BRNZ	..1	; No: no decr, and loop			;02.39
	DCR	M	; Else decr page count			;02.39
..1:
	MOV	L,C	;					;02.39
	MOV	H,B	;					;02.39
	BRNZ	XLK1	; loop if page count not zero		;02.39
;
PLLDED:	LDA	SAVTYP				;02.37
	CPI	'O'				;02.38
	BRNE	PLCOM				;02.38
	POP	H	; USERS BUFFER		 02.37
	SHLUCB	DBF	; RESTORE		 02.37
	XRA	A				;02.37
	JMP	SAVAF	; GO BACK TO BUGGER	 02.37
;
PLCOM:	LXI	H,80H				;02.37
	SHLUCB	DBF				;02.37
	LHLD	SYSBOT	; SP:=END OF USER AREA	 02.37
	DCX	H				;02.37
	SPHL
;
	LXI	H,CONPRY			;02.20
	PUSH	H	;RTN TO CONPROC
;		ABORT ADDRESS RESET RELOCATED	 02.37
	ADRUCB	PRC	; PASS OLD R.C.		;02.35
	MOV	A,M
	MVI	M,0	; ZERO NEW R.C.
	LXI	H,USERA				;02.38
	JMP	XXUSER				;02.38
;
SAVTYP:	DB	0				;02.37
;
;	************************************************ 02.14
;	***					     *** 02.14
;	***	space for minimum system stack	     *** 02.14
;	***					     *** 02.14
	ds	80	;will be 80 plus filler      *** 02.14
;	***		 before GENDVR		     *** 02.14
;	***					     *** 02.14
;	************************************************ 02.14
;
	END
