DataMuseum.dk

top - metrics - download

    Length: 2304 (0x900)
    Types: TextFile
    Names: »tshlengthsq «

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

TextFile

(
head 1
if 0.yes
shlengthsq = algol spill.yes blocks.yes bossline.yes list.yes survey.yes xref.yes
if 0.no
shlengthsq = algol spill.yes survey.yes
)
sq-system, shlengthsq
release 13.0, eah, 01.02.81

external
integer procedure shlengthsq(doc);
string doc;
comment
  calculates the sharelength for a sq-file.
  call:
    shlengthsq(doc)
   
    shlengthsq  (return value, integer)
                blocklength of the file expressed in doublewords, or, if =0,
                indication of filetrouble, see results.
 
    doc         (call value, string)
                the name of a backing storage area.

  functions:
    doc is looked up in the catalog, and if it exists and content =21, 20,
    or 0, the sharelength ( = blocklength) is calculated from tail(9).

  requirements:
    doc must describe a backing storage area.

  results:
    resultsq = 1   ok
             = 2   error in tail(9)
             = 3   doc not found
;

begin
integer monres, segsperblock, contents;
integer array zonedescr, tail(1:20);
zone help(1, 1, stderror);
long array field docname;

  resultsq:= 1;
  open(help, 0,doc,0);
  getzone6(help, zonedescr);
  docname:= 2;
  if zonedescr.docname(1) extract 8 = 0 then 
  begin
    zonedescr.docname(2):= 0;
    setzone6(help, zonedescr);
  end;
  monres:= monitor(42 <*lookup entry tail*>, help, 0, tail);

  contents:= tail(9) shift (-12);
  segsperblock:= tail(9) extract 12;
  if monres = 0 <*ok*> then
  begin
  if segsperblock < 1 or ( contents <> 21 and contents <> 20
                           and contents <> 0) then
    resultsq:= 2;
  end
  else
  if monres = 3 <*not found*> then
    resultsq:= 3
  else
  begin comment catalog error or name format possibly;
    zonedescr.docname(2):= zonedescr.docname(2) shift (-8) shift 8;
    write(out, <:<10>***shlengthsq on:>, zonedescr.docname);
    system(9, monres, <:<10>lookup  :>);
  end;
  close(help, true);
  shlengthsq:= if resultsq <> 1 then 0
               else segsperblock*128;
  end procedure shlengthsq;
end
end
▶EOF◀