|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 7296 (0x1c80)
Types: TextFile
Names: »DISK3.PAS«
└─⟦d482c3728⟧ Bits:30005987 Turbo Pascal v2.00A (Jet80)
└─⟦this⟧ »DISK3.PAS«
Program Disk3; (* Direkte diskettetilgang under CP/M 3.0 *)
const MaxSize = 1024; (* Maksimal fysisk sektorstørrelse *)
Version = $0031; (* Versionsnummer i CP/M 3.0 *)
type DPB = record
SPT: integer;
BSH, BLM, EXM: byte;
DSM, DRM: integer;
AL0, AL1: byte;
CKS, OFF: integer;
PSH, PHM: byte
end;
RWtype = (ReadSector, WriteSector);
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;
DriveL: char;
(*$I UBIOS.PAS*)
(*$I HEXIO.PAS*)
Procedure Error (no: integer);
begin
GotoXY(10,18);
case no of
0: write('Programmet virker kun under CP/M 3.0 (CP/M Plus).');
1: write('Fejl: Ugyldigt drevnummer.');
2: write('Fejl ved Søge, Læse eller Skrive.');
end;
Bdos(14,DefaultDrive);
Halt
End;
Procedure UserFrame(Mode: RWtype);
begin
ClrScr;
GotoXY(13,1);
LowVideo;
Write(' Direkte diskette-editering under CP/M Plus ');
HighVideo;
GotoXY(1,3);
Write('Modus:');
GotoXY(1,4);
LowVideo;
Case Mode of
ReadSector: Write(' Indlæse ');
WriteSector: Write(' Udskrive ');
end;
HighVideo;
Repeat
Gotoxy(13,3);
Write('Diskdrev nummer (0=A, 1=B): ',Drive:1, Chr(8));
Readln(Drive)
Until(Drive in(.0..15.));
i:= UBIOS(9, 0, Drive, 0, 0);
if (i=0) then Error(1);
Bdos(14,Drive);
i:= BdosHL(31);
with ptr^ do begin
Psize:= 128 shl PSH;
GotoXY(45,3); Write(Psize:5, ' bytes fysisk sektorstørrelse');
(* if (Psize=128) then begin
Write(' *)(*'); GotoXY(1,24);
Write('*)(* som det ser ud for styresystemet.');
end; *)
Psize:=1 shl PSH;
MaxSector:=SPT;
GotoXY(45,4); Write(SPT:5, ' logiske sektorer per spor');
GotoXY(45,6); Write(OFF:5, ' reserverede spor');
k:=(DSM+1)*((BLM+1) div 8);
GotoXY(45,7); Write(k:5, ' Kb drev-kapacitet');
MaxTrack:= round((k/SPT)*8+OFF);
GotoXY(45,5); Write(MaxTrack:5, ' Spor ialt');
repeat
GotoXY(13,4);
Write('Spornummer (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;
Sector:= Sector div Psize;
end;
Procedure DoDisk(Mode: RWtype);
begin
UserFrame(Mode);
i:= UBIOS(9, 0, Drive, 1, 0);
Psector:= UBIOS(16, 0, Sector, DPH^, 0);
GotoXY(13,6); Write('Fysisk sektor nr.: ', Psector);
if (Psize>1) then begin GotoXY(13,7); Write('Fysisk sektor del: ', Part:1) end;
i:= UBIOS(23, 0, 1, 0, 0);
i:= UBIOS(10, 0, Track, 0, 0);
i:= UBIOS(11, 0, Psector, 0, 0);
i:= UBIOS(12, 0, Addr(PhySecBuf), 0, 0);
i:= UBIOS(28, 1, 0, 0, 0);
case Mode of
ReadSector: begin
i:= UBIOS(13, 0, 0, 0, 0);
if (i<>0) then Error(2);
for i:= 1 to 128 do
LogSecBuf(.i.):= PhySecBuf(.i+Part*128.)
end;
WriteSector: begin
i:= UBIOS(13, 0, 0, 0, 0);
if (i<>0) then Error(2);
for i:= 1 to 128 do
PhySecBuf(.i+Part*128.):= LogSecBuf(.i.);
i:= UBIOS(14, 0, 0, 0, 0);
if (i<>0) then Error(2);
end;
end
end;
Procedure DisplaySector;
begin
for i:= 21 to 24 do begin
GotoXY(1,i);
ClrEol
end;
GotoXY(1,9);
LowVideo;
Write(' ');
for i:= 0 to 15 do begin
if (i=8) then write(' - ')
else 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.);
if (j=9) then write(' - ')
else Write(' ');
WriteHex(k)
end;
Write(' ');
for j:= 1 to 16 do begin
k:= LogSecBuf(.16*(i-1)+j.);
k:= k mod 128;
if (j=9) then write(' ');
if (k<32) then Write('.')
else Write(chr(k));
HighVideo
end;
Writeln
end;
end;
Procedure ChangeSector;
var st: string(.80.);
s: string(.2.);
NewHex: Boolean;
begin
repeat
GotoXY(1,20);
ClrEol;
Write('Indhold ændres fra adresse (i 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;
GotoXY(1,21);
Writeln('Indtast nyt indhold (1) i Hex (skil med mellemrumstegn), ');
Writeln(' eller (2) "''" med efterfølgende ASCII-streng:');
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
NewHex:= false;
if (i in (.$01..$80.)) then begin
if (hexVal(s)<256) then begin
LogSecBuf(.i.):= HexVal(s);
i:= i+1
end
Else j:= length(st)
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 (* Hovedprogram *)
i:= BdosHL(12);
if (i<>Version) then Error(0);
DefaultDrive:= Bdos(25);
Track:= 0;
Lsector:= 0;
Drive:= DefaultDrive;
DoDisk(ReadSector);
repeat
DisplaySector;
Cmd:= -1;
repeat
GotoXY(1,19);
ClrEol;
Write('Tast kommando: 0=Slut, 1=Læse, 2=Ændre, 3=Skrive: ');
Readln(Cmd);
until (Cmd in (.0..3.));
case Cmd of
1: begin
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)
end.
«eof»