$modcal on$
$allow_packed on$
$partial_eval on$
{{
$debug on$
$linenum 10000$
{}
$debug off$
$range off$
$ovflcheck off$
$stackcheck off$
{}
{
	MODULE: BOOTLIF.

	Contains routines used for accessing the boot lif directory
	Structure.

	general error handling procedure:  any non-ioerror errors are handled here.
	  this is left over from the original osinstall software.  if an ioerror
	  has occured, the routine will return false.  The caller must then write
	  an error message for the ioresult.

	  thus, in summary, if the called routine returns false and if ioresult <> 0,
	  then the calling routine must print an error message.  For all other cases,
	  the called routine has generated a specific error message.
}

module bootlif;

import sysglobals, sysdevs, fs;

export

type
	checkentrytype = (entry_bootable,       {entry exists in hfs root, and is bootable}
			  entry_not_bootable,   {entry exists in hfs root, but is not bootable}
			  entry_not_in_hfs,     {entry does not exist in hfs root}
			  entry_no_entry);      {not in lif directory}

	lifname = packed array[1..10] of char;

	savebootliftype = (savebootlif, donotsavebootlif);

	function openbootlif(un:unitnum):boolean;
	function addbootfile(filename:string255):boolean;
	function removebootfile(filename:string255; var OverrideLastFile:boolean):boolean;
	function firstbootfile(filename:string255):boolean;
	function zerobootlif(un:unitnum):boolean;
	function getdirentry(filename:string255):integer;
	function checkdirentry(direntry:integer;
			       var lname:lifname;
			       var check_result:checkentrytype):boolean;
	function closebootlif(save:savebootliftype):boolean;

implement

type
	vname   = packed array[1..6] of char;
	bcd     = 0..15;
	word15  = 0..32767;
	tdate   = packed array[1..12] of bcd;

	bootability  = (not_found, not_bootable, bootable);

	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;
		     lifspm            : integer;
		     lifspt            : integer;
		     lifcdate          : tdate;
		     filler            : packed array[21..123] of shortint;
		     lifsdate          : tdate;
		     lifdummy4         : shortint;
		   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;

	lif_8_dir = packed array [ 0 .. 7 ] of lif_dir_entry;
	lif_8_ptr = ^lif_8_dir;

	lif_16_dir = packed array [ 0 .. 15 ] of lif_dir_entry;
	lif_16_ptr = ^lif_16_dir;

	file_variety = (no_file, special_file, regular_file);

	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;

	integer_ptr = ^integer;

const
	bootable_eft = -5822;
	null_dir_entry = lif_dir_entry [
		   liffile_name     : '          ',
		   liffile_type     : -1,
		   lifstart_address : 0,
		   liffile_length   : 0,
		   liftoc           : tdate[0,0,0,0,0,0,0,0,0,0,0,0],
		   lifl_flag        : true,
		   lifvol_number    : 1,
		   lifimplement     : 0];

	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  ];

var
	lifopen:boolean;
	lifunit:unitnum;
	lifbuf:packed array [ 0 .. 1023 ] of char;
	plifvol:lif_vol_header_ptr;
	plif16:lif_16_ptr;
	secload_loc:integer;   { where secondary loader is to be loaded }
	secload_len:integer;   { length, in sectors, of secondary loader }
	secload_start:integer; { sector position of secondary loader }



(*********************************************************************)
(*  normallifname                                                    *)
(*********************************************************************)
procedure normallifname(var lname:lifname);
var
	i:integer;
begin
	for i := 1 to 10 do
	begin
		if lname[i] = #0 then
			lname[i] := ' ';
	end;
end;

(*********************************************************************)
(*  fidtolifname                                                     *)
(*********************************************************************)
procedure fidtolifname(fname:string255; var lname:lifname);
var
	i:integer;
	len:integer;
begin
	for i := 1 to 10 do
		lname[i] := ' ';

	len := strlen(fname);
	if len > 10 then
		len := 10;

	for i := 1 to len do
		lname[i] := fname[i];

	normallifname(lname);
end;


(*********************************************************************)
(*  must_be_HFS                                                      *)
(*********************************************************************)
function must_be_HFS(un: unitnum):boolean;
begin
  must_be_HFS := FALSE;
  if h_unitable = NIL then
  begin
      writeln('HFS not installed.');
  end
  else if not h_unitable^.tbl[un].is_hfsunit then
  begin
      writeln('#', un:1, ': is not an HFS unit.');
  end
  else
      must_be_HFS := TRUE;
end;

(*********************************************************************)
(*  must_be_rootdir                                                  *)
(*********************************************************************)
function must_be_rootdir(un: unitnum):boolean;
begin
  if h_unitable^.tbl[un].prefix <> 2 then
    begin
      writeln('Unit must be prefixed to /.');
      must_be_rootdir := FALSE;
    end
    else
	must_be_rootdir := TRUE;
end;


(*********************************************************************)
(*  rootname                                                         *)
(*********************************************************************)
function rootname ( inname : string255 ) : string255;
var
	lname1, lname2:lifname;
begin
  fidtolifname(inname, lname1);
  fidtolifname('SYSHPUX', lname2);

  if lname1 = lname2 then
    rootname := 'hp-ux'
  else
  begin
    zapspaces(inname);
    rootname := inname;
  end;
end;



(*********************************************************************)
(*  file_type                                                        *)
(*********************************************************************)
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;



(*********************************************************************)
(*  check_a_dot_out                                                  *)
(*********************************************************************)
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 }


(*********************************************************************)
(*  make_a_dot_out                                                   *)
(*********************************************************************)
function make_a_dot_out ( inname, outname : string255):boolean;
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;
begin
try
  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');
  make_a_dot_out := true;
recover
  make_a_dot_out := false;
end ;    { procedure make_a_dot_out }


(*********************************************************************)
(*  dosetdate                                                        *)
(*********************************************************************)
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;
end;


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



(*********************************************************************)
(*  clearfib                                                         *)
(*********************************************************************)
procedure clearfib(var f:fib);
var
	pc:charptr;
	i:integer;
begin
	pc := charptr(addr(f));
	for i := 1 to sizeof(f) do
	begin
		pc^ := #0;
		pc := addr(pc^, 1);
	end;
end;



(*********************************************************************)
(*  add_secload                                                      *)
(*********************************************************************)
function add_secload:boolean;
var
	boot_size['bootasm_size']:    integer;
	boot_start['bootasm_start']:  integer;
	size_in_sectors:integer;
	size_in_bytes:integer;
	f:fib;
begin
	try
		if not lifopen then
			escape(0);

		{
		  attempt to write out the new secondary loader.
		}
		clearfib(f);
		size_in_sectors := (boot_size + 255) div 256;
		size_in_bytes := size_in_sectors * 256;
		with f do
		begin
			fpos := 768;
			fpeof := size_in_bytes + fpos;
			fleof := size_in_bytes + fpos;
			funit := lifunit;
		end;
		call(unitable^[lifunit].tm, addr(f), writebytes, boot_start, size_in_bytes, 768);
		if ioresult <> 0 then escape(0);

		{
		  set up the new secondary loader variables.
		}
		secload_loc := boot_start;
		secload_len := size_in_sectors;
		secload_start := 3;

		add_secload := true;
	recover
		add_secload := false;
end;



(*********************************************************************)
(*  compress_lif                                                      *)
(*********************************************************************)
procedure compress_lif;
var
	i, j:integer;
begin
	j := -1;
	for i := 0 to 15 do
	with plif16^[i] do
	begin
		if j <> -1 then
		begin
			if liffile_type = bootable_eft then
			begin
				plif16^[j] := plif16^[i];
				plif16^[i] := null_dir_entry;
				j := j + 1;
			end;
		end
		else if liffile_type <> bootable_eft then
		begin
			j := i;
		end;
	end;
end;



(*********************************************************************)
(*  openbootlif                                                      *)
(*********************************************************************)
function openbootlif(un:unitnum):boolean;
var
	plif8a, plif8b:lif_8_ptr;
	i,j:integer;
	f:fib;
	pc:charptr;
begin
	try
		{
		  unit number must be an HFS disk.
		}
		if not must_be_HFS(un) then escape(0);

		{
		  read in 1K of the lif volume and set up
		  pointers.
		}
		clearfib(f);
		with f do
		begin
			fpos := 0;
			fpeof := 1024;
			fleof := 1024;
			funit := un;
		end;
		call(unitable^[un].tm, addr(f), readbytes, lifbuf, 1024, 0);
		if ioresult <> 0 then escape(0);
		plifvol := lif_vol_header_ptr(addr(lifbuf[0]));
		plif16  := lif_16_ptr(addr(lifbuf[256]));


		with plifvol^ do
		begin
			{
			  verify this is a good volume
			}
			if (lifid = -32768) 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)))
			then
			begin
				{all o.k., do nothing}
			end
			else
			begin
			   writeln;
			   writeln('LIF boot directory corrupted.');
			   writeln('Use Zero if you want to create a new one.');
			   escape(0);
			end;

			{
			  if lif volume starting position is not correct,
			  then adjust it.
			}
			if (lifdir_start_addr = 2) then
			begin
				plif8a := lif_8_ptr(addr(lifbuf[256]));
				plif8b := lif_8_ptr(addr(lifbuf[512]));

				plif8a^ := plif8b^;
				for i := 0 to 7 do
				begin
					plif8b^[i] := null_dir_entry;
				end;
				lifdir_start_addr := 1;
				lifdir_length := 2;
			end;
		end;

		{
		  get secondary loader address vars.
		}
		secload_loc := integer_ptr(addr(lifbuf[768]))^;
		i := integer_ptr(addr(lifbuf[(768)+4]))^;
		secload_len := (i + 255) div 256;
		secload_start := 3;


		{
		  verify all directory entries.
		    nuke any entries with file type other than bootable_eft.
		    no nulls in valid file names.
		    valid entries point correctly to secondary loader.
		}
		for i := 0 to 15 do
		with plif16^[i] do
		begin
			if liffile_type <> bootable_eft then
			begin
				plif16^[i] := null_dir_entry;
			end
			else
			begin
				normallifname(liffile_name);
				lifstart_address := secload_start;
				liffile_length := secload_len;
				lifimplement := secload_loc;
			end;
		end;



		{
		  compress the directory.
		}
		compress_lif;



		{
		  set up globals
		}
		openbootlif := true;
		lifopen := true;
		lifunit := un;
	recover
	begin
		openbootlif := false;
		lifopen := false;
	end;
end;


(*********************************************************************)
(*  addbootfile                                                      *)
(*********************************************************************)
function addbootfile(filename:string255):boolean;
var
	add_idx, i:integer;
	a_dot_out_name:string255;
begin
	try
		if (lifopen) and (must_be_rootdir(lifunit)) then
		begin
			{
			  if their are currently no boot files, then
			  add a secondary loader.
			}
			add_idx := num_boot_files;
			if add_idx = 0 then
				if not add_secload then
					escape(0);


			{
			  if the file currently exists, then overwrite its place in the
			  lif directory.
			}
			i := getdirentry(filename);
			if i <> -1 then
				add_idx := i;


			{
			  make sure there is room in the directory for this file.
			}
			if add_idx >=16 then
			begin
				ioresult := ord(idirfull);
				escape(0);
			end;

			{
			  if boot file to be added is not a.out format,
			  convert it.
			}
			setstrlen(a_dot_out_name, 0);
			strwrite(a_dot_out_name, 1, i, '#', lifunit:1, ':', rootname(filename));
			case file_type(a_dot_out_name) of
				no_file:      begin ioresult := ord(inofile); escape(0); end;
				special_file: begin ioresult := ord(ibadfiletype); escape(0); end;
				regular_file: {no action now};
			end; {case}

			if check_a_dot_out(a_dot_out_name) <> bootable then
				if not make_a_dot_out(a_dot_out_name, a_dot_out_name) then
					escape(0);

			{
			  add entry to lif directory.
			}
			with plif16^[add_idx] do
			begin
				fidtolifname(filename, liffile_name);
				liffile_type := bootable_eft;
				lifstart_address := secload_start;
				liffile_length := secload_len;
				dosetdate(liftoc);
				lifl_flag := true;
				lifvol_number := 1;
				lifimplement := secload_loc;
			end;


			addbootfile := true;
		end
		else
			escape(0);
	recover
		addbootfile := false;
end;


(*********************************************************************)
(*  removebootfile                                                   *)
(*********************************************************************)
function removebootfile(filename:string255; var OverrideLastFile:boolean):boolean;
var
	remove_idx:integer;
begin
	try
		if (lifopen) and (must_be_rootdir(lifunit)) then
		begin
			{
			  get and verify the idx for the file to be removed.
			}
			remove_idx := getdirentry(filename);
			if remove_idx = -1 then
			begin
				ioresult := ord(inofile);
				escape(0);
			end;

			{
			  if this is the last file, then if OverrideLastFile is true
			  its o.k. to remove the last file.  Otherwise, set OverrideLastFile
			  to true and escape.
			}
			if (num_boot_files = 1) and (not overridelastfile) then
			begin
				OverrideLastFile := true;
				escape(0);
			end;

			{
			  remove this file from the lif directory structure.
			}
			plif16^[remove_idx] := null_dir_entry;

			{
			  compress the directory.
			}
			compress_lif;

			removebootfile := true;
		end
		else
			escape(0);
	recover
		removebootfile := false;
end;


(*********************************************************************)
(*  firstbootfile                                                    *)
(*********************************************************************)
function firstbootfile(filename:string255):boolean;
var
	first_idx:integer;
	dir_entry:lif_dir_entry;
	i:integer;
begin
	try
		if (lifopen) and (must_be_rootdir(lifunit)) then
		begin
			{
			  get and verify the idx for the file to be removed.
			}
			first_idx := getdirentry(filename);
			if first_idx = -1 then
			begin
				ioresult := ord(inofile);
				escape(0);
			end;

			{
			  reorder the files.
			}
			if first_idx > 0 then
			begin
				dir_entry := plif16^[first_idx];
				for i := first_idx downto 1 do
					plif16^[i] := plif16^[i-1];
				plif16^[0] := dir_entry;
			end;


			firstbootfile := true;
		end
		else
			escape(0);
	recover
		firstbootfile := false;
end;


(*********************************************************************)
(*  zerobootlif                                                      *)
(*********************************************************************)
function zerobootlif(un:unitnum):boolean;
var
	i                         : integer;
	boot_size['bootasm_size'] : integer;                   { 23AUG91 - CFB }
	boot_sectors              : integer;                   { 23AUG91 - CFB }
begin
	{
	  initialize the lif buffer.
	  NOTE: to do this, an open/close does NOT need to be done.
	}
	for i := 0 to 1023 do
		lifbuf[i] := #0;
	plifvol := lif_vol_header_ptr(addr(lifbuf[0]));
	plif16  := lif_16_ptr(addr(lifbuf[256]));
	lifunit := un;


	try
		{
		  unit number must be an HFS disk.
		}
		if not must_be_HFS(lifunit) then escape(0);

		with plifvol^ do
		begin
			lifid := -32768;
			lifvol_label := 'V     ';
			if lifunit < 10 then
				lifvol_label[2] := chr(ord('0') + lifunit)
			else
			begin
				lifvol_label[2] := chr(ord('0') + lifunit div 10);
				lifvol_label[3] := chr(ord('0') + lifunit mod 10);
			end;
			boot_sectors := (boot_size + 255) div 256;
			{ round up to next sector                23AUG91 - CFB }
			lifdir_start_addr         := 1;
			lifoct_10000              := octal('10000');
			lifdir_length             := 2;
			lifversion                := 1;        { 23AUG91 - CFB }
			liftps                    := 1;        { 23AUG91 - CFB }
			lifspm                    := 1;        { 23AUG91 - CFB }
			lifspt                    := 1 + 2 + boot_sectors;
			{ lifdir_start_addr + lifdir_length + boot_sectors CFB }
			dosetdate(lifcdate);

			for i := 0 to 15 do
				plif16^[i] := null_dir_entry;

			lifopen := true;
			if not closebootlif(savebootlif) then escape(0);

			zerobootlif := true;
		end;
	recover
		zerobootlif := false;
end;


(*********************************************************************)
(*  getdirentry                                                      *)
(*********************************************************************)
function getdirentry(filename:string255):integer;
var
	lname:lifname;
	i:integer;
	done:boolean;
begin

	getdirentry := -1;

	fidtolifname(filename, lname);

	i := 0;
	done := false;
	while not done do
	begin
		if plif16^[i].liffile_name = lname then
		begin
			getdirentry := i;
			done := true;
		end;

		if i = 15 then
		begin
			done := true;
			i := -1;
		end
		else
			i := i + 1;
	end;
end;


(*********************************************************************)
(*  checkdirentry                                                    *)
(*********************************************************************)
function checkdirentry(direntry:integer;
		       var lname:lifname;
		       var check_result:checkentrytype):boolean;
var
	strname:string255;
	filename:string255;
	i:integer;
begin
	try
		if not lifopen then
			escape(0);

		if direntry < num_boot_files then
		with plif16^[direntry] do
		begin
			setstrlen(strname, 0);
			setstrlen(filename, 0);
			lname := liffile_name;
			strwrite(strname, 1, i, liffile_name);
			strwrite(filename, 1, i, '#', lifunit:1, ':/', rootname(strname));
			case check_a_dot_out(filename) of
				bootable:       check_result := entry_bootable;
				not_bootable:   check_result := entry_not_bootable;
				not_found:      check_result := entry_not_in_hfs;
			end;
		end
		else
			check_result := entry_no_entry;
		checkdirentry := true;
	recover
		checkdirentry := false;
end;


(*********************************************************************)
(*  closebootlif                                                     *)
(*********************************************************************)
function closebootlif(save:savebootliftype):boolean;
var
	f:fib;
begin
	if save = donotsavebootlif then
		closebootlif := true
	else if not lifopen then
	begin
		closebootlif := false;
		writeln('OSINSTALL INTERNAL ERROR: Can not close the LIF directory.');
	end
	else {save = savebootlif}
	begin
		clearfib(f);
		with f do
		begin
			fpos := 0;
			fpeof := 768;
			fleof := 768;
			funit := lifunit;
		end;
		call(unitable^[lifunit].tm, addr(f), writebytes, lifbuf, 768, 0);
		if ioresult <> 0 then
			closebootlif := false
		else
			closebootlif := true;
	end;
	lifopen := false;
end;


end.
