⟦d4fb44eb4⟧

TextFile

(
head 1
resultsq = set bs opensq 3 576.0 0 4.0
logsq = set bs opensq 5 512.0 0 4.0
if 0.yes
opensq = algol spill.yes list.yes bossline.yes blocks.yes xref.yes survey.yes
if 0.no
opensq = algol spill.yes survey.yes
)
sq-system, opensq
release 13.0, eah, 01.02.81

external
integer procedure opensq(z, doc, giveup, function);
value giveup, function;
zone z;
string doc;
integer giveup, function;
comment
  makes an sq-file available for recordprocessing by the standard i/o-procedures
  invar, outvar, changevar, inrec6, and outrec6.

  call:
    opensq(z, doc, giveup, function)

    opensq  (return value, integer)
            the number of records in the file.
 
    z       (call and return value, zone)
            as for algol procedure open.

    doc     (call value, string)
            as for algol procedure open.

    giveup  (call value, integer)
            as for algol procedure open.

    function (call value, integer)
            this integer is used as two halfwords, which specify the use of
            the file:
            function:= recordsize shift 12 add mode

            recordsize = 0 means that invar, outvar, or changevar will be
            used after this call.

            recordsize > 0 means that inrec6, or outrec6 will be used after
            this call, and recordsize is the number of halfwords in each re-
            cord.

            mode = 0 means reading inclusive checking of the checksum.

            mode = 1, reading exclusive checking of the checksum. this pa-
            rameter
            is always used in connecion with inrec6 (recordsize > 0).

            mode = 2, writing from the beginning of the file and with check-
            sum, if outvar/changevar is used.

            mode = 3, writing from the logical end of file and with checksum,
            if outvar/changevar is used.

  functions:
    the parameters are checked. the file is looked up in the catalog, and if

    no entry is found and mode is 2, an area creation is attempted.
    the catalog entry tail is interpreted. the filehead is cheked or created,
    if a new file is wanted. finally the file is positioned, and the zone pre-
    pared for recordaccess.

  requirements:
    zonestate = 4

    if mode <> 2, the tail and filehead must agree with the sq-system conventions.
    if mode = 2, contents = 20 or 0 is accepted too and the tail is changed
    to the sq-conventions.

    the sharelength of z must be able to hold any occuring record in the block.

  results:
    resultsq = 1  ok
             = 2  updatemark was found
             = 3  file not found in the catalog, but if mode > 1, it is cre-
                  ated and ready for use.

    zonestate = if mode < 2 then 5 else 6.

    the updatemark is set, if mode > 1.
;
begin
own integer resultsq;
own boolean logsq;
boolean newfile;
integer i, thisvers, segsinhead, recordsize, mode, blocksize, segsperblock,
        lookres, contents, sum, segmno, lastbyte, noofrecs, monres, shortclock;
real fullclock;
integer array field headpart1, headpart2, headpart3, headpart4, rest1, rest2;
integer array zonedescr(1:20), tail(1:10);
long array name(1:2);
long array field docname;
zone help(128, 1, stderror);


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 checksumsq(sum);
integer sum;
begin
  integer array field f;
  for f:= 0, 4, 8, 10, z.headpart1(3) step 2 until z.headpart2(1),
          z.headpart3(1) do
  sum:= sum extract 22 +z.f(1) extract 22;
end checksumsq;

procedure errorsq(fncno, number, text);
value fncno, number;
integer fncno, number;
string text;
comment the parameter fncno selects an action in an errorsituation.;
begin
  case fncno of
  begin
    begin comment alarm, processing stops;
      write(out, <:<10>***opensq at :>, name);
      system(9, number, text);
    end
  end case;
end proc errorsq;

procedure logoutput(no);
value no;
integer no;
comment prints the log. the output depends on the parameter no;
begin
  write(out, <:<10>log:>, no);
end proc logoutput;

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;


  thisvers:= 1 <*1st distributed version*>;
  segsinhead:= 1;
  resultsq:= 1;
  opensq:= 0;
  docname:= 2;
  open(help, 0, doc, 0);
  getzone6(help, zonedescr);
  name(1):= zonedescr.docname(1);
  name(2):= zonedescr.docname(2):= if name(1) extract 8 = 0 then extend 0
                                   else zonedescr.docname(2);
  setzone6(help, zonedescr);
  getzone6(z, zonedescr);
  if zonedescr(13) <> 4 then
    errorsq(1, zonedescr(13), <:<10>z.state :>);
  recordsize:= function shift (-12);
  comment maxrecsize is 4095;
  mode:= function extract 12;
  if mode > 3 or (mode = 0 <*read with check*> and recordsize > 0) then
    errorsq(1, mode, <:<10>ill.mode:>);
  blocksize:= zonedescr(20)//zonedescr(18)*4;
  segsperblock:= blocksize//512;

  if blocksize <> segsperblock*512 or recordsize > blocksize then
    errorsq(1, blocksize//4, <:<10>s.length:>);
  lookres:= monitor(42<*lookup*>, help, 0,tail);
  newfile:= false;
  if lookres = 0 <*found*> then
  begin comment check tail;
    contents:= tail(9) shift (-12);
    if contents = 21 then
      newfile:= mode = 2 or (mode = 3 and tail(10) = 0)
    else
    begin
      if mode <> 2 or
         (contents <> 0 and contents <> 20) or
         tail(7) <> 0 or tail(10) <> 0 then
           errorsq(1, contents, <:<10>contents:>);
      newfile:= true;
    end contents <> 21;
  end <*check tail*>
  else
  begin
    if lookres <> 3 <*i/o or name format error*> then
      errorsq(1, lookres, <:<10>lookup  :>)
    else
    begin
      comment entry not found;
      resultsq:= 3;
      if mode < 2 then goto endproc
      else newfile:= true;
    end;
  end;
  if newfile then
  begin
    comment set the tail;
    tail(6):= shortclock:= clock(1, fullclock);
    tail(7):= tail(8):= tail(10):= 0;
    tail(9):= 21 shift 12 add segsperblock;
    if lookres = 3 <*not found*> then
    begin
      tail(1):= segsperblock +segsinhead; <*size*>
      tail(2):= 1; <*preferably disc*>
      tail(3):= tail(4):= tail(5):= 0;
      monres:= monitor(40 <*create*>, help, 0, tail);
      if monres <> 0 then errorsq(1, monres, <:<10>create  :>);
      resultsq:= 3;
    end
    else
    begin
      monres:= monitor(44 <*change*>, help, 0, tail);
      if monres <> 0 then
        errorsq(1, monres, <:<10>change  :>);
    end;
      begin
      comment create the filehead;
        open(z, 4, name, 0 <*internal open*>);
        outrec6(z, 512 <*head is 1 segment p.t.*>);
        headpart1:= 0;
        for i:= 1 step 1 until 6 do
        z.headpart1(i):= case i of (
          0, <*length*>
          0, <*checksum*>
          0, <*field to next*>
          real <:sq:> shift (-24) extract 24,
          thisvers, <*sq-version*>
          segsinhead); <*segm.no for start of userpart*>
          
        headpart2:= z.headpart1(3):= i*2 -2;
        headpart2:= headpart2 +2;
        tofrom(z.headpart2, tail, 20);
        headpart2:= headpart2 -2;
        z.headpart2(12):= recordsize;
        headpart3:= z.headpart2(1):= headpart2 +2 +20 +2;
      for i:= 2 step 1 until 7 do
      z.headpart3(i):= case i of (
        0,  <*dummy*>
        0,  <*ext no*>
        0,  <*no of recs*>
        z.headpart1(6), <*segm.no. of last block*>
        0,  <*last byte*>
        0,  <*update*>
        tail(6)); <*short clock*>
      headpart4:= z.headpart3(1):= headpart3 +i*2 -2;
      z.headpart4(1):= 0;
      for rest1:= headpart4 +2 step 2 until 510 do
      z.rest1(1):= -8388608;
      getzone6(z, zonedescr);
      z.headpart1(1):= zonedescr(16):= headpart4 +2;
      checksumsq(z.headpart1(4));
      setzone6(z, zonedescr);
      checkvar(z);
      close(z, false);
    end create head;
  end new file;
  comment in all cases a filehead exists, and will be checked;
  open(z, 4, name, 0);
  getzone6(z, zonedescr);
  zonedescr(11):= 1 shift 23;
  setzone6(z, zonedescr);
  invar(z);
  headpart1:= 0;
  headpart2:= z.headpart1(3);
  headpart3:= z.headpart2(1);
  comment* outhead(<:op read:>);
  sum:= real <:sq:> shift (-24) extract 24;
  checksumsq(sum);
  if sum <> z.headpart1(4) then errorsq(1, 0, <:<10>sqsum   :>);
  if z.headpart1(5) > thisvers then
    errorsq(1, z.headpart1(5), <:<10>sqvers  :>);
  if z.headpart2(10) extract 12 <> segsperblock then
    errorsq(1, z.headpart2(10) extract 12, <:<10>spb-head:>);
  if z.headpart2(12) <> recordsize then
    errorsq(1, z.headpart2(12), <:<10>recsize :>);
  noofrecs:= z.headpart3(3);
  if noofrecs shift (-22) <> 0 <*2 leftmost bits too many*> then
  errorsq(1, noofrecs, <:<10>reccount:>);
  if z.headpart3(6) <*updatemark*> <> 0 then
    resultsq:= 2;
  if mode > 1 and z.headpart3(6) = 0 then
  begin
    i:= z.headpart1(1);
    setposition(z, 0, 0);
    swoprec6(z, i);
    z.headpart3(6):= 1; <*update*>
    checkvar(z);
    comment* outhead(<:op mod:>);
  end;
  comment end of filehead checking;
  comment position userpart;
  if mode = 3 then
  begin
    segmno:= z.headpart3(4);
    lastbyte:= z.headpart3(5);
    setposition(z, 0, segmno);
    inrec6(z, lastbyte);
    setposition(z, 0, segmno);
    outrec6(z, lastbyte);
    outrec6(z, 0);  <*no zone rec*>
  end
  else
  setposition(z, 0, z.headpart1(6));
  comment prepare recordprocessing;
  getzone6(z, zonedescr);
  zonedescr(10):= giveup;
  zonedescr(11):= if recordsize <> 0 then
                  1 shift 22 add recordsize
                  else
                  case mode +1 of
                  (1 shift 23, 0, 1 shift 23, 1 shift 23 add noofrecs)
                  ;
  setzone6(z, zonedescr);
  opensq:= noofrecs;
endproc:
end procedure opensq;
end

▶EOF◀
DataMuseum.dk

RC4000/8000/9000

⟦d4fb44eb4⟧ TextFile

Derivation

TextFile
