DataMuseum.dk

top - metrics - download

    Length: 3840 (0xf00)
    Types: TextFile
    Names: »theadparami «

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

TextFile

external
procedure headparamsi(z, keyfield, nk, maxreclength, maxbucks,
                      segsperbuck, segsperblock);
integer nk, maxreclength, maxbucks, segsperbuck, segsperblock;
integer array keyfield;
zone z;
begin

comment
  release 12.02: ib, 15.06.79
  release 13.00: eah, 01.02.79
    cor:
    no use of 'repeat' (because of fortran)
  release 13.02: fb, 1982.08.19
  cor:
  accept key=-3 i.e. long integer descending order
;

 
comment 
  the procedure will read the filehead to z and extract the parameters
  originally used by headfilei.
  
  the parameters are analogous to headfilei, but return values.
 
  z must be open and able to hold the head in one block, but not necessarily 
  in an i-zone.

  the use of variable names is analogous to headfilei, where the generation
  of codepieces is also described.
 
;

integer type, n, i10, i11, jl, bs, ws, fs, rl, bl, dl, cf, ss, ls, se;
integer field ifi, i0, i1, i2, i3, i4, i5, i6, i7, i8;
 
  se:= 42; jl:= 13; bs:= 17; ws:= 8; fs:= 49; rl:= 20; bl:= 2; dl:= 54; cf:= 53;
  ss:= 57; ls:= 38;
  setposition(z, 0, 0);
  inrec6(z, 512);
  i0:= z(1) shift (-24) extract 24 +1;
  if i0 < 38 or i0 > 2046 or i0 mod 2 <> 0 then
    system(9, i0, <:<10>head i  :>);
  i1:= i0 +14;
  i2:= i1 +20;
  i10:= 18;
  i11:= 4;
  i3:= i2 +26;
  i4:= i3 +i10;
  i5:= i4 +i10;
  i6:= i5 +i10 +2;
  i7:= i6 +30;
  i8:= i7 +30;
  if i7 > 512 then
  begin 
    setposition(z, 0, 0);
    inrec6(z, i7);
  end;
 
  ifi:= i2 +16; <*maxrecsize*>
  maxreclength:= z.ifi//4;
  ifi:= i2 +14; <*bucktablesize*>
  maxbucks:= z.ifi -(i8 -i7);
  ifi:= i3 +4; <*descrsize bucks*>
  maxbucks:= maxbucks//z.ifi;

  ifi:= i5 +16;
  segsperbuck:= z.ifi shift (-12);
  segsperblock:= z.ifi extract 12;
  ifi:= z.i0 -2; <*addr of compare1*>
  for n:= 1, n+1 while z.ifi shift (-18) <> jl do
  begin
    ifi:= ifi +6; <*sub. instr.*>
    <*types may be distinguised by the sub. instr.*>
    type:= z.ifi shift (-18);
    keyfield(n, 1):= if type = bs then 1
      else if type = ws then 2
      else if type = ss then 3
      else if type = fs then 4 else 0;
    if keyfield(n, 1) = 0 then
      system(9, type, <:<10>comp ins:>);
    if z.ifi shift (-15) <*rel*> extract 1 = 1 then
    begin <*descending order*>
      keyfield(n, 1):= -keyfield(n, 1);
      ifi:= ifi -2;
      <*addr. in the load instr.*>
      keyfield(n, 2):= z.ifi extract 12;
      ifi:= ifi +2;
    end
    else <*addr. in the sub. instr.*>
      keyfield(n, 2):= z.ifi extract 12;
    <*point at jl or se instr.*>
    ifi:= ifi + (
                 if keyfield (n, 1) = 3 
                 or keyfield (n, 1) =-3 then 6 else 2);
  end;
  nk:= n-1;
  ifi:= i0 +10;
  ifi:= z.ifi +2; <*addr of getsize*>
  ifi:= ifi +2;
  if z.ifi shift (-18) = jl then
    <*fix*>
    keyfield(n, 1):= keyfield(n, 2):= 0
  else
  begin
    ifi:= ifi -2;
    keyfield(n, 2):= z.ifi extract 12;
    type:= z.ifi shift (-18);
    if type = bl then
      keyfield(n, 1):= 1
    else if type = rl then keyfield(n, 1):= 2
    else if type <> dl then
      system(9, type, <:<10>gets ins:>)
    else
    begin
      ifi:= ifi +4;
      type:= z.ifi shift (-18);
      keyfield(n, 1):= if type = ls then 3
        else if type = cf then 4
        else 0;
    end dw;
  end var;
  setposition(z, 0, 0);
end proc;
end
▶EOF◀