SUBTTL Disk interface code
PAGE


;FIG-FORTH disk interface: no file access

;This is SYSTEM-DEPENDENT code, and is normally INCLUDED by
;4TH-SYSD.ASM

; Disk parameters are set in the 4TH-OPT.H file.

IF	INCH EQ 8
TRKS		EQU	77		;Tracks on 8" disk
RPT		EQU	26*DENSITY	;8" sec/track

IF	DENSITY-2
RECSIZE		EQU	128		;Bytes/sector, SD
ELSE
RECSIZE		EQU	1024		;Bytes/sector, DD
ENDIF

ELSE

TRKS		EQU	40		;tracks on a 5" disk
RPT		EQU	8		;sectors/track
RECSIZE		EQU	512		;bytes/sector, dd only

ENDIF

RPBLOCK		EQU	BUFSIZE/RECSIZE		;disk records/1K block
RPDRIVE		EQU	TRKS*RPT*SIDES		;records/drive
WASTE		EQU	RPDRIVE MOD RPBLOCK	;rec's. left over
BLPDRIVE	EQU	(RPDRIVE-WASTE)/RPBLOCK	;whole blocks/drive

;=#+  REC/BLK	number of disk records to fill 1 buffer	-- n

		$CONST	87H,REC/BL,K,RPBLK	;Disk records per 1K
		DW	RPBLOCK

;=#+  BLK/DRIVE	number of 1K blocks per drive		-- n

		$CONST	89H,BLK/DRIV,E,BLPDRV	;1K blocks per drive
		DW	BLPDRIVE

;=#+  MAXDRIVE	highest valid drive number		-- n

		$CONST	88H,MAXDRIV,E,MXDRV	;highest legal drive #
		DW	DRIVES-1

;=#+  MAXBLOCK	highest valid block number		-- n

		$CONST	88H,MAXBLOC,K,MXBLK	;highest legal block #
		DW	BLPDRIVE*DRIVES-1

;=:   DR0	set offset for drive zero		--

		$COLON	83H,DR,0,DRZER
		DW	ZERO,	OFSET,	STORE
		DW	SEMIS

;=:   DR1	set offset for drive one		--

		$COLON	83H,DR,1,DRONE
		DW	BLPDRV
		DW	OFSET,	STORE,	SEMIS

;=:+  D&RCALC	set drive/record for block n		n --

		$COLON	87H,D&RCAL,C,DRCAL
		DW	DUPP,	ZLESS
		DW	OVER,	MXBLK,	GREAT,	ORR
		DW	LIT,	6,	QERR	;range error!
		DW	BLPDRV,	SLMOD
		DW	DRIVE,	STORE
		DW	RPBLK,	STAR
		DW	REC,	STORE,	SEMIS

;=:+  BLKRD	read one block from disk to addr	addr blk --

		$COLON	85H,BLKR,D,BLKRD
		DW	DRCAL		;set DRIVE and RECORD
		DW	DTA,	STORE	;set DTA
		DW	PBLKRD,	SEMIS	;read it

;=:+  BLKWRT	write one block to disk from addr	addr blk --

		$COLON	86H,BLKWR,T,BLKWRT
		DW	DRCAL		;set DRIVE and RECORD
		DW	DTA,	STORE	;set DTA
		DW	PBLKWRT,	SEMIS	;write it

;=C+  (BLKRD)	block read primitive			--

TRIED		DW	?		;retry flag

		$CODE	87H,(BLKRD,),PBLKRD
		PUSH	SI
		PUSH	BP
		MOV	[TRIED],0	;reset retry flag
RETRY:		MOV	2[DSKERR],0	;reset error flag
		MOV	AX,2[DRIVE]	;AL = drive no.
		MOV	BX,2[DTA]	;BX = transfer address
		MOV	CX,2[RPBLK]	;CX = no. records to transfer
		MOV	DX,2[REC]	;DX = logical record #
		INT	37		;BIOS disk read function
		JNC	READXIT		;carry set if error

		CALL	DCHECK		;force media check
		OR	AX,AX		;0 if hopeless
		JNZ	RETRY		;may be ok...

READXIT:	POPF
		POP	BP
		POP	SI
		JMP	NEXT

;=C+  (BLKWRT)	block write primitive			--

		$CODE	88H,(BLKWRT,),PBLKWRT
		PUSH	SI
		PUSH	BP
		MOV	[TRIED],0	;reset retry flag
WRETRY:		MOV	2[DSKERR],0	;reset error flag
		MOV	AX,2[DRIVE]
		MOV	BX,2[DTA]
		MOV	CX,2[RPBLK]
		MOV	DX,2[REC]
		INT	38		;BIOS disk write function
		JNC	WRTXIT

		XOR	AH,AH		;return negative error code
		NEG	AX
		MOV	2[DSKERR],AX	;AL has error code
		MOV	BYTE PTR 2[DSKERR],AL	;AL has error code
		CALL	DCHECK		;force media check
		OR	AX,AX		;0 if hopeless
		JNZ	WRETRY		;may be ok...

WRTXIT:		POPF
		POP	BP
		POP	SI
		JMP	NEXT

;This subroutine was added because the disk read/write interrupts
;under MS-DOS >2.0 don't handle different density disks.
;If the DOS version is 2.0 or greater, this function forces MS-DOS
;to check the disk format and returns AX=TRUE.
;If the version is less than 2.0, or DCHECK has already tried once,
;AX has 0 on exit.

DCHECK		PROC	NEAR

		MOV	AX,[TRIED]
		XOR	AX,AX
		JNZ	NOHOPE		;already tried once...

		MOV	[TRIED],TRUE	;set flag
		MOV	AH,30H
		INT	21H		;get DOS version
		CMP	AL,2		;less than 2.0?
		JL	NOHOPE		;must be hard error

		MOV	DX,2[DRIVE]
		INC	DX		;0=default, 1=A, 2=B!
		MOV	AH,36H		;force media check by calling
		INT	21H		;disk free space function
		MOV	AX,TRUE		;still hope, try again
		RET	2		;flags from first try
NOHOPE:
		MOV	AX,0
		RET
DCHECK		ENDP
able of Contents


            5.2  Deleted Definitions