program Disk3; { DIREKTER DISKETTENZUGRIFF UNTER CP/M 3.0 }
{ (c) 1984 by Gerhard Strube, Muenchen }
const MaxSize = 1024; { maximale physische Sektorgroesse }
Version = $0031; { Versionsnummer von CP/M 3.0 }
type DPB = record { CP/M 3.0 Disk Parameter Block: }
SPT: integer; { Anzahl log. Sektoren je Spur }
BSH, BLM, EXM: byte; { Block Shift & Mask / Extent Mask }
DSM, DRM: integer; { Kapazitaet v. Diskette & Directory }
AL0, AL1: byte; { Directory reservierte Bloecke }
CKS, OFF: integer; { Pruefvektor / Anz. reserv. Spuren }
PSH, PHM: byte { Physical Record Shift & Mask }
end;
RWtype = (ReadSector, WriteSector); { Art des Diskettenzugriffs }
var Drive, Track,
Sector, Lsector, Psector,
Part, Psize,
MaxSector, MaxTrack,
Cmd, DefaultDrive,
i, j, k: integer;
ptr: ^DPB absolute i;
DPH: ^integer absolute i;
PhySecBuf: array [1..MaxSize] of byte;
LogSecBuf: array [1..128] of byte;
{$I UBIOS.PAS } { externe Funktion UBIOS f. BIOS-Aufrufe }
{$I HEXIO.PAS } { ext. Funkt. HEXVAL, ext. Prozedur WRITEHEX }
procedure Error (no: integer); { Abbruch u. Ausgabe einer Fehlermeldung }
begin
GotoXY (10, 18);
case no of
0: write ('PROGRAMM LAEUFT NUR UNTER CP/M 3.0 (CP/M PLUS).');
1: write ('FEHLER: UNGUELTIGE LAUFWEHKSNUMMER.');
2: write ('FEHLER BEIM SUCHEN / LESEN / SCHREIBEN.')
end;
Bdos (14, DefaultDrive);
Halt
end;
procedure UserFrame (Mode: RWtype); {Bildschirm-Maske u. Dateneingabe }
begin
ClrScr;
GotoXY ( 6, 1); write ('DIREKTER DISKETTEN-ZUGRIFF UNTER CP/M PLUS');
GotoXY (50,24); write ('(c) 1984 by Gerhard Strube');
GotoXY ( 1, 3); write ('Modus:');
GotoXY ( 1, 4); LowVideo;
case Mode of
ReadSector: write ('LESEN ');
WriteSector: write ('SCHREIBEN ')
end;
HighVideo;
repeat
GotoXY (13, 3);
write ('LAUFWERKSNUMMER (0=A, 1=B): ', Drive:1, chr(8));
readln (Drive)
until (Drive in [0..15]);
i := UBIOS (9, 0, Drive, 0, 0); { Laufwerk selektieren }
if (i = 0) then Error (1);
Bild 2. Listing des Hauptprogramms DISK3 mit Include-File HEXIO
Bdos (14, Drive);
i := BdosHL (31); { Adresse des DPB; i und ptr haben dieselbe Adresse! }
with ptr^ do begin
Psize := 128 shl PSH;
GotoXY (50, 2); write (Psize:5, ' phys.Sektorgroesse');
if (Psize = 128) then begin
write (' *)'); GotoXY (1,24);
write ('*) wie es dem Betriebssystem erscheint.')
end;
Psize := 1 shl PSH;
MaxSector := SPT;
GotoXY (50, 3); write (SPT:5, ' log.Sektoren/Spur');
GotoXY (50, 5); write (OFF:5, ' reserv. Spur(en)');
k := (DSM + 1) * ((BLM + 1) div 8);
GotoXY (50, 6); write (k:5, ' kB Kapazitaet');
MaxTrack := round ((k / SPT) * 8 + OFF);
GotoXY (50, 4); write (MaxTrack:5, ' Spuren insgesamt');
repeat
GotoXY (13, 4);
write ('SPURNUMMER (0 ..', (MaxTrack -1):4, '): ');
write (Track, chr(8));
if (Track > 9) then write (chr(8));
if (Track > 99) then write (chr(8));
readln (Track)
until (Track >= 0) and (Track < MaxTrack);
Sector := Lsector;
repeat
GotoXY (13, 5);
write ('SEKTORNUMMER (0 ..', (SPT - 1):4, '): ');
write (Sector, chr(8));
if (Sector > 9) then write (chr(8));
if (Sector > 99) then write (chr(8));
readln (Sector)
until (Sector >= 0) and (Sector < SPT);
Lsector := Sector
end;
Part := Sector mod Psize; { make logical to phyaical }
Sector := Sector div Psize; { sector size translation }
end;
procedure DoDisk (Mode: RWtype); { Diskettenoperation ausfuehren }
begin
UserFrame (Mode);
i := UBIOS (9, 0, Drive, 1, 0); { Diskette selektieren }
{ i = Adresse der Uebersetzungstabelle log.> phys. Sektoren }
Psector := UBIOS (16, 0, Sector, DPH^, 0); { phys. Sektor berechnen }
GotoXY (23, 6); write ('phys. Sektor Nr.: ', Psector);
if (Psize > 1) then begin GotoXY (13, 6); write ('Teil: ', Part:1) end;
i := UBIOS (23, 0, 1, 0, 0); { nur 1 Sektor bearbeiten }
i := UBIOS (10, 0, Track, 0, 0); { Spur vorwaehlen }
i := UBIOS (11, 0, Psector, 0, 0); { Sektor vorwaehlen }
i := UBIOS (12, 0, Addr(PhySecBuf), 0, 0); { DMA-Adresse vorwaehlen }
i := UBIOS (28, 1, 0, 0, 0); { Speicherbank vorwaehlen }
case Mode of
ReadSector: begin
i := UBIOS (13, 0, 0, 0, 0); { phys. Sektor lesen }
if (i <> 0) then Error (2);
for i := 1 to 128 do { log. Sektor auswaehlen }
LogSecBuf [i] := PhySecBuf [i + Part * 128]
end;
WriteSector: begin
i := UBIOS (13, 0, 0, 0, 0); { phys. Sektor lesen }
if (i <> 0) then Error (2);
for i := 1 to 128 do { log. Sektor "einarbeiten" }
PhySecBuf [i + Part * 128] := LogSecBuf [i];
i:= UBIOS (14, 0, 0, 0, 0); { phys. Sektor schreiben }
if (i <> 0) then Error (2)
end;
end
end;
procedure DisplaySector; { Inhalt d. log. Sektors auf Bildschirm anzeigen }
begin
for i := 20 to 23 do begin GotoXY (1, i); ClrEol end;
GotoXY (1, 8);
LowVideo; write (' ');
for i := 0 to 15 do begin write (' '); WriteHex (i) end;
HighVideo; writeln;
for i := 1 to 8 do begin
LowVideo; WriteHex ((i-1) * 16); write (':'); HighVideo;
for j := 1 to 16 do begin
k := LogSecBuf [16 * (i - 1) + j];
write (' '); WriteHex (k) { (1) als Hexadezimalzahlen }
end;
write (' ');
for j := 1 to 16 do begin
k := LogSecBuf [16 * (i - 1) + j];
if (k > 128) then LowVideo;
k := k mod 128;
if (k < 32) then write ('.') { (2) als ASCII-Zeichen; }
else write (chr(k)); { Control-Char. als Punkt }
HighVideo
end;
writeln
end;
end;
procedure ChangeSector; { Aenderungen am Inhalt d. log. Sektors vornehmen }
var st: string[80];
s: string[2];
NewHex: boolean;
begin { ChangeSector }
repeat
GotoXY (1,20); ClrEol;
write ('INHALT VERAENDERN AB ADRESSE (in Hex): 0', chr(8)); readln (st);
i := 0; if (length (st) in [1..2]) then i := HexVal (st)
until (i in [$00..$7F]);
i := i + 1; { umrechnen auf Indizierung $01..$00 }
GotoXY (1,21);
writeln ('NEUEN INHALT EINGEBEN (1) in Hex (mit Leerzeichen trennen), ');
writeln (' oder (2) "''" mit nachfolgendem ASCII-String:');
readln (st);
if (st[1] = '''') then begin
for j := 2 to length (st) do
if (i in [$01..$80]) then begin
LogSecBuf [i] := ord (st [j]);
i := i + 1
end
end
else begin
j := 1; NewHex := false;
while (j <= length (st) + 1) do begin
if (j = length (st) + 1) or (st [j] = ' ') then begin
if NewHex then begin
NewHex := false;
if (i in [$01..$80]) then
if (HexVal (s) < 256) then begin
LogSecBuf [i] := HexVal (s);
i := i + 1
end
else j := length (st) { terminate }
end;
s := ' ' end
else begin
NewHex := true;
case ord (s[0]) of
0: s := st[j];
1: s := s + st[j];
2: s := s[2] + st[j]
end
end;
j := j + 1;
end
end
end;
begin { HAUPTPROGRAMM }
i := BdosHL (12); { Funktion 12: Versionsnummer des Betriebssystems }
if (i <> Version) then Error (0);
DefaultDrive := Bdos (25); { Funktion 25: aktuelle Laufwerksnummer }
Track := 0; Lsector := 0; Drive := DefaultDrive;
DoDisk (ReadSector);
repeat
DisplaySector;
Cmd := -1; { damit spaeter ueberfluessige Returns ignoriert werden }
repeat
GotoXY (1,18); ClrEol;
write ('Gib Kommando: 0=ENDE, 1=LESEN, 2=AENDERN, 3=SCHREIBEN: ');
readln (Cmd)
until (Cmd in [0..3]);
case Cmd of
1: begin { Voreinstellung: jeweils naechsten Sektor lesen }
Lsector := Lsector + 1;
if (Lsector = MaxSector) then begin
Lsector := 0; Track := Track + 1;
if (Track = MaxTrack) then Track := 0
end;
DoDisk (ReadSector)
end;
2: ChangeSector;
3: DoDisk (WriteSector)
end
until (Cmd = 0);
CrtExit;
Bdos (14, DefaultDrive)
{ d.h. Zustand vor Aufruf des Programms wiederherstellen }
end.
{ INCLUDE-FILE HEXIO.PAS: }
type string2 = string[2];
function HexVal(s: string2): integer; { ASCII-Eingabe in Byte umwandeln }
var i, j, m, n: integer;
function NibbleVal (c: char): integer;
begin
c := UpCase (c);
if not (c in ['0'..'9', 'A'..'F']) then NibbleVal := 257
else if (c > '9') then NibbleVal := ord (c) - $37
else NibbleVal := ord (c) - $30
end; { NibbleVal }
begin { HexVal }
m := NibbleVal (s[1]);
if (length (s) = 1) then HexVal := m
else begin
n := NibbleVal (s[2]);
HexVal := 16 * m + n
end
end; { HexVal }
procedure WriteHex (b: byte); { Byte als zweistellige Hexzahl ausgeben }
var b1: byte;
procedure WriteNibble (b: byte);
begin
b := b + $30; if (b > $39) then b := b + 7; write (chr(b))
end;
begin
b1 := b shr 4; WriteNibble (b1);
b1 := b and $0F; WriteNibble (b1)
end;