head     56.3;
access   paws bayes jws quist brad dew jwh;
symbols  ;
locks    ; strict;
comment  @# @;


56.3
date     93.01.27.13.23.52;  author jwh;  state Exp;
branches ;
next     56.2;

56.2
date     93.01.27.12.03.47;  author jwh;  state Exp;
branches ;
next     56.1;

56.1
date     91.11.05.10.00.07;  author jwh;  state Exp;
branches ;
next     55.1;

55.1
date     91.08.25.10.34.58;  author jwh;  state Exp;
branches ;
next     54.1;

54.1
date     91.03.18.15.35.22;  author jwh;  state Exp;
branches ;
next     53.1;

53.1
date     91.03.11.19.34.47;  author jwh;  state Exp;
branches ;
next     52.1;

52.1
date     91.02.19.09.20.54;  author jwh;  state Exp;
branches ;
next     51.1;

51.1
date     91.01.30.16.19.27;  author jwh;  state Exp;
branches ;
next     50.1;

50.1
date     90.10.29.16.33.19;  author jwh;  state Exp;
branches ;
next     49.1;

49.1
date     90.08.14.14.17.03;  author jwh;  state Exp;
branches ;
next     48.1;

48.1
date     90.07.26.11.23.34;  author jwh;  state Exp;
branches ;
next     47.1;

47.1
date     90.05.14.11.09.45;  author dew;  state Exp;
branches ;
next     46.1;

46.1
date     90.05.07.08.56.44;  author jwh;  state Exp;
branches ;
next     45.1;

45.1
date     90.04.19.16.04.54;  author jwh;  state Exp;
branches ;
next     44.1;

44.1
date     90.04.01.22.22.42;  author jwh;  state Exp;
branches ;
next     43.1;

43.1
date     90.03.20.14.14.45;  author jwh;  state Exp;
branches ;
next     42.1;

42.1
date     90.01.23.17.58.47;  author jwh;  state Exp;
branches ;
next     41.1;

41.1
date     89.12.22.11.40.36;  author jwh;  state Exp;
branches ;
next     40.1;

40.1
date     89.09.29.12.01.46;  author jwh;  state Exp;
branches ;
next     39.1;

39.1
date     89.09.26.16.46.40;  author dew;  state Exp;
branches ;
next     38.1;

38.1
date     89.08.29.11.39.09;  author jwh;  state Exp;
branches ;
next     37.1;

37.1
date     89.05.12.11.52.39;  author dew;  state Exp;
branches ;
next     36.1;

36.1
date     89.02.06.10.30.02;  author dew;  state Exp;
branches ;
next     35.1;

35.1
date     89.02.02.13.47.35;  author dew;  state Exp;
branches ;
next     34.1;

34.1
date     89.01.23.16.21.46;  author jwh;  state Exp;
branches ;
next     33.1;

33.1
date     89.01.16.11.52.16;  author dew;  state Exp;
branches ;
next     32.1;

32.1
date     89.01.10.12.02.38;  author bayes;  state Exp;
branches ;
next     31.1;

31.1
date     88.12.14.18.23.23;  author bayes;  state Exp;
branches ;
next     30.1;

30.1
date     88.12.09.14.00.06;  author dew;  state Exp;
branches ;
next     29.1;

29.1
date     88.10.31.15.44.41;  author bayes;  state Exp;
branches ;
next     28.1;

28.1
date     88.10.06.11.10.18;  author dew;  state Exp;
branches ;
next     27.1;

27.1
date     88.09.29.11.54.11;  author bayes;  state Exp;
branches ;
next     26.1;

26.1
date     88.09.28.14.18.00;  author bayes;  state Exp;
branches ;
next     25.1;

25.1
date     88.03.02.09.50.33;  author bayes;  state Exp;
branches ;
next     24.1;

24.1
date     87.08.31.10.25.21;  author jws;  state Exp;
branches ;
next     23.1;

23.1
date     87.08.26.11.15.37;  author bayes;  state Exp;
branches ;
next     22.1;

22.1
date     87.08.17.11.51.51;  author bayes;  state Exp;
branches ;
next     21.1;

21.1
date     87.08.12.14.36.41;  author bayes;  state Exp;
branches ;
next     20.1;

20.1
date     87.07.30.11.48.00;  author bayes;  state Exp;
branches ;
next     19.1;

19.1
date     87.06.01.09.04.18;  author jws;  state Exp;
branches ;
next     18.1;

18.1
date     87.05.20.16.06.56;  author bayes;  state Exp;
branches ;
next     17.1;

17.1
date     87.04.30.11.09.39;  author jws;  state Exp;
branches ;
next     16.1;

16.1
date     87.04.26.16.19.22;  author jws;  state Exp;
branches ;
next     15.1;

15.1
date     87.04.13.10.02.26;  author jws;  state Exp;
branches ;
next     14.1;

14.1
date     87.04.01.16.14.41;  author jws;  state Exp;
branches ;
next     13.1;

13.1
date     87.02.28.19.01.55;  author jws;  state Exp;
branches ;
next     12.1;

12.1
date     87.02.02.13.56.41;  author jws;  state Exp;
branches ;
next     11.1;

11.1
date     87.01.19.10.22.52;  author jws;  state Exp;
branches ;
next     10.1;

10.1
date     86.12.24.11.38.52;  author jws;  state Exp;
branches ;
next     9.1;

9.1
date     86.12.12.15.24.41;  author bayes;  state Exp;
branches ;
next     8.1;

8.1
date     86.11.27.12.31.42;  author jws;  state Exp;
branches ;
next     7.1;

7.1
date     86.11.20.14.49.09;  author hal;  state Exp;
branches ;
next     6.1;

6.1
date     86.11.04.18.38.05;  author paws;  state Exp;
branches ;
next     5.1;

5.1
date     86.10.28.17.27.28;  author hal;  state Exp;
branches ;
next     4.1;

4.1
date     86.09.30.20.21.25;  author hal;  state Exp;
branches ;
next     3.1;

3.1
date     86.09.01.12.43.09;  author hal;  state Exp;
branches ;
next     2.1;

2.1
date     86.07.30.15.20.45;  author hal;  state Exp;
branches ;
next     1.1;

1.1
date     86.06.30.17.26.24;  author danm;  state tmp;
branches ;
next     ;


desc
@Base file for PWS 3.2 release.

@


56.3
log
@
pws2rcs automatic delta on Wed Jan 27 13:14:25 MST 1993
@
text
@$page$

{*******************************************************************************}


{program initialize(input,output);}


  {   Last Updated September 30, 1981  }

{
   This program formats the disc media.  It scans
  the media one surface at a time looking for
  defective, spare and possibly defective
  tracks.  Each surface is scanned twice.  First
  it builds two tables for the surface it is
  scanning.  One table contains all tracks
  previously marked defective.  The other
  contains all tracks that yield CRC-Data Errors
  when verified.  The elements of the possibly-
  defective table are then pattern-tested
  20 times each.  If one fails any of the 20
  tests it is determined defective and put
  into the Defective table.  If it passes it is
  assumed good.  Now elements of the defective
  table are spared.  The program then repeats
  this entire process for each surface.
}

{*******************************************************************************}

module asmr;

import sysglobals;

export

   type
     statrec =  packed record case integer of
	  0 : (status : packed array[1..4] of byte);
	  1 : (intfld : integer)
	  end; {record}
     buffer = packed array[1..16384] of byte;
     bptr = ^buffer;

     procedure verify(busaddr,iounit,headnum : shortint;
		      phiport,sectors : integer;
		      var tracknum,errtype : integer);

     procedure format(busaddr,iounit,headnum : shortint;
		      phiport,track2,sectors : integer;
		      spdword : shortint; madr : bptr;
		      var track1, errtype : integer);

implement {asmr}

  procedure verify(busaddr,iounit,headnum : shortint;
		   phiport,sectors : integer;
		   var tracknum,errtype : integer); external ;

  procedure format(busaddr,iounit,headnum : shortint;
		   phiport,track2,sectors : integer;
		   spdword : shortint; madr : bptr;
		   var track1, errtype : integer); external ;

end; {asmr}

{*******************************************************************************}

module Xminit;  {jpc}

import
  sysglobals,
  initunits,
  isr;

export
  procedure Xminitialize(drivetype: char;
			    selectcode: integer;
			    hpibaddr: shortint;
			    discunit: shortint);  {jpc}

implement {Xminit}

import
  asmr,
  midecs;

var
  initisrib : isrib;

procedure Xminitialize;  {jpc}

label 1;

const maxtimes=2; {times to verify each surface}

var
     spdcontrol : shortint;

     bufptr : bptr; {address of data area}

{***********************************************}

{ Parameters supplied by user or calling program}

{    hpibaddr,discunit : shortint;
     selectcode : integer; drivetype : char;  }
     debugflag : boolean;
     filename : string80;{if debugflag true}

{***********************************************}

     debuginput : char;
     status : statrec;
     unitid : text;

     minspare, maxspare, minhead, maxhead, sectorspertrack : integer;
     trackA, trackB : integer;
     oldtracknumber, head, sectorcount, tracknumber : integer;
     errortype : statrec;
     baddrivetype : boolean;

     deftable,sptable : array[1..15] of integer;
     pdtable : array[1..815] of integer;
     times,i,defptr,spptr,pdptr,tempptr,numberofspares : integer;
     inpdtable,found : boolean;


{*************************************************************************}


procedure errorhandle;
{
     This procedure will interpret the disc status or escape code
and return the appropriate ioresult
}
begin
with errortype do
     begin
     writeln('INITIALIZE ERROR, disc status = ',
		     intfld:0);

     if status[1]=19 then
	  begin
	  writeln('Disc is Write Protected or FORMAT switch is off');
	  writeln('Please turn FORMAT switch on and WRITE PROTECT off');
	  end;
     end;{with}
end; {procedure errorhandle}

{*********************************************************************}

procedure search( sparetrack:integer; var indeftable : boolean);
{
     This procedure searches the defective track table for the
     sparetrack.  If found then it sets indeftable true
}
var j:integer;
begin
indeftable:=false;
for j:=1 to defptr do
     if sparetrack=deftable[j] then indeftable:=true;
end; {procedure search}

{*********************************************************************}

procedure patterngenerate(k : integer);

{ This procedure generates the worst case test patterns for 7906, 7920
  and 7925 platters.  The bit pattern is repeating '101101101101101101...'
  sent over the entire track.  This pattern is then shifted left one bit
  and repeated.  It is then shifted on more time to complete the cycle'
}

var rotate : integer; {indicates which bit shift we are on}
    testbyte : packed array[1..3] of byte;  {these are the three
		   repeating bytes of the test pattern}
    j : integer;

begin
rotate := k mod 3;
case rotate of
     0 : begin
	 testbyte[1]:=109; testbyte[2]:=219; testbyte[3]:=182;
	 end;
     1 : begin
	 testbyte[1]:=219; testbyte[2]:=182; testbyte[3]:=109;
	 end;
     2 : begin
	 testbyte[1]:=182; testbyte[2]:=109; testbyte[3]:=219;
	 end;
     end; {case}

for j:=1 to 16384 do {enough to fill up 7925 track}
     bufptr^[j] := testbyte[(j-1) mod 3 + 1];

end; {procedure patterngenerate}

{*******************************************************}

begin {Xminitialize}

{***********************************************}
{
 These questions are not necessary if INITIALIZE
 is a called procedure

write('HP-IB address of disc controller = ');readln(hpibaddr);
write('Unit number of drive = ');readln(discunit);
write('Drive type (C, D, P, X) ');
readln(drivetype);
write('Select code of 98625A disc interface ');readln(selectcode);
write('Debug on (y/n)? ');read(debuginput);
writeln;
if debuginput='y' then debugflag:=true else
}

     debugflag := extended_features_mode;

{***********************************************}

if debugflag then
     begin
     write('Output device = ');
     readln(filename);
     rewrite(unitid,filename);
     end;

selectcode:=selectcode*65536;
selectcode:=selectcode+6291456;

{link in new ISR}

isrlink(noisr,charptr(selectcode+3),192,192,6,addr(initisrib));

{ now set up parameters }

sectorspertrack := 48;
minhead:=0; maxspare:=814; minspare:=800;
case drivetype of
     'c','C' : begin
	   maxspare:=409; minspare:=400; maxhead:=1
	   end;
     'd','D' : begin
	   maxspare:=409; minspare:=400; maxhead:=3; minhead:=2
	   end;
     'p','P' : maxhead:=4;
     'x','X' : begin
	   maxhead:=8; sectorspertrack:=64
	   end;
     otherwise begin
	   writeln('INITIALIZE ERROR - Illegal Drivetype');
	   goto 1
	   end
     end; { case }

numberofspares := maxspare-minspare+1;
new(bufptr);

if debugflag then writeln(unitid,'INITIALIZE debug');

{ First part of INITIALIZE.  It scans the disc
  and builds the defective table and the
  possibly-defective table.
}

with errortype do
     begin

     for head := minhead to maxhead do

	  begin
	  if debugflag then
	       begin
	       writeln(unitid);
	       writeln(unitid,'head = ',head:0);
	       end;

	  pdptr:=0; defptr:=0;

	  for times := 1 to maxtimes do
	       begin
	       if debugflag then writeln(unitid,'times = ',times:0);
	       sectorcount:=sectorspertrack*(maxspare+1);
	       tracknumber:=0;
	       intfld:=0;

	       while sectorcount>0 do

		    begin

		    {setup parameters}

		    if debugflag then
			 writeln(unitid,'starting scan at track ',tracknumber:0);

		    oldtracknumber:=tracknumber;

		    verify(hpibaddr,discunit,
			 head,selectcode,sectorcount,
			 tracknumber,intfld);

		    { now check to see if drive type is correct }

		    baddrivetype:=false;

		    case (status[3] mod 128) div 2 of
		    0 : if (drivetype<>'C') and (drivetype<>'c')
			and (drivetype<>'D') and (drivetype<>'d') then
			    baddrivetype:=true;
		    1 : if (drivetype<>'P') and (drivetype<>'p') then
			    baddrivetype:=true;
		    3 : if (drivetype<>'X') and (drivetype<>'x') then
			    baddrivetype:=true;
		    otherwise baddrivetype:=true;
		    end; {case}
		    if baddrivetype then
			 begin
			 writeln('INITIALIZE ERROR -Illegal drivetype');
			 goto 1;
			 end;


		    {now strip off spd bits}
		    status[1] := status[1] mod 32;

		    if (status[1]<>0) or (status[3] div 128 <>0) then
			 begin
			 if debugflag then
			      begin
			      write(unitid,'tracknumber = ',tracknumber:0);
			      writeln(unitid,'  status[1] = ',status[1]:0);
			      end;

			 case status[1] of
			      16 : begin
				   if debugflag then
				      writeln(unitid,'S-bit set on track ',tracknumber:0);
				    {now format tracknumber with s=0}
				   spdcontrol:=0;
				   trackA:=tracknumber;
				   format(hpibaddr,discunit,head,selectcode,
					  tracknumber,sectorspertrack,
					  spdcontrol,bufptr,trackA,intfld);
				   status[1]:=status[1] mod 32;
				   if status[1]<>0 then
					begin
					errorhandle;
					goto 1
					end;
				   end;

			      17 : begin
				   if times=1 then {all defective tracks found the first time}
					begin
					if debugflag then
					   writeln(unitid,'D-bit set on track ',tracknumber:0);
					defptr:=defptr+1;
					if defptr>numberofspares then
					     begin
					       writeln('Too many defective tracks');
					     goto 1;
					     end
					else begin
					     deftable[defptr] := tracknumber;
					     tracknumber:=tracknumber+1;
					     end;
					end

				    else tracknumber:=tracknumber+1;
				    end;

			    8,15  : begin
				    if debugflag then
				    writeln(unitid,
				      'CRC error - possibly defective track # ',tracknumber:0);
				    inpdtable:=false;
				    {
				     now search pdtable to see if the track
					has already been found.
				    }
				    for i:=1 to pdptr do
					 if tracknumber=pdtable[i] then inpdtable:=true;
				    if not inpdtable then
					 begin
					 pdptr:=pdptr+1;
					 pdtable[pdptr]:=tracknumber;
					 end;
				    tracknumber:=tracknumber+1;
				    end;
			  otherwise begin
				    if debugflag then
					 begin
					 writeln(unitid,'fatal error');
					 writeln(unitid,'status = ',intfld:0);
					 end;
				    errorhandle;
				    goto 1;
				    end;
				end; {case}
			 sectorcount:=sectorcount-((tracknumber-
			 oldtracknumber)*sectorspertrack);
			 end
		    else sectorcount:=0;

		    end; {while loop}

	       end;{for times loop}

	  if debugflag then
	       begin
	       write(unitid,'There are ',pdptr:0);
	       writeln(unitid,' possibly defective tracks on head ',head:0);
	       end;

	  tempptr:=1; intfld:=0;
	  while tempptr<=pdptr do
	       begin
	       spdcontrol:=0;
		    trackA:=pdtable[tempptr];
			 trackB:=trackA;
		    i:=0; {initialize test count}
		    if debugflag then
			 writeln(unitid,'pattern testing track ',trackA:0);

	       while (i<20) and (status[1]=0) do
		    begin

		    {first format with pattern}

		    patterngenerate(i);

		    if debugflag then
		    writeln(unitid,'calling format, i= ',i:0);

		    format(hpibaddr,discunit,head,selectcode,
			   trackB,sectorspertrack,spdcontrol,
			   bufptr,trackA,intfld);

		    status[1]:=status[1] mod 32;
		    if status[1]<>0 then
			 begin
			 errorhandle;
			 goto 1;
			 end;
		    {now verify that track}
		    verify(hpibaddr,discunit,head,selectcode,
			   sectorspertrack,trackA,intfld);
		    status[1]:=status[1] mod 32;
		    i:=i+1;

		    end; {while}

	       if status[1]=8 then
		    begin
		    spdcontrol:=1; {set D-bit}
		    if debugflag then
			 writeln(unitid,'Proven defective - track ',
			 pdtable[tempptr]:0);
		    { add to defective-track table }
		    defptr:=defptr+1;
		    if defptr>numberofspares then
			 begin
			 if debugflag then
			  writeln(unitid, 'Too many defective tracks.');
			 writeln('Too many defective tracks');goto 1;
			 end;
		    deftable[defptr]:=pdtable[tempptr];
		    if debugflag then
		       writeln(unitid,'Setting D-bit on track ',pdtable[tempptr]:0);
		    format(hpibaddr,discunit,head,selectcode,
			   trackB,sectorspertrack,spdcontrol,
			   bufptr,trackA,intfld);
		    status[1]:=status[1] mod 32;
		    if status[1]<>0 then
			 begin
			 errorhandle;
			 goto 1;
			 end;
		    end;
	       tempptr:=tempptr+1;
	       end; {while}

{
     Now there are defptr entries in the defective-track table.  These
     should each be spared.  Before selecting a spare, we need to insure
     that the spare is not in the deftable itself.
}

	  tempptr:=1;
	  spptr := minspare;

	  if debugflag then
	      begin
	      write(unitid,'There are ',defptr:0);
	      writeln(unitid,' defective tracks on head ',head:0);
	      end;

	  while tempptr<=defptr do
	       begin
	       if deftable[tempptr]<minspare then
		    begin {no need to spare defective spares}
		    search(spptr,found);
		    if not found then
			 begin
			 trackA:=deftable[tempptr];
			 trackB:=spptr;
   if debugflag then begin
	write(unitid,'sparing track ',trackA:0);
	writeln(unitid,' with track ',trackB:0);
	end;
			 format(hpibaddr,discunit,head,selectcode,
				trackB,sectorspertrack,spdcontrol,
				bufptr,trackA,intfld);
			 status[1]:=status[1] mod 32;
			 if status[1]<>0 then begin
			      errorhandle;
			      goto 1;
			      end;
			 tempptr:=tempptr+1;
			 end;
		    spptr:=spptr+1;
		    if spptr>maxspare then
			 begin
			 writeln('Too many defective tracks');
			 goto 1;
			 end;

		    end

	       else tempptr:=tempptr+1;
	       end; {while}

	  end; {for loop}

     end; {with errortype}

1 : if debugflag then
	  begin
	  writeln(unitid,'end of program');
	  close(unitid,'lock');
	  end;

isrunlink(6, addr(initisrib));

end; {Xminitialize}

end {Xminit}




@


56.2
log
@
pws2rcs automatic delta on Wed Jan 27 11:57:27 MST 1993
@
text
@d1 553
@


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 553
$page$

{*******************************************************************************}


{program initialize(input,output);}


  {   Last Updated September 30, 1981  }

{
   This program formats the disc media.  It scans
  the media one surface at a time looking for
  defective, spare and possibly defective
  tracks.  Each surface is scanned twice.  First
  it builds two tables for the surface it is
  scanning.  One table contains all tracks
  previously marked defective.  The other
  contains all tracks that yield CRC-Data Errors
  when verified.  The elements of the possibly-
  defective table are then pattern-tested
  20 times each.  If one fails any of the 20
  tests it is determined defective and put
  into the Defective table.  If it passes it is
  assumed good.  Now elements of the defective
  table are spared.  The program then repeats
  this entire process for each surface.
}

{*******************************************************************************}

module asmr;

import sysglobals;

export

   type
     statrec =  packed record case integer of
	  0 : (status : packed array[1..4] of byte);
	  1 : (intfld : integer)
	  end; {record}
     buffer = packed array[1..16384] of byte;
     bptr = ^buffer;

     procedure verify(busaddr,iounit,headnum : shortint;
		      phiport,sectors : integer;
		      var tracknum,errtype : integer);

     procedure format(busaddr,iounit,headnum : shortint;
		      phiport,track2,sectors : integer;
		      spdword : shortint; madr : bptr;
		      var track1, errtype : integer);

implement {asmr}

  procedure verify(busaddr,iounit,headnum : shortint;
		   phiport,sectors : integer;
		   var tracknum,errtype : integer); external ;

  procedure format(busaddr,iounit,headnum : shortint;
		   phiport,track2,sectors : integer;
		   spdword : shortint; madr : bptr;
		   var track1, errtype : integer); external ;

end; {asmr}

{*******************************************************************************}

module Xminit;  {jpc}

import
  sysglobals,
  initunits,
  isr;

export
  procedure Xminitialize(drivetype: char;
			    selectcode: integer;
			    hpibaddr: shortint;
			    discunit: shortint);  {jpc}

implement {Xminit}

import
  asmr,
  midecs;

var
  initisrib : isrib;

procedure Xminitialize;  {jpc}

label 1;

const maxtimes=2; {times to verify each surface}

var
     spdcontrol : shortint;

     bufptr : bptr; {address of data area}

{***********************************************}

{ Parameters supplied by user or calling program}

{    hpibaddr,discunit : shortint;
     selectcode : integer; drivetype : char;  }
     debugflag : boolean;
     filename : string80;{if debugflag true}

{***********************************************}

     debuginput : char;
     status : statrec;
     unitid : text;

     minspare, maxspare, minhead, maxhead, sectorspertrack : integer;
     trackA, trackB : integer;
     oldtracknumber, head, sectorcount, tracknumber : integer;
     errortype : statrec;
     baddrivetype : boolean;

     deftable,sptable : array[1..15] of integer;
     pdtable : array[1..815] of integer;
     times,i,defptr,spptr,pdptr,tempptr,numberofspares : integer;
     inpdtable,found : boolean;


{*************************************************************************}


procedure errorhandle;
{
     This procedure will interpret the disc status or escape code
and return the appropriate ioresult
}
begin
with errortype do
     begin
     writeln('INITIALIZE ERROR, disc status = ',
		     intfld:0);

     if status[1]=19 then
	  begin
	  writeln('Disc is Write Protected or FORMAT switch is off');
	  writeln('Please turn FORMAT switch on and WRITE PROTECT off');
	  end;
     end;{with}
end; {procedure errorhandle}

{*********************************************************************}

procedure search( sparetrack:integer; var indeftable : boolean);
{
     This procedure searches the defective track table for the
     sparetrack.  If found then it sets indeftable true
}
var j:integer;
begin
indeftable:=false;
for j:=1 to defptr do
     if sparetrack=deftable[j] then indeftable:=true;
end; {procedure search}

{*********************************************************************}

procedure patterngenerate(k : integer);

{ This procedure generates the worst case test patterns for 7906, 7920
  and 7925 platters.  The bit pattern is repeating '101101101101101101...'
  sent over the entire track.  This pattern is then shifted left one bit
  and repeated.  It is then shifted on more time to complete the cycle'
}

var rotate : integer; {indicates which bit shift we are on}
    testbyte : packed array[1..3] of byte;  {these are the three
		   repeating bytes of the test pattern}
    j : integer;

begin
rotate := k mod 3;
case rotate of
     0 : begin
	 testbyte[1]:=109; testbyte[2]:=219; testbyte[3]:=182;
	 end;
     1 : begin
	 testbyte[1]:=219; testbyte[2]:=182; testbyte[3]:=109;
	 end;
     2 : begin
	 testbyte[1]:=182; testbyte[2]:=109; testbyte[3]:=219;
	 end;
     end; {case}

for j:=1 to 16384 do {enough to fill up 7925 track}
     bufptr^[j] := testbyte[(j-1) mod 3 + 1];

end; {procedure patterngenerate}

{*******************************************************}

begin {Xminitialize}

{***********************************************}
{
 These questions are not necessary if INITIALIZE
 is a called procedure

write('HP-IB address of disc controller = ');readln(hpibaddr);
write('Unit number of drive = ');readln(discunit);
write('Drive type (C, D, P, X) ');
readln(drivetype);
write('Select code of 98625A disc interface ');readln(selectcode);
write('Debug on (y/n)? ');read(debuginput);
writeln;
if debuginput='y' then debugflag:=true else
}

     debugflag := extended_features_mode;

{***********************************************}

if debugflag then
     begin
     write('Output device = ');
     readln(filename);
     rewrite(unitid,filename);
     end;

selectcode:=selectcode*65536;
selectcode:=selectcode+6291456;

{link in new ISR}

isrlink(noisr,charptr(selectcode+3),192,192,6,addr(initisrib));

{ now set up parameters }

sectorspertrack := 48;
minhead:=0; maxspare:=814; minspare:=800;
case drivetype of
     'c','C' : begin
	   maxspare:=409; minspare:=400; maxhead:=1
	   end;
     'd','D' : begin
	   maxspare:=409; minspare:=400; maxhead:=3; minhead:=2
	   end;
     'p','P' : maxhead:=4;
     'x','X' : begin
	   maxhead:=8; sectorspertrack:=64
	   end;
     otherwise begin
	   writeln('INITIALIZE ERROR - Illegal Drivetype');
	   goto 1
	   end
     end; { case }

numberofspares := maxspare-minspare+1;
new(bufptr);

if debugflag then writeln(unitid,'INITIALIZE debug');

{ First part of INITIALIZE.  It scans the disc
  and builds the defective table and the
  possibly-defective table.
}

with errortype do
     begin

     for head := minhead to maxhead do

	  begin
	  if debugflag then
	       begin
	       writeln(unitid);
	       writeln(unitid,'head = ',head:0);
	       end;

	  pdptr:=0; defptr:=0;

	  for times := 1 to maxtimes do
	       begin
	       if debugflag then writeln(unitid,'times = ',times:0);
	       sectorcount:=sectorspertrack*(maxspare+1);
	       tracknumber:=0;
	       intfld:=0;

	       while sectorcount>0 do

		    begin

		    {setup parameters}

		    if debugflag then
			 writeln(unitid,'starting scan at track ',tracknumber:0);

		    oldtracknumber:=tracknumber;

		    verify(hpibaddr,discunit,
			 head,selectcode,sectorcount,
			 tracknumber,intfld);

		    { now check to see if drive type is correct }

		    baddrivetype:=false;

		    case (status[3] mod 128) div 2 of
		    0 : if (drivetype<>'C') and (drivetype<>'c')
			and (drivetype<>'D') and (drivetype<>'d') then
			    baddrivetype:=true;
		    1 : if (drivetype<>'P') and (drivetype<>'p') then
			    baddrivetype:=true;
		    3 : if (drivetype<>'X') and (drivetype<>'x') then
			    baddrivetype:=true;
		    otherwise baddrivetype:=true;
		    end; {case}
		    if baddrivetype then
			 begin
			 writeln('INITIALIZE ERROR -Illegal drivetype');
			 goto 1;
			 end;


		    {now strip off spd bits}
		    status[1] := status[1] mod 32;

		    if (status[1]<>0) or (status[3] div 128 <>0) then
			 begin
			 if debugflag then
			      begin
			      write(unitid,'tracknumber = ',tracknumber:0);
			      writeln(unitid,'  status[1] = ',status[1]:0);
			      end;

			 case status[1] of
			      16 : begin
				   if debugflag then
				      writeln(unitid,'S-bit set on track ',tracknumber:0);
				    {now format tracknumber with s=0}
				   spdcontrol:=0;
				   trackA:=tracknumber;
				   format(hpibaddr,discunit,head,selectcode,
					  tracknumber,sectorspertrack,
					  spdcontrol,bufptr,trackA,intfld);
				   status[1]:=status[1] mod 32;
				   if status[1]<>0 then
					begin
					errorhandle;
					goto 1
					end;
				   end;

			      17 : begin
				   if times=1 then {all defective tracks found the first time}
					begin
					if debugflag then
					   writeln(unitid,'D-bit set on track ',tracknumber:0);
					defptr:=defptr+1;
					if defptr>numberofspares then
					     begin
					       writeln('Too many defective tracks');
					     goto 1;
					     end
					else begin
					     deftable[defptr] := tracknumber;
					     tracknumber:=tracknumber+1;
					     end;
					end

				    else tracknumber:=tracknumber+1;
				    end;

			    8,15  : begin
				    if debugflag then
				    writeln(unitid,
				      'CRC error - possibly defective track # ',tracknumber:0);
				    inpdtable:=false;
				    {
				     now search pdtable to see if the track
					has already been found.
				    }
				    for i:=1 to pdptr do
					 if tracknumber=pdtable[i] then inpdtable:=true;
				    if not inpdtable then
					 begin
					 pdptr:=pdptr+1;
					 pdtable[pdptr]:=tracknumber;
					 end;
				    tracknumber:=tracknumber+1;
				    end;
			  otherwise begin
				    if debugflag then
					 begin
					 writeln(unitid,'fatal error');
					 writeln(unitid,'status = ',intfld:0);
					 end;
				    errorhandle;
				    goto 1;
				    end;
				end; {case}
			 sectorcount:=sectorcount-((tracknumber-
			 oldtracknumber)*sectorspertrack);
			 end
		    else sectorcount:=0;

		    end; {while loop}

	       end;{for times loop}

	  if debugflag then
	       begin
	       write(unitid,'There are ',pdptr:0);
	       writeln(unitid,' possibly defective tracks on head ',head:0);
	       end;

	  tempptr:=1; intfld:=0;
	  while tempptr<=pdptr do
	       begin
	       spdcontrol:=0;
		    trackA:=pdtable[tempptr];
			 trackB:=trackA;
		    i:=0; {initialize test count}
		    if debugflag then
			 writeln(unitid,'pattern testing track ',trackA:0);

	       while (i<20) and (status[1]=0) do
		    begin

		    {first format with pattern}

		    patterngenerate(i);

		    if debugflag then
		    writeln(unitid,'calling format, i= ',i:0);

		    format(hpibaddr,discunit,head,selectcode,
			   trackB,sectorspertrack,spdcontrol,
			   bufptr,trackA,intfld);

		    status[1]:=status[1] mod 32;
		    if status[1]<>0 then
			 begin
			 errorhandle;
			 goto 1;
			 end;
		    {now verify that track}
		    verify(hpibaddr,discunit,head,selectcode,
			   sectorspertrack,trackA,intfld);
		    status[1]:=status[1] mod 32;
		    i:=i+1;

		    end; {while}

	       if status[1]=8 then
		    begin
		    spdcontrol:=1; {set D-bit}
		    if debugflag then
			 writeln(unitid,'Proven defective - track ',
			 pdtable[tempptr]:0);
		    { add to defective-track table }
		    defptr:=defptr+1;
		    if defptr>numberofspares then
			 begin
			 if debugflag then
			  writeln(unitid, 'Too many defective tracks.');
			 writeln('Too many defective tracks');goto 1;
			 end;
		    deftable[defptr]:=pdtable[tempptr];
		    if debugflag then
		       writeln(unitid,'Setting D-bit on track ',pdtable[tempptr]:0);
		    format(hpibaddr,discunit,head,selectcode,
			   trackB,sectorspertrack,spdcontrol,
			   bufptr,trackA,intfld);
		    status[1]:=status[1] mod 32;
		    if status[1]<>0 then
			 begin
			 errorhandle;
			 goto 1;
			 end;
		    end;
	       tempptr:=tempptr+1;
	       end; {while}

{
     Now there are defptr entries in the defective-track table.  These
     should each be spared.  Before selecting a spare, we need to insure
     that the spare is not in the deftable itself.
}

	  tempptr:=1;
	  spptr := minspare;

	  if debugflag then
	      begin
	      write(unitid,'There are ',defptr:0);
	      writeln(unitid,' defective tracks on head ',head:0);
	      end;

	  while tempptr<=defptr do
	       begin
	       if deftable[tempptr]<minspare then
		    begin {no need to spare defective spares}
		    search(spptr,found);
		    if not found then
			 begin
			 trackA:=deftable[tempptr];
			 trackB:=spptr;
   if debugflag then begin
	write(unitid,'sparing track ',trackA:0);
	writeln(unitid,' with track ',trackB:0);
	end;
			 format(hpibaddr,discunit,head,selectcode,
				trackB,sectorspertrack,spdcontrol,
				bufptr,trackA,intfld);
			 status[1]:=status[1] mod 32;
			 if status[1]<>0 then begin
			      errorhandle;
			      goto 1;
			      end;
			 tempptr:=tempptr+1;
			 end;
		    spptr:=spptr+1;
		    if spptr>maxspare then
			 begin
			 writeln('Too many defective tracks');
			 goto 1;
			 end;

		    end

	       else tempptr:=tempptr+1;
	       end; {while}

	  end; {for loop}

     end; {with errortype}

1 : if debugflag then
	  begin
	  writeln(unitid,'end of program');
	  close(unitid,'lock');
	  end;

isrunlink(6, addr(initisrib));

end; {Xminitialize}

end {Xminit}




@


55.1
log
@Automatic bump of revision number for PWS version 3.25A
@
text
@@


54.1
log
@Automatic bump of revision number for PWS version 3.24
@
text
@@


53.1
log
@Automatic bump of revision number for PWS version 3.24B
@
text
@@


52.1
log
@Automatic bump of revision number for PWS version 3.24A
@
text
@@


51.1
log
@Automatic bump of revision number for PWS version 3.24d
@
text
@@


50.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


49.1
log
@Automatic bump of revision number for PWS version 3.24b
@
text
@@


48.1
log
@Automatic bump of revision number for PWS version 3.24a
@
text
@@


47.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


46.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@@


45.1
log
@Automatic bump of revision number for PWS version 3.23C
@
text
@@


44.1
log
@Automatic bump of revision number for PWS version 3.23B
@
text
@@


43.1
log
@Automatic bump of revision number for PWS version 3.23aA
@
text
@@


42.1
log
@Automatic bump of revision number for PWS version 3.23e
@
text
@@


41.1
log
@Automatic bump of revision number for PWS version 3.23d
@
text
@@


40.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@@


39.1
log
@Automatic bump of revision number for PWS version 3.23b
@
text
@@


38.1
log
@Automatic bump of revision number for PWS version 3.23a
@
text
@@


37.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


36.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


35.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


34.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@@


33.1
log
@Automatic bump of revision number for PWS version 3.22D
@
text
@@


32.1
log
@Automatic bump of revision number for PWS version 3.22C
@
text
@@


31.1
log
@Automatic bump of revision number for PWS version 3.22B
@
text
@@


30.1
log
@Automatic bump of revision number for PWS version 3.22A
@
text
@@


29.1
log
@Automatic bump of revision number for PWS version 3.22b
@
text
@@


28.1
log
@Automatic bump of revision number for PWS version 3.3b
@
text
@@


27.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@@


26.1
log
@Automatic bump of revision number for PWS version 3.3 Synch
@
text
@@


25.1
log
@Automatic bump of revision number for PWS version 3.2Y
@
text
@@


24.1
log
@Automatic bump of revision number for PWS version 3.2
@
text
@@


23.1
log
@Automatic bump of revision number for PWS version 3.2P
@
text
@@


22.1
log
@Automatic bump of revision number for PWS version 3.2N
@
text
@@


21.1
log
@Automatic bump of revision number for PWS version 3.2M
@
text
@@


20.1
log
@Automatic bump of revision number for PWS version 3.2L
@
text
@@


19.1
log
@Automatic bump of revision number for PWS version 3.2K
@
text
@@


18.1
log
@Automatic bump of revision number for PWS version 3.2J
@
text
@@


17.1
log
@Automatic bump of revision number for PWS version 3.2I+
@
text
@@


16.1
log
@Automatic bump of revision number for PWS version 3.2I
@
text
@@


15.1
log
@Automatic bump of revision number for PWS version 3.2H
@
text
@@


14.1
log
@Automatic bump of revision number for PWS version 3.2G
@
text
@@


13.1
log
@Automatic bump of revision number for PWS version 3.2F
@
text
@@


12.1
log
@Automatic bump of revision number for PWS version 3.2E
@
text
@@


11.1
log
@Automatic bump of revision number for PWS version 3.2D
@
text
@@


10.1
log
@Automatic bump of revision number for PWS version 3.2C
@
text
@@


9.1
log
@Automatic bump of revision number for PWS version 3.2B
@
text
@@


8.1
log
@Automatic bump of revision number for PWS version 3.2A
@
text
@@


7.1
log
@Automatic bump of revision number for PWS version 3.2l
@
text
@@


6.1
log
@Automatic bump of revision number for PWS version 3.2k
@
text
@@


5.1
log
@Automatic bump of revision number for PWS version 3.2j
@
text
@@


4.1
log
@Automatic bump of revision number for PWS version 3.2i
@
text
@@


3.1
log
@Auto bump revision for PAWS 3.2h
@
text
@@


2.1
log
@Auto bump rev number to 2.1 for sys 3.2e.
@
text
@@


1.1
log
@Initial revision
@
text
@@
