
{============================================================================}
{                                                                            }
{         Modul fuer BiosBasedFormatier-Programm (VERS.1.0  29.8.86)         }
{                                                                            }
{         Es errechnet die Parameter fuer das Formatier-Programm             }
{         aus dem DISK-BLOCK des BIOS , der in die TPA geladen wird.         }
{                                                                            }
{                                                                            }
{============================================================================}





{========== TYPEN- und VARIABLEN-Vereinbarungen fuer BBFMOD =================}




TYPE  bytearray=array[0..15]of byte;

      BLK_REC=record
                disktyp,
                fsektor,
                lsektor,
                lwpre,
                tth1,
                gap,
                spuren,
                wrpspur            :byte;
                spt                :integer;
                bsh,
                blm,
                exm                :byte;
                dsm,
                drm                :integer;
                al0,
                al1                :byte;
                cks,
                syso               :integer;
                psh,
                phm                :byte;
                spointer,
                tpointer           :integer;
                barray             :bytearray;
                fgap,
                fskew,
                reserved           :byte;
        end;

blk_typ=array[0..200]of blk_rec;

skew_type=array[0..159]of byte; { Datenformat der Skew-Tabellen }

itable=array[0..255]of byte;

dreizahl=string[3];
vierzahl=string[4];
szahl=string[16];

fd = record
        nummer:dreizahl;
        fname:szahl;
        lawegu:vierzahl;
     end;

VAR blkparameter:blk_typ;
    xdpb_anz    :byte;
    bidtable    :itable;
    formdat     :array[0..20]of fd;


{ ============= Ende der TYPE- und VAR- Declarationen ============= }


procedure GET_DATA;
var blkfile : file;
{   blkpara : array[0..5000] of byte;}

   i       : integer;
begin
 assign(blkfile,'b:blkpara.dat');
 reset(blkfile);
 i := filesize(blkfile);
 blockread(blkfile,blkparameter,i);
 close(blkfile);
end;

function ggt(m,n:integer):integer;
var rest,x:integer;
begin
   rest:=0;
   repeat
      x:=m div n;
      rest:=m-n*x;
      m:=n;n:=rest;
   until rest=0;
   ggt:=m;
end;

procedure genidtable(skew,sanz,erstsektnr:integer);
var sektcount,nrokor,nfree,pos,idnr,uberlauf:integer;
    schluss:boolean;
begin
   nrokor:=sanz div ggt(sanz,skew);pos:=0;idnr:=erstsektnr;uberlauf:=1;
   schluss:=false;
   if ggt(sanz,skew)=1 then
               begin
                  repeat
                     bidtable[pos]:=idnr;
                     pos:=(pos+skew)mod sanz;idnr:=idnr+1;
                  until (idnr-erstsektnr)=sanz;
               end
            else
               begin
                  repeat
                     sektcount:=0;
                     repeat
                        bidtable[pos]:=idnr;idnr:=idnr+1;
                        pos:=(pos+skew)mod sanz;sektcount:=sektcount+1;
                     until((sektcount=nrokor)or((idnr-erstsektnr)=sanz));
                     if (idnr-erstsektnr)=sanz then schluss:=true;
                     pos:=uberlauf;uberlauf:=uberlauf+1;
                  until schluss;
               end;
end;


FUNCTION BITTEST (TESTBYTE:byte; POS:integer):boolean;
VAR b:byte;
BEGIN
   b:=1 shl POS;
   BITTEST:=(TESTBYTE and b)<>0;
END;



FUNCTION PARAMETER_BASE:integer;

{ Ermittelt die Startadresse der BIOS-Parameter         }

BEGIN
   PARAMETER_BASE:=mem[$FF4E]*$100 + mem[$FF4D];
END;


FUNCTION BIOS3 (fn,pa,pbc,pde,phl:integer):integer;

{ CP/M-3 BIOS-CALL                                        }

TYPE parameterblock=record
                        func,areg:byte;
                        bcreg,dereg,hlreg:integer;
                    end;
VAR biospb:parameterblock;
    result:integer;

BEGIN
   with biospb do begin
        func:=fn;
        areg:=pa;
        bcreg:=pbc;
        dereg:=pde;
        hlreg:=phl;
   end;
   result:=0;
   case fn of
    2,3,7,13,14,15,17,18,19,24 : result:=bdos(50,addr(biospb));
    9,16,20,22,25 :result:=bdoshl(50,addr(biospb))
   else bdos(50,addr(biospb))
   end;
   BIOS3:=result
END;   





PROCEDURE LOAD_DISK_BLK ( INTO_RAM:INTEGER);

(*  Diese Procedure laedt den DISK-BLOCK (max. 8k) in die TPA *)
(*  wobei INTO_RAM die Anfangsadresse angibt.                 *)
{ Bringt bestehende Diskparameter in Arbeitsvariable Blkparameter
  setzt alle vorhandenen Skew-Pointer auf relative Adressen um
  ermittelt die Anzahl der schon bestehenden Formate.                }

VAR i:integer;
    test:byte;

BEGIN
{ Speicherbereich von Blkparameter mit Diskparametern aus BIOS laden }
   i:=BIOS3(30,0,0,addr(blkparameter),0);
{ Die Anzahl der Diskformate zaehlen .                                }
   xdpb_anz:=0;
   while blkparameter[xdpb_anz].disktyp <> 8 do xdpb_anz:=xdpb_anz+1;
{ Die Skew-Pointer werden auf die relative Adresse justiert        }
   for i:= 0 to xdpb_anz-1 do
        with blkparameter[i] do
                begin
                   spointer:=spointer - PARAMETER_BASE;
                end;
END;




FUNCTION GET_HEADID (NR,HEADNR:integer):byte;

(* Liefert den Wert fuer HEADID , wahrscheinlich in der Form
   HEADID:=GETHEAD ( 0/1 );                                  *)

BEGIN
  with blkparameter[NR] do begin
   if HEADNR=0 then
                 if BITTEST(disktyp,4) then GET_HEADID:=1
                                       else GET_HEADID:=0
               else
                 if BITTEST(tth1,4) then GET_HEADID:=1
                                    else GET_HEADID:=0
  end { with }
END;





FUNCTION GET_SPURANZ (NR:integer):byte;

(* Liefet die Anzahl der Spuren zurueck. Wird benoetigt fuer
   Schleifenzaehler in SEITFORM  und VERIFIZIERE              *)

BEGIN
   GET_SPURANZ:=blkparameter[NR].spuren;
END;





FUNCTION GET_WRPRECOMP_SPUR (NR:integer):byte;

(* Liefert die Nummer der Spur, ab der die Writeprecompensation
   einsetzen soll.                                              *)

BEGIN
   with blkparameter[NR] do begin
        if wrpspur>spuren then wrpspur:=spuren+1;
        GET_WRPRECOMP_SPUR:=wrpspur;
   end
END;



FUNCTION GET_WRPRECOMP (NR:integer):byte;

{ Liefert den Wert der Write-precompensation als Byte aus 0..7  }

BEGIN
   with blkparameter[NR] do begin
        if wrpspur>spuren then GET_WRPRECOMP:=0
                          else GET_WRPRECOMP:=(lwpre and $07);
   end
END;




FUNCTION GET_DECIMAL_SECTORSIZE (NR:integer):integer;

(* Liefert den dezimalen Wert der Sektorgroesse, zur Berechnung
   ob der Vergleich in einem oder zwei Durchgaengen erfolgen muss *)

BEGIN
   with blkparameter[NR] do begin
        case (disktyp and $07) of
         0 : GET_DECIMAL_SECTORSIZE:=128;
         1 : GET_DECIMAL_SECTORSIZE:=256;
         2 : GET_DECIMAL_SECTORSIZE:=512;
         3 : GET_DECIMAL_SECTORSIZE:=1024;
        end;
   end
END;




FUNCTION GET_SEKT_ANZ (NR:integer):byte;

(* Liefert die Anzahl der Sektoren pro Spur.  *)

BEGIN
   with blkparameter[NR] do begin
        GET_SEKT_ANZ:=spt div (phm+1);
   end;
END;




FUNCTION GET_SKEW (NR:integer):byte;

(* Liefert den physikalischen Skew-Faktor.     *)

BEGIN
   GET_SKEW:=blkparameter[NR].fskew
END;




FUNCTION GET_CODED_SECTOR_SIZE (NR:integer):byte;

(* Liefert die Sektorgroesse gemaess der Controler-konoention
   in 2-bit codiert.                                                *)

BEGIN
   GET_CODED_SECTOR_SIZE:=(blkparameter[NR].disktyp and $03)
END;


FUNCTION GET_TRACK_METH (NR:integer):byte;

{ Liefert die Nummer des verwendeten TRACK-Verfahrens  }

BEGIN
   GET_TRACK_METH:=(blkparameter[NR].tth1 and $07)
END;


FUNCTION GET_FORMAT_GAP (NR:integer):byte;

(* Liefert den Wert des Format-Gap's in HEX.                        *)

BEGIN
   GET_FORMAT_GAP:=blkparameter[NR].fgap
END;



FUNCTION GET_SANZ_1_SEIT (NR:integer):byte;

{ Liefert 0 wenn kein Sektor auf dieser Seite ist. Analysiert die
  log. Skew-Tabelle. }
VAR j,stelle,count:integer;
BEGIN
   j:=0;count:=0;
   repeat
      j:=j+1;stelle:=addr(blkparameter)+blkparameter[NR].spointer+j;
      if (mem[stelle]<$80) then count:=count+1;
   until j=GET_SEKT_ANZ(NR);
   GET_SANZ_1_SEIT:=count;
END;


FUNCTION GET_SANZ_2_SEIT (NR:integer):byte;

{ Liefert 0 wenn kein Sektor auf dieser Seite ist. Analysiert die
  log. Skew-Tabelle.  }

VAR j,stelle,count:integer;
BEGIN
   j:=0;count:=0;
   repeat
      j:=j+1;stelle:=addr(blkparameter)+blkparameter[NR].spointer+j;
      if (mem[stelle]>$7f) then count:=count+1;
   until j=GET_SEKT_ANZ(NR);
   GET_SANZ_2_SEIT:=count;
END;



FUNCTION GET_NR_1_SEKT (NR:integer):byte;

{   Liefert die Nummer des Sektors mit der niedrigsten Sektornummer.  }

VAR i,j:byte;
    stelle:integer;

BEGIN
   GET_NR_1_SEKT:=blkparameter[NR].fsektor
END;





FUNCTION GET_NR_L_SEKT (NR:integer):byte;

{   Liefert die Nummer des Sektors mit der hoechsten Sektornummer.  }

VAR i,j:byte;
    stelle:integer;

BEGIN
   GET_NR_L_SEKT:=blkparameter[NR].lsektor
END;


FUNCTION GET_SS_DS (NR:integer):byte;

{ Liefert den Wert fuer Single-(VS=0\RS=1)oder-Double(VRS=2)-Sided   }
VAR j:integer;
    V,R:boolean;
BEGIN
  with blkparameter[NR] do begin
   if (tth1 and $07)<>0 then  { TRACK-Verfahren <> 0 }
      begin
         if (spt*(spuren-syso))=((dsm+1)*(blm+1)) then GET_SS_DS:=0
                else GET_SS_DS:=2;
      end
    else  { TRACK-Verfahren=0 }
     begin
      j:=0;V:=false;R:=false;
      repeat
         j:=j+1;
         if mem[addr(blkparameter)+blkparameter[NR].spointer+j]<$80
            then V:=true else R:=true;
      until j=GET_SEKT_ANZ(NR);
      if (V and R) then GET_SS_DS:=2
           else begin if R then GET_SS_DS:=1;
                      if V then GET_SS_DS:=0;
                end;
     end; { End-of-else }
  end;
END;




FUNCTION GET_DENSITY (NR:integer):boolean;

{ Liefert den Wert fuer Density }

BEGIN
   GET_DENSITY:=BITTEST(blkparameter[NR].disktyp,6)
END;






PROCEDURE SET_BIDTABLE (NR:integer);

{ Fuellt unter beruecksichtigung des TRACK-Verfahrens und eventueller
  Luecken in der Sektor-Nummerierung die Tabelle BIDTABLE, die zur
  Formatierung benutzt wird.                                                }
VAR i,j,btpos:byte;
    found:boolean;
BEGIN
   with blkparameter[NR] do begin
    if (tth1 and $07)<>0 then   { TRACK-Verfahren <> 0 }
      if (GET_SEKT_ANZ(NR)-((GET_NR_L_SEKT(NR)+1)-GET_NR_1_SEKT(NR)))=0
        then { keine Luecken }
             genidtable(GET_SKEW(NR),GET_SEKT_ANZ(NR),GET_NR_1_SEKT(NR))
        else { Lueckenhafte Sektornummerierung }
             begin
                i:=GET_NR_1_SEKT(NR)-1;
                for btpos:=0 to (GET_SEKT_ANZ(NR)-1)do begin
                   repeat
                        i:=i+1;found:=false;j:=0;
                        repeat
                              j:=j+1;
   if { mem[addr(blkparameter)+blkparameter[NR].spointer+j]=i}
   mem[addr(blkparameter)+$37c+j]=i then
                                begin found:=true;
                                      bidtable[btpos]:=i end;
                        until (found or(j=GET_SEKT_ANZ(NR)));
                   until (found or (i=GET_NR_L_SEKT(NR)));
                end;
             end { end-of-TRACK-Verfahren <>0 }
        else { TRACK-Verfahren = 0 };
   end { end-of-with }
END;

function ftest(item1,item2:blk_rec):boolean;
begin
   ftest:=true;
   if not(item1.disktyp=item2.disktyp) then ftest:=false;
   if not(item1.fsektor=item2.fsektor) then ftest:=false;
   if not(item1.lsektor=item2.lsektor) then ftest:=false;
end;



procedure makelaufwerksgueltigkeiten(wieviel:byte);
var i,j:integer;
    neuf,altf:blk_rec;
    nlwg,lwg,alwg:byte;
begin
  i:=1;
  repeat
       neuf:=blkparameter[i-1]; lwg:=(neuf.lwpre and $f0);
       j:=0;
       while j<i-1 do
         begin
             altf:=blkparameter[j]; alwg:=(altf.lwpre and $f0);
             if   ftest(neuf,altf)  then
                begin
                   nlwg:=(alwg and lwg);
                   if bittest(nlwg,4) then lwg:=(lwg and $EF);
                   if bittest(nlwg,5) then lwg:=(lwg and $DF);
                   if bittest(nlwg,6) then lwg:=(lwg and $BF);
                   if bittest(nlwg,7) then lwg:=(lwg and $7F);
                end;
           j:=j+1;
       end;
       formdat[i-1].lawegu:='....';
       if bittest(lwg,4) then formdat[i-1].lawegu[1]:='0';
       if bittest(lwg,5) then formdat[i-1].lawegu[2]:='1';
       if bittest(lwg,6) then formdat[i-1].lawegu[3]:='2';
       if bittest(lwg,7) then formdat[i-1].lawegu[4]:='3';
   i:=i+1;
   until i-1>=(wieviel);
end;



var i,NR,j,hilf:integer;
begin
xdpb_anz:=14;
   GET_DATA;
makelaufwerksgueltigkeiten(xdpb_anz);
read(kbd,NR);
while NR<>100 do
   begin
      for j:=0 to 15 do write(char(blkparameter[NR].barray[j]));
      writeln;
      writeln(formdat[NR].lawegu);
      writeln((blkparameter[NR].lwpre and $f0));
      read(kbd,NR);
   end;
end.
