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


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

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

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

55.1
date     91.08.25.10.18.37;  author jwh;  state Exp;
branches ;
next     54.3;

54.3
date     91.08.21.12.35.44;  author jwh;  state Exp;
branches ;
next     54.2;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

10.1
date     86.12.24.10.47.08;  author jws;  state Exp;
branches ;
next     9.2;

9.2
date     86.12.16.10.28.29;  author jws;  state Exp;
branches ;
next     9.1;

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

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

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

6.1
date     86.11.04.17.43.16;  author paws;  state Exp;
branches ;
next     5.2;

5.2
date     86.10.29.13.56.29;  author hal;  state Exp;
branches ;
next     5.1;

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

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

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

2.1
date     86.07.30.14.31.26;  author hal;  state Exp;
branches ;
next     1.3;

1.3
date     86.07.28.18.17.45;  author hal;  state Exp;
branches ;
next     1.2;

1.2
date     86.07.28.18.07.24;  author hal;  state Exp;
branches ;
next     1.1;

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


desc
@Base file for PWS 3.2 release.

@


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

 (c) Copyright Hewlett-Packard Company, 1982.
All rights are reserved.  Copying or other
reproduction of this program except for archival
purposes is prohibited without the prior
written consent of Hewlett-Packard Company.


	    RESTRICTED RIGHTS LEGEND

Use, duplication, or disclosure by the Government
is subject to restrictions as set forth in
paragraph (b) (3) (B) of the Rights in Technical
Data and Computer Software clause in
DAR 7-104.9(a).

HEWLETT-PACKARD COMPANY
Fort Collins, Colorado                         *)


$MODCAL$
$DEBUG OFF,  range off, ovflcheck off$
$ALLOW_PACKED ON $   { JWS 4/10/85 }

program instlifdam;
module lifmodule;
import sysglobals, sysdevs, misc, fs;
export
  procedure lifdam(anyvar f: fib; unum: unitnum; request: damrequesttype);
  procedure installlifdam;

implement
  const
    entrysize = 32;
    uxtype = -5813; { eft for uxfile }
  type
    vname   =packed array[1..6] of char;
    lifname = packed array[1..10] of char;
    bcd     = 0..15;
    word    = 0..65535;
    integer16 = -32768..32767;
    word15  = 0..32767;
    tdate   = packed array[1..12] of bcd;
    lvheader=packed record      {volume header sector 0}
	       discid   : word;
	       volname  : vname;
	       dstart   : integer;
	       dummy1   : integer16;
	       dummy2   : integer16;
	       dsize    : integer;
	       version  : integer16;
	       dummy3   : integer16;
	       tps      : integer;      {tracks/surface}
	       spm      : integer;      {surfaces/medium}
	       spt      : integer;      {sectors/track}
	       cdate    : tdate;        {volume create time}
	       filler   : packed array[21..123] of integer16;
	       sdate    : tdate;
	       dummy4   : integer16;
	     end;
  direntry = packed record
	       fname    : lifname;
	       ftype    : integer16;
	       fstart   : integer;
	       fsize    : integer;
	       fdate    : tdate;
	       lastvol  : boolean;
	       volnumber: word15;
	       extension: integer;
	     end;

  spacerec  = record
		sstart      : integer;
		ssize       : integer;
		here      : integer;
		hole      : integer;
	      end;
  catarray  = array[1..maxint] of catentry;
  dirfile   = file of direntry;
  var
    dir        : ^dirfile;

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

{****************************************************************************}
  procedure badio(result : iorsltwd);
  begin ioresult := ord(result); escape(0); end;

{****************************************************************************}
  procedure pactostr(anyvar pc: lifname; l:integer; var s:string);
  var i : integer;
  begin
    setstrlen(s,l); for i:=1 to l do s[i] := pc[i];      i := l;
    while (i>1) and (s[i]=' ') do i:=i-1; setstrlen(s,i);
  end;

{****************************************************************************}
  procedure strtopac(anyvar s:string255; l:integer;
		     anyvar pc:lifname;  sizechk:boolean);
  var i,k : integer;
  begin
    if sizechk then
      if (strlen(s)>l) or (strlen(s)=0) then badio(ibadtitle);
    k:=strlen(s);
    for i:=1 to l do if i>k then pc[i] := ' ' else pc[i] := s[i];
  end;

{****************************************************************************}
  procedure strtoany(var s:string; anyvar s2:string255);
  begin s2:=s; end;

{****************************************************************************}
  procedure setdate(var d:tdate);
  var
    doy:daterec;        tod:timerec;
  begin
    sysdate(doy);       systime(tod);
    with doy, tod do
    begin
      {LAF 880101 added "mod 10" to "div 10"}
      d[1]  := year div 10 mod 10;d[2]  := year mod 10;
      d[3]  := month div 10;  d[4]  := month mod 10;
      d[5]  := day div 10;    d[6]  := day mod 10;
      d[7]  := hour div 10;   d[8]  := hour mod 10;
      d[9]  := minute div 10; d[10] := minute mod 10;
      d[11] := (centisecond div 100) div 10;
      d[12] := (centisecond div 100) mod 10;
    end;
  end;

{****************************************************************************}
  procedure lifnametostr(anyvar ln :lifname ; var s:string);
  label 1;
  var
    sl  : integer;
    fk  : filekind;
    found : boolean;

  begin {lifname to str}
    pactostr(ln,10,s); sl := strlen(s);
    if sl=10 then
    begin
      if suffix(s)=datafile then
      begin     { rip underscores and try to add suffix }
	while (sl>=1) and (s[sl]='_') do sl := sl - 1;
	for fk:=untypedfile to lastfkind do
	begin
	  if strlen(suffixtable^[fk])>0 then
	    if suffixtable^[fk][1]=s[sl] then
	    begin       { found suffix }
	      { change last char to . then append suffix }
	      setstrlen(s,sl); s[sl] := '.';
	      s := s + suffixtable^[fk];  goto 1;
	    end;
	end;
      end;      { for }
    end;
  1:end;  {lifname to str}

{****************************************************************************}
  procedure strtolifname(var s:string; var ln:lifname);
  var
    sl, i       : integer;
    stemp,temp2 : fid;  {31jan83  temp2 for case insensitive suffix}
    fk          : filekind;

  begin {str to lifname}
    sl := strlen(s);
    fk := suffix(s);
    if fk=datafile then
    begin       { data files have no suffix }
      if sl>10 then badio(ibadtitle);
      strtopac(s,10,ln,false);
    end
    else
    begin       { remove the suffix }
      sl := strlen(s)-strlen(suffixtable^[fk]);
      if sl>10 then badio(ibadtitle);
      strtopac(s,10,ln,false);  { pack the name }
      { replace dot with first char of suffix (to preserve uniqueness)}
      ln[sl] := suffixtable^[fk][1];    sl := sl+1;
      for i:=sl to 10 do ln[i] := '_';  { pad with _ }
    end;
    lifnametostr(ln,stemp);     { decompress the name as a final check }
    if stemp<>s then
    begin                       {31jan83 case insensitive suffix testing}
      temp2 := s;               { copy s, then remove given suffix }
      setstrlen(temp2,strlen(temp2)-strlen(suffixtable^[fk]));
      temp2:= temp2 + suffixtable^[fk];         { add suffix from table }
      if stemp<>temp2 then badio(ibadtitle);    { check again }
    end;
  end; {str to lifname}

{****************************************************************************}
{****************************************************************************}
  procedure lifdam(anyvar f: fib; unum: unitnum; request: damrequesttype);
    var
       vol      : lvheader;
       volid    : vid;
       ok, mediavalid ,anychange: boolean;
       dindex, dlast, dend, vsize       : integer;
       dentry   : direntry;

  $iocheck off$
{****************************************************************************}
  function volsize:integer;
  begin
    if vsize=0 then vsize := ueovbytes(unum);
    volsize := vsize;
  end;

{****************************************************************************}
  procedure cleanup;
  begin
    if ioresult=ord(zmediumchanged) then mediavalid := false;
    unitable^[unum].umediavalid   := mediavalid;
    unitable^[unum].ureportchange := true;
  end;

{****************************************************************************}
  procedure checkftitle;
  begin
    if (strlen(f.ftitle)>tidleng) or (strlen(f.ftitle)=0) then badio(ibadtitle);
    f.ftid := f.ftitle;
  end;

{****************************************************************************}
  function vvname:boolean;
  var
    i : integer;
    b : boolean;
  begin
    vvname := true; b := true;
    for i := 1 to 6 do  {1feb83 allow all blank names}
    begin
      if b then b := vol.volname[i]>' ';
      if not b then     {1feb83 allow all blank names}
	if vol.volname[i]<>' ' then vvname := false;
    end
  end;

{****************************************************************************}
  function lifvol:boolean;
  var
    i : integer;        {31jan83 allow all blank volname}
  begin { read and validate the volume header }
    with fibp(dir)^, unitable^[unum] do
    begin
      fileid := 0; fpeof := maxint;   { initialize dir }
      if uisblkd then
      begin
	call(tm,fibp(dir),readbytes,vol,sizeof(lvheader),0);
	with vol do
	   ok := ((ioresult=ord(inoerror)) and (discid=32768) and
		 (dummy1=4096) and (dummy2=0) and (dummy3=0) and
		 { dstart=1 -> wsheader or LIF BOOT dir.  if byteoffset }
		 { = 0, then dstart=1 OK (LIF BOOT dir); otherwise, }
		 { dstart=1 means wsheader, which we do NOT recognize }
		 (((byteoffset = 0) and (dstart >= 1)) or (dstart > 1)) and
		 (dsize>0) and vvname);
      end
      else ok := false;
      ureportchange := true;    { now let TM report any mediachanges }
      umediavalid   := true;
      lifvol := ok;
      if ok then
      begin
	if vol.volname[1]=' ' then      {31jan83 allow all blank volname}
	begin
	  setstrlen(volid,6); for i:=1 to 6 do volid[i]:=' ';
	end
	else
	  pactostr(vol.volname,6,volid);
	if volid<>uvid then
	begin mediavalid := false; uvid := volid; end;
      end
      else setstrlen(uvid,0);
      if (not ok) and (ioresult=ord(inoerror)) then ioresult:=ord(inodirectory);
    end;
  end;  { lifvol }

  $iocheck on$
{****************************************************************************}
  procedure opendir;
  begin
    if lifvol then
    begin
      dlast:=vol.dsize * 8;             { # entries in directory }
      dend:=vol.dstart + vol.dsize;   { directory end sector + 1 }
      with fibp(dir)^ do
      begin   { initialize the fib ( fake OPEN )}
	fisnew:=false;
	freadable:=true;      fwriteable:=true;
	freadmode:=false;     fbufvalid:=false;
	feof:=false;          fmodified:=false;
	fileid:=vol.dstart*256;
	if vol.version>0 then vsize := vol.tps*vol.spm*vol.spt*256
			 else vsize := 0;
	fpeof:=vol.dsize*256;      { end of directory }
	fleof:=fpeof;
	fpos:=0;              am:=amtable^[datafile];
	freptcnt:=0;          flastpos:=-1;
	fbufchanged:=false;   fbuffered:=true;
      end;
      dindex:=1;   read(dir^,dentry);
      goodio;
    end
    else escape(0);
  end;  { opendir }

{****************************************************************************}
  procedure checkvolid;
  begin
    if f.fvid<>volid then badio(ilostunit);
  end;

{****************************************************************************}
  procedure flushdir;
  begin { june 83 fixed to account for ops which don't open the directory RDQ}
  if fibp(dir)^.freadable
	 { directory open so flush thru AM }
    then call(fibp(dir)^.am,fibp(dir),flush,ioresult,0,0)
	 { directory not open so flush thru TM }
    else call(unitable^[unum].tm,fibp(dir),flush,ioresult,0,0);
    anychange := false;
  end;

{****************************************************************************}
  procedure getsdate(anyvar svdate:daterec);
  begin
    if lifvol then
    with vol, svdate do
    begin
      if not ((sdate[5]=0) and (sdate[6]=0)) then
      begin
	{LAF 880101 conditionally add 100 to year; year range is 28..127}
	year:=sdate[1]*10+sdate[2]; if year<28 then year:=year+100;
	month:=sdate[3]*10+sdate[4];
	day:=sdate[5]*10+sdate[6];
      end;
    end;
  end;

{****************************************************************************}
  procedure setsdate(anyvar svdate:daterec);
  var
    i   : integer;
  begin
    if lifvol then
    with svdate, vol do
    begin
      {LAF 880101 added "mod 10" to "div 10"}
      sdate[1]:=year div 10 mod 10; sdate[2]:=year mod 10;
      sdate[3]:=month div 10; sdate[4]:=month mod 10;
      sdate[5]:=day div 10; sdate[6]:=day mod 10;
      for i:=7 to 12 do sdate[i]:=0;    {clear time of day}
      with unitable^[unum] do
      begin
	call(tm,fibp(dir),writebytes,vol,sizeof(lvheader),0);
	goodio;         anychange := true;
      end;
    end;
  end;  { setsdate }

{****************************************************************************}
  procedure cleandir;
  var
    k           : integer;
    tempd       : direntry;

  begin {cleandir}
    k:=1;       seek(dir^,k);
    repeat
      read(dir^,tempd);
      if tempd.ftype=-1 then k:=dlast
      else
      if tempd.ftype<>0 then
      begin
	if (tempd.fdate[3]=9) and (tempd.fdate[4]=9) then
	begin { temp file so purge it }
	  tempd.ftype:=0;
	  writedir(dir^,k,tempd);       anychange := true;
	end;
      end;
      k:=k+1;
    until k>dlast;
    mediavalid := true;
  end;  {clean dir}

{****************************************************************************}
  procedure crunchv; { assumed to be called from procedure lifdam only 24jan83}
  var
    frompos, topos, todindex    : integer;
    bsize, filesize, movesize   : integer;
    bufptr, heapmark            : windowp;
    changed                     : boolean;
    datafib                     : fibp;

  begin
    opendir; checkvolid;
    if strlen(f.ftitle)<>0 then badio(ibadtitle);
    cleandir;
    { allocate the buffer space }
    MARK(heapmark);
    try
      bsize:=(memavail-(1024*5));
      if bsize>=256 then
      begin       { buffer in sector multiples }
	bsize:=(bsize div 256) * 256;
	newwords(bufptr,bsize div 2);
	new(datafib);   { set up the data fib }
	with datafib^ do
	begin
	  funit:=fibp(dir)^.funit;
	  fileid:=0;
	  fpeof:=volsize;      fleof:=fpeof;
	end;
      end
      else escape(-2); { not enough room to run }
      { krunch it }
      dindex:=1;
      todindex:=0;       topos:=dend*256;        anychange:=false;
      repeat
	changed:=false;
	readdir(dir^,dindex,dentry);
	if dentry.ftype=-1 then dindex:=dlast
	else
	if dentry.ftype=efttable^[badfile] then
	begin   { bad sectors ; don't move this file }
	  todindex:=todindex+1;
	  if dindex<>todindex then changed:=true;       { move the entry }
	  topos:=(dentry.fstart+dentry.fsize)*256;      { move topos }
	end
	else
	if dentry.ftype=0 then anychange := true        { found purged entry }
	else
	begin { move the file ? }
	  todindex:=todindex+1;
	  if dindex<>todindex then changed:=true;       { move the entry}

	  frompos:=dentry.fstart*256;
	  if frompos<>topos then
	    begin { move the data }
	      filesize:=dentry.fsize*256;   { bytes to move}
	      dentry.fstart:=topos div 256; { set start}
	      changed:=true;
	      with unitable^[datafib^.funit] do
	      repeat
		if filesize>bsize then movesize:=bsize
				  else movesize:=filesize;
		call(tm,datafib,readbytes,bufptr^,movesize,frompos);
		frompos:=frompos+movesize; goodio;

		call(tm,datafib,writebytes,bufptr^,movesize,topos);
		topos:=topos+movesize; goodio;

		filesize:=filesize-movesize;
	      until filesize=0;
	    end  { move the data }
	  else topos:=topos+dentry.fsize*256;
	end;    { move the file ? }
	if changed then
	begin
	  writedir(dir^,todindex,dentry);       anychange := true;
	end;
	dindex:=dindex+1;
      until dindex>dlast;
      if anychange then
      begin     { put end of directory mark }
	if todindex<dlast then
	begin
	  dentry.ftype:=-1;
	  writedir(dir^,todindex+1,dentry);
	end;
      end;
      call(unitable^[datafib^.funit].tm,datafib,flush,ioresult,0,0);
      RELEASE(heapmark);
    recover
      begin
	RELEASE(heapmark);
	frompos := ioresult;  topos := escapecode;      { save state 24jan83}
	if anychange then flushdir;                { try to clean up 24jan83}
	ioresult := frompos;                     { restore the state 24jan83}
	escape(frompos);                                       {exit 24jan83}
      end;
  end;  {crunchv}

{****************************************************************************}
  procedure domakedirectory(anyvar cat:catentry);
  var
    i      : integer;
    actualsize : integer;
    secbuf : packed array[0..63] of integer;
  begin
    if strlen(f.ftitle)>0 then badio(ibadrequest);
    with vol, cat do
    begin
      if not lifvol then
      begin
	if (ioresult<>ord(inoerror)) and
	   (ioresult<>ord(inodirectory)) then escape(0);
	ioresult := ord(inoerror);
	{ clear header fields }
	discid := 32768;
	dummy1 := 4096;   dummy2 := 0;   dummy3 := 0;
	version := 0;
      end
      else checkvolid;
		{ directory size checks }
      dstart := 2;
      dsize  := (((cextra1*entrysize)+255) div 256);
      if dsize<=0 then dsize := 10;     { default directory size }
		{ size checks }
      actualsize := ueovbytes(unum);
      if (cpsize>actualsize) or (cpsize<1024) then badio(inoroom);
      if (dstart+dsize+1)*256>=cpsize then badio(inoroom);
		{ fill in the pieces }
      strtopac(cname,6,volname,true);   { volume name }
      if version>0 then
	if (tps*spm*spt*256)<>cpsize then version := 0;

      setdate(cdate);   { fill in create date }
      for i := 1 to 12 do sdate[i] := 0; { clear system date }

      if version=0 then
      begin     { create pseudo level 1 header }
	version := 1;
	tps := 1; spm := 1; spt := cpsize div 256;
	for i:=21 to 123 do filler[i]:=0;
      end;
      dummy4 := 0;      { clear 250 maint. word }
		{ write volume header }
      with unitable^[unum] do
      BEGIN
	call(tm,fibp(dir),writebytes,vol,sizeof(lvheader),0); goodio;
	for i:=0 to 63 do secbuf[i] := 0;
	call(tm,fibp(dir),writebytes,secbuf,256,256);        {clear sector 1}
      END;
		{ write end of directory }
      opendir;
      dentry.ftype := -1;
      writedir(dir^,1,dentry); flushdir;
    end;
  end;  {domakedirectory}

{****************************************************************************}
  procedure liftofkind(lt:integer16; var fk:filekind);
  begin
    fk:=untypedfile;
    while (fk<>lastfkind) and (efttable^[fk]<>lt) do fk:=succ(fk);
    if efttable^[fk]<>lt then fk:=DATAFILE;
  end;

{****************************************************************************}
  procedure cvtdatetime(var fdate:tdate; var date:daterec; var time:timerec);
  begin
    {LAF 880101 conditionally add 100 to year; year range is 28..127}
    date.year:=fdate[1]*10+fdate[2]; if date.year<28 then date.year:=date.year+100;
    date.month:=fdate[3]*10+fdate[4];
    date.day:=fdate[5]*10+fdate[6];
    {LAF 880101 changed default to 1Jan70 from 1Mar00}
    if (date.month=0) or (date.day=0) then
      begin date.year:=70; date.month:=1; date.day:=1; end;
    time.hour:=fdate[7]*10+fdate[8];
    time.minute:=fdate[9]*10+fdate[10];
    time.centisecond:=(fdate[11]*10+fdate[12])*100;
  end;

{****************************************************************************}
  procedure doopendirectory(anyvar cat:catentry);
  begin
    opendir;    checkvolid;
    with cat do
    begin      { volume info }
      cname:=volid;
      cstart:=(vol.dstart+vol.dsize)*256;      { start of data area }
      cblocksize:=256;            { No. of bytes in allocation unit }
      cpsize:=volsize;                { physical size of the volume }
      clsize:=cpsize-cstart;            {  data space on the medium }
      cextra1:=vol.dsize*8;              { number of possible files }
      cextra2:=-1;                         { unused space available }
      cvtdatetime(vol.sdate,clastdate,clasttime);     { system date }
      cvtdatetime(vol.cdate,ccreatedate,ccreatetime);{ date created }
      cinfo:='LIF level  '; cinfo[11]:=chr(vol.version+ord('0'));
    end;       { volume info }
  end;

{****************************************************************************}
  procedure docat(anyvar cat : catarray);
  var
    di, dstart, dnum    : integer;
    done        : boolean;

    procedure zerodatetime(var dr:daterec; var tr:timerec);
    begin
      {LAF 880101 changed default to 1Jan70 from 1Mar00}
      dr.year:=70; dr.month:=1; dr.day:=1;
      tr.hour:=0; tr.minute:=0; tr.centisecond:=0;
    end;

  begin {docat}
    opendir;    checkvolid;
    dstart:=f.fpos;    dnum:=f.fpeof;   f.fpeof:=0;
    di:=1;    seek(dir^,di);    done:=false;
    while (f.fpeof<dnum) and (not done) do
    begin      { get file info }
      read(dir^,dentry);
      if dentry.ftype=-1 then done:=true
      else
      { don't show temporary or purged files }
      if (dentry.ftype<>0) and
	 ((dentry.fdate[3]<>9) or (dentry.fdate[4]<>9)) then
      begin   { count this entry }
	if dstart<=0 then     { skip to start index }
	begin { report this entry }
	  f.fpeof := f.fpeof+1;
	  with dentry, cat[f.fpeof] do
	  begin
	    lifnametostr(fname,cname);
	    ceft    := ftype;   liftofkind(ceft,ckind);
	    cpsize  := fsize*256;
	    if (ftype=-5622) {workstation data}
	    or (ftype=uxtype)   {workstation ux}
		then clsize:=extension
	    else clsize := cpsize;
	    cstart     := fstart*256;
	    cblocksize := 256;
	    zerodatetime(ccreatedate,ccreatetime);
	    cvtdatetime(fdate,clastdate,clasttime);
	    cextra1 := extension;  cextra2 := volnumber;
	    if lastvol then cinfo:='' else cinfo := 'continued';
	  end { with }
	end   { report this entry }
	else dstart := dstart-1;
      end;    { count this entry }
      di:=di+1;
      if di>dlast then done := true;
    end;      { while }
  end;  {docat}

{****************************************************************************}
  function findfile(temporary:boolean; ftypecode:integer16):boolean;
  var
    found  : boolean;
    tempname    : lifname;

  begin {find file}
    if not f.fanonymous then strtolifname(f.ftid,tempname);
    found:=false;       dindex:=1;      seek(dir^,dindex);
    repeat
      read(dir^,dentry);
      with dentry do
      begin
	if ftype=-1 then dindex:=dlast
	else
	if ftype<>0 then
	begin   { check this entry }
	  if f.fanonymous then found:=(dentry.fstart*256 = f.fileid)
	  else
	  if (tempname=fname) then
	    if ((ftypecode=0) or (ftypecode=ftype)) then
	    begin
	      if temporary then found:=(fdate[3]=9) and (fdate[4]=9)
			   else found:=(fdate[3]<>9) or (fdate[4]<>9);
	    end;
	end;
      end;      { with }
      if not found then dindex:=dindex+1;
    until (dindex>dlast) or found;
    findfile:=found;
  end; {find file}

{****************************************************************************}
  procedure purgef;
  begin
    dentry.ftype := 0; writedir(dir^,dindex,dentry); flushdir;
  end;

{****************************************************************************}
  procedure dopurgename;
  begin
    opendir;    checkvolid;     checkftitle;
    if findfile(false,0) then purgef
			 else ioresult := ord(inofile);
  end;

  {****************************************************************************}
  procedure getspace(space:integer; var srec:spacerec);
  var
    fixed, done, opening          : boolean;
    lastused, lastopening         : integer;
    dataspace                     : integer;
    mostavail, nextavail          : spacerec;

    procedure shuffle;
    var
      tempentry             : direntry;
      increment, here, hole : integer;

    begin       { move directory entries to open a required space }
      here := mostavail.here;
      hole := mostavail.hole;
      if here<=hole then
      begin
	if hole<dlast then
	begin   { move logical eod if required }
	  readdir(dir^,hole,tempentry);
	  if tempentry.ftype=-1 then
	  begin
	    writedir(dir^,hole + 1,tempentry);
	    anychange := true;
	  end;
	end;
	increment := -1;
      end
      else
	increment := 1;
      while hole<>here do
      begin
	readdir(dir^,hole+increment,tempentry);
	writedir(dir^,hole,tempentry);      anychange := true;
	hole := hole + increment;
      end;
      tempentry.ftype:=0;
      writedir(dir^,here,tempentry); anychange := true;
    end;        { shuffle }

    procedure allocate(var srec : spacerec; eod : boolean);
    begin
      srec.ssize  := dataspace;
      srec.sstart := lastused + 1;
      if eod then
      begin { end of directory allocation }
	if opening then srec.here := lastopening
		   else srec.here := dindex;
	srec.hole := srec.here;
      end
      else
      begin { middle of directory allocation }
	if opening then srec.here := lastopening
	else
	  if lastopening>0 then srec.here := dindex-1
			   else srec.here := dindex;
	srec.hole := lastopening;
      end;
    end;        { allocate }

    procedure checkspace(eod : boolean);
    var
      temp      : integer;
      check2    : boolean;
    begin
      if fixed and (dataspace>=space) then
      begin     { fixed space check }
	if (mostavail.ssize=0) { no space yet } or
	   (dataspace=space) { exact fit } or
	   { this space is bigger than previous good fit }
	   (((dataspace-space)>(mostavail.ssize-space)) and
	   (mostavail.ssize<>space)) then allocate(mostavail,eod);
	if mostavail.hole>0 then done := true;
      end;      { fixed space check }

      if not fixed then
      begin     { biggest or 2nd biggest }
	check2 := true;
	if (dataspace>=mostavail.ssize) then
	begin   { check biggest space }
	  if (dataspace>mostavail.ssize) then
	  begin { new biggest space }
	    nextavail := mostavail;       { demote to second biggest }
	    allocate(mostavail,eod);
	    check2    := false;
	  end
	  else
	  if not eod then
	  begin { same size space }
	    if opening then temp := lastopening
	    else
	      if lastopening>0 then temp := dindex -1
			       else temp := dindex;
	    if (abs(temp-lastopening)<=abs(mostavail.here-mostavail.hole)) or
	       (lastopening=0) then
	    with mostavail do
	    begin       { this causes shorter shuffle }
	      ssize  := dataspace;
	      sstart := lastused + 1;
	      here   := temp;
	      hole   := lastopening;
	    end;
	  end;  { same size space }
	end;    { check biggest space }
	if check2 then
	  if (dataspace>=nextavail.ssize) and (space<0) then
	  begin   { check 2nd biggest space }
	    if dataspace>nextavail.ssize then allocate(nextavail,eod)
	    else
	    if not eod then
	    begin { same size space }
	      if opening then temp := lastopening
	      else
		if lastopening>0 then temp := dindex -1
				 else temp := dindex;
	      if (abs(temp-lastopening)<=abs(nextavail.here-nextavail.hole)) or
		 (lastopening=0) then
	      with nextavail do
	      begin       { this causes shorter shuffle }
		ssize  := dataspace;
		sstart := lastused + 1;
		here   := temp;
		hole   := lastopening;
	      end;
	    end;
	  end;    { same size space }
      end;      { biggest or 2nd biggest }
    end; {checkspace}

    procedure checkentry;
    begin       { checkentry }
      if dentry.ftype=-1 then
      begin   { logical end of directory }
	dataspace := (volsize div 256) - lastused - 1;
	if dataspace>0 then checkspace(true);{check space at end of directory}
	{ set lastopening so outer proc. won't think directory is full }
	if lastopening=0 then lastopening := dindex;
	if (mostavail.hole=0) and (mostavail.sstart>0) then
	  mostavail.hole := lastopening;
	if (nextavail.hole=0) and (nextavail.sstart>0) then
	  nextavail.hole := lastopening;
	done := true;   lastused := (volsize div 256) + 1;
      end
      else
      if dentry.ftype=0 then
      begin   { hole in the directory }
	if not opening then
	begin
	  opening     := true;
	  lastopening := dindex;
	  if mostavail.sstart>0 then
	  with mostavail do
	  begin    { adjust fixed/biggest space }
	    if hole=0 then hole := lastopening
	    else
	      if (abs(hole-here)>abs(lastopening-here)) then
	      begin     { hole changed direction from entry }
		here := here + 1;
		hole := lastopening;
	      end;
	    if fixed then done := true;
	  end; { with }

	  if (space<0) and (nextavail.sstart>0) then
	  with nextavail do
	  begin     { adjust second biggest space }
	    if hole=0 then hole := lastopening
	    else
	      if (abs(hole-here)>abs(lastopening-here)) then
	      begin     { hole changed direction from entry }
		here := here + 1;
		hole := lastopening;
	      end;
	  end;

	end;
      end       { hole in the directory }
      else
      begin   { have file entry }
	dataspace := dentry.fstart - lastused - 1;
	if dataspace>0 then checkspace(false);
	{ if no dataspace yet, move lastopening to end of series }
	if (mostavail.sstart=0) and opening then lastopening := dindex - 1;
	opening  := false;
	lastused := dentry.fstart + dentry.fsize - 1;
      end;
    end;  {checkentry}

  begin {getspace}
    dindex := 1;
    seek(dir^,dindex);
    if space>0 then begin fixed:=true; space:=(space+255) div 256; end
	       else fixed:=false;
    lastused := dend - 1 ;    lastopening     := 0;
    mostavail.sstart:= 0;     nextavail.sstart:= 0;
    mostavail.ssize := 0;     nextavail.ssize := 0;
    mostavail.hole  := 0;     nextavail.hole  := 0;
    mostavail.here  := 0;     nextavail.here  := 0;
    done        := false;     opening     := false;
    repeat
      read(dir^,dentry);
      checkentry;
      dindex := dindex + 1;
      if not done then done := dindex>dlast;
    until done;

    if lastopening=0 then badio(idirfull)
    else
    begin       { have at least one directory opening }
      if (mostavail.sstart=0) or not fixed then
      begin
	dataspace := (volsize div 256) - lastused - 1;
	if dataspace>0 then
	begin
	  dindex := dlast + 1; {insurance policy }
	  if (not fixed and (dataspace>mostavail.ssize)) or
	     ((space<0) and (dataspace>nextavail.ssize)) or
	     (fixed and (dataspace>=space)) then checkspace(false);
	end;
      end;
      if mostavail.sstart=0 then badio(inoroom);

      if fixed then mostavail.ssize := space
      else
      with mostavail do
      begin     { final decision for non fixed space }
	{ watch for [*] type allocation }
	{ biggest of (1/2 biggest or 2nd biggest) } { include any odd sector }
	if space<0 then ssize:=(ssize div 2) + (ssize mod 2);
	if nextavail.ssize>=ssize then mostavail:=nextavail;
      end;
      shuffle;  { allign dataspace and directory entry }
      srec := mostavail;
    end;
  end;  {getspace}

{****************************************************************************}
  procedure finishfib;
  begin
    f.fileid    := dentry.fstart*256;
    f.fpeof     := dentry.fsize*256;
    if f.fisnew  then f.fleof := 0
		 else f.fleof := f.fpeof;
    f.fmodified := f.fisnew;
    if not f.fbuffered then f.am := amtable^[UNTYPEDFILE]
    else
     if f.fistextvar then f.am := amtable^[f.fkind]
		     else f.am := amtable^[datafile];
  end;  {finishfib}

{****************************************************************************}
  procedure opennew;
  var
    space       : spacerec;
  begin
    getspace(f.fpos,space);
    dindex := space.here;
    { fill in the lif directory entry }
    {file name}
    if f.fanonymous then dentry.fname := 'anonymous '
      else strtolifname(f.ftid,dentry.fname);
    dentry.ftype     := f.feft;
    dentry.fstart    := space.sstart;
    dentry.fsize     := space.ssize;
    setdate(dentry.fdate);
    dentry.fdate[3]  := 9; dentry.fdate[4] := 9; { mark as temporary }
    dentry.lastvol   := true;
    dentry.volnumber := 1;
    dentry.extension := 0;
    writedir(dir^,dindex,dentry); {write it out} flushdir;
    { finish the file fib }
    finishfib;
  end;  {opennew}

{****************************************************************************}
  procedure openold;
  var fk:filekind;
  begin
    liftofkind(dentry.ftype,fk);  f.fkind:=fk;
    finishfib;
    with dentry do
    begin
      f.fstartaddress := 0;
      f.feft := ftype;
      if (ftype=efttable^[datafile])
      or (ftype=uxtype) then f.fleof := extension
				   else f.fstartaddress := extension;
    end;
  end;

{****************************************************************************}
  procedure openf;
  begin
    opendir; checkvolid;
    if not (f.fanonymous and f.fisnew) then  checkftitle;
    if f.fisnew then
    begin   { new temp file }
      if not mediavalid then cleandir;
      if f.fanonymous then opennew
      else
      if findfile(f.fisnew,0) then ioresult:=ord(idupfile)
			      else opennew;
    end
    else    { existing permanent file }
    begin
      if findfile(f.fisnew,0) then
      begin
	openold;
	if not mediavalid then cleandir;
      end
      else ioresult:=ord(inofile);
    end;
  end;  { openf }

{****************************************************************************}
  procedure closef;
  var
    temp : integer;

  begin
    if f.fisnew then
    begin     { purge old file }
      temp:=dindex;
      if findfile(false,0) then purgef;
      dindex:=temp; readdir(dir^,dindex,dentry);
    end;
    if f.fmodified then
    with dentry do
    begin       { rewrite the directory entry }
      if (ftype=efttable^[datafile])
      or (ftype=uxtype) then extension := f.fleof
				   else extension := f.fstartaddress;
      temp:=(f.fleof+255) div 256;
      if temp<fsize then fsize:=temp;
      setdate(fdate);
      writedir(dir^,dindex,dentry); flushdir;
    end;
  end;

{****************************************************************************}
  procedure stretchf;
  var
    found, eod  : boolean;
    tempindex, filestart, dataspace, reqsize  : integer;

  begin {stretchf}
    tempindex := dindex;  found := false;   eod := false;
    filestart := dentry.fstart;
    reqsize := (f.fpos + 255) div 256;  { round requested size 25jan83}
    if reqsize>dentry.fsize then
    begin
      while (not found) and (not eod) do
      with dentry do
      begin
	tempindex := tempindex + 1;
	if tempindex>dlast then eod := true
	else
	begin
	  readdir(dir^,tempindex,dentry);
	  if ftype=-1 then eod := true
	  else
	  if ftype<>0 then
	  begin
	    found     := true;
	    dataspace := dentry.fstart - filestart;
	  end;
	end;
      end; { while with }
      if eod then
      begin     { dataspace is from begining of file to end of volume }
	found:=true;                                    {25jan83}
	dataspace := (volsize div 256) - filestart;     {25jan83}
      end;
      if found then
      if dataspace>=reqsize then                        {25jan83}
      begin   { will stretch }
	readdir(dir^,dindex,dentry);
	{ allow requested space + half of excess space  25jan83 }
	dentry.fsize := (reqsize + dataspace) div 2;    {25jan83}
	writedir(dir^,dindex,dentry);   flushdir;
	f.fpeof      := dentry.fsize * 256;
      end;    { will stretch }
    end;
  end;  { stretchf }

{****************************************************************************}
  procedure changefname(anyvar n:string255);
  var
    tempindex : integer;
    ok        : boolean;
  begin
    if f.fanonymous then badio(ibadrequest);
    opendir;    checkvolid;     checkftitle;
    { find the original (permanent file) }
    if not findfile(false,0) then badio(inofile);
    { change the name }
    tempindex := dindex;
    if (strlen(n)=0) or (strlen(n)>tidleng) then badio(ibadtitle);
    f.ftid := n;
    if findfile(false,0) then badio(idupfile)
    else
    begin
      readdir(dir^,tempindex,dentry);
      strtolifname(f.ftid,dentry.fname);
      writedir(dir^,tempindex,dentry); flushdir;
    end
  end;  { changefname }

{****************************************************************************}
  procedure dooverwritefile;
  begin
    opendir;  checkvolid;
    if f.fanonymous then badio(ibadrequest);
    checkftitle;
    f.fisnew := true;
    if findfile(false,0) then
    begin       { existing file }
      if not mediavalid then cleandir;
      openold;  f.fleof := 0;   { setup fib then reset logical eof }
      setdate(dentry.fdate);
      dentry.fdate[3] := 9; dentry.fdate[4] := 9; { now a temporary file }
      writedir(dir^,dindex,dentry);     anychange := true;
    end
    else
    begin       { new file }
      if not mediavalid then cleandir;
      opennew;
    end;
  end;  { dooverwritefile }

{****************************************************************************}
  procedure nowopen;
  begin
    opendir;
    if f.fvid<>volid then ioresult:=ord(ilostfile)
    else
    if not findfile(f.fisnew,f.feft) then ioresult:=ord(ilostfile);
    goodio;
  end;

{****************************************************************************}
{****************************************************************************}
  begin {lifdam}
    lockup;
    mediavalid := unitable^[unum].umediavalid;
    { tell TM to keep quiet about media changes for a while }
    unitable^[unum].umediavalid   := true;
    unitable^[unum].ureportchange := false;
    fibp(dir)^.funit := unum; fibp(dir)^.freadable := false;
    ioresult         := ord(inoerror);
    anychange        := false;
    try
      case request of
	openfile  : begin f.fisnew := false; openf; end;
	createfile: begin f.fisnew := true; openf; end;
	overwritefile : dooverwritefile;
	closefile : if f.fmodified then begin nowopen; closef; end;
	purgefile : begin nowopen; purgef; end;
	stretchit : begin nowopen; stretchf; end;
	changename: changefname(f.fwindow^);
	getvolumename:
	  begin
	    ok := lifvol; strtoany(unitable^[unum].uvid,f);
	  end;
	setvolumename:
	  if lifvol then
	  begin
	    strtopac(f,6,vol.volname,true);
	    with unitable^[unum] do
	    begin
	      call(tm,fibp(dir),writebytes,vol,sizeof(lvheader),0);
	      goodio;   anychange := true;
	    end;
	  end;
	purgename    : dopurgename;
	getvolumedate: getsdate(f);
	setvolumedate: setsdate(f);
	crunch       : crunchv;
	catalog      : docat(f.fwindow^);
	opendirectory: doopendirectory(f.fwindow^);
	closedirectory:begin end;
	makedirectory: domakedirectory(f.fwindow^);
	openunit,
	openvolume   : begin
			 cleanup;
			 unblockeddam(f,unum,request);
			 mediavalid := unitable^[unum].umediavalid;
		       end;
	setunitprefix: if strlen(f.ftitle)>0 then badio(ibadtitle);
	stripname    : begin
			 checkftitle; setstrlen(f.ftitle,0);
			 strtolifname(f.ftid,dentry.fname);
		       end;
	otherwise
	  ioresult := ord(ibadrequest);
      end;   { case request }
      if anychange then flushdir;
      cleanup;  { fix umediavalid and ureportchange }
    recover
    begin
      cleanup;  { fix umediavalid and ureportchange }
      if (escapecode<0) and (escapecode<>-10) then
	begin lockdown; escape(escapecode); end;
    end;
    lockdown;
  end;
  procedure installlifdam;
  begin
    if dir=nil then new(dir);
  end;
end;  { module }
  import lifmodule,loader;
begin { instlifdam}
  installlifdam;
  markuser;
end.{ rev 2.2x1 }
@


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


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 1206
					      (*

 (c) Copyright Hewlett-Packard Company, 1982.
All rights are reserved.  Copying or other
reproduction of this program except for archival
purposes is prohibited without the prior
written consent of Hewlett-Packard Company.


	    RESTRICTED RIGHTS LEGEND

Use, duplication, or disclosure by the Government
is subject to restrictions as set forth in
paragraph (b) (3) (B) of the Rights in Technical
Data and Computer Software clause in
DAR 7-104.9(a).

HEWLETT-PACKARD COMPANY
Fort Collins, Colorado                         *)


$MODCAL$
$DEBUG OFF,  range off, ovflcheck off$
$ALLOW_PACKED ON $   { JWS 4/10/85 }

program instlifdam;
module lifmodule;
import sysglobals, sysdevs, misc, fs;
export
  procedure lifdam(anyvar f: fib; unum: unitnum; request: damrequesttype);
  procedure installlifdam;

implement
  const
    entrysize = 32;
    uxtype = -5813; { eft for uxfile }
  type
    vname   =packed array[1..6] of char;
    lifname = packed array[1..10] of char;
    bcd     = 0..15;
    word    = 0..65535;
    integer16 = -32768..32767;
    word15  = 0..32767;
    tdate   = packed array[1..12] of bcd;
    lvheader=packed record      {volume header sector 0}
	       discid   : word;
	       volname  : vname;
	       dstart   : integer;
	       dummy1   : integer16;
	       dummy2   : integer16;
	       dsize    : integer;
	       version  : integer16;
	       dummy3   : integer16;
	       tps      : integer;      {tracks/surface}
	       spm      : integer;      {surfaces/medium}
	       spt      : integer;      {sectors/track}
	       cdate    : tdate;        {volume create time}
	       filler   : packed array[21..123] of integer16;
	       sdate    : tdate;
	       dummy4   : integer16;
	     end;
  direntry = packed record
	       fname    : lifname;
	       ftype    : integer16;
	       fstart   : integer;
	       fsize    : integer;
	       fdate    : tdate;
	       lastvol  : boolean;
	       volnumber: word15;
	       extension: integer;
	     end;

  spacerec  = record
		sstart      : integer;
		ssize       : integer;
		here      : integer;
		hole      : integer;
	      end;
  catarray  = array[1..maxint] of catentry;
  dirfile   = file of direntry;
  var
    dir        : ^dirfile;

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

{****************************************************************************}
  procedure badio(result : iorsltwd);
  begin ioresult := ord(result); escape(0); end;

{****************************************************************************}
  procedure pactostr(anyvar pc: lifname; l:integer; var s:string);
  var i : integer;
  begin
    setstrlen(s,l); for i:=1 to l do s[i] := pc[i];      i := l;
    while (i>1) and (s[i]=' ') do i:=i-1; setstrlen(s,i);
  end;

{****************************************************************************}
  procedure strtopac(anyvar s:string255; l:integer;
		     anyvar pc:lifname;  sizechk:boolean);
  var i,k : integer;
  begin
    if sizechk then
      if (strlen(s)>l) or (strlen(s)=0) then badio(ibadtitle);
    k:=strlen(s);
    for i:=1 to l do if i>k then pc[i] := ' ' else pc[i] := s[i];
  end;

{****************************************************************************}
  procedure strtoany(var s:string; anyvar s2:string255);
  begin s2:=s; end;

{****************************************************************************}
  procedure setdate(var d:tdate);
  var
    doy:daterec;        tod:timerec;
  begin
    sysdate(doy);       systime(tod);
    with doy, tod do
    begin
      {LAF 880101 added "mod 10" to "div 10"}
      d[1]  := year div 10 mod 10;d[2]  := year mod 10;
      d[3]  := month div 10;  d[4]  := month mod 10;
      d[5]  := day div 10;    d[6]  := day mod 10;
      d[7]  := hour div 10;   d[8]  := hour mod 10;
      d[9]  := minute div 10; d[10] := minute mod 10;
      d[11] := (centisecond div 100) div 10;
      d[12] := (centisecond div 100) mod 10;
    end;
  end;

{****************************************************************************}
  procedure lifnametostr(anyvar ln :lifname ; var s:string);
  label 1;
  var
    sl  : integer;
    fk  : filekind;
    found : boolean;

  begin {lifname to str}
    pactostr(ln,10,s); sl := strlen(s);
    if sl=10 then
    begin
      if suffix(s)=datafile then
      begin     { rip underscores and try to add suffix }
	while (sl>=1) and (s[sl]='_') do sl := sl - 1;
	for fk:=untypedfile to lastfkind do
	begin
	  if strlen(suffixtable^[fk])>0 then
	    if suffixtable^[fk][1]=s[sl] then
	    begin       { found suffix }
	      { change last char to . then append suffix }
	      setstrlen(s,sl); s[sl] := '.';
	      s := s + suffixtable^[fk];  goto 1;
	    end;
	end;
      end;      { for }
    end;
  1:end;  {lifname to str}

{****************************************************************************}
  procedure strtolifname(var s:string; var ln:lifname);
  var
    sl, i       : integer;
    stemp,temp2 : fid;  {31jan83  temp2 for case insensitive suffix}
    fk          : filekind;

  begin {str to lifname}
    sl := strlen(s);
    fk := suffix(s);
    if fk=datafile then
    begin       { data files have no suffix }
      if sl>10 then badio(ibadtitle);
      strtopac(s,10,ln,false);
    end
    else
    begin       { remove the suffix }
      sl := strlen(s)-strlen(suffixtable^[fk]);
      if sl>10 then badio(ibadtitle);
      strtopac(s,10,ln,false);  { pack the name }
      { replace dot with first char of suffix (to preserve uniqueness)}
      ln[sl] := suffixtable^[fk][1];    sl := sl+1;
      for i:=sl to 10 do ln[i] := '_';  { pad with _ }
    end;
    lifnametostr(ln,stemp);     { decompress the name as a final check }
    if stemp<>s then
    begin                       {31jan83 case insensitive suffix testing}
      temp2 := s;               { copy s, then remove given suffix }
      setstrlen(temp2,strlen(temp2)-strlen(suffixtable^[fk]));
      temp2:= temp2 + suffixtable^[fk];         { add suffix from table }
      if stemp<>temp2 then badio(ibadtitle);    { check again }
    end;
  end; {str to lifname}

{****************************************************************************}
{****************************************************************************}
  procedure lifdam(anyvar f: fib; unum: unitnum; request: damrequesttype);
    var
       vol      : lvheader;
       volid    : vid;
       ok, mediavalid ,anychange: boolean;
       dindex, dlast, dend, vsize       : integer;
       dentry   : direntry;

  $iocheck off$
{****************************************************************************}
  function volsize:integer;
  begin
    if vsize=0 then vsize := ueovbytes(unum);
    volsize := vsize;
  end;

{****************************************************************************}
  procedure cleanup;
  begin
    if ioresult=ord(zmediumchanged) then mediavalid := false;
    unitable^[unum].umediavalid   := mediavalid;
    unitable^[unum].ureportchange := true;
  end;

{****************************************************************************}
  procedure checkftitle;
  begin
    if (strlen(f.ftitle)>tidleng) or (strlen(f.ftitle)=0) then badio(ibadtitle);
    f.ftid := f.ftitle;
  end;

{****************************************************************************}
  function vvname:boolean;
  var
    i : integer;
    b : boolean;
  begin
    vvname := true; b := true;
    for i := 1 to 6 do  {1feb83 allow all blank names}
    begin
      if b then b := vol.volname[i]>' ';
      if not b then     {1feb83 allow all blank names}
	if vol.volname[i]<>' ' then vvname := false;
    end
  end;

{****************************************************************************}
  function lifvol:boolean;
  var
    i : integer;        {31jan83 allow all blank volname}
  begin { read and validate the volume header }
    with fibp(dir)^, unitable^[unum] do
    begin
      fileid := 0; fpeof := maxint;   { initialize dir }
      if uisblkd then
      begin
	call(tm,fibp(dir),readbytes,vol,sizeof(lvheader),0);
	with vol do
	   ok := ((ioresult=ord(inoerror)) and (discid=32768) and
		 (dummy1=4096) and (dummy2=0) and (dummy3=0) and
		 { dstart=1 -> wsheader or LIF BOOT dir.  if byteoffset }
		 { = 0, then dstart=1 OK (LIF BOOT dir); otherwise, }
		 { dstart=1 means wsheader, which we do NOT recognize }
		 (((byteoffset = 0) and (dstart >= 1)) or (dstart > 1)) and
		 (dsize>0) and vvname);
      end
      else ok := false;
      ureportchange := true;    { now let TM report any mediachanges }
      umediavalid   := true;
      lifvol := ok;
      if ok then
      begin
	if vol.volname[1]=' ' then      {31jan83 allow all blank volname}
	begin
	  setstrlen(volid,6); for i:=1 to 6 do volid[i]:=' ';
	end
	else
	  pactostr(vol.volname,6,volid);
	if volid<>uvid then
	begin mediavalid := false; uvid := volid; end;
      end
      else setstrlen(uvid,0);
      if (not ok) and (ioresult=ord(inoerror)) then ioresult:=ord(inodirectory);
    end;
  end;  { lifvol }

  $iocheck on$
{****************************************************************************}
  procedure opendir;
  begin
    if lifvol then
    begin
      dlast:=vol.dsize * 8;             { # entries in directory }
      dend:=vol.dstart + vol.dsize;   { directory end sector + 1 }
      with fibp(dir)^ do
      begin   { initialize the fib ( fake OPEN )}
	fisnew:=false;
	freadable:=true;      fwriteable:=true;
	freadmode:=false;     fbufvalid:=false;
	feof:=false;          fmodified:=false;
	fileid:=vol.dstart*256;
	if vol.version>0 then vsize := vol.tps*vol.spm*vol.spt*256
			 else vsize := 0;
	fpeof:=vol.dsize*256;      { end of directory }
	fleof:=fpeof;
	fpos:=0;              am:=amtable^[datafile];
	freptcnt:=0;          flastpos:=-1;
	fbufchanged:=false;   fbuffered:=true;
      end;
      dindex:=1;   read(dir^,dentry);
      goodio;
    end
    else escape(0);
  end;  { opendir }

{****************************************************************************}
  procedure checkvolid;
  begin
    if f.fvid<>volid then badio(ilostunit);
  end;

{****************************************************************************}
  procedure flushdir;
  begin { june 83 fixed to account for ops which don't open the directory RDQ}
  if fibp(dir)^.freadable
	 { directory open so flush thru AM }
    then call(fibp(dir)^.am,fibp(dir),flush,ioresult,0,0)
	 { directory not open so flush thru TM }
    else call(unitable^[unum].tm,fibp(dir),flush,ioresult,0,0);
    anychange := false;
  end;

{****************************************************************************}
  procedure getsdate(anyvar svdate:daterec);
  begin
    if lifvol then
    with vol, svdate do
    begin
      if not ((sdate[5]=0) and (sdate[6]=0)) then
      begin
	{LAF 880101 conditionally add 100 to year; year range is 28..127}
	year:=sdate[1]*10+sdate[2]; if year<28 then year:=year+100;
	month:=sdate[3]*10+sdate[4];
	day:=sdate[5]*10+sdate[6];
      end;
    end;
  end;

{****************************************************************************}
  procedure setsdate(anyvar svdate:daterec);
  var
    i   : integer;
  begin
    if lifvol then
    with svdate, vol do
    begin
      {LAF 880101 added "mod 10" to "div 10"}
      sdate[1]:=year div 10 mod 10; sdate[2]:=year mod 10;
      sdate[3]:=month div 10; sdate[4]:=month mod 10;
      sdate[5]:=day div 10; sdate[6]:=day mod 10;
      for i:=7 to 12 do sdate[i]:=0;    {clear time of day}
      with unitable^[unum] do
      begin
	call(tm,fibp(dir),writebytes,vol,sizeof(lvheader),0);
	goodio;         anychange := true;
      end;
    end;
  end;  { setsdate }

{****************************************************************************}
  procedure cleandir;
  var
    k           : integer;
    tempd       : direntry;

  begin {cleandir}
    k:=1;       seek(dir^,k);
    repeat
      read(dir^,tempd);
      if tempd.ftype=-1 then k:=dlast
      else
      if tempd.ftype<>0 then
      begin
	if (tempd.fdate[3]=9) and (tempd.fdate[4]=9) then
	begin { temp file so purge it }
	  tempd.ftype:=0;
	  writedir(dir^,k,tempd);       anychange := true;
	end;
      end;
      k:=k+1;
    until k>dlast;
    mediavalid := true;
  end;  {clean dir}

{****************************************************************************}
  procedure crunchv; { assumed to be called from procedure lifdam only 24jan83}
  var
    frompos, topos, todindex    : integer;
    bsize, filesize, movesize   : integer;
    bufptr, heapmark            : windowp;
    changed                     : boolean;
    datafib                     : fibp;

  begin
    opendir; checkvolid;
    if strlen(f.ftitle)<>0 then badio(ibadtitle);
    cleandir;
    { allocate the buffer space }
    MARK(heapmark);
    try
      bsize:=(memavail-(1024*5));
      if bsize>=256 then
      begin       { buffer in sector multiples }
	bsize:=(bsize div 256) * 256;
	newwords(bufptr,bsize div 2);
	new(datafib);   { set up the data fib }
	with datafib^ do
	begin
	  funit:=fibp(dir)^.funit;
	  fileid:=0;
	  fpeof:=volsize;      fleof:=fpeof;
	end;
      end
      else escape(-2); { not enough room to run }
      { krunch it }
      dindex:=1;
      todindex:=0;       topos:=dend*256;        anychange:=false;
      repeat
	changed:=false;
	readdir(dir^,dindex,dentry);
	if dentry.ftype=-1 then dindex:=dlast
	else
	if dentry.ftype=efttable^[badfile] then
	begin   { bad sectors ; don't move this file }
	  todindex:=todindex+1;
	  if dindex<>todindex then changed:=true;       { move the entry }
	  topos:=(dentry.fstart+dentry.fsize)*256;      { move topos }
	end
	else
	if dentry.ftype=0 then anychange := true        { found purged entry }
	else
	begin { move the file ? }
	  todindex:=todindex+1;
	  if dindex<>todindex then changed:=true;       { move the entry}

	  frompos:=dentry.fstart*256;
	  if frompos<>topos then
	    begin { move the data }
	      filesize:=dentry.fsize*256;   { bytes to move}
	      dentry.fstart:=topos div 256; { set start}
	      changed:=true;
	      with unitable^[datafib^.funit] do
	      repeat
		if filesize>bsize then movesize:=bsize
				  else movesize:=filesize;
		call(tm,datafib,readbytes,bufptr^,movesize,frompos);
		frompos:=frompos+movesize; goodio;

		call(tm,datafib,writebytes,bufptr^,movesize,topos);
		topos:=topos+movesize; goodio;

		filesize:=filesize-movesize;
	      until filesize=0;
	    end  { move the data }
	  else topos:=topos+dentry.fsize*256;
	end;    { move the file ? }
	if changed then
	begin
	  writedir(dir^,todindex,dentry);       anychange := true;
	end;
	dindex:=dindex+1;
      until dindex>dlast;
      if anychange then
      begin     { put end of directory mark }
	if todindex<dlast then
	begin
	  dentry.ftype:=-1;
	  writedir(dir^,todindex+1,dentry);
	end;
      end;
      call(unitable^[datafib^.funit].tm,datafib,flush,ioresult,0,0);
      RELEASE(heapmark);
    recover
      begin
	RELEASE(heapmark);
	frompos := ioresult;  topos := escapecode;      { save state 24jan83}
	if anychange then flushdir;                { try to clean up 24jan83}
	ioresult := frompos;                     { restore the state 24jan83}
	escape(frompos);                                       {exit 24jan83}
      end;
  end;  {crunchv}

{****************************************************************************}
  procedure domakedirectory(anyvar cat:catentry);
  var
    i      : integer;
    actualsize : integer;
    secbuf : packed array[0..63] of integer;
  begin
    if strlen(f.ftitle)>0 then badio(ibadrequest);
    with vol, cat do
    begin
      if not lifvol then
      begin
	if (ioresult<>ord(inoerror)) and
	   (ioresult<>ord(inodirectory)) then escape(0);
	ioresult := ord(inoerror);
	{ clear header fields }
	discid := 32768;
	dummy1 := 4096;   dummy2 := 0;   dummy3 := 0;
	version := 0;
      end
      else checkvolid;
		{ directory size checks }
      dstart := 2;
      dsize  := (((cextra1*entrysize)+255) div 256);
      if dsize<=0 then dsize := 10;     { default directory size }
		{ size checks }
      actualsize := ueovbytes(unum);
      if (cpsize>actualsize) or (cpsize<1024) then badio(inoroom);
      if (dstart+dsize+1)*256>=cpsize then badio(inoroom);
		{ fill in the pieces }
      strtopac(cname,6,volname,true);   { volume name }
      if version>0 then
	if (tps*spm*spt*256)<>cpsize then version := 0;

      setdate(cdate);   { fill in create date }
      for i := 1 to 12 do sdate[i] := 0; { clear system date }

      if version=0 then
      begin     { create pseudo level 1 header }
	version := 1;
	tps := 1; spm := 1; spt := cpsize div 256;
	for i:=21 to 123 do filler[i]:=0;
      end;
      dummy4 := 0;      { clear 250 maint. word }
		{ write volume header }
      with unitable^[unum] do
      BEGIN
	call(tm,fibp(dir),writebytes,vol,sizeof(lvheader),0); goodio;
	for i:=0 to 63 do secbuf[i] := 0;
	call(tm,fibp(dir),writebytes,secbuf,256,256);        {clear sector 1}
      END;
		{ write end of directory }
      opendir;
      dentry.ftype := -1;
      writedir(dir^,1,dentry); flushdir;
    end;
  end;  {domakedirectory}

{****************************************************************************}
  procedure liftofkind(lt:integer16; var fk:filekind);
  begin
    fk:=untypedfile;
    while (fk<>lastfkind) and (efttable^[fk]<>lt) do fk:=succ(fk);
    if efttable^[fk]<>lt then fk:=DATAFILE;
  end;

{****************************************************************************}
  procedure cvtdatetime(var fdate:tdate; var date:daterec; var time:timerec);
  begin
    {LAF 880101 conditionally add 100 to year; year range is 28..127}
    date.year:=fdate[1]*10+fdate[2]; if date.year<28 then date.year:=date.year+100;
    date.month:=fdate[3]*10+fdate[4];
    date.day:=fdate[5]*10+fdate[6];
    {LAF 880101 changed default to 1Jan70 from 1Mar00}
    if (date.month=0) or (date.day=0) then
      begin date.year:=70; date.month:=1; date.day:=1; end;
    time.hour:=fdate[7]*10+fdate[8];
    time.minute:=fdate[9]*10+fdate[10];
    time.centisecond:=(fdate[11]*10+fdate[12])*100;
  end;

{****************************************************************************}
  procedure doopendirectory(anyvar cat:catentry);
  begin
    opendir;    checkvolid;
    with cat do
    begin      { volume info }
      cname:=volid;
      cstart:=(vol.dstart+vol.dsize)*256;      { start of data area }
      cblocksize:=256;            { No. of bytes in allocation unit }
      cpsize:=volsize;                { physical size of the volume }
      clsize:=cpsize-cstart;            {  data space on the medium }
      cextra1:=vol.dsize*8;              { number of possible files }
      cextra2:=-1;                         { unused space available }
      cvtdatetime(vol.sdate,clastdate,clasttime);     { system date }
      cvtdatetime(vol.cdate,ccreatedate,ccreatetime);{ date created }
      cinfo:='LIF level  '; cinfo[11]:=chr(vol.version+ord('0'));
    end;       { volume info }
  end;

{****************************************************************************}
  procedure docat(anyvar cat : catarray);
  var
    di, dstart, dnum    : integer;
    done        : boolean;

    procedure zerodatetime(var dr:daterec; var tr:timerec);
    begin
      {LAF 880101 changed default to 1Jan70 from 1Mar00}
      dr.year:=70; dr.month:=1; dr.day:=1;
      tr.hour:=0; tr.minute:=0; tr.centisecond:=0;
    end;

  begin {docat}
    opendir;    checkvolid;
    dstart:=f.fpos;    dnum:=f.fpeof;   f.fpeof:=0;
    di:=1;    seek(dir^,di);    done:=false;
    while (f.fpeof<dnum) and (not done) do
    begin      { get file info }
      read(dir^,dentry);
      if dentry.ftype=-1 then done:=true
      else
      { don't show temporary or purged files }
      if (dentry.ftype<>0) and
	 ((dentry.fdate[3]<>9) or (dentry.fdate[4]<>9)) then
      begin   { count this entry }
	if dstart<=0 then     { skip to start index }
	begin { report this entry }
	  f.fpeof := f.fpeof+1;
	  with dentry, cat[f.fpeof] do
	  begin
	    lifnametostr(fname,cname);
	    ceft    := ftype;   liftofkind(ceft,ckind);
	    cpsize  := fsize*256;
	    if (ftype=-5622) {workstation data}
	    or (ftype=uxtype)   {workstation ux}
		then clsize:=extension
	    else clsize := cpsize;
	    cstart     := fstart*256;
	    cblocksize := 256;
	    zerodatetime(ccreatedate,ccreatetime);
	    cvtdatetime(fdate,clastdate,clasttime);
	    cextra1 := extension;  cextra2 := volnumber;
	    if lastvol then cinfo:='' else cinfo := 'continued';
	  end { with }
	end   { report this entry }
	else dstart := dstart-1;
      end;    { count this entry }
      di:=di+1;
      if di>dlast then done := true;
    end;      { while }
  end;  {docat}

{****************************************************************************}
  function findfile(temporary:boolean; ftypecode:integer16):boolean;
  var
    found  : boolean;
    tempname    : lifname;

  begin {find file}
    if not f.fanonymous then strtolifname(f.ftid,tempname);
    found:=false;       dindex:=1;      seek(dir^,dindex);
    repeat
      read(dir^,dentry);
      with dentry do
      begin
	if ftype=-1 then dindex:=dlast
	else
	if ftype<>0 then
	begin   { check this entry }
	  if f.fanonymous then found:=(dentry.fstart*256 = f.fileid)
	  else
	  if (tempname=fname) then
	    if ((ftypecode=0) or (ftypecode=ftype)) then
	    begin
	      if temporary then found:=(fdate[3]=9) and (fdate[4]=9)
			   else found:=(fdate[3]<>9) or (fdate[4]<>9);
	    end;
	end;
      end;      { with }
      if not found then dindex:=dindex+1;
    until (dindex>dlast) or found;
    findfile:=found;
  end; {find file}

{****************************************************************************}
  procedure purgef;
  begin
    dentry.ftype := 0; writedir(dir^,dindex,dentry); flushdir;
  end;

{****************************************************************************}
  procedure dopurgename;
  begin
    opendir;    checkvolid;     checkftitle;
    if findfile(false,0) then purgef
			 else ioresult := ord(inofile);
  end;

  {****************************************************************************}
  procedure getspace(space:integer; var srec:spacerec);
  var
    fixed, done, opening          : boolean;
    lastused, lastopening         : integer;
    dataspace                     : integer;
    mostavail, nextavail          : spacerec;

    procedure shuffle;
    var
      tempentry             : direntry;
      increment, here, hole : integer;

    begin       { move directory entries to open a required space }
      here := mostavail.here;
      hole := mostavail.hole;
      if here<=hole then
      begin
	if hole<dlast then
	begin   { move logical eod if required }
	  readdir(dir^,hole,tempentry);
	  if tempentry.ftype=-1 then
	  begin
	    writedir(dir^,hole + 1,tempentry);
	    anychange := true;
	  end;
	end;
	increment := -1;
      end
      else
	increment := 1;
      while hole<>here do
      begin
	readdir(dir^,hole+increment,tempentry);
	writedir(dir^,hole,tempentry);      anychange := true;
	hole := hole + increment;
      end;
      tempentry.ftype:=0;
      writedir(dir^,here,tempentry); anychange := true;
    end;        { shuffle }

    procedure allocate(var srec : spacerec; eod : boolean);
    begin
      srec.ssize  := dataspace;
      srec.sstart := lastused + 1;
      if eod then
      begin { end of directory allocation }
	if opening then srec.here := lastopening
		   else srec.here := dindex;
	srec.hole := srec.here;
      end
      else
      begin { middle of directory allocation }
	if opening then srec.here := lastopening
	else
	  if lastopening>0 then srec.here := dindex-1
			   else srec.here := dindex;
	srec.hole := lastopening;
      end;
    end;        { allocate }

    procedure checkspace(eod : boolean);
    var
      temp      : integer;
      check2    : boolean;
    begin
      if fixed and (dataspace>=space) then
      begin     { fixed space check }
	if (mostavail.ssize=0) { no space yet } or
	   (dataspace=space) { exact fit } or
	   { this space is bigger than previous good fit }
	   (((dataspace-space)>(mostavail.ssize-space)) and
	   (mostavail.ssize<>space)) then allocate(mostavail,eod);
	if mostavail.hole>0 then done := true;
      end;      { fixed space check }

      if not fixed then
      begin     { biggest or 2nd biggest }
	check2 := true;
	if (dataspace>=mostavail.ssize) then
	begin   { check biggest space }
	  if (dataspace>mostavail.ssize) then
	  begin { new biggest space }
	    nextavail := mostavail;       { demote to second biggest }
	    allocate(mostavail,eod);
	    check2    := false;
	  end
	  else
	  if not eod then
	  begin { same size space }
	    if opening then temp := lastopening
	    else
	      if lastopening>0 then temp := dindex -1
			       else temp := dindex;
	    if (abs(temp-lastopening)<=abs(mostavail.here-mostavail.hole)) or
	       (lastopening=0) then
	    with mostavail do
	    begin       { this causes shorter shuffle }
	      ssize  := dataspace;
	      sstart := lastused + 1;
	      here   := temp;
	      hole   := lastopening;
	    end;
	  end;  { same size space }
	end;    { check biggest space }
	if check2 then
	  if (dataspace>=nextavail.ssize) and (space<0) then
	  begin   { check 2nd biggest space }
	    if dataspace>nextavail.ssize then allocate(nextavail,eod)
	    else
	    if not eod then
	    begin { same size space }
	      if opening then temp := lastopening
	      else
		if lastopening>0 then temp := dindex -1
				 else temp := dindex;
	      if (abs(temp-lastopening)<=abs(nextavail.here-nextavail.hole)) or
		 (lastopening=0) then
	      with nextavail do
	      begin       { this causes shorter shuffle }
		ssize  := dataspace;
		sstart := lastused + 1;
		here   := temp;
		hole   := lastopening;
	      end;
	    end;
	  end;    { same size space }
      end;      { biggest or 2nd biggest }
    end; {checkspace}

    procedure checkentry;
    begin       { checkentry }
      if dentry.ftype=-1 then
      begin   { logical end of directory }
	dataspace := (volsize div 256) - lastused - 1;
	if dataspace>0 then checkspace(true);{check space at end of directory}
	{ set lastopening so outer proc. won't think directory is full }
	if lastopening=0 then lastopening := dindex;
	if (mostavail.hole=0) and (mostavail.sstart>0) then
	  mostavail.hole := lastopening;
	if (nextavail.hole=0) and (nextavail.sstart>0) then
	  nextavail.hole := lastopening;
	done := true;   lastused := (volsize div 256) + 1;
      end
      else
      if dentry.ftype=0 then
      begin   { hole in the directory }
	if not opening then
	begin
	  opening     := true;
	  lastopening := dindex;
	  if mostavail.sstart>0 then
	  with mostavail do
	  begin    { adjust fixed/biggest space }
	    if hole=0 then hole := lastopening
	    else
	      if (abs(hole-here)>abs(lastopening-here)) then
	      begin     { hole changed direction from entry }
		here := here + 1;
		hole := lastopening;
	      end;
	    if fixed then done := true;
	  end; { with }

	  if (space<0) and (nextavail.sstart>0) then
	  with nextavail do
	  begin     { adjust second biggest space }
	    if hole=0 then hole := lastopening
	    else
	      if (abs(hole-here)>abs(lastopening-here)) then
	      begin     { hole changed direction from entry }
		here := here + 1;
		hole := lastopening;
	      end;
	  end;

	end;
      end       { hole in the directory }
      else
      begin   { have file entry }
	dataspace := dentry.fstart - lastused - 1;
	if dataspace>0 then checkspace(false);
	{ if no dataspace yet, move lastopening to end of series }
	if (mostavail.sstart=0) and opening then lastopening := dindex - 1;
	opening  := false;
	lastused := dentry.fstart + dentry.fsize - 1;
      end;
    end;  {checkentry}

  begin {getspace}
    dindex := 1;
    seek(dir^,dindex);
    if space>0 then begin fixed:=true; space:=(space+255) div 256; end
	       else fixed:=false;
    lastused := dend - 1 ;    lastopening     := 0;
    mostavail.sstart:= 0;     nextavail.sstart:= 0;
    mostavail.ssize := 0;     nextavail.ssize := 0;
    mostavail.hole  := 0;     nextavail.hole  := 0;
    mostavail.here  := 0;     nextavail.here  := 0;
    done        := false;     opening     := false;
    repeat
      read(dir^,dentry);
      checkentry;
      dindex := dindex + 1;
      if not done then done := dindex>dlast;
    until done;

    if lastopening=0 then badio(idirfull)
    else
    begin       { have at least one directory opening }
      if (mostavail.sstart=0) or not fixed then
      begin
	dataspace := (volsize div 256) - lastused - 1;
	if dataspace>0 then
	begin
	  dindex := dlast + 1; {insurance policy }
	  if (not fixed and (dataspace>mostavail.ssize)) or
	     ((space<0) and (dataspace>nextavail.ssize)) or
	     (fixed and (dataspace>=space)) then checkspace(false);
	end;
      end;
      if mostavail.sstart=0 then badio(inoroom);

      if fixed then mostavail.ssize := space
      else
      with mostavail do
      begin     { final decision for non fixed space }
	{ watch for [*] type allocation }
	{ biggest of (1/2 biggest or 2nd biggest) } { include any odd sector }
	if space<0 then ssize:=(ssize div 2) + (ssize mod 2);
	if nextavail.ssize>=ssize then mostavail:=nextavail;
      end;
      shuffle;  { allign dataspace and directory entry }
      srec := mostavail;
    end;
  end;  {getspace}

{****************************************************************************}
  procedure finishfib;
  begin
    f.fileid    := dentry.fstart*256;
    f.fpeof     := dentry.fsize*256;
    if f.fisnew  then f.fleof := 0
		 else f.fleof := f.fpeof;
    f.fmodified := f.fisnew;
    if not f.fbuffered then f.am := amtable^[UNTYPEDFILE]
    else
     if f.fistextvar then f.am := amtable^[f.fkind]
		     else f.am := amtable^[datafile];
  end;  {finishfib}

{****************************************************************************}
  procedure opennew;
  var
    space       : spacerec;
  begin
    getspace(f.fpos,space);
    dindex := space.here;
    { fill in the lif directory entry }
    {file name}
    if f.fanonymous then dentry.fname := 'anonymous '
      else strtolifname(f.ftid,dentry.fname);
    dentry.ftype     := f.feft;
    dentry.fstart    := space.sstart;
    dentry.fsize     := space.ssize;
    setdate(dentry.fdate);
    dentry.fdate[3]  := 9; dentry.fdate[4] := 9; { mark as temporary }
    dentry.lastvol   := true;
    dentry.volnumber := 1;
    dentry.extension := 0;
    writedir(dir^,dindex,dentry); {write it out} flushdir;
    { finish the file fib }
    finishfib;
  end;  {opennew}

{****************************************************************************}
  procedure openold;
  var fk:filekind;
  begin
    liftofkind(dentry.ftype,fk);  f.fkind:=fk;
    finishfib;
    with dentry do
    begin
      f.fstartaddress := 0;
      f.feft := ftype;
      if (ftype=efttable^[datafile])
      or (ftype=uxtype) then f.fleof := extension
				   else f.fstartaddress := extension;
    end;
  end;

{****************************************************************************}
  procedure openf;
  begin
    opendir; checkvolid;
    if not (f.fanonymous and f.fisnew) then  checkftitle;
    if f.fisnew then
    begin   { new temp file }
      if not mediavalid then cleandir;
      if f.fanonymous then opennew
      else
      if findfile(f.fisnew,0) then ioresult:=ord(idupfile)
			      else opennew;
    end
    else    { existing permanent file }
    begin
      if findfile(f.fisnew,0) then
      begin
	openold;
	if not mediavalid then cleandir;
      end
      else ioresult:=ord(inofile);
    end;
  end;  { openf }

{****************************************************************************}
  procedure closef;
  var
    temp : integer;

  begin
    if f.fisnew then
    begin     { purge old file }
      temp:=dindex;
      if findfile(false,0) then purgef;
      dindex:=temp; readdir(dir^,dindex,dentry);
    end;
    if f.fmodified then
    with dentry do
    begin       { rewrite the directory entry }
      if (ftype=efttable^[datafile])
      or (ftype=uxtype) then extension := f.fleof
				   else extension := f.fstartaddress;
      temp:=(f.fleof+255) div 256;
      if temp<fsize then fsize:=temp;
      setdate(fdate);
      writedir(dir^,dindex,dentry); flushdir;
    end;
  end;

{****************************************************************************}
  procedure stretchf;
  var
    found, eod  : boolean;
    tempindex, filestart, dataspace, reqsize  : integer;

  begin {stretchf}
    tempindex := dindex;  found := false;   eod := false;
    filestart := dentry.fstart;
    reqsize := (f.fpos + 255) div 256;  { round requested size 25jan83}
    if reqsize>dentry.fsize then
    begin
      while (not found) and (not eod) do
      with dentry do
      begin
	tempindex := tempindex + 1;
	if tempindex>dlast then eod := true
	else
	begin
	  readdir(dir^,tempindex,dentry);
	  if ftype=-1 then eod := true
	  else
	  if ftype<>0 then
	  begin
	    found     := true;
	    dataspace := dentry.fstart - filestart;
	  end;
	end;
      end; { while with }
      if eod then
      begin     { dataspace is from begining of file to end of volume }
	found:=true;                                    {25jan83}
	dataspace := (volsize div 256) - filestart;     {25jan83}
      end;
      if found then
      if dataspace>=reqsize then                        {25jan83}
      begin   { will stretch }
	readdir(dir^,dindex,dentry);
	{ allow requested space + half of excess space  25jan83 }
	dentry.fsize := (reqsize + dataspace) div 2;    {25jan83}
	writedir(dir^,dindex,dentry);   flushdir;
	f.fpeof      := dentry.fsize * 256;
      end;    { will stretch }
    end;
  end;  { stretchf }

{****************************************************************************}
  procedure changefname(anyvar n:string255);
  var
    tempindex : integer;
    ok        : boolean;
  begin
    if f.fanonymous then badio(ibadrequest);
    opendir;    checkvolid;     checkftitle;
    { find the original (permanent file) }
    if not findfile(false,0) then badio(inofile);
    { change the name }
    tempindex := dindex;
    if (strlen(n)=0) or (strlen(n)>tidleng) then badio(ibadtitle);
    f.ftid := n;
    if findfile(false,0) then badio(idupfile)
    else
    begin
      readdir(dir^,tempindex,dentry);
      strtolifname(f.ftid,dentry.fname);
      writedir(dir^,tempindex,dentry); flushdir;
    end
  end;  { changefname }

{****************************************************************************}
  procedure dooverwritefile;
  begin
    opendir;  checkvolid;
    if f.fanonymous then badio(ibadrequest);
    checkftitle;
    f.fisnew := true;
    if findfile(false,0) then
    begin       { existing file }
      if not mediavalid then cleandir;
      openold;  f.fleof := 0;   { setup fib then reset logical eof }
      setdate(dentry.fdate);
      dentry.fdate[3] := 9; dentry.fdate[4] := 9; { now a temporary file }
      writedir(dir^,dindex,dentry);     anychange := true;
    end
    else
    begin       { new file }
      if not mediavalid then cleandir;
      opennew;
    end;
  end;  { dooverwritefile }

{****************************************************************************}
  procedure nowopen;
  begin
    opendir;
    if f.fvid<>volid then ioresult:=ord(ilostfile)
    else
    if not findfile(f.fisnew,f.feft) then ioresult:=ord(ilostfile);
    goodio;
  end;

{****************************************************************************}
{****************************************************************************}
  begin {lifdam}
    lockup;
    mediavalid := unitable^[unum].umediavalid;
    { tell TM to keep quiet about media changes for a while }
    unitable^[unum].umediavalid   := true;
    unitable^[unum].ureportchange := false;
    fibp(dir)^.funit := unum; fibp(dir)^.freadable := false;
    ioresult         := ord(inoerror);
    anychange        := false;
    try
      case request of
	openfile  : begin f.fisnew := false; openf; end;
	createfile: begin f.fisnew := true; openf; end;
	overwritefile : dooverwritefile;
	closefile : if f.fmodified then begin nowopen; closef; end;
	purgefile : begin nowopen; purgef; end;
	stretchit : begin nowopen; stretchf; end;
	changename: changefname(f.fwindow^);
	getvolumename:
	  begin
	    ok := lifvol; strtoany(unitable^[unum].uvid,f);
	  end;
	setvolumename:
	  if lifvol then
	  begin
	    strtopac(f,6,vol.volname,true);
	    with unitable^[unum] do
	    begin
	      call(tm,fibp(dir),writebytes,vol,sizeof(lvheader),0);
	      goodio;   anychange := true;
	    end;
	  end;
	purgename    : dopurgename;
	getvolumedate: getsdate(f);
	setvolumedate: setsdate(f);
	crunch       : crunchv;
	catalog      : docat(f.fwindow^);
	opendirectory: doopendirectory(f.fwindow^);
	closedirectory:begin end;
	makedirectory: domakedirectory(f.fwindow^);
	openunit,
	openvolume   : begin
			 cleanup;
			 unblockeddam(f,unum,request);
			 mediavalid := unitable^[unum].umediavalid;
		       end;
	setunitprefix: if strlen(f.ftitle)>0 then badio(ibadtitle);
	stripname    : begin
			 checkftitle; setstrlen(f.ftitle,0);
			 strtolifname(f.ftid,dentry.fname);
		       end;
	otherwise
	  ioresult := ord(ibadrequest);
      end;   { case request }
      if anychange then flushdir;
      cleanup;  { fix umediavalid and ureportchange }
    recover
    begin
      cleanup;  { fix umediavalid and ureportchange }
      if (escapecode<0) and (escapecode<>-10) then
	begin lockdown; escape(escapecode); end;
    end;
    lockdown;
  end;
  procedure installlifdam;
  begin
    if dir=nil then new(dir);
  end;
end;  { module }
  import lifmodule,loader;
begin { instlifdam}
  installlifdam;
  markuser;
end.{ rev 2.2x1 }
@


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


54.3
log
@
pws2rcs automatic delta on Wed Aug 21 12:27:56 MDT 1991
@
text
@@


54.2
log
@
pws2rcs automatic delta on Wed Aug 21 09:35:48 MDT 1991
@
text
@d1 1206
@


54.1
log
@Automatic bump of revision number for PWS version 3.24
@
text
@a0 1206
					      (*

 (c) Copyright Hewlett-Packard Company, 1982.
All rights are reserved.  Copying or other
reproduction of this program except for archival
purposes is prohibited without the prior
written consent of Hewlett-Packard Company.


	    RESTRICTED RIGHTS LEGEND

Use, duplication, or disclosure by the Government
is subject to restrictions as set forth in
paragraph (b) (3) (B) of the Rights in Technical
Data and Computer Software clause in
DAR 7-104.9(a).

HEWLETT-PACKARD COMPANY
Fort Collins, Colorado                         *)


$MODCAL$
$DEBUG OFF,  range off, ovflcheck off$
$ALLOW_PACKED ON $   { JWS 4/10/85 }

program instlifdam;
module lifmodule;
import sysglobals, sysdevs, misc, fs;
export
  procedure lifdam(anyvar f: fib; unum: unitnum; request: damrequesttype);
  procedure installlifdam;

implement
  const
    entrysize = 32;
    uxtype = -5813; { eft for uxfile }
  type
    vname   =packed array[1..6] of char;
    lifname = packed array[1..10] of char;
    bcd     = 0..15;
    word    = 0..65535;
    integer16 = -32768..32767;
    word15  = 0..32767;
    tdate   = packed array[1..12] of bcd;
    lvheader=packed record      {volume header sector 0}
	       discid   : word;
	       volname  : vname;
	       dstart   : integer;
	       dummy1   : integer16;
	       dummy2   : integer16;
	       dsize    : integer;
	       version  : integer16;
	       dummy3   : integer16;
	       tps      : integer;      {tracks/surface}
	       spm      : integer;      {surfaces/medium}
	       spt      : integer;      {sectors/track}
	       cdate    : tdate;        {volume create time}
	       filler   : packed array[21..123] of integer16;
	       sdate    : tdate;
	       dummy4   : integer16;
	     end;
  direntry = packed record
	       fname    : lifname;
	       ftype    : integer16;
	       fstart   : integer;
	       fsize    : integer;
	       fdate    : tdate;
	       lastvol  : boolean;
	       volnumber: word15;
	       extension: integer;
	     end;

  spacerec  = record
		sstart      : integer;
		ssize       : integer;
		here      : integer;
		hole      : integer;
	      end;
  catarray  = array[1..maxint] of catentry;
  dirfile   = file of direntry;
  var
    dir        : ^dirfile;

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

{****************************************************************************}
  procedure badio(result : iorsltwd);
  begin ioresult := ord(result); escape(0); end;

{****************************************************************************}
  procedure pactostr(anyvar pc: lifname; l:integer; var s:string);
  var i : integer;
  begin
    setstrlen(s,l); for i:=1 to l do s[i] := pc[i];      i := l;
    while (i>1) and (s[i]=' ') do i:=i-1; setstrlen(s,i);
  end;

{****************************************************************************}
  procedure strtopac(anyvar s:string255; l:integer;
		     anyvar pc:lifname;  sizechk:boolean);
  var i,k : integer;
  begin
    if sizechk then
      if (strlen(s)>l) or (strlen(s)=0) then badio(ibadtitle);
    k:=strlen(s);
    for i:=1 to l do if i>k then pc[i] := ' ' else pc[i] := s[i];
  end;

{****************************************************************************}
  procedure strtoany(var s:string; anyvar s2:string255);
  begin s2:=s; end;

{****************************************************************************}
  procedure setdate(var d:tdate);
  var
    doy:daterec;        tod:timerec;
  begin
    sysdate(doy);       systime(tod);
    with doy, tod do
    begin
      {LAF 880101 added "mod 10" to "div 10"}
      d[1]  := year div 10 mod 10;d[2]  := year mod 10;
      d[3]  := month div 10;  d[4]  := month mod 10;
      d[5]  := day div 10;    d[6]  := day mod 10;
      d[7]  := hour div 10;   d[8]  := hour mod 10;
      d[9]  := minute div 10; d[10] := minute mod 10;
      d[11] := (centisecond div 100) div 10;
      d[12] := (centisecond div 100) mod 10;
    end;
  end;

{****************************************************************************}
  procedure lifnametostr(anyvar ln :lifname ; var s:string);
  label 1;
  var
    sl  : integer;
    fk  : filekind;
    found : boolean;

  begin {lifname to str}
    pactostr(ln,10,s); sl := strlen(s);
    if sl=10 then
    begin
      if suffix(s)=datafile then
      begin     { rip underscores and try to add suffix }
	while (sl>=1) and (s[sl]='_') do sl := sl - 1;
	for fk:=untypedfile to lastfkind do
	begin
	  if strlen(suffixtable^[fk])>0 then
	    if suffixtable^[fk][1]=s[sl] then
	    begin       { found suffix }
	      { change last char to . then append suffix }
	      setstrlen(s,sl); s[sl] := '.';
	      s := s + suffixtable^[fk];  goto 1;
	    end;
	end;
      end;      { for }
    end;
  1:end;  {lifname to str}

{****************************************************************************}
  procedure strtolifname(var s:string; var ln:lifname);
  var
    sl, i       : integer;
    stemp,temp2 : fid;  {31jan83  temp2 for case insensitive suffix}
    fk          : filekind;

  begin {str to lifname}
    sl := strlen(s);
    fk := suffix(s);
    if fk=datafile then
    begin       { data files have no suffix }
      if sl>10 then badio(ibadtitle);
      strtopac(s,10,ln,false);
    end
    else
    begin       { remove the suffix }
      sl := strlen(s)-strlen(suffixtable^[fk]);
      if sl>10 then badio(ibadtitle);
      strtopac(s,10,ln,false);  { pack the name }
      { replace dot with first char of suffix (to preserve uniqueness)}
      ln[sl] := suffixtable^[fk][1];    sl := sl+1;
      for i:=sl to 10 do ln[i] := '_';  { pad with _ }
    end;
    lifnametostr(ln,stemp);     { decompress the name as a final check }
    if stemp<>s then
    begin                       {31jan83 case insensitive suffix testing}
      temp2 := s;               { copy s, then remove given suffix }
      setstrlen(temp2,strlen(temp2)-strlen(suffixtable^[fk]));
      temp2:= temp2 + suffixtable^[fk];         { add suffix from table }
      if stemp<>temp2 then badio(ibadtitle);    { check again }
    end;
  end; {str to lifname}

{****************************************************************************}
{****************************************************************************}
  procedure lifdam(anyvar f: fib; unum: unitnum; request: damrequesttype);
    var
       vol      : lvheader;
       volid    : vid;
       ok, mediavalid ,anychange: boolean;
       dindex, dlast, dend, vsize       : integer;
       dentry   : direntry;

  $iocheck off$
{****************************************************************************}
  function volsize:integer;
  begin
    if vsize=0 then vsize := ueovbytes(unum);
    volsize := vsize;
  end;

{****************************************************************************}
  procedure cleanup;
  begin
    if ioresult=ord(zmediumchanged) then mediavalid := false;
    unitable^[unum].umediavalid   := mediavalid;
    unitable^[unum].ureportchange := true;
  end;

{****************************************************************************}
  procedure checkftitle;
  begin
    if (strlen(f.ftitle)>tidleng) or (strlen(f.ftitle)=0) then badio(ibadtitle);
    f.ftid := f.ftitle;
  end;

{****************************************************************************}
  function vvname:boolean;
  var
    i : integer;
    b : boolean;
  begin
    vvname := true; b := true;
    for i := 1 to 6 do  {1feb83 allow all blank names}
    begin
      if b then b := vol.volname[i]>' ';
      if not b then     {1feb83 allow all blank names}
	if vol.volname[i]<>' ' then vvname := false;
    end
  end;

{****************************************************************************}
  function lifvol:boolean;
  var
    i : integer;        {31jan83 allow all blank volname}
  begin { read and validate the volume header }
    with fibp(dir)^, unitable^[unum] do
    begin
      fileid := 0; fpeof := maxint;   { initialize dir }
      if uisblkd then
      begin
	call(tm,fibp(dir),readbytes,vol,sizeof(lvheader),0);
	with vol do
	   ok := ((ioresult=ord(inoerror)) and (discid=32768) and
		 (dummy1=4096) and (dummy2=0) and (dummy3=0) and
		 { dstart=1 -> wsheader or LIF BOOT dir.  if byteoffset }
		 { = 0, then dstart=1 OK (LIF BOOT dir); otherwise, }
		 { dstart=1 means wsheader, which we do NOT recognize }
		 (((byteoffset = 0) and (dstart >= 1)) or (dstart > 1)) and
		 (dsize>0) and vvname);
      end
      else ok := false;
      ureportchange := true;    { now let TM report any mediachanges }
      umediavalid   := true;
      lifvol := ok;
      if ok then
      begin
	if vol.volname[1]=' ' then      {31jan83 allow all blank volname}
	begin
	  setstrlen(volid,6); for i:=1 to 6 do volid[i]:=' ';
	end
	else
	  pactostr(vol.volname,6,volid);
	if volid<>uvid then
	begin mediavalid := false; uvid := volid; end;
      end
      else setstrlen(uvid,0);
      if (not ok) and (ioresult=ord(inoerror)) then ioresult:=ord(inodirectory);
    end;
  end;  { lifvol }

  $iocheck on$
{****************************************************************************}
  procedure opendir;
  begin
    if lifvol then
    begin
      dlast:=vol.dsize * 8;             { # entries in directory }
      dend:=vol.dstart + vol.dsize;   { directory end sector + 1 }
      with fibp(dir)^ do
      begin   { initialize the fib ( fake OPEN )}
	fisnew:=false;
	freadable:=true;      fwriteable:=true;
	freadmode:=false;     fbufvalid:=false;
	feof:=false;          fmodified:=false;
	fileid:=vol.dstart*256;
	if vol.version>0 then vsize := vol.tps*vol.spm*vol.spt*256
			 else vsize := 0;
	fpeof:=vol.dsize*256;      { end of directory }
	fleof:=fpeof;
	fpos:=0;              am:=amtable^[datafile];
	freptcnt:=0;          flastpos:=-1;
	fbufchanged:=false;   fbuffered:=true;
      end;
      dindex:=1;   read(dir^,dentry);
      goodio;
    end
    else escape(0);
  end;  { opendir }

{****************************************************************************}
  procedure checkvolid;
  begin
    if f.fvid<>volid then badio(ilostunit);
  end;

{****************************************************************************}
  procedure flushdir;
  begin { june 83 fixed to account for ops which don't open the directory RDQ}
  if fibp(dir)^.freadable
	 { directory open so flush thru AM }
    then call(fibp(dir)^.am,fibp(dir),flush,ioresult,0,0)
	 { directory not open so flush thru TM }
    else call(unitable^[unum].tm,fibp(dir),flush,ioresult,0,0);
    anychange := false;
  end;

{****************************************************************************}
  procedure getsdate(anyvar svdate:daterec);
  begin
    if lifvol then
    with vol, svdate do
    begin
      if not ((sdate[5]=0) and (sdate[6]=0)) then
      begin
	{LAF 880101 conditionally add 100 to year; year range is 28..127}
	year:=sdate[1]*10+sdate[2]; if year<28 then year:=year+100;
	month:=sdate[3]*10+sdate[4];
	day:=sdate[5]*10+sdate[6];
      end;
    end;
  end;

{****************************************************************************}
  procedure setsdate(anyvar svdate:daterec);
  var
    i   : integer;
  begin
    if lifvol then
    with svdate, vol do
    begin
      {LAF 880101 added "mod 10" to "div 10"}
      sdate[1]:=year div 10 mod 10; sdate[2]:=year mod 10;
      sdate[3]:=month div 10; sdate[4]:=month mod 10;
      sdate[5]:=day div 10; sdate[6]:=day mod 10;
      for i:=7 to 12 do sdate[i]:=0;    {clear time of day}
      with unitable^[unum] do
      begin
	call(tm,fibp(dir),writebytes,vol,sizeof(lvheader),0);
	goodio;         anychange := true;
      end;
    end;
  end;  { setsdate }

{****************************************************************************}
  procedure cleandir;
  var
    k           : integer;
    tempd       : direntry;

  begin {cleandir}
    k:=1;       seek(dir^,k);
    repeat
      read(dir^,tempd);
      if tempd.ftype=-1 then k:=dlast
      else
      if tempd.ftype<>0 then
      begin
	if (tempd.fdate[3]=9) and (tempd.fdate[4]=9) then
	begin { temp file so purge it }
	  tempd.ftype:=0;
	  writedir(dir^,k,tempd);       anychange := true;
	end;
      end;
      k:=k+1;
    until k>dlast;
    mediavalid := true;
  end;  {clean dir}

{****************************************************************************}
  procedure crunchv; { assumed to be called from procedure lifdam only 24jan83}
  var
    frompos, topos, todindex    : integer;
    bsize, filesize, movesize   : integer;
    bufptr, heapmark            : windowp;
    changed                     : boolean;
    datafib                     : fibp;

  begin
    opendir; checkvolid;
    if strlen(f.ftitle)<>0 then badio(ibadtitle);
    cleandir;
    { allocate the buffer space }
    MARK(heapmark);
    try
      bsize:=(memavail-(1024*5));
      if bsize>=256 then
      begin       { buffer in sector multiples }
	bsize:=(bsize div 256) * 256;
	newwords(bufptr,bsize div 2);
	new(datafib);   { set up the data fib }
	with datafib^ do
	begin
	  funit:=fibp(dir)^.funit;
	  fileid:=0;
	  fpeof:=volsize;      fleof:=fpeof;
	end;
      end
      else escape(-2); { not enough room to run }
      { krunch it }
      dindex:=1;
      todindex:=0;       topos:=dend*256;        anychange:=false;
      repeat
	changed:=false;
	readdir(dir^,dindex,dentry);
	if dentry.ftype=-1 then dindex:=dlast
	else
	if dentry.ftype=efttable^[badfile] then
	begin   { bad sectors ; don't move this file }
	  todindex:=todindex+1;
	  if dindex<>todindex then changed:=true;       { move the entry }
	  topos:=(dentry.fstart+dentry.fsize)*256;      { move topos }
	end
	else
	if dentry.ftype=0 then anychange := true        { found purged entry }
	else
	begin { move the file ? }
	  todindex:=todindex+1;
	  if dindex<>todindex then changed:=true;       { move the entry}

	  frompos:=dentry.fstart*256;
	  if frompos<>topos then
	    begin { move the data }
	      filesize:=dentry.fsize*256;   { bytes to move}
	      dentry.fstart:=topos div 256; { set start}
	      changed:=true;
	      with unitable^[datafib^.funit] do
	      repeat
		if filesize>bsize then movesize:=bsize
				  else movesize:=filesize;
		call(tm,datafib,readbytes,bufptr^,movesize,frompos);
		frompos:=frompos+movesize; goodio;

		call(tm,datafib,writebytes,bufptr^,movesize,topos);
		topos:=topos+movesize; goodio;

		filesize:=filesize-movesize;
	      until filesize=0;
	    end  { move the data }
	  else topos:=topos+dentry.fsize*256;
	end;    { move the file ? }
	if changed then
	begin
	  writedir(dir^,todindex,dentry);       anychange := true;
	end;
	dindex:=dindex+1;
      until dindex>dlast;
      if anychange then
      begin     { put end of directory mark }
	if todindex<dlast then
	begin
	  dentry.ftype:=-1;
	  writedir(dir^,todindex+1,dentry);
	end;
      end;
      call(unitable^[datafib^.funit].tm,datafib,flush,ioresult,0,0);
      RELEASE(heapmark);
    recover
      begin
	RELEASE(heapmark);
	frompos := ioresult;  topos := escapecode;      { save state 24jan83}
	if anychange then flushdir;                { try to clean up 24jan83}
	ioresult := frompos;                     { restore the state 24jan83}
	escape(frompos);                                       {exit 24jan83}
      end;
  end;  {crunchv}

{****************************************************************************}
  procedure domakedirectory(anyvar cat:catentry);
  var
    i      : integer;
    actualsize : integer;
    secbuf : packed array[0..63] of integer;
  begin
    if strlen(f.ftitle)>0 then badio(ibadrequest);
    with vol, cat do
    begin
      if not lifvol then
      begin
	if (ioresult<>ord(inoerror)) and
	   (ioresult<>ord(inodirectory)) then escape(0);
	ioresult := ord(inoerror);
	{ clear header fields }
	discid := 32768;
	dummy1 := 4096;   dummy2 := 0;   dummy3 := 0;
	version := 0;
      end
      else checkvolid;
		{ directory size checks }
      dstart := 2;
      dsize  := (((cextra1*entrysize)+255) div 256);
      if dsize<=0 then dsize := 10;     { default directory size }
		{ size checks }
      actualsize := ueovbytes(unum);
      if (cpsize>actualsize) or (cpsize<1024) then badio(inoroom);
      if (dstart+dsize+1)*256>=cpsize then badio(inoroom);
		{ fill in the pieces }
      strtopac(cname,6,volname,true);   { volume name }
      if version>0 then
	if (tps*spm*spt*256)<>cpsize then version := 0;

      setdate(cdate);   { fill in create date }
      for i := 1 to 12 do sdate[i] := 0; { clear system date }

      if version=0 then
      begin     { create pseudo level 1 header }
	version := 1;
	tps := 1; spm := 1; spt := cpsize div 256;
	for i:=21 to 123 do filler[i]:=0;
      end;
      dummy4 := 0;      { clear 250 maint. word }
		{ write volume header }
      with unitable^[unum] do
      BEGIN
	call(tm,fibp(dir),writebytes,vol,sizeof(lvheader),0); goodio;
	for i:=0 to 63 do secbuf[i] := 0;
	call(tm,fibp(dir),writebytes,secbuf,256,256);        {clear sector 1}
      END;
		{ write end of directory }
      opendir;
      dentry.ftype := -1;
      writedir(dir^,1,dentry); flushdir;
    end;
  end;  {domakedirectory}

{****************************************************************************}
  procedure liftofkind(lt:integer16; var fk:filekind);
  begin
    fk:=untypedfile;
    while (fk<>lastfkind) and (efttable^[fk]<>lt) do fk:=succ(fk);
    if efttable^[fk]<>lt then fk:=DATAFILE;
  end;

{****************************************************************************}
  procedure cvtdatetime(var fdate:tdate; var date:daterec; var time:timerec);
  begin
    {LAF 880101 conditionally add 100 to year; year range is 28..127}
    date.year:=fdate[1]*10+fdate[2]; if date.year<28 then date.year:=date.year+100;
    date.month:=fdate[3]*10+fdate[4];
    date.day:=fdate[5]*10+fdate[6];
    {LAF 880101 changed default to 1Jan70 from 1Mar00}
    if (date.month=0) or (date.day=0) then
      begin date.year:=70; date.month:=1; date.day:=1; end;
    time.hour:=fdate[7]*10+fdate[8];
    time.minute:=fdate[9]*10+fdate[10];
    time.centisecond:=(fdate[11]*10+fdate[12])*100;
  end;

{****************************************************************************}
  procedure doopendirectory(anyvar cat:catentry);
  begin
    opendir;    checkvolid;
    with cat do
    begin      { volume info }
      cname:=volid;
      cstart:=(vol.dstart+vol.dsize)*256;      { start of data area }
      cblocksize:=256;            { No. of bytes in allocation unit }
      cpsize:=volsize;                { physical size of the volume }
      clsize:=cpsize-cstart;            {  data space on the medium }
      cextra1:=vol.dsize*8;              { number of possible files }
      cextra2:=-1;                         { unused space available }
      cvtdatetime(vol.sdate,clastdate,clasttime);     { system date }
      cvtdatetime(vol.cdate,ccreatedate,ccreatetime);{ date created }
      cinfo:='LIF level  '; cinfo[11]:=chr(vol.version+ord('0'));
    end;       { volume info }
  end;

{****************************************************************************}
  procedure docat(anyvar cat : catarray);
  var
    di, dstart, dnum    : integer;
    done        : boolean;

    procedure zerodatetime(var dr:daterec; var tr:timerec);
    begin
      {LAF 880101 changed default to 1Jan70 from 1Mar00}
      dr.year:=70; dr.month:=1; dr.day:=1;
      tr.hour:=0; tr.minute:=0; tr.centisecond:=0;
    end;

  begin {docat}
    opendir;    checkvolid;
    dstart:=f.fpos;    dnum:=f.fpeof;   f.fpeof:=0;
    di:=1;    seek(dir^,di);    done:=false;
    while (f.fpeof<dnum) and (not done) do
    begin      { get file info }
      read(dir^,dentry);
      if dentry.ftype=-1 then done:=true
      else
      { don't show temporary or purged files }
      if (dentry.ftype<>0) and
	 ((dentry.fdate[3]<>9) or (dentry.fdate[4]<>9)) then
      begin   { count this entry }
	if dstart<=0 then     { skip to start index }
	begin { report this entry }
	  f.fpeof := f.fpeof+1;
	  with dentry, cat[f.fpeof] do
	  begin
	    lifnametostr(fname,cname);
	    ceft    := ftype;   liftofkind(ceft,ckind);
	    cpsize  := fsize*256;
	    if (ftype=-5622) {workstation data}
	    or (ftype=uxtype)   {workstation ux}
		then clsize:=extension
	    else clsize := cpsize;
	    cstart     := fstart*256;
	    cblocksize := 256;
	    zerodatetime(ccreatedate,ccreatetime);
	    cvtdatetime(fdate,clastdate,clasttime);
	    cextra1 := extension;  cextra2 := volnumber;
	    if lastvol then cinfo:='' else cinfo := 'continued';
	  end { with }
	end   { report this entry }
	else dstart := dstart-1;
      end;    { count this entry }
      di:=di+1;
      if di>dlast then done := true;
    end;      { while }
  end;  {docat}

{****************************************************************************}
  function findfile(temporary:boolean; ftypecode:integer16):boolean;
  var
    found  : boolean;
    tempname    : lifname;

  begin {find file}
    if not f.fanonymous then strtolifname(f.ftid,tempname);
    found:=false;       dindex:=1;      seek(dir^,dindex);
    repeat
      read(dir^,dentry);
      with dentry do
      begin
	if ftype=-1 then dindex:=dlast
	else
	if ftype<>0 then
	begin   { check this entry }
	  if f.fanonymous then found:=(dentry.fstart*256 = f.fileid)
	  else
	  if (tempname=fname) then
	    if ((ftypecode=0) or (ftypecode=ftype)) then
	    begin
	      if temporary then found:=(fdate[3]=9) and (fdate[4]=9)
			   else found:=(fdate[3]<>9) or (fdate[4]<>9);
	    end;
	end;
      end;      { with }
      if not found then dindex:=dindex+1;
    until (dindex>dlast) or found;
    findfile:=found;
  end; {find file}

{****************************************************************************}
  procedure purgef;
  begin
    dentry.ftype := 0; writedir(dir^,dindex,dentry); flushdir;
  end;

{****************************************************************************}
  procedure dopurgename;
  begin
    opendir;    checkvolid;     checkftitle;
    if findfile(false,0) then purgef
			 else ioresult := ord(inofile);
  end;

  {****************************************************************************}
  procedure getspace(space:integer; var srec:spacerec);
  var
    fixed, done, opening          : boolean;
    lastused, lastopening         : integer;
    dataspace                     : integer;
    mostavail, nextavail          : spacerec;

    procedure shuffle;
    var
      tempentry             : direntry;
      increment, here, hole : integer;

    begin       { move directory entries to open a required space }
      here := mostavail.here;
      hole := mostavail.hole;
      if here<=hole then
      begin
	if hole<dlast then
	begin   { move logical eod if required }
	  readdir(dir^,hole,tempentry);
	  if tempentry.ftype=-1 then
	  begin
	    writedir(dir^,hole + 1,tempentry);
	    anychange := true;
	  end;
	end;
	increment := -1;
      end
      else
	increment := 1;
      while hole<>here do
      begin
	readdir(dir^,hole+increment,tempentry);
	writedir(dir^,hole,tempentry);      anychange := true;
	hole := hole + increment;
      end;
      tempentry.ftype:=0;
      writedir(dir^,here,tempentry); anychange := true;
    end;        { shuffle }

    procedure allocate(var srec : spacerec; eod : boolean);
    begin
      srec.ssize  := dataspace;
      srec.sstart := lastused + 1;
      if eod then
      begin { end of directory allocation }
	if opening then srec.here := lastopening
		   else srec.here := dindex;
	srec.hole := srec.here;
      end
      else
      begin { middle of directory allocation }
	if opening then srec.here := lastopening
	else
	  if lastopening>0 then srec.here := dindex-1
			   else srec.here := dindex;
	srec.hole := lastopening;
      end;
    end;        { allocate }

    procedure checkspace(eod : boolean);
    var
      temp      : integer;
      check2    : boolean;
    begin
      if fixed and (dataspace>=space) then
      begin     { fixed space check }
	if (mostavail.ssize=0) { no space yet } or
	   (dataspace=space) { exact fit } or
	   { this space is bigger than previous good fit }
	   (((dataspace-space)>(mostavail.ssize-space)) and
	   (mostavail.ssize<>space)) then allocate(mostavail,eod);
	if mostavail.hole>0 then done := true;
      end;      { fixed space check }

      if not fixed then
      begin     { biggest or 2nd biggest }
	check2 := true;
	if (dataspace>=mostavail.ssize) then
	begin   { check biggest space }
	  if (dataspace>mostavail.ssize) then
	  begin { new biggest space }
	    nextavail := mostavail;       { demote to second biggest }
	    allocate(mostavail,eod);
	    check2    := false;
	  end
	  else
	  if not eod then
	  begin { same size space }
	    if opening then temp := lastopening
	    else
	      if lastopening>0 then temp := dindex -1
			       else temp := dindex;
	    if (abs(temp-lastopening)<=abs(mostavail.here-mostavail.hole)) or
	       (lastopening=0) then
	    with mostavail do
	    begin       { this causes shorter shuffle }
	      ssize  := dataspace;
	      sstart := lastused + 1;
	      here   := temp;
	      hole   := lastopening;
	    end;
	  end;  { same size space }
	end;    { check biggest space }
	if check2 then
	  if (dataspace>=nextavail.ssize) and (space<0) then
	  begin   { check 2nd biggest space }
	    if dataspace>nextavail.ssize then allocate(nextavail,eod)
	    else
	    if not eod then
	    begin { same size space }
	      if opening then temp := lastopening
	      else
		if lastopening>0 then temp := dindex -1
				 else temp := dindex;
	      if (abs(temp-lastopening)<=abs(nextavail.here-nextavail.hole)) or
		 (lastopening=0) then
	      with nextavail do
	      begin       { this causes shorter shuffle }
		ssize  := dataspace;
		sstart := lastused + 1;
		here   := temp;
		hole   := lastopening;
	      end;
	    end;
	  end;    { same size space }
      end;      { biggest or 2nd biggest }
    end; {checkspace}

    procedure checkentry;
    begin       { checkentry }
      if dentry.ftype=-1 then
      begin   { logical end of directory }
	dataspace := (volsize div 256) - lastused - 1;
	if dataspace>0 then checkspace(true);{check space at end of directory}
	{ set lastopening so outer proc. won't think directory is full }
	if lastopening=0 then lastopening := dindex;
	if (mostavail.hole=0) and (mostavail.sstart>0) then
	  mostavail.hole := lastopening;
	if (nextavail.hole=0) and (nextavail.sstart>0) then
	  nextavail.hole := lastopening;
	done := true;   lastused := (volsize div 256) + 1;
      end
      else
      if dentry.ftype=0 then
      begin   { hole in the directory }
	if not opening then
	begin
	  opening     := true;
	  lastopening := dindex;
	  if mostavail.sstart>0 then
	  with mostavail do
	  begin    { adjust fixed/biggest space }
	    if hole=0 then hole := lastopening
	    else
	      if (abs(hole-here)>abs(lastopening-here)) then
	      begin     { hole changed direction from entry }
		here := here + 1;
		hole := lastopening;
	      end;
	    if fixed then done := true;
	  end; { with }

	  if (space<0) and (nextavail.sstart>0) then
	  with nextavail do
	  begin     { adjust second biggest space }
	    if hole=0 then hole := lastopening
	    else
	      if (abs(hole-here)>abs(lastopening-here)) then
	      begin     { hole changed direction from entry }
		here := here + 1;
		hole := lastopening;
	      end;
	  end;

	end;
      end       { hole in the directory }
      else
      begin   { have file entry }
	dataspace := dentry.fstart - lastused - 1;
	if dataspace>0 then checkspace(false);
	{ if no dataspace yet, move lastopening to end of series }
	if (mostavail.sstart=0) and opening then lastopening := dindex - 1;
	opening  := false;
	lastused := dentry.fstart + dentry.fsize - 1;
      end;
    end;  {checkentry}

  begin {getspace}
    dindex := 1;
    seek(dir^,dindex);
    if space>0 then begin fixed:=true; space:=(space+255) div 256; end
	       else fixed:=false;
    lastused := dend - 1 ;    lastopening     := 0;
    mostavail.sstart:= 0;     nextavail.sstart:= 0;
    mostavail.ssize := 0;     nextavail.ssize := 0;
    mostavail.hole  := 0;     nextavail.hole  := 0;
    mostavail.here  := 0;     nextavail.here  := 0;
    done        := false;     opening     := false;
    repeat
      read(dir^,dentry);
      checkentry;
      dindex := dindex + 1;
      if not done then done := dindex>dlast;
    until done;

    if lastopening=0 then badio(idirfull)
    else
    begin       { have at least one directory opening }
      if (mostavail.sstart=0) or not fixed then
      begin
	dataspace := (volsize div 256) - lastused - 1;
	if dataspace>0 then
	begin
	  dindex := dlast + 1; {insurance policy }
	  if (not fixed and (dataspace>mostavail.ssize)) or
	     ((space<0) and (dataspace>nextavail.ssize)) or
	     (fixed and (dataspace>=space)) then checkspace(false);
	end;
      end;
      if mostavail.sstart=0 then badio(inoroom);

      if fixed then mostavail.ssize := space
      else
      with mostavail do
      begin     { final decision for non fixed space }
	{ watch for [*] type allocation }
	{ biggest of (1/2 biggest or 2nd biggest) } { include any odd sector }
	if space<0 then ssize:=(ssize div 2) + (ssize mod 2);
	if nextavail.ssize>=ssize then mostavail:=nextavail;
      end;
      shuffle;  { allign dataspace and directory entry }
      srec := mostavail;
    end;
  end;  {getspace}

{****************************************************************************}
  procedure finishfib;
  begin
    f.fileid    := dentry.fstart*256;
    f.fpeof     := dentry.fsize*256;
    if f.fisnew  then f.fleof := 0
		 else f.fleof := f.fpeof;
    f.fmodified := f.fisnew;
    if not f.fbuffered then f.am := amtable^[UNTYPEDFILE]
    else
     if f.fistextvar then f.am := amtable^[f.fkind]
		     else f.am := amtable^[datafile];
  end;  {finishfib}

{****************************************************************************}
  procedure opennew;
  var
    space       : spacerec;
  begin
    getspace(f.fpos,space);
    dindex := space.here;
    { fill in the lif directory entry }
    {file name}
    if f.fanonymous then dentry.fname := 'anonymous '
      else strtolifname(f.ftid,dentry.fname);
    dentry.ftype     := f.feft;
    dentry.fstart    := space.sstart;
    dentry.fsize     := space.ssize;
    setdate(dentry.fdate);
    dentry.fdate[3]  := 9; dentry.fdate[4] := 9; { mark as temporary }
    dentry.lastvol   := true;
    dentry.volnumber := 1;
    dentry.extension := 0;
    writedir(dir^,dindex,dentry); {write it out} flushdir;
    { finish the file fib }
    finishfib;
  end;  {opennew}

{****************************************************************************}
  procedure openold;
  var fk:filekind;
  begin
    liftofkind(dentry.ftype,fk);  f.fkind:=fk;
    finishfib;
    with dentry do
    begin
      f.fstartaddress := 0;
      f.feft := ftype;
      if (ftype=efttable^[datafile])
      or (ftype=uxtype) then f.fleof := extension
				   else f.fstartaddress := extension;
    end;
  end;

{****************************************************************************}
  procedure openf;
  begin
    opendir; checkvolid;
    if not (f.fanonymous and f.fisnew) then  checkftitle;
    if f.fisnew then
    begin   { new temp file }
      if not mediavalid then cleandir;
      if f.fanonymous then opennew
      else
      if findfile(f.fisnew,0) then ioresult:=ord(idupfile)
			      else opennew;
    end
    else    { existing permanent file }
    begin
      if findfile(f.fisnew,0) then
      begin
	openold;
	if not mediavalid then cleandir;
      end
      else ioresult:=ord(inofile);
    end;
  end;  { openf }

{****************************************************************************}
  procedure closef;
  var
    temp : integer;

  begin
    if f.fisnew then
    begin     { purge old file }
      temp:=dindex;
      if findfile(false,0) then purgef;
      dindex:=temp; readdir(dir^,dindex,dentry);
    end;
    if f.fmodified then
    with dentry do
    begin       { rewrite the directory entry }
      if (ftype=efttable^[datafile])
      or (ftype=uxtype) then extension := f.fleof
				   else extension := f.fstartaddress;
      temp:=(f.fleof+255) div 256;
      if temp<fsize then fsize:=temp;
      setdate(fdate);
      writedir(dir^,dindex,dentry); flushdir;
    end;
  end;

{****************************************************************************}
  procedure stretchf;
  var
    found, eod  : boolean;
    tempindex, filestart, dataspace, reqsize  : integer;

  begin {stretchf}
    tempindex := dindex;  found := false;   eod := false;
    filestart := dentry.fstart;
    reqsize := (f.fpos + 255) div 256;  { round requested size 25jan83}
    if reqsize>dentry.fsize then
    begin
      while (not found) and (not eod) do
      with dentry do
      begin
	tempindex := tempindex + 1;
	if tempindex>dlast then eod := true
	else
	begin
	  readdir(dir^,tempindex,dentry);
	  if ftype=-1 then eod := true
	  else
	  if ftype<>0 then
	  begin
	    found     := true;
	    dataspace := dentry.fstart - filestart;
	  end;
	end;
      end; { while with }
      if eod then
      begin     { dataspace is from begining of file to end of volume }
	found:=true;                                    {25jan83}
	dataspace := (volsize div 256) - filestart;     {25jan83}
      end;
      if found then
      if dataspace>=reqsize then                        {25jan83}
      begin   { will stretch }
	readdir(dir^,dindex,dentry);
	{ allow requested space + half of excess space  25jan83 }
	dentry.fsize := (reqsize + dataspace) div 2;    {25jan83}
	writedir(dir^,dindex,dentry);   flushdir;
	f.fpeof      := dentry.fsize * 256;
      end;    { will stretch }
    end;
  end;  { stretchf }

{****************************************************************************}
  procedure changefname(anyvar n:string255);
  var
    tempindex : integer;
    ok        : boolean;
  begin
    if f.fanonymous then badio(ibadrequest);
    opendir;    checkvolid;     checkftitle;
    { find the original (permanent file) }
    if not findfile(false,0) then badio(inofile);
    { change the name }
    tempindex := dindex;
    if (strlen(n)=0) or (strlen(n)>tidleng) then badio(ibadtitle);
    f.ftid := n;
    if findfile(false,0) then badio(idupfile)
    else
    begin
      readdir(dir^,tempindex,dentry);
      strtolifname(f.ftid,dentry.fname);
      writedir(dir^,tempindex,dentry); flushdir;
    end
  end;  { changefname }

{****************************************************************************}
  procedure dooverwritefile;
  begin
    opendir;  checkvolid;
    if f.fanonymous then badio(ibadrequest);
    checkftitle;
    f.fisnew := true;
    if findfile(false,0) then
    begin       { existing file }
      if not mediavalid then cleandir;
      openold;  f.fleof := 0;   { setup fib then reset logical eof }
      setdate(dentry.fdate);
      dentry.fdate[3] := 9; dentry.fdate[4] := 9; { now a temporary file }
      writedir(dir^,dindex,dentry);     anychange := true;
    end
    else
    begin       { new file }
      if not mediavalid then cleandir;
      opennew;
    end;
  end;  { dooverwritefile }

{****************************************************************************}
  procedure nowopen;
  begin
    opendir;
    if f.fvid<>volid then ioresult:=ord(ilostfile)
    else
    if not findfile(f.fisnew,f.feft) then ioresult:=ord(ilostfile);
    goodio;
  end;

{****************************************************************************}
{****************************************************************************}
  begin {lifdam}
    lockup;
    mediavalid := unitable^[unum].umediavalid;
    { tell TM to keep quiet about media changes for a while }
    unitable^[unum].umediavalid   := true;
    unitable^[unum].ureportchange := false;
    fibp(dir)^.funit := unum; fibp(dir)^.freadable := false;
    ioresult         := ord(inoerror);
    anychange        := false;
    try
      case request of
	openfile  : begin f.fisnew := false; openf; end;
	createfile: begin f.fisnew := true; openf; end;
	overwritefile : dooverwritefile;
	closefile : if f.fmodified then begin nowopen; closef; end;
	purgefile : begin nowopen; purgef; end;
	stretchit : begin nowopen; stretchf; end;
	changename: changefname(f.fwindow^);
	getvolumename:
	  begin
	    ok := lifvol; strtoany(unitable^[unum].uvid,f);
	  end;
	setvolumename:
	  if lifvol then
	  begin
	    strtopac(f,6,vol.volname,true);
	    with unitable^[unum] do
	    begin
	      call(tm,fibp(dir),writebytes,vol,sizeof(lvheader),0);
	      goodio;   anychange := true;
	    end;
	  end;
	purgename    : dopurgename;
	getvolumedate: getsdate(f);
	setvolumedate: setsdate(f);
	crunch       : crunchv;
	catalog      : docat(f.fwindow^);
	opendirectory: doopendirectory(f.fwindow^);
	closedirectory:begin end;
	makedirectory: domakedirectory(f.fwindow^);
	openunit,
	openvolume   : begin
			 cleanup;
			 unblockeddam(f,unum,request);
			 mediavalid := unitable^[unum].umediavalid;
		       end;
	setunitprefix: if strlen(f.ftitle)>0 then badio(ibadtitle);
	stripname    : begin
			 checkftitle; setstrlen(f.ftitle,0);
			 strtolifname(f.ftid,dentry.fname);
		       end;
	otherwise
	  ioresult := ord(ibadrequest);
      end;   { case request }
      if anychange then flushdir;
      cleanup;  { fix umediavalid and ureportchange }
    recover
    begin
      cleanup;  { fix umediavalid and ureportchange }
      if (escapecode<0) and (escapecode<>-10) then
	begin lockdown; escape(escapecode); end;
    end;
    lockdown;
  end;
  procedure installlifdam;
  begin
    if dir=nil then new(dir);
  end;
end;  { module }
  import lifmodule,loader;
begin { instlifdam}
  installlifdam;
  markuser;
end.{ rev 2.2x1 }
@


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.3
log
@
Comment from auto synch of clock fix:
date: 88/03/02 17:21:53;  author: quist;  state: Exp;  lines added/del: 12/6
SYSDATE fixes, RDQ
@
text
@@


26.2
log
@
Comment from auto synch of clock fix:
date: 88/03/02 09:21:54;  author: bayes;  state: Exp;  lines added/del: 0/0
Automatic bump of revision number for PWS version 3.2Y
@
text
@d123 2
a124 1
      d[1]  := year div 10;   d[2]  := year mod 10;
d339 2
a340 1
	year:=sdate[1]*10+sdate[2];
d355 2
a356 1
      sdate[1]:=year div 10; sdate[2]:=year mod 10;
d560 2
a561 1
    date.year:=fdate[1]*10+fdate[2];
d564 1
d566 1
a566 1
      begin date.year:=0; date.month:=3; date.day:=1; end;
d599 2
a600 1
      dr.year:=0; dr.month:=3; dr.day:=1;
@


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


9.2
log
@Fix for FSDat00620 -- Allow dstart=1 only if byteoffset=0. This keeps
wsheader files from being recognized as LIF volumes.
@
text
@@


9.1
log
@Automatic bump of revision number for PWS version 3.2B
@
text
@d258 5
a262 1
		 (dstart>=1) and (dsize>0) and vvname);
@


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


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


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


5.2
log
@Allow LIF volumes with dirstart = 1 (0-based).  These are created
by OSINSTALL.
@
text
@@


5.1
log
@Automatic bump of revision number for PWS version 3.2j
@
text
@d258 1
a258 1
		 (dstart>1) and (dsize>0) and vvname);
@


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


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


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


1.3
log
@Refer to uxfile eft directly instead of through efttable; otherwise,
get wierd results when uxam not present.
@
text
@@


1.2
log
@Used to keep datafile leof in extension word of LIF dir;
now we do this for both datafile and uxfile.
@
text
@d36 1
d615 2
a616 2
	    if (ftype=efttable^[datafile]) {workstation data}
	    or (ftype=efttable^[uxfile])   {workstation ux}
d966 1
a966 1
      or (ftype=efttable^[uxfile]) then f.fleof := extension
d1011 1
a1011 1
      or (ftype=efttable^[uxfile]) then extension := f.fleof
@


1.1
log
@Initial revision
@
text
@d614 3
a616 1
	    if ftype=-5622 {workstation data} then clsize:=extension
d964 2
a965 1
      if ftype=efttable^[datafile] then f.fleof := extension
d1009 2
a1010 1
      if ftype=efttable^[datafile] then extension := f.fleof
@
