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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

30.1
date     88.12.09.13.44.18;  author dew;  state Exp;
branches ;
next     29.2;

29.2
date     88.11.23.11.03.56;  author dew;  state Exp;
branches ;
next     29.1;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

2.1
date     86.07.30.14.36.15;  author hal;  state Exp;
branches ;
next     1.1;

1.1
date     86.06.30.14.38.43;  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, 1983.
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, stackcheck off, iocheck off$
$ALLOW_PACKED ON$ {JWS 3/31/87}

program UCSD_AM_INIT;

module UCSD_am;         {UCSD access method}

import sysglobals, asm, misc, sysdevs;

export
  procedure init_UCSD_am;

implement


(* ACCESS METHOD FOR UCSD TEXT FILES *)
{The assumption of this access method is that direct access will not happen}

procedure textam(fp: fibp;  request: amrequesttype;
			  anyvar buffer: window; buffsize, position: integer);
label 1, 2, 3, 4;
const pagesize = 2*fblksize;
var ptr: charptr;
    count, index: shortint;
    c: char;

   procedure initpage(position: integer);

   const   {FOR OPTIMIZATION FOR 3.1B BUGFIX LAF/SFB--5/15/85}
     z_arr_size = 64;
     iter_m1    = fblksize div z_arr_size - 1;
   type
     zero_array = array[0..z_arr_size-1] of char;
     zero_array_p = ^zero_array;
   const
     zeros = zero_array [z_arr_size of #0];

   var i: integer;
       start: integer;  {FOR OPTIMIZATION FOR 3.1B BUGFIX LAF/SFB--5/15/85}
       zero_p: zero_array_p;    {FOR 3.1B OPTIMIZATION}
   begin with fp^ do
    begin
    fpos := position + pagesize - position mod pagesize;
    if fpos > fleof then
      begin
      if fpos > fpeof then
	begin
	call(unitable^[funit].dam, fp^, funit, stretchit);
	if fpos > fpeof then begin ioresult := ord(ieof); goto 1; end;
	end;
      fleof := fpos; fmodified := true;
      end;
    fpos := position; index := fpos mod fblksize;
    if index = 0 then   {OPTIMIZATION FOR 3.1B BUGFIX LAF/SFB--5/15/85}
      begin     {DO "FAST INIT" OF FBUFFER TO 512 #0s LAF/SFB 5/15/85}
	zero_p := addr(zeros);
	start := 0;
	for i:=0 to iter_m1 do
	  begin
	    moveright(zero_p^,fbuffer[start],z_arr_size);
	    start := start + z_arr_size;
	  end;
      end
    else        {NORMAL "ANY SIZE" INIT TO #0s, AS IN 3.0}
      for i := index to fblksize-1 do fbuffer[i] := chr(0);
    fbufchanged := true;        flastpos := fpos;
    end;
   end;

   procedure putbuffer;
   label 2;
   const linesize = 256;
   var block, i, j, bytes: integer;
       save: packed array[0..linesize-1] of char;
   begin with fp^ do
      begin
      block := flastpos div fblksize;
      if odd(block) and (fbuffer[fblksize-1] <> chr(0)) then
	begin
	j := fblksize-2;
	while j >= fblksize-1-linesize do
	  if fbuffer[j] = eol then
	    begin
	    bytes := fblksize-1-j;
	    moveleft(fbuffer[j+1], save, bytes);
	    for i := j+1 to fblksize-1 do fbuffer[i] := chr(0);
	    goto 2;
	    end
	  else j := j - 1;
	bytes := 0;                   {give up, line too long to carry over}
	end
      else bytes := 0;
   2: call (unitable^[funit].tm, fp, writebytes,
					 fbuffer, fblksize, block*fblksize);
      if ioresult <> ord(inoerror) then goto 1;
      fpos := (block+1)*fblksize; index := 0;
      if bytes > 0 then
	begin
	initpage(fpos+bytes);
	moveleft(save, fbuffer, bytes);
	end
      else fbufchanged := false;
      if not odd(block) then    {3.1B BUGFIX--LAF/SFB  5/15/85}
	initpage(fpos);         {ALWAYS INIT SECOND HALF OF PAGE}
      end;
   end;

   procedure putenviron;
   begin
    if fp^.fleof < pagesize then
      begin
      initpage(0);          putbuffer;
      initpage(fblksize);   putbuffer;
      end;
   end;

   procedure putchar(c: char);
   begin with fp^ do
    begin
    if index = 0 then initpage(fpos);
    fbuffer[index] := c;
    fpos  := fpos + 1; index := index + 1;
    if index = fblksize then putbuffer;
    end;
   end;

   procedure flushindent;
   begin with fp^ do
     if freptcnt <> 0 then
       begin
       if      freptcnt = 1 then putchar(' ')
       else if freptcnt > 1 then
		begin putchar(chr(dle)); putchar(chr(freptcnt+ord(' '))); end;
       freptcnt := 0;
       end;
   end;

   procedure flushbuffer;
   var block: integer;
   begin
    with fp^ do
      begin
      fpos := flastpos;  index := fpos mod fblksize; flushindent;
      while fbufchanged do
	begin
	block := flastpos div fblksize;
	putbuffer;
	if not odd(block) then initpage((block+1)*fblksize);
	end;
      end;
   end;

   procedure endline;
   begin with fp^ do
     begin
     buffer[0] := chr(count); if count > 0 then feoln := false;
     flastpos := fpos;
     goto 1
     end;
   end;

   procedure getbuffer;
   begin with fp^ do
     begin
     flastpos := fpos;
     if (fpos + fblksize) > fleof then
       if request = readtoeol then endline
       else ioresult := ord(ieof)
     else call(unitable^[funit].tm, fp, readbytes, fbuffer, fblksize, fpos);
     if ioresult <> ord(inoerror) then goto 1;
     end;
   end;


begin   {TEXTAM}
 ioresult := ord(inoerror);     {3.0 BUG FIX--SFB 4/24/85}
 with fp^ do
 case request of
  flush:    begin
	    putenviron;
	    flushbuffer;
	    call(unitable^[funit].tm, fp, flush, buffer, buffsize, position);
	    end;
  writeeol: begin
	    c := eol;
	    textam(fp, writebytes, c, 1, position);
	    end;
  writebytes:
    begin
    fpos := position;   index := fpos mod fblksize;
    putenviron;
    ptr := addr(buffer);
    while buffsize > 0 do
      begin
      c := ptr^;        ptr := addr(ptr^, 1);
      buffsize := buffsize - 1;
      if c = ' ' then
	if freptcnt >= 0 then freptcnt := freptcnt + 1
	else goto 4
      else
	begin
	if freptcnt >= 0 then
	  begin
	  flushindent;
	  if c <> eol then freptcnt := -1;
	  end
	else if c = eol then freptcnt := 0;
     4: if index = 0 then initpage(fpos);    {MAY BE DONE AGAIN IN PUTBUFFER}
	fbuffer[index] := c;
	fpos  := fpos + 1; index := index + 1;
	if index = fblksize then putbuffer;
	end;
      end;
    flastpos := fpos;
    end; {writebytes}

  readtoeol,
  readbytes:
    begin
    ptr := addr(buffer); count := 0;
    if position = 0 then                        {reset has been done}
      begin
      flushbuffer;                              {if reset after writing}
      fpos := pagesize;   index := 0;
      fleof := fleof + (-fleof) mod pagesize;
      end
    else begin  fpos := position;   index := fpos mod fblksize; end;

    if request = readtoeol then
      begin
      ptr^ := chr(0);      ptr := addr(ptr^, 1);
      end;
    while buffsize > 0 do
      begin
   2: if freptcnt < -1 then
	   begin c := ' '; freptcnt := freptcnt + 1; feoln := false;
	   end
      else begin
	3: if index = 0 then getbuffer;
	   c := fbuffer[index];
	   if c = chr(0) then {end of page}
		   begin
		   fpos := fpos - fpos mod pagesize + pagesize;
		   index := 0; goto 3;
		   end;
	   fpos := fpos + 1; index := index + 1;
	   if index = fblksize then index := 0;
	   if c = chr(dle) then {space compression}
	     begin
	     if index = 0 then getbuffer;
	     c := fbuffer[index];
	     fpos := fpos + 1; index := index + 1;
	     if index = fblksize then index := 0;
	     freptcnt := 31 - ord(c);
	     goto 2;
	     end;
	   if c = eol then
	     if request = readtoeol then begin fpos := fpos - 1; endline; end
	     else begin feoln := true; c := ' '; end
	   else feoln := false;
	   end;
      ptr^ := c;                ptr := addr(ptr^, 1);
      count := count + 1;       buffsize := buffsize - 1;
      end;
    if request = readtoeol then endline;
    flastpos := fpos;
    end;  {readbytes}

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

procedure init_UCSD_am;
begin
  suffixtable^[textfile]        := 'TEXT';      {text file suffix}
  amtable^    [textfile]        := textam;      {UCSD text file format}
  efttable^   [textfile]        := -5570;       {DCD Pascal "UCSD TEXT" file}
end;

end;                    {UCSD text access method}


import UCSD_am, loader;

begin {program install UCSD AM}
 init_UCSD_am;
 markuser;  {DEW 11/23/88, Fix defect FSDdt01557}
end.


@


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


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

 (c) Copyright Hewlett-Packard Company, 1983.
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, stackcheck off, iocheck off$
$ALLOW_PACKED ON$ {JWS 3/31/87}

program UCSD_AM_INIT;

module UCSD_am;         {UCSD access method}

import sysglobals, asm, misc, sysdevs;

export
  procedure init_UCSD_am;

implement


(* ACCESS METHOD FOR UCSD TEXT FILES *)
{The assumption of this access method is that direct access will not happen}

procedure textam(fp: fibp;  request: amrequesttype;
			  anyvar buffer: window; buffsize, position: integer);
label 1, 2, 3, 4;
const pagesize = 2*fblksize;
var ptr: charptr;
    count, index: shortint;
    c: char;

   procedure initpage(position: integer);

   const   {FOR OPTIMIZATION FOR 3.1B BUGFIX LAF/SFB--5/15/85}
     z_arr_size = 64;
     iter_m1    = fblksize div z_arr_size - 1;
   type
     zero_array = array[0..z_arr_size-1] of char;
     zero_array_p = ^zero_array;
   const
     zeros = zero_array [z_arr_size of #0];

   var i: integer;
       start: integer;  {FOR OPTIMIZATION FOR 3.1B BUGFIX LAF/SFB--5/15/85}
       zero_p: zero_array_p;    {FOR 3.1B OPTIMIZATION}
   begin with fp^ do
    begin
    fpos := position + pagesize - position mod pagesize;
    if fpos > fleof then
      begin
      if fpos > fpeof then
	begin
	call(unitable^[funit].dam, fp^, funit, stretchit);
	if fpos > fpeof then begin ioresult := ord(ieof); goto 1; end;
	end;
      fleof := fpos; fmodified := true;
      end;
    fpos := position; index := fpos mod fblksize;
    if index = 0 then   {OPTIMIZATION FOR 3.1B BUGFIX LAF/SFB--5/15/85}
      begin     {DO "FAST INIT" OF FBUFFER TO 512 #0s LAF/SFB 5/15/85}
	zero_p := addr(zeros);
	start := 0;
	for i:=0 to iter_m1 do
	  begin
	    moveright(zero_p^,fbuffer[start],z_arr_size);
	    start := start + z_arr_size;
	  end;
      end
    else        {NORMAL "ANY SIZE" INIT TO #0s, AS IN 3.0}
      for i := index to fblksize-1 do fbuffer[i] := chr(0);
    fbufchanged := true;        flastpos := fpos;
    end;
   end;

   procedure putbuffer;
   label 2;
   const linesize = 256;
   var block, i, j, bytes: integer;
       save: packed array[0..linesize-1] of char;
   begin with fp^ do
      begin
      block := flastpos div fblksize;
      if odd(block) and (fbuffer[fblksize-1] <> chr(0)) then
	begin
	j := fblksize-2;
	while j >= fblksize-1-linesize do
	  if fbuffer[j] = eol then
	    begin
	    bytes := fblksize-1-j;
	    moveleft(fbuffer[j+1], save, bytes);
	    for i := j+1 to fblksize-1 do fbuffer[i] := chr(0);
	    goto 2;
	    end
	  else j := j - 1;
	bytes := 0;                   {give up, line too long to carry over}
	end
      else bytes := 0;
   2: call (unitable^[funit].tm, fp, writebytes,
					 fbuffer, fblksize, block*fblksize);
      if ioresult <> ord(inoerror) then goto 1;
      fpos := (block+1)*fblksize; index := 0;
      if bytes > 0 then
	begin
	initpage(fpos+bytes);
	moveleft(save, fbuffer, bytes);
	end
      else fbufchanged := false;
      if not odd(block) then    {3.1B BUGFIX--LAF/SFB  5/15/85}
	initpage(fpos);         {ALWAYS INIT SECOND HALF OF PAGE}
      end;
   end;

   procedure putenviron;
   begin
    if fp^.fleof < pagesize then
      begin
      initpage(0);          putbuffer;
      initpage(fblksize);   putbuffer;
      end;
   end;

   procedure putchar(c: char);
   begin with fp^ do
    begin
    if index = 0 then initpage(fpos);
    fbuffer[index] := c;
    fpos  := fpos + 1; index := index + 1;
    if index = fblksize then putbuffer;
    end;
   end;

   procedure flushindent;
   begin with fp^ do
     if freptcnt <> 0 then
       begin
       if      freptcnt = 1 then putchar(' ')
       else if freptcnt > 1 then
		begin putchar(chr(dle)); putchar(chr(freptcnt+ord(' '))); end;
       freptcnt := 0;
       end;
   end;

   procedure flushbuffer;
   var block: integer;
   begin
    with fp^ do
      begin
      fpos := flastpos;  index := fpos mod fblksize; flushindent;
      while fbufchanged do
	begin
	block := flastpos div fblksize;
	putbuffer;
	if not odd(block) then initpage((block+1)*fblksize);
	end;
      end;
   end;

   procedure endline;
   begin with fp^ do
     begin
     buffer[0] := chr(count); if count > 0 then feoln := false;
     flastpos := fpos;
     goto 1
     end;
   end;

   procedure getbuffer;
   begin with fp^ do
     begin
     flastpos := fpos;
     if (fpos + fblksize) > fleof then
       if request = readtoeol then endline
       else ioresult := ord(ieof)
     else call(unitable^[funit].tm, fp, readbytes, fbuffer, fblksize, fpos);
     if ioresult <> ord(inoerror) then goto 1;
     end;
   end;


begin   {TEXTAM}
 ioresult := ord(inoerror);     {3.0 BUG FIX--SFB 4/24/85}
 with fp^ do
 case request of
  flush:    begin
	    putenviron;
	    flushbuffer;
	    call(unitable^[funit].tm, fp, flush, buffer, buffsize, position);
	    end;
  writeeol: begin
	    c := eol;
	    textam(fp, writebytes, c, 1, position);
	    end;
  writebytes:
    begin
    fpos := position;   index := fpos mod fblksize;
    putenviron;
    ptr := addr(buffer);
    while buffsize > 0 do
      begin
      c := ptr^;        ptr := addr(ptr^, 1);
      buffsize := buffsize - 1;
      if c = ' ' then
	if freptcnt >= 0 then freptcnt := freptcnt + 1
	else goto 4
      else
	begin
	if freptcnt >= 0 then
	  begin
	  flushindent;
	  if c <> eol then freptcnt := -1;
	  end
	else if c = eol then freptcnt := 0;
     4: if index = 0 then initpage(fpos);    {MAY BE DONE AGAIN IN PUTBUFFER}
	fbuffer[index] := c;
	fpos  := fpos + 1; index := index + 1;
	if index = fblksize then putbuffer;
	end;
      end;
    flastpos := fpos;
    end; {writebytes}

  readtoeol,
  readbytes:
    begin
    ptr := addr(buffer); count := 0;
    if position = 0 then                        {reset has been done}
      begin
      flushbuffer;                              {if reset after writing}
      fpos := pagesize;   index := 0;
      fleof := fleof + (-fleof) mod pagesize;
      end
    else begin  fpos := position;   index := fpos mod fblksize; end;

    if request = readtoeol then
      begin
      ptr^ := chr(0);      ptr := addr(ptr^, 1);
      end;
    while buffsize > 0 do
      begin
   2: if freptcnt < -1 then
	   begin c := ' '; freptcnt := freptcnt + 1; feoln := false;
	   end
      else begin
	3: if index = 0 then getbuffer;
	   c := fbuffer[index];
	   if c = chr(0) then {end of page}
		   begin
		   fpos := fpos - fpos mod pagesize + pagesize;
		   index := 0; goto 3;
		   end;
	   fpos := fpos + 1; index := index + 1;
	   if index = fblksize then index := 0;
	   if c = chr(dle) then {space compression}
	     begin
	     if index = 0 then getbuffer;
	     c := fbuffer[index];
	     fpos := fpos + 1; index := index + 1;
	     if index = fblksize then index := 0;
	     freptcnt := 31 - ord(c);
	     goto 2;
	     end;
	   if c = eol then
	     if request = readtoeol then begin fpos := fpos - 1; endline; end
	     else begin feoln := true; c := ' '; end
	   else feoln := false;
	   end;
      ptr^ := c;                ptr := addr(ptr^, 1);
      count := count + 1;       buffsize := buffsize - 1;
      end;
    if request = readtoeol then endline;
    flastpos := fpos;
    end;  {readbytes}

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

procedure init_UCSD_am;
begin
  suffixtable^[textfile]        := 'TEXT';      {text file suffix}
  amtable^    [textfile]        := textam;      {UCSD text file format}
  efttable^   [textfile]        := -5570;       {DCD Pascal "UCSD TEXT" file}
end;

end;                    {UCSD text access method}


import UCSD_am, loader;

begin {program install UCSD AM}
 init_UCSD_am;
 markuser;  {DEW 11/23/88, Fix defect FSDdt01557}
end.


@


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 313
@


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

 (c) Copyright Hewlett-Packard Company, 1983.
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, stackcheck off, iocheck off$
$ALLOW_PACKED ON$ {JWS 3/31/87}

program UCSD_AM_INIT;

module UCSD_am;         {UCSD access method}

import sysglobals, asm, misc, sysdevs;

export
  procedure init_UCSD_am;

implement


(* ACCESS METHOD FOR UCSD TEXT FILES *)
{The assumption of this access method is that direct access will not happen}

procedure textam(fp: fibp;  request: amrequesttype;
			  anyvar buffer: window; buffsize, position: integer);
label 1, 2, 3, 4;
const pagesize = 2*fblksize;
var ptr: charptr;
    count, index: shortint;
    c: char;

   procedure initpage(position: integer);

   const   {FOR OPTIMIZATION FOR 3.1B BUGFIX LAF/SFB--5/15/85}
     z_arr_size = 64;
     iter_m1    = fblksize div z_arr_size - 1;
   type
     zero_array = array[0..z_arr_size-1] of char;
     zero_array_p = ^zero_array;
   const
     zeros = zero_array [z_arr_size of #0];

   var i: integer;
       start: integer;  {FOR OPTIMIZATION FOR 3.1B BUGFIX LAF/SFB--5/15/85}
       zero_p: zero_array_p;    {FOR 3.1B OPTIMIZATION}
   begin with fp^ do
    begin
    fpos := position + pagesize - position mod pagesize;
    if fpos > fleof then
      begin
      if fpos > fpeof then
	begin
	call(unitable^[funit].dam, fp^, funit, stretchit);
	if fpos > fpeof then begin ioresult := ord(ieof); goto 1; end;
	end;
      fleof := fpos; fmodified := true;
      end;
    fpos := position; index := fpos mod fblksize;
    if index = 0 then   {OPTIMIZATION FOR 3.1B BUGFIX LAF/SFB--5/15/85}
      begin     {DO "FAST INIT" OF FBUFFER TO 512 #0s LAF/SFB 5/15/85}
	zero_p := addr(zeros);
	start := 0;
	for i:=0 to iter_m1 do
	  begin
	    moveright(zero_p^,fbuffer[start],z_arr_size);
	    start := start + z_arr_size;
	  end;
      end
    else        {NORMAL "ANY SIZE" INIT TO #0s, AS IN 3.0}
      for i := index to fblksize-1 do fbuffer[i] := chr(0);
    fbufchanged := true;        flastpos := fpos;
    end;
   end;

   procedure putbuffer;
   label 2;
   const linesize = 256;
   var block, i, j, bytes: integer;
       save: packed array[0..linesize-1] of char;
   begin with fp^ do
      begin
      block := flastpos div fblksize;
      if odd(block) and (fbuffer[fblksize-1] <> chr(0)) then
	begin
	j := fblksize-2;
	while j >= fblksize-1-linesize do
	  if fbuffer[j] = eol then
	    begin
	    bytes := fblksize-1-j;
	    moveleft(fbuffer[j+1], save, bytes);
	    for i := j+1 to fblksize-1 do fbuffer[i] := chr(0);
	    goto 2;
	    end
	  else j := j - 1;
	bytes := 0;                   {give up, line too long to carry over}
	end
      else bytes := 0;
   2: call (unitable^[funit].tm, fp, writebytes,
					 fbuffer, fblksize, block*fblksize);
      if ioresult <> ord(inoerror) then goto 1;
      fpos := (block+1)*fblksize; index := 0;
      if bytes > 0 then
	begin
	initpage(fpos+bytes);
	moveleft(save, fbuffer, bytes);
	end
      else fbufchanged := false;
      if not odd(block) then    {3.1B BUGFIX--LAF/SFB  5/15/85}
	initpage(fpos);         {ALWAYS INIT SECOND HALF OF PAGE}
      end;
   end;

   procedure putenviron;
   begin
    if fp^.fleof < pagesize then
      begin
      initpage(0);          putbuffer;
      initpage(fblksize);   putbuffer;
      end;
   end;

   procedure putchar(c: char);
   begin with fp^ do
    begin
    if index = 0 then initpage(fpos);
    fbuffer[index] := c;
    fpos  := fpos + 1; index := index + 1;
    if index = fblksize then putbuffer;
    end;
   end;

   procedure flushindent;
   begin with fp^ do
     if freptcnt <> 0 then
       begin
       if      freptcnt = 1 then putchar(' ')
       else if freptcnt > 1 then
		begin putchar(chr(dle)); putchar(chr(freptcnt+ord(' '))); end;
       freptcnt := 0;
       end;
   end;

   procedure flushbuffer;
   var block: integer;
   begin
    with fp^ do
      begin
      fpos := flastpos;  index := fpos mod fblksize; flushindent;
      while fbufchanged do
	begin
	block := flastpos div fblksize;
	putbuffer;
	if not odd(block) then initpage((block+1)*fblksize);
	end;
      end;
   end;

   procedure endline;
   begin with fp^ do
     begin
     buffer[0] := chr(count); if count > 0 then feoln := false;
     flastpos := fpos;
     goto 1
     end;
   end;

   procedure getbuffer;
   begin with fp^ do
     begin
     flastpos := fpos;
     if (fpos + fblksize) > fleof then
       if request = readtoeol then endline
       else ioresult := ord(ieof)
     else call(unitable^[funit].tm, fp, readbytes, fbuffer, fblksize, fpos);
     if ioresult <> ord(inoerror) then goto 1;
     end;
   end;


begin   {TEXTAM}
 ioresult := ord(inoerror);     {3.0 BUG FIX--SFB 4/24/85}
 with fp^ do
 case request of
  flush:    begin
	    putenviron;
	    flushbuffer;
	    call(unitable^[funit].tm, fp, flush, buffer, buffsize, position);
	    end;
  writeeol: begin
	    c := eol;
	    textam(fp, writebytes, c, 1, position);
	    end;
  writebytes:
    begin
    fpos := position;   index := fpos mod fblksize;
    putenviron;
    ptr := addr(buffer);
    while buffsize > 0 do
      begin
      c := ptr^;        ptr := addr(ptr^, 1);
      buffsize := buffsize - 1;
      if c = ' ' then
	if freptcnt >= 0 then freptcnt := freptcnt + 1
	else goto 4
      else
	begin
	if freptcnt >= 0 then
	  begin
	  flushindent;
	  if c <> eol then freptcnt := -1;
	  end
	else if c = eol then freptcnt := 0;
     4: if index = 0 then initpage(fpos);    {MAY BE DONE AGAIN IN PUTBUFFER}
	fbuffer[index] := c;
	fpos  := fpos + 1; index := index + 1;
	if index = fblksize then putbuffer;
	end;
      end;
    flastpos := fpos;
    end; {writebytes}

  readtoeol,
  readbytes:
    begin
    ptr := addr(buffer); count := 0;
    if position = 0 then                        {reset has been done}
      begin
      flushbuffer;                              {if reset after writing}
      fpos := pagesize;   index := 0;
      fleof := fleof + (-fleof) mod pagesize;
      end
    else begin  fpos := position;   index := fpos mod fblksize; end;

    if request = readtoeol then
      begin
      ptr^ := chr(0);      ptr := addr(ptr^, 1);
      end;
    while buffsize > 0 do
      begin
   2: if freptcnt < -1 then
	   begin c := ' '; freptcnt := freptcnt + 1; feoln := false;
	   end
      else begin
	3: if index = 0 then getbuffer;
	   c := fbuffer[index];
	   if c = chr(0) then {end of page}
		   begin
		   fpos := fpos - fpos mod pagesize + pagesize;
		   index := 0; goto 3;
		   end;
	   fpos := fpos + 1; index := index + 1;
	   if index = fblksize then index := 0;
	   if c = chr(dle) then {space compression}
	     begin
	     if index = 0 then getbuffer;
	     c := fbuffer[index];
	     fpos := fpos + 1; index := index + 1;
	     if index = fblksize then index := 0;
	     freptcnt := 31 - ord(c);
	     goto 2;
	     end;
	   if c = eol then
	     if request = readtoeol then begin fpos := fpos - 1; endline; end
	     else begin feoln := true; c := ' '; end
	   else feoln := false;
	   end;
      ptr^ := c;                ptr := addr(ptr^, 1);
      count := count + 1;       buffsize := buffsize - 1;
      end;
    if request = readtoeol then endline;
    flastpos := fpos;
    end;  {readbytes}

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

procedure init_UCSD_am;
begin
  suffixtable^[textfile]        := 'TEXT';      {text file suffix}
  amtable^    [textfile]        := textam;      {UCSD text file format}
  efttable^   [textfile]        := -5570;       {DCD Pascal "UCSD TEXT" file}
end;

end;                    {UCSD text access method}


import UCSD_am, loader;

begin {program install UCSD AM}
 init_UCSD_am;
 markuser;  {DEW 11/23/88, Fix defect FSDdt01557}
end.


@


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.2
log
@Fix of defect #FSDdt01557.  DEW 11/23/88.
Problem:
	UCSD_AM does not pload it self when first ran.
	This can cause system crash if no files in
	INITLIB do not markuser or if it is run individually
	after PWS has booted.

It has been working because:
	1) other files in INITLIB markuser, and
	2) UCSD_AM does not acquire memory from the heap.
	3) apparently, no one has ever ran UCSD_AM individually
	   after a boot.
@
text
@@


29.1
log
@Automatic bump of revision number for PWS version 3.22b
@
text
@d306 1
a306 1
import UCSD_am;
d310 1
@


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.1
log
@Automatic bump of revision number for PWS version 3.2G
@
text
@@


13.2
log
@Pws2unix automatic delta on Wed Apr  1 08:30:27 MST 1987
@
text
@@


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


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


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


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


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


8.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.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.1
log
@Initial revision
@
text
@@
