mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-23 08:24:18 +00:00
381 lines
11 KiB
ObjectPascal
381 lines
11 KiB
ObjectPascal
(*************************************************************************)
|
|
(* FMFD *)
|
|
(* *)
|
|
(* High level disk formatting utility *)
|
|
(* for SS/DS 40/80T floppy disks *)
|
|
(* *)
|
|
(* (c) 2009 Copyright S.J.Kay *)
|
|
(*************************************************************************)
|
|
|
|
{ WARNING - Make sure the END address is lowered to say about $8000 }
|
|
{ before compiling to disk otherwise it will crash when used from }
|
|
{ within a SUBMIT file. This happens to any TURBO v2.00a compiled }
|
|
{ program because it does not check the TPA size !. }
|
|
|
|
{$C-} { turn off ^C and ^S checking }
|
|
|
|
const
|
|
APPNAME = 'FMFD';
|
|
APPVERS = '1.0.0';
|
|
APPDATE = '26 February 2009';
|
|
|
|
FORMAT_BYTE = $e5;
|
|
|
|
type
|
|
String80 = string[80];
|
|
String127 = string[127];
|
|
|
|
var
|
|
Version : integer;
|
|
DrvChr : char;
|
|
DrvCde : integer;
|
|
BnkFlg : byte;
|
|
Parameters : String80;
|
|
ComLne : String80 absolute $0080;
|
|
Buffer : array [0..1023] of byte;
|
|
SecTrk : integer;
|
|
DiskSides : integer;
|
|
DiskTracks : integer;
|
|
|
|
BIOSPB : record
|
|
FN : byte;
|
|
A : byte;
|
|
BC : integer;
|
|
DE : integer;
|
|
HL : integer
|
|
end;
|
|
|
|
|
|
procedure BiosCall (Fn, A : byte; BC, DE, HL : integer);
|
|
begin
|
|
BIOSPB.FN := Fn;
|
|
BIOSPB.A := A;
|
|
BIOSPB.BC := BC;
|
|
BIOSPB.DE := DE;
|
|
BIOSPB.HL := HL;
|
|
bdos(50, addr(BIOSPB))
|
|
end;
|
|
|
|
|
|
function BiosFunc (Fn, A : byte; BC, DE, HL : integer) : byte;
|
|
begin
|
|
BIOSPB.FN := Fn;
|
|
BIOSPB.A := A;
|
|
BIOSPB.BC := BC;
|
|
BIOSPB.DE := DE;
|
|
BIOSPB.HL := HL;
|
|
BiosFunc := bdos(50, addr(BIOSPB))
|
|
end;
|
|
|
|
|
|
procedure BiosX (Fn, Ax : byte; BCx, DEx, HLx : integer);
|
|
begin
|
|
inline
|
|
(
|
|
$3A/Fn/ { ld a,(Fn) }
|
|
$4F/ { ld c,a }
|
|
$87/ { add a,a }
|
|
$81/ { add a,c }
|
|
$06/$00/ { ld b,0 }
|
|
$4F/ { ld c,a }
|
|
$2A/$01/$00/ { ld hl,(0001h) }
|
|
$09/ { add hl,bc }
|
|
$22/* + 17/ { ld (zzzz),hl }
|
|
$3A/Ax/ { ld a,(Ax) }
|
|
$ED/$4B/BCx/ { ld bc,(BCx) }
|
|
$ED/$5B/DEx/ { ld de,(DEx) }
|
|
$2A/HLx/ { ld hl,(HLx) }
|
|
$CD/$00/$00 { call zzzz }
|
|
)
|
|
end;
|
|
|
|
|
|
procedure GetBIOSdata (AdrSor, AdrDst, Amount : integer);
|
|
begin
|
|
BiosX(28, 0, $0100, 0, 0); { set xmove banks, bank #0 to bank #1 }
|
|
BiosX(24, 0, Amount, AdrSor, AdrDst) { move memory }
|
|
end;
|
|
|
|
|
|
function GetBIOSword (AdrSor : integer) : integer;
|
|
const
|
|
WrdDst : integer = 0;
|
|
begin
|
|
GetBIOSdata(AdrSor, addr(WrdDst), 2);
|
|
GetBIOSword := WrdDst
|
|
end;
|
|
|
|
|
|
function GetBIOSbyte (AdrSor : integer) : byte;
|
|
const
|
|
BytDst : byte = 0;
|
|
begin
|
|
GetBIOSdata(AdrSor, addr(BytDst), 1);
|
|
GetBIOSbyte := BytDst
|
|
end;
|
|
|
|
{
|
|
*==========================================================================
|
|
* Return the number of command line parameters.
|
|
*
|
|
* pass: void
|
|
* return: integer number of parameters
|
|
*==========================================================================
|
|
}
|
|
function ParamCount : integer;
|
|
var
|
|
i, PrmCnt, PrmLen : integer;
|
|
begin
|
|
i := 1;
|
|
PrmCnt := 0;
|
|
PrmLen := length(ComLne);
|
|
while i <= PrmLen do
|
|
begin
|
|
while (i <= PrmLen) and (ComLne[i] = ' ') do
|
|
i := i + 1;
|
|
if i <= PrmLen then
|
|
PrmCnt := PrmCnt + 1;
|
|
if ComLne[i] = '/' then
|
|
i := i + 1;
|
|
while (i <= PrmLen) and (not(ComLne[i] in [' ', '/'])) do
|
|
i := i + 1
|
|
end;
|
|
ParamCount := PrmCnt
|
|
end;
|
|
|
|
{
|
|
*==========================================================================
|
|
* Return the specified command line parameter.
|
|
*
|
|
* pass: PrmNmb : integer
|
|
* return: String127 parameter
|
|
*==========================================================================
|
|
}
|
|
function ParamStr (PrmNmb : integer) : String127;
|
|
var
|
|
i, PrmCnt, PrmLen : integer;
|
|
PrmStr : string[127];
|
|
begin
|
|
i := 1;
|
|
PrmCnt := 0;
|
|
PrmStr := '';
|
|
PrmLen := length(ComLne);
|
|
while (i <= PrmLen) and (PrmCnt < PrmNmb) do
|
|
begin
|
|
while (i <= PrmLen) AND (ComLne[i] = ' ') do
|
|
i := i + 1;
|
|
if i <= PrmLen then
|
|
PrmCnt := PrmCnt + 1;
|
|
if ComLne[i] = '/' then
|
|
begin
|
|
PrmStr := '/';
|
|
i := i + 1
|
|
end
|
|
else
|
|
PrmStr := '';
|
|
while (i <= PrmLen) and (not (ComLne[i] in [' ', '/'])) do
|
|
begin
|
|
PrmStr := PrmStr + ComLne[i];
|
|
i := i + 1
|
|
end
|
|
end;
|
|
ParamStr := PrmStr
|
|
end;
|
|
|
|
{
|
|
*==========================================================================
|
|
* Write disk sector
|
|
*
|
|
* pass: track : integer
|
|
* sector : integer
|
|
* return: byte 0 if no error
|
|
*==========================================================================
|
|
}
|
|
function WriteDiskSector ( track : integer;
|
|
sector : integer) : byte;
|
|
var
|
|
res_a : byte;
|
|
begin
|
|
BiosCall(10, 0, track, 0, 0); { set physical track }
|
|
BiosCall(11, 0, sector, 0, 0); { set physical sector }
|
|
BiosCall(12, 0, addr(buffer), 0, 0); { set DMA address }
|
|
BiosCall(28, 1, 0, 0, 0); { set data bank #1 (TPA) }
|
|
res_a := BiosFunc(14, 0, 0, 0, 0); { write 1 sector }
|
|
WriteDiskSector := res_a;
|
|
end;
|
|
|
|
{
|
|
*==========================================================================
|
|
* Write disk track.
|
|
*
|
|
* Skewing is used to speed things up.
|
|
*
|
|
* pass: track : integer
|
|
* return: byte 0 if no error
|
|
*==========================================================================
|
|
}
|
|
function WriteDiskTrack (track : integer) : byte;
|
|
var
|
|
s : integer;
|
|
res : byte;
|
|
begin
|
|
s := 1;
|
|
repeat
|
|
res := WriteDiskSector(track, s);
|
|
s := s + 1;
|
|
until ((res <> 0) or (s > SecTrk));
|
|
WriteDiskTrack := res;
|
|
end;
|
|
|
|
{
|
|
*==========================================================================
|
|
* Format all tracks.
|
|
*
|
|
* pass: drive : char drive char (A-B)
|
|
* return: void
|
|
*==========================================================================
|
|
}
|
|
procedure FormatAllTracks;
|
|
var
|
|
t : integer;
|
|
res : integer;
|
|
completed : real;
|
|
begin
|
|
BiosCall(9, 0, DrvCde, 1, 0);
|
|
|
|
fillchar(buffer, sizeof(buffer), FORMAT_BYTE);
|
|
t := 0;
|
|
writeln;
|
|
write(' 0 percent completed', ^M);
|
|
repeat
|
|
res := WriteDiskTrack(t);
|
|
t := t + 1;
|
|
completed := (t / (DiskTracks * DiskSides)) * 100.0;
|
|
write(completed:3:0, ^M);
|
|
until ((res <> 0) or (t = (DiskTracks * DiskSides)));
|
|
bdos(37, 1 shl DrvCde); { reset the formatted drive }
|
|
writeln;
|
|
writeln;
|
|
if (res = 0) then
|
|
writeln('Format completed')
|
|
else
|
|
writeln('Format failed');
|
|
end;
|
|
|
|
{
|
|
*==========================================================================
|
|
* Format disk
|
|
*
|
|
* pass: drive : char drive char (A-B)
|
|
* return: void
|
|
*==========================================================================
|
|
}
|
|
procedure FormatDisk (drive : char);
|
|
var
|
|
TblAdr : integer;
|
|
DPH, DPB, SPT, PHM : integer;
|
|
res_hl : integer;
|
|
def_drive : byte;
|
|
response : string[1];
|
|
begin
|
|
DrvCde := ord(drive) - ord('A');
|
|
TblAdr := bioshl(21) + DrvCde * 2;
|
|
DPH := GetBIOSword(TblAdr);
|
|
if (DPH <> 0) then
|
|
begin
|
|
DPB := GetBIOSword(DPH+12);
|
|
SPT := GetBIOSword(DPB); { sectors/track }
|
|
PHM := GetBIOSbyte(DPB+16); { physical sector mask }
|
|
SecTrk := SPT DIV (PHM + 1);
|
|
|
|
writeln('WARNING - All data on ', drive,
|
|
': will be lost forever !');
|
|
|
|
write('Are you sure [y/n] ?: ');
|
|
buflen := 1;
|
|
readln(response);
|
|
if ((response = 'y') or (response = 'Y')) then
|
|
FormatAllTracks
|
|
else
|
|
writeln('Format aborted');
|
|
end
|
|
else
|
|
writeln('The drive specified does not exist')
|
|
end;
|
|
|
|
{
|
|
*==========================================================================
|
|
* Usage Information
|
|
*
|
|
* pass: void
|
|
* return: void
|
|
*==========================================================================
|
|
}
|
|
procedure UsageInformation;
|
|
begin
|
|
writeln(APPNAME, ' v', APPVERS, ' (c) Copyright S.J.Kay ', APPDATE);
|
|
writeln;
|
|
writeln('!!! WARNING !!!');
|
|
writeln('This program performs a high level disk format by writing E5 hex');
|
|
writeln('to all locations on the disk, this is just as destructive as a');
|
|
writeln('low level format, you will lose all data on the disk!');
|
|
writeln;
|
|
writeln('Usage:- ', APPNAME, ' SS/DS 40/80 drive:');
|
|
writeln;
|
|
writeln(' SS/DS = SS is single sided, DS is double sided disk');
|
|
writeln(' 40/80 = 40 or 80 tracks per disk side');
|
|
writeln('drive: = CP/M drive A: or B:');
|
|
end;
|
|
|
|
var
|
|
parm : String127;
|
|
Error : integer;
|
|
begin
|
|
Version := bdoshl(12);
|
|
if (hi(Version) = $00) and (lo(Version) >= $30) then
|
|
begin
|
|
Error := ord(ParamCount <> 3);
|
|
if (Error = 0) then
|
|
begin
|
|
parm := ParamStr(1);
|
|
if (parm = 'SS') then
|
|
DiskSides := 1
|
|
else
|
|
if (parm = 'DS') then
|
|
DiskSides := 2
|
|
else
|
|
Error := 1;
|
|
|
|
if (Error = 0) then
|
|
begin
|
|
parm := ParamStr(2);
|
|
if (parm = '40') then
|
|
DiskTracks := 40
|
|
else
|
|
if (parm = '80') then
|
|
DiskTracks := 80
|
|
else
|
|
Error := Error + 1;
|
|
end;
|
|
|
|
if (Error = 0) then
|
|
begin
|
|
parm := ParamStr(3);
|
|
if (length(parm) = 2) then
|
|
parm[1] := upcase(parm[1]);
|
|
if ((parm[2] = ':') and (parm[1] in ['A'..'B'])) then
|
|
FormatDisk(parm[1])
|
|
else
|
|
Error := Error + 1;
|
|
end;
|
|
end;
|
|
if (Error <> 0) then
|
|
UsageInformation
|
|
end
|
|
else
|
|
begin
|
|
writeln;
|
|
writeln('Wrong SYSTEM, requires CP/M Plus ver 3.0 up')
|
|
end
|
|
end.
|