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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

27.1
date     88.09.29.11.18.51;  author bayes;  state Exp;
branches ;
next     26.2;

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

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

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

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

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

21.1
date     87.08.12.13.32.45;  author bayes;  state Exp;
branches ;
next     20.2;

20.2
date     87.08.07.16.01.48;  author bayes;  state Exp;
branches ;
next     20.1;

20.1
date     87.07.30.10.44.47;  author bayes;  state Exp;
branches ;
next     19.4;

19.4
date     87.07.23.14.01.00;  author bayes;  state Exp;
branches ;
next     19.3;

19.3
date     87.06.24.11.13.46;  author bayes;  state Exp;
branches ;
next     19.2;

19.2
date     87.06.18.10.40.11;  author bayes;  state Exp;
branches ;
next     19.1;

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

18.1
date     87.05.20.14.57.36;  author bayes;  state Exp;
branches ;
next     17.3;

17.3
date     87.05.15.14.30.46;  author bayes;  state Exp;
branches ;
next     17.2;

17.2
date     87.05.14.15.36.19;  author bayes;  state Exp;
branches ;
next     17.1;

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

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

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

14.1
date     87.04.01.14.55.54;  author jws;  state Exp;
branches ;
next     13.2;

13.2
date     87.04.01.09.27.40;  author jws;  state Exp;
branches ;
next     13.1;

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

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

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

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

9.1
date     86.12.12.14.04.07;  author bayes;  state Exp;
branches ;
next     8.2;

8.2
date     86.12.08.18.57.53;  author jws;  state Exp;
branches ;
next     8.1;

8.1
date     86.11.27.11.33.28;  author jws;  state Exp;
branches ;
next     7.2;

7.2
date     86.11.21.15.20.30;  author hal;  state Exp;
branches ;
next     7.1;

7.1
date     86.11.20.13.22.05;  author hal;  state Exp;
branches ;
next     6.2;

6.2
date     86.11.05.09.46.39;  author hal;  state Exp;
branches ;
next     6.1;

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

5.1
date     86.10.28.16.11.52;  author hal;  state Exp;
branches ;
next     4.4;

4.4
date     86.10.20.14.56.39;  author hal;  state Exp;
branches ;
next     4.3;

4.3
date     86.10.17.15.08.14;  author hal;  state Exp;
branches ;
next     4.2;

4.2
date     86.10.08.13.15.25;  author hal;  state Exp;
branches ;
next     4.1;

4.1
date     86.09.30.19.25.26;  author hal;  state Exp;
branches ;
next     3.4;

3.4
date     86.09.19.15.26.25;  author hal;  state Exp;
branches ;
next     3.3;

3.3
date     86.09.04.17.50.29;  author hal;  state Exp;
branches ;
next     3.2;

3.2
date     86.09.01.17.27.25;  author hal;  state Exp;
branches ;
next     3.1;

3.1
date     86.09.01.11.36.19;  author hal;  state Exp;
branches ;
next     2.6;

2.6
date     86.08.26.16.09.38;  author hal;  state Exp;
branches ;
next     2.5;

2.5
date     86.08.25.10.27.17;  author hal;  state Exp;
branches ;
next     2.4;

2.4
date     86.08.20.16.13.31;  author hal;  state Exp;
branches ;
next     2.3;

2.3
date     86.08.19.15.24.47;  author hal;  state Exp;
branches ;
next     2.2;

2.2
date     86.07.30.18.17.48;  author hal;  state Exp;
branches ;
next     2.1;

2.1
date     86.07.30.14.26.18;  author hal;  state Exp;
branches ;
next     1.26;

1.26
date     86.07.30.10.03.03;  author geli;  state Exp;
branches ;
next     1.25;

1.25
date     86.07.29.12.57.57;  author hal;  state Exp;
branches ;
next     1.24;

1.24
date     86.07.28.17.37.34;  author hal;  state Exp;
branches ;
next     1.23;

1.23
date     86.07.28.08.59.27;  author hal;  state Exp;
branches ;
next     1.22;

1.22
date     86.07.23.18.42.36;  author hal;  state Exp;
branches ;
next     1.21;

1.21
date     86.07.22.16.53.28;  author hal;  state Exp;
branches ;
next     1.20;

1.20
date     86.07.22.16.36.13;  author hal;  state Exp;
branches ;
next     1.19;

1.19
date     86.07.22.16.16.14;  author hal;  state Exp;
branches ;
next     1.18;

1.18
date     86.07.21.16.49.30;  author hal;  state Exp;
branches ;
next     1.17;

1.17
date     86.07.18.14.24.10;  author hal;  state Exp;
branches ;
next     1.16;

1.16
date     86.07.17.17.25.03;  author hal;  state Exp;
branches ;
next     1.15;

1.15
date     86.07.16.09.58.21;  author hal;  state Exp;
branches ;
next     1.14;

1.14
date     86.07.15.17.06.24;  author geli;  state Exp;
branches ;
next     1.13;

1.13
date     86.07.14.13.42.57;  author hal;  state Exp;
branches ;
next     1.12;

1.12
date     86.07.14.11.19.18;  author geli;  state Exp;
branches ;
next     1.11;

1.11
date     86.07.11.15.10.56;  author hal;  state Exp;
branches ;
next     1.10;

1.10
date     86.07.11.14.14.03;  author hal;  state Exp;
branches ;
next     1.9;

1.9
date     86.07.11.14.11.48;  author hal;  state Exp;
branches ;
next     1.8;

1.8
date     86.07.08.15.46.19;  author geli;  state Exp;
branches ;
next     1.7;

1.7
date     86.07.08.13.39.56;  author hal;  state Exp;
branches ;
next     1.6;

1.6
date     86.07.08.13.28.28;  author hal;  state Exp;
branches ;
next     1.5;

1.5
date     86.07.08.09.05.24;  author hal;  state Exp;
branches ;
next     1.4;

1.4
date     86.07.04.13.02.09;  author hal;  state Exp;
branches ;
next     1.3;

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

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

1.1
date     86.06.04.08.47.55;  author geli;  state tmp;
branches ;
next     ;


desc
@Base file for PWS 3.2 release.

@


56.3
log
@
pws2rcs automatic delta on Wed Jan 27 13:14:25 MST 1993
@
text
@$modcal$
$allow_packed on$ {jws 3/31/87}
$linenum 9000$
$lines 54$

$partial_eval on$

$range off$
$ovflcheck off$
$debug off$

module hfsupport;


{ OS-specific and miscellaneous support routines for HFS }


$search 'hfstuff'$
import
    sysglobals,
    misc,
    asm,
    fs,
    loader,
    sysdevs,
    iocomasm,
    hfstuff;


export

const
    DISK_SECTOR = 256;

$if 1=0$
var
    printmesg: boolean; {debug use only}
    xprintmesg: boolean; {debug use only}
$end$

type
    pac_type = packed array[1..maxint] of char;

procedure init_support;

procedure init_support_unit(unum: unitnum; corrupt: boolean);

procedure get_bytes(unit: unitnum;
		    size, start: integer; buffer: windowp);

procedure put_bytes(unit: unitnum;
		    size, start: integer; buffer: windowp);

procedure copy_user_data(sourcebyte, destbyte, size: integer);

function set_unit(unum: unitnum) : unitnum;

procedure check_disk_status;

function get_uid: integer;

procedure set_uid(user_id: ushort);

function get_gid: integer;

procedure set_gid(group_id: ushort);

function get_umask: integer;

procedure medium_gone;

procedure medium_back(rootname: vid);

procedure pac_to_string(anyvar pac: pac_type;
			length: integer;
			var strng: string);

function in_use(ino: integer): boolean;

procedure set_corrupt;

function value(symbol: string255): integer;

$if 1=0$
{DEBUG AIDS}
procedure report(mesg : string255);
procedure reportn(mesg : string255; value : integer);
procedure xreport(mesg : string255);
procedure xreportn(mesg : string255; value : integer);
procedure freeze;
$end$

implement

const
    debug = false;

var
    {for raw I/O transactions to the unit}
    tempfib: fibp;
    dummywindow: shortint;

    { current base unit, set by set_unit }
    current_unum: integer;
    { current unum used by dam, also from set_unit }
    dam_unum: integer;

type
    id_record = packed record
	user_id: ushort;
	group_id: ushort;
    end;
    id_tabletype = array[0..maxunit] of id_record;

var
    id_unitable: ^id_tabletype;

$if debug$
    {DBG}
    lines_out: integer;
$end$

$if debug$
procedure report(mesg : string255);
var temperr : integer;
begin
 temperr := ioresult;
 if printmesg then begin
  writeln(mesg);
  lines_out := lines_out + 1;
  if lines_out = 20 then freeze;
 end;
 ioresult := temperr;
end;

procedure reportn(mesg : string255; value : integer);
var temperr : integer;
begin
 temperr := ioresult;
 if printmesg then begin
  writeln(mesg,' ',value:1);
  lines_out := lines_out + 1;
  if lines_out = 20 then freeze;
 end;
 ioresult := temperr;
end;

procedure xreport(mesg : string255);
var temperr : integer;
begin
 temperr := ioresult;
 if xprintmesg then begin
  writeln(mesg);
  lines_out := lines_out + 1;
  if lines_out = 20 then freeze;
 end;
 ioresult := temperr;
end;

procedure xreportn(mesg : string255; value : integer);
var temperr : integer;
begin
 temperr := ioresult;
 if xprintmesg then begin
  writeln(mesg,' ',value:1);
  lines_out := lines_out + 1;
  if lines_out = 20 then freeze;
 end;
 ioresult := temperr;
end;

procedure freeze;
var achar : char;
    temperr : integer;
begin
 temperr := ioresult;
 if printmesg then begin
  write('frozen ');
  read(achar);
 end;
 ioresult := temperr;
 lines_out := 0;
end;
$end$


{-----------------------------------------------------------------}
{
{ convert a pac of given length to a string
}
procedure pac_to_string(anyvar pac: pac_type;
			length: integer;
			var strng: string);
var
    i: integer;
begin
    setstrlen(strng, length);
    for i := 1 to length do
	strng[i] := pac[i];
end;


{--------------------------------------------------------------------}
{
{ in_use
{ tell if this inumber can be deleted or have its name changed
{ NOT if it's the root, or the prefix of any aliased unit
}
function in_use(ino: integer): boolean;
label
    999;
var
    unit: integer;
begin
    in_use := true;
    if ino = root_inode then
	goto 999;
    for unit := 1 to maxunit do
	with h_unitable^.tbl[unit] do
	    if is_hfsunit
	    and (base_unum = current_unum)
	    and (prefix = ino) then
		goto 999;
    in_use := false;
999:
end;

{-----------------------------------------------------------------------}
{
{ setuptempfib
{ sets up a temporary FIB for use with the old TM (saved in h_unitable)
{ to do the actual I/O required for hfsdam or hfstm. The FIB can
{ only be considered valid DURING one invocation of the file system
{ (DAM or TM). Setuptempfib is invoked by set_unit, which is called at
{ the beginning of each TM or DAM execution by get_superblock, or when
{ ever tempfib is temporarily reopened for purpose of flushing a
{ "foreign" cache record..
{ The FIB is used by routines get_bytes and put_bytes.
{ Added setuptempfibn, to set up tempfib for any unit (see get/put_bytes
{ fix for flushing non-dam_unum cache record). Setuptempfib still sets up
{ tempfib for dam_unum. Get/put_bytes always leave tempfib as they found it.
{ SFB
}
procedure setuptempfibn(unit:integer);
begin
    finitb(tempfib^, addr(dummywindow), 1);
    with tempfib^ do begin
	pathid := 0;
	funit  := unit {dam_unum};
	{ next line does not do i/o to disk }
	unblockeddam(tempfib^, unit {dam_unum}, openunit);
	{ BASIC -- you could open the FIB now }
	freadable  := true;
	fwriteable := true;
	feof       := false;
	feoln      := false;
    end;
end;

procedure setuptempfib;
begin
 setuptempfibn(dam_unum);
end;

{--------------------------------------------------------------------}
{
{ goodio
{ check the results of an i/o or status request
{ set ioresult if any error
{ tmpumax is the umaxbytes before the operation being checked.
{ some TM's set umaxbytes to 256 to show medium gone
{ escape on any error other than icorrupt
{ Added test_unit, so goodio checks proper unit when flushing to
{ non-DAM_UNUM disc.
{ SFB
}
procedure goodio(test_unit:integer{SFB}; tmpumax: integer);
begin
    with unitable^[test_unit {was dam_unum. SFB}] do begin
	if umaxbytes = 256 then begin
	    umaxbytes := tmpumax;
	    ioresult := ord(znotready);
	end
	else
	if not umediavalid then
	    ioresult := ord(zmediumchanged);
	{ escape if there is any ioresult }
	if (ioresult <> ord(inoerror)) and (ioresult <> ord(icorrupt)) then
	    escape(-10);
    end;
end;


{--------------------------------------------------------------------}
{
{ get_bytes, put_bytes
{ Use old TM to access disk as raw device.
{ Use tempfib, set up by setuptempfib, or setuptempfibn.
{ Added fix for "files open on more than one unit" (alias "Librarian 2 units
{ bug") bug. This fix allows get_bytes and put_bytes to deal with units that
{ are not DAM_UNUM. The cause is the hfstm optimization that leaves
{ dirty cache records unflushed at normal termination. These caused problems
{ when a file on another unit was closed, or the DAM called at all on another
{ unit with the dirty records still in cache, flushing those dirty records to
{ the wrong disc. The fix sets up tempfib properly, by  temporarily
{ reinitializing it if get/put_bytes are dealing with cache records for a
{ unit that is not DAM_UNUM.
{ Then the setuptempfib initialization of tempfib is restored.
{ Note one weakness, due to cacher design: if we are flushing a dirty record
{ from a foreign unit, we cannot use the "correct" tm (the one for the unit
{ via which the record was originally loaded. We can only use the tm for the
{ base_unum of that unit. A minor internals bug, usually effectless.
{ SFB
}
procedure get_bytes(unit: unitnum; size, start: integer; buffer: windowp);
var
    tmpumax: integer;
    tmpior : integer;
    changedfib: boolean;
begin
    changedfib:=false;
    if h_unitable^.tbl[unit].base_unum<>h_unitable^.tbl[dam_unum].base_unum
    then        {SFB}
      begin
       {We are reading for another unit than called with, so
	set up tempfib for that unit.
	Getbytes needs this fix because to flush inodes, we need
	to read in the buffer, modify it, then flush it. See read_buf.
	SFB}
       setuptempfibn(unit);
       changedfib:=true;
      end
    else
     { ignore incoming unit, which is the base unit from the cache }
     unit:=dam_unum;    {so that we use DAM_UNUM in following call, etc. SFB}

    with unitable^[unit {was dam_unum. SFB}] do begin
	umediavalid := true;
	tmpumax := umaxbytes;
	if h_unitable^.tbl[unit].is_hfsunit then
	 call(h_unitable^.tbl[unit].tm {OLD tm or H/W tm} ,
	      tempfib, readbytes, buffer^, size, start)
	else   {tm in h_unitable not set up, so call unitable tm}
	 call(tm {THE tm for non-HFS unit} ,
	      tempfib, readbytes, buffer^, size, start);
	if changedfib then      {restore for dam_unum. SFB}
	 begin
	  tmpior := ioresult;
	  setuptempfib;
	  ioresult := tmpior;
	 end;
	goodio(unit {SFB}, tmpumax);
    end;
end;

procedure put_bytes(unit: unitnum; size, start: integer; buffer: windowp);
var
    tmpumax: integer;
    tmpior : integer;
    changedfib: boolean;
begin
    { don't write on a corrupt file system (unit is base unit) }
    if h_unitable^.tbl[unit].fs_corrupt then begin
	ioresult := ord(icorrupt);
	escape(-10);
    end;

    changedfib:=false;
    if h_unitable^.tbl[unit].base_unum<>h_unitable^.tbl[dam_unum].base_unum
    then        {SFB}
      begin     {we are flushing for another unit than called with, so
		 set up tempfib for that unit. SFB}
       setuptempfibn(unit);
       changedfib:=true;
      end
    else
     { ignore incoming unit, which is the base unit from the cache }
     unit:=dam_unum;    {so that we use DAM_UNUM in call, etc. SFB}
    { ignore incoming unit, which is the base unit from the cache }

    with unitable^[unit {was dam_unum. SFB}] do begin
	umediavalid := true;
	tmpumax := umaxbytes;
	if h_unitable^.tbl[unit].is_hfsunit then
	 call(h_unitable^.tbl[unit].tm {OLD tm or H/W tm} ,
	      tempfib, writebytes, buffer^, size, start)
	else   {tm in h_unitable not set up, so call unitable tm}
	 call(tm {THE tm for non-HFS unit} ,
	      tempfib, writebytes, buffer^, size, start);
	if changedfib then      {restore for dam_unum. SFB}
	 begin
	  tmpior := ioresult;
	  setuptempfib;
	  ioresult := tmpior;
	 end;
	goodio(unit, tmpumax);
    end;
end;

{------------------------------------------------------------------------}
{
{ Copy user data across the disk.
{ Used for growing files from smaller frag cluster into larger.
{ Using cache is bad because the blocks are small, and because we would
{ have to forget the contents anyway.
}
procedure copy_user_data(sourcebyte, destbyte, size: integer);
const
    slop = 1000;
var
    heaptop, workspace: windowp;
    nmoves, movesize, tailsize, i, position: integer;
    avail: integer;
begin
    { avail -- how much heap space we could use }
    avail := memavail - slop;
    if avail < DEV_BSIZE then begin
$if debug$
	reportn('fail copydata, space available only', avail);
$end$
	escape(-2);
    end;

    { nmoves -- number of moves; movesize -- how much to move at once }
    if avail < size then begin
	{ movesize is avail rounded down to DEV_BSIZE boundary }
	movesize := (avail div DEV_BSIZE) * DEV_BSIZE;
	nmoves := size div movesize;
    end
    else begin
	movesize := size;
	nmoves := 1;
    end;

    position := 0;
    mark(heaptop);
    newbytes(workspace, movesize);
    try
	{copy the movesize blocks}
	for i:= 1 to nmoves do begin
	    get_bytes(dam_unum, movesize, sourcebyte+position, workspace);
	    put_bytes(dam_unum, movesize, destbyte+position, workspace);
	    position := position + movesize;
	end;
	{ copy whatever is left over }
	if position <> size then begin
	    tailsize := size - position;
	    get_bytes(dam_unum, tailsize, sourcebyte+position, workspace);
	    put_bytes(dam_unum, tailsize, destbyte+position, workspace);
	end;
	escape(0);
    recover begin
	release(heaptop);
	if escapecode <> 0 then begin
$if debug$
	    reportn('escapecode at copy complete', escapecode);
$end$
	    escape(escapecode);
	end;
    end;
end;

{---------------------------------------------------------------------}
{
{ Check the disk status.
{ With reportchange true (we set this on DAM entry), we see
{ 1) if disk popped and then put back in, or turned off and back on
{       umediavalid FALSE
{       we translate this to ioresult zmediumchanged
{ 2) if disk out, or off
{       either umaxbytes set to 256, or some ioresult
{       we change the first case to znotready, and leave the second alone
{ Called from get_superblock and getvolumename.
}
{ Added code to preserve info about umediavalid for floppies. If umediavalid
{ false on floppy, generate zmediumchanged so we can invalidate cache for it.
{ This solves problem of unit #3 consuming disk controller status for "medium"
{ changed", before #43 sees it. This works because CS80 tm sets umediavalid
{ false on all same_media units, when it sets it false on one.
{ MINI is upgraded in 3.2 to also do this. AMIGO not done, as no AMIGO
{ removable disks supported on HFS.
{
{ Goodio generates an zmediumchanged and escapes if not umediavalid.
{
{ Umediavalid is not quite reliable
{ as an indication of "medium change"; it is too conservative, being set false
{ by Command Interpreter sometimes, to indicate "cleanup". The "I" key, or
{ an untrapped escape in the CI will do this. This would make prefixing of
{ floppies "unreliable", as the prefix needs to "pop" when umediavalid is seen
{ false. Therefore the HFSDAM disallows prefixing floppies below their root.
{ SFB
}
procedure check_disk_status;
var
    tmpumax: integer;
    zmed:    boolean;   {SFB}
begin
    with unitable^[dam_unum] do
     begin
      tmpumax := umaxbytes;
      zmed :=(umediavalid or uisfixed);
      umediavalid := true;
      call(h_unitable^.tbl[dam_unum].tm, tempfib, readbytes,
	   tempfib^.fbuffer, 0, 256);
     end;

    if (not zmed) or (ioresult <> ord(inoerror)) then    {SFB}
     ioresult:=ord(zmediumchanged);

    if ioresult = ord(ibadrequest) then
	ioresult := ord(inoerror);
    try
	goodio(dam_unum {SFB}, tmpumax);
    recover
	;
end;


{--------------------------------------------------------------------}
{
{ set up support for the given unit
{ called from get_superblock and init_hfs_unit
{ we return the BASE unit, so cacher can recognize all its buffers
{ We may be called before is_hfsunit is set, which means that
{ we should copy over the old TM for use by init_hfs_unit.
}
function set_unit(unum: unitnum): unitnum;
begin
    dam_unum := unum;
    with h_unitable^.tbl[unum] do begin
	current_unum := base_unum;
	if not is_hfsunit then
	    tm := unitable^[unum].tm;
    end;
    setuptempfib;
    set_unit := current_unum;
end;

function id_decode(id: ushort): ushort;
begin
    id_decode := id;
end;

function id_encode(id: ushort): ushort;
begin
    id_encode := id;
end;

function get_uid: integer;
begin
    get_uid := id_decode(id_unitable^[dam_unum].user_id);
end;

procedure set_uid(user_id: ushort);
begin
    id_unitable^[dam_unum].user_id := id_encode(user_id);
end;

function get_gid: integer;
begin
    get_gid := id_decode(id_unitable^[dam_unum].group_id);
end;

procedure set_gid(group_id: ushort);
begin
    id_unitable^[dam_unum].group_id := id_encode(group_id);
end;

function get_umask: integer;
begin
    get_umask := h_unitable^.tbl[dam_unum].umask;
end;

{---------------------------------------------------------------------}
{
{ medium_gone
{ The medium has changed, so reset all prefixes to the root,
{ and forget the uvid.
}
procedure medium_gone;
var
    i: integer;
begin
    for i := 0 to maxunit do
	with h_unitable^.tbl[i] do
	    if is_hfsunit and (base_unum = current_unum) then begin
		prefix := root_inode;
		unitable^[i].uvid := '';
	    end;
end;

{------------------------------------------------------------------}
{
{ medium_back
{ We have a valid superblock.  If the uvid was lost (set to ''),
{ we can now reset it correctly.
}
procedure medium_back(rootname: vid);
var
    i, my_base: integer;
begin
    with h_unitable^ do begin
	my_base := tbl[current_unum].base_unum;
	for i := 1 to maxunit do with tbl[i] do
	    if is_hfsunit
	    and (prefix = root_inode)
	    and (base_unum = my_base) then
		with unitable^[i] do
		    if uvid = '' then uvid := rootname;
    end;
end;

{----------------------------------------------------------------------}
{
{ set_corrupt
{ set fs_corrupt bit in h_unitable (base unit)
{ this blocks all further writes on the unit, from
{ the TM or from HFS (put_bytes)
}
procedure set_corrupt;
begin
    h_unitable^.tbl[current_unum].fs_corrupt := true;
end;

{-----------------------------------------------------------------------}
{
{ value
{ find value of symbol in symbol table
{ returns 0 if not found
{ taken from CTABLE
}
function value(symbol: string255): integer;
  var
    modp: moddescptr;
    ptr, valueptr: addrec;
    found: boolean;
  begin {value}
    value := 0;
    found := false;
    modp := sysdefs;
    while (modp<>nil) and not found do
      with modp^ do
	begin
	  ptr := defaddr;
	  while (ptr.a<defaddr.a+defsize) and not found do
	    begin
	      found := ptr.syp^=symbol;
	      ptr.a := ptr.a+strlen(ptr.syp^)+1;
	      ptr.a := ptr.a+ord(odd(ptr.a));
	      valueptr.a := ptr.a+2;
	      if found then
		value := valueptr.vep^.value;
	      ptr.a := ptr.a+ptr.gvp^.short;
	    end; {while}
	  modp := link;
	end; {with modp^}
  end; {value}


{--------------------------------------------------------------------}
{
{ init_support_unit
{ Called ONCE for each unit installed to hfsdam/hfstm.
{ Called by init_hfs_unit in cacher.
{ Sets up base_unum "synonym" for other unitable/h_unitable
{ entries on the same physical unit.
{ Note the assumption that the unit table sa/ba/du/... entries
{ are already correct.
}
procedure init_support_unit(unum: unitnum; corrupt: boolean);
var
    i: shortint;
begin
    with h_unitable^.tbl[unum] do begin
	base_unum := unum;
	is_hfsunit := true;
	fs_corrupt := corrupt;
	prefix := root_inode;
	umask := 0;
    end;
end;


{--------------------------------------------------------------------}
{
{ init_support
{ Called at driver install time, and also whenever TABLE runs.
}
procedure init_support;
var
    i: shortint;
begin
    {create a fib and close it}
    if tempfib = NIL then begin
	new(tempfib);
	tempfib^.freadable  := false;
	tempfib^.fwriteable := false;
    end;


    if h_unitable = nil then
	new(h_unitable);
    for i:=0 to maxunit do
	with h_unitable^.tbl[i] do begin
	    is_hfsunit := FALSE;
	    fs_corrupt := FALSE;
	    { set base_unum for use by init_hfs_unit }
	    base_unum := i;
	end;

    if id_unitable = nil then
	new(id_unitable);
    for i:=0 to maxunit do
	with id_unitable^[i] do begin
	    user_id  := paws_uid;
	    group_id := paws_gid;
	end;

end;

end.





@


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


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 726
$modcal$
$allow_packed on$ {jws 3/31/87}
$linenum 9000$
$lines 54$

$partial_eval on$

$range off$
$ovflcheck off$
$debug off$

module hfsupport;


{ OS-specific and miscellaneous support routines for HFS }


$search 'hfstuff'$
import
    sysglobals,
    misc,
    asm,
    fs,
    loader,
    sysdevs,
    iocomasm,
    hfstuff;


export

const
    DISK_SECTOR = 256;

$if 1=0$
var
    printmesg: boolean; {debug use only}
    xprintmesg: boolean; {debug use only}
$end$

type
    pac_type = packed array[1..maxint] of char;

procedure init_support;

procedure init_support_unit(unum: unitnum; corrupt: boolean);

procedure get_bytes(unit: unitnum;
		    size, start: integer; buffer: windowp);

procedure put_bytes(unit: unitnum;
		    size, start: integer; buffer: windowp);

procedure copy_user_data(sourcebyte, destbyte, size: integer);

function set_unit(unum: unitnum) : unitnum;

procedure check_disk_status;

function get_uid: integer;

procedure set_uid(user_id: ushort);

function get_gid: integer;

procedure set_gid(group_id: ushort);

function get_umask: integer;

procedure medium_gone;

procedure medium_back(rootname: vid);

procedure pac_to_string(anyvar pac: pac_type;
			length: integer;
			var strng: string);

function in_use(ino: integer): boolean;

procedure set_corrupt;

function value(symbol: string255): integer;

$if 1=0$
{DEBUG AIDS}
procedure report(mesg : string255);
procedure reportn(mesg : string255; value : integer);
procedure xreport(mesg : string255);
procedure xreportn(mesg : string255; value : integer);
procedure freeze;
$end$

implement

const
    debug = false;

var
    {for raw I/O transactions to the unit}
    tempfib: fibp;
    dummywindow: shortint;

    { current base unit, set by set_unit }
    current_unum: integer;
    { current unum used by dam, also from set_unit }
    dam_unum: integer;

type
    id_record = packed record
	user_id: ushort;
	group_id: ushort;
    end;
    id_tabletype = array[0..maxunit] of id_record;

var
    id_unitable: ^id_tabletype;

$if debug$
    {DBG}
    lines_out: integer;
$end$

$if debug$
procedure report(mesg : string255);
var temperr : integer;
begin
 temperr := ioresult;
 if printmesg then begin
  writeln(mesg);
  lines_out := lines_out + 1;
  if lines_out = 20 then freeze;
 end;
 ioresult := temperr;
end;

procedure reportn(mesg : string255; value : integer);
var temperr : integer;
begin
 temperr := ioresult;
 if printmesg then begin
  writeln(mesg,' ',value:1);
  lines_out := lines_out + 1;
  if lines_out = 20 then freeze;
 end;
 ioresult := temperr;
end;

procedure xreport(mesg : string255);
var temperr : integer;
begin
 temperr := ioresult;
 if xprintmesg then begin
  writeln(mesg);
  lines_out := lines_out + 1;
  if lines_out = 20 then freeze;
 end;
 ioresult := temperr;
end;

procedure xreportn(mesg : string255; value : integer);
var temperr : integer;
begin
 temperr := ioresult;
 if xprintmesg then begin
  writeln(mesg,' ',value:1);
  lines_out := lines_out + 1;
  if lines_out = 20 then freeze;
 end;
 ioresult := temperr;
end;

procedure freeze;
var achar : char;
    temperr : integer;
begin
 temperr := ioresult;
 if printmesg then begin
  write('frozen ');
  read(achar);
 end;
 ioresult := temperr;
 lines_out := 0;
end;
$end$


{-----------------------------------------------------------------}
{
{ convert a pac of given length to a string
}
procedure pac_to_string(anyvar pac: pac_type;
			length: integer;
			var strng: string);
var
    i: integer;
begin
    setstrlen(strng, length);
    for i := 1 to length do
	strng[i] := pac[i];
end;


{--------------------------------------------------------------------}
{
{ in_use
{ tell if this inumber can be deleted or have its name changed
{ NOT if it's the root, or the prefix of any aliased unit
}
function in_use(ino: integer): boolean;
label
    999;
var
    unit: integer;
begin
    in_use := true;
    if ino = root_inode then
	goto 999;
    for unit := 1 to maxunit do
	with h_unitable^.tbl[unit] do
	    if is_hfsunit
	    and (base_unum = current_unum)
	    and (prefix = ino) then
		goto 999;
    in_use := false;
999:
end;

{-----------------------------------------------------------------------}
{
{ setuptempfib
{ sets up a temporary FIB for use with the old TM (saved in h_unitable)
{ to do the actual I/O required for hfsdam or hfstm. The FIB can
{ only be considered valid DURING one invocation of the file system
{ (DAM or TM). Setuptempfib is invoked by set_unit, which is called at
{ the beginning of each TM or DAM execution by get_superblock, or when
{ ever tempfib is temporarily reopened for purpose of flushing a
{ "foreign" cache record..
{ The FIB is used by routines get_bytes and put_bytes.
{ Added setuptempfibn, to set up tempfib for any unit (see get/put_bytes
{ fix for flushing non-dam_unum cache record). Setuptempfib still sets up
{ tempfib for dam_unum. Get/put_bytes always leave tempfib as they found it.
{ SFB
}
procedure setuptempfibn(unit:integer);
begin
    finitb(tempfib^, addr(dummywindow), 1);
    with tempfib^ do begin
	pathid := 0;
	funit  := unit {dam_unum};
	{ next line does not do i/o to disk }
	unblockeddam(tempfib^, unit {dam_unum}, openunit);
	{ BASIC -- you could open the FIB now }
	freadable  := true;
	fwriteable := true;
	feof       := false;
	feoln      := false;
    end;
end;

procedure setuptempfib;
begin
 setuptempfibn(dam_unum);
end;

{--------------------------------------------------------------------}
{
{ goodio
{ check the results of an i/o or status request
{ set ioresult if any error
{ tmpumax is the umaxbytes before the operation being checked.
{ some TM's set umaxbytes to 256 to show medium gone
{ escape on any error other than icorrupt
{ Added test_unit, so goodio checks proper unit when flushing to
{ non-DAM_UNUM disc.
{ SFB
}
procedure goodio(test_unit:integer{SFB}; tmpumax: integer);
begin
    with unitable^[test_unit {was dam_unum. SFB}] do begin
	if umaxbytes = 256 then begin
	    umaxbytes := tmpumax;
	    ioresult := ord(znotready);
	end
	else
	if not umediavalid then
	    ioresult := ord(zmediumchanged);
	{ escape if there is any ioresult }
	if (ioresult <> ord(inoerror)) and (ioresult <> ord(icorrupt)) then
	    escape(-10);
    end;
end;


{--------------------------------------------------------------------}
{
{ get_bytes, put_bytes
{ Use old TM to access disk as raw device.
{ Use tempfib, set up by setuptempfib, or setuptempfibn.
{ Added fix for "files open on more than one unit" (alias "Librarian 2 units
{ bug") bug. This fix allows get_bytes and put_bytes to deal with units that
{ are not DAM_UNUM. The cause is the hfstm optimization that leaves
{ dirty cache records unflushed at normal termination. These caused problems
{ when a file on another unit was closed, or the DAM called at all on another
{ unit with the dirty records still in cache, flushing those dirty records to
{ the wrong disc. The fix sets up tempfib properly, by  temporarily
{ reinitializing it if get/put_bytes are dealing with cache records for a
{ unit that is not DAM_UNUM.
{ Then the setuptempfib initialization of tempfib is restored.
{ Note one weakness, due to cacher design: if we are flushing a dirty record
{ from a foreign unit, we cannot use the "correct" tm (the one for the unit
{ via which the record was originally loaded. We can only use the tm for the
{ base_unum of that unit. A minor internals bug, usually effectless.
{ SFB
}
procedure get_bytes(unit: unitnum; size, start: integer; buffer: windowp);
var
    tmpumax: integer;
    tmpior : integer;
    changedfib: boolean;
begin
    changedfib:=false;
    if h_unitable^.tbl[unit].base_unum<>h_unitable^.tbl[dam_unum].base_unum
    then        {SFB}
      begin
       {We are reading for another unit than called with, so
	set up tempfib for that unit.
	Getbytes needs this fix because to flush inodes, we need
	to read in the buffer, modify it, then flush it. See read_buf.
	SFB}
       setuptempfibn(unit);
       changedfib:=true;
      end
    else
     { ignore incoming unit, which is the base unit from the cache }
     unit:=dam_unum;    {so that we use DAM_UNUM in following call, etc. SFB}

    with unitable^[unit {was dam_unum. SFB}] do begin
	umediavalid := true;
	tmpumax := umaxbytes;
	if h_unitable^.tbl[unit].is_hfsunit then
	 call(h_unitable^.tbl[unit].tm {OLD tm or H/W tm} ,
	      tempfib, readbytes, buffer^, size, start)
	else   {tm in h_unitable not set up, so call unitable tm}
	 call(tm {THE tm for non-HFS unit} ,
	      tempfib, readbytes, buffer^, size, start);
	if changedfib then      {restore for dam_unum. SFB}
	 begin
	  tmpior := ioresult;
	  setuptempfib;
	  ioresult := tmpior;
	 end;
	goodio(unit {SFB}, tmpumax);
    end;
end;

procedure put_bytes(unit: unitnum; size, start: integer; buffer: windowp);
var
    tmpumax: integer;
    tmpior : integer;
    changedfib: boolean;
begin
    { don't write on a corrupt file system (unit is base unit) }
    if h_unitable^.tbl[unit].fs_corrupt then begin
	ioresult := ord(icorrupt);
	escape(-10);
    end;

    changedfib:=false;
    if h_unitable^.tbl[unit].base_unum<>h_unitable^.tbl[dam_unum].base_unum
    then        {SFB}
      begin     {we are flushing for another unit than called with, so
		 set up tempfib for that unit. SFB}
       setuptempfibn(unit);
       changedfib:=true;
      end
    else
     { ignore incoming unit, which is the base unit from the cache }
     unit:=dam_unum;    {so that we use DAM_UNUM in call, etc. SFB}
    { ignore incoming unit, which is the base unit from the cache }

    with unitable^[unit {was dam_unum. SFB}] do begin
	umediavalid := true;
	tmpumax := umaxbytes;
	if h_unitable^.tbl[unit].is_hfsunit then
	 call(h_unitable^.tbl[unit].tm {OLD tm or H/W tm} ,
	      tempfib, writebytes, buffer^, size, start)
	else   {tm in h_unitable not set up, so call unitable tm}
	 call(tm {THE tm for non-HFS unit} ,
	      tempfib, writebytes, buffer^, size, start);
	if changedfib then      {restore for dam_unum. SFB}
	 begin
	  tmpior := ioresult;
	  setuptempfib;
	  ioresult := tmpior;
	 end;
	goodio(unit, tmpumax);
    end;
end;

{------------------------------------------------------------------------}
{
{ Copy user data across the disk.
{ Used for growing files from smaller frag cluster into larger.
{ Using cache is bad because the blocks are small, and because we would
{ have to forget the contents anyway.
}
procedure copy_user_data(sourcebyte, destbyte, size: integer);
const
    slop = 1000;
var
    heaptop, workspace: windowp;
    nmoves, movesize, tailsize, i, position: integer;
    avail: integer;
begin
    { avail -- how much heap space we could use }
    avail := memavail - slop;
    if avail < DEV_BSIZE then begin
$if debug$
	reportn('fail copydata, space available only', avail);
$end$
	escape(-2);
    end;

    { nmoves -- number of moves; movesize -- how much to move at once }
    if avail < size then begin
	{ movesize is avail rounded down to DEV_BSIZE boundary }
	movesize := (avail div DEV_BSIZE) * DEV_BSIZE;
	nmoves := size div movesize;
    end
    else begin
	movesize := size;
	nmoves := 1;
    end;

    position := 0;
    mark(heaptop);
    newbytes(workspace, movesize);
    try
	{copy the movesize blocks}
	for i:= 1 to nmoves do begin
	    get_bytes(dam_unum, movesize, sourcebyte+position, workspace);
	    put_bytes(dam_unum, movesize, destbyte+position, workspace);
	    position := position + movesize;
	end;
	{ copy whatever is left over }
	if position <> size then begin
	    tailsize := size - position;
	    get_bytes(dam_unum, tailsize, sourcebyte+position, workspace);
	    put_bytes(dam_unum, tailsize, destbyte+position, workspace);
	end;
	escape(0);
    recover begin
	release(heaptop);
	if escapecode <> 0 then begin
$if debug$
	    reportn('escapecode at copy complete', escapecode);
$end$
	    escape(escapecode);
	end;
    end;
end;

{---------------------------------------------------------------------}
{
{ Check the disk status.
{ With reportchange true (we set this on DAM entry), we see
{ 1) if disk popped and then put back in, or turned off and back on
{       umediavalid FALSE
{       we translate this to ioresult zmediumchanged
{ 2) if disk out, or off
{       either umaxbytes set to 256, or some ioresult
{       we change the first case to znotready, and leave the second alone
{ Called from get_superblock and getvolumename.
}
{ Added code to preserve info about umediavalid for floppies. If umediavalid
{ false on floppy, generate zmediumchanged so we can invalidate cache for it.
{ This solves problem of unit #3 consuming disk controller status for "medium"
{ changed", before #43 sees it. This works because CS80 tm sets umediavalid
{ false on all same_media units, when it sets it false on one.
{ MINI is upgraded in 3.2 to also do this. AMIGO not done, as no AMIGO
{ removable disks supported on HFS.
{
{ Goodio generates an zmediumchanged and escapes if not umediavalid.
{
{ Umediavalid is not quite reliable
{ as an indication of "medium change"; it is too conservative, being set false
{ by Command Interpreter sometimes, to indicate "cleanup". The "I" key, or
{ an untrapped escape in the CI will do this. This would make prefixing of
{ floppies "unreliable", as the prefix needs to "pop" when umediavalid is seen
{ false. Therefore the HFSDAM disallows prefixing floppies below their root.
{ SFB
}
procedure check_disk_status;
var
    tmpumax: integer;
    zmed:    boolean;   {SFB}
begin
    with unitable^[dam_unum] do
     begin
      tmpumax := umaxbytes;
      zmed :=(umediavalid or uisfixed);
      umediavalid := true;
      call(h_unitable^.tbl[dam_unum].tm, tempfib, readbytes,
	   tempfib^.fbuffer, 0, 256);
     end;

    if (not zmed) or (ioresult <> ord(inoerror)) then    {SFB}
     ioresult:=ord(zmediumchanged);

    if ioresult = ord(ibadrequest) then
	ioresult := ord(inoerror);
    try
	goodio(dam_unum {SFB}, tmpumax);
    recover
	;
end;


{--------------------------------------------------------------------}
{
{ set up support for the given unit
{ called from get_superblock and init_hfs_unit
{ we return the BASE unit, so cacher can recognize all its buffers
{ We may be called before is_hfsunit is set, which means that
{ we should copy over the old TM for use by init_hfs_unit.
}
function set_unit(unum: unitnum): unitnum;
begin
    dam_unum := unum;
    with h_unitable^.tbl[unum] do begin
	current_unum := base_unum;
	if not is_hfsunit then
	    tm := unitable^[unum].tm;
    end;
    setuptempfib;
    set_unit := current_unum;
end;

function id_decode(id: ushort): ushort;
begin
    id_decode := id;
end;

function id_encode(id: ushort): ushort;
begin
    id_encode := id;
end;

function get_uid: integer;
begin
    get_uid := id_decode(id_unitable^[dam_unum].user_id);
end;

procedure set_uid(user_id: ushort);
begin
    id_unitable^[dam_unum].user_id := id_encode(user_id);
end;

function get_gid: integer;
begin
    get_gid := id_decode(id_unitable^[dam_unum].group_id);
end;

procedure set_gid(group_id: ushort);
begin
    id_unitable^[dam_unum].group_id := id_encode(group_id);
end;

function get_umask: integer;
begin
    get_umask := h_unitable^.tbl[dam_unum].umask;
end;

{---------------------------------------------------------------------}
{
{ medium_gone
{ The medium has changed, so reset all prefixes to the root,
{ and forget the uvid.
}
procedure medium_gone;
var
    i: integer;
begin
    for i := 0 to maxunit do
	with h_unitable^.tbl[i] do
	    if is_hfsunit and (base_unum = current_unum) then begin
		prefix := root_inode;
		unitable^[i].uvid := '';
	    end;
end;

{------------------------------------------------------------------}
{
{ medium_back
{ We have a valid superblock.  If the uvid was lost (set to ''),
{ we can now reset it correctly.
}
procedure medium_back(rootname: vid);
var
    i, my_base: integer;
begin
    with h_unitable^ do begin
	my_base := tbl[current_unum].base_unum;
	for i := 1 to maxunit do with tbl[i] do
	    if is_hfsunit
	    and (prefix = root_inode)
	    and (base_unum = my_base) then
		with unitable^[i] do
		    if uvid = '' then uvid := rootname;
    end;
end;

{----------------------------------------------------------------------}
{
{ set_corrupt
{ set fs_corrupt bit in h_unitable (base unit)
{ this blocks all further writes on the unit, from
{ the TM or from HFS (put_bytes)
}
procedure set_corrupt;
begin
    h_unitable^.tbl[current_unum].fs_corrupt := true;
end;

{-----------------------------------------------------------------------}
{
{ value
{ find value of symbol in symbol table
{ returns 0 if not found
{ taken from CTABLE
}
function value(symbol: string255): integer;
  var
    modp: moddescptr;
    ptr, valueptr: addrec;
    found: boolean;
  begin {value}
    value := 0;
    found := false;
    modp := sysdefs;
    while (modp<>nil) and not found do
      with modp^ do
	begin
	  ptr := defaddr;
	  while (ptr.a<defaddr.a+defsize) and not found do
	    begin
	      found := ptr.syp^=symbol;
	      ptr.a := ptr.a+strlen(ptr.syp^)+1;
	      ptr.a := ptr.a+ord(odd(ptr.a));
	      valueptr.a := ptr.a+2;
	      if found then
		value := valueptr.vep^.value;
	      ptr.a := ptr.a+ptr.gvp^.short;
	    end; {while}
	  modp := link;
	end; {with modp^}
  end; {value}


{--------------------------------------------------------------------}
{
{ init_support_unit
{ Called ONCE for each unit installed to hfsdam/hfstm.
{ Called by init_hfs_unit in cacher.
{ Sets up base_unum "synonym" for other unitable/h_unitable
{ entries on the same physical unit.
{ Note the assumption that the unit table sa/ba/du/... entries
{ are already correct.
}
procedure init_support_unit(unum: unitnum; corrupt: boolean);
var
    i: shortint;
begin
    with h_unitable^.tbl[unum] do begin
	base_unum := unum;
	is_hfsunit := true;
	fs_corrupt := corrupt;
	prefix := root_inode;
	umask := 0;
    end;
end;


{--------------------------------------------------------------------}
{
{ init_support
{ Called at driver install time, and also whenever TABLE runs.
}
procedure init_support;
var
    i: shortint;
begin
    {create a fib and close it}
    if tempfib = NIL then begin
	new(tempfib);
	tempfib^.freadable  := false;
	tempfib^.fwriteable := false;
    end;


    if h_unitable = nil then
	new(h_unitable);
    for i:=0 to maxunit do
	with h_unitable^.tbl[i] do begin
	    is_hfsunit := FALSE;
	    fs_corrupt := FALSE;
	    { set base_unum for use by init_hfs_unit }
	    base_unum := i;
	end;

    if id_unitable = nil then
	new(id_unitable);
    for i:=0 to maxunit do
	with id_unitable^[i] do begin
	    user_id  := paws_uid;
	    group_id := paws_gid;
	end;

end;

end.





@


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


26.2
log
@
Comment from auto synch of clock fix:
date: 88/03/02 09:14:52;  author: bayes;  state: Exp;  lines added/del: 0/0
Automatic bump of revision number for PWS version 3.2Y
@
text
@@


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.2
log
@Reduced stack space need for get/put_bytes over 3.2L version (20.1).
Added setuptempfibn. Moved goodio calls from location in 3.2L.
@
text
@@


20.1
log
@Automatic bump of revision number for PWS version 3.2L
@
text
@d235 3
a237 1
{ the beginning of each TM or DAM execution by get_superblock.
d239 4
d244 1
a244 1
procedure setuptempfib;
d249 1
a249 1
	funit  := dam_unum;
d251 1
a251 1
	unblockeddam(tempfib^, dam_unum, openunit);
d260 5
d297 2
a298 2
{ use old TM to access disk as raw device.
{ use tempfib, set up by setuptempfib.
d305 3
a307 3
{ the wrong disc. The fix sets funit properly in tempfib, and temporarily
{ reinitializes it if get/put_bytes are dealing with cache records for a
{ unit that is not DAM_UNUM 9or current_unum for hfscache's point-of-view.
d318 2
a319 1
    tmpfib: fib;        {SFB}
d321 1
a321 1
    tmpfib := tempfib^;  {in case we need to reinit tempfib. SFB}
d324 8
a331 12
     with tempfib^ do
      begin  {We are reading for another unit than called with, so
	      set up tempfib for that unit. Ie. simulate setuptempfib.
	      Getbytes needs this fix because to flush inodes, we need
	      to read in the buffer, modify it, then flush it. See read_buf.
	      SFB}
       funit:=unit;
       unblockeddam(tempfib^, unit, openunit);
       freadable  := true;
       fwriteable := true;
       feof       := false;
       feoln      := false;
d346 6
a353 2

    tempfib^:=tmpfib;    {restore old tempfib. SFB}
d359 2
a360 1
    tmpfib: fib;        {SFB}
d368 1
a368 1
    tmpfib := tempfib^;  {in case we need to reinit tempfib. SFB}
a370 1
     with tempfib^ do
d372 3
a374 7
		 set up tempfib for that unit. Ie. simulate setuptempfib. SFB}
       funit:=unit;
       unblockeddam(tempfib^, unit, openunit);
       freadable  := true;
       fwriteable := true;
       feof       := false;
       feoln      := false;
d390 6
a397 2

   tempfib^:=tmpfib;     {restore old tempfib. SFB}
@


19.4
log
@Changed to $debug OFF$ (sorry 'bout that)
@
text
@@


19.3
log
@Main fix: get/put_bytes use correct tm depending on is_hfsunit. Also
compare base_unum to dam_unum, not unit to dam_unum.
@
text
@d10 1
a10 1
$debug oN $
@


19.2
log
@Fix for cache record flush of other-unit dirty record. Related to
hfstm no-sync of dirty records optimization
@
text
@d10 1
a10 1
$debug off$
d310 2
a311 1
    if unit<>h_unitable^.tbl[dam_unum].base_unum then        {SFB}
d316 2
a317 1
	      to read in the buffer, modify it, then flush it. See read_buf. SFB}
d332 6
a337 2
	call(h_unitable^.tbl[unit {was dam_unum. SFB}].tm {OLD tm} ,
	     tempfib, readbytes, buffer^, size, start);
d356 2
a357 1
    if unit<>h_unitable^.tbl[dam_unum].base_unum then        {SFB}
d376 6
a381 2
	call(h_unitable^.tbl[unit {was dam_unum. SFB}].tm {OLD tm},
	     tempfib, writebytes, buffer^, size, start);
@


19.1
log
@Automatic bump of revision number for PWS version 3.2K
@
text
@d262 3
d266 1
a266 1
procedure goodio(tmpumax: integer);
d268 1
a268 1
    with unitable^[dam_unum] do begin
d288 15
d307 1
d309 19
a327 2
    { ignore incoming unit, which is the base unit from the cache }
    with unitable^[dam_unum] do begin
d330 1
a330 1
	call(h_unitable^.tbl[dam_unum].tm {OLD tm} ,
d332 1
a332 1
	goodio(tmpumax);
d334 2
d341 1
d349 15
d365 2
a366 1
    with unitable^[dam_unum] do begin
d369 1
a369 1
	call(h_unitable^.tbl[dam_unum].tm {OLD tm},
d371 1
a371 1
	goodio(tmpumax);
d373 2
d490 1
a490 1
	goodio(tmpumax);
@


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


17.3
log
@Removed comment implying AMIGO supports HFS. Added comment saying
"no AMIGO removable media support on HFS"
@
text
@@


17.2
log
@Fixed "unreliable floppy cache after Volumes" bug. See hfsdam version 17.3
@
text
@d399 3
a401 2
{ false on all same_media units, when it sets it false on one. AMIGO and
{ MINI are upgraded in 3.2 to also do this.
@


17.1
log
@Automatic bump of revision number for PWS version 3.2I+
@
text
@d395 17
d415 1
d417 12
a428 4
    tmpumax := unitable^[dam_unum].umaxbytes;
    call(h_unitable^.tbl[dam_unum].tm, tempfib, readbytes,
	 tempfib^.fbuffer, 0, 256);
    { if device (e.g. RAM) can't clearunit, assume it's OK }
@


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.2
log
@Pws2unix automatic delta on Wed Apr  1 08:30:27 MST 1987
@
text
@@


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

@


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


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


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


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


8.2
log
@FSDat00682 -- fix so umaxbytes changes properly with floppy size
@
text
@@


8.1
log
@Automatic bump of revision number for PWS version 3.2A
@
text
@d266 1
a266 1
	if umaxbytes < tmpumax then begin
@


7.2
log
@In check_disk_status, use readbytes instead of clearunit.
Reason -- Amigo TM does not return useful info with
clearunit, which means that Amigo disks will not work with
previous versions.
@
text
@@


7.1
log
@Automatic bump of revision number for PWS version 3.2l
@
text
@d400 2
a401 2
    call(h_unitable^.tbl[dam_unum].tm, tempfib, clearunit,
	 tempfib^.fbuffer, 0, 0);
@


6.2
log
@check_disk_status -- if ibadrequest ("disk", which might be RAM volume, cannot
do a clearunit), assume that "disk" is OK.
@
text
@@


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


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


4.4
log
@Add value() from CTABLE for use in reading hfs_user values.
@
text
@@


4.3
log
@Change default umask to 0.
@
text
@d24 1
d82 2
d514 35
@


4.2
log
@Initialize fs_corrupt in h_unitable.  This was already done for HFS
units, but it needs doing for all units because of 3/43 business.
@
text
@d531 1
a531 1
	umask := octal('022');
@


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


3.4
log
@init_support_unit no longer tries to set base_unum properly.
Reason -- it's called from TABLE, when the unitable is in flux.
The code for setting base_unum is now in CTABLE.
@
text
@@


3.3
log
@$if debug$ around debugging stuff (off).
Cleanup.
@
text
@a524 3
    found: boolean;
{---------------}
function same_device(i: shortint): boolean;
a525 10
    with unitable^[i] do
	same_device := (unitable^[unum].sc = sc)
		   and (unitable^[unum].ba = ba)
		   and (unitable^[unum].du = du)
		   and (unitable^[unum].dv = dv)
		   and (unitable^[unum].letter = letter)
		   and (unitable^[unum].byteoffset = byteoffset);
end;
{---------------}
begin
a527 19

	found := false;   {search for other unitable entries on same H/W}
	{ convention: base_unum is the lowest-numbered unit }
	i := 0;
	while (i <= maxunit) and (not found) do
	    if (i <> unum)
	    and same_device(i) then begin
		if i < unum then begin
		    { existing units still OK }
		    base_unum := i;
		    found := true;
		end
		else
		    { new unit is lowest, so existing units all wrong }
		    h_unitable^.tbl[i].base_unum := unum;
	    end
	    else
		i := i + 1;

@


3.2
log
@goodio used to reset umaxbytes to 256 when TM had grown it.
Now we only reset umaxbytes if TM has shrunk it.  This fixes bug
where hfs floppy is unuseable unless floppy is in drive when
TABLE runs.
@
text
@d1 1
a1 2
$LINENUM 9000$
$LINES 54$
d3 2
a4 1
$MODCAL$
d6 2
d34 1
d38 1
d81 1
d88 1
d92 3
d115 1
d118 1
d120 1
d181 1
a235 2
var
    tempio: integer;
a285 1
    tmpioresult: integer;
d335 1
d337 1
d372 1
d374 1
d428 1
a428 1
  id_decode := id;
d433 1
a433 1
  id_encode := id;
d438 1
a438 1
  get_uid := id_decode(id_unitable^[dam_unum].user_id);
d443 1
a443 1
  id_unitable^[dam_unum].user_id := id_encode(user_id);
d448 1
a448 1
  get_gid := id_decode(id_unitable^[dam_unum].group_id);
d453 1
a453 1
  id_unitable^[dam_unum].group_id := id_encode(group_id);
d458 1
a458 1
  get_umask := h_unitable^.tbl[dam_unum].umask;
@


3.1
log
@Automatic bump of revision number for PWS version 3.2h
@
text
@d252 1
a252 1
	if umaxbytes <> tmpumax then begin
@


2.6
log
@New debugging stuff.  therwise the same.
@
text
@@


2.5
log
@Debug etc now off.
disc -> disk.
@
text
@d30 1
a30 1
    DISC_SECTOR = 256;
d106 2
d113 1
a113 1
 if printmesg then
d115 3
d125 1
a125 1
 if printmesg then
d127 3
d137 1
a137 1
 if xprintmesg then
d139 3
d149 1
a149 1
 if xprintmesg then
d151 3
d167 1
@


2.4
log
@init_hfs_unit now gets parameter telling whether corrupt or not;
this is true when superblock OK except for fs_clean.
@
text
@d6 3
a8 1
{$range off$ $ovflcheck off$ {want to enable this line when finished}
a9 2
$debug on$                 {debug OFF when finished}

d53 1
a53 1
procedure check_disc_status;
d215 1
a215 1
	{ next line does not do i/o to disc }
d254 1
a254 1
{ use old TM to access disc as raw device.
d294 1
a294 1
{ Copy user data across the disc.
d353 1
a353 1
{ Check the disc status.
d355 1
a355 1
{ 1) if disc popped and then put back in, or turned off and back on
d358 1
a358 1
{ 2) if disc out, or off
d363 1
a363 1
procedure check_disc_status;
@


2.3
log
@init_support_unit now sets up base_unum so that whenever
several units share the same device, the base_unum is always
the LOWEST such unit.  The user sees this convention through
rootname, which now uses the base_unum to form the default name.
,
@
text
@d41 1
a41 1
procedure init_support_unit(unum: unitnum);
d493 1
a493 1
procedure init_support_unit(unum: unitnum);
d532 1
a532 1
	fs_corrupt := false;
@


2.2
log
@medium_gone (was reset_prefix), medium_back (was
check_root_uvid) now here.
remove seed init for old random # generator.
@
text
@d514 1
d519 8
a526 3
		base_unum := h_unitable^.tbl[i].base_unum;
		{ only need to find one, as others already agree }
		found := true;
@


2.1
log
@Auto bump rev number to 2.1 for sys 3.2e.
@
text
@d65 1
a65 1
procedure reset_prefix(fs: super_block_ptr_type);
d67 2
a94 1
    seed: integer;
d434 1
a434 1
{ reset_prefix
d438 1
a438 1
procedure reset_prefix;
d450 21
a541 2
    seed := 12345;

@


1.26
log
@Pws2unix automatic delta on Wed Jul 30 09:07:03 MEZ 1986
@
text
@@


1.25
log
@Only changed a ouple of comments.
@
text
@d24 1
a24 2
    hfstuff,
    rnd;
a70 2
function randbetween(x, y: integer): integer;

a153 14
{---------------------------------------------------------------------}
{
{ randbetween
{ return a random integer between x and y, inclusive
}
function randbetween(x, y: integer): integer;
begin
    if x < y then begin
	random(seed);
	randbetween := x + seed mod (y - x);
    end
    else
	randbetween := x;
end;
a154 2


d543 1
a543 1
	    user_id  := {paws_uid} 0; {DEBUG}
@


1.24
log
@Remove a few debugging statements.
@
text
@d294 1
a294 1
    { don't write on a corrupt file system }
d471 1
a471 1
{ set fs_corrupt bit in h_unitable
@


1.23
log
@Debugging printout changes.
Rearrange base_unum calculations.
Don't escape get_bytes when we see icorrupt.  This should
allow reading, but not writing, corrupt discs.
@
text
@a385 1
    xreport('check disc -- calling tm');
a387 1
    xreport('check disc -- tm returned');
d391 1
a391 1
	xreportn('check disc -- goodio escaped', ioresult);
@


1.22
log
@Don't write on a corrupt file system..  Add routine
set_corrupt, sets corrupt bit in h_unitable.
@
text
@d35 1
d81 2
d127 18
d250 1
d263 1
a263 1
	if ioresult <> ord(inoerror) then
d278 1
d386 1
d389 1
d392 2
a393 1
    recover;
d400 1
a400 1
{ called from get_superblock
d402 2
d408 5
a412 1
    current_unum := h_unitable^.tbl[unum].base_unum;
d485 3
a487 3
{ called ONCE for each unit installed to hfsdam/hfstm
{ called by init_hfs_unit in cacher
{ sets up base_unum "symnonym" for othe unitable/h_unitable
d489 2
d496 2
d499 12
a510 1
    h_unitable^.tbl[unum].base_unum := unum;
d512 9
a520 16
    found := false;   {search for other unitable entries on same H/W}
    i := 0;
    while (i <= maxunit) and (not found) do begin
	with h_unitable^.tbl[i] do begin
	    if (i<>unum) and is_hfsunit then
		with unitable^[base_unum] do
		    if (unitable^[unum].sc = sc) and    {check for identity}
		       (unitable^[unum].ba = ba) and
		       (unitable^[unum].du = du) and
		       (unitable^[unum].dv = dv) and
		       (unitable^[unum].letter = letter) and
		       (unitable^[unum].byteoffset = byteoffset) then
			{identical units i and unum}
			found := true;
	    if not found then
		i := i+1
d522 1
a522 4
		h_unitable^.tbl[unum].base_unum := base_unum;
	{ only need to find one unit, since others already agree }
	end;
    end;
a523 1
    with h_unitable^.tbl[unum] do begin
d526 1
a528 1

d535 1
a535 2
{ to be called by the installation program for the hfs driver
{ exactly ONCE, at driver install time
a536 1

a540 1
    printmesg := true;
@


1.21
log
@Init base_unum when init is_hfsunit so that cacher
can call set_unit in init_hfs-unit (whew!).
@
text
@d75 2
d271 6
d281 1
a281 1
	call(h_unitable^.tbl[dam_unum].tm {OLD tm} ,
d438 12
d490 1
d523 1
d529 5
a533 4
    for i:=0 to maxunit do begin
	id_unitable^[i].user_id  := paws_uid;
	id_unitable^[i].group_id := paws_gid;
    end;
@


1.20
log
@Fix typo in last delta.
@
text
@d500 4
a503 1
	h_unitable^.tbl[i].is_hfsunit := FALSE;
@


1.19
log
@Lots of cleanup.  Remove io_to_file stuff.
init_hfs_unit -> init_support_unit, called from cacher's
init_hfs_unit now.
@
text
@d438 1
a438 1
procedure init_hfs_unit(unum: unitnum);
@


1.18
log
@Add randbetween -- random number routine.
@
text
@d1 2
a2 2
  $LINENUM 9000$
  $LINES 54$
d4 1
a4 1
  $MODCAL$
d6 1
a6 1
 {$range off$ $ovflcheck off$ {want to enable this line when finished}
d8 1
a8 1
  $debug off$                 {debug OFF when finished}
d10 1
a10 1
  module hfsupport;
a11 6
  {
  { This is Scott's old support module, with the cacher and the
  { calculation routines removed.  It is meant to be a place where
  { OS-specific things live.  It isn't well tested; I'm leaving that
  { to Scott.  Sorry!  -Hal.
  }
d13 1
a14 5
  {Contains cache manager, which handles caching for superblocks, cylinder
   group info blocks (cgroup blocks), inodes, and DEV_BSIZE (1024) size
   data segments. Also contains h_unitable initialization, and get_dbnum, plus
   support routines which locate byte positions of superblocks, cgroup blocks,
   inodes, and data blocks (not DEV_BSIZE segments) on disc}
d16 10
a26 3
  $search 'hfstuff'$
  import sysglobals, misc, asm, fs,
	 sysdevs, iocomasm, hfstuff, rnd;
d28 1
d30 2
a31 5
  {module hfsupport expects getsuperblock to be called before any other
   routines in it are called. Current_unum is the unit all subsequent calls
   are applied to. On entry both the DAM and the AM (and any other callers of
   hfsupport) MUST getsuperblock for the rest of the routines to work
   correctly}
d33 2
a34 4
  {because caching is done in static heap space, the hfs driver is NOT
   reentrant with respect to interrupts. ie, if you call the AM, DAM, or the
   hfsTM from within an ISR, you risk messing up any lower level transactions
   currently happening, even if you've got your own FIB!}
d36 1
a36 29
  {GENERAL FUTURE IMPLEMENTATION NOTES-
   - check when umediavalid needs to be tested
   - note that cylinder group info block size can be 4K or 8K
   - note that the flush routines MUST NEVER write to the wrong medium
   - may want to consider caching the prefix inode data as well as the inode
     number in the h_unitable
   - get/flush_cgroup are completely unimplemented right now, as they are not
     needed for readonly access
   - every sblock and cgroup disk read should check the magic number.
   }



  export

   const
     io_to_file = FALSE {true};
     DISC_SECTOR = 256;

   var
    printmesg         : boolean; {debug use only}

   type
    id_record = packed record
       user_id  : ushort;
       group_id : ushort;
     end;
    id_tabletype = array[0..maxunit] of id_record;

a38 3
   var
    id_unitable: ^id_tabletype;

d41 1
a41 1
procedure init_hfs_unit(unum : unitnum);
d49 1
a49 1
procedure copy_user_data(sourcebyte, destbyte, size : integer);
d51 1
a51 1
function set_unit(unum : unitnum) : unitnum;
d55 1
a55 6
$if true {io_to_file}$
type
   charfile = file of char;
   charfile_ptr = ^charfile;
procedure set_file_io(f: charfile_ptr);
$end$
a56 1
function get_uid: integer;
d58 1
d60 1
d62 1
d64 1
d66 1
d73 1
d82 4
a85 4
  var
      {for raw I/O transactions to the unit}
      tempfib           : fibp;
      dummywindow       : shortint;
d87 5
a91 3
      current_unum: integer;
      dam_unum: integer;
      seed: integer;
d93 6
d100 2
a102 1
$if true {io_to_file}$
a103 9
var hfsfile: charfile_ptr;

procedure set_file_io(f: charfile_ptr);
begin
   hfsfile := f;
end;

$end$

d153 1
a153 1
{  converts a pac of given length to a string
d167 24
a190 1
   {--------------------------------------------------------------------}
d192 14
a205 11
   {setuptempfib sets up a temporary FIB for use with the old TM (saved in
    h_unitable) to do the actual I/O required for hfsdam or hfstm. The FIB can
    only be considered valid DURING one invocation of the file system (AM,
    DAM or TM). Setuptempfib is invoked by get_superblock, which is called at
    the beginning of each TM or DAM execution. The FIB is used by routines
    get_bytes and put_bytes
   }

   procedure setuptempfib;
   var tempio : integer;
   begin
d207 12
a218 14
    with tempfib^ do
     begin
      pathid := 0;
      funit  := dam_unum;
      { does not do i/o to disc }
      unblockeddam(tempfib^, dam_unum, openunit);
      { next line for BASIC -- this opens the fib }
      {call(unitable^[dam_unum].tm, tempfib, unitstatus, fbuffer, 0, 0);}
      freadable  := true;
      fwriteable := true;
      feof       := false;
      feoln      := false;
     end;
   end;
d226 1
d245 10
a254 12
$if not io_to_file$
   {--------------------------------------------------------------------}

   {get_bytes uses the old TM (in h_unitable) to access the disc as a raw
    device to retrieve data from it. Setuptempfib must be called before
    calling get_bytes (setuptempfib is called by get_superblock, which also
    MUST be called)}

   procedure get_bytes(unit: unitnum; size, start : integer; buffer : windowp);
   var
     tmpumax: integer;
   begin
d257 7
a263 7
      umediavalid := true;
      tmpumax := umaxbytes;
      call(h_unitable^.tbl[dam_unum].tm {OLD tm} ,
	 tempfib, readbytes, buffer^, size, start);
      goodio(tmpumax);
     end;
   end;
d265 4
a268 11
   {--------------------------------------------------------------------}

   {put_bytes uses the old TM (in h_unitable) to access the disc as a raw
    deviceto store data to it. Setuptempfib must be called before calling
    put_bytes (setuptempfib is called by get_superblock, which also MUST be
    called)}

   procedure put_bytes(unit: unitnum; size, start : integer; buffer : windowp);
   var
     tmpumax: integer;
   begin
d271 7
a277 7
      umediavalid := true;
      tmpumax := umaxbytes;
      call(h_unitable^.tbl[dam_unum].tm {OLD tm} ,
	 tempfib, writebytes, buffer^, size, start);
      goodio(tmpumax);
     end;
   end;
a278 1
$end$
d283 1
a283 1
{ Cache is bad because the blocks are small, and because we would
d286 1
a286 1
procedure copy_user_data(sourcebyte, destbyte, size : integer);
a335 1

d338 1
d348 1
a348 2
{ Called with getvolumename only, because we retry if mediumchanged;
{ other DAM requests just pass i/o errors back to the caller.
d352 1
a352 1
   tmpumax: integer;
d354 6
a359 6
  tmpumax := unitable^[dam_unum].umaxbytes;
  call(h_unitable^.tbl[dam_unum].tm, tempfib, clearunit,
       tempfib^.fbuffer, 0, 0);
  try
    goodio(tmpumax);
  recover;
d363 7
a369 7

$if io_to_file$

procedure get_bytes(unit: unitnum;
		    size, start: integer; buffer: windowp);
var
    tempio: integer;
a370 37
    seek(hfsfile^, start+1);
    freadbytes(hfsfile^, buffer^, size);
    tempio := ioresult;
    if ioresult <> 0 then begin
	writeln('error in get_bytes ', tempio);
	ioresult := tempio;
    end;
end;

procedure put_bytes(unit: unitnum;
		    size, start: integer; buffer: windowp);
var
    tempio: integer;
begin
    seek(hfsfile^, start+1);
    fwritebytes(hfsfile^, buffer^, size);
    tempio := ioresult;
    if ioresult <> 0 then begin
	writeln('error in put_bytes ',tempio);
	ioresult := tempio;
    end;
end;

$end$

   {--------------------------------------------------------------------}

   {get_superblock tries to get the superblock for unum. If it is in RAM
    currently, it does no I/O, otherwise it tries to do the requisite I/O. If
    successful, it has the side-effects of setting up the tempfib, sting
    current_unum to unum, setting surrent_super to point to the data portion
    of the superbufs that contains the RAM image of that superblock.
    If umediavalid was false (floppy removed), or uisoffline is true (device
    gone), then all buffers are called for that base_unum}

   function set_unit(unum : unitnum) : unitnum;
   begin
d372 1
a372 1
    current_unum   := h_unitable^.tbl[unum].base_unum;    {prepare for get_bytes}
d375 1
a375 1
   end;
a388 4
$if io_to_file$
  get_uid := 1;
$end$
$if not io_to_file$
a389 1
$end$
a398 4
$if io_to_file$
  get_gid := 1;
$end$
$if not io_to_file$
a399 1
$end$
a406 1
{HAL}
d409 1
a409 1
  get_umask := octal('022');
d412 6
d420 1
a420 1
  i: integer;
d423 5
a427 6
       with h_unitable^.tbl[i] do
	 if is_hfsunit then
	   if base_unum = current_unum then begin
	     prefix := root_inode;
	     unitable^[i].uvid := '';
	   end;
d431 8
a438 10

{init_hfs_unit is to be called by the installation program for the unitable
(normally TABLE) exactly ONCE for each unit installed to hfsdam/hfstm.
It calls init_cache_unit to tell the cache configurator that it needs
cache space}
{The procedure is mostly concerned with finding other unitable/h_unitable
entries that access the same physical unit, so we can set up a "synonym"
base_unum matching previously initialized h_unitable entry unit numbers}

procedure init_hfs_unit(unum : unitnum);
d440 2
a441 2
i     : shortint;
found : boolean;
d443 1
a443 2
$if not io_to_file$
h_unitable^.tbl[unum].base_unum := unum;
d445 21
a465 20
found := false;   {search for other unitable entries on same H/W}
i     := 0;
while (i <= maxunit) and (not found) do
begin
  if i<>unum then
   if h_unitable^.tbl[i].is_hfsunit then {it is HFS unit}
    with unitable^[h_unitable^.tbl[i].base_unum] do
     if (unitable^[unum].sc = sc) and    {check for identity}
	(unitable^[unum].ba = ba) and
	(unitable^[unum].du = du) and
	(unitable^[unum].dv = dv) and
	(unitable^[unum].letter = letter) and
	(unitable^[unum].byteoffset = byteoffset) then
      found := true;     {identical units i and unum}
  if not found then
   i := i+1
  else
   h_unitable^.tbl[unum].base_unum := h_unitable^.tbl[i].base_unum;
end;     {we only need to match one entry, because all identical H/W
	  previously init_hfs_unit'ed will match that base_unum}
d467 4
a470 8
with h_unitable^.tbl[unum] do
 begin
  is_hfsunit := true;
  fs_corrupt := false;
 end;
{
h_unitable^.tbl[unum].is_hfsunit := init_cache_unit(unum);
}
a471 8
$end$

{initialize id_unitable}
for i:=0 to maxunit do
  begin
    id_unitable^[i].user_id  := paws_uid;
    id_unitable^[i].group_id := paws_gid;
  end;
d476 5
a481 3
{init_support is to be called by the installation program for the hfs driver
 exactly ONCE, at driver install time}

d483 2
a484 1
var i : shortint;
d486 2
d489 6
a494 2
 printmesg := true;
 seed := 12345;
a495 6
 if tempfib = NIL then
  begin              {create a fib and close it}
   new(tempfib);
   tempfib^.freadable  := false;
   tempfib^.fwriteable := false;
  end;
d497 4
d502 6
a507 12
$if not io_to_file$
   { When h_unitable (sysglobals) begins nil, then only new it if nil }
   new(h_unitable);
   for i:=0 to maxunit do
    h_unitable^.tbl[i].is_hfsunit := FALSE; {set all h_units to "not installed"}
   { end of code to call only if h_unitable nil, once it starts at 0 }
{ unitioinit should set h_unitable to nil }

$end$

  {new up an id_unitable}
  new(id_unitable);
@


1.17
log
@Check_disc_changed -> check_disc_status, since can now notice
that disc is out, or off.
@
text
@d29 1
a29 1
	 sysdevs, iocomasm, hfstuff;
d110 1
d127 1
d172 17
d566 1
@


1.16
log
@Remove old hfs_time (use sys routines instead).
Fix copy_user_data -- was a bit too greedy.
@
text
@d91 1
a91 1
procedure check_disc_changed;
d215 7
a221 1

d224 11
a234 6
  with unitable^[dam_unum] do begin
    if not umediavalid then
      ioresult := ord(zmediumchanged);
    if umaxbytes <> tmpumax then begin
      umaxbytes := tmpumax;
      ioresult := ord(znotready);
a235 5
    if ioresult <> ord(inoerror) then begin
      {reportn('escape_io, iores', ioresult);}
      escape(-10);
    end;
  end;
d344 10
a353 3
{ detects changed media, sets ioresult to zmediumchanged
{ it does NOT detect a missing disc -- this isn't detected until
{ we do i/o.
d355 1
a355 1
procedure check_disc_changed;
@


1.15
log
@New routine pac_to_str.
@
text
@a99 1
function hfs_time: integer;
a185 45
{
{ Return the number of seconds since midnight GMT on January 1, 1970.
{ Also writes the value into its address if non-zero.
{ Ignores time zone.
}
function hfs_time: integer;
type
  marray_type = array[1..12] of integer;
const
  { number of days in each month, ignoring leap year }
  marray = marray_type[31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31];
  TZ = 7*3600;  {Hardwired timezone for CO; replace sfb}
var
  date: daterec;
  time: timerec;
  dsecs, tsecs: integer;
  y, m: integer;
{----------------}
{ is the year 1900+y a leap year? }
function isleap(y: integer): boolean;
begin
  isleap := (y mod 4 = 0) and (y <> 100); { fails in 2100 }
end;
{----------------}
begin
  sysdate(date);
  systime(time);
  with date, time do begin
    if (year < 100) and (month in [1..12]) and (day > 0) then begin
      { dsecs -- seconds in the date record }
      dsecs := (year-70)*365*24*60*60 + (day-1)*24*60*60;
      for m := 1 to month - 1 do
	dsecs := dsecs + marray[m]*24*60*60;
      for y := 70 to year do
	if isleap(y) and ((y < year) or (month > 2)) then
	  dsecs := dsecs + 24*60*60;
    end
    else dsecs := 0;
    { tsecs -- seconds in the time record }
    tsecs := hour*60*60 + minute*60 + centisecond div 100;
  end;
  hfs_time := tsecs + dsecs +TZ {sfb};
end;


d277 21
d299 9
a307 42
 procedure copy_user_data(sourcebyte, destbyte, size : integer);
 const slop = 4000;
 var heaptop, workspace : windowp;
     space,
     nmoves, movesize, tailsize,
     i, position : integer;
 begin
  {reportn('copydata sourcebyte',sourcebyte);
  reportn('copydata destbyte',destbyte);
  reportn('copydata size',size);}

  {reportn('memavail', memavail);}
  space := ((memavail - slop) div DEV_BSIZE) * DEV_BSIZE;
  if space = 0 then begin
    {reportn('fail copydata, space available only',space);}
    escape(-2);
  end;

  if space < size then
   begin
    {report('space < size');}
    nmoves := size div space;                      {number of movesize moves}
    movesize := (space div DEV_BSIZE) * DEV_BSIZE; {size of nmoves moves}
   end
  else begin
   nmoves := 1;
   movesize := size;
  end;

  {reportn('workspace',space);
  reportn('nmoves',nmoves);
  reportn('movesize',movesize);}

  position := 0;
  mark(heaptop);
  newbytes(workspace, movesize);
  try
    for i:= 1 to nmoves do begin
    {copy the movesize blocks}
     get_bytes(dam_unum, movesize, sourcebyte+position, workspace);
     put_bytes(dam_unum, movesize, destbyte+position, workspace);
     position := position + movesize;
d310 23
a332 6
    {reportn('position after nmoves',position);}
    if position <> size then begin
     tailsize := size - position;
     {reportn('tailsize',tailsize);}
     get_bytes(dam_unum, tailsize, sourcebyte+position, workspace);
     put_bytes(dam_unum, tailsize, destbyte+position, workspace);
a333 7
  escape(0);
  recover begin
    release(heaptop);
    {reportn('escapecode at copy complete',escapecode);}
    if escapecode <> 0 then
     escape(escapecode);
 end;
a335 1

@


1.14
log
@Pws2unix automatic delta on Tue Jul 15 16:35:26 MEZ 1986
@
text
@d72 2
d107 3
d112 1
d169 15
@


1.13
log
@Change h_unitable^[x] to h_unitable^.tbl[x].
@
text
@d528 1
a528 1
   h_unitable^.tbl[unum].base_unum := h_unitable^[i].base_unum;
d547 1
a547 1
    id_unitable^[i].group_id := ws_gid;
@


1.12
log
@use paws_uid and ws_gid instead of PAWS_UID and WS_GID
@
text
@d274 1
a274 1
      call(h_unitable^[dam_unum].tm {OLD tm} ,
d295 1
a295 1
      call(h_unitable^[dam_unum].tm {OLD tm} ,
d375 1
a375 1
  call(h_unitable^[dam_unum].tm, tempfib, clearunit,
d429 1
a429 1
    current_unum   := h_unitable^[unum].base_unum;    {prepare for get_bytes}
d485 1
a485 1
       with h_unitable^[i] do
d509 1
a509 1
h_unitable^[unum].base_unum := unum;
d516 2
a517 2
   if h_unitable^[i].is_hfsunit then {it is HFS unit}
    with unitable^[h_unitable^[i].base_unum] do
d528 1
a528 1
   h_unitable^[unum].base_unum := h_unitable^[i].base_unum;
d532 1
a532 1
with h_unitable^[unum] do
d538 1
a538 1
h_unitable^[unum].is_hfsunit := init_cache_unit(unum);
d575 1
a575 1
    h_unitable^[i].is_hfsunit := FALSE; {set all h_units to "not installed"}
@


1.11
log
@fix typo in last version.
@
text
@d546 2
a547 2
    id_unitable^[i].user_id  := PAWS_UID;
    id_unitable^[i].group_id := WS_GID;
@


1.10
log
@Forgot to add the routine described in comments to previous revision.
@
text
@d110 1
a110 1
{procedure freeze;}
@


1.9
log
@add copy_user_data -- moves user data without going through cache.
@
text
@d8 1
a8 1
  $debug OFF$                 {debug OFF when finished}
d82 1
a82 2
$IF 1 = 0$
procedure get_super_bytes(unit: unitnum;
a83 1
$END$
d85 2
a86 2
procedure put_bytes(unit: unitnum;
		    size, start: integer; buffer: windowp);
d110 1
a110 1
procedure freeze;
d251 1
a251 1
      reportn('escape_io, iores', ioresult);
d302 61
@


1.8
log
@declare id_unitable, initialize it and change routines which
used h_unitable^[unum].user_id and ...group_id to use
set_uid, get_uid, set_gid and get_gid instead.
@
text
@d8 1
a8 1
  $debug ON $                 {debug OFF when finished}
@


1.7
log
@don't escape in check_disc_changed.
@
text
@d65 10
d102 1
d104 1
d375 10
d391 1
a391 1
  get_uid := h_unitable^[current_unum].user_id;
d395 5
d406 1
a406 1
  get_gid := h_unitable^[current_unum].group_id;
d410 5
d483 7
d521 3
@


1.6
log
@remove kill_bufs, medium_changed, get_super_bytes, set_root_uvid.
new get/put_bytes resets umaxbytes, checks if tm changed it.
@
text
@d306 3
a308 1
  goodio(tmpumax);
@


1.5
log
@many changes involving checks for disc absent or changed.  knows
about superblocks.  added get_super_bytes (retries if medium
changed, also invalidates cache), check_disc_present, check_disc_changed,
brought rootname from hfsdam, keep units straight (base unit vs dam unit),
reset_prefix (when medium has changed), set_root_uvid (when it comes
back on line).  Most of this is support for get_superblock.  Starting
to look real.
@
text
@a63 2
    kill_bufs: procedure(unit: shortint);
    medium_changed: boolean;
d71 2
d75 2
a80 2
procedure check_disc_present;

a82 2
function rootname(fs: super_block_ptr_type; unum: unitnum) : vid;

a94 1
procedure set_root_uvid(fs: super_block_ptr_type);
d231 1
a231 1
procedure escape_io;
d233 2
a234 2
  if not unitable^[dam_unum].umediavalid then
    if ioresult = ord(inoerror) then
d236 9
a244 2
  if ioresult <> ord(inoerror) then
    escape(-10);
d258 1
a258 1
     tmpreport: boolean;
d263 1
a263 2
      tmpreport := ureportchange;
      ureportchange := true;
d266 1
a266 2
      ureportchange := tmpreport;
      escape_io;
d279 1
a279 1
    tmpreport: boolean;
d284 1
a284 2
      tmpreport := ureportchange;
      ureportchange := true;
d287 2
a288 3
      ureportchange := tmpreport;
      escape_io;
    end;
d290 1
d306 1
a306 4
  try
    escape_io;
  recover;
  unitable^[dam_unum].umaxbytes := tmpumax;
a308 13
procedure check_disc_present;
var
   tmpbuf: packed array [1..256] of char;
   tmpumax: integer;
begin
  { get_bytes can reset these two fields.  arggghhhh!!!! }
  tmpumax := unitable^[dam_unum].umaxbytes;
  try
    get_bytes(dam_unum, sizeof(tmpbuf), 0, addr(tmpbuf));
  recover
      call(kill_bufs, current_unum);
  unitable^[dam_unum].umaxbytes := tmpumax;
end;
a310 26
procedure get_super_bytes(unit: unitnum; size, start : integer;
			  buffer : windowp);
label
  999;
begin
  report('in get_super_bytes');
  with unitable^[dam_unum] do begin
    reportn('get_bytes 1, fpeof ', tempfib^.fpeof);
    reportn('before get_bytes 1, iores ', ioresult);
    try
      get_bytes(dam_unum, size, start, buffer);
    recover;
    reportn('after get_bytes 1, iores ', ioresult);
    if ioresult = ord(inoerror) then
       goto 999;
    call(kill_bufs, unit);
    if ioresult <> ord(zmediumchanged) then
      escape(-10);
    ioresult := ord(inoerror);
    medium_changed := true;
    report('get_bytes 2');
    get_bytes(dam_unum, size, start, buffer);
  end;
999:
end;

d387 1
a387 26
function rootname(fs: super_block_ptr_type; unum: unitnum) : vid;
   const
    nilname = fs_name_type[#0#0#0#0#0#0];
   var
    tempname : string[6];
    i        : integer;
   begin
    if fs = nil then
      tempname := ''
    else
    if fs^.fname = nilname then
     begin
      tempname := 'hfs';
      strwrite(tempname,4,i,unum:1);
     end
    else
     begin
      setstrlen(tempname, 6);
      for i:=1 to 6 do
       tempname[i] := fs^.fname[i-1];
      tempname := strltrim(strrtrim(tempname));
     end;
    rootname := tempname;
   end;

procedure reset_prefix(fs: super_block_ptr_type);
d396 1
a396 1
	     unitable^[i].uvid := rootname(fs, i);
a397 8
end;

procedure set_root_uvid(fs: super_block_ptr_type);
begin
       with h_unitable^[dam_unum] do
	 if is_hfsunit then
	     if prefix = root_inode then
		 unitable^[dam_unum].uvid := rootname(fs, dam_unum);
@


1.4
log
@new(h_unitable) always, not just if nil.  Reason -- h_unitable in 
sysglobals, which aren't zeroed.
@
text
@d27 1
d29 1
a29 1
	 sysdevs, iocomasm;
d64 2
d73 2
d77 1
a77 1
procedure set_unit(unum : unitnum);
d79 6
d96 2
d99 1
d105 1
a105 3
  {
  implement
  }
a111 1
      kill_bufs: procedure(unit: unitnum);
d113 1
a115 1
IMPLEMENT
d151 2
a152 1
 if printmesg then
d154 1
d221 5
a225 8
      funit  := current_unum;
      unblockeddam(tempfib^, current_unum, openunit);
      tempio := ioresult;
      if tempio <> 0 then
       begin
	writeln('error in setuptempfib ',tempio);
	ioresult := tempio;
       end;
d233 11
d253 2
a254 1
   var tempio : integer;
d256 6
a261 1
    call(h_unitable^[unit].tm {OLD tm} ,
d263 3
a265 6
    tempio := ioresult;
    if ioresult <> 0 then
	begin
	 writeln('error in get_bytes ',tempio);
	 ioresult := tempio;
	end;
d276 2
a277 1
   var tempio : integer;
d279 10
a288 8
    call(h_unitable^[unit].tm {OLD tm} , tempfib,
	 writebytes, buffer^, size, start);
    tempio := ioresult;
    if ioresult <> 0 then
	begin
	 writeln('error in put_bytes ',tempio);
	 ioresult := tempio;
	end;
d292 60
d394 1
a394 3
   procedure set_unit(unum : unitnum);
   label 999;

d396 1
a396 1
$if not io_to_file$
d398 2
a399 29

    with unitable^[unum] do
     if (not umediavalid) or (offline) then     {disk changed/dead}
      call(kill_bufs, current_unum);

    setuptempfib;       {bug fix-ALWAYS setuptempfib in get_superblock SFB}

    with unitable^[unum] do
    if (not umediavalid) or (offline) then
     begin      {floppy removed/disk dead??, so force disc touch SFB}
      writeln('umediavalid ',umediavalid:5,'  offline ',offline:5);
      call(kill_bufs, current_unum);
      unitable^[unum].umediavalid := TRUE;
      call(h_unitable^[unum].tm, tempfib, clearunit, dummywindow, 0, 0);
      writeln('touched unit');
      setuptempfib;     {set it up again ?? SFB}
      if ioresult = ord(inoerror) then
       unitable^[unum].umediavalid := true
      else      {couldn't access disc, so abort with ioresult}
       BEGIN
	current_unum := -1;
	writeln('couldn''t fix umediavalid in get_super');
	goto 999;
       END;
     end;
$end$

999:
   {and ioresult carries error info if any}
d422 1
d428 46
a524 3
procedure dummy_kill_bufs(unit : unitnum);
begin
end;
a544 2
 kill_bufs := dummy_kill_bufs;

d550 2
a551 1
   { end of code to call only if h_unitable nil, once sysglobals init to 0 }
a558 6
{
{ THINGS TO WATCH OUT FOR
{   kill_bufs never set to anything
{   change hfsalloc so it doesn't cache user data
{   set_unit
}
@


1.3
log
@correction from "newest" dam received 23.06.86 from Scott
@
text
@d446 1
a446 2
 if h_unitable = NIL then
  begin
d450 1
a450 1
  end;
@


1.2
log
@removed the h_unitable stuff, because jws had put the same
stuff in sysglobals and that's where it belongs anyway.
@
text
@d137 1
d139 1
d142 1
@


1.1
log
@Initial revision
@
text
@a60 16
   type
      h_unittype = record
       prefix    : integer;   {holds prefix inode #}
       tm        : amtype;    {holds "old" TM}
       base_unum : unitnum;   {for quick cache matching}
       is_hfsunit: boolean;   {initialized as hfs unit?}
       fs_corrupt: boolean;   {has someone detected fs corruption}
    {move the following two inside the DAM as an access_unitable, declared
     below "implement" for security}
       user_id   : shortint;  {current "logged-in" or default user id}
       group_id  : shortint;  {current "logged-in" or default group id}
      end;

      h_unitabletype = array[0..maxunit] of h_unittype;


a61 2
{the "extension" unitable -- move to sysglobals later for generality}
    h_unitable        : ^h_unitabletype;
@
