; SHOBLOCK, Version 1.0
;
; A utility that will display the tracks and sectors that are
; allocated to a given input block for a specified drive.  It
; will also display the allocation block that contains a given
; track and sector.  Designed to work on either single or
; double density drives, and will probably work on a hard disk.
;
; NOTE:  SHOBLOCK is a product of Horn Engineering Associates.
; It is offered for the free use of anyone but it may not be
; sold or offered for sale, either in itself or as a part of
; any collection of programs, without the express permission
; of Horn Engineering Associates.
;
; Charles E. Horn,PE
; Garland, TX
; 13 November 1984
;
; 10/12/85  Added code to report the file name to which requested
;	    block number is allocated.	Changes name from TRACKSEC
;	    to SHOBLOCK because of added functions.	(CEH)
;
; 10/07/85  Revised to permit distinction between logical and
;	    physical sectors.  Allows entry of either.	Also
;	    corrected error that numbered logical sectors from
;	    1.	Now numbers from 0.  Physical sectors start with
;	    1 according to standard CP/M conventions.	  (CEH)
;
;
;	MISC EQUATES
;
	CR	EQU	0DH
	LF	EQU	0AH
	TAB	EQU	9
	BS	EQU	8
	ROWMAX	EQU	8	;maximum sectors to be displayed
				;per row.  Can change this here for
				;consoles that display less than 8
				;columns.  Each sector displayed
				;occupies 9 row spaces.
;
;	CP/M EQUATES
;
	BOOT	EQU	0	;wboot entry address
	CONIN	EQU	1	;console input function
	CONOUT	EQU	2	;console output function
	PBUF	EQU	9	;print buffer function
	CONBUF	EQU	10	;read in console buffer function
	SELDSK	EQU	14	;select disk function
	CURDSK	EQU	25	;get current disk function
	GDPB	EQU	31	;get disk parameter block address function
;
	BDOS	EQU	5	;BDOS entry address
	TPA	EQU	BOOT+100H	;normal TPA address
;
	ORG	TPA
;
START:	LXI	H,0		;find CP/M SP
	DAD	SP
	LXI	SP,STACK	;set our stack
	PUSH	H		;put CP/M SP on stack for quiet exit
;
	MVI	C,CURDSK	;get current default disk
	CALL	BDOS
	STA	DEFDRV		;save default drive for exit
;
	CALL	ILPRT
	DB	CR,LF,'SHOBLOCK; Ver 1.0 [10/07/85]'
	DB	CR,LF,'from Horn Engineering Associates',CR,LF,0
;
MENU:	CALL	ILPRT
	DB	CR,LF,'SHOBLOCK will report the tracks and sectors that'
	DB	CR,LF,'are allocated to a given allocation block number'
	DB	CR,LF,'for a specified  drive.   Alternately,  it  will'
	DB	CR,LF,'report  the  allocation block number for a given'
	DB	CR,LF,'track and sector and report the file  name  that'
	DB	CR,LF,'it is allocated to.'
	DB	CR,LF,LF,'Do you wish to continue <Y/N>? |*|',BS,BS,0
;
	MVI	C,CONIN
	CALL	BDOS
	ANI	5FH		;convert response to UC
	CPI	'Y'
	JZ	START1
	CPI	'N'
	JZ	EXIT
	JMP	MENU		;require good answer
;
START1:
	CALL	ILPRT
	DB	CR,LF,LF,'Which drive do you wish to use <A-P>? |*|',BS,BS,0
	MVI	C,CONIN
	CALL	BDOS
	ANI	5FH		;make UC
	CPI	'A'		;check range of reply
	JC	START1		;if not valid
	CPI	'P'+1
	JNC	START1		;if not valid
	SUI	'A'		;'A' drive = 0, 'P' drive = 15
	PUSH	PSW		;save drive number
	LHLD	BOOT+1		;get wboot entry addr in BIOS
	LXI	D,24		;offset to SELDSK routine
	DAD	D		;addr in HL
	SHLD	PATCH1+1	;stuff into inline code
	LXI	D,3		;offset to SETTRK routine
	DAD	D		;addr to HL
	SHLD	PATCHA+1	;stuff into code
	DAD	D		;+3 to SETSEC routine
	SHLD	PATCHD+1	;stuff into code
	DAD	D		;+3 to SETDMA routine
	SHLD	PATCHE+1	;stuff into code
	DAD	D		;+3 to READ routine
	SHLD	PATCHF+1	;stuff into code
	LXI	D,9		;offset to SECTRAN routine
	DAD	D		;addr in HL
	SHLD	PATCH2+1	;stuff into inline code
	SHLD	PATCH6+1	;and another place
	SHLD	PATCHC+1	;and another
	MOV	C,A		;drive number to C
PATCH1: CALL	$-$		;SELDSK thu BIOS to get DPB header addr
	MOV	A,M		;translate table address to HL
	INX	H
	MOV	H,M		;high byte
	MOV	L,A		;low byte
	SHLD	PATCH3+1	;stuff into in-line code
	SHLD	PATCH4+1	;and another place
	SHLD	PATCH5+1	;and another
	SHLD	PATCHB+1	;and another
	POP	PSW		;restore drive number
	MOV	E,A		;set the default drive again through
	MVI	C,SELDSK	;..BDOS so system will know we did it.
	CALL	BDOS
	CALL	GETDPB		;set up disk parameter buffers
;
START2:
	CALL	ILPRT
	DB	CR
	DB	LF,LF,'Do you wish to enter TRACK and SECTOR numbers'
	DB	CR,LF,'or BLOCK number <T/B>? (Q to Quit) |*|',BS,BS,0
;
	MVI	C,CONIN
	CALL	BDOS
	ANI	5FH		;make UC
	CPI	'T'
	JZ	TRACKIN
	CPI	'B'
	JZ	BLOCKIN
	CPI	'Q'
	JZ	EXIT
	JMP	START2		;make him get it right
;
TRACKIN:
	CALL	ILPRT
	DB	CR
    DB	LF,LF,'Enter decimal track number, then RETURN: |***|',BS,BS,BS,BS,0
	CALL	SCIN$LE 	;read console buffer
	MVI	C,3+1		;3 is maximum number of digits
	LXI	H,CLIN		;point to first char in buffer
	CALL	DECPROC 	;check for valid and convert to binary
	JC	ERRORA		;if not a valid number
	CALL	CHECKTRACK	;check for valid track number
	JC	ERRORA		;if not valid
	SHLD	BINTRACK	;store the result
	JMP	SECTIN		;get the sector number
ERRORA:
	CALL	ILPRT
	DB	CR,LF,'+++ Not a valid TRACK number +++',0
	JMP	TRACKIN
;
SECTIN:
	CALL	ILPRT
	DB	CR,LF
	DB	'Do you wish to enter LOGICAL or PHYSICAL '
	DB	'sector number <L/P>? |*|',BS,BS,0
	MVI	C,CONIN
	CALL	BDOS
	ANI	5FH		;make response UC
	CPI	'L'
	JZ	SECTINL 	;process logical
	CPI	'P'
	JZ	SECTINP 	;process physical
	JMP	SECTIN		;get it right
;
SECTINP:
	MVI	A,1		;set flag for physical numbers
	STA	SECFLG
	CALL	ILPRT
	DB	CR,LF
    DB	'Enter PHYSICAL sector number in DECIMAL <RET>: |***|',BS,BS,BS,BS,0
	CALL	SCIN$LE 	;read buffer
	LXI	H,CLIN		;point to buffer
	MVI	C,3+1		;3 is maximum number of digits
	CALL	DECPROC 	;check for valid and convert to binary
	JC	ERRORB		;if not a valid number
	CALL	CHECKSEC	;check for valid sector number
	JC	ERRORB		;if not valid
	MOV	A,L		;phys sect num to A
PATCH3: LXI	H,$-$		;addr of translate table put here
	MVI	C,-1		;initialize logical counter
TRANLOOP:			;translate physical to logical
	INR	C		;bump logical count
	CMP	M		;match to phys?
	INX	H		;bump pointer
	JNZ	TRANLOOP	;if no match
	MOV	L,C		;logical number to HL
	MVI	H,0
	SHLD	BINSECT 	;store the result
	JMP	PROCESSA	;go to output processor 'A'
;
SECTINL:
	XRA	A		;flag for logical sectors
	STA	SECFLG
	CALL	ILPRT
	DB	CR,LF
   DB  'Enter LOGICAL sector number in DECIMAL <RET>: |***|',BS,BS,BS,BS,0
	CALL	SCIN$LE
	LXI	H,CLIN		;point to text in buffer
	MVI	C,3+1		;max num char = 3
	CALL	DECPROC 	;chech for valid and make binary
	JC	ERRORB		;CY if error
	CALL	CHECKSEC	;check for valid sector number
	JC	ERRORB		;if error
	SHLD	BINSECT 	;store valid number
	JMP	PROCESSA	;..and process it
ERRORB:
	CALL	ILPRT
	DB	CR,LF,'+++ Not a valid SECTOR number +++',CR,LF,0
	JMP	SECTIN
;
BLOCKIN:
	CALL	ILPRT
	DB	CR
	DB	LF,LF,'Do you wish to enter Block Number in'
	DB	CR,LF,'HEX or DECIMAL <H/D>? |*|',BS,BS,0
	MVI	C,CONIN
	CALL	BDOS
	ANI	5FH		;make UC
	CPI	'H'
	JZ	USEHEX		;get hex entry
	CPI	'D'
	JZ	USEDEC		;get decimal entry
	JMP	BLOCKIN 	;must pick one
;
USEHEX:
	CALL	ILPRT
	DB	CR
    DB	LF,LF,'Enter Allocation Block Number in HEX: |****|',BS,BS,BS,BS,BS,0
	CALL	SCIN$LE 	;read console buffer
	MVI	C,4+1		;4 characters max
	LXI	H,CLIN		;point to buffer
	CALL	HEXPROC 	;check characters for valid and conv. to binary
	JC	ERRORC		;if not valid number
	CALL	CHECKBLOCK	;check for valid block number
	JC	ERRORC		;if not valid
	SHLD	BINBLOCK	;store binary block number
	JMP	PROCESSB	;go to processor 'B'
ERRORC:
	CALL	ILPRT
	DB	CR,LF,'+++ Not a valid BLOCK number +++',0
	JMP	USEHEX
;
USEDEC:
	CALL	ILPRT
	DB	CR
    DB	LF,LF,'Enter Allocation Block Number in DECIMAL: |***|',BS,BS,BS,BS,0
	CALL	SCIN$LE 	;read console buffer
	MVI	C,3+1		;3 characters max
	LXI	H,CLIN		;point to buffer
	CALL	DECPROC 	;check for valid and convert to binary
	JC	ERRORD		;if not valid number
	CALL	CHECKBLOCK	;check for valid block number
	JC	ERRORD		;if not valid
	SHLD	BINBLOCK	;store binary block number
	JMP	PROCESSB	;go to processor 'B'
ERRORD:
	CALL	ILPRT
	DB	CR,LF,'+++ Not a valid BLOCK number +++',0
	JMP	USEDEC
;
;	The main processor loop for TRACK/SECTOR input
;	Always enter here with logical sector in BINSECT
;
PROCESSA:
	LHLD	BINSECT 		;get binary sector number
	XCHG				;sector number to DE
	LHLD	BINTRACK		;track number to HL
	CALL	GAB			;gets allocation block num. to HL
	SHLD	BINBLOCK		;save the binary value
	PUSH	H			;save it
	MOV	B,H			;HL to BC
	MOV	C,L
	LXI	H,BLOCKAD		;decimal digits in message
	MVI	A,3			;unpack 3 digits
	CALL	UDD			;unpack the digits
	POP	B			;allocation block number
	LXI	H,BLOCKAH		;hex digits in message
	CALL	HEXOUT			;unpack hex to message
	LHLD	BINSECT 		;sector number
	PUSH	H			;save it
	MOV	B,H			;...to BC
	MOV	C,L
	LXI	H,SECTORA		;sector digits in message
	MVI	A,3			;unpack 3 digits
	CALL	UDD			;unpack the digits
	POP	B			;recover logical sector
PATCH4: LXI	H,$-$			;addr of translate table here
PATCH2: CALL	$-$			;translate sector thru BIOS
	MOV	C,L			;physical sector to BC
	MOV	B,H
	LXI	H,SECTORA+4		;space for it in message
	MVI	A,3			;3 bytes to unpack
	CALL	UDD			;unpack to message
	LHLD	BINTRACK		;track number
	MOV	B,H			;...to BC
	MOV	C,L
	LXI	H,TRACKA		;track digits in message
	MVI	A,3			;3 digits to unpack
	CALL	UDD			;unpack the digits
	CALL	ILPRT
	DB	CR,LF,'Track '
TRACKA: DB	'nnn; Logical(Physical) Sector '
SECTORA: DB	'nnn(nnn)',CR,LF
	DB	'is allocated to Block '
BLOCKAD: DB	'nnn ('
BLOCKAH: DB	'nnnnH)',0
	JMP	REDO			;done - show filename and to menu
;
;	The main processor loop for BLOCK input
;
PROCESSB:
	LDA	RECPERBLK		;get records per block
	STA	TMPRPB			;store in working buffer
	LHLD	BINBLOCK		;get block number
	PUSH	H			;save it
	MOV	B,H			;move to BC
	MOV	C,L
	LXI	H,BLOCKBD		;point to decimal string in msg
	MVI	A,3			;3 digits to unpack
	CALL	UDD			;unpack to message
	POP	B			;block number to BC
	PUSH	B			;save it again
	LXI	H,BLOCKBH		;point to hex string in message
	CALL	HEXOUT			;unpack hex digits
	CALL	ILPRT
	DB	CR,LF,'Block '
BLOCKBD: DB	'nnn ('
BLOCKBH: DB	'nnnnH) contains the following sectors:',CR,LF,LF,0
	POP	H			;restore block number
	CALL	GTAS			;get first track and sector
	SHLD	TMPTRK			;store track number
	XCHG
	SHLD	TMPSEC			;store sector number
TRACKNUM:
	MVI	A,ROWMAX		;set sectors/row counter
	STA	ROWCNT
	CALL	ILPRT
	DB	'TRACK ',0
	LHLD	TMPTRK			;get track number
	MOV	B,H			;...into BC
	MOV	C,L
	LXI	H,TRACKB		;track digits in message
	MVI	A,3			;3 digits to unpack
	CALL	UDD			;unpack the digits
	CALL	ILPRT
TRACKB: DB	'nnn: LOGICAL(PHYSICAL) SECTORS: ',CR,LF,0
SECNUM:
	LHLD	TMPSEC			;get sector number
	MOV	B,H			;...into BC
	MOV	C,L
	PUSH	B			;save logical sector
	LXI	H,SECTORB		;sector digits in message
	MVI	A,3			;3 digits to unpack
	CALL	UDD			;unpack the digits
	POP	B			;logical to BC
PATCH5: LXI	D,$-$			;point to sec transl table
PATCH6: CALL	$-$			;BIOS translate to phys
	MOV	B,H			;phys sec to BC
	MOV	C,L
	LXI	H,SECTORB+4		;point to space in msg
	MVI	A,3			;3 digits
	CALL	UDD			;unpack to msg
;
	CALL	ILPRT
SECTORB:
        DB      'nnn(nnn) ',0
	LDA	ROWCNT			;get row count
	DCR	A			;bump down
	STA	ROWCNT
	ORA	A			;CRLF if line full
	CZ	NEWLIN
	LDA	TMPRPB			;get block record count
	DCR	A			;count down
	STA	TMPRPB			;store new count
	JZ	REDO			;done - show filename and to menu
	LHLD	TMPSEC			;get current sector number
	XCHG				;...to DE
	LHLD	TMPTRK			;get current track
	CALL	GNTAS			;get next track and sector
	XCHG				;DE = track; HL = sector
	SHLD	TMPSEC			;store new sector number
	LHLD	TMPTRK			;get old track number
	CALL	CDEHL			;compare track numbers
	JZ	SECNUM			;get next sector if same track
	XCHG				;else - new track num to HL
	SHLD	TMPTRK			;and store it
	CALL	ILPRT
	DB	CR,LF,0 		;new line
	JMP	TRACKNUM		;and display new track number
;
REDO:	CALL	GETDIR			;read directory into buffer
	CALL	FNDBLK			;find file containing block
	JMP	START2			;back to menu
;
NEWLIN:
	CALL	CRLF
	MVI	A,ROWMAX		;reset row counter
	STA	ROWCNT
	RET
;
;	End of main loops
;
EXIT:
	LDA	DEFDRV		;get default drive
	MOV	E,A		;drive to E
	MVI	C,SELDSK	;set it as we came in
	CALL	BDOS
	POP	H		;restore CP/M SP
	SPHL
	RET			;for a quiet exit
;
;
;***************
;* SUBROUTINES *
;***************
;
;	DECPROC - Checks decimal number string for valid characters
;		  and converts valid number to binary.
;	Entry:	HL point to ascii number string in console buffer
;		C contains max number of console digits + 1
;	Exit:	HL contains binary number
;		else - CY set means not a valid number
;
DECPROC:
	LDA	CLEFT			;get number of char in buffer
	ORA	A			;check for no entry
	JZ	SETCY			;set CY and RET if so
	CMP	C			;see if too many
	JNC	SETCY			;set CY and RET if so
	LXI	D,0			;initialize conversion register
	MOV	C,A			;store number of digits for count
DECPROC1:
	MOV	A,M			;get a digit
	CALL	DIGCHK			;check for valid digit - remove bias
	RC				;CY set if error
	INX	H			;advance pointer
	XCHG				;pointer to DE - conversion to HL
	CALL	DADA			;add digit to accumulation
	DCR	C			;count down digits
	JNZ	DECPROC2		;if not done
	ORA	A			;set no CY
	RET
SETCY:
	STC				;set CY for error flag
	RET
DECPROC2:
	PUSH	D			;save pointer
	PUSH	H			;save accumulated value
	DAD	H			;*2
	DAD	H			;*4
	DAD	H			;*8
	POP	D			;original value
	DAD	D			;*9
	DAD	D			;*10
	XCHG				;accumulation to DE
	POP	H			;pointer to HL
	JMP	DECPROC1
DIGCHK:
	CPI	'0'
	RC				;if < '0'
	CPI	'9'+1			;CY set if OK
	CMC
	RC				;if is wasn't
	SUI	'0'			;remove ascii bias
	RET
;
;	HEXPROC - Checks HEX number string for valid characters
;		  and valid number of characters.  Converts valid
;		  number to binary.
;	Entry:	HL points to hex digit string
;		C contains number of char in buffer + 1
;	Exit:	HL contains binary number
;		else - CY set if error
;
HEXPROC:
	LDA	CLEFT			;get number of char in buffer
	ORA	A			;check for none
	JZ	RETCY			;RET with CY if so
	CMP	C			;see if too many digits
	JNC	RETCY			;if so
	LXI	D,0			;initialize register for accumulation
	MOV	C,A			;initialize digit counter
HEXPROC1:
	MOV	A,M			;get a digit
	CALL	HEXCHK			;check for valid and make binary
	RC				;CY set if error
	INX	H			;advance pointer
	XCHG				;pointer to DE - accumulation to HL
	CALL	DADA			;add digit to accumulation
	DCR	C			;downcount
	JNZ	HEXPROC2		;if not done
	ORA	A			;else - set no CY
	RET
RETCY:
	STC				;set CY for error flag
	RET
HEXPROC2:
	DAD	H			;accumulation *2
	DAD	H			;*4
	DAD	H			;*8
	DAD	H			;*16
	XCHG				;accumulation to DE - pointer to HL
	JMP	HEXPROC1
HEXCHK:
	CPI	'0'
	RC				;if not a digit
	CPI	'9'+1
	JC	HEXCHK1 		;is numeric
	ANI	5FH			;make alpha UC
	CPI	'A'
	RC				;if not alpha either
	CPI	'F'+1			;CY if alpha
	JC	HEXCHK2 		;if OK
	CMC				;else - set CY
	RET				;with error
HEXCHK1:
	SUI	'0'			;make numeric binary
	ORA	A			;set no CY
	RET
HEXCHK2:
	SUI	'7'			;make 'A'=10; 'F'=15
	ORA	A			;set no CY
	RET
;
;       DADA - HL=HL+A
;
DADA:	PUSH	D		;protect DE
	MOV	E,A		;get (A) into (DE)
	MVI	D,0
	DAD	D		;add to (HL)
	POP	D		;restore DE
	RET
;
;	CRLF - CR and LF to console
;
CRLF:	MVI	E,CR
	MVI	C,CONOUT
	CALL	BDOS
	MVI	E,LF
	MVI	C,CONOUT
	CALL	BDOS
	RET
;
;	GETDPB - Sets up buffers with DPB data
;	(See Johnson-Laird; The Programmer's CP/M Handbook)
;	Entry: None.  Assumes that target drive has been
;	       set before entry.
;	Exit:  Following buffers initialized.
;
;	The buffers
;
DPB:				;disk parameter block
DPBSPT: DW	0		;sectors per track
DPBBS:	DB	0		;block shift
DPBBM:	DB	0		;block mask
DPBEM:	DB	0		;extent mask
DPBMAB: DW	0		;maximum allocation block number
DPBNOD: DW	0		;num. of directory entries - 1
DPBDAB: DW	0		;directory allocation blocks
DPBCBS: DW	0		;check buffer size
DPBTBD: DW	0		;tracks before directory (reserved trks)
DPBSZ:	EQU	$-DPB		;DPB size
RECPERBLK: DB	0		;computed sectors per block
;
GETDPB:
	MVI	C,GDPB		;get DPB function
	CALL	BDOS		;get DPB address
	MVI	C,DPBSZ 	;number of bytes to move
	LXI	D,DPB		;destination for move
GETDPBL:
	MOV	A,M		;get a byte
	STAX	D		;move it
	INX	D		;bump
	INX	H		;...pointers
	DCR	C		;bump down count
	JNZ	GETDPBL 	;loop for more moves
	LDA	DPBBS		;get block shift to find sectors/block
	MOV	C,A		;...into C
	MVI	A,1		;initialize for shift
SPBL:
	ADD	A		;shift left
	DCR	C		;count one shift
	JNZ	SPBL		;loop for more
	STA	RECPERBLK	;store sectors per block
	RET
;
;	GTAS - Get track and sector (given allocation block number)
;
;	Entry:	HL = allocation block number
;	Exit:	HL = track number
;		DE = sector number
;
GTAS:	LDA	DPBBS		;get block shift
GTASS:
	DAD	H		;shift block left
	DCR	A		;decrement BS
	JNZ	GTASS		;if more shift needed
	XCHG			;DE=all. block * sec/block
	LHLD	DPBSPT		;get sectors per track
	XCHG			;HL=total num sectors; DE=sec per track
	CALL	DIVHL		;BC=HL/DE(track), HL=remainder(sector)
	XCHG			;DE=sector, HL=track
	LHLD	DPBTBD		;track before directory
	DAD	B		;DE=sector, HL=absolute track
	RET
;
;	GNTAS - Get next track and sector.
;	Entry:	HL=current track number
;		DE=current sector number
;	Exit:	HL=updated track number
;		DE=updated sector number
;
GNTAS:	PUSH	H		;save track
	INX	D		;update sector
	LHLD	DPBSPT		;get sectors per track
	DCX	H		;adjust for first logical = 0
	CALL	SUBHL		;HL=HL-DE, CY set if underflow
	POP	H		;restore track
	RNC			;if no track update
	INX	H		;update track number
	LXI	D,0		;reset sector to 0
	RET
;
;	GMTAS - Get maximum track and sector
;		Call to GTAS with maximum allocation block as input
;	Entry:	none
;	Exit:	HL = maximum track number
;		DE = sector number in maximum block
;
GMTAS:
	LHLD	DPBMAB		;get maximum allocation block
	JMP	GTAS		;return from there
;
;	GAB - Get allocation block for given track and sector
;	Entry:	HL = track number
;		BC = sector number
;	Exit:	HL = allocation block number
;
GAB:
	PUSH	D		;save sector number
	XCHG			;DE = track number
	LHLD	DPBTBD		;get num of track before directory
	XCHG			;DE = tracks before dir; HL = track num
	CALL	SUBHL		;HL = HL - DE = relative track number
	XCHG			;DE = relative track
	LHLD	DPBSPT		;get sectors per track
	CALL	MULHL		;HL = HL*DE = total sectors
	XCHG			;DE = total sectors
	POP	H		;HL = sector number
;;	DCX	H		;make relative to 0
;	Error by Johnson-Laird?  Logical already relative to 0.
;
	DAD	D		;HL = relative sector
	LDA	DPBBM		;block mask
	MOV	B,A		;ready for AND
	MOV	A,L		;get LS byte of relative sector
	ANA	B		;AND with block mask
	PUSH	PSW		;A = sector displacement
	LDA	DPBBS		;get block shift
	MOV	C,A		;use for counter
GABS:
	CALL	SHLR		;shift HL right (mult by 2)
	DCR	C		;count shifts
	JNZ	GABS		;shift as needed
	POP	PSW		;recover offset
	RET
;
;	DIVHL - Divide HL by DE
;	Entry:	HL=dividend, DE=divisor
;	Exit:	BC=quotient, HL=remainder
;
DIVHL:	PUSH	D		;save divisor
	MOV	A,E		;complement divisor
	CMA
	MOV	E,A
	MOV	A,D
	CMA
	MOV	D,A
	INX	D
	LXI	B,0		;initialize quotient
DIVHLS: 			;subtract loop
	INX	B		;add one to quotient
	DAD	D		;subtract divisor
	JC	DIVHLS		;if dividend not yet negative
	DCX	B		;overshoot - subtract 1
	XCHG			;DE=remainder-divisor
	POP	H		;recover positive divisor
	DAD	D		;HL=remainder
	RET			;BC=quotient, HL=remainder
;
;	MULHL - HL = HL*DE using itterative add
;	Entry:	HL = multiplicand
;		DE = multiplier
;	Exit:	HL = product
;		DE = multiplier
;
MULHL:
	PUSH	B		;save user register
	MOV	A,H		;check for either entry zero
	ORA	L		;if zero - fake the product
	JZ	MULHLZ
	MOV	A,D
	ORA	E
	JZ	MULHLZ		;if zero - fake the product
	MOV	A,D		;get ms byte of value in DE
	CMP	H		;check which is smaller
	JC	MULHLN		;CY if D < H; no exchage
	XCHG			;if H < D
MULHLN:
	MOV	B,D		;make BC multiplier
	MOV	C,E
	MOV	D,H		;make DE = HL = multiplicand
	MOV	E,L
	DCX	B		;adjust count
MULHLA:
	MOV	A,B		;see if all iterations are done
	ORA	C
	JZ	MULHLX		;exit if done
	DAD	D		;HL = multiplicand + multiplicand
	DCX	B		;count down on multiplier - 1
	JMP	MULHLA		;loop until all ADDs done
MULHLZ:
	LXI	H,0		;fake product if either input is zero
MULHLX:
	POP	B		;recover user register
	RET
;
;	SUBHL - HL=HL-DE
;	Entry:	HL=subtrahend, DE=subtractor
;	Exit:	HL=difference
;
SUBHL:	MOV	A,L		;get ls byte
	SUB	E		;subtract without regard to carry
	MOV	L,A		;put difference back
	MOV	A,H		;get ms byte
	SBB	D		;subtract including carry
	MOV	H,A		;put difference back
	RET
;
;	SHLR - Shift HL right (divide by 2)
;	Entry:	HL = value to be divided
;	Exit:	HL = HL/2
;
SHLR:
	ORA	A		;clear CY
	MOV	A,H		;get ms byte
	RAR			;no CY to bit 7; zero bit to CY
	MOV	H,A		;restore shifted byte
	MOV	A,L		;get ls byte
	RAR			;bit 7 = zero of ms byte
	MOV	L,A		;restore shifted byte
	RET
;
;	CDEHL - Compare DE and HL for equality
;	Exit:	'Z' set if DE=HL
;
CDEHL:	MOV	A,E		;compare ls bytes
	XRA	L		;zero if same
	RNZ			;if not same
	MOV	A,D		;compare ms bytes
	XRA	H		;'Z' set if same
	RET
;
;	HLIHL - Loads HL indirect through HL
;
HLIHL:	MOV	A,M		;low byte to A
	INX	H		;point to high byte
	MOV	H,M		;high byte to H
	MOV	L,A		;low byte to L
	RET
;
;	CHECKTRACK - Checks for valid non-directory track number
;		     in the range from dir track up to DPB maximum.
;	Entry:	Binary track number in HL
;	Exit:	CY set if number out of range
;		Original track number in HL
;
CHECKTRACK:
	PUSH	H		;save entered track number
	XCHG			;track number to DE
	LHLD	DPBTBD		;get tracks before directory
	XCHG			;HL=track num; DE=TBD
	CALL	SUBHL		;ret with CY if Track num > TBD
	POP	H		;assume error
	RC			;ret with CY if error
	PUSH	H		;else - save track num again
	CALL	GMTAS		;get maximum track number to HL
	POP	D		;entry number to DE
	PUSH	D		;save again
	ORA	A		;set no CY
	CALL	SUBHL		;CY set if DE > HL
	POP	H		;return with entry number in HL
	RET
;
;	CHECKSEC - Checks for valid sector number in range from
;		   0 up to DPB sectors per track.
;	Entry:	Binary sector number in HL
;	Exit:	CY set if out of range
;		HL = original entered number
;
CHECKSEC:
	LDA	SECFLG		;logical=0; physical=1
	MOV	C,A		;flag to C
	MOV	A,L		;sector to A
	CMP	C		;CY if num < min
	RC			;ret with CY error
;
	PUSH	H		;save sector number
	LHLD	DPBSPT		;sectors per track to HL
	DCX	H		;assume logical number
	MOV	A,C		;get flag
	ORA	A		;Z if logical
	JZ	CHKSEC1
	INX	H		;else was physical
CHKSEC1:
	POP	D		;original entered number
	PUSH	D		;save again
	CALL	SUBHL		;CY set if entered number > valid SPT
	POP	H		;original number to HL
	RET
;
;	CHECKBLOCK - Checks for valid block number in range from
;		     1 up to DPB maximum block number.
;	Entry:	Binary block number in HL
;	Exit:	CY set if out of range
;		HL = original entered number
;
CHECKBLOCK:
	PUSH	H		;save binary block number
	LHLD	DPBMAB		;get maximum block number
	POP	D		;our entered number
	PUSH	D		;save again
	CALL	SUBHL		;CY set if entered number > valid MAB
	POP	H		;original number to HL
	RET
;
;	HEXOUT - Converts binary number to ascii hex digit string
;		 and places string in buffer.
;	Entry:	HL = Pointer to destination buffer
;		BC = binary number
;	Exit:	hex number in buffer
;
HEXOUT:
	MOV	A,B		;get ms byte
	CALL	HEXOUT1 	;put into buffer
	MOV	A,C		;get ls byte
HEXOUT1:
	PUSH	PSW		;save byte
	RAR			;ms nyble to ls position
	RAR
	RAR
	RAR
	ANI	0FH		;mask off ms nyble
	CALL	OUTHEX		;ascii out to buffer
	POP	PSW		;restore original byte
	ANI	0FH		;mask off ms nyble
	CALL	OUTHEX		;ascii out to buffer
	RET
;
;	OUTHEX - Supports HEXOUT
;
OUTHEX:
	CPI	9+1		;numeric?
	JC	HEXNUM		;if so
	ADI	'7'		;else bias for ascii alpha
	JMP	HEXBUF		;...and send to buffer
HEXNUM:
	ADI	'0'		;bias for ascii numeric
HEXBUF:
	MOV	M,A		;char to buffer
	INX	H		;point to next in buffer
	RET
;
;	ILPRT - Outputs text string following
;	the call.  Uses null string terminator.
;
ILPRT:
	POP	H		;get RET off stack
ILPRT1:
	MOV	A,M		;get a character
	INX	H		;bump pointer (past terminator if end)
	ORA	A		;null terminator?
	JZ	ILPRT2		;done if so
	PUSH	H		;save pointer
	MOV	E,A		;char to E
	MVI	C,CONOUT	;print it
	CALL	BDOS
	POP	H		;restore pointer
	JMP	ILPRT1		;get next
ILPRT2:
	PCHL			;return to pointer address
;
;	UDD - Unpack decimal digits to buffer.	Output is zero filled.
;	Entry:	BC=binary number to unpack
;		HL=output buffer address
;		A=decimal digit count
;	Exit:	HL=HL+A
;
UDD:	CALL	DADA		;point to last digit position
	PUSH	H		;save final HL value
UDD1:	PUSH	PSW		;save digit count
	PUSH	H		;save pointer
	LXI	D,10		;divide binary by 10
	CALL	DIV66		;HL=BC/DE
	PUSH	H		;move result
	POP	B		;...to BC
	POP	H		;restore pointer
	MVI	A,'0'		;ascii bias
	ADD	E		;add to remainder
	DCX	H		;decrement pointer
	MOV	M,A		;digit to buffer
	POP	PSW		;restore digit count
	DCR	A		;downcount
	JNZ	UDD1		;loop for next
	POP	H		;restore original pointer
	RET
;
;	DIV66 - HL=BC/DE, DE=remainder
;	(Used to set up registers to use DIVHL)
;	(DIVHL - BC=HL/DE, HL=remainder)
;
DIV66:	PUSH	B		;dividend to
	POP	H		;...HL, divisor in DE
	CALL	DIVHL		;BC=HL/DE
	XCHG			;remainder to DE
	PUSH	B		;quotient to
	POP	H		;...HL
	RET
;
;	SCIN$LE - Clear console buffer and read console in
;		  line mode with echo.	80 character buffer
;		  is appended to this subroutine.
;	Entry:	None
;	Exit:	Console line in buffer
;
SCIN$LE:
	PUSH H! PUSH D! PUSH B! PUSH PSW	;save registers
	LXI	H,CLIN		;...zero the buffer
	LDA	CBUF		;get buffer length
	MOV	B,A		;length to B
	XRA	A		;get a zero
SCIN$LE1:
	MOV	M,A		;zero a byte
	INX	H		;bump pointer
	DCR	B		;count down
	JNZ	SCIN$LE1	;do till done
	LXI	D,CBUF		;point to head of buffer
	MVI	C,CONBUF	;read console buffer function
	CALL	BDOS		;read console line to our buffer
	CALL	CRLF		;echo the CR,LF
	POP PSW! POP B! POP D! POP H		;restore registers
	RET
;
;	GETDIR - Reads directory tracks into memory for search
;		 of match with entry block number and file name
;		 to which it is assigned.
;		 No entry parameters.
;
GETDIR: LXI	H,0		;init to logical sectory 0
	SHLD	TMPSCT		;store for count
	LXI	H,DIRECT	;point to directory buffer
	SHLD	TMPDMA		;store for read pointer
	LHLD	DPBSPT		;get DPB sectors per track
	SHLD	TMPSPT		;store for count
	LHLD	DPBNOD		;max num direct entries - 1
	INX	H		;make true
	LXI	D,4		;4 entries per sector
	CALL	DIVHL		;compute number of directory sectors
	PUSH	B		;save number of sectors
	LHLD	DPBTBD		;get num tracks before directory
GETDIR1:
	PUSH	H		;move to BC
	POP	B
PATCHA: CALL	$-$		;set directory track
GETDIR2:
	LHLD	TMPSCT		;get sector number
	PUSH	H		;to BC
	POP	B
PATCHB: LXI	D,$-$		;point to translate table
PATCHC: CALL	$-$		;translate sector to physical
	PUSH	H		;physical to BC
	POP	B
PATCHD: CALL	$-$		;set sector
	LHLD	TMPDMA		;get current DMA address
	PUSH	H		;to BC
	POP	B
PATCHE: CALL	$-$		;set DMA
PATCHF: CALL	$-$		;read sector
	ORA	A		;zero if no error
	POP	B		;get sector count - clear stack
	JNZ	DIRERR		;if error in read
	DCX	B		;count down total sectors
	MOV	A,C
	ORA	B		;zero if done
	RZ
;
	PUSH	B		;save sector count
	LHLD	TMPSPT		;sector per track count
	DCX	H		;count down
	SHLD	TMPSPT		;re-store
	MOV	A,L		;if zero need new track
	ORA	H
	JZ	NEWTRK
;
	LHLD	TMPSCT		;else - get sector number
	INX	H		;bump it
	SHLD	TMPSCT		;store it
	LHLD	TMPDMA		;get DMA pointer
	LXI	D,128		;bump by one sector
	DAD	D
	SHLD	TMPDMA		;restore it
	JMP	GETDIR2 	;get another sector
;
NEWTRK: LHLD	TMPTBD		;get track number
	INX	H		;increment
	SHLD	TMPTBD		;re-store
	LXI	H,0		;reset sector number to logical 0
	SHLD	TMPSCT		;store it
	LHLD	TMPDMA		;current DMA pointer
	LXI	D,128		;bump to next sector
	DAD	D
	SHLD	TMPDMA		;store it
	JMP	GETDIR1 	;start with next track
;
DIRERR: CALL	ILPRT
	DB	CR,LF,'Bad sector in directory tracks...',CR,LF,0
	POP	H		;clear RET address from stack
	JMP	START2		;back to menu
;
;
;	FNDBLK - Searches directory sectors in buffer for entry
;		 block number match and displays file name if
;		 match found.
;		 Entry - binary block number in BINBLOCK (DW).
;		 NOTE:	If max number of blocks on disk, per Disk
;		 Parameter Block is >255, each block number in the
;		 directory entry field will occupy two bytes and the
;		 max number of blocks per extent will be 8.  Else,
;		 each block number will occupy one byte and extents
;		 will contain 16 blocks.
;
FNDBLK:
	LHLD	BINBLOCK		;check for zero - not allowed
	MOV	A,L
	ORA	H
	JZ	NOLUCK			;if zero
	LDA	DPBMAB+1		;will be zero if max blocks < 256
	STA	MABFLG			;store flag for later
	ORA	A
	MVI	A,16			;assume one byte blocks
	JZ	FNDBLK1 		;if so
	MVI	A,8			;else set for two byte blocks
;
FNDBLK1:
	STA	BLKCNT			;block counter per entry
	LHLD	DPBNOD			;get max num of dir entries - 1
	INX	H			;make true
	PUSH	H			;get to BC - our counter
	POP	B
	LXI	H,DIRECT		;point to directory buffer
;
FNDBLK2:
	MOV	A,M			;get char there
	ORA	A			;zero if active entry
	JNZ	FNDBLK5 		;if not active
	PUSH	H			;else - save pointer
	LXI	D,16			;offset to block numbers
	DAD	D			;HL points there
;
FNDBLK3:
	PUSH	H			;save block pointer
	CALL	HLIHL			;word at pointer to HL
	XCHG				;put in DE
	LHLD	BINBLOCK		;get binary block number
	XCHG				;swap HL and DE
	LDA	MABFLG			;see if two byte blocks
	ORA	A			;Z if not
	JZ	SMALBLK
	CALL	CDEHL			;else - check for match
	POP	H			;restore block pointer - clear stack
	JZ	FOUNDIT 		;if found - entry pointer on stack
	INX	H			;bump pointer twice for bigblocks
	INX	H
	JMP	FNDBLK4 		;go loop for next
;
SMALBLK:
	MVI	H,0			;small blocks - clear high byte
	CALL	CDEHL			;check for match
	POP	H			;get block pointer - clear stack
	JZ	FOUNDIT 		;if found - entry pointer on stack
	INX	H			;bump pointer once for small blocks
;
FNDBLK4:
	LDA	BLKCNT			;get block count for this entry
	DCR	A			;bump down
	STA	BLKCNT
	JNZ	FNDBLK3 		;check next block
	POP	H			;get entry pointer
	LXI	D,32			;index to next entry
	DAD	D
	DCX	B			;bump down entry count
	MOV	A,C
	ORA	B			;zero if done
	JZ	NOLUCK			;no match found
	LDA	MABFLG			;reset block counter for entry
	ORA	A
	MVI	A,16			;assume two byte blocks
	JZ	FNDBLK4A		;if not
	MVI	A,8			;else set for one byte blocks
;
FNDBLK4A:
	STA	BLKCNT
	JMP	FNDBLK2 		;go check next entry
;
FNDBLK5:
	DCX	B			;bump down entry count
	MOV	A,C
	ORA	B			;zero if done
	JZ	NOLUCK			;no match found
	LXI	D,32			;else - index to next entry
	DAD	D			;pointer in HL
	JMP	FNDBLK2 		;go check next entry
;
FOUNDIT:				;found a match
	POP	H			;get entry pointer
	INX	H			;point past active flag
	LXI	D,FNAME 		;space in output message
	MVI	C,8			;8 char in filename
;
FOUND1:
	MOV	A,M			;get a char
	CPI	' '			;blank?
	JNZ	FOUND2			;if not
	INX	H			;else - bump pointer
	DCR	C			;count down
	JNZ	FOUND1			;skip spaces
	JMP	FOUND3			;go for extension
;
FOUND2:
	STAX	D			;char to message field
	INX	H			;bump pointers
	INX	D
	DCR	C			;count down
	JNZ	FOUND1			;loop for all
;
FOUND3:
	MVI	A,'.'			;insert a dot
	STAX	D
	INX	D			;extension space
	MVI	C,3			;max three char
;
FOUND4:
	MOV	A,M			;get char
	CPI	' '			;skip spaces
	JNZ	FOUND5			;if not
	INX	H			;bump pointer
	DCR	C			;count down
	JNZ	FOUND4			;if not done
	JMP	FOUND6			;message full
;
FOUND5:
	STAX	D			;char to msg
	INX	H			;bump pointers
	INX	D
	DCR	C			;count down
	JNZ	FOUND4			;if not done
;
FOUND6: 				;done - print message
	XRA	A			;get a null
	STAX	D			;terminate message
	CALL	ILPRT
	DB	CR,LF,LF,'Block assigned to file '
FNAME:	DB	'filename.ext',0
	CALL	ILPRT
	DB	'...',CR,LF,0
	RET
;
NOLUCK: 				;done - block not assigned
	CALL	ILPRT
	DB	CR,LF,LF
	DB	'Block is not assigned to an active file...',CR,LF,0
	RET
;
;
;	The console buffer
;
CBUF:	DB	CLEN		;buffer length
CLEFT:	DB	0		;number of characters entered
CLIN:	DS	80		;the 80 character buffer
CLEN:	EQU	$-CLIN		;buffer length for CBUF
;
;*******************
;* PROGRAM STORAGE *
;*******************
;
DEFDRV: DB	0		;entry default drive storage
TMPRPB: DB	0		;records per block buffer
TMPTRK: DW	0		;track number buffer
TMPSEC: DW	0		;sector number buffer
BINTRACK:
	DW	0		;binary track number
BINSECT:
	DW	0		;binary sector number
BINBLOCK:
	DW	0		;binary block number
ROWCNT: DB	ROWMAX		;counter for sector/row
SECFLG: DB	0		;logical/physical sector flag
MABFLG: DB	0		;default one byte blocks
TMPSCT: DW	0		;temp sector number
TMPDMA: DW	DIRECT		;temp DMA address
TMPSPT: DW	26		;temp sectors per track
TMPTBD: DW	2		;temp tracks before directory
BLKCNT: DB	16		;block count in dir search
;
;
;**************************
;* UNITIALIZED STACK AREA *
;**************************
	DS	64
STACK:	EQU	$
;
;***************************
;* UNITIALIZED BUFFER AREA *
;***************************
;
DIRECT: EQU	$		;directory buffer
;
	END	START
;