DataMuseum.dk

top - metrics - download

    Length: 5376 (0x1500)
    Types: TextFile
    Names: »textendcf   «

└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
    └─⟦75ff9bef3⟧ 
        └─⟦this⟧ »textendcf   « 

TextFile

(
head 1
extendcf=algol list.yes survey.yes
end
head 1
)

extendcf
external
procedure  extendcf(z, extension);
value  extension;
zone  z;
integer  extension;
comment
    the procedure extends the cf-file currently being processed by
    the zone z, which must be in one of the normal 6 cf-states
    (read-only, read-update, or update-all, -m or -l).
    the positive integer extension defines how many segments the
    file should be extended.
    the file will, depending on type, be extended with an integral
    number of buckets or blocks, at least one.
    if an error occurs in a call of a monitor-procedure, resultcf will
    be equal to:  result-of-monitor-call * 10000 + number-of-monitor-fnc,
    otherwise resultcf will be equal to the result of opencf.
    in the first case the file has not been extended, but the situation
    is as it was before.
    the mode-procedures and opencf are called and may
    cause alarms and calls of jump-proc.
    in case of hard errors on backing store stderror, or the block-proc
    of zone z may be called.
;
begin
  integer  i, fnc, readonlyl, filetype, savezstate,
    savelength, saveresult, oldsegs, newsegs, increment,
    headsegs, i5, b52, b53, cfbufrefrel, ibufrefrel;

  integer array  zdescr, savezdescr, tail(1:20);

  integer field  zgiveup, zstate, recordbase, recordlength,
    basebufferarea, bufferlength, ifld;

  real array field  zdocname;

comment
    init field-variables for zone-descriptor;

  zdocname:= 2;
  zgiveup:= 20;
  zstate:= 26;
  recordbase:= 28;
  recordlength:= 32;
  basebufferarea:= 38;
  bufferlength:= 40;

comment
    init variables for reference to file-cf;

  readonlyl:= 22;

  i5 := 96;
  b52:= 34;
  b53:= 36;

comment
    start saving the old state;

  saveresult:= 1;

  getzone6(z, zdescr);
  savezstate:= zdescr.zstate;

  filetype:= if savezstate < readonlyl then  0 else  1;

comment
    the zonestate is changed to readonly in order to ensure that the
    file is properly updated, and to check the current zone-state;

  readonlycf(z);
  getzone6(z, zdescr);

  comment
      let current record describe the whole buffer, and change the
      zonestate to after-declaration;

    zdescr.zstate:= 4;
    zdescr.recordbase:= zdescr.basebufferarea;
    zdescr.recordlength:= zdescr.bufferlength * 4;

    setzone6(z, zdescr);

    ibufrefrel := z(1) shift (-24) extract 24 + 1;
    cfbufrefrel:= z(1)             extract 24 + 1;

comment    find headsegs and increment from file head;
    if filetype = 0 then
    begin
    comment    master;
      headsegs:= 0;
      ifld:= ibufrefrel + i5 + 16;
      increment:= z.ifld shift(-12); <* segsperbuck *>
    end  master
    else
    begin
    comment    list;
      ifld:= cfbufrefrel + b52;
      headsegs := z.ifld; <* segs in head *>
      ifld:= cfbufrefrel + b53;
      increment:= z.ifld; <* segs in block *>
    end  list;

    savelength:= (cfbufrefrel + 18)//4;

    begin
      real array  savetables(1:savelength);

    comment
        in this block the first part of the zone-buffer, which
        contains the chain-tables and the jump-specification,
        is saved, and the file is extended and reopened;

      for i:= 1 step 1 until savelength do
        savetables(i):= z(i);

    comment
        get tail of old entry by lookup;

      fnc:= 42; i:= monitor(fnc, z, 0, tail);

      if i>0 then  goto error;

      oldsegs:= tail(1);
      newsegs:= headsegs + (oldsegs + extension - headsegs)
                           //increment * increment;
      if newsegs <= oldsegs then
         newsegs:=  newsegs + increment;
      if newsegs <= oldsegs then
      begin
      comment    error;
        saveresult:= 999999;
        goto reopen;
      end;

      tail(1):= newsegs;

    comment
        change the size of the entry;

      fnc:= 44; i:= monitor(fnc, z, 0, tail);

      if i > 0 then
      begin
error:
        saveresult:= i * 10000 + fnc;
      end  error;


reopen:
;   comment
        open the file again;

      i:= 1;
      opencf(z, string zdescr.zdocname(increase(i)), zdescr.zgiveup);

      if saveresult = 1 then  saveresult:= resultcf;

      getzone6(z, savezdescr);

    comment
        restore the first part of the zone-buffer;

      setzone6(z, zdescr);

      for i:= 1 step 1 until savelength do
        z(i):= savetables(i);

      setzone6(z, savezdescr);
  
  end  block of savetables;

comment
    restore zonestate;

  i:= savezstate - readonlyl + (if filetype = 0 then  7 else  2);

  case i of
  begin
    ;
    ;
    readupdcf(z);
    updateallcf(z);
  end case i;

  resultcf:= saveresult;
end  extendcf;
end
▶EOF◀