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


56.1
date     91.11.05.09.37.58;  author jwh;  state Exp;
branches ;
next     55.2;

55.2
date     91.11.04.16.18.38;  author jwh;  state Exp;
branches ;
next     55.1;

55.1
date     91.08.25.10.16.37;  author jwh;  state Exp;
branches ;
next     54.2;

54.2
date     91.08.21.14.16.57;  author jwh;  state Exp;
branches ;
next     54.1;

54.1
date     91.03.18.15.22.48;  author jwh;  state Exp;
branches ;
next     53.3;

53.3
date     91.03.18.14.05.25;  author jwh;  state Exp;
branches ;
next     53.2;

53.2
date     91.03.15.15.53.15;  author jwh;  state Exp;
branches ;
next     53.1;

53.1
date     91.03.11.19.24.04;  author jwh;  state Exp;
branches ;
next     52.2;

52.2
date     91.03.11.17.21.27;  author jwh;  state Exp;
branches ;
next     52.1;

52.1
date     91.02.19.09.07.44;  author jwh;  state Exp;
branches ;
next     51.2;

51.2
date     91.02.18.21.17.25;  author jwh;  state Exp;
branches ;
next     51.1;

51.1
date     91.01.30.16.06.55;  author jwh;  state Exp;
branches ;
next     50.2;

50.2
date     91.01.30.09.54.16;  author jwh;  state Exp;
branches ;
next     50.1;

50.1
date     90.10.29.16.22.18;  author jwh;  state Exp;
branches ;
next     49.2;

49.2
date     90.10.29.14.42.16;  author jwh;  state Exp;
branches ;
next     49.1;

49.1
date     90.08.14.14.06.36;  author jwh;  state Exp;
branches ;
next     48.2;

48.2
date     90.08.14.10.06.51;  author jwh;  state Exp;
branches ;
next     48.1;

48.1
date     90.07.26.11.12.23;  author jwh;  state Exp;
branches ;
next     47.2;

47.2
date     90.07.24.15.28.36;  author jwh;  state Exp;
branches ;
next     47.1;

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

46.1
date     90.05.07.08.39.31;  author jwh;  state Exp;
branches ;
next     45.3;

45.3
date     90.05.04.15.22.36;  author jwh;  state Exp;
branches ;
next     45.2;

45.2
date     90.04.27.17.31.59;  author dew;  state Exp;
branches ;
next     45.1;

45.1
date     90.04.19.15.46.54;  author jwh;  state Exp;
branches ;
next     44.2;

44.2
date     90.04.19.13.52.02;  author jwh;  state Exp;
branches ;
next     44.1;

44.1
date     90.04.01.22.04.46;  author jwh;  state Exp;
branches ;
next     43.2;

43.2
date     90.04.01.16.51.03;  author jwh;  state Exp;
branches ;
next     43.1;

43.1
date     90.03.20.13.55.01;  author jwh;  state Exp;
branches ;
next     42.2;

42.2
date     90.03.19.16.39.34;  author jwh;  state Exp;
branches ;
next     42.1;

42.1
date     90.01.23.17.40.13;  author jwh;  state Exp;
branches ;
next     41.2;

41.2
date     90.01.20.17.15.55;  author jwh;  state Exp;
branches ;
next     41.1;

41.1
date     89.12.22.11.22.40;  author jwh;  state Exp;
branches ;
next     40.2;

40.2
date     89.12.21.15.37.35;  author jwh;  state Exp;
branches ;
next     40.1;

40.1
date     89.09.29.11.45.13;  author jwh;  state Exp;
branches ;
next     39.2;

39.2
date     89.09.28.17.53.25;  author jwh;  state Exp;
branches ;
next     39.1;

39.1
date     89.09.26.16.30.14;  author dew;  state Exp;
branches ;
next     38.2;

38.2
date     89.09.26.15.12.36;  author dew;  state Exp;
branches ;
next     38.1;

38.1
date     89.08.29.11.21.14;  author jwh;  state Exp;
branches ;
next     37.2;

37.2
date     89.08.23.10.32.52;  author dew;  state Exp;
branches ;
next     37.1;

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

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

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

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

33.1
date     89.01.16.11.35.15;  author dew;  state Exp;
branches ;
next     32.2;

32.2
date     89.01.10.12.20.05;  author bayes;  state Exp;
branches ;
next     32.1;

32.1
date     89.01.10.11.42.06;  author bayes;  state Exp;
branches ;
next     31.3;

31.3
date     89.01.09.12.41.28;  author dew;  state Exp;
branches ;
next     31.2;

31.2
date     88.12.16.16.16.43;  author dew;  state Exp;
branches ;
next     31.1;

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

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

29.1
date     88.10.31.15.25.23;  author bayes;  state Exp;
branches ;
next     28.3;

28.3
date     88.10.31.11.21.13;  author bayes;  state Exp;
branches ;
next     28.2;

28.2
date     88.10.21.15.16.22;  author bayes;  state Exp;
branches ;
next     28.1;

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

27.1
date     88.09.29.11.22.07;  author bayes;  state Exp;
branches ;
next     26.3;

26.3
date     88.09.28.12.57.12;  author bayes;  state Exp;
branches ;
next     26.2;

26.2
date     88.09.28.12.56.52;  author bayes;  state Exp;
branches ;
next     26.1;

26.1
date     88.09.28.12.56.33;  author bayes;  state Exp;
branches ;
next     24.1;

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

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

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

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

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

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

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

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

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

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

14.1
date     87.04.01.15.04.09;  author jws;  state Exp;
branches ;
next     13.3;

13.3
date     87.03.30.16.27.47;  author bayes;  state Exp;
branches ;
next     13.2;

13.2
date     87.03.30.16.21.28;  author bayes;  state Exp;
branches ;
next     13.1;

13.1
date     87.02.28.18.19.41;  author jws;  state Exp;
branches ;
next     12.2;

12.2
date     87.02.18.10.47.21;  author bayes;  state Exp;
branches ;
next     12.1;

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

11.1
date     87.01.19.09.34.28;  author jws;  state Exp;
branches ;
next     10.5;

10.5
date     87.01.16.12.02.49;  author bayes;  state Exp;
branches ;
next     10.4;

10.4
date     87.01.13.13.51.05;  author bayes;  state Exp;
branches ;
next     10.3;

10.3
date     87.01.12.15.03.53;  author bayes;  state Exp;
branches ;
next     10.2;

10.2
date     86.12.29.13.19.23;  author root;  state Exp;
branches ;
next     10.1;

10.1
date     86.12.24.10.42.01;  author jws;  state Exp;
branches ;
next     9.3;

9.3
date     86.12.22.09.22.46;  author root;  state Exp;
branches ;
next     9.2;

9.2
date     86.12.16.09.00.10;  author bayes;  state Exp;
branches ;
next     9.1;

9.1
date     86.12.12.14.15.27;  author bayes;  state Exp;
branches ;
next     8.3;

8.3
date     86.12.12.10.42.28;  author bayes;  state Exp;
branches ;
next     8.2;

8.2
date     86.12.10.08.51.47;  author root;  state Exp;
branches ;
next     8.1;

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

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

6.1
date     86.11.04.17.33.18;  author paws;  state Exp;
branches ;
next     5.3;

5.3
date     86.10.30.15.47.41;  author danm;  state Exp;
branches ;
next     5.2;

5.2
date     86.10.30.14.51.24;  author danm;  state Exp;
branches ;
next     5.1;

5.1
date     86.10.28.16.21.12;  author hal;  state Exp;
branches ;
next     4.3;

4.3
date     86.10.21.13.40.19;  author danm;  state Exp;
branches ;
next     4.2;

4.2
date     86.10.09.11.29.00;  author danm;  state Exp;
branches ;
next     4.1;

4.1
date     86.09.30.19.30.38;  author hal;  state Exp;
branches ;
next     1.16;

1.16
date     86.09.29.10.12.18;  author geli;  state Exp;
branches ;
next     1.15;

1.15
date     86.09.26.17.25.21;  author danm;  state Exp;
branches ;
next     1.14;

1.14
date     86.09.24.15.53.04;  author danm;  state Exp;
branches ;
next     1.13;

1.13
date     86.09.18.16.10.52;  author danm;  state Exp;
branches ;
next     1.12;

1.12
date     86.09.18.10.32.32;  author danm;  state Exp;
branches ;
next     1.11;

1.11
date     86.09.17.17.45.46;  author danm;  state Exp;
branches ;
next     1.10;

1.10
date     86.09.15.16.44.28;  author danm;  state Exp;
branches ;
next     1.9;

1.9
date     86.09.15.15.58.33;  author danm;  state Exp;
branches ;
next     1.8;

1.8
date     86.09.15.15.29.37;  author danm;  state Exp;
branches ;
next     1.7;

1.7
date     86.09.05.17.36.22;  author danm;  state Exp;
branches ;
next     1.6;

1.6
date     86.09.04.19.58.10;  author danm;  state Exp;
branches ;
next     1.5;

1.5
date     86.09.03.15.53.20;  author danm;  state Exp;
branches ;
next     1.4;

1.4
date     86.09.03.14.48.16;  author danm;  state Exp;
branches ;
next     1.3;

1.3
date     86.09.02.18.42.16;  author danm;  state Exp;
branches ;
next     1.2;

1.2
date     86.09.01.14.47.44;  author danm;  state Exp;
branches ;
next     1.1;

1.1
date     86.08.25.19.57.45;  author danm;  state Exp;
branches ;
next     ;


desc
@after first successfule compile
@


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@$modcal$
$allow_packed on$
$partial_eval on$
{{
$debug on$
{}
$debug off$
$range off$
$ovflcheck off$
$stackcheck off$
{}


program osinstall(keyboard, input, output);

{}
$search 'PROGS:MATCHSTR', 'HPROGS:BOOTLIF'$
{{
$search 'MATCHSTR', 'BOOTLIF'$
{}


import BOOTLIF, sysglobals, misc, fs, ci, matchstr;

const
	version         = '  [3.25]';
	copyright_line1 = '  Copyright 1986, 1991 Hewlett-Packard Company';
	copyright_line2 = '       All rights are reserved.';

	cmd_prompt = 'OSINSTALL: Check Install Order Remove Zero Quit? ' ;
	confirm = 'Are you SURE you want to proceed? (Y/N) ';
	esc_char = chr(27);

type
	prompttype = string80;


var
	keyboard:text;
	prompt_main:prompttype;
	cmd_done:boolean;
	action_os:char;



procedure goodio;
begin
  if ioresult <> ord (inoerror) then
      escape(0);
end;    { procedure goodio }

procedure badio (iocode : iorsltwd);
begin
  ioresult := ord (iocode);
  escape(0);
end;


procedure upcchar(var ch : char);
begin
  if ('a'<=ch) and (ch<='z') then
      ch := chr(ord(ch)-32);
end;    { procedure upcchar }


procedure badcommand(c:char);
begin
  writeln('bad command ''',c,'''');
  if streaming then escape(-1) else badio(inoerror);
end;    { badcommand }

procedure printioerrmsg;
var
  msg   : string[80];
begin
  if ioresult <> ord(inoerror) then
      begin
	getioerrmsg (msg,ioresult);
	writeln ('Error: ',msg,cteol);
      end;
end;    { procedure printioerrmsg }


procedure readcheck;
var
  saveio : integer;
begin
  if ioresult <> ord (inoerror) then
    begin
      saveio := ioresult;
      writeln;
      ioresult := saveio;
      escape(0);
    end;
end;    { procedure readcheck }

procedure promptforchar ( pl : prompttype;
			var ch : char);
begin
  write (homechar,pl,cteol);
  read (keyboard,ch);
  readcheck;
  if ch = esc_char then
      ch := ' ';

  if ch=' ' then
      write(clearscr)
  else
    begin
      write (homechar,cteol);
      upcchar (ch);
    end;
end;    { procedure promptforchar }

procedure promptread(p:prompttype; var answer:char; list:prompttype;
		   default:char);
var
  s1   : string[1];
  done : boolean;
begin
  if (default<>esc_char) and streaming then
    answer:=default
  else
    begin
      setstrlen(s1,1);
      write(p,cteol);
      repeat
	read(keyboard,answer); readcheck; upcchar(answer);
	if answer=esc_char then
	  begin
	    writeln;
	    badio(inoerror);
	  end;
	s1[1] := answer;
	done  := breakstr(s1,1,list)>0;
	if not done and streaming then
	  badcommand(answer);
      until done;
      writeln(answer);
    end;
end;    { promptread }

procedure promptyorn(p : prompttype; var answer :char);
begin
  promptread(p+' ? (Y/N) ',answer,'YN','Y');
end;    { promptyorn }

procedure get_user_input ( prompt : prompttype ;
			 var answer : string80 ) ;
begin
  setstrlen (answer, 0);
  writeln;
  write (prompt);
  readln (answer);
  goodio;
  zapspaces (answer);
end ;  { procedure get_user_input }

procedure put_copyright;
begin
  writeln ( clearscr ) ;
  fgotoxy(output, 0,3);
  writeln(version);
  writeln(copyright_line1);
  writeln(copyright_line2);
end;

function filename_ok ( ltitle : fid ) : boolean ;
begin
  filename_ok := true ;
  { must be 10 or less characters long }
  if (strlen ( ltitle ) > 10) or (strlen ( ltitle ) = 0) then
    filename_ok := false;

  if strpos('/', ltitle) <> 0 then
    filename_ok := false;
end ;    { function filename_ok }

procedure check;
const
  prompt1 = 'Volume:file to check (in boot area) ? ';
var
  answer : string80;
  newfid : fid;
  prompt : prompttype;
  volid : vid;
  ltitle : fid;
  lkind : filekind;
  unitnum : integer;
  segs : integer;
  current : integer;
  done : boolean;
  lname:lifname;
  check_result:checkentrytype;
  file_found:boolean;
begin
  try
  { get unit number from user }

  writeln (clearscr);
  prompt := prompt1;
  get_user_input ( prompt, answer );

  if strlen ( answer ) = 0 then
    escape(0)
  else
    begin
      zapspaces (answer);
      newfid:=answer;
    end;
  segs := 0;

  if not scantitle ( newfid, volid, ltitle, segs, lkind ) then
    if ( strlen ( volid ) = 0 ) then
      badio ( ibadunit );
  unitnum := findvolume (volid, true);
  if unitnum = 0 then
    badio ( inounit);
  strappend ( volid, ':' );

  while (strlen(ltitle) > 0) and (ltitle[1] = '/') do
   ltitle := str(ltitle, 2, strlen(ltitle)-1);

  if not openbootlif(unitnum) then escape(0);

  if strlen(ltitle) = 0 then
  begin
    current :=0;
    done := false;
  end
  else
  begin
    if not filename_ok ( ltitle ) then
      badio ( ibadtitle );
    current := getdirentry(ltitle);
    if current = -1 then
      badio(inofile);
    done := true;
  end;

  file_found := false;
  repeat
    if not checkdirentry(current, lname, check_result) then
	escape(0);
    case check_result of
      entry_bootable:
		begin
			file_found := true;
			writeln(lname, '  bootable');
		end;

      entry_not_bootable:
		begin
			file_found := true;
			writeln(lname, '  not bootable in '+volid+'/ (not a.out format)');
		end;

      entry_not_in_hfs:
		begin
			file_found := true;
			writeln(lname, '  not found in '+volid+'/');
		end;

      entry_no_entry:   done := true;
    end;

    current := current + 1;
    if current > 15 then
      done := true;
  until done ;

  if not file_found then
  begin
      writeln;
      writeln ('No entries in LIF boot directory.');
  end;

  if not closebootlif(savebootlif) then
	escape(0);

  recover
    begin
      printioerrmsg ;
      if escapecode <> 0 then
	  escape (escapecode);
    end;
end;

procedure install;
const
  prompt1 = 'Volume:file to install (from root directory on HFS) ? ';
var
  answer : string80;
  newfid : fid;
  prompt : prompttype;
  volid : vid;
  ltitle : fid;
  lkind : filekind;
  unitnum : integer;
  segs : integer;
  i : integer;
begin
  try
  { get unit number and file from user }

  writeln (clearscr);
  prompt := prompt1;
  get_user_input ( prompt, answer );

  if strlen ( answer ) = 0 then
      { not an error, but abort }
      escape(0)
  else
    begin
      zapspaces (answer);
      newfid:=answer;
    end;
  segs := 0;

  if not scantitle ( newfid, volid, ltitle, segs, lkind ) then
    badio ( ibadtitle );
  unitnum := findvolume (volid, true);
  if unitnum = 0 then
    badio ( ibadtitle);
  strappend ( volid, ':' );

  while (strlen(ltitle) > 0) and (ltitle[1] = '/') do
   ltitle := str(ltitle, 2, strlen(ltitle)-1);

  if not filename_ok ( ltitle ) then
    badio ( ibadtitle );

  if not openbootlif(unitnum) then escape(0);
  if not addbootfile(ltitle) then escape(0);
  if not closebootlif(savebootlif) then escape(0);


  writeln;
  writeln (volid,ltitle,' installed');

  recover
    begin
      printioerrmsg ;
      if escapecode <> 0 then
	escape (escapecode);
    end;
end;

procedure order;
const
  prompt1 = 'Volume:file to move to first position (in boot area) ? ';
var
  answer : string80;
  ans : char;
  newfid : fid;
  prompt : prompttype;
  volid : vid;
  ltitle : fid;
  lkind : filekind;
  unitnum : integer;
  segs : integer;
  i : integer;
begin
  try
  { get unit number and file from user }

  writeln (clearscr);
  prompt := prompt1;
  get_user_input ( prompt, answer );

  if strlen ( answer ) = 0 then
    { not an error, but abort }
    escape(0)
  else
    begin
      zapspaces (answer);
      newfid:=answer;
    end;
  segs := 0;

  if not scantitle ( newfid, volid, ltitle, segs, lkind ) then
    badio ( ibadtitle );

  unitnum := findvolume (volid, true);
  if unitnum = 0 then
    badio ( inounit );
  strappend ( volid, ':' );

  while (strlen(ltitle) > 0) and (ltitle[1] = '/') do
   ltitle := str(ltitle, 2, strlen(ltitle)-1);

  if not filename_ok ( ltitle ) then
    badio ( ibadtitle );

  if not openbootlif(unitnum) then escape(0);
  if not firstbootfile(ltitle) then escape(0);
  if not closebootlif(savebootlif) then escape(0);

  writeln;
  writeln (ltitle, ' now in first directory position.');

  recover
    begin
      printioerrmsg ;
      if escapecode <> 0 then
	escape (escapecode);
    end;
end ;  { procedure order }

procedure remove;
const
  prompt1 = 'Volume:file to remove (from boot area) ? ';
var
  answer : string80;
  ans : char;
  newfid : fid;
  prompt : prompttype;
  volid : vid;
  ltitle : fid;
  lkind : filekind;
  unitnum : integer;
  segs : integer;
  i : integer;
  override:boolean;
begin
  try
  { get unit number and file from user }

  writeln (clearscr);
  prompt := prompt1;
  get_user_input ( prompt, answer );

  if strlen ( answer ) = 0 then
    { not an error, but abort }
	escape(0)
  else
    begin
      zapspaces (answer);
      newfid:=answer;
    end;
  segs := 0;

  if not scantitle ( newfid, volid, ltitle, segs, lkind ) then
    begin
      badio ( ibadtitle );
    end ;
  unitnum := findvolume (volid, true);
  if unitnum = 0 then
    badio ( inounit);

  while (strlen(ltitle) > 0) and (ltitle[1] = '/') do
   ltitle := str(ltitle, 2, strlen(ltitle)-1);

  if not filename_ok ( ltitle ) then
    badio ( ibadtitle );

  if not openbootlif(unitnum) then escape(0);
  override := false;
  if not removebootfile(ltitle, override) then
  begin
	if override then
	begin
	   writeln;
	   writeln('This will remove last bootable file.');
	   promptread ( confirm, ans, 'YN', 'N' );
	   if ans <> 'Y' then
	      escape (0);
	   if not removebootfile(ltitle, override) then
	      escape(0);
	end
	else
	  escape(0);
  end;
  if not closebootlif(savebootlif) then escape(0);


  writeln;
  writeln (ltitle, ' removed from LIF boot directory.');

  recover
    begin
      printioerrmsg ;
      if escapecode <> 0 then
	escape (escapecode);
    end;
end ;  { procedure remove }

procedure zero;
const
  prompt1 = 'Volume (boot area) to zero ? ';
var
  answer : string80;
  ans : char;
  newfid : fid;
  prompt : prompttype;
  volid : vid;
  ltitle : fid;
  lkind : filekind;
  unitnum : integer;
  segs : integer;
  i : integer;
  inname : string255;
begin
  try
  { get unit number and file from user }

  writeln (clearscr);
  writeln (homechar);
  prompt := prompt1;
  get_user_input ( prompt, answer );

  if strlen ( answer ) = 0 then
    { not an error, but abort }
    escape(0)
  else
    begin
      zapspaces (answer);
      newfid:=answer;
    end;
  segs := 0;

  if not scantitle ( newfid, volid, ltitle, segs, lkind ) then
    badio ( ibadtitle );
  if strlen ( ltitle ) <> 0 then
    badio (ibadtitle);

  unitnum := findvolume (volid, true);
  if unitnum = 0 then
    badio ( ibadtitle);
  strappend ( volid, ':' );

  if not zerobootlif(unitnum) then escape(0);

  writeln;
  writeln ('Volume ',volid,' LIF boot directory zeroed.');

  recover
    begin
      printioerrmsg ;
      if escapecode <> 0 then
	escape (escapecode);
    end;
end ;  { procedure zero }

begin {osinstall}
  put_copyright;
  prompt_main := cmd_prompt;
  cmd_done := false;
  repeat
    promptforchar ( prompt_main, action_os );
    ioresult := 0;
    case action_os of
      'C' : check ;
      'I' : install ;
      'O' : order ;
      'R' : remove ;
      'Z' : zero ;
      'Q' : cmd_done := true;
      ' ' : put_copyright;
      Otherwise ;
    end;
  until cmd_done;
end.
@


55.2
log
@
pws2rcs automatic delta on Mon Nov  4 13:45:04 MST 1991
@
text
@@


55.1
log
@Automatic bump of revision number for PWS version 3.25A
@
text
@d26 1
a26 1
	version         = '  [3.25A]';
@


54.2
log
@
pws2rcs automatic delta on Wed Aug 21 13:42:03 MDT 1991
@
text
@@


54.1
log
@Automatic bump of revision number for PWS version 3.24
@
text
@d26 1
a26 1
	version         = '  [3.24]';
@


53.3
log
@
pws2rcs automatic delta on Mon Mar 18 13:19:08 MST 1991
@
text
@@


53.2
log
@Updated copyright message.
@
text
@d26 1
a26 1
	version         = '  [3.24B]';
@


53.1
log
@Automatic bump of revision number for PWS version 3.24B
@
text
@d27 1
a27 1
	copyright_line1 = '  Copyright 1986, 1990 Hewlett-Packard Company';
@


52.2
log
@
pws2rcs automatic delta on Mon Mar 11 16:41:32 MST 1991
@
text
@@


52.1
log
@Automatic bump of revision number for PWS version 3.24A
@
text
@d26 1
a26 1
	version         = '  [3.24A]';
@


51.2
log
@
pws2rcs automatic delta on Mon Feb 18 20:38:36 MST 1991
@
text
@@


51.1
log
@Automatic bump of revision number for PWS version 3.24d
@
text
@d26 1
a26 1
	version         = '  [3.24d]';
@


50.2
log
@
pws2rcs automatic delta on Wed Jan 30 09:08:19 MST 1991
@
text
@@


50.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@d26 1
a26 1
	version         = '  [3.24c]';
@


49.2
log
@
pws2rcs automatic delta on Mon Oct 29 14:00:44 MST 1990
@
text
@@


49.1
log
@Automatic bump of revision number for PWS version 3.24b
@
text
@d26 1
a26 1
	version         = '  [3.24b]';
@


48.2
log
@
pws2rcs automatic delta on Tue Aug 14 09:29:26 MDT 1990
@
text
@@


48.1
log
@Automatic bump of revision number for PWS version 3.24a
@
text
@d26 1
a26 1
	version         = '  [3.24a]';
@


47.2
log
@
pws2rcs automatic delta on Tue Jul 24 14:47:20 MDT 1990
@
text
@@


47.1
log
@Automatic bump of revision number for PWS version 3.23
@
text
@d26 1
a26 1
	version         = '  [3.23]';
@


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


45.3
log
@
pws2rcs automatic delta on Fri May  4 14:44:01 MDT 1990
@
text
@@


45.2
log
@Added 1990 copyright.
@
text
@d26 1
a26 1
	version         = '  [3.23C]';
@


45.1
log
@Automatic bump of revision number for PWS version 3.23C
@
text
@d27 1
a27 1
	copyright_line1 = '  Copyright 1986, 1989 Hewlett-Packard Company';
@


44.2
log
@
pws2rcs automatic delta on Thu Apr 19 13:13:04 MDT 1990
@
text
@@


44.1
log
@Automatic bump of revision number for PWS version 3.23B
@
text
@d26 1
a26 1
	version         = '  [3.23B]';
@


43.2
log
@
pws2rcs automatic delta on Sun Apr  1 16:13:30 MDT 1990
@
text
@@


43.1
log
@Automatic bump of revision number for PWS version 3.23aA
@
text
@d26 1
a26 1
	version         = '  [3.23A]';
@


42.2
log
@
pws2rcs automatic delta on Mon Mar 19 16:00:53 MST 1990
@
text
@@


42.1
log
@Automatic bump of revision number for PWS version 3.23e
@
text
@d26 1
a26 1
	version         = '  [3.23e]';
@


41.2
log
@
pws2rcs automatic delta on Sat Jan 20 16:32:46 MST 1990
@
text
@@


41.1
log
@Automatic bump of revision number for PWS version 3.23d
@
text
@d26 1
a26 1
	version         = '  [3.23d]';
@


40.2
log
@
pws2rcs automatic delta on Thu Dec 21 14:54:59 MST 1989
@
text
@@


40.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@d26 1
a26 1
	version         = '  [3.23c]';
@


39.2
log
@
pws2rcs automatic delta on Thu Sep 28 17:16:32 MDT 1989
@
text
@@


39.1
log
@Automatic bump of revision number for PWS version 3.23b
@
text
@d26 1
a26 1
	version         = '  [3.23b]';
@


38.2
log
@
pws2rcs automatic delta on Tue Sep 26 14:31:31 MDT 1989
@
text
@@


38.1
log
@Automatic bump of revision number for PWS version 3.23a
@
text
@d26 1
a26 1
	version         = '  [3.23a]';
@


37.2
log
@Major updates.
OSINSTALL disk interface routines were rewritten to fix critical defect
#FSDdt02202.  When mixing secondary loader routines, the disk is
no longer bootable.  Problem was the archtitecture of the original
disk interface routines.

All disk interface routines in a module/file BOOTLIF.

All human interface remains untouched, with the exception that a 
version # is added to the copyright statements.
@
text
@@


37.1
log
@Automatic bump of revision number for PWS version 3.3a
@
text
@d4 3
d10 2
a12 1
program osinstall (keyboard, input, output);
d14 2
d17 1
a17 1
$search 'PROGS:MATCHSTR'$   { real search }
d19 2
a20 1
$search 'MATCHSTR'$ { stand alone test search }
a21 6
import  sysglobals,
	sysdevs,        {SFB}
	misc,
	fs,
	ci,
	matchstr;
d23 2
d26 3
d30 3
a32 7
  {
     Update copyright datet to 1989.  This differentiates the
     3.22 version from pre 3.22 versions.  Required for programatic
     and debugger reboot.
  }
  copyright_line1 = '  Copyright 1986, 1989 Hewlett-Packard Company';
  copyright_line2 = '       All rights are reserved.';
a33 18
  cmd_prompt = 'OSINSTALL: Check Install Order Remove Quit Zero ?' ;
  confirm = 'Are you SURE you want to proceed? (Y/N) ';

  LIFmagic = -32768 {#1#2};
  entrysize = 32;
  esc_char = chr(27);
  wshdr_size = 512;

  nullstr = #0;
  bootable_eft = -5822;
  SECTORSIZE = 256;
  LIFDUMMY1 = 4096;
  LIF_END_HDR = -1;
  HPUX_BOOT = -5822;
  DIRSTART = 1;       { directory start, in sectors, 0-based }
  DIRBLKS = 2;        { how many dir sectors }
  LOADADDR = hex('FFFF0800');

d35 1
a36 8
  prompttype = string80;
  vname   = packed array[1..6] of char;
  lifname = packed array[1..10] of char;
  lifstring = string[120];      {SFB}
  bcd     = 0..15;
  word15  = 0..32767;
  tdate   = packed array[1..12] of bcd;
  strp = ^string255;
a37 119
  file_variety = (no_file, special_file, regular_file);

  bootability  = (not_found, not_bootable, bootable);

  fildesentry = packed record
		  f_ptr    : fibp;
		  fwindow  : windowp;
		end;

  lif_vol_header = packed record
		     lifid             : shortint;
		     lifvol_label      : vname;
		     lifdir_start_addr : integer;
		     lifoct_10000      : shortint;
		     lifdummy          : shortint;
		     lifdir_length     : integer;
		     lifversion        : shortint;
		     lifzero           : shortint;
		     liftps            : integer;       {SFB}
		     lifspm            : integer;       {SFB}
		     lifspt            : integer;       {SFB}
		     lifcdate          : tdate;         {SFB}
		     filler            : packed array[21..123] of shortint; {SFB}
		     lifsdate          : tdate;         {SFB}
		     lifdummy4         : shortint;      {SFB}
		   end ;

  lif_vol_header_ptr = ^lif_vol_header;

  lif_dir_entry = packed record
		    liffile_name     : lifname;
		    liffile_type     : shortint;
		    lifstart_address : integer;
		    liffile_length   : integer;
		    liftoc           : tdate;
		    lifl_flag        : boolean;
		    lifvol_number    : word15;
		    lifimplement     : integer;
		  end;

  lif_dir_entry_ptr = ^lif_dir_entry;

  dirstatus = (dneeded,dwanted,dontcare);

  closecode =(keepit, purgeit, closeit);

  control = record
	      cfib      : fib;
	      path      : integer;
	      diropen   : boolean;
	      fileopen  : boolean;
	      useunit   : boolean;
	      mounted   : boolean;
	      cpvol     : vid;
	      cvol      : vid;
	      cfile     : fid;
	      dstatus   : dirstatus;
	      badclose  : closecode;
	      goodclose : closecode;
	    end;

  a_dot_out_block = packed record
		      magic     : integer;
		      stamp     : shortint;
		      unused    : shortint;
		      sparehp   : integer;
		      txt       : integer;
		      data      : integer;
		      bss       : integer;
		      trsize    : integer;
		      drsize    : integer;
		      pasint    : integer;
		      lesyms    : integer;
		      dnttsize  : integer;
		      entry     : integer;
		      sltsize   : integer;
		      vtsize    : integer;
		      spare3    : integer;
		      spare4    : integer;
		    end;

  check_info = packed record
		 name    : lifstring;
		 problem : string80;
	       end;

const

  DIRPB = SECTORSIZE div sizeof(lif_dir_entry);    { dir entries per block }

  boot_a_dot_out = a_dot_out_block[
		     magic   : hex('020c0108'),
		     stamp   : 0,
		     unused  : 0,
		     sparehp : 0,
		     txt     : 0,
		     data    : 0,
		     bss     : 0,
		     trsize  : 0,
		     drsize  : 0,
		     pasint  : 0,
		     lesyms  : 0,
		     dnttsize: 0,
		     entry   : 0,
		     sltsize : 0,
		     vtsize  : 0,
		     spare3  : 0,
		     spare4  : 0  ];

  null_dir_entry = lif_dir_entry [
		   liffile_name     : '          ',
		   liffile_type     : -1,
		   lifstart_address : 0,        {SFB}
		   liffile_length   : 0,        {SFB}
		   liftoc           : tdate[0,0,0,0,0,0,0,0,0,0,0,0],
		   lifl_flag        : true,
		   lifvol_number    : 1,
		   lifimplement     : 0 {SFB}];

d39 4
a42 1
 keyboard : text;       {SFB}
a43 23
procedure do_osinstall; {SFB 3-30-87}
var
  boot_start['bootasm_start']:  integer;
  boot_size['bootasm_size']:    integer;
  boot_fstart['bootasm_fstart']:integer;        {SFB for 3.2D}
  cmd_done:                     boolean;
  action_os:                    char;
  file_info:                    control ;
  ininfo:                       control;
  in_boot_vol:                  lif_vol_header ;
  out_boot_vol:                 lif_vol_header ;
  in_boot_dir:                  array [0..15] of lif_dir_entry ;
  out_boot_dir:                 array [0..15] of lif_dir_entry ;
  in_lifname:                   array [0..15] of lifstring;
  out_lifname:                  array [0..15] of lifstring;
  filedes:                      fildesentry;
  option:                       string255;
  prompt_main:                  prompttype;
  good_list:                    array [0..15] of check_info;
  bad_list:                     array [0..15] of check_info;
  good_cur:                     integer;
  bad_cur:                      integer;
  tempfib:                      fibp;
a44 5
procedure upcchar(var ch : char);
begin
  if ('a'<=ch) and (ch<='z') then
      ch := chr(ord(ch)-32);
end;    { procedure upcchar }
d58 8
a82 13
procedure must_be_HFS(un: unitnum);
begin
  if h_unitable = NIL then
    begin
      writeln('HFS not installed.');
      escape(0);
    end;
  if not h_unitable^.tbl[un].is_hfsunit then
    begin
      writeln('#', un:1, ': is not an HFS unit.');
      escape(0);
    end;
end;
a83 88
procedure must_be_rootdir(un: unitnum);
begin
  if h_unitable^.tbl[un].prefix <> 2 then
    begin
      writeln('Unit must be prefixed to /.');
      escape(0);
    end;
end;

function setupfib(path: strp; tempfib: fibp): boolean;
var
  temp_fsegs : integer;
  fk : filekind;
begin
  with tempfib^ do
    begin
      setupfib := false;
      if scantitle( path^, fvid, ftitle, temp_fsegs, fk) then
	{valid filename}
	begin
	  funit := findvolume(fvid,TRUE);
	  if (funit <=  0) or (funit > maxunit) then
	      badio ( ibadunit )
	  else
	    begin
	      finitb(tempfib^,fwindow,1);
	      {initialize fib for open a file}
	      feft := 3 {LIF directory, actually the BOOT directory};
	      fkind := untypedfile;
	      for fk := untypedfile to lastfkind do
		if efttable^[fk] = feft then
		  fkind := fk;
	      fisnew := false;
	      option := '';
	      foptstring := addr(option);
	      fanonymous := false;
	      fmodified := false;
	      flocked := true;
	      freptcnt := 0;
	      fbufchanged := false;
	      flastpos := -1;
	      fstartaddress := 0;
	      pathid := -1;
	      fnosrmtemp := true;
	      if temp_fsegs > 0 then fpos := temp_fsegs*fblksize
				else fpos := temp_fsegs;
	      feof := false;
	      feoln := false;
	      freadmode := true;
	      setupfib := true;
	    end;
	end
      else {scantitle}
	badio ( ibadtitle );
    end; {with}
end; {setupfib}

procedure open_unit ( path: strp );
begin
  {get a fib}
  new(tempfib);
  tempfib^.flistptr := openfileptr;
  openfileptr := tempfib;
  if setupfib(path,tempfib) then
    with tempfib^ do
      begin
	if (ftitle = '') and (unitable^[funit].uisblkd = true) then { open
								      unit }
	  {ignore ioresults set by findvolume in setupfib,
	   except for znotready}
	  if ioresult <> ord(znotready) then
	    call(unitable^[funit].dam,tempfib^,funit,openunit);

	if ioresult <> 0 then
	  if ioresult = ord(znotready) then
	    badio ( znotready )
	  else badio ( ibadunit )
	else
	  begin
	    {successfully opened the unit, now update filedes}
	    freadable := true;
	    fwriteable := true;
	    filedes.f_ptr := tempfib;
	    filedes.fwindow := fwindow;
	  end;
    end;{with}
end; { procedure open_unit }

d159 1
a159 12
procedure make_a_dot_out ( inname : string255;
			 outname : string255 );
var
  infile      : file of char;
  outfile     : file of char;
  headerfile  : file of a_dot_out_block;
  c           : char;
  cp          : charptr;
  sizefile    : file of integer;
  a_out_block : a_dot_out_block;
  i           : shortint;
  pcoffset    : integer;
d161 5
a165 90
  a_out_block := boot_a_dot_out;
  try         {SFB}
    reset(sizefile, inname);
  recover begin
	    writeln;
	    writeln('Operation not allowed on this filetype');
	    escape(0);
	  end;

  if fibp ( addr ( sizefile ))^.fkind <> sysfile then
      begin
	writeln;
	writeln ('File ', inname, ' is neither a SYSTM nor an a.out file.');
	escape (0);
      end ;

  with a_out_block do
    begin
      read(sizefile, txt);        {dummy read}
      read(sizefile, txt);
      txt := txt - 8;            {remove first 8 bytes of boot format}
      read(sizefile, pcoffset);
      read(sizefile, pcoffset);
      read(sizefile, pcoffset);
      pcoffset := pcoffset + 8;
    end;
  close(sizefile);

  rewrite(outfile, outname, '\-5813\');

  cp := addr(a_out_block);
  for i := 1 to sizeof(a_out_block) do
    begin
      write(outfile, cp^);
      cp := addr(cp^, 1);
    end;

  reset(infile, inname);
  for i := 1 to 8 do
    read(infile, c);      {space past first 8 bytes of boot format}
  for i := 1 to 14 do
    read(infile, c);
  { lea *,a0 }
  write(outfile, chr(hex('41')));
  write(outfile, chr(hex('fa')));
  write(outfile, chr(hex('ff')));
  write(outfile, chr(hex('fe')));
  { lea pcoffset,a1 }
  write(outfile, chr(hex('43')));
  write(outfile, chr(hex('f9')));
  cp := addr(pcoffset);
  for i := 1 to sizeof(pcoffset) do
    begin
      write(outfile, cp^);
      cp := addr(cp^, 1);
    end;
  { adda.l a1, a0 }
  write(outfile, chr(hex('d1')));
  write(outfile, chr(hex('c9')));
  { jmp (a0) }
  write(outfile, chr(hex('4e')));
  write(outfile, chr(hex('d0')));
  while not eof(infile) do
    begin
      read(infile, c);
      write(outfile,c);
    end;

  close(infile);
  close(outfile, 'lock');
end ;    { procedure make_a_dot_out }

procedure dosetdate(var adate : tdate); {SFB}
var
  tmpdate : daterec;
  tmptime : timerec;
begin
 sysdate(tmpdate);
 systime(tmptime);
 with tmpdate, tmptime do
  begin
   {LAF 880101 added "mod 10" to "div 10"}
   adate[1]  := year div 10 mod 10;adate[2]    := year mod 10;
   adate[3]  := month div 10;   adate[4]    := month mod 10;
   adate[5]  := day div 10;     adate[6]    := day mod 10;
   adate[7]  := hour div 10;    adate[8]    := hour mod 10;
   adate[9]  := minute div 10;  adate[10]   := minute mod 10;
   adate[11] := (centisecond div 100) div 10;
   adate[12] := (centisecond div 100) mod 10;
  end;
a167 386
function boot_vol_ok ( boot_vol : lif_vol_header ) : boolean;
begin
  with boot_vol do
    boot_vol_ok :=
      (lifid = LIFmagic) and
      (lifoct_10000 = octal('10000')) and
      (lifdummy = 0) and
      (lifzero = 0) and
      (((lifdir_start_addr = 1) and (lifdir_length = 2))
	or
      ((lifdir_start_addr = 2) and (lifdir_length = 1)));
end;

procedure get_boot_directory ( volid : vid );
type
  buf = packed array [0..maxint] of char;
var
  bufptr : ^buf;
  in_vol_ptr : ANYPTR;
  i : integer;
  path : string255 ;
  old_ioresult : integer;
  null_pos : integer;
begin
  for i := 0 to 15 do
    begin
      in_boot_dir[i] := null_dir_entry;
      out_boot_dir[i] := null_dir_entry;
      in_lifname[i] := '';
      out_lifname[i] := '';
      in_boot_dir[i].lifstart_address := boot_fstart;       {SFB}
      out_boot_dir[i].lifstart_address := boot_fstart;      {SFB}
      in_boot_dir[i].liffile_length :=
	     (boot_size+SECTORSIZE-1) DIV SECTORSIZE;       {SFB}
      out_boot_dir[i].liffile_length :=
	     (boot_size+SECTORSIZE-1) DIV SECTORSIZE;       {SFB}
      in_boot_dir[i].lifimplement := boot_start;            {SFB}
      out_boot_dir[i].lifimplement := boot_start;           {SFB}
    end;
  in_vol_ptr := addr (in_boot_vol);

  path := volid;
  open_unit ( addr (path) );

  bufptr := in_vol_ptr;  { trick }
  freadbytes (filedes.f_ptr^, bufptr^, sizeof (in_boot_vol));
  goodio;

  if not boot_vol_ok(in_boot_vol) then
    begin
      writeln;
      writeln('LIF boot directory corrupted.');
      writeln('Use Zero if you want to create a new one.');
      escape(0);
  end;

  if in_boot_vol.lifdir_start_addr = 2 then
    begin  {old format}
      { seek to 512, read 256 or 8 directory entries }
      fseek (filedes.f_ptr^, 513);
      for i := 0 to 7 do
	begin
	  bufptr := addr ( in_boot_dir[i] );  { trick }
	  freadbytes (filedes.f_ptr^, bufptr^, sizeof (lif_dir_entry));
	end;
    end
  else
    begin
      { seek to 256, read 512 or 16 directory entries }
      fseek (filedes.f_ptr^, 257);
      for i := 0 to 15 do
	begin
	  bufptr := addr ( in_boot_dir[i] );  { trick }
	  freadbytes (filedes.f_ptr^, bufptr^, sizeof (lif_dir_entry));
	end;
    end;

  for i := 0 to 15 do
    begin
      strmove(10, in_boot_dir[i].liffile_name, 1, in_lifname[i], 1);
      null_pos := strpos (nullstr, in_lifname[i]);
      if null_pos <> 0 then
	setstrlen (in_lifname[i], (null_pos - 1));
      in_lifname[i]:=strrtrim(in_lifname[i]);   {SFB-fixes 6.2 bootname bug??}
    end;

end ;    { procedure get_boot_directory }

procedure put_boot_directory ( volid : vid );
type
  buf = packed array [0..maxint] of char;
var
  bufptr        : ^buf;
  out_vol_ptr   : ANYPTR;
  out_dir_ptr   : ANYPTR;
  i,j           : integer; {for FSDdt02073 SFB/DEW 12/16/88}
  path          : string255 ;
  old_ioresult  : integer;
begin
{???? keyboard lockup }
  out_vol_ptr := addr (out_boot_vol);
  path := volid;
  fseek (filedes.f_ptr^, 1);  {reset file pointer}

  bufptr := out_vol_ptr;  { trick }
  fwritebytes (filedes.f_ptr^, bufptr^, sizeof (out_boot_vol));
  goodio;

  { seek to 256, write 512 bytes or 16 directory entries }
  fseek (filedes.f_ptr^, 257);
  for i := 0 to 15 do
    begin
      {for pawsqa3.3 defect FSDdt02073 SFB/DEW 12/16/88}
      for j:=1 to 10 do {ensure no nulls anywhere in name on disc.
			 Debugger and programmatic named reboot can't
			 have nulls in bootname.}
	  if out_boot_dir[i].liffile_name[j]=#0 then out_boot_dir[i].liffile_name[j]:=' ';
      out_dir_ptr := addr ( out_boot_dir[i] );
      bufptr := out_dir_ptr ;  { trick }
      fwritebytes (filedes.f_ptr^, bufptr^, sizeof (lif_dir_entry));
    end;

  fcloseit (filedes.f_ptr^, 'save');
  if ioresult <> 0 then       {SFB}
   escape(0);
end ;    { procedure put_boot_directory }

procedure write_lif_header(volid: vid);
type
  buf = packed array [0..maxint] of char;
var
  bufptr                : ^buf;
  out_vol_ptr           : ANYPTR;
  out_dir_ptr           : ANYPTR;
  i                     : integer;
  path                  : string255 ;
  old_ioresult          : integer;
  null_pos              : integer;
  result                : integer;
  unit, nameunit        : integer;
  boot_sectors  : integer;
begin
  path := volid;
  open_unit ( addr (path) );
  unit := filedes.f_ptr^.funit ;

  boot_sectors := (boot_size + (SECTORSIZE-1)) div SECTORSIZE;

  { sector 0 -- volume header }
  with out_boot_vol do
    begin
      lifid := LIFmagic;
      if h_unitable <> nil then
	nameunit := h_unitable^.tbl[unit].base_unum
      else
	nameunit := unit;

      lifvol_label := 'V     ';
      if nameunit < 10 then
	  lifvol_label[2] := chr(ord('0') + nameunit)
      else
	begin
	  lifvol_label[2] := chr(ord('0') + nameunit div 10);
	  lifvol_label[3] := chr(ord('0') + nameunit mod 10);
	end;

      lifdir_start_addr         := DIRSTART;
      lifoct_10000              := LIFDUMMY1;
      lifdummy                  := 0;
      lifdir_length             := DIRBLKS;
      lifversion                := 1;
      lifzero                   := 0;
      liftps                    := 1;    {SFB}
      lifspm                    := 1;    {SFB}
      lifspt                    := {8192 div 256} 25;   {SFB}

      dosetdate(lifcdate);      {SFB}

      for i:=21 to 123 do       {SFB}
       filler[i]:=0;

      lifdummy4 := 00;          {SFB}
  end;

  out_vol_ptr := addr (out_boot_vol);
  bufptr := out_vol_ptr;  { trick }
  fwritebytes (filedes.f_ptr^, bufptr^, sizeof (out_boot_vol));
  goodio;

  { seek to 256, write 512 bytes or 16 directory entries }
  fseek (filedes.f_ptr^, 257);
  for i := 0 to 15 do
    begin
      out_dir_ptr := addr ( out_boot_dir[i] );
      bufptr := out_dir_ptr ;  { trick }
      fwritebytes (filedes.f_ptr^, bufptr^, sizeof (lif_dir_entry));
    end;
  goodio;

  { now the boot program }
  fwritebytes (filedes.f_ptr^, boot_start, boot_sectors*SECTORSIZE);
  goodio;

  fcloseit (filedes.f_ptr^, 'save');
end;    { procedure write_lif_header }

function file_type ( inname : string255 ) : file_variety;
var
  f: file of char;
begin
  try
    reset(f, inname);
    file_type := regular_file;
  recover
    if ioresult = ord(inofile) then
      file_type := no_file
    else
      if ioresult = ord(inoaccess) then
	file_type := regular_file
      else
	file_type := special_file;
end;

function rootname ( inname : string255 ) : string255;
begin
  if inname = 'SYSHPUX' then
    rootname := 'hp-ux'
  else
    rootname := inname;
end;

function null_padded_name(oldname:fid):fid;     {SFB}
var i:integer;
begin
  for i := (strlen(oldname) + 1 ) to 10 do
    strappend (oldname, nullstr);
  null_padded_name:=oldname;
end;

function check_a_dot_out ( inname : string255 ) : bootability;  {SFB}
var
  sizefile : file of integer;
  magic_num : integer;
  old_ioresult : integer;
begin
  check_a_dot_out := not_found;  {SFB}
  try
    reset(sizefile, inname);
    check_a_dot_out := not_bootable;  {SFB}
    read(sizefile, magic_num);
    if magic_num = hex('020c0108') then
	check_a_dot_out := bootable;  {SFB}
    close(sizefile);
  recover ;
end ;    { function check_a_dot_out }

function num_boot_files : integer;
var
  count : integer;
  i : integer;
begin
  count := 0;
  for i := 0 to 15 do
    begin
      if in_boot_dir[i].liffile_type = bootable_eft then
	  count := count + 1 ;
    end ;
  num_boot_files := count;
end ;    { function num_boot_files }

procedure dup_boot_dir;
var
  i : integer;
begin
  for i := 0 to 15 do
    begin
      out_boot_dir[i] := in_boot_dir[i];
      out_lifname[i] := in_lifname[i];
    end ;

  out_boot_vol := in_boot_vol ;
  out_boot_vol.lifdir_start_addr := 1;
  out_boot_vol.lifdir_length := 2;
end ;   { procedure dup_boot_dir }

procedure order_boot_file ( ltitle : fid );
var
  i : integer;
  j : integer;
begin

  j := 1;
  for i := 0 to 15 do
    begin
      if in_lifname[i] <> ltitle then {SFB/DEW 01/10/89 changed to string
				       compare for simplicity}
	begin
	  out_boot_dir[j] := in_boot_dir[i];
	  out_lifname[j] := in_lifname[i];
	  j := j + 1 ;
	end
      else
	begin
	  out_boot_dir[0] := in_boot_dir[i];
	  out_lifname[0] := in_lifname[i];
	end;
    end ;

   out_boot_vol := in_boot_vol ;
   out_boot_vol.lifdir_start_addr := 1;
   out_boot_vol.lifdir_length := 2;
end ;   { procedure order_boot_file }

procedure nuke_boot_file ( ltitle : fid );
var
  i : integer;
  j : integer;
  nulterm_name, spaceterm_name : lifname;
  last_entry : integer;
begin
  if strlen(ltitle) = 0 then
    badio ( ibadtitle );
  ltitle:=null_padded_name(ltitle);     {SFB}
  strmove ( 10, ltitle, 1, nulterm_name, 1 );
  for i:=1 to 10 do   {now build spacepadded version of ltitle as PAC SFB}
    if ltitle[i] = nullstr then
      strmove(1, ' ', 1, ltitle, i);
  strmove (10, ltitle, 1, spaceterm_name, 1);

  last_entry := num_boot_files - 1 ;
  j := 0;
  for i := 0 to 15 do
    begin
      if (in_boot_dir[i].liffile_name <> nulterm_name) and
	 (in_boot_dir[i].liffile_name <> spaceterm_name) then  {SFB}
	  begin
	    out_boot_dir[j] := in_boot_dir[i];
	    out_lifname[j] := in_lifname[i];
	    j := j + 1 ;
	  end;
    end ;

  if last_entry >= 0 then
      begin   {SFB}
	out_boot_dir[last_entry] := null_dir_entry;
	out_boot_dir[last_entry].lifstart_address := boot_fstart;     {SFB}
	out_boot_dir[last_entry].liffile_length :=
		   (boot_size+SECTORSIZE-1) DIV SECTORSIZE;           {SFB}
	out_boot_dir[last_entry].lifimplement := boot_start;          {SFB}
      end;

  out_boot_vol := in_boot_vol ;
  out_boot_vol.lifdir_start_addr := 1;
  out_boot_vol.lifdir_length := 2;
end ;   { procedure nuke_boot_file }

procedure add_boot_file ( ltitle : fid );
var
  i : integer;
  open_slot : integer;
begin
  if num_boot_files >= 16 then
    badio ( idirfull );

  for i := 15 downto 0 do
    if out_boot_dir[i].liffile_type = -1 then
	open_slot := i;


  for i := 0 to 15 do
    if out_lifname[i] = ltitle then {SFB/DEW 01/10/89 compare stripped}
				    {lifname from disc to ltitle instead}
				    {of comparing PACs}
	open_slot := i;

  with out_boot_dir[open_slot] do
    begin
      ltitle:=null_padded_name(ltitle);     {SFB, don't change ltitle
					     until now so can compare with
					     out_lifname[i].}
      strmove ( 10, ltitle, 1, liffile_name, 1 );
      liffile_type := bootable_eft;
      dosetdate(liftoc);        {SFB}
    end;
end ;   { procedure add_boot_file }

d176 1
a176 1
    filename_ok := false;       {SFB}
d179 1
a179 95
procedure check_entries ( volid : vid; ltitle : fid );
var
  title : lifstring;
  done : boolean;
  current : integer;
  inname : string255 ;
  i : integer;
  nullpos : integer;
  a_dot_out_state : bootability;      {SFB}

  function stripped_name(oldname:lifstring):lifstring;   {SFB}
  var nullpos:integer;
  begin
    nullpos:=strpos (nullstr, oldname);
    if nullpos <> 0 then
	setstrlen (oldname, (nullpos-1));
    stripped_name:=oldname;
  end;

begin
  done := false;
  current := -1;
  good_cur := 0;
  bad_cur := 0;
  title := '';

  if ( strlen ( ltitle ) = 0 ) then
    begin
      title := in_lifname[0];
      current := 0;
    end
  else
    begin
      done := true;
      title:=ltitle;
      for i := 0 to 15 do
	if title = strrtrim(in_lifname[i]) then {SFB}
	  current := i;
      if current = -1 then
	badio ( inofile );
      end;

  repeat
    { check that file type is -5822 for bootable file }
    if in_boot_dir[current].liffile_type = bootable_eft then
      begin
	{ check that a file exists in / and is a.out format }
	inname := volid;
	strappend (inname, '/');
	strappend (inname, rootname(title));
	a_dot_out_state := check_a_dot_out(inname);   {SFB}
	title:=stripped_name(title);    {SFB}
	if a_dot_out_state = bootable then {SFB}
	  begin
	    good_list[good_cur].name    := title;
	    good_list[good_cur].problem := 'bootable';      {SFB}
	    good_cur := good_cur + 1;
	  end
	else
	 if a_dot_out_state = not_found then     {SFB}
	   begin
	     bad_list[bad_cur].name    := title;
	     bad_list[bad_cur].problem := 'not found in '+volid+'/'; {SFB}
	     bad_cur := bad_cur + 1;
	   end
	 else
	   if a_dot_out_state = not_bootable then     {SFB}
	    begin
	      bad_list[bad_cur].name    := title;
	      bad_list[bad_cur].problem :=
		 'not bootable in '+volid+'/ (not a.out format)'; {SFB}
	      bad_cur := bad_cur + 1;
	    end;
      end
    else
      begin
	{ not a bootable type }
	if in_boot_dir[current].liffile_type <> -1 then
	  begin
	    bad_list[bad_cur].name    := title;
	    bad_list[bad_cur].problem :=
			       'not a LIF bootfile (not .SYSTM)'; {SFB}
	    bad_cur := bad_cur + 1;
	  end;
      end;

    current := current + 1;
    if current <= 15 then
      title := in_lifname[current]
    else
      done := true;
  until done ;
end ;    { procedure check_entries }

procedure check ;
d191 5
a195 1
  i : integer;
a204 1
    { exit. SFB }
d221 2
a222 1
  { check that the unit is HFS }
d224 1
a224 1
  must_be_HFS(unitnum);
d226 14
a239 1
  { get the current contents of the LIF boot directory }
d241 10
a250 1
  get_boot_directory ( volid );
d252 5
a256 1
  { check that the fields have valid entries }
d258 5
a262 3
  while (strlen(ltitle) > 0) and (ltitle[1] = '/') do
   {remove leading '/'s from filename for 3.2G SFB}
   ltitle := str(ltitle, 2, strlen(ltitle)-1);
d264 2
a265 1
  check_entries ( volid, ltitle );
d267 4
a270 1
  { report status of check to the user }
d272 2
a273 2
  if ( good_cur = 0 ) and ( bad_cur = 0 ) then
    begin
d276 1
a276 1
    end;
d278 2
a279 7
  if good_cur > 0 then
    begin
      writeln;
      for i := 0 to (good_cur -1) do
	with good_list[i] do
	  writeln ( name, strrpt(' ',12-strlen(name)), problem );
    end;
a280 8
  if bad_cur > 0 then
    begin
      writeln;
      for i := 0 to (bad_cur -1) do
	with bad_list[i] do
	  writeln ( name, strrpt(' ',12-strlen(name)), problem );
    end;

d287 1
a287 1
end ;  { procedure check }
d289 1
a289 1
procedure install ;
a301 1
  inname : string255;
a326 11
  { check that the unit is HFS and pointed at root directory }

  must_be_HFS(unitnum);
  must_be_rootdir(unitnum);

  { get the current contents of the LIF boot directory }

  get_boot_directory ( volid );

  { convert file in / to a.out format }

a327 1
   {remove leading '/'s from filename for 3.2G SFB}
d333 3
a335 6
  inname := volid+rootname(ltitle);
  case file_type(inname) of   {SFB}
    no_file:      badio(inofile);
    special_file: badio(ibadfiletype);
    regular_file: {no action now};
  end; {case}
a336 2
  if not (check_a_dot_out ( inname ) = bootable) then   {SFB}
    make_a_dot_out (inname, inname );
a337 6
  { set up boot directory }

  dup_boot_dir;
  add_boot_file ( ltitle );
  put_boot_directory ( volid );

d347 1
a347 1
end ;  { procedure install }
d349 1
a349 1
procedure order ;
a362 1
  inname : string255;
a388 11
  { check that the unit is HFS and pointed at root directory }

  must_be_HFS(unitnum);
  must_be_rootdir(unitnum);

  { get the current contents of the LIF boot directory }

  get_boot_directory ( volid );

  { check files }

a389 1
   {remove leading '/'s from filename for 3.2G SFB}
d392 1
a392 1
  if ltitle = '' then
d395 3
a397 3
  check_entries ( volid, ltitle );
  if bad_cur > 0 then ;
    { badio ( ibadfiletype ); }
a398 8
  { set up boot directory }

  if num_boot_files > 1 then
    begin
      order_boot_file ( ltitle );
      put_boot_directory ( volid );
    end;

d410 1
a410 1
procedure remove ;
d424 1
a424 1
  inname : string255;
a449 1
  strappend ( volid, ':' );
a450 11
  { check that the unit is HFS and pointed at root directory }

  must_be_HFS(unitnum);
  must_be_rootdir(unitnum);

  { get the current contents of the LIF boot directory }

  get_boot_directory ( volid );

  { check files }

a451 1
   {remove leading '/'s from filename for 3.2G SFB}
d454 2
a455 9
  check_entries ( volid, ltitle );
  if num_boot_files = 1 then
    begin
      writeln;
      writeln('This will remove last bootable file.');
      promptread ( confirm, ans, 'YN', 'N' );
      if ans <> 'Y' then
	escape (0);
    end;
d457 18
a474 1
  { set up boot directory }
a475 2
  nuke_boot_file ( ltitle );
  put_boot_directory ( volid );
d488 1
a488 1
procedure zero ;
d532 1
a532 1
  { check that the unit is HFS and pointed at root directory }
a533 17
  must_be_HFS(unitnum);

  { get the current contents of the LIF boot directory }

  for i := 0 to 15 do
   begin      {SFB}
     out_boot_dir[i] := null_dir_entry;
     out_boot_dir[i].lifstart_address := boot_fstart;  {SFB}
     out_boot_dir[i].liffile_length :=
	      (boot_size+SECTORSIZE-1) DIV SECTORSIZE; {SFB}
     out_boot_dir[i].lifimplement := boot_start;       {SFB}
   end;

  { set up boot directory }

  write_lif_header ( volid );

d545 2
a546 7
begin    { procedure do_osinstall }
  {we make this a procedure to save global space SFB 3-30-87}
  writeln ( clearscr ) ;
  fgotoxy(output,0,4);
  writeln(copyright_line1);
  writeln(copyright_line2);

d551 1
d559 3
a561 2
      otherwise ; { bad option }
    end ;
d563 1
a563 5
end; {procedure do_osinstall}

begin   {program osinstall}
  do_osinstall;
end.    { program osinstall }
@


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.2
log
@Fixed newly introduced bug (3.22C bug) where Install and existing
file would duplicate it in LIF boot directory. Also fixed similar
problem in order.
Scott/Dave
@
text
@@


32.1
log
@Automatic bump of revision number for PWS version 3.22C
@
text
@a812 1
  new_name : lifname;
a813 2
  ltitle:=null_padded_name(ltitle);     {SFB}
  strmove ( 10, ltitle, 1, new_name, 1 );
d818 2
a819 1
      if in_boot_dir[i].liffile_name <> new_name then
a883 1
  new_name : lifname;
a891 2
  ltitle:=null_padded_name(ltitle);     {SFB}
  strmove ( 10, ltitle, 1, new_name, 1 );
d894 3
a896 1
    if out_boot_dir[i].liffile_name = new_name then
d901 3
@


31.3
log
@
pws2rcs automatic delta on Mon Jan  9 11:50:34 MST 1989
@
text
@@


31.2
log
@This defect was detected during formal 3.22 QA.
the problem was that named reboot wouldn't work with the
boot names generated by PWS OSINSTALL.  This was due to
OSINSTALL right padding with nulls instead of spaces.
@
text
@d24 6
a29 1
  copyright_line1 = '  Copyright 1986, 1988 Hewlett-Packard Company';
@


31.1
log
@Automatic bump of revision number for PWS version 3.22B
@
text
@d12 1
a12 1
{
d614 1
a614 1
  i             : integer;
d631 5
@


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.3
log
@
ipws2rcs automatic delta on Mon Oct 31 10:34:17 MST 1988
:w
:q
@
text
@@


28.2
log
@Fixed 6.2 HP-UX naming problem: names ending in spaces weren't being
recognized by Check code. Also cleaned up bits and pieces here and there,
consolidating some common code into functions, etc.
Scott
@
text
@d10 2
a12 2
$search 'PROGS:MATCHSTR'$   { real search }

@


28.1
log
@Automatic bump of revision number for PWS version 3.3b
@
text
@d10 1
a12 1
{
d24 1
a24 1
  copyright_line1 = '  Copyright 1986 Hewlett-Packard Company';
a44 1

a177 1

d180 21
a201 23
  boot_start['bootasm_start']: integer;
  boot_size['bootasm_size']: integer;
  boot_fstart['bootasm_fstart']: integer;        {SFB for 3.2D}
  cmd_done : boolean;
  action_os : char;
  file_info : control ;
  ininfo : control;
  in_boot_vol : lif_vol_header ;
  out_boot_vol : lif_vol_header ;
  in_boot_dir : array [0..15] of lif_dir_entry ;
  out_boot_dir : array [0..15] of lif_dir_entry ;
  in_lifname : array [0..15] of lifstring;
  out_lifname : array [0..15] of lifstring;
  filedes : fildesentry;
  option : string255;
  prompt_main : prompttype;
  good_list : array [0..15] of check_info;
  bad_list : array [0..15] of check_info;
  good_cur : integer;
  bad_cur : integer;
  tempfib : fibp;


d203 4
a207 6
  begin
    if ('a'<=ch) and (ch<='z')
      then
	ch := chr(ord(ch)-32);
  end;    { procedure upcchar }

d209 4
a213 6
  begin
    if ioresult <> ord (inoerror)
      then
	escape(0);
  end;    { procedure goodio }

d215 4
a219 5
  begin
    ioresult := ord (iocode);
    escape(0);
  end;

d221 4
a225 5
  begin
    writeln('bad command ''',c,'''');
    if streaming then escape(-1) else badio(inoerror);
  end;    { badcommand }

d227 9
a236 12
  var
    msg   : string[80];

  begin
    if ioresult <> ord(inoerror)
      then
	begin
	  getioerrmsg (msg,ioresult);
	  writeln ('Error: ',msg,cteol);
	end;
  end;    { procedure printioerrmsg }

d238 3
a240 3

  begin
    if h_unitable = NIL then begin
d244 2
a245 1
    if not h_unitable^.tbl[un].is_hfsunit then begin
d249 1
a249 1
  end;
d252 3
a254 3

  begin
    if h_unitable^.tbl[un].prefix <> 2 then begin
d258 1
a258 1
  end;
d260 15
a274 10

{
function unitnumber (var fvid : vid) : boolean;

  begin
    unitnumber := false;
    if strlen(fvid) > 1
      then
	if fvid[1]='#'
	  then
d276 25
a300 3
	      if (fvid[2]>='0') and (fvid[2]<='9')
		then
		  unitnumber := (spanstr(fvid, 2, '0123456789') = strlen(fvid));
d302 5
a306 1
  end; { unitnumber }
d308 7
a314 7
function setupfib(path: strp; tempfib: fibp): boolean;

  var
    temp_fsegs : integer;
    fk : filekind;

  begin
d317 12
a328 3
	setupfib := false;
	if scantitle( path^, fvid, ftitle, temp_fsegs, fk) then
	  {valid filename}
d330 8
a337 6
	    funit := findvolume(fvid,TRUE);
	    if (funit <=  0) or (funit > maxunit) then
		badio ( ibadunit )
	    else
	      begin
		finitb(tempfib^,fwindow,1);
a338 66
		{initialize fib for open a file}
		feft := 3 {LIF directory, actually the BOOT directory};
		fkind := untypedfile;
		for fk := untypedfile to lastfkind do
		  if efttable^[fk] = feft then
		    fkind := fk;
		fisnew := false;
		option := '';
		foptstring := addr(option);
		fanonymous := false;
		fmodified := false;
		flocked := true;
		freptcnt := 0;
		fbufchanged := false;
		flastpos := -1;
		fstartaddress := 0;
		pathid := -1;
		fnosrmtemp := true;
		if temp_fsegs > 0 then fpos := temp_fsegs*fblksize
				  else fpos := temp_fsegs;
		feof := false;
		feoln := false;
		freadmode := true;
		setupfib := true;
	      end;
	  end
	else {scantitle}
	    badio ( ibadtitle );
      end; {with}
  end; {setupfib}

procedure open_unit ( path: strp );

  begin

    {get a fib}
    new(tempfib);
    tempfib^.flistptr := openfileptr;
    openfileptr := tempfib;

    if setupfib(path,tempfib) then
      with tempfib^ do
	begin
	  if (ftitle = '') and (unitable^[funit].uisblkd = true) then { open unit }
	    begin
	      {ignore ioresults set by findvolume in setupfib, except for znotready}
	      if ioresult <> ord(znotready) then
		call(unitable^[funit].dam,tempfib^,funit,openunit);
	    end ;

	  if ioresult <> 0 then
	    if ioresult = ord(znotready) then
	      badio ( znotready )
	    else badio ( ibadunit )
	  else
	    begin
	      {successfully opened the unit, now update filedes}
	      freadable := true;
	      fwriteable := true;
	      filedes.f_ptr := tempfib;
	      filedes.fwindow := fwindow;
	    end;
      end;{with}

  end; { procedure open_unit }

d340 11
a351 14
  var
    saveio : integer;

  begin
    if ioresult <> ord (inoerror)
      then
	begin
	  saveio := ioresult;
	  writeln;
	  ioresult := saveio;
	  escape(0);
	end;
  end;    { procedure readcheck }

d353 7
a359 1
			  var ch : char);
d361 8
a368 16
  begin
    write (homechar,pl,cteol);
    read (keyboard,ch);
    readcheck;
    if ch = esc_char
      then
	ch := ' ';
    if ch=' '
      then
	write(clearscr)
      else
	begin
	  write (homechar,cteol);
	  upcchar (ch);
	end;
  end;    { procedure promptforchar }
d371 8
a378 9
		     default:char);

  var
    s1   : string[1];
    done : boolean;

  begin
    if (default<>esc_char) and streaming then answer:=default
    else
d384 5
a388 1
	if answer=esc_char then  begin writeln; badio(inoerror); end;
d391 2
a392 1
	if not done and streaming then badcommand(answer);
d396 1
a396 1
  end;    { promptread }
d399 3
a402 4
  begin
    promptread(p+' ? (Y/N) ',answer,'YN','Y');
  end;    { promptyorn }

d404 9
a412 1
			   var answer : string80 ) ;
a413 9
  begin
    setstrlen (answer, 0);
    writeln;
    write (prompt);
    readln (answer);
    goodio;
    zapspaces (answer);
  end ;  { procedure get_user_input }

d415 20
a434 1
			   outname : string255 );
d436 6
a441 1
  var
d443 11
a453 9
    infile      : file of char;
    outfile     : file of char;
    headerfile  : file of a_dot_out_block;
    c           : char;
    cp          : charptr;
    sizefile    : file of integer;
    a_out_block : a_dot_out_block;
    i           : shortint;
    pcoffset    : integer;
d455 1
a455 1
  begin
d457 6
a462 8
    a_out_block := boot_a_dot_out;
    try         {SFB}
      reset(sizefile, inname);
    recover begin
	     writeln;
	     writeln('Operation not allowed on this filetype');
	     escape(0);
	    end;
d464 18
a481 26
    if fibp ( addr ( sizefile ))^.fkind <> sysfile
      then
	begin
	  writeln;
	  writeln ('File ', inname, ' is neither a SYSTM nor an a.out file.');
	  escape (0);
	end ;

    with a_out_block do
      begin
	read(sizefile, txt);        {dummy read}
	read(sizefile, txt);
	txt := txt - 8;            {remove first 8 bytes of boot format}
	read(sizefile, pcoffset);
	read(sizefile, pcoffset);
	read(sizefile, pcoffset);
	pcoffset := pcoffset + 8;
      end;
    close(sizefile);

    rewrite(outfile, outname, '\-5813\');

    cp := addr(a_out_block);
    for i := 1 to sizeof(a_out_block) do begin
    write(outfile, cp^);
    cp := addr(cp^, 1);
d483 8
a490 5

    reset(infile, inname);
    for i := 1 to 8 do
      read(infile, c);      {space past first 8 bytes of boot format}
    for i := 1 to 14 do
d492 2
a493 26
    { lea *,a0 }
    write(outfile, chr(hex('41')));
    write(outfile, chr(hex('fa')));
    write(outfile, chr(hex('ff')));
    write(outfile, chr(hex('fe')));
    { lea pcoffset,a1 }
    write(outfile, chr(hex('43')));
    write(outfile, chr(hex('f9')));
    cp := addr(pcoffset);
    for i := 1 to sizeof(pcoffset) do
      begin
	write(outfile, cp^);
	cp := addr(cp^, 1);
      end;
    { adda.l a1, a0 }
    write(outfile, chr(hex('d1')));
    write(outfile, chr(hex('c9')));
    { jmp (a0) }
    write(outfile, chr(hex('4e')));
    write(outfile, chr(hex('d0')));
    while not eof(infile) do
      begin
	read(infile, c);
	write(outfile,c);
      end;
    close(infile);
d495 3
a497 1
    close(outfile, 'lock');
a498 2
  end ;    { procedure make_a_dot_out }

d501 2
a502 2
    tmpdate : daterec;
    tmptime : timerec;
d504 13
a516 13
   sysdate(tmpdate);
   systime(tmptime);
   with tmpdate, tmptime do
    begin
     {LAF 880101 added "mod 10" to "div 10"}
     adate[1]  := year div 10 mod 10;adate[2]    := year mod 10;
     adate[3]  := month div 10;   adate[4]    := month mod 10;
     adate[5]  := day div 10;     adate[6]    := day mod 10;
     adate[7]  := hour div 10;    adate[8]    := hour mod 10;
     adate[9]  := minute div 10;  adate[10]   := minute mod 10;
     adate[11] := (centisecond div 100) div 10;
     adate[12] := (centisecond div 100) mod 10;
    end;
d520 11
a530 11
  begin
    with boot_vol do
      boot_vol_ok :=
	(lifid = LIFmagic) and
	(lifoct_10000 = octal('10000')) and
	(lifdummy = 0) and
	(lifzero = 0) and
	(((lifdir_start_addr = 1) and (lifdir_length = 2))
	  or
	((lifdir_start_addr = 2) and (lifdir_length = 1)));
  end;
a531 1

d533 26
d560 2
a561 2
  type
    buf = packed array [0..maxint] of char;
d563 3
a565 7
  var
    bufptr : ^buf;
    in_vol_ptr : ANYPTR;
    i : integer;
    path : string255 ;
    old_ioresult : integer;
    null_pos : integer;
d567 2
a568 29
  begin

    for i := 0 to 15 do
	begin
	  in_boot_dir[i] := null_dir_entry;
	  out_boot_dir[i] := null_dir_entry;
	  in_lifname[i] := '';
	  out_lifname[i] := '';
	  in_boot_dir[i].lifstart_address := boot_fstart;       {SFB}
	  out_boot_dir[i].lifstart_address := boot_fstart;      {SFB}
	  in_boot_dir[i].liffile_length :=
		 (boot_size+SECTORSIZE-1) DIV SECTORSIZE;       {SFB}
	  out_boot_dir[i].liffile_length :=
		 (boot_size+SECTORSIZE-1) DIV SECTORSIZE;       {SFB}
	  in_boot_dir[i].lifimplement := boot_start;            {SFB}
	  out_boot_dir[i].lifimplement := boot_start;           {SFB}
	end;
    in_vol_ptr := addr (in_boot_vol);

    path := volid;
    open_unit ( addr (path) );

    bufptr := in_vol_ptr;  { trick }

    freadbytes (filedes.f_ptr^, bufptr^, sizeof (in_boot_vol));

    goodio;

    if not boot_vol_ok(in_boot_vol) then begin
d573 1
a573 1
    end;
d575 5
a579 12
    if in_boot_vol.lifdir_start_addr = 2
      then
	begin  {old format}
	  { seek to 512, read 256 or 8 directory entries }
	  fseek (filedes.f_ptr^, 513);
	  for i := 0 to 7 do
	    begin
	      bufptr := addr ( in_boot_dir[i] );  { trick }
	      freadbytes (filedes.f_ptr^, bufptr^, sizeof (lif_dir_entry));
	    end;
	end
      else
d581 2
a582 7
	  { seek to 256, read 512 or 16 directory entries }
	  fseek (filedes.f_ptr^, 257);
	  for i := 0 to 15 do
	    begin
	      bufptr := addr ( in_boot_dir[i] );  { trick }
	      freadbytes (filedes.f_ptr^, bufptr^, sizeof (lif_dir_entry));
	    end;
d584 11
d596 8
a603 8
    for i := 0 to 15 do
      begin
	strmove(10, in_boot_dir[i].liffile_name, 1, in_lifname[i], 1);
	null_pos := strpos (nullstr, in_lifname[i]);
	if null_pos <> 0
	  then
	    setstrlen (in_lifname[i], (null_pos - 1));
      end;
d605 1
a605 1
  end ;    { procedure get_boot_directory }
a606 1

d608 10
a617 14

  type
    buf = packed array [0..maxint] of char;

  var
    bufptr : ^buf;
    out_vol_ptr : ANYPTR;
    out_dir_ptr : ANYPTR;
    i : integer;
    path : string255 ;
    old_ioresult : integer;

  begin

d619 3
d623 3
a625 1
    out_vol_ptr := addr (out_boot_vol);
d627 8
a634 2
    path := volid;
    fseek (filedes.f_ptr^, 1);  {reset file pointer}
d636 4
a639 1
    bufptr := out_vol_ptr;  { trick }
a640 20
    fwritebytes (filedes.f_ptr^, bufptr^, sizeof (out_boot_vol));

    goodio;

    { seek to 256, write 512 bytes or 16 directory entries }
    fseek (filedes.f_ptr^, 257);
    for i := 0 to 15 do
      begin
	out_dir_ptr := addr ( out_boot_dir[i] );
	bufptr := out_dir_ptr ;  { trick }
	fwritebytes (filedes.f_ptr^, bufptr^, sizeof (lif_dir_entry));
      end;

    fcloseit (filedes.f_ptr^, 'save');
    if ioresult <> 0 then       {SFB}
     escape(0);

  end ;    { procedure put_boot_directory }


d642 13
a654 16

  type
    buf = packed array [0..maxint] of char;

  var
    bufptr : ^buf;
    out_vol_ptr : ANYPTR;
    out_dir_ptr : ANYPTR;
    i : integer;
    path : string255 ;
    old_ioresult : integer;
    null_pos : integer;
    result: integer;
    unit, nameunit: integer;
    boot_sectors: integer;

d656 3
d660 1
a660 3
    path := volid;
    open_unit ( addr (path) );
    unit := filedes.f_ptr^.funit ;
d662 8
a669 1
    boot_sectors := (boot_size + (SECTORSIZE-1)) div SECTORSIZE;
d671 7
a677 14
    { sector 0 -- volume header }
    with out_boot_vol do begin
	lifid := LIFmagic;
	if h_unitable <> nil then
	    nameunit := h_unitable^.tbl[unit].base_unum
	else
	    nameunit := unit;

	lifvol_label := 'V     ';
	if nameunit < 10 then
	    lifvol_label[2] := chr(ord('0') + nameunit)
	else begin
	    lifvol_label[2] := chr(ord('0') + nameunit div 10);
	    lifvol_label[3] := chr(ord('0') + nameunit mod 10);
d680 9
a688 14
	lifdir_start_addr := DIRSTART;
	lifoct_10000 := LIFDUMMY1;
	lifdummy := 0;
	lifdir_length := DIRBLKS;
	lifversion := 1;
	lifzero := 0;
	liftps := 1;    {SFB}
	lifspm := 1;    {SFB}
	lifspt := {8192 div 256} 25;   {SFB}
	dosetdate(lifcdate);      {SFB}
	for i:=21 to 123 do       {SFB}
	 filler[i]:=0;
	lifdummy4 := 00;          {SFB}
    end;
d690 1
a690 4
    out_vol_ptr := addr (out_boot_vol);
    bufptr := out_vol_ptr;  { trick }
    fwritebytes (filedes.f_ptr^, bufptr^, sizeof (out_boot_vol));
    goodio;
d692 2
a693 9
    { seek to 256, write 512 bytes or 16 directory entries }
    fseek (filedes.f_ptr^, 257);
    for i := 0 to 15 do
      begin
	out_dir_ptr := addr ( out_boot_dir[i] );
	bufptr := out_dir_ptr ;  { trick }
	fwritebytes (filedes.f_ptr^, bufptr^, sizeof (lif_dir_entry));
      end;
    goodio;
d695 2
a696 3
    { now the boot program }
    fwritebytes (filedes.f_ptr^, boot_start, boot_sectors*SECTORSIZE);
    goodio;
d698 4
a701 1
    fcloseit (filedes.f_ptr^, 'save');
d703 9
a711 1
end;    { procedure write_lif_header }
d713 3
d717 2
a718 15
{
function file_exists ( inname : string255 ) : boolean;
  var
    f: file of char;
  begin
    file_exists := false;
    try
      reset(f, inname);
      close(f);
      file_exists := true;
    recover
      if (ioresult <> ord(inoerror)) and (ioresult <> ord(inofile)) then
	escape(-10);
  end;
}
d721 12
a732 9
  var
    f: file of char;
  begin
    try
      reset(f, inname);
      file_type := regular_file;
    recover
      if ioresult = ord(inofile) then
	file_type := no_file
d734 2
a735 5
	if ioresult = ord(inoaccess) then
	  file_type := regular_file
	else
	  file_type := special_file;
  end;
d737 7
a743 7
  function rootname ( inname : string255 ) : string255;
    begin
      if inname = 'SYSHPUX' then
	rootname := 'hp-ux'
      else
	rootname := inname;
    end;
d745 7
d754 15
a769 22
  var
    sizefile : file of integer;
    magic_num : integer;
    old_ioresult : integer;

  begin

    check_a_dot_out := not_found;  {SFB}

    try
      reset(sizefile, inname);
      check_a_dot_out := not_bootable;  {SFB}
      read(sizefile, magic_num);
      if magic_num = hex('020c0108')
	then
	  check_a_dot_out := bootable;  {SFB}
      close(sizefile);

    recover ;

  end ;    { function check_a_dot_out }

d771 12
a783 17
  var
    count : integer;
    i : integer;

  begin

    count := 0;
    for i := 0 to 15 do
      begin
	if in_boot_dir[i].liffile_type = bootable_eft
	  then
	    count := count + 1 ;
      end ;
    num_boot_files := count;

  end ;    { function num_boot_files }

d785 8
d794 4
a797 2
  var
    i : integer;
a798 14
  begin

    for i := 0 to 15 do
      begin
	out_boot_dir[i] := in_boot_dir[i];
	out_lifname[i] := in_lifname[i];
      end ;

     out_boot_vol := in_boot_vol ;
     out_boot_vol.lifdir_start_addr := 1;
     out_boot_vol.lifdir_length := 2;

  end ;   { procedure dup_boot_dir }

d800 7
d808 15
a822 4
  var
    i : integer;
    j : integer;
    new_name : lifname;
d824 4
a827 1
  begin
a828 29
    if ( strlen (ltitle) < 10 )
      then
	for i := (strlen(ltitle) + 1 ) to 10 do
	  strappend ( ltitle, nullstr );
    strmove ( 10, ltitle, 1, new_name, 1 );

    j := 1;
    for i := 0 to 15 do
      begin
	if in_boot_dir[i].liffile_name <> new_name
	  then
	    begin
	      out_boot_dir[j] := in_boot_dir[i];
	      out_lifname[j] := in_lifname[i];
	      j := j + 1 ;
	    end
	  else
	    begin
	      out_boot_dir[0] := in_boot_dir[i];
	      out_lifname[0] := in_lifname[i];
	    end;
      end ;

     out_boot_vol := in_boot_vol ;
     out_boot_vol.lifdir_start_addr := 1;
     out_boot_vol.lifdir_length := 2;

  end ;   { procedure order_boot_file }

d830 12
a841 19

  var
    i : integer;
    j : integer;
    nulterm_name, spaceterm_name : lifname;
    last_entry : integer;

  begin

    if strlen(ltitle) = 0 then
      badio ( ibadtitle );

    if ( strlen (ltitle) < 10 )
      then
	for i := (strlen(ltitle) + 1 ) to 10 do
	  strappend ( ltitle, nullstr );
    strmove ( 10, ltitle, 1, nulterm_name, 1 );
    for i:=1 to 10 do   {now build spacepadded version of ltitle as PAC SFB}
     if ltitle[i] = nullstr then
d843 1
a843 1
    strmove (10, ltitle, 1, spaceterm_name, 1);
d845 12
a856 1
    last_entry := num_boot_files - 1 ;
d858 8
a865 12
    j := 0;
    for i := 0 to 15 do
      begin
	if (in_boot_dir[i].liffile_name <> nulterm_name) and
	   (in_boot_dir[i].liffile_name <> spaceterm_name)   {SFB}
	  then
	    begin
	      out_boot_dir[j] := in_boot_dir[i];
	      out_lifname[j] := in_lifname[i];
	      j := j + 1 ;
	    end;
      end ;
d867 4
a870 10
    if last_entry >= 0
      then
	begin   {SFB}
	  out_boot_dir[last_entry] := null_dir_entry;
	  out_boot_dir[last_entry].lifstart_address := boot_fstart;     {SFB}
	  out_boot_dir[last_entry].liffile_length :=
		     (boot_size+SECTORSIZE-1) DIV SECTORSIZE;           {SFB}
     {out_boot_dir[i].lifimplement := boot_start; {replaced for 3.2E fix SFB}
	  out_boot_dir[last_entry].lifimplement := boot_start;          {SFB}
	end;
a871 6
     out_boot_vol := in_boot_vol ;
     out_boot_vol.lifdir_start_addr := 1;
     out_boot_vol.lifdir_length := 2;

  end ;   { procedure nuke_boot_file }

d873 7
d881 3
a883 4
  var
    i : integer;
    open_slot : integer;
    new_name : lifname;
d885 2
a886 1
  begin
d888 3
a890 5
    if num_boot_files >= 16
      then
	begin
	  badio ( idirfull );
	end;
d892 7
a898 4
    for i := 15 downto 0 do
      if out_boot_dir[i].liffile_type = -1
	then
	  open_slot := i;
a899 21
    if ( strlen (ltitle) < 10 )
      then
	for i := (strlen(ltitle) + 1 ) to 10 do
	  strappend ( ltitle, nullstr );
    strmove ( 10, ltitle, 1, new_name, 1 );

    for i := 0 to 15 do
      if out_boot_dir[i].liffile_name = new_name
	then
	  open_slot := i;

    with out_boot_dir[open_slot] do
      begin

	strmove ( 10, ltitle, 1, liffile_name, 1 );
	liffile_type := bootable_eft;
	dosetdate(liftoc);        {SFB}
      end;

  end ;   { procedure add_boot_file }

d901 5
d907 3
a909 1
  begin
a910 21
    filename_ok := true ;

    { must be 10 or less characters long }
    if (strlen ( ltitle ) > 10) or (strlen ( ltitle ) = 0)
      then
	filename_ok := false;

    if strpos('/', ltitle) <> 0 then
     filename_ok := false;       {SFB}

   { Removed for 3.2B SFB
    else for i := 1 to strlen(ltitle) do
      begin
	if strpos ( str(ltitle, i, 1), legal_LIF_chars) = 0
	  then
	    filename_ok := false;
      end ;
   }

  end ;    { function filename_ok }

d912 8
d921 2
a922 9
  var
    title : lifstring;
    done : boolean;
    current : integer;
    inname : string255 ;
    i : integer;
    nullpos : integer;
    a_dot_out_state : bootability;      {SFB}

d924 5
a928 5
    done := false;
    current := -1;
    good_cur := 0;
    bad_cur := 0;
    title := '';
d930 6
a935 9
    if ( strlen ( ltitle ) = 0 )
      then
	begin
	  title := in_lifname[0];
	  current := 0;
	end
      else
	begin
	  done := true;
d937 15
a951 9
	  strappend ( title, ltitle );
	  for i := 0 to 15 do
	    if title = strrtrim(in_lifname[i])  {SFB}
	      then
		current := i;
	  if current = -1
	    then
	      badio ( inofile );
	end;
d953 11
a963 4
    repeat
      { check that file type is -5822 for bootable file }
      if in_boot_dir[current].liffile_type = bootable_eft
	then
d965 3
a967 39
	  { check that a file exists in / and is a.out format }
	  inname := volid;
	  strappend (inname, '/');
	  strappend (inname, rootname(title));
	  a_dot_out_state := check_a_dot_out(inname);   {SFB}
	  if a_dot_out_state = bootable      {SFB}
	    then
	      begin
		nullpos := strpos (nullstr, title);
		if nullpos <> 0
		  then
		    setstrlen (title, (nullpos - 1));
		good_list[good_cur].name    := title;
		good_list[good_cur].problem := 'bootable';      {SFB}
		good_cur := good_cur + 1;
	      end
	    else
	     if a_dot_out_state = not_found then     {SFB}
	      begin
		nullpos := strpos ({title,} nullstr, title);    {SFB}
		if nullpos <> 0
		  then
		    setstrlen (title, (nullpos - 1));
		bad_list[bad_cur].name    := title;
		bad_list[bad_cur].problem := 'not found in '+volid+'/'; {SFB}
		bad_cur := bad_cur + 1;
	      end
	     else
	      if a_dot_out_state = not_bootable then     {SFB}
	       begin
		 nullpos := strpos ({title,} nullstr, title);    {SFB}
		 if nullpos <> 0
		   then
		     setstrlen (title, (nullpos - 1));
		 bad_list[bad_cur].name    := title;
		 bad_list[bad_cur].problem :=
		       'not bootable in '+volid+'/ (not a.out format)'; {SFB}
		 bad_cur := bad_cur + 1;
	       end;
d970 19
d990 4
a993 9
	    { not a bootable type }
	    if in_boot_dir[current].liffile_type <> -1
	      then
		begin
		  bad_list[bad_cur].name    := title;
		  bad_list[bad_cur].problem :=
				     'not a LIF bootfile (not .SYSTM)'; {SFB}
		  bad_cur := bad_cur + 1;
		end;
d995 1
d997 7
a1003 6
      current := current + 1;
      if current <= 15
	then
	  title := in_lifname[current]
	else
	  done := true;
a1004 4
    until done ;

  end ;    { procedure check_entries }

d1006 15
d1022 3
a1024 2
  const
    prompt1 = 'Volume:file to check (in boot area) ? ';
d1026 9
a1034 10
  var
    answer : string80;
    newfid : fid;
    prompt : prompttype;
    volid : vid;
    ltitle : fid;
    lkind : filekind;
    unitnum : integer;
    segs : integer;
    i : integer;
d1036 7
a1042 2
  begin
    try
d1044 1
a1044 1
    { step 1 : get unit number from user }
d1046 1
a1046 1
    writeln (clearscr);
d1048 1
a1048 3
    prompt := prompt1;
    setstrlen (newfid, 0);
    get_user_input ( prompt, answer );
d1050 1
a1050 12
    if strlen ( answer ) = 0
      then
	begin
	  { exit SFB }
	  escape(0);
	end
      else
	begin
	  zapspaces (answer);
	  strappend (newfid, answer);
	end;
    segs := 0;
d1052 1
a1052 3
    if not scantitle ( newfid, volid, ltitle, segs, lkind )
      then
	begin
d1054 3
a1056 8
	  if ( strlen ( volid ) = 0 )
	    then
	      badio ( ibadunit );
	end ;
    unitnum := findvolume (volid, true);
    if unitnum = 0 then
      badio ( inounit);
    strappend ( volid, ':' );
d1058 1
a1058 1
    { step 2 : check that the unit is HFS }
d1060 1
a1060 1
    must_be_HFS(unitnum);
d1062 5
a1066 1
    { step 3 : get the current contents of the LIF boot directory }
d1068 7
a1074 1
    get_boot_directory ( volid );
d1076 7
a1082 1
    { step 4 : check that the fields have valid entries }
d1084 7
a1090 3
    while (strlen(ltitle) > 0) and (ltitle[1] = '/') do
     {remove leading '/'s from filename for 3.2G SFB}
     ltitle := str(ltitle, 2, strlen(ltitle)-1);
a1091 39
    check_entries ( volid, ltitle );

    { step 5 : report status of check to the user }

    if ( good_cur = 0 ) and ( bad_cur = 0 )
      then
	begin
	  writeln;
	  writeln ('No entries in LIF boot directory.');
	end;

    if good_cur > 0
      then
	begin
	  writeln;
	  for i := 0 to (good_cur -1) do
	    with good_list[i] do
	      writeln ( name, strrpt(' ',12-strlen(name)), problem );
	end;

    if bad_cur > 0
      then
	begin
	  writeln;
	  for i := 0 to (bad_cur -1) do
	    with bad_list[i] do
	      writeln ( name, strrpt(' ',12-strlen(name)), problem );
	end;

    recover
      begin
	printioerrmsg ;
	if escapecode <> 0
	  then
	    escape (escapecode);
      end;

  end ;  { procedure check }

d1093 16
d1110 3
a1112 2
  const
    prompt1 = 'Volume:file to install (from root directory on HFS) ? ';
d1114 9
a1122 11
  var
    answer : string80;
    newfid : fid;
    prompt : prompttype;
    volid : vid;
    ltitle : fid;
    lkind : filekind;
    unitnum : integer;
    segs : integer;
    i : integer;
    inname : string255;
d1124 6
a1129 2
  begin
    try
d1131 1
a1131 1
    { step 1 : get unit number and file from user }
d1133 2
a1134 1
    writeln (clearscr);
d1136 1
a1136 3
    prompt := prompt1;
    setstrlen (newfid, 0);
    get_user_input ( prompt, answer );
d1138 1
a1138 12
    if strlen ( answer ) = 0
      then
	begin
	  { not an error, but abort }
	  escape(0);
	end
      else
	begin
	  zapspaces (answer);
	  strappend (newfid, answer);
	end;
    segs := 0;
d1140 1
a1140 3
    if not scantitle ( newfid, volid, ltitle, segs, lkind )
      then
	begin
d1142 3
a1144 6
	  badio ( ibadtitle );
	end ;
    unitnum := findvolume (volid, true);
    if unitnum = 0 then
      badio ( ibadtitle);
    strappend ( volid, ':' );
d1146 2
a1147 1
    { step 2 : check that the unit is HFS and pointed at root directory }
d1149 6
a1154 1
    must_be_HFS(unitnum);
d1156 2
a1157 1
    must_be_rootdir(unitnum);
d1159 1
a1159 1
    { step 3 : get the current contents of the LIF boot directory }
d1161 3
a1163 1
    get_boot_directory ( volid );
d1165 2
a1166 1
    { step 4 : convert file in / to a.out format }
d1168 7
a1174 3
    while (strlen(ltitle) > 0) and (ltitle[1] = '/') do
     {remove leading '/'s from filename for 3.2G SFB}
     ltitle := str(ltitle, 2, strlen(ltitle)-1);
a1175 42
    if not filename_ok ( ltitle )
      then
	begin
	  badio ( ibadtitle );
	end ;

    inname := volid+rootname(ltitle);
    {
    if not file_exists(inname) then
       badio ( inofile );
    }

    case file_type(inname) of   {SFB}
     no_file:      badio(inofile);
     special_file: badio(ibadfiletype);
     regular_file: {no action now};
    end; {case}

    if not (check_a_dot_out ( inname ) = bootable)      {SFB}
      then
	make_a_dot_out (inname, inname );

    { step 5 : set up boot directory }

    dup_boot_dir;
    add_boot_file ( ltitle );

    put_boot_directory ( volid );

    writeln;
    writeln (volid,ltitle,' installed');

    recover
      begin
	printioerrmsg ;
	if escapecode <> 0
	  then
	    escape (escapecode);
      end;

  end ;  { procedure install }

d1177 17
d1195 3
a1197 2
  const
    prompt1 = 'Volume:file to move to first position (in boot area) ? ';
d1199 9
a1207 12
  var
    answer : string80;
    ans : char;
    newfid : fid;
    prompt : prompttype;
    volid : vid;
    ltitle : fid;
    lkind : filekind;
    unitnum : integer;
    segs : integer;
    i : integer;
    inname : string255;
d1209 2
a1210 2
  begin
    try
d1212 4
a1215 1
    { step 1 : get unit number and file from user }
d1217 1
a1217 1
    writeln (clearscr);
d1219 2
a1220 3
    prompt := prompt1;
    setstrlen (newfid, 0);
    get_user_input ( prompt, answer );
d1222 1
a1222 12
    if strlen ( answer ) = 0
      then
	begin
	  { not an error, but abort }
	  escape(0);
	end
      else
	begin
	  zapspaces (answer);
	  strappend (newfid, answer);
	end;
    segs := 0;
d1224 1
a1224 9
    if not scantitle ( newfid, volid, ltitle, segs, lkind )
      then
	begin
	  badio ( ibadtitle );
	end ;
    unitnum := findvolume (volid, true);
    if unitnum = 0 then
      badio ( inounit );
    strappend ( volid, ':' );
d1226 1
a1226 1
    { step 2 : check that the unit is HFS and pointed at root directory }
d1228 3
a1230 1
    must_be_HFS(unitnum);
d1232 2
a1233 1
    must_be_rootdir(unitnum);
d1235 3
a1237 1
    { step 3 : get the current contents of the LIF boot directory }
d1239 1
a1239 1
    get_boot_directory ( volid );
d1241 5
a1245 1
    { step 4 : check files }
d1247 2
a1248 3
    while (strlen(ltitle) > 0) and (ltitle[1] = '/') do
     {remove leading '/'s from filename for 3.2G SFB}
     ltitle := str(ltitle, 2, strlen(ltitle)-1);
d1250 7
a1256 2
    if ltitle = '' then
      badio ( ibadtitle );
a1257 31
    check_entries ( volid, ltitle );

    if bad_cur > 0
      then
	begin
	  { badio ( ibadfiletype ); }
	end ;

    { step 5 : set up boot directory }

    if num_boot_files > 1
      then
	begin
	  order_boot_file ( ltitle );
	  put_boot_directory ( volid );
	end;

    writeln;
    writeln (ltitle, ' now in first directory position.');

    recover
      begin
	printioerrmsg ;
	if escapecode <> 0
	  then
	    escape (escapecode);
      end;


  end ;  { procedure order }

d1259 17
d1277 3
a1279 2
  const
    prompt1 = 'Volume:file to remove (from boot area) ? ';
d1281 9
a1289 12
  var
    answer : string80;
    ans : char;
    newfid : fid;
    prompt : prompttype;
    volid : vid;
    ltitle : fid;
    lkind : filekind;
    unitnum : integer;
    segs : integer;
    i : integer;
    inname : string255;
d1291 8
a1298 2
  begin
    try
d1300 1
a1300 1
    { step 1 : get unit number and file from user }
d1302 2
a1303 1
    writeln (clearscr);
d1305 1
a1305 3
    prompt := prompt1;
    setstrlen (newfid, 0);
    get_user_input ( prompt, answer );
d1307 1
a1307 12
    if strlen ( answer ) = 0
      then
	begin
	  { not an error, but abort }
	  escape(0);
	end
      else
	begin
	  zapspaces (answer);
	  strappend (newfid, answer);
	end;
    segs := 0;
d1309 1
a1309 9
    if not scantitle ( newfid, volid, ltitle, segs, lkind )
      then
	begin
	  badio ( ibadtitle );
	end ;
    unitnum := findvolume (volid, true);
    if unitnum = 0 then
      badio ( inounit);
    strappend ( volid, ':' );
d1311 3
a1313 1
    { step 2 : check that the unit is HFS and pointed at root directory }
d1315 9
a1323 1
    must_be_HFS(unitnum);
d1325 1
a1325 1
    must_be_rootdir(unitnum);
d1327 2
a1328 1
    { step 3 : get the current contents of the LIF boot directory }
d1330 2
a1331 1
    get_boot_directory ( volid );
d1333 7
a1339 1
    { step 4 : check files }
a1340 37
    while (strlen(ltitle) > 0) and (ltitle[1] = '/') do
     {remove leading '/'s from filename for 3.2G SFB}
     ltitle := str(ltitle, 2, strlen(ltitle)-1);

    check_entries ( volid, ltitle );

    if num_boot_files = 1
      then
	begin
	  writeln;
	  writeln('This will remove last bootable file.');
	  promptread ( confirm, ans, 'YN', 'N' );
	  if ans <> 'Y'
	    then
	      escape (0);
	end;

    { step 5 : set up boot directory }

    nuke_boot_file ( ltitle );
    put_boot_directory ( volid );

    writeln;
    writeln (ltitle, ' removed from LIF boot directory.');

    recover
      begin

	printioerrmsg ;
	if escapecode <> 0
	  then
	    escape (escapecode);
      end;


  end ;  { procedure remove }

d1342 17
d1360 4
a1363 2
  const
    prompt1 = 'Volume (boot area) to zero ? ';
d1365 9
a1373 12
  var
    answer : string80;
    ans : char;
    newfid : fid;
    prompt : prompttype;
    volid : vid;
    ltitle : fid;
    lkind : filekind;
    unitnum : integer;
    segs : integer;
    i : integer;
    inname : string255;
d1375 4
a1378 2
  begin
    try
d1380 4
a1383 1
    { step 1 : get unit number and file from user }
d1385 1
a1385 2
    writeln (clearscr);
    writeln (homechar);
d1387 1
a1387 3
    prompt := prompt1;
    setstrlen (newfid, 0);
    get_user_input ( prompt, answer );
d1389 1
a1389 12
    if strlen ( answer ) = 0
      then
	begin
	  { not an error, but abort }
	  escape(0);
	end
      else
	begin
	  zapspaces (answer);
	  strappend (newfid, answer);
	end;
    segs := 0;
d1391 8
a1398 10
    if not scantitle ( newfid, volid, ltitle, segs, lkind )
      then
	begin
	  badio ( ibadtitle );
	end ;
    if strlen ( ltitle ) <> 0
      then
	begin
	  badio (ibadtitle);
	end ;
d1400 1
a1400 4
    unitnum := findvolume (volid, true);
    if unitnum = 0 then
      badio ( ibadtitle);
    strappend ( volid, ':' );
d1402 1
a1402 1
    { step 2 : check that the unit is HFS and pointed at root directory }
d1404 2
a1405 1
    must_be_HFS(unitnum);
d1407 7
a1413 1
    { step 3 : get the current contents of the LIF boot directory }
a1414 27
    for i := 0 to 15 do
     begin      {SFB}
      out_boot_dir[i] := null_dir_entry;
      out_boot_dir[i].lifstart_address := boot_fstart;  {SFB}
      out_boot_dir[i].liffile_length :=
	       (boot_size+SECTORSIZE-1) DIV SECTORSIZE; {SFB}
      out_boot_dir[i].lifimplement := boot_start;       {SFB}
     end;

    { step 4 : set up boot directory }

    write_lif_header ( volid );

    writeln;
    writeln ('Volume ',volid,' LIF boot directory zeroed.');

    recover
      begin
	printioerrmsg ;
	if escapecode <> 0
	  then
	    escape (escapecode);
      end;


  end ;  { procedure zero }

d1416 1
a1416 2
 {we make this a procedure to save global space SFB 3-30-87}

a1417 1

a1426 1

a1431 1

d1436 1
a1436 1
 end; {procedure do_osinstall}
d1439 2
a1440 2
 do_osinstall;
end.     { program osinstall }
@


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


26.3
log
@
Comment from auto synch of clock fix:
date: 88/03/02 17:40:33;  author: quist;  state: Exp;  lines added/del: 2/1
SYSDATE fixes, RDQ
@
text
@@


26.2
log
@
Comment from auto synch of clock fix:
date: 88/03/02 09:18:24;  author: bayes;  state: Exp;  lines added/del: 0/0
Automatic bump of revision number for PWS version 3.2Y
@
text
@d552 2
a553 1
     adate[1]  := year div 10;    adate[2]    := year mod 10;
@


26.1
log
@Automatic bump of revision number for PWS version 3.3 Synch
@
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.3
log
@Fixed typo on $SEARCH declaration
@
text
@@


13.2
log
@Fixed "/SYSTEM_P" bug, corrected trailing '/'s in filename,
removed all debugging code (most was unusable, and some was compiled
into product object, though inaccessible), reduced globals from
~14K to 0 bytes. See TURNEM for related fixes at link time.
@
text
@a9 1
{
d12 1
@


13.1
log
@Automatic bump of revision number for PWS version 3.2F
@
text
@d10 1
a12 1
{
a34 8
  debug = FALSE;
  debug1 = FALSE;

  {
  debug = TRUE;
  debug1 = TRUE;
  }

d177 1
d179 4
a187 1
  keyboard : text;
a205 80
procedure debug_print_vol ;

  begin
    with in_boot_vol do
      begin
	writeln ('in_boot_vol: ');
	writeln ('    lifid             : ', lifid );
	writeln ('    lifvol_label      : ', lifvol_label );
	writeln ('    lifdir_start_addr : ', lifdir_start_addr );
	writeln ('    lifoct_10000      : ', lifoct_10000 );
	writeln ('    lifdummy          : ', lifdummy );
	writeln ('    lifdir_length     : ', lifdir_length );
	writeln ('    lifversion        : ', lifversion );
	writeln ('    lifzero           : ', lifzero );
	writeln ;
	readln;
      end;

    with out_boot_vol do
      begin
	writeln ('out_boot_vol: ');
	writeln ('    lifid             : ', lifid );
	writeln ('    lifvol_label      : ', lifvol_label );
	writeln ('    lifdir_start_addr : ', lifdir_start_addr );
	writeln ('    lifoct_10000      : ', lifoct_10000 );
	writeln ('    lifdummy          : ', lifdummy );
	writeln ('    lifdir_length     : ', lifdir_length );
	writeln ('    lifversion        : ', lifversion );
	writeln ('    lifzero           : ', lifzero );
	writeln ;
	readln;
      end;
  end ;    { procedure debug_print_vol }

procedure debug_print_dir ;

  var
    i, j : integer;

  begin
    writeln ('in_boot_dir: ');
    for i := 0 to 15 do
      with in_boot_dir[i] do
	begin
	  writeln ('  entry : ', i );
	  writeln ('    liffile_name     : ', liffile_name );
	  writeln ('    liffile_type     : ', liffile_type );
	  writeln ('    lifstart_address : ', lifstart_address );
	  writeln ('    liffile_length   : ', liffile_length );
	  write   ('    liftoc           : ' );
	  for j := 1 to 12 do write ( liftoc[j]:2, ', ' );
	  writeln ;
	  writeln ('    lifl_flag        : ', lifl_flag );
	  writeln ('    lifvol_number    : ', lifvol_number );
	  writeln ('    lifimplement     : ', lifimplement );
	  readln;
	end;
    writeln;

    writeln ('out_boot_dir: ');
    for i := 0 to 15 do
      with out_boot_dir[i] do
	begin
	  writeln ('  entry : ', i );
	  writeln ('    liffile_name     : ', liffile_name );
	  writeln ('    liffile_type     : ', liffile_type );
	  writeln ('    lifstart_address : ', lifstart_address );
	  writeln ('    liffile_length   : ', liffile_length );
	  write   ('    liftoc           : ' );
	  for j := 1 to 12 do write ( liftoc[j]:2, ', ' );
	  writeln ;
	  writeln ('    lifl_flag        : ', lifl_flag );
	  writeln ('    lifvol_number    : ', lifvol_number );
	  writeln ('    lifimplement     : ', lifimplement );
	  readln;
	end;
    writeln;

  end ;    { procedure debug_print_dir }

a342 3
$if debug$
writeln ('DEBUG: open_unit: start');
$end$
a351 6
$if debug1$
writeln('DEBUG : setupfib: before open_unit dam call');
writeln ('DEBUG: setupfib: ftitle = ', ftitle);
writeln ('DEBUG: setupfib: uisblkd = ', unitable^[funit].uisblkd);
$end$

a354 5
$if debug1$
writeln('DEBUG : setupfib: before open_unit dam call');
writeln ('DEBUG: setupfib: fbuffered = ', fbuffered);
writeln ('DEBUG: setupfib: fistestvar = ', fistextvar);
$end$
a369 8

$if debug1$
writeln ('DEBUG: open_unit: after dam openunit, after fill fields');
writeln ('DEBUG: open_unit: freadable = ', filedes.f_ptr^.freadable );
writeln ('DEBUG: open_unit: fwriteable = ', filedes.f_ptr^.fwriteable );
readln;
$end$

a372 4
$if debug$
writeln ('DEBUG: open_unit: end');
$end$

a469 4
$if debug$
writeln ('DEBUG: make_a_dot_out: start');
$end$

a540 5
$if debug$
writeln ('DEBUG: make_a_dot_out: end');
$end$


a590 4
$if debug$
writeln ('DEBUG: get_boot_directory: start');
$end$

a610 10
$if debug1$
old_ioresult := ioresult;
writeln ('DEBUG: get_boot_directory: before 1st freadbytes');
writeln ('DEBUG: get_boot_directory: ioresult = ', old_ioresult );
writeln ('DEBUG: get_boot_directory: freadable = ', filedes.f_ptr^.freadable );
writeln ('DEBUG: get_boot_directory: fwriteable = ', filedes.f_ptr^.fwriteable );
writeln ('DEBUG: get_boot_directory: flocked = ', filedes.f_ptr^.flocked );
readln;
$end$

a614 7
$if debug$
old_ioresult := ioresult;
writeln ('DEBUG: get_boot_directory: after 1st freadbytes');
writeln ('DEBUG: get_boot_directory: ioresult = ', old_ioresult );
readln;
$end$

a616 4
$if debug1$
writeln ('DEBUG: get_boot_directory: after 1st freadbytes & goodio');
$end$

a654 4
$if debug$
writeln ('DEBUG: get_boot_directory: end  ');
$end$

a674 4
$if debug$
writeln ('DEBUG: put_boot_directory: start');
$end$

a679 10
$if debug1$
old_ioresult := ioresult;
writeln ('DEBUG: put_boot_directory: before 1st fwritebytes');
writeln ('DEBUG: put_boot_directory: ioresult = ', old_ioresult );
writeln ('DEBUG: put_boot_directory: freadable = ', filedes.f_ptr^.freadable );
writeln ('DEBUG: put_boot_directory: fwriteable = ', filedes.f_ptr^.fwriteable );
writeln ('DEBUG: put_boot_directory: flocked = ', filedes.f_ptr^.flocked );
readln;
$end$

a683 7
$if debug$
old_ioresult := ioresult;
writeln ('DEBUG: put_boot_directory: after 1st fwritebytes');
writeln ('DEBUG: put_boot_directory: ioresult = ', old_ioresult );
readln;
$end$

a685 4
$if debug1$
writeln ('DEBUG: put_boot_directory: after 1st fwritebytes & goodio');
$end$

a698 4
$if debug$
writeln ('DEBUG: put_boot_directory: end  ');
$end$

a832 4
$if debug$
writeln ('DEBUG: check_a_dot_out: start');
$end$

a843 4
$if debug$
writeln ('DEBUG: check_a_dot_out: end  ');
$end$

a844 5
$if debug$
old_ioresult := ioresult;
writeln ('DEBUG: check_a_dot_out recover block');
writeln ('DEBUG: check_a_dot_out: io_result = ', old_ioresult);
$end$
a946 2
{ writeln('nul ',nulterm_name,'-  space ',spaceterm_name,'-');}

a987 6
$if debug$
writeln;
writeln ('DEBUG: add_boot_file: start');
debug_print_dir;
$end$

a1012 11
$if debug$
writeln;
writeln ('DEBUG: add_boot_file: ******************');
writeln;
writeln ('DEBUG: add_boot_file: fill open_slot');
writeln ('DEBUG: add_boot_file: ltitle = ', ltitle);
writeln ('DEBUG: add_boot_file: strlen ltitle = ', strlen(ltitle));
writeln ('DEBUG: add_boot_file: open_slot = ', open_slot);
readln;
$end$

a1017 6
$if debug$
writeln ('DEBUG: add_boot_file: end  ');
writeln ('DEBUG: add_boot_file: open_slot = ', open_slot);
debug_print_dir;
$end$

d1029 1
a1029 1
	filename_ok := false
d1031 3
a1062 5
$if debug$
debug_print_vol;
debug_print_dir;
$end$

a1077 17
$if debug$
writeln;
writeln ('DEBUG: check_entries: after searching for single name match ');
writeln ('DEBUG: check_entries: current = ', current);
writeln ('DEBUG: check_entries: title = ', title);
for i := 0 to 15 do
writeln ('DEBUG: check_entries: in_lifname[',i:2,']  = ', in_lifname[i]);
readln;
$end$

{
for i:=0 to 15 do
 begin
  writeln(strlen(in_lifname[i]):3,'  ',in_lifname[i]);
 end;
writeln('current in check_entries ',current:1);
}
a1178 6
$if debug$
writeln ('DEBUG: check step 1: after get_user_input');
writeln ('DEBUG: check step 1: answer = ', answer);
readln ;
$end$

a1191 6
$if debug$
writeln ('DEBUG: check step 1: before scantitle');
writeln ('DEBUG: check step 1: newfid = ', newfid);
readln ;
$end$

a1195 8
$if debug1$
writeln ('DEBUG: check step 1: after scantitle FALSE return');
writeln ('DEBUG: check step 1: newfid = ', newfid);
writeln ('DEBUG: check step 1: volid  = ', volid );
writeln ('DEBUG: check step 1: ltitle = ', ltitle);
readln ;
$end$

a1206 4
$if debug$
writeln ('DEBUG: check step 2: start');
$end$

a1210 4
$if debug$
writeln ('DEBUG: check step 3: get_boot_directory: start');
$end$

d1215 3
a1217 3
$if debug$
writeln ('DEBUG: check step 4: check_entries: start');
$end$
a1249 4
$if debug$
writeln ('DEBUG: check recover block');
$end$

a1285 6
$if debug$
writeln ('DEBUG: install step 1: after get_user_input');
writeln ('DEBUG: install step 1: answer = ', answer);
readln ;
$end$

a1298 6
$if debug$
writeln ('DEBUG: install step 1: before scantitle');
writeln ('DEBUG: install step 1: newfid = ', newfid);
readln ;
$end$

a1302 8
$if debug1$
writeln ('DEBUG: install step 1: after scantitle FALSE return');
writeln ('DEBUG: install step 1: newfid = ', newfid);
writeln ('DEBUG: install step 1: volid  = ', volid );
writeln ('DEBUG: install step 1: ltitle = ', ltitle);
readln ;
$end$

a1311 4
$if debug$
writeln ('DEBUG: install step 2');
$end$

a1317 4
$if debug$
writeln ('DEBUG: install step 3: get_boot_directory');
$end$

d1322 4
a1359 4
$if debug$
writeln ('DEBUG: install recover block ');
$end$

a1396 6
$if debug$
writeln ('DEBUG: order step 1: after get_user_input');
writeln ('DEBUG: order step 1: answer = ', answer);
readln ;
$end$

a1409 6
$if debug$
writeln ('DEBUG: order step 1: before scantitle');
writeln ('DEBUG: order step 1: newfid = ', newfid);
readln ;
$end$

a1412 9

$if debug1$
writeln ('DEBUG: order step 1: after scantitle FALSE return');
writeln ('DEBUG: order step 1: newfid = ', newfid);
writeln ('DEBUG: order step 1: volid  = ', volid );
writeln ('DEBUG: order step 1: ltitle = ', ltitle);
readln ;
$end$

a1421 4
$if debug$
writeln ('DEBUG: order step 2');
$end$

a1427 4
$if debug$
writeln ('DEBUG: order step 3: get_boot_directory');
$end$

d1432 4
a1460 4
$if debug$
writeln ('DEBUG: order recover block ');
$end$

a1498 6
$if debug$
writeln ('DEBUG: remove step 1: after get_user_input');
writeln ('DEBUG: remove step 1: answer = ', answer);
readln ;
$end$

a1511 6
$if debug$
writeln ('DEBUG: remove step 1: before scantitle');
writeln ('DEBUG: remove step 1: newfid = ', newfid);
readln ;
$end$

a1514 9

$if debug1$
writeln ('DEBUG: remove step 1: after scantitle FALSE return');
writeln ('DEBUG: remove step 1: newfid = ', newfid);
writeln ('DEBUG: remove step 1: volid  = ', volid );
writeln ('DEBUG: remove step 1: ltitle = ', ltitle);
readln ;
$end$

a1523 4
$if debug$
writeln ('DEBUG: remove step 2');
$end$

a1529 6
$if debug$
writeln ('DEBUG: remove step 3: get_boot_directory');
$end$

{ writeln('volid ',volid, '  ltitle ',ltitle);}

d1534 3
a1536 1
{writeln('call check_entries in remove ',volid,ltitle);}
a1539 2
{writeln('done check_entries in remove, num_bootfiles ',num_boot_files:1);}

a1553 3
$if debug$
debug_print_dir;
$end$
a1560 3
$if debug$
writeln ('DEBUG: remove recover block ');
$end$
a1600 6
$if debug$
writeln ('DEBUG: zero step 1: after get_user_input');
writeln ('DEBUG: zero step 1: answer = ', answer);
readln ;
$end$

a1613 6
$if debug$
writeln ('DEBUG: zero step 1: before scantitle');
writeln ('DEBUG: zero step 1: newfid = ', newfid);
readln ;
$end$

a1616 9

$if debug1$
writeln ('DEBUG: zero step 1: after scantitle FALSE return');
writeln ('DEBUG: zero step 1: newfid = ', newfid);
writeln ('DEBUG: zero step 1: volid  = ', volid );
writeln ('DEBUG: zero step 1: ltitle = ', ltitle);
readln ;
$end$

a1631 4
$if debug$
writeln ('DEBUG: zero step 2');
$end$

a1635 4
$if debug$
writeln ('DEBUG: zero step 3: get_boot_directory');
$end$

a1653 4
$if debug$
writeln ('DEBUG: zero recover block ');
$end$

d1663 2
a1664 1
begin    { program osinstall }
d1688 1
d1690 2
@


12.2
log
@Did fix on index i --> last_entry in nuke_boot_file, for bug #1003 (dup
of #958). Did not do compile and functional before newci. Trivial.
@
text
@@


12.1
log
@Automatic bump of revision number for PWS version 3.2E
@
text
@d1161 2
a1162 1
	  out_boot_dir[i].lifimplement := boot_start;                   {SFB}
@


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


10.5
log
@Corrected $SEARCH directive.
@
text
@@


10.4
log
@Parameterized booter file info via BOOTASM defs (size, start, fstart)
@
text
@a9 1
{
d12 1
@


10.3
log
@Added bootasm_fstart references. Still needs HPUX 5.2 booter.
@
text
@d178 1
a178 1
		   liffile_length   : 21,
d182 1
a182 1
		   lifimplement     : -63488 ];
d722 6
d1159 3
d2028 3
@


10.2
log
@Fix to remove debugging output from real 3.2C version (which is 10.2)
@
text
@d10 1
a12 1
{
d16 1
d86 4
a89 1
		     filler            : packed array[1..110] of shortint; {SFB}
d177 1
a177 1
		   lifstart_address : 3,
d188 1
d207 1
d209 1
a425 3
  var
    tempfib : fibp;

d662 19
d720 2
d922 3
a924 2
	lifspt := 8192 div 256;   {SFB}
	for i:=1 to 110 do      {SFB}
d926 1
d1150 4
a1153 1
	out_boot_dir[last_entry] := null_dir_entry;
d1214 1
d2016 1
d2018 2
@


10.1
log
@Automatic bump of revision number for PWS version 3.2C
@
text
@a875 1
	lifvol_label := 'BOOT  ';
d880 2
d883 1
a883 1
	    lifvol_label[5] := chr(ord('0') + nameunit)
d885 2
a886 2
	    lifvol_label[5] := chr(ord('0') + nameunit div 10);
	    lifvol_label[6] := chr(ord('0') + nameunit mod 10);
d888 1
d1104 1
a1104 1
writeln('nul ',nulterm_name,'-  space ',spaceterm_name,'-');
d1263 2
d1270 1
d1841 1
a1841 1
writeln('volid ',volid, '  ltitle ',ltitle);
d1847 1
a1847 1
writeln('call check_entries in remove ',volid,ltitle);
d1851 1
a1851 1
writeln('done check_entries in remove, num_bootfiles ',num_boot_files:1);
@


9.3
log
@Minor bugfixes and HI changes. Matches in H/I, but not all error handlin
is correct
@
text
@@


9.2
log
@Almost final rev. Prompt changes, error handling fixes.
@
text
@d58 1
a58 1
  lifstring = string[255];      {SFB}
d66 2
d82 4
a85 1
		     filler            : packed array[1..116] of shortint;
d893 4
a896 1
	for i:=1 to 167 do      {SFB}
d966 1
a966 1
function check_a_dot_out ( inname : string255 ) : boolean;
d979 1
a979 1
    check_a_dot_out := false;
d983 1
d987 1
a987 1
	  check_a_dot_out := true;
d1084 1
a1084 1
    new_name : lifname;
d1096 5
a1100 1
    strmove ( 10, ltitle, 1, new_name, 1 );
d1102 2
d1109 2
a1110 1
	if in_boot_dir[i].liffile_name <> new_name
d1223 1
d1249 1
a1249 1
	    if title = in_lifname[i]
d1261 5
d1280 2
a1281 1
	  if check_a_dot_out ( inname )
d1289 1
a1289 1
		good_list[good_cur].problem := 'bootable';
d1293 1
d1300 1
a1300 1
		bad_list[bad_cur].problem := 'no file in / in bootable format';
d1302 13
a1314 1
	      end;
d1323 2
a1324 1
		  bad_list[bad_cur].problem := 'not a bootable type';
d1588 1
a1588 1
    if not check_a_dot_out ( inname )
d1836 2
d1842 2
d1846 2
d2007 1
@


9.1
log
@Automatic bump of revision number for PWS version 3.2B
@
text
@d23 3
d58 1
a58 1
  lifstring = string[10];
d80 1
d339 1
a339 1
      writeln('That unit must be prefixed to /.');
d580 1
a580 1
	     writeln('Operation not allowed on directory');
d833 2
d888 2
d985 1
a985 1
    recover escape(0);  {fixed SFB}
d1261 1
a1261 1
		nullpos := strpos (title, nullstr);  {reversed  SFB }
d1271 1
a1271 1
		nullpos := strpos (title, nullstr);
d1306 1
a1306 1
    prompt1 = 'Volume[:file] to check (in boot area) ? ';
d1546 3
a1548 3
     no_file: badio(inofile);
     special_file:badio(ibadfiletype);
     regular_file:{no action now};
d1563 1
a1563 1
    writeln (ltitle,' installed');
d1680 1
a1680 1
	  badio ( inofile );
d1809 1
a1809 1
	  write ('Remove last bootable file ');
d1964 3
@


8.3
log
@Pws2unix automatic delta on Fri Dec 12 09:42:40 MST 1986
@
text
@@


8.2
log
@ll RCs
(ignore above line). Prompts changed (shortened), some error handling/reporting
fixed up.
@
text
@a9 1
{
d12 1
@


8.1
log
@Manual bump of revision number to 8.1 for 3.2A
@
text
@d10 1
d13 1
a13 1
{ $search 'MATCHSTR'$ } { stand alone test search }
d19 1
a19 2
	matchstr,
	sysdevs;
d28 1
a28 1
  sh_exc = chr(27);
d30 1
d33 6
d61 2
a63 6
		  fd       : 0..63;
		  in_use   : boolean;
		  is_unit1 : boolean;
		  is_unit2 : boolean;
		  is_unit6 : boolean;
		  use4,use5, use6, use7 : boolean;
d118 1
a118 1
		      text      : integer;
d134 2
a135 2
		 name : lifstring;
		 prob : string80;
d147 1
a147 1
		     text    : 0,
a176 1
  esckey : string[6];
d322 1
a322 1
      writeln('HFS_DAM is not installed.');
d326 1
a326 1
      writeln('That is not an HFS unit.');
d341 1
a411 1
    fd : integer;
a421 1
    fd := 0;
d445 3
a447 4
	    case ioresult of
	      ord(znotready) : badio ( znotready );
	      otherwise badio ( ibadunit );
	    end
a452 2
	      filedes.fd := fd;
	      filedes.in_use := true;
a454 3
	      filedes.is_unit1 := false;
	      filedes.is_unit2 := false;
	      filedes.is_unit6 := false;
a487 6
procedure showprompt ( p : prompttype );

  begin
    write (homechar,p,cteol);
  end;   { procedure showprompt }

d492 1
a492 1
    showprompt (pl);
d495 1
a495 1
    if ch = sh_exc
d516 1
a516 1
    if (default<>sh_exc) and streaming then answer:=default
d523 1
a523 1
	if answer=sh_exc then  begin writeln; badio(inoerror); end;
d572 8
a579 1
    reset(sizefile, inname);
d590 3
a592 3
	read(sizefile, text);        {dummy read}
	read(sizefile, text);
	text := text - 8;            {remove first 8 bytes of boot format}
d691 1
a691 2
    path := '';
    strappend ( path, volid ) ;
d789 1
a789 2
    path := '';
    strappend ( path, volid ) ;
d856 1
a856 2
    path := '';
    strappend ( path, volid ) ;
d908 1
d922 1
d924 17
d977 1
a977 1
    recover
a1169 5
  const
    legal_LIF_chars = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890_';
  var
    i : integer;

d1179 1
d1186 1
d1238 1
a1238 1
	      badio ( ibadtitle );
d1253 1
a1253 1
		nullpos := strpos (nullstr, title);
d1257 2
a1258 2
		good_list[good_cur].name := title;
		good_list[good_cur].prob := 'OK';
d1267 2
a1268 2
		bad_list[bad_cur].name := title;
		bad_list[bad_cur].prob := 'No file in / in bootable format';
d1278 2
a1279 2
		  bad_list[bad_cur].name := title;
		  bad_list[bad_cur].prob := 'not a bootable type';
d1298 1
a1298 1
    prompt1 = 'Volume [:file] to check ? ';
a1316 10
    writeln (homechar);
    writeln;
    writeln ('This option checks the consistency of the boot directory ');
    writeln ('and boot files. ');
    writeln;
    writeln ('A typical response of "#43:SYSTEM_P" will check the boot');
    writeln ('file "SYSTEM_P" on volume "#43".');
    writeln ('Pressing only the Return key, will check all boot files');
    writeln ('on the default volume.');
    writeln;
d1331 2
a1332 2
	  { use current default volume }
	  newfid := dkvid;
d1365 1
a1365 1
      badio ( ibadtitle);
d1407 1
a1407 1
	      writeln ( name, ' ', prob );
d1416 1
a1416 1
	      writeln ( name, ' ', prob );
d1436 1
a1436 1
    prompt1 = 'Volume and file to install ? ';
a1455 10
    writeln (homechar);
    writeln;
    writeln ('This option installs a file as a bootable file on an HFS disc.');
    writeln;
    writeln ('Typical input is "#43:SYSTEM_D".');
    writeln ('This command assumes that a file called "SYSTEM_D" is');
    writeln ('currently in the root directory of volume #43 and that ');
    writeln ('this file is a "SYSTM" file.  This file will be');
    writeln ('overwritten by the bootable file.');
    writeln;
d1532 1
d1535 1
d1537 6
d1574 1
a1574 1
    prompt1 = 'Volume and file to move to first position ? ';
a1594 8
    writeln (homechar);
    writeln;
    writeln ('This option reorders the bootable files on an HFS disc.');
    writeln;
    writeln ('Typical input is "#43:SYSTEM_D".');
    writeln ('SYSTEM_D will become the first file in the LIF');
    writeln ('boot directory.');
    writeln;
d1641 1
a1641 1
      badio ( ibadtitle);
d1672 1
a1672 1
	  badio ( ibadtitle );
d1705 1
a1705 1
    prompt1 = 'Volume and file to remove ? ';
a1725 7
    writeln (homechar);
    writeln;
    writeln ('This option removes a bootable file from an HFS disc.');
    writeln;
    writeln ('Typical input is "#43:SYSTEM_D".');
    writeln ('Only the LIF boot directory entry is affected.');
    writeln;
d1772 1
a1772 1
      badio ( ibadtitle);
d1801 1
a1801 4
	  writeln ('This will remove the last bootable file from the');
	  writeln ('directory. This means that you will not be able to');
	  writeln ('boot from this device unless you install a boot file.');
	  writeln;
d1837 1
a1837 1
    prompt1 = 'Volume to zero ? ';
a1858 5
    writeln;
    writeln ('This option zeros the LIF boot volume of an HFS disc.');
    writeln;
    writeln ('Typical input is "#43".');
    writeln;
a1955 5
  if kbdtype = itfkbd
    then
      esckey := 'esc'
    else
      esckey := 'sh_esc';
@


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.3
log
@the link command and the routines that it exclusively uses removed
@
text
@@


5.2
log
@zero command installed, lots of little bug fixes, link bug fix, compiled
and tested by hal & dan before check-in, debug turned off
@
text
@a2 1
{HAL}
d10 1
a10 1
$search 'PROGS:MATCHSTR'$
d12 2
d23 1
a23 2
  {HAL}
  cmd_prompt = 'OSINSTALL: Check Install Link Order Remove Quit Zero ?' ;
d30 1
a30 1
  debug = FALSE; {HAL}
a32 1
  {HAL}
a315 1
{HAL}
a328 1
{HAL}
a560 165
function get_2_names ( var answer : string80;
		       var second_name : string80 ) : boolean;

  var
    comma_pos : integer;
    answer_len : integer;

  begin

    get_2_names := false;
    setstrlen ( second_name, 0 );

    comma_pos := strpos ( ',', answer );

    if comma_pos > 0
      then
	begin
	  answer_len := strlen ( answer );
	  second_name := str ( answer, (comma_pos + 1), ( answer_len - comma_pos));
	  setstrlen ( answer, (comma_pos - 1));
	  get_2_names := true;
	end
      else
	begin
	end ;

  end ;   { function get_2_names }

procedure setupfibforfile( var lfib : fib;
			   volid : vid;
			   ltitle : fid;
			   segs : integer;
			   lkind : filekind);
begin
  with lfib do
    begin
      {HAL2}
      { peel ':' off volid }
      volid      := str(volid, 1, strlen(volid)-1);
      fvid       := volid;
      ftitle     := ltitle;
      funit      := findvolume(fvid,true);
      {HAL2}
      if funit = 0 then
	badio ( ilostunit );
      fkind      := lkind;
      feft := efttable^[lkind];
      foptstring := nil;
      fbuffered  := true;
      fpos       := segs * 512;
      freptcnt   := 0;
      fanonymous := false;
      fmodified  := false;
      fbufchanged:= false;
      fstartaddress := 0;
      flastpos   := -1;
      pathid     := -1;
      fnosrmtemp := true;
      flocked    := true;
      feof       := false;
      feoln      := false;
      fb0        := false;
      fb1        := false;
    end;

end;    { setupfibforfile }

procedure opendir (var cfib : fib; var dircatentry : catentry);

  begin   { opendir }
    ioresult := ord(inoerror);
    with cfib do
    try
      with unitable^[funit] do
	begin
	  {HAL}
	  {lockup;}           { lock keyboard }
	  fwindow    := addr(dircatentry);
	  call(dam,cfib,funit,opendirectory);
	  if ( ioresult <> ord (inoerror))
	    then
	      begin
		{ opendir failed }
		escape (0);
	      end;
	  {HAL}
	  {lockdown;}         { unlock keyboard }
	end;

      recover
	if escapecode<>0
	  then
	    escape(escapecode);

  end;    { opendir }

procedure link_files ( volid : vid;
		       ltitle : fid;
		       new_entry : fid;
		       segs : integer;
		       lkind : filekind );

  var
    infib : fib;
    outfib : fib;
    dircatentry : catentry;
    old_ioresult : integer;

  begin
    { opendir of root }
writeln('link_files ', volid, ltitle, lkind);

    setupfibforfile ( infib, volid, ltitle, segs, lkind );
writeln('fibforfile back');
    opendir ( infib, dircatentry );

$if debug$
old_ioresult := ioresult;
writeln;
writeln ('DEBUG: link_files: after successful opendir of root');
writeln ('DEBUG: link_files: ioresult = ', old_ioresult);
readln;
$end$

    { dup in fib to out fib & change name }

    outfib := infib;
    infib.fwindow := addr (outfib);
    infib.fpurgeoldlink := false;

    outfib.ftitle := new_entry;

    { call dam }

    {HAL}
    {lockup;}
    call (unitable^[infib.funit].dam, infib, infib.funit, duplicatelink);
    {HAL}
    {lockdown;}

$if debug$
old_ioresult := ioresult;
writeln;
writeln ('DEBUG: link_files: after successful dam duplink call');
writeln ('DEBUG: link_files: ioresult = ', old_ioresult);
readln;
$end$
    goodio;

    {HAL}
    {lockup;}
    call (unitable^[infib.funit].dam, infib, infib.funit, closedirectory);
    {HAL}
    {lockdown;}

$if debug$
old_ioresult := ioresult;
writeln;
writeln ('DEBUG: link_files: after successful dam closedir call');
writeln ('DEBUG: link_files: ioresult = ', old_ioresult);
readln;
$end$

  end ;    { procedure link_files }

a652 1
{HAL}
a725 1
    {HAL}
a914 1
{HAL}
a928 1
  {HAL}
a1059 1
    {HAL2}
a1156 1
  {HAL2}
a1167 1
    {HAL}
a1239 1
	  {HAL}
a1364 1
    {HAL2}
a1374 1
    {HAL}
d1481 1
a1481 2
	  { error }
	  {HAL}
a1511 1
    {HAL2}
a1521 1
    {HAL}
a1523 1
    {HAL}
a1541 1
    {HAL}
a1542 1
    {HAL}
a1573 160
procedure link ;

  const
    prompt1 = 'Volume and files to link ? ';

  var
    answer : string80;
    second_name : string80;
    newfid : fid;
    prompt : prompttype;
    volid : vid;
    ltitle : fid;
    new_entry : fid;
    lkind : filekind;
    unitnum : integer;
    segs : integer;

  begin
    try

    { step 1 : get unit number and file from user }

    writeln (clearscr);
    writeln (homechar);
    writeln;
    writeln ('This option makes a link to a bootable file on an HFS disc.');
    writeln;
    writeln ('Typical input is "#43:SYSTEM_D, SYSTEM_N".');
    writeln ('This command assumes that a file called "SYSTEM_D" is');
    writeln ('currently in the root directory of volume #43 and that ');
    writeln ('this file is in a bootable format. The name "SYSTEM_N"');
    writeln ('will be linked to "SYSTEM_D" and an entry in the boot');
    writeln ('directory will be made for "SYSTEM_N".');
    writeln;

    prompt := prompt1;
    setstrlen (new_entry, 0);
    setstrlen (newfid, 0);
    get_user_input ( prompt, answer );

$if debug$
writeln ('DEBUG: link step 1: after get_user_input');
writeln ('DEBUG: link step 1: answer = ', answer);
readln ;
$end$

    if strlen ( answer ) = 0
      then
	begin
	  { error }
	  {HAL}
	  escape(0);
	end
      else
	if get_2_names ( answer, second_name )
	  then
	    begin
	      zapspaces (answer);
	      zapspaces (second_name);
	      strappend (newfid, answer);
	      strappend (new_entry, second_name);
	    end
	  else
	    begin
	      { error }
	      badio ( ibadtitle );
	    end;
    segs := 0;

$if debug$
writeln ('DEBUG: link step 1: before scantitle');
writeln ('DEBUG: link step 1: newfid = ', newfid);
writeln ('DEBUG: link step 1: new_entry = ', new_entry);
readln ;
$end$

    if not scantitle ( newfid, volid, ltitle, segs, lkind )
      then
	begin

$if debug1$
writeln ('DEBUG: link step 1: after scantitle FALSE return');
writeln ('DEBUG: link step 1: newfid = ', newfid);
writeln ('DEBUG: link step 1: volid  = ', volid );
writeln ('DEBUG: link step 1: ltitle = ', ltitle);
readln ;
$end$

	  badio ( ibadtitle );
	end ;
    unitnum := findvolume (volid, true);
    {HAL2}
    if unitnum = 0 then
      badio ( ibadtitle);
    strappend ( volid, ':' );

    { step 2 : check that the unit is HFS and pointed at root directory }

$if debug$
writeln ('DEBUG: link step 2');
$end$

    {HAL}
    must_be_HFS(unitnum);

    {HAL}
    must_be_rootdir(unitnum);

    { step 3 : get the current contents of the LIF boot directory }

$if debug$
writeln ('DEBUG: link step 3: get_boot_directory');
$end$

    get_boot_directory ( volid );

    { step 4 : check that system names are OK }

    check_entries ( volid, ltitle );

    if bad_cur > 0
      then
	begin
	  badio ( ibadtitle );
	end ;

    if not filename_ok ( new_entry )
      then
	begin
	  badio ( ibadtitle );
	end ;

    { step 5 : set up boot directory }

    dup_boot_dir;
    add_boot_file ( new_entry );

    {HAL}
    link_files ( volid, ltitle, rootname(new_entry), segs, lkind );

    put_boot_directory ( volid );

    writeln;
    writeln (new_entry, ' linked to ', ltitle );

    recover
      begin
$if debug$
writeln ('DEBUG: link recover block ');
$end$

	printioerrmsg ;
	if escapecode <> 0
	  then
	    escape (escapecode);
      end;


  end ;  { procedure link }

d1620 1
a1620 2
	  { error }
	  {HAL}
a1650 1
    {HAL2}
a1660 1
    {HAL}
a1662 1
    {HAL}
a1674 1
    {HAL2}
d1758 1
a1758 2
	  { error }
	  {HAL}
a1788 1
    {HAL2}
a1798 1
    {HAL}
a1800 1
    {HAL}
a1814 7
    {HAL}
    {if bad_cur > 0
      then
	begin
	  badio ( ibadtitle );
	end ;}

d1899 1
a1899 2
	  { error }
	  {HAL}
a1935 1
    {HAL2}
a1945 1
    {HAL}
a1995 1
      'L' : link ;
d2001 1
a2001 1
      otherwise ; { bad option } {HAL}
@


5.1
log
@Automatic bump of revision number for PWS version 3.2j
@
text
@a1 1
$sysprog$
d3 5
a7 1
$debug on$
d22 2
a23 1
  cmd_prompt = 'OSINSTALL: Check Install Link Order Remove Quit Zero' ;
d30 1
a30 1
  debug = TRUE ;
d33 9
d43 1
d138 2
d171 2
d317 25
d600 3
d606 3
d639 2
a640 1
	  lockup;           { lock keyboard }
d649 2
a650 1
	  lockdown;         { unlock keyboard }
d674 1
d677 1
d698 2
a699 1
    lockup;
d701 2
a702 1
    lockdown;
d713 2
a714 1
    lockup;
d716 2
a717 1
    lockdown;
d752 8
d821 15
d895 8
a965 1
    { open_unit ( addr (path) ); }
d1012 98
d1157 1
a1157 1
	if in_boot_dir[i].liffile_type = -5822
d1232 4
d1318 1
a1318 1
	liffile_type := -5822;
d1330 1
d1332 5
d1342 2
a1343 1
    if strlen ( ltitle ) > 10
d1345 1
a1345 1
	filename_ok := false ;
d1347 6
a1352 4
    { no "/" characters in the name }
    if strpos ( '/', ltitle ) > 0
      then
	filename_ok := false ;
a1386 5
	  if not filename_ok ( ltitle )
	    then
	      begin
		badio (ibadtitle);
	      end;
d1409 1
a1409 1
      if in_boot_dir[current].liffile_type = -5822
d1415 2
a1416 1
	  strappend (inname, title);
d1541 3
d1552 2
a1553 5
    if not h_unitable^.tbl[unitnum].is_hfsunit
      then
	begin
	  badio (ibadrequest);
	end;
d1573 7
d1584 1
a1584 1
	  for i := 0 to good_cur do
d1593 1
a1593 1
	  for i := 0 to bad_cur do
d1660 2
a1661 1
	  badio ( ibadtitle );
d1691 3
d1702 2
a1703 5
    if not h_unitable^.tbl[unitnum].is_hfsunit
      then
	begin
	  badio (ibadrequest);
	end;
d1705 2
a1706 5
    if ( h_unitable^.tbl[unitnum].prefix <> 2 )
      then
	begin
	  badio (ibadrequest);
	end;
d1724 6
a1729 1
    inname := volid+ltitle;
d1808 2
a1809 1
	  badio ( ibadtitle );
d1849 3
d1860 2
a1861 5
    if not h_unitable^.tbl[unitnum].is_hfsunit
      then
	begin
	  badio (ibadrequest);
	end;
d1863 2
a1864 5
    if ( h_unitable^.tbl[unitnum].prefix <> 2 )
      then
	begin
	  badio (ibadrequest);
	end;
d1895 2
a1896 1
    link_files ( volid, ltitle, new_entry, segs, lkind );
d1965 2
a1966 1
	  badio ( ibadtitle );
d1996 3
d2007 2
a2008 5
    if not h_unitable^.tbl[unitnum].is_hfsunit
      then
	begin
	  badio (ibadrequest);
	end;
d2010 2
a2011 5
    if ( h_unitable^.tbl[unitnum].prefix <> 2 )
      then
	begin
	  badio (ibadrequest);
	end;
d2023 4
d2108 2
a2109 1
	  badio ( ibadtitle );
d2139 3
d2150 2
a2151 5
    if not h_unitable^.tbl[unitnum].is_hfsunit
      then
	begin
	  badio (ibadrequest);
	end;
d2153 2
a2154 5
    if ( h_unitable^.tbl[unitnum].prefix <> 2 )
      then
	begin
	  badio (ibadrequest);
	end;
d2168 2
a2169 1
    if bad_cur > 0
d2173 1
a2173 1
	end ;
d2215 127
d2357 6
a2362 5
      'C' : check ;      { implement 1 done }
      'I' : install ;    { implement 2 done }
      'L' : link ;       { implement 4 }
      'O' : order ;      { implement 5 }
      'R' : remove ;     { implement 3 done }
d2365 1
a2365 1
      otherwise cmd_done := true; { bad option }
@


4.3
log
@checkin before system build on 20 Oct, link bug still exists
and zero not implemented
@
text
@@


4.2
log
@update of prompts and user messages to be consistent with the ERS,
logic error fix in remove confirmation action

@
text
@@


4.1
log
@Automatic bump of revision number for PWS version 3.2i
@
text
@d19 2
a20 2
  cmd_prompt = 'OSINSTALL: Check Install Link Order Remove Quit' ;
  confirm = 'Are you sure you want to proceed? (Y/N) ';
d1271 1
a1271 1
    prompt1 = 'Unit number and file to check ? ';
d1292 2
a1293 2
    writeln ('This checks the consistany of the boot directory and boot');
    writeln ('files. ');
d1296 2
a1297 3
    writeln ('file "SYSTEM_P" on volume "#43".  A response of "#11" will');
    writeln ('check all boot files on volume "#11".  An empty response, ');
    writeln ('i.e. pressing only the return key, will check all boot files');
d1414 1
a1414 1
    prompt1 = 'Unit number and file to install ? ';
d1436 1
a1436 1
    writeln ('This installs a file as a bootable file on a HFS disk.');
d1441 2
a1442 2
    writeln ('this file was created with the "BOOT" command of the');
    writeln ('Librarian.');
d1537 3
d1557 1
a1557 1
    prompt1 = 'Unit number and files to link ? ';
d1579 1
a1579 1
    writeln ('This installs a link to a bootable file on a HFS disk.');
d1585 2
a1586 2
    writeln ('will be linked to "SYSTEM_D" and an entry in the boot.');
    writeln ('made for "SYSTEM_N".');
d1697 3
d1718 1
a1718 1
    prompt1 = 'Unit number and file to move to first slot ? ';
d1741 1
a1741 1
    writeln ('This reorders the bootable files on a HFS disk.');
d1744 1
a1744 1
    writeln ('SYSTEM_D will become the first file in the LIF.');
d1839 3
d1860 1
a1860 1
    prompt1 = 'Unit number and file to remove ? ';
d1883 1
a1883 1
    writeln ('This removes a bootable file from a HFS disk.');
d1980 1
a1980 1
	  if ans = 'Y'
d1992 3
@


1.16
log
@changes to build 3.2i
@
text
@@


1.15
log
@integration of osinstall with paws system turn
@
text
@d8 1
a8 1
$search 'MATCHSTR'$
@


1.14
log
@everything but link appears to be working but the link command
@
text
@d619 1
d627 8
d645 1
d647 9
d661 8
@


1.13
log
@after successful compile and short test of check, remove, order
@
text
@d26 1
a26 1
  debug = FALSE;
d945 1
a945 1
	if in_boot_dir[i].liffile_type <> -1
d1016 1
d1026 2
d1040 4
a1540 2
    i : integer;
    inname : string255;
d1561 1
@


1.12
log
@code complete except for new enhancements and repairs of errors,
after successful compile
@
text
@d26 1
a26 1
  debug = TRUE;
d155 1
d456 1
a456 1
    write (p,cteol);
d639 4
d740 1
d811 7
a817 1
      strmove(10, in_boot_dir[i].liffile_name, 1, in_lifname[i], 1);
d1139 1
d1166 9
a1192 1
		{ nullpos := strpos (title, nullstr); }
d1255 2
d1261 2
a1262 2
    writeln ('A typical response of "#3:/SYSTEM_P" will check the boot');
    writeln ('file "SYSTEM_P" on volume "#3".  A response of "#11" will');
d1400 2
d1405 1
a1405 1
    writeln ('Typical input is "#43:/SYSTEM_D".');
d1542 2
d1547 1
a1547 1
    writeln ('Typical input is "#43:/SYSTEM_D, SYSTEM_N".');
d1700 2
d1705 1
a1705 1
    writeln ('Typical input is "#43:/SYSTEM_D".');
d1839 2
d1844 1
a1844 1
    writeln ('Typical input is "#43:/SYSTEM_D".');
d1947 3
d1977 4
a1980 2
  promptforchar ( prompt_main, action_os );
  case action_os of
d1982 5
a1986 5
    'C' : check ;      { implement 1 done }
    'I' : install ;    { implement 2 done }
    'L' : link ;       { implement 4 }
    'O' : order ;      { implement 5 }
    'R' : remove ;     { implement 3 done }
d1988 4
a1991 4
    'Q' : ;

    otherwise { bad option }
  end ;
@


1.11
log
@after compile, filling out the code, debug to conditional compile
@
text
@d548 30
a577 1
procedure link_files ( volid : vid; ltitle : fid; new_entry : fid );
d579 40
d620 18
d960 38
d1496 1
a1496 1
    prompt1 = 'Unit number and file to install ? ';
d1631 1
a1631 1
    link_files ( volid, ltitle, new_entry );
d1652 16
d1670 101
@


1.10
log
@added extension so that there is a warning when the last
boot file entry is removed
@
text
@d371 3
a373 4
    if debug then
      begin
	writeln ('DEBUG: open_unit: start');
      end;
d384 5
a388 6
	if debug1 then
	  begin
	    writeln('DEBUG : setupfib: before open_unit dam call');
	    writeln ('DEBUG: setupfib: ftitle = ', ftitle);
	    writeln ('DEBUG: setupfib: uisblkd = ', unitable^[funit].uisblkd);
	  end;
d393 5
a397 6
	      if debug1 then
		begin
		  writeln('DEBUG : setupfib: before open_unit dam call');
		  writeln ('DEBUG: setupfib: fbuffered = ', fbuffered);
		  writeln ('DEBUG: setupfib: fistestvar = ', fistextvar);
		end;
d420 6
a425 7
    if debug1 then
      begin
	writeln ('DEBUG: open_unit: after dam openunit, after fill fields');
	writeln ('DEBUG: open_unit: freadable = ', filedes.f_ptr^.freadable );
	writeln ('DEBUG: open_unit: fwriteable = ', filedes.f_ptr^.fwriteable );
	readln;
      end;
d430 3
a432 4
    if debug then
      begin
	writeln ('DEBUG: open_unit: end');
      end;
d520 33
d570 3
a572 4
    if debug then
      begin
	writeln ('DEBUG: make_a_dot_out: start');
      end;
d630 3
a632 4
    if debug then
      begin
	writeln ('DEBUG: make_a_dot_out: end');
      end;
d651 3
a653 4
    if debug then
      begin
	writeln ('DEBUG: get_boot_directory: start');
      end;
d668 9
a676 10
    if debug1 then
      begin
	old_ioresult := ioresult;
	writeln ('DEBUG: get_boot_directory: before 1st freadbytes');
	writeln ('DEBUG: get_boot_directory: ioresult = ', old_ioresult );
	writeln ('DEBUG: get_boot_directory: freadable = ', filedes.f_ptr^.freadable );
	writeln ('DEBUG: get_boot_directory: fwriteable = ', filedes.f_ptr^.fwriteable );
	writeln ('DEBUG: get_boot_directory: flocked = ', filedes.f_ptr^.flocked );
	readln;
      end;
d682 6
a687 7
    if debug then
      begin
	old_ioresult := ioresult;
	writeln ('DEBUG: get_boot_directory: after 1st freadbytes');
	writeln ('DEBUG: get_boot_directory: ioresult = ', old_ioresult );
	readln;
      end;
d691 3
a693 4
    if debug1 then
      begin
	writeln ('DEBUG: get_boot_directory: after 1st freadbytes & goodio');
      end;
d720 3
a722 4
    if debug then
      begin
	writeln ('DEBUG: get_boot_directory: end  ');
      end;
d744 3
a746 4
    if debug then
      begin
	writeln ('DEBUG: put_boot_directory: start');
      end;
d755 9
a763 10
    if debug1 then
      begin
	old_ioresult := ioresult;
	writeln ('DEBUG: put_boot_directory: before 1st fwritebytes');
	writeln ('DEBUG: put_boot_directory: ioresult = ', old_ioresult );
	writeln ('DEBUG: put_boot_directory: freadable = ', filedes.f_ptr^.freadable );
	writeln ('DEBUG: put_boot_directory: fwriteable = ', filedes.f_ptr^.fwriteable );
	writeln ('DEBUG: put_boot_directory: flocked = ', filedes.f_ptr^.flocked );
	readln;
      end;
d769 6
a774 7
    if debug then
      begin
	old_ioresult := ioresult;
	writeln ('DEBUG: put_boot_directory: after 1st fwritebytes');
	writeln ('DEBUG: put_boot_directory: ioresult = ', old_ioresult );
	readln;
      end;
d778 3
a780 4
    if debug1 then
      begin
	writeln ('DEBUG: put_boot_directory: after 1st fwritebytes & goodio');
      end;
d793 3
a795 4
    if debug then
      begin
	writeln ('DEBUG: put_boot_directory: end  ');
      end;
d808 3
a810 4
    if debug then
      begin
	writeln ('DEBUG: check_a_dot_out: start');
      end;
d822 3
a824 4
    if debug then
      begin
	writeln ('DEBUG: check_a_dot_out: end  ');
      end;
d827 5
a831 6
      if debug then
	begin
	  old_ioresult := ioresult;
	  writeln ('DEBUG: check_a_dot_out recover block');
	  writeln ('DEBUG: check_a_dot_out: io_result = ', old_ioresult);
	end;
d835 1
a835 1
function only_one_boot_file : boolean;
d850 1
a850 5
    if count > 1
      then
	only_one_boot_file := false
      else
	only_one_boot_file := true;
d852 1
a852 1
  end ;    { function only_one_boot_file }
d915 5
a919 6
    if debug then
      begin
	writeln;
	writeln ('DEBUG: add_boot_file: start');
	debug_print_dir;
      end;
d921 6
a926 1
    open_slot := 16;
d943 2
a944 4
    if open_slot < 16
      then
	with out_boot_dir[open_slot] do
	  begin
d946 10
a955 11
	    if debug then
	      begin
		writeln;
		writeln ('DEBUG: add_boot_file: ******************');
		writeln;
		writeln ('DEBUG: add_boot_file: fill open_slot');
		writeln ('DEBUG: add_boot_file: ltitle = ', ltitle);
		writeln ('DEBUG: add_boot_file: strlen ltitle = ', strlen(ltitle));
		writeln ('DEBUG: add_boot_file: open_slot = ', open_slot);
		readln;
	      end;
d957 2
a958 9
	    strmove ( 10, ltitle, 1, liffile_name, 1 );
	    liffile_type := -5822;
	  end;

    if debug then
      begin
	writeln ('DEBUG: add_boot_file: end  ');
	writeln ('DEBUG: add_boot_file: open_slot = ', open_slot);
	debug_print_dir;
d961 6
d1003 4
a1006 5
    if debug then
      begin
	debug_print_vol;
	debug_print_dir;
      end ;
d1017 6
d1124 5
a1128 6
    if debug then
      begin
	writeln ('DEBUG: check step 1: after get_user_input');
	writeln ('DEBUG: check step 1: answer = ', answer);
	readln ;
      end;
d1143 5
a1147 6
    if debug then
      begin
	writeln ('DEBUG: check step 1: before scantitle');
	writeln ('DEBUG: check step 1: newfid = ', newfid);
	readln ;
      end;
d1153 7
a1159 8
	  if debug1 then
	    begin
	      writeln ('DEBUG: check step 1: after scantitle FALSE return');
	      writeln ('DEBUG: check step 1: newfid = ', newfid);
	      writeln ('DEBUG: check step 1: volid  = ', volid );
	      writeln ('DEBUG: check step 1: ltitle = ', ltitle);
	      readln ;
	    end;
d1170 3
a1172 4
    if debug then
      begin
	writeln ('DEBUG: check step 2: start');
      end;
d1182 3
a1184 4
    if debug then
      begin
	writeln ('DEBUG: check step 3: get_boot_directory: start');
      end;
d1190 3
a1192 4
    if debug then
      begin
	writeln ('DEBUG: check step 4: check_entries: start');
      end;
d1218 3
a1220 4
	if debug then
	  begin
	    writeln ('DEBUG: check recover block');
	  end ;
d1266 5
a1270 6
    if debug then
      begin
	writeln ('DEBUG: install step 1: after get_user_input');
	writeln ('DEBUG: install step 1: answer = ', answer);
	readln ;
      end;
d1285 5
a1289 6
    if debug then
      begin
	writeln ('DEBUG: install step 1: before scantitle');
	writeln ('DEBUG: install step 1: newfid = ', newfid);
	readln ;
      end;
a1290 1
{ need to check what scantitle does when no volume, only filename }
d1295 7
a1301 8
	  if debug1 then
	    begin
	      writeln ('DEBUG: install step 1: after scantitle FALSE return');
	      writeln ('DEBUG: install step 1: newfid = ', newfid);
	      writeln ('DEBUG: install step 1: volid  = ', volid );
	      writeln ('DEBUG: install step 1: ltitle = ', ltitle);
	      readln ;
	    end;
d1310 3
a1312 4
    if debug then
      begin
	writeln ('DEBUG: install step 2');
      end;
d1328 3
a1330 4
    if debug then
      begin
	writeln ('DEBUG: install step 3: get_boot_directory');
      end;
d1347 2
d1356 3
a1358 4
	if debug then
	  begin
	    writeln ('DEBUG: install recover block ');
	  end;
d1370 17
d1390 120
d1512 3
a1514 4
	if debug then
	  begin
	    writeln ('DEBUG: link recover block ');
	  end;
d1532 3
a1534 4
	if debug then
	  begin
	    writeln ('DEBUG: order recover block ');
	  end;
d1579 5
a1583 6
    if debug then
      begin
	writeln ('DEBUG: remove step 1: after get_user_input');
	writeln ('DEBUG: remove step 1: answer = ', answer);
	readln ;
      end;
d1598 5
a1602 6
    if debug then
      begin
	writeln ('DEBUG: remove step 1: before scantitle');
	writeln ('DEBUG: remove step 1: newfid = ', newfid);
	readln ;
      end;
a1603 1
{ need to check what scantitle does when no volume, only filename }
d1608 7
a1614 8
	  if debug1 then
	    begin
	      writeln ('DEBUG: remove step 1: after scantitle FALSE return');
	      writeln ('DEBUG: remove step 1: newfid = ', newfid);
	      writeln ('DEBUG: remove step 1: volid  = ', volid );
	      writeln ('DEBUG: remove step 1: ltitle = ', ltitle);
	      readln ;
	    end;
d1623 3
a1625 4
    if debug then
      begin
	writeln ('DEBUG: remove step 2');
      end;
d1641 3
a1643 4
    if debug then
      begin
	writeln ('DEBUG: remove step 3: get_boot_directory');
      end;
d1647 1
a1647 1
    { step 4 : convert file in / to a.out format }
d1649 3
a1651 1
    if not filename_ok ( ltitle )
d1657 1
a1657 1
    if only_one_boot_file
d1663 1
a1663 1
	  writeln ('from this device unless you install a boot file.');
d1671 2
a1673 1

d1678 3
a1680 4
	if debug then
	  begin
	    writeln ('DEBUG: remove recover block ');
	  end;
d1704 2
a1705 2
    'C' : check ;      { implement 1 }
    'I' : install ;    { implement 2 }
d1708 1
a1708 1
    'R' : remove ;     { implement 3 }
@


1.9
log
@after successful compile of remove command additions
@
text
@d20 1
d822 23
d1415 1
d1523 14
@


1.8
log
@after successful compile of with small fixes and enhancements
for install command
@
text
@d840 33
d876 3
a878 3
   i : integer;
   open_slot : integer;
   new_name : lifname;
d1386 15
d1403 99
@


1.7
log
@check and install cmds seem to be working
@
text
@d845 1
d862 11
a876 6
	    if ( strlen (ltitle) < 10 )
	      then
		begin
		  for i := (strlen(ltitle) + 1 ) to 10 do
		    strappend ( ltitle, nullstr );
		end ;
d903 18
d1248 1
a1248 1
    { step 2 : check that the unit is HFS }
d1261 6
d1277 6
@


1.6
log
@some fixes to check, install mostly working except for entry 8 not geting
nulled out
@
text
@d560 1
a560 1
    rewrite(outfile, outname);
d713 1
d764 1
a764 1
    { seek to 256, read 512 or 16 directory entries }
d768 2
a769 1
	bufptr := addr ( out_boot_dir[i] );  { trick }
d772 2
@


1.5
log
@after first SIMPLE successfull test of check option
@
text
@d27 1
d540 6
d601 7
d730 2
a731 1
    open_unit ( addr (path) );
d767 2
a768 3
	bufptr := addr ( in_boot_dir[i] );  { trick }
	freadbytes (filedes.f_ptr^, bufptr^, sizeof (lif_dir_entry));
	fseek (filedes.f_ptr^, (sizeof (lif_dir_entry) + 1));
d786 6
d802 5
d844 8
d857 28
a884 1
    with out_boot_dir[open_slot] do
d886 3
a888 2
	strmove ( 10, liffile_name, 1, ltitle, 1 );
	liffile_type := -5822;
d901 1
d946 5
d957 4
a1023 1
    { answer := '#43:'; }
d1141 1
a1141 1
    prompt1 = 'Unit number and file to install ?';
d1172 1
a1172 2
    { get_user_input ( prompt, answer ); }
    answer := '#43:';
d1244 1
a1244 1
    inname := volid+'/'+ltitle;
d1247 1
a1247 1
	{ make_a_dot_out (inname ); }
d1252 1
a1252 1
    { put_boot_directory ( volid ); }
@


1.4
log
@successfull compile after alot of install code
@
text
@d518 1
a518 1
    readln (keyboard,answer);
a519 1
    writeln (answer);
a666 1
	      fseek (filedes.f_ptr^, (sizeof (lif_dir_entry) + 1));
a676 1
	      fseek (filedes.f_ptr^, (sizeof (lif_dir_entry) + 1));
d847 1
a847 1
    if debug1 then
d921 1
a921 1
    prompt1 = 'Unit number and file to check ?';
@


1.3
log
@after successful complilation with check_entries filled out
@
text
@d383 1
a383 1
	if debug then
d393 1
a393 1
	      if debug then
d421 1
a421 1
    if debug then
d629 1
a629 1
    if debug then
d654 1
a654 1
    if debug then
d668 1
a668 1
	      fseek (filedes.f_ptr^, sizeof (lif_dir_entry));
d679 1
a679 1
	      fseek (filedes.f_ptr^, sizeof (lif_dir_entry));
d693 74
d772 1
d786 6
d795 40
d850 5
a854 6
    if debug
      then
	begin
	  debug_print_vol;
	  debug_print_dir;
	end ;
a918 4

      begin
      end;

a924 1
    prompt2 = 'File to check (return only for all files) ?';
a934 3
    filename : fid;
    dircatentry : catentry;
    searchname : fid;
d955 2
a956 2
    { get_user_input ( prompt, answer ); }
    answer := '#43:';
d1073 15
d1090 97
@


1.2
log
@after successful read LIF volume header
@
text
@d33 1
d115 5
d162 2
d167 4
d620 2
d663 1
a663 1
	  fseek (filedes.f_ptr^, 512);
d666 2
a667 1
	      freadbytes (filedes.f_ptr, in_boot_dir[i], sizeof (lif_dir_entry));
d674 1
a674 1
	  fseek (filedes.f_ptr^, 256);
d677 2
a678 1
	      freadbytes (filedes.f_ptr, in_boot_dir[i], sizeof (lif_dir_entry));
d683 3
d693 1
a693 1
procedure check_entries ( ltitle : fid );
d695 4
d700 1
a700 2
    debug_print_vol;
    debug_print_dir;
d702 101
d823 1
d922 1
a922 1
    check_entries ( ltitle );
d924 1
a924 1
    { step 5 : for each valid entry check that a valid boot file exists }
d926 8
d935 8
a942 1
    { step 6 : report status of check to the user }
@


1.1
log
@Initial revision
@
text
@d4 1
d25 2
d175 1
d190 1
d210 1
a210 1
	  for j := 1 to 12 do write ( liftoc[j], ', ' );
d215 1
d229 1
a229 1
	  for j := 1 to 12 do write ( liftoc[j], ', ' );
d234 1
d331 6
a336 2
		freptcnt := 0; fbufchanged := false; flastpos := -1;
		fstartaddress := 0; pathid := -1; fnosrmtemp := true;
d339 3
a341 1
		feof := false; feoln := false;
a349 41
procedure setupfibforfile ( filename : fid;
			    var lfib : fib;
			    var vname : vid );

  var
    lkind : filekind;
    segs  : integer;

  begin
    segs := 0;
    ioresult := ord (inoerror);
    with lfib do
      if scantitle ( filename, fvid, ftitle, segs, lkind )
	then
	  begin
	    vname      := fvid;
	    funit      := findvolume(fvid,true);
	    fkind      := lkind;
	    feft := efttable^[lkind];
	    foptstring := nil;
	    fbuffered  := true;
	    fpos       := segs * 512;
	    freptcnt   := 0;
	    fanonymous := false;
	    fmodified  := false;
	    fbufchanged:= false;
	    fstartaddress := 0;
	    flastpos   := -1;
	    pathid     := -1;
	    fnosrmtemp := true;
	    flocked    := true;
	    feof       := false;
	    feoln      := false;
	    fb0        := false;
	    fb1        := false;
	  end
	else
	  badio ( ibadtitle );

  end;    { procedure setupfibforfile }

d357 5
d364 3
a366 1
    fd := -1;
d371 7
d381 6
d398 1
a398 1
	      {successfully opened the unit, now update fildes_table[fd]}
d408 9
d419 6
d446 1
a446 1
    write (homechar,p,cteol);
a498 147
procedure mountvolume(sd : prompttype ;var finfo : control);

  var
    answer        : char;
    unit          : integer;
    tempname      : vid;

  begin
    with finfo do
    begin
      if streaming then
      begin
	writeln('Volume ',cpvol,' not online while streaming',cteol);
	escape(-1);
      end;

      tempname := cpvol;
      unit     := findvolume(tempname,false); { check for bad unit # }
      ioresult := ord(inoerror);

      repeat
	{ construct the prompt }
	write('Please mount',sd);
	if strlen(cvol)>0 then write(' volume ',cvol);
	if ((strlen(sd)>0) or (strlen(cvol)>0)) and useunit then write(' in');
	if useunit then write(' unit ',cpvol);
	writeln(cteol);
	promptread('''C'' continues, <'+esckey+'> aborts ',answer,'C','C');
						  { 3.0 ITF fix 4/6/84 }

	if useunit then tempname := cpvol else tempname := cvol;
	cfib.funit := findvolume(tempname,true);

	if cfib.funit>0 then
	begin
	  if ioresult=ord(inodirectory) then
	  begin
	    if dstatus<>dontcare then writeln('No directory on ',cpvol);
	    setstrlen(tempname,0);
	    case dstatus of
	      dneeded: cfib.funit := 0;
	      dwanted: begin
			 promptyorn('Use current media',answer);
			 if answer='N' then cfib.funit := 0
				       else dstatus    := dontcare;
		       end;
	      otherwise
	    end;   { case dstatus }
	  end
	  else
	  begin
	    if ioresult<>ord(inoerror) then
	    begin
	      printioerrmsg; cfib.funit := 0;
	    end
	    else
	    begin { found a directory }
	      if cvol='' then cvol := tempname
	      else
	      if cvol<>tempname then cfib.funit := 0;
	    end;
	  end;
	end;
      until cfib.funit>0;
      cfib.fvid := cvol;
      mounted   := true;
    end;
  end;    { mount volume }

procedure closedir (var finfo : control);

  begin
    with finfo, cfib do
    begin
      if diropen then
      begin
	lockup;       { lock keyboard for this operation }
	pathid := path;   { restore pathid }
	call (unitable^[funit].dam, cfib, funit, closedirectory);
	diropen := false;
	lockdown;
      end;
    end;
  end;    { closedir }

procedure opendir(filename      : fid;
	      var searchname    : fid;
		  prompt        : prompttype;
	      var finfo         : control;
	      var dircatentry   : catentry);

  var
    doparent : boolean;
    unit     : integer;

  begin   { opendir }
    ioresult := ord(inoerror);
    with finfo, cfib do
    try
      lockup;
      doparent := diropen;
      if doparent
	then
	  closedir (finfo);
      diropen := false;
      lockdown;
      setupfibforfile (filename, cfib, cpvol);
      useunit := unitnumber(cpvol);
      dstatus := dneeded;
      if useunit
	then
	  cvol := ''
	else
	  cvol := cpvol;
      if (funit=0) or unitnumber(fvid)
	then
	  mountvolume (prompt, finfo)
	else
	  mounted := true;

      with unitable^[funit] do
	begin
	  lockup;           { lock keyboard }
	  fwindow := addr (dircatentry);
	  if doparent
	    then
	      call (dam, cfib, funit, openparentdir)
	    else
	      call (dam, cfib, funit, opendirectory);
	  diropen := (ioresult=ord(inoerror));
	  if diropen
	    then
	      begin
		path       := pathid;
		searchname := ftitle;
		cvol       := dircatentry.cname;
	      end;
	  lockdown;         { unlock keyboard }
	  if not diropen
	    then
	      escape(0);    { opendirectory failed }
	end ;

    recover
      if escapecode<>0 then escape(escapecode);
  end;    { opendir }

d504 2
a505 1
    showprompt (prompt);
d508 1
d587 3
d591 2
d595 1
d599 5
d609 1
d614 24
a637 1
    freadbytes (filedes.f_ptr, in_boot_vol, sizeof (in_boot_vol));
d640 5
d667 5
d702 2
d718 11
a728 1
    get_user_input ( prompt, answer );
d741 9
a749 1
    if scantitle ( newfid, volid, ltitle, segs, lkind )
d751 15
a765 1
	badio ( ibadunit );
d767 1
d771 6
a776 2
    opendir (filename, searchname, '', ininfo, dircatentry);
    if not ininfo.diropen
a777 3
	escape(0);
    if str ( dircatentry.cinfo, 1, 4 ) <> 'HFS '
      then
d784 5
d793 5
d805 6
d812 6
d823 15
d843 16
d864 16
d885 16
@
