DataMuseum.dk

top - metrics - download

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

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

TextFile

external
integer procedure  buflengthcf(filename, blocks_in_core);
value  blocks_in_core; integer  blocks_in_core;
string  filename;
comment
    the procedure returns the needed bufferlength for a
    cf-file which is stored in the backing storage area with the
    name filename.
    only the first double-word of the filehead: (i-buf-ref-rel
    or 0, cf-buf-ref-rel) and the resulting bufferlength are
    checked. 
    stderror is called if there is trouble with the file.
    the parameter blocks_in_core has the meaning:
      extend_segments shift 6 add blocks_in_core
    where extend_segments is the number of segments with
    which it should be possible to extend the file.
      (-1) shift 6 add blocks_in_core means extension to the
    maximum size, a limit which is never exceeded in the buffer
    calculation.
;
begin
  integer
    b52, b53, b59, b61,
    f18,

    bufrefrel,
    bytes,
    cfbufrefrel,
    doublewords,
    i,
    ibufrefrel,
    extension, segments, bucktablesize, max_buck_table,
    blocks, max_blocks,

    i2, i3, i4, i5, i8;

  integer array
    iarr(1:1),
    zd(1:20);

  long array field
    name_in_zd;

  zone
    z(2*128, 1, docerror);


procedure  alarm(int, text);
value  int;
integer  int;
string  text;
comment
  the procedure prints an alarm headline, and calls
  system(9...;
begin
  write(out, <:<10><10>***buflengthcf  alarm:    :>,
    zd.name_in_zd, <:<10>:>);
  if int <> -123456 then  system(9, int, text);
end  alarm;


procedure  docerror(z, s, b);
zone  z;
integer  s, b;
comment
  the procedure prints an alarm headline, and calls
  stderror;
begin
  alarm(-123456, <::>);
  stderror(z, s, b);
end  docerror;


integer procedure  word(byteno);
value  byteno; integer  byteno;
comment
    yields the value of the word in the zone z with the even bytenumber
    byteno + bufrefrel, the first word having the bytenumber zero;

  word:= z((bufrefrel + byteno + 4)//4) shift
         (if (bufrefrel + byteno) mod 4 = 0 then  -24 else  0)
         extract 24;

comment    definition of file-cf slang-names;

  b52:= 34; b53:= 36; b59:= 48; b61:= 54;
  f18:= 10;

comment    definition of file-i slang-names;

  i2:= 34; i3:= 60; i4:= 78; i5:= 96; i8:= 176;

  open(z, 4, filename, 1 shift 18);

comment    prepare printing of filename at alarm;
  getzone6(z, zd);
  name_in_zd:= 2;

  if inrec6(z, 0) < 2*512 then  goto fileheaderror;
  inrec6(z, 2*512);

comment
    now the file is described as an area process in the monitor, and
    the length of the file can be fetched from that, by monitor-
    procedure process-description, followed by a move of core area;

  i:= monitor(4, z, 0, iarr);
  system(5, i+18, iarr);

comment
    now iarr(1) contains the number of segments in the file;

  extension:= blocks_in_core shift(-6);
  blocks_in_core:= blocks_in_core extract 6;
  segments:= iarr(1) + extension;

  if blocks_in_core < 1 then  goto param_error;

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

  if cfbufrefrel < 4 or cfbufrefrel mod 2 <> 0 or
     cfbufrefrel > 2046 then  goto fileheaderror;

  if ibufrefrel <> -1 then
  begin
  comment    the file should be a masterfile;

    if blocks_in_core > 2 then  goto paramerror;

    if cfbufrefrel > ibufrefrel or ibufrefrel mod 2 <> 0 or
        ibufrefrel > 2046 then  goto fileheaderror;

    bufrefrel:= bytes:= ibufrefrel;

  end  masterfile
  else
  begin
  comment    the file should be a listfile;

    bufrefrel:= bytes:= cfbufrefrel;

  end  listfile;


  if bufrefrel > 512 then
  begin
    setposition(z, 0, bufrefrel//512);
    bufrefrel:= bufrefrel mod 512;
    inrec6(z, 2*512);
  end  long filehead;

  if ibufref_rel <> -1 then
  begin
  comment    master;
    max_buck_table:= word(i2+14) - 30 <* i8-i7 *>;
    buck_table_size:=
      if extension = (-1) shift (-6) then  max_buck_table
      else
      (segments//word(i2+2) <* segsperbuck *>
       + (if extension > 0 then  1 else  0))
       * word(i3 + 4) <* entrysize *>;

    i:=  i8 +
         (if   buck_table_size  <   max_buck_table
          then buck_table_size else max_buck_table)
          + word(i4) <* block table size *>
          + blocks_in_core * word(i5) <* block size *>;
  end  master
  else
  begin
  comment    list;
    max_blocks:= word(b59);
    blocks:=
      if extension = (-1) shift (-6) then  max_blocks
      else
      (segments - word(b52) <* segsinhead *>)
       // word(b53) <* segs in block *>
       + 1 <* safety *>;

    i:= b61 + 4 + f18 - 2
        + ((if   blocks  <   max_blocks
            then blocks else max_blocks) + 3)//4 * 2
        + blocks_in_core * (2 + word(b53) * 512);
  end  list;

  doublewords:= (bytes + i + 3)//4;


  if doublewords < 128 or doublewords > 200 * 128 then
  begin

fileheaderror:
    alarm(0, <:<10>prep-cf :>);

paramerror:
    alarm(blocks_in_core, <:<10>block_p :>);

  end  errors;

  buflengthcf:= doublewords;

  close(z, true);
end  buflengthcf;
end
▶EOF◀