{$C Copyright (c) 1983 SAGE Computer Technology, All Rights Reserved}

{ SAGE IV Winchester Formatter

  File:	    WINFORMAT.TEXT
  Date:	    23-Oct-83
  Version:  1B


  COPYRIGHT (c) 1983 SAGE Computer Technology
  All Rights Reserved
  

  Development History:

  1    23-Mar-83  Initial release.
  1A   27-Jul-83  Allow default of previous info from drive.
		  Handle self configuring number of heads.
		  Split WINFORMAT into two files.
		  Put in head exercise before format.
  1B   23-Oct-83  Changed because UNITCLEAR no longer recalibrates.
		  Use logical device 17 to leave system on-line.
		  Change limit on head numbers.
		  Added new operating systems.
 

  Description:

  This program may be used for formatting any of up to
  four drives on a SAGE IV Computer system.  The program also
  initializes the Bad Track Map and Winchester Partition Map
  on the drive.

  The program uses a pair of assembly functions, XUNITREAD and
  XUNITWRITE, contained in file XUNITIO.TEXT.  These routines
  are used instead of the normal UNITREAD and UNITWRITE to
  allow use of block numbers larger than one word.  The returned
  value is the error code from the Winchester driver (not mapped
  into p-System IORESULT values).

}

PROGRAM FormatWinchester;

USES {$U COMMANDIO.CODE} COMMANDIO,
     {$U WIN_UNIT.CODE} Win_Unit,
     {$U MNU_UNIT.CODE} MNU_Unit,
     {$U SAGETOOLS.CODE} SIO_Unit,
     {$U SCREENOPS.CODE} SCREENOPS,
     {$U CONFIGSAGE.CODE} Config_Sage;
     
CONST
  Version = '1.2';
  
  MN_MAIN	= 0;  M_MAIN	= 'MAIN';
  MN_FUN	= 1;  M_FUN	= 'FUN';
  MN_SFOR	= 2;  M_SFOR	= 'SFOR';
  MN_SVER	= 3;  M_SVER	= 'SVER';
  MN_FPARM	= 4;  M_FPARM	= 'PARM';
  
  D_FC		= 0;
  D_FST		= 1;
  D_VC		= 2;
  D_VST		= 3;
  D_UDM		= 4;
  D_LPM		= 5;
  D_TBT		= 6;
  D_BTM		= 7;
  D_FPARM	= 8;

  D_SC		= 0;
  D_SH		= 1;
  D_EC		= 2;
  D_EH		= 3;
  D_DF		= 4;
  D_DV		= 4;

  D_DPAT	= 0;
  D_FRTRY	= 1;

VAR
  DiskImage:ARRAY[0..3] OF Win_DiskImage;
  Drive:INTEGER;
  OldWinch,NewWinch:Conf_Winch;
  Track:INTEGER;
  BlockLow,BlockHigh:INTEGER;
  MaxTrack:INTEGER;
  BlocksPerTrack:INTEGER;
  BPT:INTEGER;
  Index:INTEGER;
  Done:BOOLEAN;
  TooBad:BOOLEAN;
  GoodRead:BOOLEAN;
  StartCyl,EndCyl:INTEGER;
  StartHead,EndHead:INTEGER;
  ExtraBad:ARRAY[1..64] OF INTEGER;
  NumExtraBad:INTEGER;
  FormRetries:INTEGER;
  FormPattern:INTEGER;
  TrackData:PACKED ARRAY[0..10239] OF 0..255;
  ValidConfig:ARRAY[0..3] OF BOOLEAN;
  HeadSet:ARRAY[0..3] OF BOOLEAN;
  HeadsOnDrive:ARRAY[0..3] OF INTEGER;
  
FUNCTION XUNITREAD(Device:INTEGER; VAR Buffer; Size,HighBlock,LowBlock,
		    Control:INTEGER):INTEGER; EXTERNAL;
		    
FUNCTION XUNITWRITE(Device:INTEGER; VAR Buffer; Size,HighBlock,LowBlock,
		     Control:INTEGER):INTEGER; EXTERNAL;

PROCEDURE Init;
VAR
  Version:PACKED RECORD
	    Major:0..255;
	    Minor:0..255;
	    Dummy:ARRAY[0..100] OF INTEGER;
	  END;
BEGIN
  FILLCHAR(Version,SIZEOF(Version),0);
  UNITREAD(128,Version,0,4,0);
  IF Version.Major = 3 THEN
    BEGIN
      WRITELN(CHR(7),'Cannot run WFORMAT under Multi-User BIOS');
      EXIT(PROGRAM);
    END;
  FormRetries:=0;
  FormPattern:=229;
  FOR Drive := 0 TO 3 DO
    BEGIN
      ValidConfig[Drive]:=FALSE;
      HeadSet[Drive]:=FALSE;
    END;
  MEMLOCK('OSUTIL');
  FILLCHAR(DiskImage,SIZEOF(DiskImage),0);
END;

{$I WINFORMAT1.TEXT}

FUNCTION FindError:CHAR;
VAR
  TempWinch:Conf_Winch;
BEGIN
  Conf_Rd_Winch(17,TempWinch);
  WITH TempWinch DO
    BEGIN
      FindError:='?';
      IF LastError = 248 THEN FindError:='X';
      IF LastError = 255 THEN FindError:='0';
      IF LastError = 253 THEN FindError:='1';
      IF LastError = 252 THEN FindError:='2';
      IF LastError = 250 THEN FindError:='3';
      IF LastError = 247 THEN FindError:='4';
      IF LastError = 246 THEN FindError:='5';
      IF LastError = 245 THEN FindError:='6';
      IF LastError = 244 THEN FindError:='7';
      IF LastError = 242 THEN FindError:='8';
    END;
END;


PROCEDURE DoTrack(HighBlock,LowBlock:INTEGER);
VAR
  Index:INTEGER;
  Complete:BOOLEAN;
BEGIN
  IF XUNITWRITE(17,TrackData,BPT,HighBlock,LowBlock,8192) <> 0 THEN
    WITH DiskImage[Drive] DO
      BEGIN
	Index:=0;
	Complete:=FALSE;
	WHILE (NOT Complete) AND (BadTracks[Index] <> 0) DO
	  BEGIN
	    IF Track = BadTracks[Index] THEN Complete:=TRUE;
	    Index:=Index+1;
	  END; 
	IF NOT Complete THEN
	  BEGIN
	    IF NumExtraBad <64 THEN
	      BEGIN
		NumExtraBad:=NumExtraBad+1;
		ExtraBad[NumExtraBad]:=Track;
		WRITE(FindError);
	      END
	    ELSE
	      BEGIN
		Exception(TRUE);
		WRITELN;
		WRITELN('Too many bad tracks');
		Done:=TRUE;
		TooBad:=TRUE;
	      END;
	  END
	ELSE
	  WRITE('*');
      END
  ELSE
    WRITE('.');
END;

PROCEDURE VerifyTrack(HighBlock,LowBlock:INTEGER);
VAR
  Index:INTEGER;
  Complete:BOOLEAN;
BEGIN
  IF XUNITREAD(17,TrackData,BPT,HighBlock,LowBlock,8192) <> 0 THEN
    WITH DiskImage[Drive] DO
      BEGIN
	Complete:=FALSE;
	Index:=0;
	WHILE (NOT Complete) AND (BadTracks[Index] <> 0) DO
	  BEGIN
	    IF Track = BadTracks[Index] THEN Complete:=TRUE;
	    Index:=Index+1;
	  END; 
	IF NOT Complete THEN
	  BEGIN
	    WRITE(FindError);
	    IF NumExtraBad > 0 THEN
	      BEGIN
		Index:=1;
		WHILE (NOT Complete) AND (Index <= NumExtraBad) DO
		  BEGIN
		    IF Track = ExtraBad[Index] THEN Complete:=TRUE;
		    Index:=Index+1;
		  END;
	      END;
	    IF NOT Complete THEN
	      BEGIN
		IF NumExtraBad <64 THEN
		  BEGIN
		    NumExtraBad:=NumExtraBad+1;
		    ExtraBad[NumExtraBad]:=Track;
		  END
		ELSE
		  BEGIN
		    Exception(TRUE);
		    WRITELN;
		    WRITELN('TOO Many bad tracks');
		    Done:=TRUE;
		    TooBad:=TRUE;
		  END;
	      END;
	  END
	ELSE
	  WRITE('*');
      END
  ELSE
    WRITE('.');
END;

PROCEDURE Format(StartTrack,EndTrack:INTEGER);
VAR
  Temp:INTEGER;
  Count:INTEGER;
  StartLow,StartHigh:INTEGER;
  Data:PACKED RECORD
	 Calibrate:INTEGER;
	 Actual:INTEGER;
	 Status:0..255;
	 VCO:0..255;
       END;

PROCEDURE CheckIO;
VAR
  Dummy:BOOLEAN;
BEGIN
  IF IORESULT <> 0 THEN
    BEGIN
      Exception(TRUE);
      WRITELN('Error writing to file');
      Dummy:=SC_Space_Wait(TRUE);
      EXIT(Format);
    END;
END;

BEGIN { Format }
  FILLCHAR(TrackData,SIZEOF(TrackData),FormPattern);
  NewWinch:=OldWinch;
  NewWinch.Tries:=FormRetries+1;
  
  { Exercise seeks }
  NewWinch.Tests:=32; { do seek only }
  Conf_WT_Winch(17,NewWinch); { also recalibrates }
  FOR Count := 1 TO 10 DO
    BEGIN
      UNITREAD(17,Temp,1,NewWinch.Cylinders-1);
      UNITREAD(17,Temp,1,0);
    END;
  
  { Calibrate VCO }
  NewWinch.Tests:=64;
  Conf_WT_Winch(17,NewWinch);
  UNITREAD(17,Data,0,0);
  UNITWRITE(17,Data,0,0);
  NewWinch.Tests:=0;
  Conf_WT_Winch(17,NewWinch);
  
  UNITREAD(17,Temp,1,0,8192); { ignore error on this read }
  FOR Count:=0 TO 32000 DO; { Just for delay }
  
  BPT:=OldWinch.BytesPerSector*OldWinch.SectorsPerTrack;
  BlocksPerTrack:=BPT DIV 512;
  
  Track:=StartTrack;
  Temp:=0;
  BlockLow:=0;
  BlockHigh:=0;
  WHILE Temp < StartTrack DO
    BEGIN
      IF (BlockLow < 0) AND ((BlockLow+BlocksPerTrack) >= 0) THEN
	BlockHigh:=BlockHigh+1;
      BlockLow:=BlockLow+BlocksPerTrack;
      Temp:=Temp+1;
    END;
  StartLow:=BlockLow;
  StartHigh:=BlockHigh;
  NumExtraBad:=0;
  Done:=FALSE;
  WRITELN;
  TooBad:=FALSE;
  Count:=0;
  WRITELN('Format pass');
  REPEAT
    IF (Count MOD 50) = 0 THEN
      BEGIN
	WRITELN;
	WRITE('<',Track:5,'>');
      END;
    DoTrack(BlockHigh,BlockLow);
    Track:=Track+1;
    IF Track > EndTrack THEN Done:=TRUE;
    IF (BlockLow < 0) AND ((BlockLow+BlocksPerTrack) >= 0) THEN
      BlockHigh:=BlockHigh+1;
    BlockLow:=BlockLow+BlocksPerTrack;
    Count:=Count+1;
  UNTIL Done;
  WRITELN;
  WRITELN;
  IF NOT TooBad THEN
    BEGIN
      WRITELN('Verify pass');
      Count:=0;
      BlockLow:=StartLow;
      BlockHigh:=StartHigh;
      Track:=StartTrack;
      Done:=FALSE;
      REPEAT
	IF (Count MOD 50) = 0 THEN
	  BEGIN
	    WRITELN;
	    WRITE('<',Track:5,'>');
	  END;
	VerifyTrack(BlockHigh,BlockLow);
	Track:=Track+1;
	IF Track > EndTrack THEN Done:=TRUE;
	IF (BlockLow < 0) AND ((BlockLow+BlocksPerTrack) >= 0) THEN
	  BlockHigh:=BlockHigh+1;
	BlockLow:=BlockLow+BlocksPerTrack;
	Count:=Count+1;
      UNTIL Done;
      WRITELN;
      WRITELN;
    END;
  IF TooBad THEN
    BEGIN
      Exception(TRUE);
      WRITELN('Format aborted');
    END;
  IF NumExtraBad > 0 THEN
    BEGIN
      Exception(TRUE);
      WRITELN('There were ',NumExtraBad,' new bad tracks found');
      IF MNU_YesorNo('Do you want a list of them?') THEN
	BEGIN
	  IF MNU_Fopen THEN
	    BEGIN
	      WRITELN(MNU_File);
	      CheckIO;
	      WRITELN(MNU_File,'New Bad Tracks:');
	      CheckIO;
	      WRITELN(MNU_File);
	      CheckIO;
	    END;
	  Index:=1;
	  WHILE Index <= NumExtraBad DO
	    BEGIN
	      WRITE('Cyl ',ExtraBad[Index] DIV OldWinch.Heads:4,' Head ',
		    ExtraBad[Index] MOD OldWinch.Heads,'    ');
	      IF MNU_Fopen THEN
		BEGIN
		  WRITE(MNU_File,'Cyl ',ExtraBad[Index] DIV OldWinch.Heads:4,
			' Head ',ExtraBad[Index] MOD OldWinch.Heads,'	 ');
		  CheckIO;
		END;
	      IF (Index MOD 4) = 0 THEN
		BEGIN
		  WRITELN;
		  IF MNU_Fopen THEN
		    BEGIN
		      WRITELN(MNU_File);
		      CheckIO;
		    END;
		END;
	      Index:=Index+1;
	    END;
	  IF MNU_Fopen THEN
	    BEGIN
	      WRITELN(MNU_File);
	      CheckIO;
	    END;
	END;
    END
  ELSE
    WRITELN('Format was successful');
  Conf_WT_Winch(17,OldWinch); { Put back old winchester configuration }
END;

PROCEDURE Verify(StartTrack,EndTrack:INTEGER);
VAR
  Temp:INTEGER;
  Count:INTEGER;
  Dummy:BOOLEAN;

PROCEDURE CheckIO;
VAR
  Dummy:BOOLEAN;
BEGIN
  IF IORESULT <> 0 THEN
    BEGIN
      Exception(TRUE);
      WRITELN('Error writing to file');
      Dummy:=SC_Space_Wait(TRUE);
      EXIT(Verify);
    END;
END;

BEGIN { Verify }
  NewWinch:=OldWinch;
  NewWinch.Tries:=FormRetries+1;
  Conf_WT_Winch(17,NewWinch);
  
  UNITREAD(17,Temp,1,0,8192); { ignore error on this read }
  FOR Count:=0 TO 32000 DO; { Just for delay }
  
  BPT:=OldWinch.BytesPerSector*OldWinch.SectorsPerTrack;
  BlocksPerTrack:=BPT DIV 512;
  
  Track:=StartTrack;
  Temp:=0;
  BlockLow:=0;
  BlockHigh:=0;
  WHILE Temp < StartTrack DO
    BEGIN
      IF (BlockLow < 0) AND ((BlockLow+BlocksPerTrack) >= 0) THEN
	BlockHigh:=BlockHigh+1;
      BlockLow:=BlockLow+BlocksPerTrack;
      Temp:=Temp+1;
    END;
  NumExtraBad:=0;
  Done:=FALSE;
  TooBad:=FALSE;
  Count:=0;
  Done:=FALSE;
  WRITELN('Verify pass');
  REPEAT
    IF (Count MOD 50) = 0 THEN
      BEGIN
	WRITELN;
	WRITE('<',Track:5,'>');
      END;
    VerifyTrack(BlockHigh,BlockLow);
    Track:=Track+1;
    IF Track > EndTrack THEN Done:=TRUE;
    IF (BlockLow < 0) AND ((BlockLow+BlocksPerTrack) >= 0) THEN
      BlockHigh:=BlockHigh+1;
    BlockLow:=BlockLow+BlocksPerTrack;
    Count:=Count+1;
  UNTIL Done;
  WRITELN;
  IF TooBad THEN
    BEGIN
      Exception(TRUE);
      WRITELN('Verify aborted');
    END;
  IF NumExtraBad > 0 THEN
    BEGIN
      Exception(TRUE);
      WRITELN('There were ',NumExtraBad,' new bad tracks found');
      IF MNU_YesorNo('Do you want a list of them?') THEN
	BEGIN
	  IF MNU_Fopen THEN
	    BEGIN
	      WRITELN(MNU_File);
	      CheckIO;
	      WRITELN(MNU_File,'New Bad Tracks:');
	      CheckIO;
	      WRITELN(MNU_File);
	      CheckIO;
	    END;
	  Index:=1;
	  WHILE Index <= NumExtraBad DO
	    BEGIN
	      WRITE('Cyl ',ExtraBad[Index] DIV OldWinch.Heads:4,' Head ',
		    ExtraBad[Index] MOD OldWinch.Heads,'    ');
	      IF MNU_Fopen THEN
		BEGIN
		  WRITE(MNU_File,'Cyl ',ExtraBad[Index] DIV OldWinch.Heads:4,
			' Head ',ExtraBad[Index] MOD OldWinch.Heads,'	 ');
		  CheckIO;
		END;
	      IF (Index MOD 4) = 0 THEN
		BEGIN
		  WRITELN;
		  IF MNU_Fopen THEN
		    BEGIN
		      WRITELN(MNU_File);
		      CheckIO;
		    END;
		END;
	      Index:=Index+1;
	    END;
	  IF MNU_Fopen THEN
	    BEGIN
	      WRITELN(MNU_File);
	      CheckIO;
	    END;
	END;
    END
  ELSE
    WRITELN('Verify successful');
  WRITELN;
  Dummy:=SC_Space_Wait(FALSE);
  Conf_WT_Winch(17,OldWinch); { Put back old winchester configuration }
END;

PROCEDURE MenuInit;
BEGIN
  MNU_Menu(M_MAIN,'Winchester Drive Selection',MNU_1Style,MN_MAIN,0);
  MNU_ItemM('Drive 0',0,0,M_FUN,FALSE);
  MNU_ItemM('Drive 1',0,1,M_FUN,FALSE);
  MNU_ItemM('Drive 2',0,2,M_FUN,FALSE);
  MNU_ItemM('Drive 3',0,3,M_FUN,FALSE);

  MNU_Menu(M_FUN,'Function Selections',MNU_1Style,MN_FUN,0);
  MNU_ItemE('Format complete disk',0,D_FC,TRUE);
  MNU_ItemM('Format selected tracks',0,D_FST,M_SFOR,FALSE);
  MNU_ItemE('Verify complete disk',0,D_VC,TRUE);
  MNU_ItemM('Verify selected tracks',0,D_VST,M_SVER,FALSE);
  MNU_ItemE('Update Device Maps',0,D_UDM,TRUE);
  MNU_ItemE('Display partition map',0,D_LPM,TRUE);
  MNU_ItemE('Display bad track map',0,D_BTM,TRUE);
  MNU_ItemE('Translate block to track',0,D_TBT,TRUE);
  MNU_ItemM('Format parameters',0,D_FPARM,M_FPARM,FALSE);

  MNU_Menu(M_SFOR,'Selective Format',MNU_1Style,MN_SFOR,6);
  MNU_ItemI('Starting cylinder',0,D_SC,MAXINT,0);
  MNU_ItemI('Starting head',0,D_SH,15,0);
  MNU_ItemI('Ending cylinder',0,D_EC,MAXINT,0);
  MNU_ItemI('Ending head',0,D_EH,15,0);
  MNU_ItemE('Do the format',0,D_DF,TRUE);

  MNU_Menu(M_SVER,'Selective Verify',MNU_1Style,MN_SVER,6);
  MNU_CopyI(M_SFOR,D_SC);
  MNU_CopyI(M_SFOR,D_SH);
  MNU_CopyI(M_SFOR,D_EC);
  MNU_CopyI(M_SFOR,D_EH);
  MNU_ItemE('Do the verify',0,D_DV,TRUE);

  MNU_Menu(M_FPARM,'Format Parameters',MNU_1Style,MN_FPARM,10);
  MNU_ItemH('Data pattern',0,D_DPAT,2);
  MNU_ItemI('Retries',0,D_FRTRY,MAXINT,0);
END;

PROCEDURE UpdateDeviceMap;
VAR
  Dummy:BOOLEAN;
  Temp:Win_DiskImage;
  TempWinch:Conf_Winch;
BEGIN
  WITH DiskImage[Drive].PromInfo DO
    BEGIN
      Heads:=OldWinch.Heads;
      SectorsPerTrack:=OldWinch.SectorsPerTrack;
      BytesPerSector:=OldWinch.BytesPerSector;
      LowReadCounter:=OldWinch.LowReadCounter;
      HighReadCounter:=OldWinch.HighReadCounter;
      StepCtr:=OldWinch.StepCtr;
    END;
  WRITELN;
  IF XUNITWRITE(17,DiskImage[Drive],SIZEOF(Win_DiskImage),0,0,8192) <> 0  THEN
    BEGIN
      Exception(TRUE);
      WRITELN('Error writing configuration to disk')
    END
  ELSE
    IF XUNITREAD(17,Temp,SIZEOF(Win_DiskImage),0,0,8192) <> 0 THEN
      BEGIN
	Exception(TRUE);
	WRITELN('Error reading back configuration from disk')
      END
    ELSE
      IF DiskImage[Drive] <> Temp THEN
	BEGIN
	  Exception(TRUE);
	  WRITELN('Error comparing configuration on disk')
	END
      ELSE
	BEGIN
	  { Force recalibrate & reload of device map }
	  Conf_Rd_Winch(17,TempWinch);
	  Conf_Wt_Winch(17,TempWinch);
	  WRITELN('Configuration stored successfully');
	END;
  WRITELN;
  Dummy:=SC_Space_Wait(FALSE);
END;

PROCEDURE FormatComplete;
VAR
  S:STRING;
BEGIN
  MNU_ClrScreen;
  S:='Do you really want to destroy all information on Winchester drive ';
  SIO_IntWt(Drive,S);
  S:=CONCAT(S,'?');
  IF MNU_YesorNo(S) THEN
    BEGIN
      FORMAT(0,(OldWinch.Cylinders*OldWinch.Heads)-1);
      UpdateDeviceMap;
    END;
END;

FUNCTION CheckLimits:BOOLEAN;
VAR
  Error:BOOLEAN;
BEGIN
  Error:=FALSE;
  WITH OldWinch DO
    BEGIN
      IF StartCyl > (Cylinders-1) THEN
	BEGIN
	  WRITELN('Starting cylinder > ',Cylinders-1);
	  Error:=TRUE;
	END;
      IF StartHead > (Heads-1) THEN
	BEGIN
	  WRITELN('Starting head > ',Heads-1);
	  Error:=TRUE;
	END;
      IF EndCyl > (Cylinders-1) THEN
	BEGIN
	  WRITELN('Ending cylinder > ',Cylinders-1);
	  Error:=TRUE;
	END;
      IF EndHead > (Heads-1) THEN
	BEGIN
	  WRITELN('Ending head > ',Heads-1);
	  Error:=TRUE;
	END;
    END;
  IF Error THEN
    BEGIN
      WRITE('Process aborted');
      MNU_Reject:=TRUE;
    END;
  CheckLimits:=NOT Error;
END;

PROCEDURE FormatSelected;
VAR
  S:STRING;
  StartTrack,EndTrack:INTEGER;
  Dummy:BOOLEAN;
BEGIN
  MNU_ClrScreen;
  IF NOT CheckLimits THEN EXIT(FormatSelected);
  WRITELN('Do you really want to destroy information on Winchester drive ',
	   Drive,',');
  S:='Cylinder ';
  SIO_IntWt(StartCyl,S);
  S:=CONCAT(S,' Head ');
  SIO_IntWt(StartHead,S);
  S:=CONCAT(S,'	 to  Cylinder ');
  SIO_IntWt(EndCyl,S);
  S:=CONCAT(S,' Head ');
  SIO_IntWt(EndHead,S);
  S:=CONCAT(S,' ?');
  IF MNU_YesorNo(S) THEN
    BEGIN
      StartTrack:=(StartCyl*OldWinch.Heads)+StartHead;
      EndTrack:=(EndCyl*OldWinch.Heads)+EndHead;
      FORMAT(StartTrack,EndTrack);
    END;
  WRITELN;
  Dummy:=SC_Space_Wait(FALSE);
END;

PROCEDURE VerifyComplete;
BEGIN
  MNU_ClrScreen;
  Verify(0,(OldWinch.Cylinders*OldWinch.Heads)-1)
END;

PROCEDURE VerifySelected;
VAR
  StartTrack,EndTrack:INTEGER;
BEGIN
  MNU_ClrScreen;
  IF NOT CheckLimits THEN EXIT(VerifySelected);
  StartTrack:=(StartCyl*OldWinch.Heads)+StartHead;
  EndTrack:=(EndCyl*OldWinch.Heads)+EndHead;
  Verify(StartTrack,EndTrack);
END;

PROCEDURE ListPartitionMap;
VAR
  Part:INTEGER;
  Dum:BOOLEAN;
  N:Win_NameType;
  I:INTEGER;
  Blocks:INTEGER[8];
  Category:STRING;
  StartCyl,StartHead:INTEGER;
  EndCyl,EndHead:INTEGER;
  TotalBad:INTEGER;
  TotalBlocks:INTEGER[8];
  Scan:INTEGER;

PROCEDURE CheckIO;
VAR
  Dummy:BOOLEAN;
BEGIN
  IF IORESULT <> 0 THEN
    BEGIN
      Exception(TRUE);
      WRITELN('Error writing to file');
      Dummy:=SC_Space_Wait(TRUE);
      EXIT(ListPartitionMap);
    END;
END;

BEGIN
  MNU_ClrScreen;
  TotalBad:=0;
  Scan:=0;
  WHILE (Scan < Win_BadMax) DO
    BEGIN
      IF DiskImage[Drive].BadTracks[Scan] <> 0 THEN TotalBad:=TotalBad+1;
      Scan:=Scan+1;
    END;
  WITH OldWinch DO
    BEGIN
      BlocksPerTrack:=(BytesPerSector*SectorsPerTrack) DIV 512;
      TotalBlocks:=BlocksPerTrack;
      TotalBlocks := ((Cylinders * Heads)-1)*TotalBlocks;
      TotalBlocks := TotalBlocks - (TotalBad*BlocksPerTrack);
    END;
  WRITE('Drive ',Drive,':  ',TotalBlocks,' usable blocks');
  IF TotalBad > 0 THEN WRITELN(', ',TotalBad,' bad tracks') ELSE WRITELN;
  WRITELN(' ':49,'Logical track range');
  WRITELN('Partition  Name	    Blocks    Category	    ',
	  'Cyl Hd  to  Cyl Hd')  WRITELN;
  IF MNU_Fopen THEN
    BEGIN
      WRITELN(MNU_File);
      CheckIO;
      WRITELN(MNU_File);
      CheckIO;
      WRITE(MNU_File,'Drive ',Drive,':	',TotalBlocks,' usable blocks');
      CheckIO;
      IF TotalBad > 0 THEN
	WRITELN(MNU_File,', ',TotalBad,' bad tracks')
      ELSE
	WRITELN(MNU_File);
      CheckIO;
      WRITELN(MNU_File,' ':49,'Logical track range');
      CheckIO;
      WRITELN(MNU_File,'Partition  Name		 Blocks	   Category	 ',
	      'Cyl Hd  to  Cyl Hd');
      CheckIO;
      WRITELN(MNU_File);
      CheckIO;
    END;
  FOR Part:= 0 TO 15 DO
    WITH DiskImage[Drive] DO
      BEGIN
	IF (Part=0) OR (Devmap[Part].BaseTrack <> 0) THEN
	  BEGIN
	    N:=DevData[Part].Name;
	    FOR I := 0 TO 7 DO
	      IF N[I] = CHR(0) THEN N[I]:=' ';
	    WITH OldWinch DO
	      BEGIN
		Blocks:=BlocksPerTrack;
		Blocks:=Blocks*(DevMap[Part].TopTrack-
				DevMap[Part].BaseTrack+1);
		StartCyl:= DevMap[Part].BaseTrack DIV OldWinch.Heads;
		StartHead:=DevMap[Part].BaseTrack MOD OldWinch.Heads;
		EndCyl:=DevMap[Part].TopTrack DIV OldWinch.Heads;
		EndHead:=DevMap[Part].TopTrack MOD OldWinch.Heads;
	      END;
	    Category:='';
	    CASE DevData[Part].System OF
	      1:Category:='UCSD';
	      2:Category:='CPM';
	      3:Category:='MODULA';
	      4:Category:='HYFORTH';
	      5:Category:='PDOS';
	      6:Category:='MIRAGE';
	      7:Category:='BOS';
	      8:Category:='IDRIS';
	    END;
	    WRITELN('	',Part:2,'	',N,'	 ',Blocks:8,'	 ',Category:8,
		    '	 ',StartCyl:5,'	 ',StartHead,'	  ',EndCyl:5,
		    '  ',EndHead);
	    IF MNU_Fopen THEN
	      BEGIN
		WRITELN(MNU_File,'   ',Part:2,'	     ',N,'    ',Blocks:8,
			'    ',Category:8,
			'    ',StartCyl:5,'  ',StartHead,'    ',EndCyl:5,
			'  ',EndHead);
		CheckIO;
	      END;
	  END;
      END;
  WRITELN;
  IF MNU_Fopen THEN
    BEGIN
      WRITELN(MNU_File);
      CheckIO;
    END;
  Dum:=SC_Space_Wait(FALSE);
END;

PROCEDURE TranslateBlocktoTrack;
VAR
  Part:INTEGER;
  Block:INTEGER[8];
  Track:INTEGER;
  Dum:BOOLEAN;
  Scan:INTEGER;
BEGIN
  WITH DiskImage[Drive],OldWinch DO
    BEGIN
      MNU_ClrScreen;
      WRITE('Partition number: ');
      READLN(Part);
      WRITELN;
      IF (Part >= 0) AND (Part <= 15) THEN
	BEGIN
	  WRITE('Logical Block number: ');
	  READLN(Block);
	  WRITELN;
	  Block:=Block DIV (SectorsPerTrack*BytesPerSector DIV 512);
	  Track:=TRUNC(Block)+DevMap[Part].BaseTrack;
	  Scan:=0;
	  WHILE (Scan < Win_BadMax) DO
	    BEGIN
	      IF BadTracks[Scan] <> 0 THEN
		IF BadTracks[Scan] <= Track THEN Track:=Track+1;
	      Scan:=Scan+1;
	    END;
	  WRITELN('Physical Track is ',Track,' (Cyl ',Track DIV Heads,'	 Head ',
		   Track MOD Heads,')');
	END;
      WRITELN;
      Dum:=SC_Space_Wait(FALSE);
    END;
END;

PROCEDURE ListBadTracks;
VAR
  Scan:INTEGER;
  Counter:INTEGER;
  Cyl,Head:INTEGER;
  Track:INTEGER;
  Dummy:BOOLEAN;

PROCEDURE CheckIO;
VAR
  Dummy:BOOLEAN;
BEGIN
  IF IORESULT <> 0 THEN
    BEGIN
      Exception(TRUE);
      WRITELN('Error writing to file');
      Dummy:=SC_Space_Wait(TRUE);
      EXIT(ListBadTracks);
    END;
END;

BEGIN { ListBadTracks}
  MNU_ClrScreen;
  Counter:=0;
  Scan:=0;
  WHILE (Scan < Win_BadMax) DO
    BEGIN
      Track:=DiskImage[Drive].BadTracks[Scan];
      IF Track <> 0 THEN
	BEGIN
	  IF Counter = 0 THEN
	    BEGIN
	      WRITELN('Bad tracks on drive ',Drive);
	      WRITELN;
	      WRITELN('	 Cyl Hd	     Cyl Hd	 Cyl Hd	     Cyl Hd');
	      WRITELN;
	      IF MNU_Fopen THEN
		BEGIN
		  WRITELN(MNU_File);
		  CheckIO;
		  WRITELN(MNU_File,'Bad tracks on drive ',Drive);
		  CheckIO;
		  WRITELN(MNU_File);
		  CheckIO;
		  WRITELN(MNU_File,
			  '  Cyl Hd	 Cyl Hd	     Cyl Hd	 Cyl Hd');
		  CheckIO;
		  WRITELN(MNU_File);
		  CheckIO;
		END;
	    END;
	  Cyl:= Track DIV OldWinch.Heads;
	  Head:= TRACK MOD OldWinch.Heads;
	  WRITE(Cyl:5,'	 ',Head,'    ');
	  IF MNU_Fopen THEN
	    BEGIN
	      WRITE(MNU_File,Cyl:5,'  ',Head,'	  ');
	      CheckIO;
	    END;
	  Counter:=Counter+1;
	  IF (Counter MOD 4) = 0 THEN
	    BEGIN
	      WRITELN;
	      IF MNU_Fopen THEN
		BEGIN
		  WRITELN(MNU_File);
		  CheckIO;
		END;
	    END;
	END;
      Scan:=Scan+1;
    END;
  WRITELN;
  IF MNU_Fopen THEN
    BEGIN
      WRITELN(MNU_File);
      CheckIO;
    END;
  IF (Counter MOD 4) <> 0 THEN
    BEGIN
      WRITELN;
      IF MNU_Fopen THEN
	BEGIN
	  WRITELN(MNU_File);
	  CheckIO;
	  WRITELN(MNU_File);
	  CheckIO;
	END;
    END;
  IF Counter = 0 THEN
    BEGIN
      WRITELN('No bad tracks on drive ',Drive);
      WRITELN;
    END;
  Dummy:=SC_Space_Wait(TRUE);
END;


PROCEDURE GetDriveInfo;
VAR
  H:INTEGER;
BEGIN
  IF XUNITREAD(17,DiskImage[Drive],SIZEOF(Win_DiskImage),0,0,0) <> 0 THEN
    BEGIN
      MNU_Error;
      Exception(TRUE);
      WRITELN('Could not read configuration from drive');
    END
  ELSE
    BEGIN
      HeadsOnDrive[Drive]:=DiskImage[Drive].PromInfo.Heads;
      H:=((DiskImage[Drive].DevMap[0].TopTrack+1) DIV OldWinch.Cylinders);
      IF (H = HeadsOnDrive[Drive]) AND (H <> 0) THEN 
	BEGIN
	  OldWinch.Heads:=HeadsOnDrive[Drive];
	  ValidConfig[Drive]:=TRUE;
	  HeadSet[Drive]:=TRUE;
	END;
    END;
END;

PROCEDURE GetHead;
VAR
  NumHeads:INTEGER;
  Found:BOOLEAN;
  Dummy:BOOLEAN;
  S:STRING;
  Cursor:INTEGER;
BEGIN
  IF NOT HeadSet[Drive] THEN
    BEGIN
      Found:=FALSE;
      FILLCHAR(DiskImage[Drive],SIZEOF(WIN_DiskImage),0);
      REPEAT
	WRITE('Enter number of heads on drive ',Drive,': ');
	READLN(S);
	IF LENGTH(S) = 0 THEN
	  BEGIN
	    MNU_Reject:=TRUE;
	    EXIT(GetHead);
	  END;
	Cursor:=1;
	IF SIO_IntRd(Cursor,S,NumHeads) THEN
	  BEGIN
	    IF (NumHeads < 1) OR (NumHeads > 16) THEN
	      BEGIN
		WRITE(CHR(7),'Head range is 1 to 16, ');
		Dummy:=SC_Space_Wait(TRUE);
		MNU_ClrScreen;
	      END
	    ELSE
	      BEGIN
		Found:=TRUE;
		HeadSet[Drive]:=TRUE;
		OldWinch.Heads:=NumHeads;
		HeadsOnDrive[Drive]:=NumHeads;
		DiskImage[Drive].DevMap[0].TopTrack := (NumHeads *
		    OldWinch.Cylinders)-1;
	      END;
	  END
	ELSE
	  WRITE(CHR(7));
      UNTIL Found;
    END;
END;


BEGIN
  WRITELN;
  WRITELN('Winchester Formatter Version ',Version);
  WRITELN;
  Init;
  ReadFile;
  IF NOT GoodRead THEN
    BEGIN
      MEMSWAP('OSUTIL');
      EXIT(PROGRAM);
    END;
  MenuInit;
  MNU_Show('MAIN');
  REPEAT
    MNU_Loop;
    CASE MNU_State OF
      MNU_Enter:IF MNU_MenuNumber = MN_FUN THEN
		  BEGIN
		    Drive:=MNU_ItemNumber;
		    Conf_Assign(17,9,Drive*16);
		    Conf_RD_Winch(17,OldWinch);
		    StartCyl:=OldWinch.Cylinders;
		    IF StartCyl = 0 THEN
		      BEGIN
			Exception(TRUE);
			MNU_Error;
			WRITE('Drive is not configured in BIOS');
			MNU_Reject:=TRUE;
		      END
		    ELSE
		      BEGIN
			StartHead:=0;
			EndCyl:=StartCyl;
			EndHead:=0;
			IF NOT ValidConfig[Drive] THEN
			  BEGIN
			    GetDriveInfo;
			    IF NOT HeadSet[Drive] THEN GetHead;
			  END
			ELSE
			  BEGIN
			    OldWinch.Heads:=HeadsOnDrive[Drive];
			  END;
		      END;
		  END;
      MNU_Put:CASE MNU_MenuNumber OF
		MN_FUN:CASE MNU_ItemNumber OF
			 D_FC:FormatComplete;
			 D_VC:VerifyComplete;
			 D_UDM:BEGIN
				 MNU_ClrScreen;
				 UpdateDeviceMap;
			       END;
			 D_LPM:ListPartitionMap;
			 D_TBT:TranslateBlocktoTrack;
			 D_BTM:ListBadTracks;
		       END;
		MN_SFOR:CASE MNU_ItemNumber OF
			  D_SC:StartCyl:=MNU_Value;
			  D_SH:StartHead:=MNU_Value;
			  D_EC:EndCyl:=MNU_Value;
			  D_EH:EndHead:=MNU_Value;
			  D_DF:FormatSelective;
			END;
		MN_SVER:CASE MNU_ItemNumber OF
			  D_SC:StartCyl:=MNU_Value;
			  D_SH:StartHead:=MNU_Value;
			  D_EC:EndCyl:=MNU_Value;
			  D_EH:EndHead:=MNU_Value;
			  D_DV:VerifySelective;
			END;
		MN_FPARM:CASE MNU_ItemNumber OF
			  D_DPAT:FormPattern:=MNU_Value;
			  D_FRTRY:FormRetries:=MNU_Value;
			 END;
	      END;
      MNU_Get:CASE MNU_MenuNumber OF
		MN_SFOR,
		MN_SVER:CASE MNU_ItemNumber OF
			  D_SC:MNU_Value:=StartCyl;
			  D_SH:MNU_Value:=StartHead;
			  D_EC:MNU_Value:=EndCyl;
			  D_EH:MNU_Value:=EndHead;
			END;
		MN_FPARM:CASE MNU_ItemNumber OF
			  D_DPAT:MNU_Value:=FormPattern;
			  D_FRTRY:MNU_Value:=FormRetries;
			 END;
	      END;
      MNU_Exit:IF MNU_MenuNumber = MN_FUN THEN
		 BEGIN
		   Conf_Restore;
		 END;
    END;
  UNTIL MNU_State = MNU_Done;
  MEMSWAP('OSUTIL');
END.

                                                                                                                                                                                                                                                                                                                                                                                                                                                                          