⟦d5144ccd6⟧

TextFile

(
head 1
if 0.yes
    closesq = algol spill.yes blocks.yes list.yes survey.yes xref.yes bossline.yes
if 0.no
    closesq = algol spill.yes survey.yes
)
sq-system, closesq
release 13.0, eah, 01.02,81
  cor: (01519) update mark when nothing written in file.

external
integer procedure closesq(z, release, cut);
value   release, cut;
zone    z;
boolean release, cut;
comment 
  terminates the use of an sq-file.

  call:
    closesq(z, release, cut)

    closesq  (return value, integer)
             if close after reading, then the number of records accessed
             since opening, else the number of records in the file.

    z        (call and return value, zone)
             as for the algol procedure close.

    release  (call value, boolean)
             as for the algol procedure close.

    cut      (call value, boolean)
             if cut=true and zonestate=6 (writing), the file will be cut
             to an integral number of blocks, else this parameter is
             ignored.

  functions:
    if zonestate is 5 (after reading), the closing is performed as for
    the algol procedure close. if zonestate is 6 (after writing), the
    last block (possibly a whole block) is filled with all bits set on,
    the block is transferred to the file, may be the file is cut, the
    filehead and the catalog entry tail are updated and finally normal
    closing is performed.

  requirements:
    zonestate must be 0, 5 or 6.
    the file must be a sq-file.

  results:
    resultsq = 1   ok
             = 2   updatemark was sensed after reading.

    zonestate = 4, after declaration.

;

begin
boolean extension;
integer i, zstate, monres, segmno, segsperblock, lastblock, lastbyte,
        noofrecs, shortclock;
real fullclock;
integer array zonedescr(1:20), tail(1:20), sharedescr(1:12);
integer array field headpart1, headpart2, headpart3;
long array name(1:2);
long array field docname;


integer procedure clock(fncno, fullclock);
value fncno;
integer fncno;
real fullclock;
comment the parameter fncno selects an operation on shortclock;
begin
own integer shortclock;
integer i;
real time;
  i:= fncno;
  if shortclock = 0 then fncno:= 1;
  comment select a function;
again:
  case fncno of
  begin
    begin comment fncno = 1, take shortclock;
      shortclock:= systime(7, 0, time);
      if i <> fncno then
      begin
        fncno:= i;
        goto again;
      end;
    end;
    comment fncno = 2, print shortclock;
    write(out, <:d.:>, <<zddddd.dddd>,
               systime(6, shortclock, time) +time/1000000);
  end case;
  clock:= shortclock;
end proc clock;

procedure errorsq(fncno, number, text);
value fncno, number;
integer fncno, number;
string text;
begin
  case fncno of
  begin
    begin comment alarm, processing stops;
      write(out, <:<10>***closesq at :>, name);
      system(9, number, text);
    end
  end case;
end proc errorsq;

  procedure outhead(text);
  string text;
  begin 
    write(out, <:<10>:>, text, <:<10>:>);
    for i:= 1 step 1 until z.headpart1(1)//2 do
    write(out, z.headpart1(i), <:<10>:>);
  end outhead;

  extension:= false;
  docname:= 2;
  resultsq:= 1;
  getzone6(z, zonedescr);
  name(1):= zonedescr.docname(1);
  name(2):= zonedescr.docname(2);
  zstate:= zonedescr(13);
  if zstate <> 0 and zstate <> 5 and zstate <> 6 then
    errorsq(1, zstate, <:<10>z.state :>);
  monres:= monitor(42<*lookup*>, z, 0, tail);
  if monres <> 0 then
    errorsq(1, monres, <:<10>lookup  :>);
  if tail(9) shift (-12) <> 21 then
    errorsq(1, tail(9) shift (-12), <:<10>contents:>);
  getshare6(z, sharedescr, zonedescr(17<*used share*>));
  segsperblock:= tail(9) extract 12;
  if zstate = 6 <*write*> then
  begin comment fill the last block;
  integer field ifield;
    ifield:= outrec6(z, 0);
    if ifield = 0 then ifield:= segsperblock*512;
    outrec6(z, ifield);
    for ifield:= ifield step -2 until 2 do
    z.ifield:= -8388608;
  end;
  segmno:= if zstate = 5 then sharedescr(7 <*segmno*>)
    else zonedescr(9);
  lastbyte:= zonedescr(14<*recbase*>) -zonedescr(19<*basebuf*>)
             +zonedescr(16<*reclength*>) -(sharedescr(2<*first shared*>) -1);
  comment get the filehead;
  setposition(z, 0, 0);
  invar(z);
  headpart1:= 0;
  headpart2:= z.headpart1(3<*next part*>);
  headpart3:= z.headpart2(1<*next part*>);
  comment* outhead(<:cl read:>);
  if segsperblock <> z.headpart2(10) extract 12 then
  errorsq(1, segsperblock, <:<10>ht-confl:>);
  noofrecs:= zonedescr(11) extract 22;
  if zonedescr(11) shift (-22) extract 1 = 1 <*fix length bit*> then
    noofrecs := ((segmno - z.headpart1(6)<*length of head*>) // segsperblock)
                * (segsperblock * 512 // noofrecs)
                + lastbyte // noofrecs;

  comment   make the filehead ready for updating;
  i:=z.headpart1(1);
  setposition (z, 0, 0);
  swoprec6 (z, i);

  if zstate = 5 then resultsq:= resultsq +z.headpart3(6<*update*>)
  else 
  if zstate = 6 then  <*write*>
  begin
    comment get tail again, possibly extended;
    monres:= monitor(42<*lookup*>, z, 0, tail);
    shortclock:= clock(1, fullclock);
    if noofrecs > z.headpart3(3) then
    begin
      extension:= true;
      for i:= 2 step 1 until 7 do
      z.headpart3(i):= case i of
       (0,  <*dummy*>
        z.headpart3(2) +1, <*extensionno*>
        noofrecs,
        segmno,
        lastbyte,
        0, <*updatemark*>
        shortclock
       );
      checkvar(z);
      comment* outhead(<:cl mod:>);
      tail(10):= noofrecs;
    end extension
    else
    begin
      z.headpart3(6):= 0;
      checkvar(z);
    end;
    if cut then
    tail(1):= segmno +segsperblock;
    if cut or extension then
    begin
      tail(6):= shortclock;
      monres:= monitor(44 <*change*>, z, 0, tail);
      if monres <> 0 then
        errorsq(1, monres, <:<10>cut      :>);
    end;
  end write
  else
  if zstate = 0 and z.headpart3(6) = 1 then
  begin  <*after open for write*>
    z.headpart3(6) := 0;
    checkvar(z);
  end;
  close(z, release);
  closesq:= noofrecs;
end closesq;

end
▶EOF◀
DataMuseum.dk

RC4000/8000/9000

⟦d5144ccd6⟧ TextFile

Derivation

TextFile
