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


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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

1.1
date     86.06.30.14.18.14;  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
@$SYSPROG$ $DEBUG OFF, RANGE OFF, OVFLCHECK OFF, STACKCHECK OFF$
$ALLOW_PACKED ON$ {JWS 3/31/87}
program installascii;
module asciimodule;
import sysglobals, asm;
export
  procedure asciiam(fp : fibp; request: amrequesttype;
		    anyvar buffer:window; bufsize,position:integer);
implement
const
  buflength = fblksize;
  sectorsize= 256;

procedure asciiam(fp: fibp; request: amrequesttype;
		  anyvar buffer: window; bufsize,position: integer);
var
  bufend : integer;

  procedure bufparams;
  begin
    with fp^ do
    if (flastpos+buflength)>fpeof then bufend := fpeof
				  else bufend := flastpos + buflength;
  end;

  procedure rendfile;
  begin
    if request<>readtoeol then ioresult := ord(ieof);
    fp^.fpos := fp^.fleof;        { fix fpos }
    escape(0);
  end;

  procedure flushbuffer;
  begin
    ioresult := 0;
    with fp^, unitable^[funit] do
    begin     { write out the buffer }
      call(tm,fp,WRITEBYTES,fbuffer,bufend-flastpos,flastpos);
      if ioresult<>0 then escape(0);
      fbufchanged := false;
    end;
  end;

  procedure loadbuffer(posit: integer);
  begin
    ioresult:=0;
    with fp^, unitable^[funit]  do
    begin
      if fbufchanged then flushbuffer;
      flastpos := (posit div sectorsize) * sectorsize; bufparams;
      call(tm,fp,READBYTES,fbuffer,bufend-flastpos,flastpos);
      if ioresult<>0 then escape(0);
    end;
  end;

  procedure seekposit(posit: integer);
  begin
    with fp^ do
    begin
      if (posit<flastpos) or (posit>=bufend) then loadbuffer(posit);
      fpos:=posit;
    end;
  end;

  procedure wendbuffer;
  begin { append access only }
    with fp^ do
    begin
	{ write all but last sector }
      fbufchanged := true;
      if (bufend-flastpos)>sectorsize then
      begin
	bufend := bufend - sectorsize;
	flushbuffer;
	moveleft(fbuffer[bufend-flastpos],fbuffer[0],sectorsize);
      end
      else flushbuffer;
      fleof := fpos + 1;            fmodified := true;
      if fleof>fpeof then
      begin   { move the physical end of file }
	fpos := ((fleof + 256) div 256) * 256;
	call(unitable^[funit].dam,fp^,funit,STRETCHIT);
	if fleof>fpeof then begin ioresult := ord(ieof); escape(0); end;
	fpos := fleof - 1;
      end;
      flastpos := bufend; bufparams;
    end;
  end;

  procedure wnextbyte(c:char);
  begin { append access only }
    with fp^ do
    begin
      if fpos>=bufend then wendbuffer;
      fbuffer[fpos - flastpos] := c;     fbufchanged := true;
      fpos := fpos + 1;  fleof := fpos;  fmodified   := true;
    end;
  end;      { wnextbyte }

  procedure writeendline;
  var
    tposit, j : integer;
    tbufchanged : boolean; {added for 3.1 BUGFIX DTS #181 SFB--6/4/85}
  begin
    with fp^ do
    begin
      if freptcnt=0 then
      begin     { zero length record }
	if odd(fpos) then wnextbyte(' ');
	wnextbyte(chr(0)); wnextbyte(chr(0));
      end
      else
      begin     { have some data }
	tbufchanged := fbufchanged; {3.1 BUGFIX #081 SFB--6/4/85}
	tposit := fpos; j := tposit - freptcnt - 2;
		{ rewrite the record size }
	if j<flastpos then loadbuffer(j);
	fbuffer[j - flastpos] := chr(freptcnt div 256);
	fbuffer[(j+1) - flastpos] := chr(freptcnt mod 256);
	fbufchanged := true;

	if tposit>=bufend then loadbuffer(tposit);
	fpos := tposit;   freptcnt := 0;
	if tbufchanged  then fbufchanged := true; {3.1 BUGFIX #181 SFB-6/4/85}
      end;
    end;
  end; { writeendline }

  procedure wendfile;
  begin
    with fp^ do
    begin
      if freptcnt>0 then writeendline;
      { write logical end of file marker }
      if odd(fpos) then  wnextbyte(' '); { pad to even position }
      if fleof<fpeof then
      begin
	wnextbyte(chr(255)); wnextbyte(chr(255));
      end;
      if fbufchanged then flushbuffer;
      call(unitable^[funit].tm,fp,flush,ioresult,0,0);
    end;
  end;

  function min(v1,v2,v3:integer):integer;
  begin
    if v1<v2 then
    begin       { v1 or v3 }
      if v1<v3 then min := v1 else min := v3;
    end
    else        { v2 or v3 }
    begin
      if v2<v3 then min := v2 else min := v3;
    end;
  end;

  function rnextbyte:char;
  begin
    with fp^ do
    begin
      if fpos>=fleof then rendfile;
      if (fpos>=bufend) then loadbuffer(fpos);
      rnextbyte := fbuffer[fpos - flastpos];
      fpos      := fpos + 1;
    end;
  end;

  procedure getrecsize;
  begin
    with fp^ do
    begin
      if odd(fpos) then freptcnt := ord(rnextbyte);
      freptcnt := ord(rnextbyte);
      if freptcnt>127 then rendfile;
      freptcnt := (freptcnt * 256) + ord(rnextbyte);
    end;
  end;

  procedure readchars;
  var
    count, i     : integer;
  begin       { readchars }
    with fp^ do
    begin
      i:=0;
      if bufsize=1 then
      begin   { single character read }
	if freptcnt=0 then
	begin buffer[0] := ' '; freptcnt := -1; end
	else
	begin buffer[0] := rnextbyte; freptcnt := freptcnt - 1; end;
      end
      else    { multi character read }
      while i<bufsize do
      begin
	if freptcnt=0 then
	begin   { end of record }
	  buffer[i] := ' ';   i := i + 1;
	  if i<bufsize then getrecsize
		       else freptcnt := -1;
	end
	else
	begin   { move data bytes }
	  if fpos>=fleof then rendfile
			 else seekposit(fpos);
	  count := min(bufsize-i, bufend-fpos, freptcnt);
	  moveleft(fbuffer[fpos-flastpos],buffer[i],count);
	  i := i + count; freptcnt := freptcnt - count; fpos := fpos + count;
	end;
      end;      { while }
      feoln := (freptcnt<0);
      if not feoln then fpos := -fpos;
    end;
  end;        { readchars }

  procedure readstring;
  var   i, count : integer;
  begin
    i := 0;
    with fp^ do
    begin
      if freptcnt>0 then
      while i<bufsize do
      begin      { read data bytes }
	if fpos>=fleof then rendfile    else seekposit(fpos);
	count := min(bufsize-i, bufend-fpos, freptcnt);
	moveleft(fbuffer[fpos-flastpos],buffer[i+1],count);
	freptcnt := freptcnt - count; i := i + count; fpos := fpos + count;
	buffer[0] := chr(i);
	if freptcnt=0 then i := bufsize
      end;
      fpos := -fpos;
    end;
  end;

  procedure writechars;
  var
    i, count  : integer;

  begin       { writechars }
    with fp^ do
    begin
      if (freptcnt = 0) and (bufsize>0) then
      begin         { start a new record }
	if odd(fpos) then wnextbyte(' ');       { pad to even size }
	wnextbyte(chr(255)); wnextbyte(chr(255)); { dummy count field }
      end;
      i:=0;
      while i<bufsize do
      begin         { write data character(s) }
	if fpos>=bufend then wendbuffer;
	count := min(bufsize-i, bufend-fpos, 32767-freptcnt);
	if count<=0 then { too many characters for the record }
	  begin ioresult := ord(ibadformat); escape(0); end;
	moveleft(buffer[i],fbuffer[fpos-flastpos],count);
	fpos := fpos + count; freptcnt := freptcnt + count; i := i + count;
	fbufchanged := true;
      end;    { while }
      fleof := fpos;
    end;      { with }
  end;        { write chars }

  begin { asciiam }
    ioresult:=0;
    try
      with fp^ do
      begin
	if flastpos<0 then      { force buffer load }
	  begin flastpos := -buflength; fbufchanged := false; end;
	bufparams;  fpos := abs(position);
	case request of
	  readbytes, readtoeol:
	    begin
	      if request=readtoeol then buffer[0] := chr(0);
	      if fbufchanged then
	      begin     { close last record }
		fpos := fleof; wendfile;
		fpos := abs(position);  { restore fpos }
	      end;
	      if position<0 then
	      begin     { seqential read }
		if request=readbytes then readchars
				     else readstring;
	      end       { seqential read }
	      else
	      begin     { positioned read }
		if position>fp^.fleof then rendfile
				      else seekposit(position);
		getrecsize;
		if request=readbytes then readchars
				     else readstring;
	      end;      { positioned read }
	    end;
	  writebytes:
	    begin
	      if position<>0 then writechars    { normal write }
	      else
	      begin       { rewrite }
		flastpos := 0; bufparams; freptcnt := 0; writechars;
	      end;
	    end;
	  flush: if fbufchanged then
		   begin fpos := fleof; wendfile; end;
	  writeeol:     { end the line }
	    begin
	      if position<>0 then writeendline
	      else
	      begin     { zero length record at start of file }
		flastpos := 0; bufparams; freptcnt := 0;
		wnextbyte(chr(0)); wnextbyte(chr(0));
	      end;
	    end;
	  otherwise ioresult := ord(ibadrequest);
	end;    { case }
      end;      { with }
    recover
      if escapecode<0 then escape(escapecode);
  end;  { asciiam }
end;    { ascii module }

import asciimodule,sysglobals,loader;
begin   { installascii }
  amtable^[ASCIIFILE]     := asciiam;
  suffixtable^[ASCIIFILE] := 'ASC';
  efttable^[ASCIIFILE]    := 1;
  markuser;
end. { rev 16 A }
@


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


56.1
log
@Automatic bump of revision number for PWS version 3.25
@
text
@a0 327
$SYSPROG$ $DEBUG OFF, RANGE OFF, OVFLCHECK OFF, STACKCHECK OFF$
$ALLOW_PACKED ON$ {JWS 3/31/87}
program installascii;
module asciimodule;
import sysglobals, asm;
export
  procedure asciiam(fp : fibp; request: amrequesttype;
		    anyvar buffer:window; bufsize,position:integer);
implement
const
  buflength = fblksize;
  sectorsize= 256;

procedure asciiam(fp: fibp; request: amrequesttype;
		  anyvar buffer: window; bufsize,position: integer);
var
  bufend : integer;

  procedure bufparams;
  begin
    with fp^ do
    if (flastpos+buflength)>fpeof then bufend := fpeof
				  else bufend := flastpos + buflength;
  end;

  procedure rendfile;
  begin
    if request<>readtoeol then ioresult := ord(ieof);
    fp^.fpos := fp^.fleof;        { fix fpos }
    escape(0);
  end;

  procedure flushbuffer;
  begin
    ioresult := 0;
    with fp^, unitable^[funit] do
    begin     { write out the buffer }
      call(tm,fp,WRITEBYTES,fbuffer,bufend-flastpos,flastpos);
      if ioresult<>0 then escape(0);
      fbufchanged := false;
    end;
  end;

  procedure loadbuffer(posit: integer);
  begin
    ioresult:=0;
    with fp^, unitable^[funit]  do
    begin
      if fbufchanged then flushbuffer;
      flastpos := (posit div sectorsize) * sectorsize; bufparams;
      call(tm,fp,READBYTES,fbuffer,bufend-flastpos,flastpos);
      if ioresult<>0 then escape(0);
    end;
  end;

  procedure seekposit(posit: integer);
  begin
    with fp^ do
    begin
      if (posit<flastpos) or (posit>=bufend) then loadbuffer(posit);
      fpos:=posit;
    end;
  end;

  procedure wendbuffer;
  begin { append access only }
    with fp^ do
    begin
	{ write all but last sector }
      fbufchanged := true;
      if (bufend-flastpos)>sectorsize then
      begin
	bufend := bufend - sectorsize;
	flushbuffer;
	moveleft(fbuffer[bufend-flastpos],fbuffer[0],sectorsize);
      end
      else flushbuffer;
      fleof := fpos + 1;            fmodified := true;
      if fleof>fpeof then
      begin   { move the physical end of file }
	fpos := ((fleof + 256) div 256) * 256;
	call(unitable^[funit].dam,fp^,funit,STRETCHIT);
	if fleof>fpeof then begin ioresult := ord(ieof); escape(0); end;
	fpos := fleof - 1;
      end;
      flastpos := bufend; bufparams;
    end;
  end;

  procedure wnextbyte(c:char);
  begin { append access only }
    with fp^ do
    begin
      if fpos>=bufend then wendbuffer;
      fbuffer[fpos - flastpos] := c;     fbufchanged := true;
      fpos := fpos + 1;  fleof := fpos;  fmodified   := true;
    end;
  end;      { wnextbyte }

  procedure writeendline;
  var
    tposit, j : integer;
    tbufchanged : boolean; {added for 3.1 BUGFIX DTS #181 SFB--6/4/85}
  begin
    with fp^ do
    begin
      if freptcnt=0 then
      begin     { zero length record }
	if odd(fpos) then wnextbyte(' ');
	wnextbyte(chr(0)); wnextbyte(chr(0));
      end
      else
      begin     { have some data }
	tbufchanged := fbufchanged; {3.1 BUGFIX #081 SFB--6/4/85}
	tposit := fpos; j := tposit - freptcnt - 2;
		{ rewrite the record size }
	if j<flastpos then loadbuffer(j);
	fbuffer[j - flastpos] := chr(freptcnt div 256);
	fbuffer[(j+1) - flastpos] := chr(freptcnt mod 256);
	fbufchanged := true;

	if tposit>=bufend then loadbuffer(tposit);
	fpos := tposit;   freptcnt := 0;
	if tbufchanged  then fbufchanged := true; {3.1 BUGFIX #181 SFB-6/4/85}
      end;
    end;
  end; { writeendline }

  procedure wendfile;
  begin
    with fp^ do
    begin
      if freptcnt>0 then writeendline;
      { write logical end of file marker }
      if odd(fpos) then  wnextbyte(' '); { pad to even position }
      if fleof<fpeof then
      begin
	wnextbyte(chr(255)); wnextbyte(chr(255));
      end;
      if fbufchanged then flushbuffer;
      call(unitable^[funit].tm,fp,flush,ioresult,0,0);
    end;
  end;

  function min(v1,v2,v3:integer):integer;
  begin
    if v1<v2 then
    begin       { v1 or v3 }
      if v1<v3 then min := v1 else min := v3;
    end
    else        { v2 or v3 }
    begin
      if v2<v3 then min := v2 else min := v3;
    end;
  end;

  function rnextbyte:char;
  begin
    with fp^ do
    begin
      if fpos>=fleof then rendfile;
      if (fpos>=bufend) then loadbuffer(fpos);
      rnextbyte := fbuffer[fpos - flastpos];
      fpos      := fpos + 1;
    end;
  end;

  procedure getrecsize;
  begin
    with fp^ do
    begin
      if odd(fpos) then freptcnt := ord(rnextbyte);
      freptcnt := ord(rnextbyte);
      if freptcnt>127 then rendfile;
      freptcnt := (freptcnt * 256) + ord(rnextbyte);
    end;
  end;

  procedure readchars;
  var
    count, i     : integer;
  begin       { readchars }
    with fp^ do
    begin
      i:=0;
      if bufsize=1 then
      begin   { single character read }
	if freptcnt=0 then
	begin buffer[0] := ' '; freptcnt := -1; end
	else
	begin buffer[0] := rnextbyte; freptcnt := freptcnt - 1; end;
      end
      else    { multi character read }
      while i<bufsize do
      begin
	if freptcnt=0 then
	begin   { end of record }
	  buffer[i] := ' ';   i := i + 1;
	  if i<bufsize then getrecsize
		       else freptcnt := -1;
	end
	else
	begin   { move data bytes }
	  if fpos>=fleof then rendfile
			 else seekposit(fpos);
	  count := min(bufsize-i, bufend-fpos, freptcnt);
	  moveleft(fbuffer[fpos-flastpos],buffer[i],count);
	  i := i + count; freptcnt := freptcnt - count; fpos := fpos + count;
	end;
      end;      { while }
      feoln := (freptcnt<0);
      if not feoln then fpos := -fpos;
    end;
  end;        { readchars }

  procedure readstring;
  var   i, count : integer;
  begin
    i := 0;
    with fp^ do
    begin
      if freptcnt>0 then
      while i<bufsize do
      begin      { read data bytes }
	if fpos>=fleof then rendfile    else seekposit(fpos);
	count := min(bufsize-i, bufend-fpos, freptcnt);
	moveleft(fbuffer[fpos-flastpos],buffer[i+1],count);
	freptcnt := freptcnt - count; i := i + count; fpos := fpos + count;
	buffer[0] := chr(i);
	if freptcnt=0 then i := bufsize
      end;
      fpos := -fpos;
    end;
  end;

  procedure writechars;
  var
    i, count  : integer;

  begin       { writechars }
    with fp^ do
    begin
      if (freptcnt = 0) and (bufsize>0) then
      begin         { start a new record }
	if odd(fpos) then wnextbyte(' ');       { pad to even size }
	wnextbyte(chr(255)); wnextbyte(chr(255)); { dummy count field }
      end;
      i:=0;
      while i<bufsize do
      begin         { write data character(s) }
	if fpos>=bufend then wendbuffer;
	count := min(bufsize-i, bufend-fpos, 32767-freptcnt);
	if count<=0 then { too many characters for the record }
	  begin ioresult := ord(ibadformat); escape(0); end;
	moveleft(buffer[i],fbuffer[fpos-flastpos],count);
	fpos := fpos + count; freptcnt := freptcnt + count; i := i + count;
	fbufchanged := true;
      end;    { while }
      fleof := fpos;
    end;      { with }
  end;        { write chars }

  begin { asciiam }
    ioresult:=0;
    try
      with fp^ do
      begin
	if flastpos<0 then      { force buffer load }
	  begin flastpos := -buflength; fbufchanged := false; end;
	bufparams;  fpos := abs(position);
	case request of
	  readbytes, readtoeol:
	    begin
	      if request=readtoeol then buffer[0] := chr(0);
	      if fbufchanged then
	      begin     { close last record }
		fpos := fleof; wendfile;
		fpos := abs(position);  { restore fpos }
	      end;
	      if position<0 then
	      begin     { seqential read }
		if request=readbytes then readchars
				     else readstring;
	      end       { seqential read }
	      else
	      begin     { positioned read }
		if position>fp^.fleof then rendfile
				      else seekposit(position);
		getrecsize;
		if request=readbytes then readchars
				     else readstring;
	      end;      { positioned read }
	    end;
	  writebytes:
	    begin
	      if position<>0 then writechars    { normal write }
	      else
	      begin       { rewrite }
		flastpos := 0; bufparams; freptcnt := 0; writechars;
	      end;
	    end;
	  flush: if fbufchanged then
		   begin fpos := fleof; wendfile; end;
	  writeeol:     { end the line }
	    begin
	      if position<>0 then writeendline
	      else
	      begin     { zero length record at start of file }
		flastpos := 0; bufparams; freptcnt := 0;
		wnextbyte(chr(0)); wnextbyte(chr(0));
	      end;
	    end;
	  otherwise ioresult := ord(ibadrequest);
	end;    { case }
      end;      { with }
    recover
      if escapecode<0 then escape(escapecode);
  end;  { asciiam }
end;    { ascii module }

import asciimodule,sysglobals,loader;
begin   { installascii }
  amtable^[ASCIIFILE]     := asciiam;
  suffixtable^[ASCIIFILE] := 'ASC';
  efttable^[ASCIIFILE]    := 1;
  markuser;
end. { rev 16 A }
@


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


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


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


54.1
log
@Automatic bump of revision number for PWS version 3.24
@
text
@a0 327
$SYSPROG$ $DEBUG OFF, RANGE OFF, OVFLCHECK OFF, STACKCHECK OFF$
$ALLOW_PACKED ON$ {JWS 3/31/87}
program installascii;
module asciimodule;
import sysglobals, asm;
export
  procedure asciiam(fp : fibp; request: amrequesttype;
		    anyvar buffer:window; bufsize,position:integer);
implement
const
  buflength = fblksize;
  sectorsize= 256;

procedure asciiam(fp: fibp; request: amrequesttype;
		  anyvar buffer: window; bufsize,position: integer);
var
  bufend : integer;

  procedure bufparams;
  begin
    with fp^ do
    if (flastpos+buflength)>fpeof then bufend := fpeof
				  else bufend := flastpos + buflength;
  end;

  procedure rendfile;
  begin
    if request<>readtoeol then ioresult := ord(ieof);
    fp^.fpos := fp^.fleof;        { fix fpos }
    escape(0);
  end;

  procedure flushbuffer;
  begin
    ioresult := 0;
    with fp^, unitable^[funit] do
    begin     { write out the buffer }
      call(tm,fp,WRITEBYTES,fbuffer,bufend-flastpos,flastpos);
      if ioresult<>0 then escape(0);
      fbufchanged := false;
    end;
  end;

  procedure loadbuffer(posit: integer);
  begin
    ioresult:=0;
    with fp^, unitable^[funit]  do
    begin
      if fbufchanged then flushbuffer;
      flastpos := (posit div sectorsize) * sectorsize; bufparams;
      call(tm,fp,READBYTES,fbuffer,bufend-flastpos,flastpos);
      if ioresult<>0 then escape(0);
    end;
  end;

  procedure seekposit(posit: integer);
  begin
    with fp^ do
    begin
      if (posit<flastpos) or (posit>=bufend) then loadbuffer(posit);
      fpos:=posit;
    end;
  end;

  procedure wendbuffer;
  begin { append access only }
    with fp^ do
    begin
	{ write all but last sector }
      fbufchanged := true;
      if (bufend-flastpos)>sectorsize then
      begin
	bufend := bufend - sectorsize;
	flushbuffer;
	moveleft(fbuffer[bufend-flastpos],fbuffer[0],sectorsize);
      end
      else flushbuffer;
      fleof := fpos + 1;            fmodified := true;
      if fleof>fpeof then
      begin   { move the physical end of file }
	fpos := ((fleof + 256) div 256) * 256;
	call(unitable^[funit].dam,fp^,funit,STRETCHIT);
	if fleof>fpeof then begin ioresult := ord(ieof); escape(0); end;
	fpos := fleof - 1;
      end;
      flastpos := bufend; bufparams;
    end;
  end;

  procedure wnextbyte(c:char);
  begin { append access only }
    with fp^ do
    begin
      if fpos>=bufend then wendbuffer;
      fbuffer[fpos - flastpos] := c;     fbufchanged := true;
      fpos := fpos + 1;  fleof := fpos;  fmodified   := true;
    end;
  end;      { wnextbyte }

  procedure writeendline;
  var
    tposit, j : integer;
    tbufchanged : boolean; {added for 3.1 BUGFIX DTS #181 SFB--6/4/85}
  begin
    with fp^ do
    begin
      if freptcnt=0 then
      begin     { zero length record }
	if odd(fpos) then wnextbyte(' ');
	wnextbyte(chr(0)); wnextbyte(chr(0));
      end
      else
      begin     { have some data }
	tbufchanged := fbufchanged; {3.1 BUGFIX #081 SFB--6/4/85}
	tposit := fpos; j := tposit - freptcnt - 2;
		{ rewrite the record size }
	if j<flastpos then loadbuffer(j);
	fbuffer[j - flastpos] := chr(freptcnt div 256);
	fbuffer[(j+1) - flastpos] := chr(freptcnt mod 256);
	fbufchanged := true;

	if tposit>=bufend then loadbuffer(tposit);
	fpos := tposit;   freptcnt := 0;
	if tbufchanged  then fbufchanged := true; {3.1 BUGFIX #181 SFB-6/4/85}
      end;
    end;
  end; { writeendline }

  procedure wendfile;
  begin
    with fp^ do
    begin
      if freptcnt>0 then writeendline;
      { write logical end of file marker }
      if odd(fpos) then  wnextbyte(' '); { pad to even position }
      if fleof<fpeof then
      begin
	wnextbyte(chr(255)); wnextbyte(chr(255));
      end;
      if fbufchanged then flushbuffer;
      call(unitable^[funit].tm,fp,flush,ioresult,0,0);
    end;
  end;

  function min(v1,v2,v3:integer):integer;
  begin
    if v1<v2 then
    begin       { v1 or v3 }
      if v1<v3 then min := v1 else min := v3;
    end
    else        { v2 or v3 }
    begin
      if v2<v3 then min := v2 else min := v3;
    end;
  end;

  function rnextbyte:char;
  begin
    with fp^ do
    begin
      if fpos>=fleof then rendfile;
      if (fpos>=bufend) then loadbuffer(fpos);
      rnextbyte := fbuffer[fpos - flastpos];
      fpos      := fpos + 1;
    end;
  end;

  procedure getrecsize;
  begin
    with fp^ do
    begin
      if odd(fpos) then freptcnt := ord(rnextbyte);
      freptcnt := ord(rnextbyte);
      if freptcnt>127 then rendfile;
      freptcnt := (freptcnt * 256) + ord(rnextbyte);
    end;
  end;

  procedure readchars;
  var
    count, i     : integer;
  begin       { readchars }
    with fp^ do
    begin
      i:=0;
      if bufsize=1 then
      begin   { single character read }
	if freptcnt=0 then
	begin buffer[0] := ' '; freptcnt := -1; end
	else
	begin buffer[0] := rnextbyte; freptcnt := freptcnt - 1; end;
      end
      else    { multi character read }
      while i<bufsize do
      begin
	if freptcnt=0 then
	begin   { end of record }
	  buffer[i] := ' ';   i := i + 1;
	  if i<bufsize then getrecsize
		       else freptcnt := -1;
	end
	else
	begin   { move data bytes }
	  if fpos>=fleof then rendfile
			 else seekposit(fpos);
	  count := min(bufsize-i, bufend-fpos, freptcnt);
	  moveleft(fbuffer[fpos-flastpos],buffer[i],count);
	  i := i + count; freptcnt := freptcnt - count; fpos := fpos + count;
	end;
      end;      { while }
      feoln := (freptcnt<0);
      if not feoln then fpos := -fpos;
    end;
  end;        { readchars }

  procedure readstring;
  var   i, count : integer;
  begin
    i := 0;
    with fp^ do
    begin
      if freptcnt>0 then
      while i<bufsize do
      begin      { read data bytes }
	if fpos>=fleof then rendfile    else seekposit(fpos);
	count := min(bufsize-i, bufend-fpos, freptcnt);
	moveleft(fbuffer[fpos-flastpos],buffer[i+1],count);
	freptcnt := freptcnt - count; i := i + count; fpos := fpos + count;
	buffer[0] := chr(i);
	if freptcnt=0 then i := bufsize
      end;
      fpos := -fpos;
    end;
  end;

  procedure writechars;
  var
    i, count  : integer;

  begin       { writechars }
    with fp^ do
    begin
      if (freptcnt = 0) and (bufsize>0) then
      begin         { start a new record }
	if odd(fpos) then wnextbyte(' ');       { pad to even size }
	wnextbyte(chr(255)); wnextbyte(chr(255)); { dummy count field }
      end;
      i:=0;
      while i<bufsize do
      begin         { write data character(s) }
	if fpos>=bufend then wendbuffer;
	count := min(bufsize-i, bufend-fpos, 32767-freptcnt);
	if count<=0 then { too many characters for the record }
	  begin ioresult := ord(ibadformat); escape(0); end;
	moveleft(buffer[i],fbuffer[fpos-flastpos],count);
	fpos := fpos + count; freptcnt := freptcnt + count; i := i + count;
	fbufchanged := true;
      end;    { while }
      fleof := fpos;
    end;      { with }
  end;        { write chars }

  begin { asciiam }
    ioresult:=0;
    try
      with fp^ do
      begin
	if flastpos<0 then      { force buffer load }
	  begin flastpos := -buflength; fbufchanged := false; end;
	bufparams;  fpos := abs(position);
	case request of
	  readbytes, readtoeol:
	    begin
	      if request=readtoeol then buffer[0] := chr(0);
	      if fbufchanged then
	      begin     { close last record }
		fpos := fleof; wendfile;
		fpos := abs(position);  { restore fpos }
	      end;
	      if position<0 then
	      begin     { seqential read }
		if request=readbytes then readchars
				     else readstring;
	      end       { seqential read }
	      else
	      begin     { positioned read }
		if position>fp^.fleof then rendfile
				      else seekposit(position);
		getrecsize;
		if request=readbytes then readchars
				     else readstring;
	      end;      { positioned read }
	    end;
	  writebytes:
	    begin
	      if position<>0 then writechars    { normal write }
	      else
	      begin       { rewrite }
		flastpos := 0; bufparams; freptcnt := 0; writechars;
	      end;
	    end;
	  flush: if fbufchanged then
		   begin fpos := fleof; wendfile; end;
	  writeeol:     { end the line }
	    begin
	      if position<>0 then writeendline
	      else
	      begin     { zero length record at start of file }
		flastpos := 0; bufparams; freptcnt := 0;
		wnextbyte(chr(0)); wnextbyte(chr(0));
	      end;
	    end;
	  otherwise ioresult := ord(ibadrequest);
	end;    { case }
      end;      { with }
    recover
      if escapecode<0 then escape(escapecode);
  end;  { asciiam }
end;    { ascii module }

import asciimodule,sysglobals,loader;
begin   { installascii }
  amtable^[ASCIIFILE]     := asciiam;
  suffixtable^[ASCIIFILE] := 'ASC';
  efttable^[ASCIIFILE]    := 1;
  markuser;
end. { rev 16 A }
@


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


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


26.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
@d2 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
@@
