unit Formunit;   {Formatierroutinen fr Standardformate}

interface

const     {Laufwerkstabellen fr Standardformate}
  tab36 : array[1..11] of byte
          = ($df,$02,$25,$02,$09,$2a,$ff,$50,$f6,$0f,$08);
  tab12 : array[1..11] of byte
          = ($df,$02,$25,$02,$0f,$1b,$ff,$54,$f6,$0f,$08);
  tab14 : array[1..11] of byte
          = ($af,$02,$25,$02,$12,$1b,$ff,$6c,$f6,$0f,$08);
  form36 : array[1..4] of byte
                           {Mediabyte, Sektoren pro Cluster}
          = ($fd,2,$70,2);
               {Eintrge Hauptverzeichnis, Sektoren pro FAT}
  form72 : array[1..4] of byte
          = ($f9,2,$70,3);
  form12 : array[1..4] of byte
          = ($f9,1,$e0,7);
  form14 : array[1..4] of byte
          = ($f0,1,$e0,9);
  versuche = 5;       {Zahl der Versuche bei Fehlern}

type
  tabelle = array[1..4] of byte;

var
  laufwerka, laufwerkb : byte;    {Art der Laufwerke}
  tabalt, tabneu       : pointer; {Zeiger auf Laufwerkstabelle}
  formtab              : ^tabelle; {Zeiger auf Diskformate}
  einzelschritt        : boolean;  {Einzelstep}

procedure diskreset;                   {Reset bei Fehlern}
function  config(drive : byte) : byte; {Laufwerkskonfiguration}
procedure einzelstep;          {720 KB in 5.25 MF-Laufwerk}
procedure schreibrate(art, kap, drive : byte);
 {Schreibrate whlen}
 {Procedure Schreibrate immer vor Laufwerkstabneu aufrufen !}
procedure laufwerkstabneu;     {neuer DPB}
procedure laufwerkstabalt;
function  readwriteverify(was, spur, seite, sektor,
                          anzahl, drive : byte;
                          var buffer) : byte;
function  spurformat(spur, seite, sektor,
                     anzahl, drive : byte) : byte;

implementation

uses dos;

{************************************************************}
procedure diskreset;
var
  cpu     : registers;
  zaehler : byte;

begin
  zaehler:=versuche;
  repeat
    cpu.ah:=0;  {Diskreset}
    cpu.dl:=0;  {Reset fr alle Laufwerke}
    intr($13, cpu);
    dec(zaehler,1);
  until (zaehler=0) or (cpu.flags and fcarry=0) or (cpu.ah=0);
  if einzelschritt then einzelstep;  {Wichtig}
  {Nach jedem Reset umschalten auf Einzelstep !}
end;
{************************************************************}
function config(drive : byte) : byte;
var                                   { 0 : Kein Laufwerk}
  cpu     : registers;                { 1 : 360 KB}
  zaehler : byte;                     { 2 : 1.2 MB}
                                      { 3 : 720 KB}
                                      { 4 : 1.44 MB}
begin
  zaehler:=versuche;
  repeat
    cpu.ah:=8;     {Feststellen des Laufwerkstyps}
    cpu.dl:=drive; {Nummer des Laufwerks}
    intr($13, cpu);
    dec(zaehler,1);
  until (zaehler=0) or (cpu.flags and fcarry=0) or (cpu.ah=0);
  if zaehler=0 then
  begin {Funktion nicht vorhanden, dann XT oder hnlich}
    case drive of
      0: begin
           intr($11, cpu); {Feststellung der Konfiguration}
           config:=(cpu.al and $01) ;      {1 = Drive A da}
         end;{Equipmentword IPL-Bit, berhaupt Diskette da?}

      1: begin
           intr($11, cpu); {Feststellung der Konfiguration}
           zaehler:=(cpu.al and $C0) shr 6;
           if zaehler=0 then {kein Laufwerk B}
              config:=0
           else
              config:=1     {Laufwerk B da}
         end; {Equipmentword Drive-Zhler, 00=1 Drive, 01=2}
    else
         config:=0; {alle anderen Anforderungen abweisen}
    end;
  end
  else
    config:=cpu.bl;  {Art des Laufwerks}
end;
{************************************************************}
procedure einzelstep; {720 KB in 5.25 MF-Laufwerk}
var
  inhalt : byte;
begin
  inhalt:=mem[$0040:$0090]; {Controllerbyte}
  inhalt:=inhalt and $DF;
  mem[$0040:$0090]:=inhalt; {Einzelstep fr Laufwerk A}
  inhalt:=mem[$0040:$0091];
  inhalt:=inhalt and $DF;
  mem[$0040:$0091]:=inhalt; {Einzelstep fr Laufwerk B}
end;
{************************************************************}
procedure schreibrate(art, kap, drive : byte);
var
  cpu           : registers;
  form, zaehler : byte;
  ax            : word;

begin
  if art=1 then
  begin
    form:=1;  {360 KB Laufwerk}
    tabneu:=@tab36;   {360 KB Laufwerkstabelle}
    formtab:=@form36; {360 KB Diskettenformat}
    cpu.ax:=$1828; cpu.cx:=$2709;  {Parameter fr 18h}
  end
  else
  if art=2 then        {1.2 MB MF-Laufwerk}
    if kap<=2 then
    begin
      form:=2;
      tabneu:=@tab36;  {360 KB oder 720 KB in 5,25 MF-Drive}
      cpu.ax:=$1828; cpu.cx:=$2709;
      if kap=1 then formtab:=@form36 else formtab:=@form72;
    end
    else
    begin
      form:=3;
      tabneu:=@tab12;  {1.2 MB in 1.2 MB-Laufwerk}
      formtab:=@form12;
      cpu.ax:=$1850; cpu.cx:=$4f0f;
    end
  else
  if art>=3 then         {720 KB oder 1.44 MB Laufwerk}
    if kap<=2 then
    begin
      form:=4;
      tabneu:=@tab36;
      formtab:=@form72;  {720 KB}
      cpu.ax:=$1850; cpu.cx:=$4f09;
    end
    else
    begin
      form:=3;
      tabneu:=@tab14;
      formtab:=@form14;  {1.44 MB}
      cpu.ax:=$1850; cpu.cx:=$4f12;
    end;
  zaehler:=versuche;
  ax:=cpu.ax;       {AX-Register wird durch Funktion verndert}
  repeat
    cpu.ax:=ax;
    cpu.dl:=drive;  {Nummer des Laufwerks}
    intr($13, cpu); {Funktion Nr. 18h aufrufen}
    if cpu.flags and fcarry=1 then
    begin
      diskreset;    {Fehler aufgetreten}
      dec(zaehler);
    end;
  until (cpu.flags and fcarry=0) or (zaehler=0) or (cpu.ah=0);
  if (zaehler=0) then  {Funktion 18h nicht vorhanden}
  begin
    zaehler:=versuche; {letzte Rettung}
    repeat     {Funktion Nr. 17h, falls 18h nicht vorhanden}
      cpu.ah:=$17;     {Schreibrate setzen}
      cpu.al:=form;
      cpu.dl:=drive;   {Welches Laufwerk formatieren}
      intr($13, cpu);
      if cpu.flags and fcarry=1 then
      begin
        diskreset;     {Fehler aufgetreten}
        dec(zaehler);
      end;
    until (cpu.flags and fcarry=0) or (zaehler=0) or (cpu.ah=0);
  end;
  if (art=2) and (kap=2) then
  begin    {720 KB in 5,25}
    einzelstep;
    einzelschritt:=true;  {Merker fr Einzelstep eingeschaltet}
  end
  else     {anderes Format gewhlt}
    einzelschritt:=false; {Kein Einzelschritt eingeschaltet}
end;
{************************************************************}
procedure laufwerkstabneu;

begin
  getintvec($1e,tabalt);
  setintvec($1e,tabneu);
end;
{************************************************************}
procedure laufwerkstabalt;

begin
  setintvec($1e,tabalt);
end;
{************************************************************}
function readwriteverify(was, spur, seite, sektor,
                         anzahl, drive : byte;
                         var buffer) : byte;
var
  cpu     : registers;
  zaehler : byte;

begin                {was=2 : Sektoren von Diskette lesen}
  zaehler:=versuche; {was=3 : Sektoren auf Diskette schreiben}
  repeat             {was=4 : Sektoren verifizieren}
    cpu.ah:=was;
    cpu.dl:=drive;
    cpu.dh:=seite;
    cpu.ch:=spur;
    cpu.cl:=sektor;
    cpu.al:=anzahl;
    cpu.es:=seg(buffer);
    cpu.bx:=ofs(buffer);
    intr($13, cpu);
    readwriteverify:=cpu.ah;    {Rckgabe des Fehlercodes}
    if cpu.flags and fcarry=1 then
    begin
      readwriteverify:=cpu.ah;  {Fehlercode}
      diskreset;
    end;
    dec(zaehler);
  until (zaehler=0) or (cpu.flags and fcarry=0) or (cpu.ah=0);
end;
{************************************************************}
function  spurformat(spur, seite, sektor,
                     anzahl, drive : byte) : byte;
type
  formrec = record
              trackdisk, seitedisk, sektordisk, zahlbyte : byte;
            end;
var
  cpu       : registers;
  formattab : array[1..18] of formrec; {Max. 18 Sektoren}
  zaehler   : byte;
  sekzahl   : byte;

begin
  zaehler:=versuche;
  for sekzahl:=1 to anzahl do
  begin
    formattab[sekzahl].trackdisk:=spur;
    formattab[sekzahl].seitedisk:=seite;
    formattab[sekzahl].sektordisk:=sekzahl;
    formattab[sekzahl].zahlbyte:=2;
  end;
  repeat
    cpu.ah:=5;     {Spur formatieren}
    cpu.dl:=drive;
    cpu.dh:=seite;
    cpu.ch:=spur;
    cpu.al:=anzahl;
    cpu.es:=seg(formattab);
    cpu.bx:=ofs(formattab);
    intr($13, cpu);
    spurformat:=cpu.ah;  {Rckgabe des Fehlercodes}
    if cpu.flags and fcarry=1 then
    begin
      spurformat:=cpu.ah;
      diskreset;
    end;
    dec(zaehler);
  until (zaehler=0) or (cpu.flags and fcarry=0) or (cpu.ah=0);
end;
{********************Hauptprogramm der Unit******************}
begin
  laufwerka:=config(0);
  laufwerkb:=config(1);  {Art von Laufwerk A und B}
end.
