language-Modula2-0.1: examples/Modula-2_Libraries/PMOS/sources/tests/diskpatc.mod
MODULE DiskPatch;
(********************************************************)
(* *)
(* Low-level disk utility. *)
(* *)
(* Programmer: P. Moylan *)
(* Last edited: 5 March 1995 *)
(* Status: Working *)
(* *)
(* Ultimately, this could become a utility for *)
(* checking and patching the contents of floppy *)
(* OR hard disks. For now, it is just a test *)
(* of the device drivers. *)
(* *)
(* Getting inconsistent results towards the end *)
(* of the hard disk: sector sometimes found, and *)
(* sometimes not. However, this is in an area *)
(* which is officially beyond the disk capacity. *)
(* *)
(********************************************************)
FROM SYSTEM IMPORT
(* type *) BYTE,
(* proc *) ADR;
FROM Trace IMPORT
(* proc *) TraceOn, NYI, Pause, InTrace, OutTrace;
FROM Keyboard IMPORT
(* proc *) InKey, PutBack;
FROM Windows IMPORT
(* type *) Window, Colour, FrameType, DividerType,
(* proc *) OpenWindow, ChangeScrollingRegion, CloseWindow,
WriteString, WriteChar, WriteLn, ScrollUp, ScrollDown,
ColourSwap, SetCursor, EditString;
FROM NumericIO IMPORT
(* proc *) ReadCard, WriteCard, WriteHexByte, WriteHexWord,
WriteHexLongword, EditHexLongword;
FROM Devices IMPORT
(* type *) Device, BlockNumberType,
(* proc *) IdentifyDevice, ReadPhysicalBlock;
FROM IOErrorCodes IMPORT
(* type *) ErrorCode,
(* proc *) TranslateErrorCode;
(*IMPORT HardDisk;*)
IMPORT Floppy;
(************************************************************************)
CONST Esc = CHR(27);
CONST
(* MaxRow is the ending row number of the data area of the screen *)
(* window. *)
MaxRow = 18;
TYPE BufferSubscript = [0..511];
(************************************************************************)
(* *)
(* Essentially the whole of this module consists of procedures to *)
(* manipulate the data in a single block buffer, and to display it in *)
(* a fixed screen window. Therefore, we might as well make this *)
(* information global to the module. *)
(* *)
(************************************************************************)
VAR
(* The fields in Display are: *)
(* window: the screen window. *)
(* row, column: the current screen coordinates. *)
(* ExtraAtTop: the number of rows which have scrolled off *)
(* the top of the screen. *)
(* ExtraAtBottom: the number of rows which failed to fit *)
(* at the bottom of the screen. *)
Display: RECORD
window: Window;
row: [0..MaxRow];
column: [0..15];
ExtraAtTop, ExtraAtBottom: CARDINAL;
END (*RECORD*);
(* The record called "CurrentBlock" has fields: *)
(* ByteNumber: the number of the byte within the block *)
(* data: actual data for the disk block on which we are *)
(* currently operating. *)
CurrentBlock: RECORD
ByteNumber: BufferSubscript;
data: ARRAY BufferSubscript OF BYTE;
END (*RECORD*);
(************************************************************************)
(* BASIC DISPLAY OPERATIONS *)
(************************************************************************)
PROCEDURE Highlight;
(* Highlights the currently selected byte on the display. *)
BEGIN
InTrace ("Highlight");
WITH Display DO
ColourSwap (window, row+3, 3*column+8, 2);
ColourSwap (window, row+3, column+60, 1);
SetCursor (window, 1, 37);
WriteHexWord (window, CurrentBlock.ByteNumber);
END (*WITH*);
OutTrace ("Highlight");
END Highlight;
(************************************************************************)
PROCEDURE Unhighlight;
(* Removes the highlighting of the currently selected byte. *)
BEGIN
InTrace ("Unhighlight");
Highlight;
OutTrace ("Unhighlight");
END Unhighlight;
(************************************************************************)
PROCEDURE DisplayRow (j: CARDINAL);
(* Displays row j of the Buffer. (One row is 16 bytes). *)
VAR k: [0..15];
Base: CARDINAL;
BEGIN
SetCursor (Display.window, j+3, 1);
Base := 16*(j+Display.ExtraAtTop);
(* Write the address of the first byte in the row. *)
WriteHexWord (Display.window, Base); WriteString (Display.window, ": ");
(* Write 16 bytes in hexadecimal. *)
FOR k := 0 TO 15 DO
WriteHexByte (Display.window, CurrentBlock.data[Base+k]);
WriteChar (Display.window, " ");
END (*FOR*);
WriteString (Display.window, " ");
(* Now the same information in character form. *)
FOR k := 0 TO 15 DO
WriteChar (Display.window, CHR (CurrentBlock.data[Base+k]));
END (*FOR*);
END DisplayRow;
(************************************************************************)
PROCEDURE InitialDisplay;
(* Displays the beginning of the buffer (a display of the whole *)
(* buffer would not fit onto the screen. *)
VAR j: [0..MaxRow-2];
BEGIN
InTrace ("InitialDisplay");
WITH Display DO
row := 0; column := 0; ExtraAtTop := 0;
ExtraAtBottom := MAX(BufferSubscript) DIV 16 - MaxRow + 2;
END (*WITH*);
CurrentBlock.ByteNumber := 0;
FOR j := 0 TO MaxRow-2 DO
DisplayRow (j);
END (*FOR*);
Highlight;
OutTrace ("InitialDisplay");
END InitialDisplay;
(************************************************************************)
PROCEDURE ShiftDisplayUp;
(* Moves the display up one row, adding a new row at the bottom. *)
(* Exception: nothing happens if there is no new row to add. *)
VAR MaxRowMinusTwo: CARDINAL;
BEGIN
InTrace ("ShiftDisplayUp");
WITH Display DO
IF ExtraAtBottom > 0 THEN
ScrollUp (window);
INC (ExtraAtTop); DEC (ExtraAtBottom);
INC (CurrentBlock.ByteNumber, 16);
(* The following seemingly indirect way of proceeding *)
(* is to compensate for an unexplained intermittent *)
(* crash of the compiler. It is very hard to pin down *)
(* the exact circumstances of the crash, because it is *)
(* not always repeatable, but it seems to be related to *)
(* using a constant as an actual procedure parameter. *)
MaxRowMinusTwo := MaxRow - 2;
DisplayRow (MaxRowMinusTwo);
END (*IF*);
END (*WITH*);
OutTrace ("ShiftDisplayUp");
END ShiftDisplayUp;
(************************************************************************)
PROCEDURE ShiftDisplayDown;
(* Moves the display down one row, adding a new row at the top. *)
(* Exception: nothing happens if there is no new row to add. *)
BEGIN
InTrace ("ShiftDisplayDown");
WITH Display DO
IF ExtraAtTop > 0 THEN
ScrollDown (window);
DEC (ExtraAtTop); INC (ExtraAtBottom);
DEC (CurrentBlock.ByteNumber, 16);
DisplayRow (0);
END (*IF*);
END (*WITH*);
OutTrace ("ShiftDisplayDown");
END ShiftDisplayDown;
(************************************************************************)
(* CURSOR MOVEMENTS *)
(************************************************************************)
PROCEDURE CursorUp (lines: CARDINAL);
(* Moves the cursor up by the given number of rows. *)
VAR j: CARDINAL;
BEGIN
WITH Display DO
FOR j := 1 TO lines DO
IF row = 0 THEN ShiftDisplayDown
ELSE
DEC (row); DEC (CurrentBlock.ByteNumber, 16);
END (*IF*);
END (*FOR*);
END (*WITH*);
END CursorUp;
(************************************************************************)
PROCEDURE CursorDown (lines: CARDINAL);
(* Moves the cursor down by the given number of rows. *)
VAR j: CARDINAL;
BEGIN
WITH Display DO
FOR j := 1 TO lines DO
IF row = MaxRow-2 THEN ShiftDisplayUp
ELSE
INC (row); INC (CurrentBlock.ByteNumber, 16);
END (*IF*);
END (*FOR*);
END (*WITH*);
END CursorDown;
(************************************************************************)
PROCEDURE CursorLeft;
(* Moves the cursor one byte left. *)
BEGIN
WITH Display DO
IF column = 0 THEN
IF CurrentBlock.ByteNumber > 0 THEN
column := 15; INC (CurrentBlock.ByteNumber, 15);
CursorUp(1);
END (*IF*);
ELSE
DEC (column); DEC (CurrentBlock.ByteNumber);
END (*IF*);
END (*WITH*);
END CursorLeft;
(************************************************************************)
PROCEDURE CursorRight;
(* Moves the cursor one byte right. *)
BEGIN
WITH Display DO
IF column = 15 THEN
IF CurrentBlock.ByteNumber < MAX(BufferSubscript) THEN
column := 0; DEC (CurrentBlock.ByteNumber, 15);
CursorDown(1);
END (*IF*);
ELSE
INC (column); INC (CurrentBlock.ByteNumber);
END (*IF*);
END (*WITH*);
END CursorRight;
(************************************************************************)
PROCEDURE Home;
(* Moves the cursor to the beginning of the row. *)
BEGIN
WITH Display DO
DEC (CurrentBlock.ByteNumber, column); column := 0;
END (*WITH*);
END Home;
(************************************************************************)
PROCEDURE GoToEnd;
(* Moves the cursor to the end of the row. *)
BEGIN
WITH Display DO
INC (CurrentBlock.ByteNumber, 15-column); column := 15;
END (*WITH*);
END GoToEnd;
(************************************************************************)
PROCEDURE CursorMovements (VAR (*INOUT*) nextchar: CHAR);
(* Moves the cursor around the data buffer as directed by keyboard *)
(* input. On entry, nextchar holds the first keyboard character. *)
(* On exit, nextchar holds the first input character which this *)
(* procedure does not recognise. *)
CONST Nul = CHR(0); pagejump = 10;
BEGIN
InTrace ("CursorMovements");
LOOP
IF nextchar = Nul THEN
nextchar := InKey();
Unhighlight;
IF nextchar = "K" THEN (* cursor left *)
CursorLeft;
ELSIF nextchar = "M" THEN (* cursor right *)
CursorRight;
ELSIF nextchar = "H" THEN (* cursor up *)
CursorUp (1);
ELSIF nextchar = "P" THEN (* cursor down *)
CursorDown (1);
ELSIF nextchar = "I" THEN (* page up *)
CursorUp (pagejump);
ELSIF nextchar = "Q" THEN (* page down *)
CursorDown (pagejump);
ELSIF nextchar = "G" THEN (* home *)
Home;
ELSIF nextchar = "O" THEN (* end *)
GoToEnd;
ELSE
Highlight;
EXIT (*LOOP*);
END (*IF*);
Highlight;
nextchar := InKey();
ELSE
EXIT (*LOOP*);
END (*IF*);
END (*LOOP*);
OutTrace ("CursorMovements");
END CursorMovements;
(************************************************************************)
(* THE MAIN BLOCK OPERATIONS *)
(************************************************************************)
PROCEDURE OperateOn (drive: CHAR; BlockNumber: BlockNumberType);
VAR nextchar: CHAR; status: ErrorCode;
device: Device; unit: CARDINAL;
string: ARRAY [0..31] OF CHAR;
BEGIN
IdentifyDevice (drive, device, unit);
status := ReadPhysicalBlock (device, unit, BlockNumber,
ADR(CurrentBlock.data));
OpenWindow (Display.window,green,black,0,MaxRow+2,0,79,
simpleframe,doubledivider);
WriteString (Display.window, "Drive ");
WriteChar (Display.window, drive);
WriteString (Display.window, " Block ");
WriteHexLongword (Display.window, BlockNumber);
WriteString (Display.window, " Byte");
WriteString (Display.window, " status = ");
TranslateErrorCode (status, string);
WriteString (Display.window, string);
ChangeScrollingRegion (Display.window, 3, MaxRow+1);
InitialDisplay;
nextchar := InKey();
REPEAT
CursorMovements (nextchar);
IF nextchar <> Esc THEN
nextchar := InKey();
END (*IF*);
UNTIL nextchar = Esc;
(*Pause;*)
CloseWindow (Display.window);
END OperateOn;
(************************************************************************)
PROCEDURE MainMenu;
CONST CR = CHR(13);
VAR w: Window; drivename: ARRAY [0..0] OF CHAR;
drive, ch: CHAR; BlockNumber: BlockNumberType;
BEGIN
OpenWindow (w,white,red,0,4,0,35,simpleframe,nodivider);
WriteString (w, "Test of hard disk read operations");
BlockNumber := 0; drive := "C";
SetCursor (w, 2, 1);
WriteString (w, "Drive: C Block number: 00000000");
LOOP
SetCursor (w, 2, 8);
drivename[0] := drive;
EditString (w, drivename, 1);
ch := InKey();
IF ch = Esc THEN EXIT(*LOOP*)
ELSIF ch <> CR THEN PutBack(ch);
END (*IF*);
drive := CAP(drivename[0]);
IF (drive < "A") OR (drive > "D") THEN EXIT(*LOOP*) END(*IF*);
SetCursor (w, 2, 26);
EditHexLongword (w, BlockNumber);
IF BlockNumber = 0FFFFFFFFH THEN EXIT(*LOOP*) END(*IF*);
ch := InKey();
IF ch = Esc THEN EXIT(*LOOP*)
ELSIF ch <> CR THEN PutBack(ch);
END (*IF*);
OperateOn (drive, BlockNumber);
SetCursor (w, 3, 1);
WriteString (w, "Finished with block ");
WriteHexLongword (w, BlockNumber);
END (*LOOP*);
CloseWindow (w);
END MainMenu;
(************************************************************************)
(* MAIN PROGRAM *)
(************************************************************************)
BEGIN
(* TraceOn (15,24,0,79,1); *)
MainMenu;
END DiskPatch.