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


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

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

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

55.1
date     91.08.25.10.31.12;  author jwh;  state Exp;
branches ;
next     54.4;

54.4
date     91.08.21.10.37.53;  author jwh;  state Exp;
branches ;
next     54.3;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

37.1
date     89.05.12.11.49.06;  author dew;  state Exp;
branches ;
next     36.2;

36.2
date     89.05.09.10.53.32;  author quist;  state Exp;
branches ;
next     36.1;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

15.1
date     87.04.13.09.49.52;  author jws;  state Exp;
branches ;
next     14.2;

14.2
date     87.04.08.09.16.29;  author jws;  state Exp;
branches ;
next     14.1;

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

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

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

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

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

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

8.2
date     86.12.12.11.47.41;  author bayes;  state Exp;
branches ;
next     8.1;

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

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

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

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

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

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

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

2.1
date     86.07.30.15.09.01;  author hal;  state Exp;
branches ;
next     1.5;

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

1.4
date     86.07.28.16.04.20;  author geli;  state Exp;
branches ;
next     1.3;

1.3
date     86.07.14.11.10.40;  author geli;  state Exp;
branches ;
next     1.2;

1.2
date     86.07.09.09.52.11;  author geli;  state Exp;
branches ;
next     1.1;

1.1
date     86.06.30.16.44.42;  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
@module misc;    {homeless orphans}

import sysglobals, asm;

export

const

  null  = 0;    nullchar  = chr(0);
		homechar  = chr(1);
  etx   = 3;
  bell  = 7;    bellchar  = chr(7);
  bs    = 8;    leftchar  = chr(8);
  tab   = 9;    cteol     = chr(9);
  lf    = 10;   downchar  = chr(10);
  vt    = 11;   cteos     = chr(11);
  ff    = 12;   clearscr  = chr(12);
  cr    = 13;   eol       = chr(13);
  dle   = 16;
  esc   = 27;   escchar   = chr(27);
  fsp   = 28;   rightchar = chr(28);
  us    = 31;   upchar    = chr(31);
  del   = 127;
  cntrl = 255;

  { external file types }
  codefile_eft = -5582;
  datafile_eft = -5622;
  uxfile_eft   = -5813;
  sysfile_eft  = -5822;

type
(* CATALOGUE INFORMATION, zero entry refers to the directory itself *)

  catentry = record
    cname:  tid;                {name of file or directory}
    ceft:   shortint;           {external file type (LIF)}
    ckind:  filekind;           {file kind}
    cpsize: integer;            {physical size of file
					or of total data space on volume}
    clsize: integer;            {logical size of file
					or unused space on medium}
    cstart: integer;            {starting location of file
					or first possible data location}
    cblocksize: integer;        {size of a sector or block}
    ccreatedate, clastdate:  daterec;   {creation, last modified dates}
    ccreatetime, clasttime:  timerec;   {creation, last modified times}
    cextra1,                    {extension
					or total possible number of files
					or requested number of files}
    cextra2:   integer;         {secondary discretionary field
					or start index of requested catalog}
    cinfo:  string[20];         {comment or miscellaneous information}

    end;

    passentry = record
		 pbits: integer;
		 pword: passtype;
		 end;

type
(* SETPASSWORDS/CATPASSWORDS entries used with HFS*)
  h_catpasswd_ids = packed record
	  cat_uid: ushort;
	  cat_gid: ushort;
	  case integer of
	    0: (cat_mode: ushort);
	    1: (cat_umask: integer);
	  end;
  h_setpasswd_command = (hfs_login, hfs_umask,
			hfs_open,
			hfs_chmod, hfs_chown, hfs_chgrp,
			hfs_chatime, hfs_chmtime);
  h_setpasswd_entry = packed record
		command: h_setpasswd_command;
		new_value: integer;
		end;

  { Added for SRM-UX support 8/10/90 JWH }
  { removed 10/31/90 moved to SRM_TYPES }

  { srmux_array = array[1..50] of boolean; }

var
  idle: byte;              { idle character -- 3.0 bug jws 3/20/84 }
  lastfid : ^fid;          { storage of fid before zapspaces in FS fileopen }
			   {SRM-UX RPC support. RDQ }
  { moved to SRM_DRV 10/31/90 }
  { srmux_on : srmux_array; }  {SRM-UX support. JWH }

procedure getioerrmsg(var s :string; lastior : integer);
procedure printerror(errorcode, lastior: integer);
procedure upc(var s: string);
function ueovbytes(unit: unitnum): integer;
procedure unblockeddam(anyvar f: fib; unum: unitnum; request: damrequesttype);
procedure initfilekinds;
procedure lockup;
procedure lockdown;
{ Added for SRM-UX support 8/10/90 }
{ moved to SRM_DRV 10/31/90 }
{ function is_srmux_unit(unum : unitnum) : boolean; }
{ procedure init_srmux_array; }


implement

procedure lockup;
begin
  locklevel := locklevel + 1;
end;

procedure lockdown;
var saveio: integer;
    saveec: shortint;
begin
locklevel := locklevel - 1;
if locklevel = 0 then
  begin
  saveio := ioresult;
  saveec := sysescapecode;
  while actionspending > 0 do
    begin
    call(deferredaction[actionspending]);
    actionspending := actionspending - 1;
    end;
  ioresult := saveio;
  sysescapecode := saveec;
  end;
end;

procedure upc(var s: string);
var i: shortint;
    c: char;
begin
 for i := 1 to strlen(s) do
   begin
   c := s[i];           {this assignment saves two or three subscripts}
   if (c >= 'a') and (c <= 'z') then s[i] := chr(ord(c)+ (ord('A')-ord('a')));
   end;
end;

function ueovbytes(unit: unitnum): integer;
  label 1;
  var return_bytes: integer;
      saved_ioresult: integer;
      saved_reportbit: boolean;
      tracks: shortint;
      f: fib;

function try_tracks(number_of_tracks: shortint): boolean;
begin {try_tracks}
  f.fpeof  := number_of_tracks*(30*256)-unitable^[unit].byteoffset;
  f.funit := unit; f.fileid := 0;
  call (unitable^[unit].tm, addr(f), readbytes, f.fbuffer, 256, f.fpeof-512);
  if ioresult=0 then
    begin
      return_bytes := f.fpeof; { <<< desired side-effect! }
      try_tracks := true
    end {if}
  else
    try_tracks := false
end; {try_tracks}

begin {ueovbytes}
with unitable^[unit] do
 if not uisblkd then ueovbytes := maxint
 else if (letter<>'H') and (letter<>'F') then ueovbytes := umaxbytes
 else
    begin
    saved_reportbit := ureportchange;  ureportchange := false;
    saved_ioresult := ioresult;
    return_bytes := 0;             {in case none of the tries succeed!!!}
    if letter='H' then
      if try_tracks(150) then goto 1;         {DS disc init'ed by a 9895}
    for tracks := 61 to 67 do
      if not try_tracks(tracks) then goto 1;  {SS disc init'ed by a 9885}
    if not try_tracks(73) then {goto 1};      {SS disc init'ed by a 9895}
1:  ioresult := saved_ioresult;
    ureportchange := saved_reportbit;
    if return_bytes<=umaxbytes then ueovbytes := return_bytes
			       else ueovbytes := umaxbytes;
    end;
end; {ueovbytes}

procedure getioerrmsg(var s : string; lastior : integer);
var dummy: integer;
begin
  case lastior of
    ord(inoerror      ):  s := '(no I/O error reported)';
    ord(zbadblock     ):  s := 'block parity error';
    ord(ibadunit      ):  s := 'illegal unit number';
    ord(zbadmode      ):  s := 'illegal IO request';
    ord(ztimeout      ):  s := 'device timeout';
    ord(ilostunit     ):  s := 'volume has gone off-line';
    ord(ilostfile     ):  s := 'file lost in dir';
    ord(ibadtitle     ):  s := 'bad file name';
    ord(inoroom       ):  s := 'no room on vol';
    ord(inounit       ):  s := 'logical volume not found';
    ord(inofile       ):  s := 'file not found';
    ord(idupfile      ):  s := 'dup dir entry';
    ord(inotclosed    ):  s := 'file already open';
    ord(inotopen      ):  s := 'file not open';
    ord(ibadformat    ):  s := 'bad input format';
    ord(znosuchblk    ):  s := 'block number out of range';
    ord(znodevice     ):  s := 'device absent or unaccessible';
    ord(zinitfail     ):  s := 'medium formatting/sparing failed';
    ord(zprotected    ):  s := 'medium is write protected';
    ord(zstrangei     ):  s := 'unexpected interrupt';
    ord(zbadhardware  ):  s := 'hardware fault';
    ord(zcatchall     ):  s := 'unrecognized error state';
    ord(zbaddma       ):  s := 'DMA absent or unavailable';
    ord(inotvalidsize ):  s := 'file size not compatible with type';
    ord(inotreadable  ):  s := 'file not opened for reading';
    ord(inotwriteable ):  s := 'file not opened for writing';
    ord(inotdirect    ):  s := 'file not opened for direct access';
    ord(idirfull      ):  s := 'no room in directory';
    ord(istrovfl      ):  s := 'string subscript out of range';
    ord(ibadclose     ):  s := 'bad file close string parameter';
    ord(ieof          ):  s := 'tried to read or write past eof';
    ord(zuninitialized):  s := 'medium uninitialized';
    ord(znoblock      ):  s := 'block not found';
    ord(znotready     ):  s := 'device not ready or medium absent';
    ord(znomedium     ):  s := 'medium absent';
    ord(inodirectory  ):  s := 'no directory on volume';
    ord(ibadfiletype  ):  s := 'file type illegal or does not match';
    ord(ibadvalue     ):  s := 'parameter illegal or out of range';
    ord(icantstretch  ):  s := 'file cannot be extended';
    ord(ibadrequest   ):  s := 'undefined operation for unit/file';
    ord(inotlockable  ):  s := 'file not lockable';
    ord(ifilelocked   ):  s := 'file already locked';
    ord(ifileunlocked ):  s := 'file not locked';
    ord(idirnotempty  ):  s := 'directory not empty';
    ord(itoomanyopen  ):  s := 'too many files open on device';
    ord(inoaccess     ):  s := 'access to file not allowed';
    ord(ibadpass      ):  s := 'invalid password';
    ord(ifilenotdir   ):  s := 'file is not a directory';
    ord(inotondir     ):  s := 'operation not allowed on directory';
    ord(ineedtempdir  ):  s := 'cannot create /WORKSTATIONS/TEMP_FILES';
    ord(isrmcatchall  ):  s := 'unrecognized SRM or SRM/UX error';
    ord(zmediumchanged):  s := 'medium may have been changed';
    ord(icorrupt      ):  s := 'file system corrupt';
    ord(itoobig       ):  s := 'file or file system too big';
    ord(inopermission ):  s := 'no permission for requested action';
    ord(zdvrcachefull ):  s := 'driver cache full';
    ord(zdvrnoconfig  ):  s := 'driver configuration failed';
    ord(idontlink     ):  s := 'cannot link across mounted volumes';

    otherwise
      begin setstrlen(s,0);
	    strwrite(s, 1, dummy, 'ioresult was ', lastior:1);
      end;

  end (*IO ERRORS*) ;
end;

procedure printerror(errorcode,lastior: integer);
label 1;
var   s,st: string[80];
      excp_line['excp_line']: integer;
      excp_pc['excp_pc']: integer;
begin
  writeln(cteol,bellchar); write(cteol);

  if errorcode > 0 then
    writeln(output,'Abnormal termination.  Halt code ',errorcode:1)
  else
    begin
      case errorcode of
    0:  s := 'normal termination not caught by GO';
   -1:  s := 'abnormal termination not caught by GO';
   -2:  s := 'not enough memory';
   -3:  s := 'reference to NIL pointer';
   -4:  s := 'integer overflow';
   -5:  s := 'divide by zero';
   -6:  s := 'real math overflow';
   -7:  s := 'real math underflow';
   -8:  s := 'value range error';
   -9:  s := 'case value range error';

  -10:  getioerrmsg(s,lastior);           (* IORESULT <> 0 *)

  -11:  s := 'CPU word access to odd address';
  -12:  s := 'CPU bus error';
  -13:  s := 'illegal CPU instruction';
  -14:  s := 'CPU privilege violation';
  -15:  s := 'bad argument: SIN/COS';
  -16:  s := 'bad argument: LN';
  -17:  s := 'bad argument: SQRT';
  -18:  s := 'bad argument: real/BCD conversion';
  -19:  s := 'bad argument: BCD/real conversion';
  -20:  s := 'stopped by user';
  -21:  s := 'unassigned CPU trap';
(*-22:                              *************** call to debugger ********)
  -23:  goto 1;                            (******** give no message !! *****)
  -24:  s := 'macro parameter not 0..9 or A..Z';
  -25:  s := 'undefined macro parameter';
  -26:  s := 'I/O routine error';
  -27:  s := 'graphics routine error';
  -28:  s := 'ram parity error';
  -29:  s := 'misc floating pt hardware error';

otherwise
	s := 'undocumented error'
      end; (*CASE ERRORCODE*)
      writeln(output,
'-------------------------------------------------');
      writeln('error ',errorcode:1,': ',s,cteol); write(cteol);
      if excp_line >= 0 then write('line number:  ',excp_line:1, '   ');
      writeln('PC value:    ',excp_pc:1);
    end;
1: end (*PRINTERROR*) ;



(*DIRECTORY ACCESS METHOD FOR DIRECT UNIT OPEN,   ASSUMES NO DIRECTORY *)

procedure unblockeddam(anyvar f: fib; unum: unitnum; request: damrequesttype);
type vidptr = ^vid;
var buf: { shortint } packed array[0..1023] of char; { JWH 7/30/91 }
begin
ioresult := 0;
with f, unitable^[unum] do
 case request of
  stretchit,                    {can't do anything}
  purgefile, closefile:         {nothing to do};
				{changed stripname for version 2.2 on 4-May-83}
  stripname: begin              {move ftitle to ftid and set ftitle to null}
	       if strlen(ftitle) > tidleng then
		 begin
		   ioresult := ord(ibadtitle);
		   setstrlen(ftid,0);
		 end
	       else
		 ftid := ftitle;
	       setstrlen(ftitle,0);
	     end;
  getvolumename: vidptr(addr(f))^ := uvid;
  setvolumename: uvid := vidptr(addr(f))^;
  openunit,
  openvolume,
  createfile,
  openfile:  begin
	     fileid := 0;
	     ureportchange := false;
	     if request = openunit then fpeof := umaxbytes
	     else if not uisblkd then fpeof := maxint
	       else begin
		     FPEOF := MAXINT;   {CHANGED FOR 9122 4/11/84 SFB}
		     call(tm, addr(f), readbytes, buf, 2, 0); {TOUCH DISC}
		     {UNITABLE^[UNUM].UMAXBYTES WAS VALIDATED BY TM CALL -
		      IE DISC CONTROLLER SENT PRESENT MEDIA VALUE IF SMART
		      ENOUGH}
		     fpeof := ueovbytes(unum);  {MOVED 4/11/84 SFB}
		     {UEOVBYTES SET TO UMAXBYTES IF BLOCKED & NOT 9885/9895}
		    end;
	     ureportchange := true; umediavalid := true;
	     fleof := fpeof;
	     fisnew := false;
	     if        not uisblkd  then
		  if not fistextvar then am := tm
				    else am := serialtextamhook
	     else if not fbuffered  then am := amtable^[untypedfile]
	     else if not fistextvar then am := amtable^[datafile]
				    else am := amtable^[fkind];
	     end;

  otherwise ioresult := ord(ibadrequest);
 end;
end;

(*  ACCESS METHOD FOR UNBUFFERED TRANSFERS *)
{updates fpos, checks logical limits of file, calls "stretch" if necessary}

procedure unbuffedam(fp: fibp;  request: amrequesttype;
			  anyvar buffer: window; buffsize, position: integer);
label 1;
begin
with fp^, unitable^[funit] do
  case request of
   readbytes,writebytes:
    begin
    fpos := position + buffsize;
    if fpos > fleof then
      if (request=readbytes) then begin ioresult := ord(ieof); goto 1; end
      else
	begin
	if fpos > fpeof then
	  begin
	  call(dam, fp^, funit, stretchit);
	  if fpos > fpeof then begin ioresult := ord(ieof); goto 1; end
	  end;
	fleof := fpos; fmodified := true;
	end;
    call(tm, fp, request, buffer, buffsize, position);
    end;
   flush: call(tm, fp, request, buffer, buffsize, position);
   otherwise ioresult := ord(ibadrequest);
  end;
1:
end;


(*  ACCESS METHOD FOR SERIAL TEXT INPUT DEVICES *)
{converts a carriage return character to an 'end of line' indication}

procedure serialtextam(fp: fibp;  request: amrequesttype;
			  anyvar buffer: window; buffsize, position: integer);
var i: integer;
begin
with fp^, unitable^[funit] do
  begin
  call(tm, fp, request, buffer, buffsize, position);
  if ioresult = ord(inoerror) then
   if request = readbytes then
    begin
    feoln := buffer[buffsize-1] = eol;
    for i := 0 to buffsize - 1 do if buffer[i]=eol then buffer[i] := ' ';
    end;
  end;
end;

(* ACCESS METHOD FOR DATA FILES *)
{accomplishes general purpose buffering}

procedure standardam(fp: fibp;  request: amrequesttype;
			anyvar buffer: window; buffsize, position: integer);
label 1,2;
var lastblock, block, oldfleof, oldfpos,                {rdq}
    firstpos, firstbytes, middlebytes, endbytes, i: integer;
    c: char;
    {following vars added for 3.1 performance improvement--4/10/85--SFB}
    heaptop : anyptr;           {pointer used to return heapspace}
    mybuf   : windowp;          {pointer to middlebytes buffer on heap}
    endblock: integer;          {used as in 2.0 AM}
    startbytes : integer;       {tempcopy of firstbytes for buffered xfer}
    midbytes   : integer;       {tempcopy of middlebytes for buffered xfer}
    eolchar: char;              {variable eol char for UX and other files SFB}


  procedure flushbuffer;
  var bufsize: integer;
  begin with fp^ do
   if fbufchanged {block buffer has been written} then
    begin
    bufsize := fleof - flastpos;
    if bufsize > fblksize then bufsize := fblksize;
    call (unitable^[funit].tm, fp, writebytes, fbuffer, bufsize, flastpos);
    if ioresult <> ord(inoerror) then goto 1;
    fbufchanged := false;
    end;
  end;

  procedure fetchbuffer;
  var i, bufsize: integer;
  begin if block<>lastblock then with fp^ do
   begin
   flushbuffer;
   lastblock := block;  flastpos := lastblock*fblksize;
   bufsize := oldfleof - flastpos;
   if bufsize <= 0 then bufsize := 0 else
      begin
      if bufsize > fblksize then bufsize := fblksize;
      call (unitable^[funit].tm, fp, readbytes, fbuffer, bufsize, flastpos);
      if ioresult <> ord(inoerror) then goto 1;
      end;
   for i := bufsize to fblksize-1 do fbuffer[i] := chr(0);
   end;
  end;

begin with fp^ do
 begin
 ioresult := ord(inoerror);
 if feft=uxfile_eft then       { Set eolchar properly -- SFB }
   eolchar:=chr(lf)            { EOL set to \n for HPUX text files}
 else
   eolchar:=chr(cr);           { Normal eol for data file}
 oldfleof := fleof; oldfpos := fpos;                    {rdq}
 case request of
  flush: begin
	 flushbuffer;
	 call(unitable^[funit].tm, fp, flush, fp^, 0, 0);
	 end;
  writeeol: begin
	    c := eolchar;
	    standardam(fp, writebytes, c, 1, position);
	    end;
  readtoeol:
    begin
    middlebytes := 0;
    fpos := position;
    if buffsize > fleof - position then buffsize := fleof - position;
    lastblock := (flastpos - flastpos mod fblksize) div fblksize;
    while buffsize > 0 do
      begin
      block := fpos div fblksize;
      fetchbuffer;
      firstpos := fpos - flastpos;
      firstbytes := fblksize - firstpos;
      if firstbytes > buffsize then firstbytes := buffsize;
      for i := 0 to firstbytes-1 do
	if fbuffer[firstpos+i]=eolchar then
	  begin firstbytes := i; buffsize := i; goto 2; end;
      2: moveleft(fbuffer[firstpos], buffer[1+middlebytes], firstbytes);
      middlebytes := middlebytes + firstbytes;
      fpos := fpos + firstbytes;
      buffsize := buffsize - firstbytes;
      end;
    buffer[0] := chr(middlebytes);
    if middlebytes>0 then fp^.feoln := false;
    end;
  readbytes,writebytes:
   begin
   fpos := position + buffsize;
   if fpos > fleof then
    if (request = readbytes) then
      begin {feoln := true;} ioresult := ord(ieof); fpos:=oldfpos; goto 1; end
    else begin
	 if fpos > fpeof then
	     begin
	     call(unitable^[funit].dam, fp^, funit, stretchit);
	     if fpos > fpeof then begin ioresult := ord(ieof); fpos := oldfpos;
					goto 1;
				  end;
	     end;
	 fleof := fpos; fmodified := true;
	 end;

   if flastpos < 0 then lastblock := -1
   else lastblock := flastpos div fblksize;
   block     := position div fblksize;
   if (buffsize=1) and (block=lastblock)   {the most common case!}   then
     if request = readbytes then buffer[0] := fbuffer[position mod fblksize]
     else begin
	  fbuffer[position mod fblksize] := buffer[0];
	  fbufchanged := true;
	  end
   else
     begin
     firstpos := (-position) mod fblksize;
     if firstpos >= buffsize then
	  begin firstbytes := buffsize; endbytes := 0; end
     else begin firstbytes := firstpos; endbytes :=fpos mod fblksize; end;
     middlebytes := buffsize - firstbytes - endbytes;

     if firstbytes > 0 then
       begin
       fetchbuffer;
       if request=readbytes
	 then moveleft(fbuffer[fblksize-firstpos], buffer, firstbytes)
       else
	 begin
	 moveleft(buffer, fbuffer[fblksize-firstpos], firstbytes);
	 fbufchanged := true;
	 end;
       block := block + 1;
       end;

{ code removed in 3.1 and replaced by following for performance reasons}
{ 4/13/85--SFB/LAF}

if middlebytes > 0 then  {performance enhancement for 3.1--SFB/LAF 5/13/85}
 begin
  endblock := block + middlebytes div fblksize; {prepare to set block at end}
  if odd(ord(addr(buffer[firstbytes]))) then    {odd start for middlebytes}
    if (memavail - 5*1024) >= middlebytes then  {room on heap for middlebytes}
     begin        {use tm to ship out data--similar to but different than 2.0}
      mark(heaptop);
      lockup;           {protect against STOP key during RECOVER execution}
      try                                 {protect the state of the heap}
       newwords(mybuf, middlebytes div 2);      {and get word-aligned space}
       if request = writebytes then
	moveleft(buffer[firstbytes], mybuf^, middlebytes); {copy data to heap}
       if (block <= lastblock) and (lastblock < endblock) then  {as in 2.0}
	begin flushbuffer; lastblock := -1; end;
       call(unitable^[funit].tm, fp, request,   {transfer middlebytes}
	    mybuf^, middlebytes, block*fblksize);
       if request = readbytes then              {whether tm failed or not!}
	moveleft(mybuf^, buffer[firstbytes], middlebytes);{copy data to buffer}
       release(heaptop);                        {and return heap}
      recover
       begin
	release(heaptop);                       {return heap in any case}
	if escapecode <> -10 then               {some non-IO escape but}
	 ioresult := ord(zcatchall);            {don't know what went wrong}
       end;       {recover}
      lockdown;                         {let STOP key through if it wants}
      if ioresult <> ord(inoerror) then {test ioresult after tm call,}
       goto 1;                          {just as in fetch/flushbuffer,
		     except we moved data to user buffer for read whether tm
		     failed or not (to simulate 2.1/3.0 post-fail condition,
		     or direct move-to-user-buffer post-fail condition)}
     end
    else                                        {no room on heap}
     begin
      startbytes := firstbytes; {copy to startbytes and midbytes so at finish}
      midbytes   := middlebytes;{firstbytes and middlebytes won't have changed}
      while midbytes > 0 do     {use 2.1/3.0-like method to ship out data}
       begin                    {"buffered xfer"}
	if request = readbytes then
	 begin
	  fetchbuffer;
	  moveleft(fbuffer, buffer[startbytes], fblksize);
	 end
	else
	 begin
	  flushbuffer;
	  lastblock := block;
	  flastpos := lastblock*fblksize;
	  moveleft(buffer[startbytes], fbuffer, fblksize);
	  fbufchanged := true;
	 end;
	midbytes    := midbytes - fblksize;
	startbytes  := startbytes + fblksize;
	block       := block + 1; {this gets set to endblock when done}
       end
     end
  else                    {middlebytes starts on even RAM address}
   begin                  {so call tm directly--as in 2.0 AM--see 2.0 code}
    if (block <= lastblock) and (lastblock < endblock) then
     begin flushbuffer; lastblock := -1; end;
    call(unitable^[funit].tm, fp, request, buffer[firstbytes], middlebytes,
	 block*fblksize);
    if ioresult <> ord(inoerror) then   {test ioresult right after tm call,}
     goto 1;                            {just as in fetch/flushbuffer}
   end;
  block := endblock;    {set block no matter which branch we took}
 end;

if endbytes > 0 then
       begin
       fetchbuffer;
       if request=readbytes

	 {following 2 movelefts modified (+middlebytes) to be workable with
	  2.0-type direct tm calls--firstbytes is no longer changed during
	  middlebytes transfer, as it was in 2.1/3.0 am--SFB 5/10/85}

	 then moveleft(fbuffer, buffer[firstbytes+middlebytes], endbytes)
	 else begin
	      moveleft(buffer[firstbytes+middlebytes], fbuffer, endbytes);
	      fbufchanged := true;
	      end;
       end;
     end;
   if fistextvar then if request = readbytes then
    for i := 0 to buffsize-1 do
     if buffer[i] = eolchar then begin feoln := true; buffer[i] := ' '; end
     else feoln := false;
   end;
  otherwise ioresult := ord(ibadrequest);
 end;
end;
1:
end;


procedure initfilekinds;
var fk: filekind;
begin
 serialtextamhook := serialtextam;

 {new(efttable);                                ALREADY DONE IN BOOT LOADER}
 new(amtable);
 new(suffixtable);

 for fk := untypedfile to lastfkind do
  begin
  suffixtable^[fk]              := '';          {no suffix   }
  amtable^[fk]                  := unbuffedam;  {no buffering}
  efttable^[fk]                 := 0;           {unassociated LIF file type}
  end;

  efttable^   [untypedfile]     := 3;           {LIF directory}
						{no suffix}
						{no buffering}

  suffixtable^[badfile]         := 'BAD';       {bad block indication}
  efttable^   [badfile]         := 2;           {LIF bad block marker}
						{no buffering}

  efttable^   [datafile]        := datafile_eft;{DCD Pascal data file}
						{no suffix}
  amtable^    [datafile]        := standardam;  {general purpose buffering}

  suffixtable^[codefile]        := 'CODE';      {code file suffix}
  efttable^   [codefile]        := codefile_eft;{DCD Pascal code file}
						{no buffering}

  suffixtable^[sysfile]         := 'SYSTM';     {suffix for system file}
  efttable^   [sysfile]         := sysfile_eft; {DCD system (boot) file}
						{no buffering}

  suffixtable^[uxfile]          := 'UX';        {suffix for HP-UX data file}
  efttable^   [uxfile]          := uxfile_eft;  {All HP-UX regular files}
  amtable^    [uxfile]          := standardam;  {Upgraded for HPUX text files}
						{UXTEXT_AM may overwrite this}
end;

{ Added for SRM-UX support JWH 8/10/90 : }
{ moved to SRM_DRV 10/31/90 }

{ function is_srmux_unit(unum : unitnum) : boolean;
begin
  is_srmux_unit := srmux_on[unum];
end;

procedure init_srmux_array;
var i : integer;
begin
 for i := 1 to 50 do
   srmux_on[i] := false;
end; }


end  {miscellaneous stuff module}
@


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


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 716
module misc;    {homeless orphans}

import sysglobals, asm;

export

const

  null  = 0;    nullchar  = chr(0);
		homechar  = chr(1);
  etx   = 3;
  bell  = 7;    bellchar  = chr(7);
  bs    = 8;    leftchar  = chr(8);
  tab   = 9;    cteol     = chr(9);
  lf    = 10;   downchar  = chr(10);
  vt    = 11;   cteos     = chr(11);
  ff    = 12;   clearscr  = chr(12);
  cr    = 13;   eol       = chr(13);
  dle   = 16;
  esc   = 27;   escchar   = chr(27);
  fsp   = 28;   rightchar = chr(28);
  us    = 31;   upchar    = chr(31);
  del   = 127;
  cntrl = 255;

  { external file types }
  codefile_eft = -5582;
  datafile_eft = -5622;
  uxfile_eft   = -5813;
  sysfile_eft  = -5822;

type
(* CATALOGUE INFORMATION, zero entry refers to the directory itself *)

  catentry = record
    cname:  tid;                {name of file or directory}
    ceft:   shortint;           {external file type (LIF)}
    ckind:  filekind;           {file kind}
    cpsize: integer;            {physical size of file
					or of total data space on volume}
    clsize: integer;            {logical size of file
					or unused space on medium}
    cstart: integer;            {starting location of file
					or first possible data location}
    cblocksize: integer;        {size of a sector or block}
    ccreatedate, clastdate:  daterec;   {creation, last modified dates}
    ccreatetime, clasttime:  timerec;   {creation, last modified times}
    cextra1,                    {extension
					or total possible number of files
					or requested number of files}
    cextra2:   integer;         {secondary discretionary field
					or start index of requested catalog}
    cinfo:  string[20];         {comment or miscellaneous information}

    end;

    passentry = record
		 pbits: integer;
		 pword: passtype;
		 end;

type
(* SETPASSWORDS/CATPASSWORDS entries used with HFS*)
  h_catpasswd_ids = packed record
	  cat_uid: ushort;
	  cat_gid: ushort;
	  case integer of
	    0: (cat_mode: ushort);
	    1: (cat_umask: integer);
	  end;
  h_setpasswd_command = (hfs_login, hfs_umask,
			hfs_open,
			hfs_chmod, hfs_chown, hfs_chgrp,
			hfs_chatime, hfs_chmtime);
  h_setpasswd_entry = packed record
		command: h_setpasswd_command;
		new_value: integer;
		end;

  { Added for SRM-UX support 8/10/90 JWH }
  { removed 10/31/90 moved to SRM_TYPES }

  { srmux_array = array[1..50] of boolean; }

var
  idle: byte;              { idle character -- 3.0 bug jws 3/20/84 }
  lastfid : ^fid;          { storage of fid before zapspaces in FS fileopen }
			   {SRM-UX RPC support. RDQ }
  { moved to SRM_DRV 10/31/90 }
  { srmux_on : srmux_array; }  {SRM-UX support. JWH }

procedure getioerrmsg(var s :string; lastior : integer);
procedure printerror(errorcode, lastior: integer);
procedure upc(var s: string);
function ueovbytes(unit: unitnum): integer;
procedure unblockeddam(anyvar f: fib; unum: unitnum; request: damrequesttype);
procedure initfilekinds;
procedure lockup;
procedure lockdown;
{ Added for SRM-UX support 8/10/90 }
{ moved to SRM_DRV 10/31/90 }
{ function is_srmux_unit(unum : unitnum) : boolean; }
{ procedure init_srmux_array; }


implement

procedure lockup;
begin
  locklevel := locklevel + 1;
end;

procedure lockdown;
var saveio: integer;
    saveec: shortint;
begin
locklevel := locklevel - 1;
if locklevel = 0 then
  begin
  saveio := ioresult;
  saveec := sysescapecode;
  while actionspending > 0 do
    begin
    call(deferredaction[actionspending]);
    actionspending := actionspending - 1;
    end;
  ioresult := saveio;
  sysescapecode := saveec;
  end;
end;

procedure upc(var s: string);
var i: shortint;
    c: char;
begin
 for i := 1 to strlen(s) do
   begin
   c := s[i];           {this assignment saves two or three subscripts}
   if (c >= 'a') and (c <= 'z') then s[i] := chr(ord(c)+ (ord('A')-ord('a')));
   end;
end;

function ueovbytes(unit: unitnum): integer;
  label 1;
  var return_bytes: integer;
      saved_ioresult: integer;
      saved_reportbit: boolean;
      tracks: shortint;
      f: fib;

function try_tracks(number_of_tracks: shortint): boolean;
begin {try_tracks}
  f.fpeof  := number_of_tracks*(30*256)-unitable^[unit].byteoffset;
  f.funit := unit; f.fileid := 0;
  call (unitable^[unit].tm, addr(f), readbytes, f.fbuffer, 256, f.fpeof-512);
  if ioresult=0 then
    begin
      return_bytes := f.fpeof; { <<< desired side-effect! }
      try_tracks := true
    end {if}
  else
    try_tracks := false
end; {try_tracks}

begin {ueovbytes}
with unitable^[unit] do
 if not uisblkd then ueovbytes := maxint
 else if (letter<>'H') and (letter<>'F') then ueovbytes := umaxbytes
 else
    begin
    saved_reportbit := ureportchange;  ureportchange := false;
    saved_ioresult := ioresult;
    return_bytes := 0;             {in case none of the tries succeed!!!}
    if letter='H' then
      if try_tracks(150) then goto 1;         {DS disc init'ed by a 9895}
    for tracks := 61 to 67 do
      if not try_tracks(tracks) then goto 1;  {SS disc init'ed by a 9885}
    if not try_tracks(73) then {goto 1};      {SS disc init'ed by a 9895}
1:  ioresult := saved_ioresult;
    ureportchange := saved_reportbit;
    if return_bytes<=umaxbytes then ueovbytes := return_bytes
			       else ueovbytes := umaxbytes;
    end;
end; {ueovbytes}

procedure getioerrmsg(var s : string; lastior : integer);
var dummy: integer;
begin
  case lastior of
    ord(inoerror      ):  s := '(no I/O error reported)';
    ord(zbadblock     ):  s := 'block parity error';
    ord(ibadunit      ):  s := 'illegal unit number';
    ord(zbadmode      ):  s := 'illegal IO request';
    ord(ztimeout      ):  s := 'device timeout';
    ord(ilostunit     ):  s := 'volume has gone off-line';
    ord(ilostfile     ):  s := 'file lost in dir';
    ord(ibadtitle     ):  s := 'bad file name';
    ord(inoroom       ):  s := 'no room on vol';
    ord(inounit       ):  s := 'logical volume not found';
    ord(inofile       ):  s := 'file not found';
    ord(idupfile      ):  s := 'dup dir entry';
    ord(inotclosed    ):  s := 'file already open';
    ord(inotopen      ):  s := 'file not open';
    ord(ibadformat    ):  s := 'bad input format';
    ord(znosuchblk    ):  s := 'block number out of range';
    ord(znodevice     ):  s := 'device absent or unaccessible';
    ord(zinitfail     ):  s := 'medium formatting/sparing failed';
    ord(zprotected    ):  s := 'medium is write protected';
    ord(zstrangei     ):  s := 'unexpected interrupt';
    ord(zbadhardware  ):  s := 'hardware fault';
    ord(zcatchall     ):  s := 'unrecognized error state';
    ord(zbaddma       ):  s := 'DMA absent or unavailable';
    ord(inotvalidsize ):  s := 'file size not compatible with type';
    ord(inotreadable  ):  s := 'file not opened for reading';
    ord(inotwriteable ):  s := 'file not opened for writing';
    ord(inotdirect    ):  s := 'file not opened for direct access';
    ord(idirfull      ):  s := 'no room in directory';
    ord(istrovfl      ):  s := 'string subscript out of range';
    ord(ibadclose     ):  s := 'bad file close string parameter';
    ord(ieof          ):  s := 'tried to read or write past eof';
    ord(zuninitialized):  s := 'medium uninitialized';
    ord(znoblock      ):  s := 'block not found';
    ord(znotready     ):  s := 'device not ready or medium absent';
    ord(znomedium     ):  s := 'medium absent';
    ord(inodirectory  ):  s := 'no directory on volume';
    ord(ibadfiletype  ):  s := 'file type illegal or does not match';
    ord(ibadvalue     ):  s := 'parameter illegal or out of range';
    ord(icantstretch  ):  s := 'file cannot be extended';
    ord(ibadrequest   ):  s := 'undefined operation for unit/file';
    ord(inotlockable  ):  s := 'file not lockable';
    ord(ifilelocked   ):  s := 'file already locked';
    ord(ifileunlocked ):  s := 'file not locked';
    ord(idirnotempty  ):  s := 'directory not empty';
    ord(itoomanyopen  ):  s := 'too many files open on device';
    ord(inoaccess     ):  s := 'access to file not allowed';
    ord(ibadpass      ):  s := 'invalid password';
    ord(ifilenotdir   ):  s := 'file is not a directory';
    ord(inotondir     ):  s := 'operation not allowed on directory';
    ord(ineedtempdir  ):  s := 'cannot create /WORKSTATIONS/TEMP_FILES';
    ord(isrmcatchall  ):  s := 'unrecognized SRM or SRM/UX error';
    ord(zmediumchanged):  s := 'medium may have been changed';
    ord(icorrupt      ):  s := 'file system corrupt';
    ord(itoobig       ):  s := 'file or file system too big';
    ord(inopermission ):  s := 'no permission for requested action';
    ord(zdvrcachefull ):  s := 'driver cache full';
    ord(zdvrnoconfig  ):  s := 'driver configuration failed';
    ord(idontlink     ):  s := 'cannot link across mounted volumes';

    otherwise
      begin setstrlen(s,0);
	    strwrite(s, 1, dummy, 'ioresult was ', lastior:1);
      end;

  end (*IO ERRORS*) ;
end;

procedure printerror(errorcode,lastior: integer);
label 1;
var   s,st: string[80];
      excp_line['excp_line']: integer;
      excp_pc['excp_pc']: integer;
begin
  writeln(cteol,bellchar); write(cteol);

  if errorcode > 0 then
    writeln(output,'Abnormal termination.  Halt code ',errorcode:1)
  else
    begin
      case errorcode of
    0:  s := 'normal termination not caught by GO';
   -1:  s := 'abnormal termination not caught by GO';
   -2:  s := 'not enough memory';
   -3:  s := 'reference to NIL pointer';
   -4:  s := 'integer overflow';
   -5:  s := 'divide by zero';
   -6:  s := 'real math overflow';
   -7:  s := 'real math underflow';
   -8:  s := 'value range error';
   -9:  s := 'case value range error';

  -10:  getioerrmsg(s,lastior);           (* IORESULT <> 0 *)

  -11:  s := 'CPU word access to odd address';
  -12:  s := 'CPU bus error';
  -13:  s := 'illegal CPU instruction';
  -14:  s := 'CPU privilege violation';
  -15:  s := 'bad argument: SIN/COS';
  -16:  s := 'bad argument: LN';
  -17:  s := 'bad argument: SQRT';
  -18:  s := 'bad argument: real/BCD conversion';
  -19:  s := 'bad argument: BCD/real conversion';
  -20:  s := 'stopped by user';
  -21:  s := 'unassigned CPU trap';
(*-22:                              *************** call to debugger ********)
  -23:  goto 1;                            (******** give no message !! *****)
  -24:  s := 'macro parameter not 0..9 or A..Z';
  -25:  s := 'undefined macro parameter';
  -26:  s := 'I/O routine error';
  -27:  s := 'graphics routine error';
  -28:  s := 'ram parity error';
  -29:  s := 'misc floating pt hardware error';

otherwise
	s := 'undocumented error'
      end; (*CASE ERRORCODE*)
      writeln(output,
'-------------------------------------------------');
      writeln('error ',errorcode:1,': ',s,cteol); write(cteol);
      if excp_line >= 0 then write('line number:  ',excp_line:1, '   ');
      writeln('PC value:    ',excp_pc:1);
    end;
1: end (*PRINTERROR*) ;



(*DIRECTORY ACCESS METHOD FOR DIRECT UNIT OPEN,   ASSUMES NO DIRECTORY *)

procedure unblockeddam(anyvar f: fib; unum: unitnum; request: damrequesttype);
type vidptr = ^vid;
var buf: { shortint } packed array[0..1023] of char; { JWH 7/30/91 }
begin
ioresult := 0;
with f, unitable^[unum] do
 case request of
  stretchit,                    {can't do anything}
  purgefile, closefile:         {nothing to do};
				{changed stripname for version 2.2 on 4-May-83}
  stripname: begin              {move ftitle to ftid and set ftitle to null}
	       if strlen(ftitle) > tidleng then
		 begin
		   ioresult := ord(ibadtitle);
		   setstrlen(ftid,0);
		 end
	       else
		 ftid := ftitle;
	       setstrlen(ftitle,0);
	     end;
  getvolumename: vidptr(addr(f))^ := uvid;
  setvolumename: uvid := vidptr(addr(f))^;
  openunit,
  openvolume,
  createfile,
  openfile:  begin
	     fileid := 0;
	     ureportchange := false;
	     if request = openunit then fpeof := umaxbytes
	     else if not uisblkd then fpeof := maxint
	       else begin
		     FPEOF := MAXINT;   {CHANGED FOR 9122 4/11/84 SFB}
		     call(tm, addr(f), readbytes, buf, 2, 0); {TOUCH DISC}
		     {UNITABLE^[UNUM].UMAXBYTES WAS VALIDATED BY TM CALL -
		      IE DISC CONTROLLER SENT PRESENT MEDIA VALUE IF SMART
		      ENOUGH}
		     fpeof := ueovbytes(unum);  {MOVED 4/11/84 SFB}
		     {UEOVBYTES SET TO UMAXBYTES IF BLOCKED & NOT 9885/9895}
		    end;
	     ureportchange := true; umediavalid := true;
	     fleof := fpeof;
	     fisnew := false;
	     if        not uisblkd  then
		  if not fistextvar then am := tm
				    else am := serialtextamhook
	     else if not fbuffered  then am := amtable^[untypedfile]
	     else if not fistextvar then am := amtable^[datafile]
				    else am := amtable^[fkind];
	     end;

  otherwise ioresult := ord(ibadrequest);
 end;
end;

(*  ACCESS METHOD FOR UNBUFFERED TRANSFERS *)
{updates fpos, checks logical limits of file, calls "stretch" if necessary}

procedure unbuffedam(fp: fibp;  request: amrequesttype;
			  anyvar buffer: window; buffsize, position: integer);
label 1;
begin
with fp^, unitable^[funit] do
  case request of
   readbytes,writebytes:
    begin
    fpos := position + buffsize;
    if fpos > fleof then
      if (request=readbytes) then begin ioresult := ord(ieof); goto 1; end
      else
	begin
	if fpos > fpeof then
	  begin
	  call(dam, fp^, funit, stretchit);
	  if fpos > fpeof then begin ioresult := ord(ieof); goto 1; end
	  end;
	fleof := fpos; fmodified := true;
	end;
    call(tm, fp, request, buffer, buffsize, position);
    end;
   flush: call(tm, fp, request, buffer, buffsize, position);
   otherwise ioresult := ord(ibadrequest);
  end;
1:
end;


(*  ACCESS METHOD FOR SERIAL TEXT INPUT DEVICES *)
{converts a carriage return character to an 'end of line' indication}

procedure serialtextam(fp: fibp;  request: amrequesttype;
			  anyvar buffer: window; buffsize, position: integer);
var i: integer;
begin
with fp^, unitable^[funit] do
  begin
  call(tm, fp, request, buffer, buffsize, position);
  if ioresult = ord(inoerror) then
   if request = readbytes then
    begin
    feoln := buffer[buffsize-1] = eol;
    for i := 0 to buffsize - 1 do if buffer[i]=eol then buffer[i] := ' ';
    end;
  end;
end;

(* ACCESS METHOD FOR DATA FILES *)
{accomplishes general purpose buffering}

procedure standardam(fp: fibp;  request: amrequesttype;
			anyvar buffer: window; buffsize, position: integer);
label 1,2;
var lastblock, block, oldfleof, oldfpos,                {rdq}
    firstpos, firstbytes, middlebytes, endbytes, i: integer;
    c: char;
    {following vars added for 3.1 performance improvement--4/10/85--SFB}
    heaptop : anyptr;           {pointer used to return heapspace}
    mybuf   : windowp;          {pointer to middlebytes buffer on heap}
    endblock: integer;          {used as in 2.0 AM}
    startbytes : integer;       {tempcopy of firstbytes for buffered xfer}
    midbytes   : integer;       {tempcopy of middlebytes for buffered xfer}
    eolchar: char;              {variable eol char for UX and other files SFB}


  procedure flushbuffer;
  var bufsize: integer;
  begin with fp^ do
   if fbufchanged {block buffer has been written} then
    begin
    bufsize := fleof - flastpos;
    if bufsize > fblksize then bufsize := fblksize;
    call (unitable^[funit].tm, fp, writebytes, fbuffer, bufsize, flastpos);
    if ioresult <> ord(inoerror) then goto 1;
    fbufchanged := false;
    end;
  end;

  procedure fetchbuffer;
  var i, bufsize: integer;
  begin if block<>lastblock then with fp^ do
   begin
   flushbuffer;
   lastblock := block;  flastpos := lastblock*fblksize;
   bufsize := oldfleof - flastpos;
   if bufsize <= 0 then bufsize := 0 else
      begin
      if bufsize > fblksize then bufsize := fblksize;
      call (unitable^[funit].tm, fp, readbytes, fbuffer, bufsize, flastpos);
      if ioresult <> ord(inoerror) then goto 1;
      end;
   for i := bufsize to fblksize-1 do fbuffer[i] := chr(0);
   end;
  end;

begin with fp^ do
 begin
 ioresult := ord(inoerror);
 if feft=uxfile_eft then       { Set eolchar properly -- SFB }
   eolchar:=chr(lf)            { EOL set to \n for HPUX text files}
 else
   eolchar:=chr(cr);           { Normal eol for data file}
 oldfleof := fleof; oldfpos := fpos;                    {rdq}
 case request of
  flush: begin
	 flushbuffer;
	 call(unitable^[funit].tm, fp, flush, fp^, 0, 0);
	 end;
  writeeol: begin
	    c := eolchar;
	    standardam(fp, writebytes, c, 1, position);
	    end;
  readtoeol:
    begin
    middlebytes := 0;
    fpos := position;
    if buffsize > fleof - position then buffsize := fleof - position;
    lastblock := (flastpos - flastpos mod fblksize) div fblksize;
    while buffsize > 0 do
      begin
      block := fpos div fblksize;
      fetchbuffer;
      firstpos := fpos - flastpos;
      firstbytes := fblksize - firstpos;
      if firstbytes > buffsize then firstbytes := buffsize;
      for i := 0 to firstbytes-1 do
	if fbuffer[firstpos+i]=eolchar then
	  begin firstbytes := i; buffsize := i; goto 2; end;
      2: moveleft(fbuffer[firstpos], buffer[1+middlebytes], firstbytes);
      middlebytes := middlebytes + firstbytes;
      fpos := fpos + firstbytes;
      buffsize := buffsize - firstbytes;
      end;
    buffer[0] := chr(middlebytes);
    if middlebytes>0 then fp^.feoln := false;
    end;
  readbytes,writebytes:
   begin
   fpos := position + buffsize;
   if fpos > fleof then
    if (request = readbytes) then
      begin {feoln := true;} ioresult := ord(ieof); fpos:=oldfpos; goto 1; end
    else begin
	 if fpos > fpeof then
	     begin
	     call(unitable^[funit].dam, fp^, funit, stretchit);
	     if fpos > fpeof then begin ioresult := ord(ieof); fpos := oldfpos;
					goto 1;
				  end;
	     end;
	 fleof := fpos; fmodified := true;
	 end;

   if flastpos < 0 then lastblock := -1
   else lastblock := flastpos div fblksize;
   block     := position div fblksize;
   if (buffsize=1) and (block=lastblock)   {the most common case!}   then
     if request = readbytes then buffer[0] := fbuffer[position mod fblksize]
     else begin
	  fbuffer[position mod fblksize] := buffer[0];
	  fbufchanged := true;
	  end
   else
     begin
     firstpos := (-position) mod fblksize;
     if firstpos >= buffsize then
	  begin firstbytes := buffsize; endbytes := 0; end
     else begin firstbytes := firstpos; endbytes :=fpos mod fblksize; end;
     middlebytes := buffsize - firstbytes - endbytes;

     if firstbytes > 0 then
       begin
       fetchbuffer;
       if request=readbytes
	 then moveleft(fbuffer[fblksize-firstpos], buffer, firstbytes)
       else
	 begin
	 moveleft(buffer, fbuffer[fblksize-firstpos], firstbytes);
	 fbufchanged := true;
	 end;
       block := block + 1;
       end;

{ code removed in 3.1 and replaced by following for performance reasons}
{ 4/13/85--SFB/LAF}

if middlebytes > 0 then  {performance enhancement for 3.1--SFB/LAF 5/13/85}
 begin
  endblock := block + middlebytes div fblksize; {prepare to set block at end}
  if odd(ord(addr(buffer[firstbytes]))) then    {odd start for middlebytes}
    if (memavail - 5*1024) >= middlebytes then  {room on heap for middlebytes}
     begin        {use tm to ship out data--similar to but different than 2.0}
      mark(heaptop);
      lockup;           {protect against STOP key during RECOVER execution}
      try                                 {protect the state of the heap}
       newwords(mybuf, middlebytes div 2);      {and get word-aligned space}
       if request = writebytes then
	moveleft(buffer[firstbytes], mybuf^, middlebytes); {copy data to heap}
       if (block <= lastblock) and (lastblock < endblock) then  {as in 2.0}
	begin flushbuffer; lastblock := -1; end;
       call(unitable^[funit].tm, fp, request,   {transfer middlebytes}
	    mybuf^, middlebytes, block*fblksize);
       if request = readbytes then              {whether tm failed or not!}
	moveleft(mybuf^, buffer[firstbytes], middlebytes);{copy data to buffer}
       release(heaptop);                        {and return heap}
      recover
       begin
	release(heaptop);                       {return heap in any case}
	if escapecode <> -10 then               {some non-IO escape but}
	 ioresult := ord(zcatchall);            {don't know what went wrong}
       end;       {recover}
      lockdown;                         {let STOP key through if it wants}
      if ioresult <> ord(inoerror) then {test ioresult after tm call,}
       goto 1;                          {just as in fetch/flushbuffer,
		     except we moved data to user buffer for read whether tm
		     failed or not (to simulate 2.1/3.0 post-fail condition,
		     or direct move-to-user-buffer post-fail condition)}
     end
    else                                        {no room on heap}
     begin
      startbytes := firstbytes; {copy to startbytes and midbytes so at finish}
      midbytes   := middlebytes;{firstbytes and middlebytes won't have changed}
      while midbytes > 0 do     {use 2.1/3.0-like method to ship out data}
       begin                    {"buffered xfer"}
	if request = readbytes then
	 begin
	  fetchbuffer;
	  moveleft(fbuffer, buffer[startbytes], fblksize);
	 end
	else
	 begin
	  flushbuffer;
	  lastblock := block;
	  flastpos := lastblock*fblksize;
	  moveleft(buffer[startbytes], fbuffer, fblksize);
	  fbufchanged := true;
	 end;
	midbytes    := midbytes - fblksize;
	startbytes  := startbytes + fblksize;
	block       := block + 1; {this gets set to endblock when done}
       end
     end
  else                    {middlebytes starts on even RAM address}
   begin                  {so call tm directly--as in 2.0 AM--see 2.0 code}
    if (block <= lastblock) and (lastblock < endblock) then
     begin flushbuffer; lastblock := -1; end;
    call(unitable^[funit].tm, fp, request, buffer[firstbytes], middlebytes,
	 block*fblksize);
    if ioresult <> ord(inoerror) then   {test ioresult right after tm call,}
     goto 1;                            {just as in fetch/flushbuffer}
   end;
  block := endblock;    {set block no matter which branch we took}
 end;

if endbytes > 0 then
       begin
       fetchbuffer;
       if request=readbytes

	 {following 2 movelefts modified (+middlebytes) to be workable with
	  2.0-type direct tm calls--firstbytes is no longer changed during
	  middlebytes transfer, as it was in 2.1/3.0 am--SFB 5/10/85}

	 then moveleft(fbuffer, buffer[firstbytes+middlebytes], endbytes)
	 else begin
	      moveleft(buffer[firstbytes+middlebytes], fbuffer, endbytes);
	      fbufchanged := true;
	      end;
       end;
     end;
   if fistextvar then if request = readbytes then
    for i := 0 to buffsize-1 do
     if buffer[i] = eolchar then begin feoln := true; buffer[i] := ' '; end
     else feoln := false;
   end;
  otherwise ioresult := ord(ibadrequest);
 end;
end;
1:
end;


procedure initfilekinds;
var fk: filekind;
begin
 serialtextamhook := serialtextam;

 {new(efttable);                                ALREADY DONE IN BOOT LOADER}
 new(amtable);
 new(suffixtable);

 for fk := untypedfile to lastfkind do
  begin
  suffixtable^[fk]              := '';          {no suffix   }
  amtable^[fk]                  := unbuffedam;  {no buffering}
  efttable^[fk]                 := 0;           {unassociated LIF file type}
  end;

  efttable^   [untypedfile]     := 3;           {LIF directory}
						{no suffix}
						{no buffering}

  suffixtable^[badfile]         := 'BAD';       {bad block indication}
  efttable^   [badfile]         := 2;           {LIF bad block marker}
						{no buffering}

  efttable^   [datafile]        := datafile_eft;{DCD Pascal data file}
						{no suffix}
  amtable^    [datafile]        := standardam;  {general purpose buffering}

  suffixtable^[codefile]        := 'CODE';      {code file suffix}
  efttable^   [codefile]        := codefile_eft;{DCD Pascal code file}
						{no buffering}

  suffixtable^[sysfile]         := 'SYSTM';     {suffix for system file}
  efttable^   [sysfile]         := sysfile_eft; {DCD system (boot) file}
						{no buffering}

  suffixtable^[uxfile]          := 'UX';        {suffix for HP-UX data file}
  efttable^   [uxfile]          := uxfile_eft;  {All HP-UX regular files}
  amtable^    [uxfile]          := standardam;  {Upgraded for HPUX text files}
						{UXTEXT_AM may overwrite this}
end;

{ Added for SRM-UX support JWH 8/10/90 : }
{ moved to SRM_DRV 10/31/90 }

{ function is_srmux_unit(unum : unitnum) : boolean;
begin
  is_srmux_unit := srmux_on[unum];
end;

procedure init_srmux_array;
var i : integer;
begin
 for i := 1 to 50 do
   srmux_on[i] := false;
end; }


end  {miscellaneous stuff module}
@


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


54.4
log
@
pws2rcs automatic delta on Wed Aug 21 10:27:27 MDT 1991
@
text
@@


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


54.2
log
@
Made the buffer in unblockeddam bigger so that it will work OK with
the SCSI TEAC drive in the MACE box. JWH 7/30/91.
@
text
@a0 716
module misc;    {homeless orphans}

import sysglobals, asm;

export

const

  null  = 0;    nullchar  = chr(0);
		homechar  = chr(1);
  etx   = 3;
  bell  = 7;    bellchar  = chr(7);
  bs    = 8;    leftchar  = chr(8);
  tab   = 9;    cteol     = chr(9);
  lf    = 10;   downchar  = chr(10);
  vt    = 11;   cteos     = chr(11);
  ff    = 12;   clearscr  = chr(12);
  cr    = 13;   eol       = chr(13);
  dle   = 16;
  esc   = 27;   escchar   = chr(27);
  fsp   = 28;   rightchar = chr(28);
  us    = 31;   upchar    = chr(31);
  del   = 127;
  cntrl = 255;

  { external file types }
  codefile_eft = -5582;
  datafile_eft = -5622;
  uxfile_eft   = -5813;
  sysfile_eft  = -5822;

type
(* CATALOGUE INFORMATION, zero entry refers to the directory itself *)

  catentry = record
    cname:  tid;                {name of file or directory}
    ceft:   shortint;           {external file type (LIF)}
    ckind:  filekind;           {file kind}
    cpsize: integer;            {physical size of file
					or of total data space on volume}
    clsize: integer;            {logical size of file
					or unused space on medium}
    cstart: integer;            {starting location of file
					or first possible data location}
    cblocksize: integer;        {size of a sector or block}
    ccreatedate, clastdate:  daterec;   {creation, last modified dates}
    ccreatetime, clasttime:  timerec;   {creation, last modified times}
    cextra1,                    {extension
					or total possible number of files
					or requested number of files}
    cextra2:   integer;         {secondary discretionary field
					or start index of requested catalog}
    cinfo:  string[20];         {comment or miscellaneous information}

    end;

    passentry = record
		 pbits: integer;
		 pword: passtype;
		 end;

type
(* SETPASSWORDS/CATPASSWORDS entries used with HFS*)
  h_catpasswd_ids = packed record
	  cat_uid: ushort;
	  cat_gid: ushort;
	  case integer of
	    0: (cat_mode: ushort);
	    1: (cat_umask: integer);
	  end;
  h_setpasswd_command = (hfs_login, hfs_umask,
			hfs_open,
			hfs_chmod, hfs_chown, hfs_chgrp,
			hfs_chatime, hfs_chmtime);
  h_setpasswd_entry = packed record
		command: h_setpasswd_command;
		new_value: integer;
		end;

  { Added for SRM-UX support 8/10/90 JWH }
  { removed 10/31/90 moved to SRM_TYPES }

  { srmux_array = array[1..50] of boolean; }

var
  idle: byte;              { idle character -- 3.0 bug jws 3/20/84 }
  lastfid : ^fid;          { storage of fid before zapspaces in FS fileopen }
			   {SRM-UX RPC support. RDQ }
  { moved to SRM_DRV 10/31/90 }
  { srmux_on : srmux_array; }  {SRM-UX support. JWH }

procedure getioerrmsg(var s :string; lastior : integer);
procedure printerror(errorcode, lastior: integer);
procedure upc(var s: string);
function ueovbytes(unit: unitnum): integer;
procedure unblockeddam(anyvar f: fib; unum: unitnum; request: damrequesttype);
procedure initfilekinds;
procedure lockup;
procedure lockdown;
{ Added for SRM-UX support 8/10/90 }
{ moved to SRM_DRV 10/31/90 }
{ function is_srmux_unit(unum : unitnum) : boolean; }
{ procedure init_srmux_array; }


implement

procedure lockup;
begin
  locklevel := locklevel + 1;
end;

procedure lockdown;
var saveio: integer;
    saveec: shortint;
begin
locklevel := locklevel - 1;
if locklevel = 0 then
  begin
  saveio := ioresult;
  saveec := sysescapecode;
  while actionspending > 0 do
    begin
    call(deferredaction[actionspending]);
    actionspending := actionspending - 1;
    end;
  ioresult := saveio;
  sysescapecode := saveec;
  end;
end;

procedure upc(var s: string);
var i: shortint;
    c: char;
begin
 for i := 1 to strlen(s) do
   begin
   c := s[i];           {this assignment saves two or three subscripts}
   if (c >= 'a') and (c <= 'z') then s[i] := chr(ord(c)+ (ord('A')-ord('a')));
   end;
end;

function ueovbytes(unit: unitnum): integer;
  label 1;
  var return_bytes: integer;
      saved_ioresult: integer;
      saved_reportbit: boolean;
      tracks: shortint;
      f: fib;

function try_tracks(number_of_tracks: shortint): boolean;
begin {try_tracks}
  f.fpeof  := number_of_tracks*(30*256)-unitable^[unit].byteoffset;
  f.funit := unit; f.fileid := 0;
  call (unitable^[unit].tm, addr(f), readbytes, f.fbuffer, 256, f.fpeof-512);
  if ioresult=0 then
    begin
      return_bytes := f.fpeof; { <<< desired side-effect! }
      try_tracks := true
    end {if}
  else
    try_tracks := false
end; {try_tracks}

begin {ueovbytes}
with unitable^[unit] do
 if not uisblkd then ueovbytes := maxint
 else if (letter<>'H') and (letter<>'F') then ueovbytes := umaxbytes
 else
    begin
    saved_reportbit := ureportchange;  ureportchange := false;
    saved_ioresult := ioresult;
    return_bytes := 0;             {in case none of the tries succeed!!!}
    if letter='H' then
      if try_tracks(150) then goto 1;         {DS disc init'ed by a 9895}
    for tracks := 61 to 67 do
      if not try_tracks(tracks) then goto 1;  {SS disc init'ed by a 9885}
    if not try_tracks(73) then {goto 1};      {SS disc init'ed by a 9895}
1:  ioresult := saved_ioresult;
    ureportchange := saved_reportbit;
    if return_bytes<=umaxbytes then ueovbytes := return_bytes
			       else ueovbytes := umaxbytes;
    end;
end; {ueovbytes}

procedure getioerrmsg(var s : string; lastior : integer);
var dummy: integer;
begin
  case lastior of
    ord(inoerror      ):  s := '(no I/O error reported)';
    ord(zbadblock     ):  s := 'block parity error';
    ord(ibadunit      ):  s := 'illegal unit number';
    ord(zbadmode      ):  s := 'illegal IO request';
    ord(ztimeout      ):  s := 'device timeout';
    ord(ilostunit     ):  s := 'volume has gone off-line';
    ord(ilostfile     ):  s := 'file lost in dir';
    ord(ibadtitle     ):  s := 'bad file name';
    ord(inoroom       ):  s := 'no room on vol';
    ord(inounit       ):  s := 'logical volume not found';
    ord(inofile       ):  s := 'file not found';
    ord(idupfile      ):  s := 'dup dir entry';
    ord(inotclosed    ):  s := 'file already open';
    ord(inotopen      ):  s := 'file not open';
    ord(ibadformat    ):  s := 'bad input format';
    ord(znosuchblk    ):  s := 'block number out of range';
    ord(znodevice     ):  s := 'device absent or unaccessible';
    ord(zinitfail     ):  s := 'medium formatting/sparing failed';
    ord(zprotected    ):  s := 'medium is write protected';
    ord(zstrangei     ):  s := 'unexpected interrupt';
    ord(zbadhardware  ):  s := 'hardware fault';
    ord(zcatchall     ):  s := 'unrecognized error state';
    ord(zbaddma       ):  s := 'DMA absent or unavailable';
    ord(inotvalidsize ):  s := 'file size not compatible with type';
    ord(inotreadable  ):  s := 'file not opened for reading';
    ord(inotwriteable ):  s := 'file not opened for writing';
    ord(inotdirect    ):  s := 'file not opened for direct access';
    ord(idirfull      ):  s := 'no room in directory';
    ord(istrovfl      ):  s := 'string subscript out of range';
    ord(ibadclose     ):  s := 'bad file close string parameter';
    ord(ieof          ):  s := 'tried to read or write past eof';
    ord(zuninitialized):  s := 'medium uninitialized';
    ord(znoblock      ):  s := 'block not found';
    ord(znotready     ):  s := 'device not ready or medium absent';
    ord(znomedium     ):  s := 'medium absent';
    ord(inodirectory  ):  s := 'no directory on volume';
    ord(ibadfiletype  ):  s := 'file type illegal or does not match';
    ord(ibadvalue     ):  s := 'parameter illegal or out of range';
    ord(icantstretch  ):  s := 'file cannot be extended';
    ord(ibadrequest   ):  s := 'undefined operation for unit/file';
    ord(inotlockable  ):  s := 'file not lockable';
    ord(ifilelocked   ):  s := 'file already locked';
    ord(ifileunlocked ):  s := 'file not locked';
    ord(idirnotempty  ):  s := 'directory not empty';
    ord(itoomanyopen  ):  s := 'too many files open on device';
    ord(inoaccess     ):  s := 'access to file not allowed';
    ord(ibadpass      ):  s := 'invalid password';
    ord(ifilenotdir   ):  s := 'file is not a directory';
    ord(inotondir     ):  s := 'operation not allowed on directory';
    ord(ineedtempdir  ):  s := 'cannot create /WORKSTATIONS/TEMP_FILES';
    ord(isrmcatchall  ):  s := 'unrecognized SRM or SRM/UX error';
    ord(zmediumchanged):  s := 'medium may have been changed';
    ord(icorrupt      ):  s := 'file system corrupt';
    ord(itoobig       ):  s := 'file or file system too big';
    ord(inopermission ):  s := 'no permission for requested action';
    ord(zdvrcachefull ):  s := 'driver cache full';
    ord(zdvrnoconfig  ):  s := 'driver configuration failed';
    ord(idontlink     ):  s := 'cannot link across mounted volumes';

    otherwise
      begin setstrlen(s,0);
	    strwrite(s, 1, dummy, 'ioresult was ', lastior:1);
      end;

  end (*IO ERRORS*) ;
end;

procedure printerror(errorcode,lastior: integer);
label 1;
var   s,st: string[80];
      excp_line['excp_line']: integer;
      excp_pc['excp_pc']: integer;
begin
  writeln(cteol,bellchar); write(cteol);

  if errorcode > 0 then
    writeln(output,'Abnormal termination.  Halt code ',errorcode:1)
  else
    begin
      case errorcode of
    0:  s := 'normal termination not caught by GO';
   -1:  s := 'abnormal termination not caught by GO';
   -2:  s := 'not enough memory';
   -3:  s := 'reference to NIL pointer';
   -4:  s := 'integer overflow';
   -5:  s := 'divide by zero';
   -6:  s := 'real math overflow';
   -7:  s := 'real math underflow';
   -8:  s := 'value range error';
   -9:  s := 'case value range error';

  -10:  getioerrmsg(s,lastior);           (* IORESULT <> 0 *)

  -11:  s := 'CPU word access to odd address';
  -12:  s := 'CPU bus error';
  -13:  s := 'illegal CPU instruction';
  -14:  s := 'CPU privilege violation';
  -15:  s := 'bad argument: SIN/COS';
  -16:  s := 'bad argument: LN';
  -17:  s := 'bad argument: SQRT';
  -18:  s := 'bad argument: real/BCD conversion';
  -19:  s := 'bad argument: BCD/real conversion';
  -20:  s := 'stopped by user';
  -21:  s := 'unassigned CPU trap';
(*-22:                              *************** call to debugger ********)
  -23:  goto 1;                            (******** give no message !! *****)
  -24:  s := 'macro parameter not 0..9 or A..Z';
  -25:  s := 'undefined macro parameter';
  -26:  s := 'I/O routine error';
  -27:  s := 'graphics routine error';
  -28:  s := 'ram parity error';
  -29:  s := 'misc floating pt hardware error';

otherwise
	s := 'undocumented error'
      end; (*CASE ERRORCODE*)
      writeln(output,
'-------------------------------------------------');
      writeln('error ',errorcode:1,': ',s,cteol); write(cteol);
      if excp_line >= 0 then write('line number:  ',excp_line:1, '   ');
      writeln('PC value:    ',excp_pc:1);
    end;
1: end (*PRINTERROR*) ;



(*DIRECTORY ACCESS METHOD FOR DIRECT UNIT OPEN,   ASSUMES NO DIRECTORY *)

procedure unblockeddam(anyvar f: fib; unum: unitnum; request: damrequesttype);
type vidptr = ^vid;
var buf: { shortint } packed array[0..1023] of char; { JWH 7/30/91 }
begin
ioresult := 0;
with f, unitable^[unum] do
 case request of
  stretchit,                    {can't do anything}
  purgefile, closefile:         {nothing to do};
				{changed stripname for version 2.2 on 4-May-83}
  stripname: begin              {move ftitle to ftid and set ftitle to null}
	       if strlen(ftitle) > tidleng then
		 begin
		   ioresult := ord(ibadtitle);
		   setstrlen(ftid,0);
		 end
	       else
		 ftid := ftitle;
	       setstrlen(ftitle,0);
	     end;
  getvolumename: vidptr(addr(f))^ := uvid;
  setvolumename: uvid := vidptr(addr(f))^;
  openunit,
  openvolume,
  createfile,
  openfile:  begin
	     fileid := 0;
	     ureportchange := false;
	     if request = openunit then fpeof := umaxbytes
	     else if not uisblkd then fpeof := maxint
	       else begin
		     FPEOF := MAXINT;   {CHANGED FOR 9122 4/11/84 SFB}
		     call(tm, addr(f), readbytes, buf, 2, 0); {TOUCH DISC}
		     {UNITABLE^[UNUM].UMAXBYTES WAS VALIDATED BY TM CALL -
		      IE DISC CONTROLLER SENT PRESENT MEDIA VALUE IF SMART
		      ENOUGH}
		     fpeof := ueovbytes(unum);  {MOVED 4/11/84 SFB}
		     {UEOVBYTES SET TO UMAXBYTES IF BLOCKED & NOT 9885/9895}
		    end;
	     ureportchange := true; umediavalid := true;
	     fleof := fpeof;
	     fisnew := false;
	     if        not uisblkd  then
		  if not fistextvar then am := tm
				    else am := serialtextamhook
	     else if not fbuffered  then am := amtable^[untypedfile]
	     else if not fistextvar then am := amtable^[datafile]
				    else am := amtable^[fkind];
	     end;

  otherwise ioresult := ord(ibadrequest);
 end;
end;

(*  ACCESS METHOD FOR UNBUFFERED TRANSFERS *)
{updates fpos, checks logical limits of file, calls "stretch" if necessary}

procedure unbuffedam(fp: fibp;  request: amrequesttype;
			  anyvar buffer: window; buffsize, position: integer);
label 1;
begin
with fp^, unitable^[funit] do
  case request of
   readbytes,writebytes:
    begin
    fpos := position + buffsize;
    if fpos > fleof then
      if (request=readbytes) then begin ioresult := ord(ieof); goto 1; end
      else
	begin
	if fpos > fpeof then
	  begin
	  call(dam, fp^, funit, stretchit);
	  if fpos > fpeof then begin ioresult := ord(ieof); goto 1; end
	  end;
	fleof := fpos; fmodified := true;
	end;
    call(tm, fp, request, buffer, buffsize, position);
    end;
   flush: call(tm, fp, request, buffer, buffsize, position);
   otherwise ioresult := ord(ibadrequest);
  end;
1:
end;


(*  ACCESS METHOD FOR SERIAL TEXT INPUT DEVICES *)
{converts a carriage return character to an 'end of line' indication}

procedure serialtextam(fp: fibp;  request: amrequesttype;
			  anyvar buffer: window; buffsize, position: integer);
var i: integer;
begin
with fp^, unitable^[funit] do
  begin
  call(tm, fp, request, buffer, buffsize, position);
  if ioresult = ord(inoerror) then
   if request = readbytes then
    begin
    feoln := buffer[buffsize-1] = eol;
    for i := 0 to buffsize - 1 do if buffer[i]=eol then buffer[i] := ' ';
    end;
  end;
end;

(* ACCESS METHOD FOR DATA FILES *)
{accomplishes general purpose buffering}

procedure standardam(fp: fibp;  request: amrequesttype;
			anyvar buffer: window; buffsize, position: integer);
label 1,2;
var lastblock, block, oldfleof, oldfpos,                {rdq}
    firstpos, firstbytes, middlebytes, endbytes, i: integer;
    c: char;
    {following vars added for 3.1 performance improvement--4/10/85--SFB}
    heaptop : anyptr;           {pointer used to return heapspace}
    mybuf   : windowp;          {pointer to middlebytes buffer on heap}
    endblock: integer;          {used as in 2.0 AM}
    startbytes : integer;       {tempcopy of firstbytes for buffered xfer}
    midbytes   : integer;       {tempcopy of middlebytes for buffered xfer}
    eolchar: char;              {variable eol char for UX and other files SFB}


  procedure flushbuffer;
  var bufsize: integer;
  begin with fp^ do
   if fbufchanged {block buffer has been written} then
    begin
    bufsize := fleof - flastpos;
    if bufsize > fblksize then bufsize := fblksize;
    call (unitable^[funit].tm, fp, writebytes, fbuffer, bufsize, flastpos);
    if ioresult <> ord(inoerror) then goto 1;
    fbufchanged := false;
    end;
  end;

  procedure fetchbuffer;
  var i, bufsize: integer;
  begin if block<>lastblock then with fp^ do
   begin
   flushbuffer;
   lastblock := block;  flastpos := lastblock*fblksize;
   bufsize := oldfleof - flastpos;
   if bufsize <= 0 then bufsize := 0 else
      begin
      if bufsize > fblksize then bufsize := fblksize;
      call (unitable^[funit].tm, fp, readbytes, fbuffer, bufsize, flastpos);
      if ioresult <> ord(inoerror) then goto 1;
      end;
   for i := bufsize to fblksize-1 do fbuffer[i] := chr(0);
   end;
  end;

begin with fp^ do
 begin
 ioresult := ord(inoerror);
 if feft=uxfile_eft then       { Set eolchar properly -- SFB }
   eolchar:=chr(lf)            { EOL set to \n for HPUX text files}
 else
   eolchar:=chr(cr);           { Normal eol for data file}
 oldfleof := fleof; oldfpos := fpos;                    {rdq}
 case request of
  flush: begin
	 flushbuffer;
	 call(unitable^[funit].tm, fp, flush, fp^, 0, 0);
	 end;
  writeeol: begin
	    c := eolchar;
	    standardam(fp, writebytes, c, 1, position);
	    end;
  readtoeol:
    begin
    middlebytes := 0;
    fpos := position;
    if buffsize > fleof - position then buffsize := fleof - position;
    lastblock := (flastpos - flastpos mod fblksize) div fblksize;
    while buffsize > 0 do
      begin
      block := fpos div fblksize;
      fetchbuffer;
      firstpos := fpos - flastpos;
      firstbytes := fblksize - firstpos;
      if firstbytes > buffsize then firstbytes := buffsize;
      for i := 0 to firstbytes-1 do
	if fbuffer[firstpos+i]=eolchar then
	  begin firstbytes := i; buffsize := i; goto 2; end;
      2: moveleft(fbuffer[firstpos], buffer[1+middlebytes], firstbytes);
      middlebytes := middlebytes + firstbytes;
      fpos := fpos + firstbytes;
      buffsize := buffsize - firstbytes;
      end;
    buffer[0] := chr(middlebytes);
    if middlebytes>0 then fp^.feoln := false;
    end;
  readbytes,writebytes:
   begin
   fpos := position + buffsize;
   if fpos > fleof then
    if (request = readbytes) then
      begin {feoln := true;} ioresult := ord(ieof); fpos:=oldfpos; goto 1; end
    else begin
	 if fpos > fpeof then
	     begin
	     call(unitable^[funit].dam, fp^, funit, stretchit);
	     if fpos > fpeof then begin ioresult := ord(ieof); fpos := oldfpos;
					goto 1;
				  end;
	     end;
	 fleof := fpos; fmodified := true;
	 end;

   if flastpos < 0 then lastblock := -1
   else lastblock := flastpos div fblksize;
   block     := position div fblksize;
   if (buffsize=1) and (block=lastblock)   {the most common case!}   then
     if request = readbytes then buffer[0] := fbuffer[position mod fblksize]
     else begin
	  fbuffer[position mod fblksize] := buffer[0];
	  fbufchanged := true;
	  end
   else
     begin
     firstpos := (-position) mod fblksize;
     if firstpos >= buffsize then
	  begin firstbytes := buffsize; endbytes := 0; end
     else begin firstbytes := firstpos; endbytes :=fpos mod fblksize; end;
     middlebytes := buffsize - firstbytes - endbytes;

     if firstbytes > 0 then
       begin
       fetchbuffer;
       if request=readbytes
	 then moveleft(fbuffer[fblksize-firstpos], buffer, firstbytes)
       else
	 begin
	 moveleft(buffer, fbuffer[fblksize-firstpos], firstbytes);
	 fbufchanged := true;
	 end;
       block := block + 1;
       end;

{ code removed in 3.1 and replaced by following for performance reasons}
{ 4/13/85--SFB/LAF}

if middlebytes > 0 then  {performance enhancement for 3.1--SFB/LAF 5/13/85}
 begin
  endblock := block + middlebytes div fblksize; {prepare to set block at end}
  if odd(ord(addr(buffer[firstbytes]))) then    {odd start for middlebytes}
    if (memavail - 5*1024) >= middlebytes then  {room on heap for middlebytes}
     begin        {use tm to ship out data--similar to but different than 2.0}
      mark(heaptop);
      lockup;           {protect against STOP key during RECOVER execution}
      try                                 {protect the state of the heap}
       newwords(mybuf, middlebytes div 2);      {and get word-aligned space}
       if request = writebytes then
	moveleft(buffer[firstbytes], mybuf^, middlebytes); {copy data to heap}
       if (block <= lastblock) and (lastblock < endblock) then  {as in 2.0}
	begin flushbuffer; lastblock := -1; end;
       call(unitable^[funit].tm, fp, request,   {transfer middlebytes}
	    mybuf^, middlebytes, block*fblksize);
       if request = readbytes then              {whether tm failed or not!}
	moveleft(mybuf^, buffer[firstbytes], middlebytes);{copy data to buffer}
       release(heaptop);                        {and return heap}
      recover
       begin
	release(heaptop);                       {return heap in any case}
	if escapecode <> -10 then               {some non-IO escape but}
	 ioresult := ord(zcatchall);            {don't know what went wrong}
       end;       {recover}
      lockdown;                         {let STOP key through if it wants}
      if ioresult <> ord(inoerror) then {test ioresult after tm call,}
       goto 1;                          {just as in fetch/flushbuffer,
		     except we moved data to user buffer for read whether tm
		     failed or not (to simulate 2.1/3.0 post-fail condition,
		     or direct move-to-user-buffer post-fail condition)}
     end
    else                                        {no room on heap}
     begin
      startbytes := firstbytes; {copy to startbytes and midbytes so at finish}
      midbytes   := middlebytes;{firstbytes and middlebytes won't have changed}
      while midbytes > 0 do     {use 2.1/3.0-like method to ship out data}
       begin                    {"buffered xfer"}
	if request = readbytes then
	 begin
	  fetchbuffer;
	  moveleft(fbuffer, buffer[startbytes], fblksize);
	 end
	else
	 begin
	  flushbuffer;
	  lastblock := block;
	  flastpos := lastblock*fblksize;
	  moveleft(buffer[startbytes], fbuffer, fblksize);
	  fbufchanged := true;
	 end;
	midbytes    := midbytes - fblksize;
	startbytes  := startbytes + fblksize;
	block       := block + 1; {this gets set to endblock when done}
       end
     end
  else                    {middlebytes starts on even RAM address}
   begin                  {so call tm directly--as in 2.0 AM--see 2.0 code}
    if (block <= lastblock) and (lastblock < endblock) then
     begin flushbuffer; lastblock := -1; end;
    call(unitable^[funit].tm, fp, request, buffer[firstbytes], middlebytes,
	 block*fblksize);
    if ioresult <> ord(inoerror) then   {test ioresult right after tm call,}
     goto 1;                            {just as in fetch/flushbuffer}
   end;
  block := endblock;    {set block no matter which branch we took}
 end;

if endbytes > 0 then
       begin
       fetchbuffer;
       if request=readbytes

	 {following 2 movelefts modified (+middlebytes) to be workable with
	  2.0-type direct tm calls--firstbytes is no longer changed during
	  middlebytes transfer, as it was in 2.1/3.0 am--SFB 5/10/85}

	 then moveleft(fbuffer, buffer[firstbytes+middlebytes], endbytes)
	 else begin
	      moveleft(buffer[firstbytes+middlebytes], fbuffer, endbytes);
	      fbufchanged := true;
	      end;
       end;
     end;
   if fistextvar then if request = readbytes then
    for i := 0 to buffsize-1 do
     if buffer[i] = eolchar then begin feoln := true; buffer[i] := ' '; end
     else feoln := false;
   end;
  otherwise ioresult := ord(ibadrequest);
 end;
end;
1:
end;


procedure initfilekinds;
var fk: filekind;
begin
 serialtextamhook := serialtextam;

 {new(efttable);                                ALREADY DONE IN BOOT LOADER}
 new(amtable);
 new(suffixtable);

 for fk := untypedfile to lastfkind do
  begin
  suffixtable^[fk]              := '';          {no suffix   }
  amtable^[fk]                  := unbuffedam;  {no buffering}
  efttable^[fk]                 := 0;           {unassociated LIF file type}
  end;

  efttable^   [untypedfile]     := 3;           {LIF directory}
						{no suffix}
						{no buffering}

  suffixtable^[badfile]         := 'BAD';       {bad block indication}
  efttable^   [badfile]         := 2;           {LIF bad block marker}
						{no buffering}

  efttable^   [datafile]        := datafile_eft;{DCD Pascal data file}
						{no suffix}
  amtable^    [datafile]        := standardam;  {general purpose buffering}

  suffixtable^[codefile]        := 'CODE';      {code file suffix}
  efttable^   [codefile]        := codefile_eft;{DCD Pascal code file}
						{no buffering}

  suffixtable^[sysfile]         := 'SYSTM';     {suffix for system file}
  efttable^   [sysfile]         := sysfile_eft; {DCD system (boot) file}
						{no buffering}

  suffixtable^[uxfile]          := 'UX';        {suffix for HP-UX data file}
  efttable^   [uxfile]          := uxfile_eft;  {All HP-UX regular files}
  amtable^    [uxfile]          := standardam;  {Upgraded for HPUX text files}
						{UXTEXT_AM may overwrite this}
end;

{ Added for SRM-UX support JWH 8/10/90 : }
{ moved to SRM_DRV 10/31/90 }

{ function is_srmux_unit(unum : unitnum) : boolean;
begin
  is_srmux_unit := srmux_on[unum];
end;

procedure init_srmux_array;
var i : integer;
begin
 for i := 1 to 50 do
   srmux_on[i] := false;
end; }


end  {miscellaneous stuff module}
@


54.1
log
@Automatic bump of revision number for PWS version 3.24
@
text
@d320 1
a320 1
var buf: shortint;
@


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.2
log
@Got the SRM/UX stuff outa here.
@
text
@@


50.1
log
@Automatic bump of revision number for PWS version 3.23c
@
text
@d81 1
d83 1
a83 1
  srmux_array = array[1..50] of boolean;
d89 2
a90 1
  srmux_on : srmux_array;  {SRM-UX support. JWH }
d101 3
a103 2
function is_srmux_unit(unum : unitnum) : boolean;
procedure init_srmux_array;
d701 1
d703 1
a703 1
function is_srmux_unit(unum : unitnum) : boolean;
d713 1
a713 1
end;
@


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


49.1
log
@Automatic bump of revision number for PWS version 3.24b
@
text
@d237 1
a237 1
    ord(isrmcatchall  ):  s := 'unrecognized SRM error';
d244 1
@


48.2
log
@Added some stuff for SRM-UX support. JWH.
@
text
@@


48.1
log
@Automatic bump of revision number for PWS version 3.24a
@
text
@d80 4
d88 1
d98 3
d694 14
@


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.2
log
@change made to support RPC in SRM-UX
added lastfid variable
RDQ 9 may 89

@
text
@@


36.1
log
@Automatic bump of revision number for PWS version 3.22
@
text
@d82 2
a119 1

@


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


14.2
log
@Fix enumerated types for hfs passwd commands (use hfs_login, etc.).
@
text
@@


14.1
log
@Automatic bump of revision number for PWS version 3.2G
@
text
@d71 4
a74 4
  h_setpasswd_command = (login, umask,
			open,
			chmod, chown, chgrp,
			chatime, chmtime);
@


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


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


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


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


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


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


8.1
log
@Automatic bump of revision number for PWS version 3.2A
@
text
@d425 1
d461 4
d472 1
a472 1
	    c := eol;
d489 1
a489 1
	if fbuffer[firstpos+i]=eol then
d635 1
a635 1
     if buffer[i] = eol then begin feoln := true; buffer[i] := ' '; end
d680 5
@


7.2
log
@Export (and use) datafile_eft, uxfile_eft, coodefile_eft,
and sysfile_eft.
@
text
@@


7.1
log
@Automatic bump of revision number for PWS version 3.2l
@
text
@d26 6
d664 1
a664 1
  efttable^   [datafile]        := -5622;       {DCD Pascal data file}
d669 1
a669 1
  efttable^   [codefile]        := -5582;       {DCD Pascal code file}
d673 1
a673 1
  efttable^   [sysfile]         := -5822;       {DCD system (boot) file}
@


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


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


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


3.1
log
@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.5
log
@Add messages for new ioresults.
@
text
@@


1.4
log
@chctime deleted from sub command set to HFS setpasswords
@
text
@d224 5
@


1.3
log
@definition of ushort now in GLOBALS
@
text
@d68 1
a68 1
			chatime, chmtime, chctime);
@


1.2
log
@new types for hfs setpasswords and catpasswords
@
text
@a57 1
  ushort = 0..65535;
@


1.1
log
@Initial revision
@
text
@d56 19
@
