DataMuseum.dk

top - metrics - download

    Length: 4608 (0x1200)
    Types: TextFile
    Names: »textendi    «

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

TextFile

external
procedure extendi (z, segments);
value                 segments ;
zone               z           ;
integer               segments ;
begin

comment
  release 13.0:  eah, 1.2.81
;

comment    the procedure changes the catalog entry of the isqfile comnected
           to z. 
           when segments > 0 the fle is extended with the necessary number
           of whole buckets.
           when segments < 0 the file is cut to the number of used buckets.
           in all cases the shortclock is inserted in the tail
;

  integer entsize, fnc, i, maxbucks, maxsegs, max_used_bucks, 
          newsegs, oldsegs, res, savestate, segsperbuck,
          i0, i1, i2, i3, i4, i5, i6, i7, i8, i10;
  boolean test;

  long array field  zdocname;
  integer    field  basebufferarea, bufferlength, recordbase, recordlength,
                    shortclock, zgiveup, zstate, ifi;

  integer    array  tail(1:10), zd(1:20);

  procedure testproc (no);
  integer no;
  begin
    case no of
    begin
<*1*>   write(out, <:<10>extendi: :>,zd.zdocname,
              <:<10>maxsegs, maxbucks, segsperbuck, maxusedbucks::>,
              maxsegs, maxbucks, segsperbuck, max_used_bucks);
<*2*>   write(out, <:<10>   segments, oldsegs, newsegs::>,
              segments, oldsegs, newsegs);
<*3*>   write(out, <:<10>   result::>, res);
<*4*>   begin
          write(out,<:<10>   zonbuf filehead::>);
          for ifi:= 2 step 2 until i8+30 do
          begin
            if ifi mod 10 = 2 then write(out,"nl",1,<<ddd>,ifi,<:::>);
            write(out,<<-ddddddd>, z.ifi);
          end;
        end 4;

    end;
  end testproc;

  test := false;

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

  getzone6 (z, zd);
  savestate := zd.zstate;

  if savestate < 10 or savestate > 13 then
    res := 5  <* zonestate not read_only_i, put_i, or update_i *>
  else
  begin
    res := 1;

  comment    the zonestate is changed to read_only_i to ensure correct
             updating of the file;
    set_read_i (z);
    getzone6 (z, zd);

  comment    change the zonestate to after declaration, and let the record
             describe the whole buffer;
    zd.zstate       := 4;
    zd.recordbase   := zd.basebufferarea;
    zd.recordlength := zd.bufferlength * 4;
    setzone6 (z, zd);

  comment    find the isq file parameters from the file head;
    ifi:= 2;
    i0 := z.ifi + 1;
    i1 := i0 + 14;
    i2 := i1 + 20;
    i3 := i2 + 26;
    i10:= 18;
    i4 := i3 + i10;
    i5 := i4 + i10;
    i6 := i5 + i10 + 2;
    i7 := i6 + 30;
    i8 := i7 + 30;

    ifi := i3 + 4;   <*descr.size bucks*>
    entsize := z.ifi;
    ifi := i2 + 14;  <*bucktable size*>
    maxbucks := (z.ifi - (i8-i7)) // entsize;

    ifi := i7;
    max_used_bucks := (z.ifi - (i8-i7)) // entsize;

    ifi := i5 + 16;
    segsperbuck := z.ifi shift (-12);
    maxsegs := maxbucks * segsperbuck;

    comment *
      if test then testproc(1);
    comment *
      if test then testproc(4);

  comment    find new file size;
    fnc := 42;  i := monitor (fnc, z, 0, tail);  <*lookup*>
    if i > 0 then goto mon_error;

    oldsegs := tail(1);
    if segments = 0 then
      newsegs := oldsegs  <*only change of shortclock*>
    else
    if segments < 0 then
      newsegs := max_used_bucks * segsperbuck
    else
    begin
      newsegs := (oldsegs + segments + segsperbuck - 1)
                 // segsperbuck * segsperbuck;
      if newsegs > maxsegs then
      begin
        newsegs := maxsegs;
        res := 6;
      end;
    end;
 
    comment *
      if test then testproc(2);

  comment    change the entry of the file;
    tail(1) := newsegs;
    tail.shortclock := systime (7, 0, 0.0);

    fnc := 44;  i := monitor (fnc, z, 0, tail);  <*change entry*>
    if i > 0 then
    begin
mon_error:
      res := i*10000 + fnc;
    end error;

  comment    open the file again;
    open (z, 4, zd.zdocname, zd.zgiveup);
    startfilei (z);
    if res = 1 then res := resulti;

  comment    restore the zonestate;
    case savestate - 9 of
    begin
      ;
      ;
      set_put_i (z);
      set_update_i (z);
    end;
  end zonestate ok;

  comment *
    if test then testproc(3);

  resulti := res;
end extendi;
end;
▶EOF◀