⟦5fd14d90e⟧

TextFile


external


procedure head_file_i (z, keyfield, n, maxreclength, maxbucks, segsperbuck,
                       segsperblock);

  value n, maxreclength, maxbucks, segsperbuck, segsperblock;
  integer n, maxreclength, maxbucks, segsperbuck, segsperblock;
  integer array keyfield;
  zone z;

  begin

  comment
  z           : the name of the zone in which the file head is generated,
                only one share is needed, but it should be able to hold
                at least 10*n+30 elements as one record in an integral
                number of segments.

  keyfield    : a two-dimensional array holding information about
                types and relative locations of the keywords and,
                if needed, the length in a record.

  n           : number of keywords.

  maxreclength: maximum length, in reals, of records which will be stored
                in the file.
                if only constant length records are used then maxreclength
                is this constant length.

  maxbucks    : maximum number of buckets to be provided for in the
                buckettable.

  segsperbuck : number of segments in one bucket.
                on disk normally segsperbuck = 40.

  segsperblock: number of segments in one block.

  the procedure will generate the head of an indexed sequential file
  and output it, by means of outrec, to the file opened in z. 
  the head consists of codepieces, which will be used by the record
  handling procedures whenever they refer to keys or recordlengths,
  a list of entry points to these codepieces and other parameters
  describing the file.
  the head is a whole number of segments which is followed by the buckhead
  on a separate segment. the buckhead is also initialized and output in this
  procedure.
  ;
\f



integer blw0, rlw0, dlw1, bsw0, wsw0, ssw1, fsw1, blw1, rlw1, hsw1, rsw1,
        dsw1, sew00, snw00, ndw12, jlret, cfw12, jlw2x2, lsw12, jlx3,
        w1, w2, x2, x3, relmark,
        i, k, i0, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12,
        minrecsize, maxrecsize, reckeysize, keypartsize, bucktablesize,
        segsize, doubleintegers, lengthtype, recrel, savekey, savebase,
        segsinhead, segsinsharebucks, segsinshareblocks, blocksperbuck,
        blocksperbuck1, bytesperblock, word, isqrelease, monres;

real time;

long sum;

integer array recaddr, saveaddr(1:n+1), typeoperation(1:16), ia(1:10);

integer procedure typeop (base, i); value base, i; integer base, i;
        typeop:= typeoperation (base + abs keyfield(i,1));

procedure storeword (word) in z at byte :(p);
        value word, p; integer word, p;
        begin
        integer field element;
        element:= p +2;
        z.element:= word;
        end storeword;

procedure compile (instr); value instr; integer instr;
        begin
        storeword(
          if false add (instr shift (-15)) then
            instr - instr extract 12 + (instr-k) extract 12
          else instr) in z at byteaddress :(k);
        k := k+2;
        end compile;
<*start:*>
 
<*initialize constants:*>
 
isqrelease:= 15;
w1 := 1 shift 16; w2 := 2 shift 16; x2 := 2 shift 12; x3 := 3 shift 12;
relmark := 1 shift 15;
blw0 := 2 shift 18;       rlw0 := 20 shift 18;
dlw1 :=54 shift 18+w1;    bsw0 := 17 shift 18;
wsw0 := 8 shift 18;       ssw1 := 57 shift 18 + w1;
fsw1 :=49 shift 18 + w1;  blw1 :=  2 shift 18 + w1;
rlw1 :=20 shift 18 + w1;  hsw1 := 26 shift 18 + w1;
rsw1 :=23 shift 18 + w1;  dsw1 := 55 shift 18 + w1;
sew00:=42 shift 18;       snw00:= 43 shift 18;
ndw12:=35 shift 18 +w1 + 2;  cfw12:= 53 shift 18 + w1 + 2;
jlret:=13 shift 18 + relmark; jlx3:= 13 shift 18 + x3;
jlw2x2:=13 shift 18 + w2 + x2 ;  lsw12:= 38 shift 18 + w1 + 2;

for i := 1 step 1 until 16 do
   typeoperation(i) := case i of
   (blw0, rlw0, dlw1, dlw1, 
    bsw0, wsw0, ssw1, fsw1,
    blw1, rlw1, dlw1, dlw1,
    hsw1, rsw1, dsw1, dsw1);

savekey:= 2;  i10:= 18; i11:= 4;  i12:= 4;
savebase:= savekey+relmark - 1;  segsize:= 512;
i0:= 0;  i1:= i0+14;  i2:= i1+20; i3:= i2+26;  i4:= i3+i10;
i5:= i4+i10;  i6:= i5+i10+2;  i7:= i6+30;  i8:= i7+30;
bucktablesize:= i8 -i7;

minrecsize:= maxrecsize:= maxreclength*4;

test_reasonable:
if maxrecsize < 1 or maxrecsize > 10000 or
   segsperbuck < 2 or segsperbuck > 1000 or
   segsperblock < 1 or segsperblock > 50 or
   maxbucks > 10000 then system(9, 0, <:<10>head i p:>);
\f


<*compute addresses:*>

k := reckeysize := doubleintegers := 0;

for i := 1 step 1 until n do
   begin
   lengthtype := abs keyfield(i,1);
   if lengthtype = 3 then
     begin lengthtype :=4 ; doubleintegers := doubleintegers + 1; end;
   if lengthtype < 1 or lengthtype > 4 then goto keyfielderror;
   recrel:= keyfield(i,2);  k:= k+lengthtype;
   if recrel < lengthtype or recrel >maxrecsize then
     goto keyfielderror;
   if recrel > reckeysize then reckeysize:= recrel;
   if lengthtype > 1 then
     begin  if recrel mod 2 <> 0 then goto keyfielderror;
            k:= k mod 2 + k;
     end;
   recaddr (i) := recrel + x3;  saveaddr (i) := k + savebase
   end;

k := keypartsize := k mod 2 + k;  reckeysize:= reckeysize mod 2 + reckeysize;

lengthtype := keyfield (n + 1,1);
if lengthtype <> 0 then
variable_length_records:
  begin
  if lengthtype < 1 or lengthtype > 4 then goto keyfielderror;
  recrel:= keyfield(n+1,2);
  if recrel < lengthtype or recrel > maxrecsize or
     (lengthtype > 1 and recrel mod 2 <> 0) then
      goto keyfielderror;
  minrecsize := if recrel > reckeysize then recrel else reckeysize;
  if lengthtype > 2 then k := k + 2;
  recaddr (n + 1) := recrel + x3;
  k:= k + 2;  
  saveaddr (n + 1) := k + savebase;
  end;

k:= k+savekey;
i0:= i:= k + 24*n + 8*doubleintegers + (keypartsize+2)//4 * 4 +
    (if lengthtype = 0 then 6 else 14);

if i > 2044 then

keyfielderror: system(9, i, <:<10>recdescr:>);

i1:= i1+i0;  i2:= i2+i0;  i3:= i3+i0;  i4:= i4+i0;  i5:= i5+i0;
i6:= i6+i0;  i7:= i7+i0;  i8:=i8+i0;
segsinhead:= (i7-1)//segsize + 1;
outrec6(z, segsinhead*segsize);

storeword (i0+1) at:(0);  comment zonebufrefrel;

jlret := jlret + i0 - 2;
\f



generate_codepieces:

compare1 :
 ;comment compares savekey with the reckey given by x3 = recbase,
  exits with:  w0 < 0  for savekey < reckey
               w0 = 0  for savekey = reckey
               w0 > 0  for savekey > reckey
  the code generated for each keyfield is of the form:
        < form difference in w0 >
          se  w0  0
          jl.     return
  where se  w0  0 is omitted for the last keyfield and 
  < form difference in w0 > depends on keyfield type as follows:


  keyfield type            value        code
  

  12 - bit integer:
    ascending order        1            bl. w0  saveaddr
                                        bs  w0  recaddr

    descending order      -1            bl  w0  recaddr
                                        bs. w0  saveaddr

  24 - bit integer:
    ascending order        2            rl. w0  saveaddr
                                        ws  w0  recaddr

    descending order      -2            rl  w0  recaddr
                                        ws. w0  saveaddr

  48 - bit integer:
    ascending order        3            dl. w1  saveaddr
                                        ss  w1  recaddr
                                        sn  w0  0
                                        nd  w1  2

    descending order      -3            dl  w1  recaddr
                                        ss. w1  saveaddr
                                        sn  w0  0
                                        nd  w1  2

  48 - bit real:
    ascending order        4            dl. w1  saveaddr
                                        fs  w1  recaddr

    descending order      -4            dl  w1  recaddr
                                        fs. w1  saveaddr
    
  total size in bytes:
    n *8 + number of 48 - bit integer fields * 4 - 2;
\f




storeword (k) at:(i0 + 0); comment relative entry point for compare1;
for i := 1 step 1 until n do
   begin
   compile (typeop(0 , i) +
            (if keyfield (i , 1) < 0 then recaddr (i) else saveaddr (i)));
   compile (typeop(4 , i) +
            (if keyfield (i , 1) < 0 then saveaddr (i) else recaddr (i)));
   if abs keyfield (i , 1) = 3 then
     begin  compile(snw00);  compile (ndw12); end;
   if i < n then
     compile (sew00);
   compile(jlret);
   end;


savethekey:
 ;comment moves the reckey given by x3 = recbase to savekey, field by field
  according to type:

  12 - bit integer            24 - bit integer        48 - bit integer or real
  bl  w1  recaddr             rl  w1  recaddr         dl  w1  recaddr
  bs. w1  saveaddr            rs. w1  saveaddr        ds. w1  saveaddr

  terminated by:    jl.  return.

  total size in bytes:   n * 4 + 2;

storeword (k) at :(i0 + 4); comment relative entry point for savethekey;
for i := 1 step 1 until n do
   begin
   compile (typeop(8 , i) + recaddr (i));
   compile (typeop(12 , i) + saveaddr (i));
   end;                   
compile (jlret);


restorehead:
 ;comment moves savelength and savekey to the record given by x3 = recbase,
  field by field according to type, with no code for savelength if fixed length 
  records ( lengthtype = 0 ).

  total size in bytes :
   ( if lengthtype = 0 then 0 else 4 ) + 4 * n + 2;

storeword (k) at:(i0 + 6); comment relative entry point for restorehead;
if lengthtype <> 0 then
  begin
  compile (typeop (8 , n + 1) + saveaddr (n + 1));
  compile (typeop (12 , n + 1) + recaddr (n + 1));
  end;

for i := 1 step 1 until n do
   begin
   compile (typeop (8 , i) + saveaddr (i));
   compile (typeop (12 , i) + recaddr (i));
   end;
compile (jlret);
\f



copykey:
 ;comment
  copies the savekey to the entry given by x3 = entry by
  dl-ds instructions.
  terminated by:   jl. return.

  total size in bytes:  (keypartsize+2)//4 * 4 + 2;

  storeword (k) at :(i0 + 8); comment relative entry point for copykey;
  for i := 1 step 1 until keypartsize // 4 do
     begin
     compile (dlw1 + 4 * i + savebase);
     compile (dsw1 + 4 * i + x3);
     end;
  if keypartsize mod 4 > 0 then
     begin
     compile (rlw1 + keypartsize + savebase);
     compile (rsw1 + keypartsize + x3);
     end;
  compile (jlret);

compare2:
 ;comment  compares savekey with the keypart of the entry given
  in x3. instructions as in compare1 but other addresses.
  terminated by:   jl. return.

  total size in bytes:  8*n + 4*doubleintegers - 2;


  storeword (k) at :(i0 +2); comment relative entry point for compare2;
  for i := 1 step 1  until n do
     begin
     compile (typeop (0 , i) + saveaddr (i) +
             (if keyfield (i , 1) < 0 then x3 - savebase else 0 ));
     compile (typeop (4 , i) + saveaddr (i) +
             (if keyfield (i , 1) < 0 then 0 else x3 - savebase ));
     if abs keyfield (i , 1) = 3 then
       begin
       compile (snw00);
       compile (ndw12);
       end;
     if i < n then compile (sew00);
     compile(jlret);
     end;
\f



getsize:
 ;comment
  if fixed recordlength is specified, indicated by lengthtype=0, then
  getsize simply returns with w1 = maxrecsize otherwise the length field
  of the record is moved to savelength, the value converted to number
  of bytes and returned in w1.

  totalsize in bytes:
    if lengthtype = 0 then 2 else 6;

storeword (k) at :(i0 + 10); comment relative entry point for getsize;
if lengthtype <> 0 then
  begin
  compile (typeop (8 , n + 1) + recaddr (n +1));
  compile ( typeop (12 , n + 1) + saveaddr (n +1));
  compile (if lengthtype = 4 then cfw12 else lsw12);
  end
else
  compile (rlw1 + i2+16+relmark);
comment as the next instruction is the common returnjump we need no
jl return here;

storeword (k) at :(i0 + 12); comment relative entry point for compare3;
compile (jlw2x2);             comment returnjump in zonebufref - 2;



sizecomputations:

bucktablesize:= maxbucks*(keypartsize+i11)+bucktablesize;

segsinsharebucks:= (bucktablesize-1)//segsize + 1;

blocksperbuck:= segsperbuck*segsize//(segsperblock*segsize+
   keypartsize+i12);
segsinshareblocks:= (blocksperbuck*(keypartsize+i12)-1)//segsize + 1;

blocksperbuck1:= (segsperbuck - segsinhead - segsinsharebucks -
                  segsinshareblocks) // segsperblock;

bytesperblock:= if lengthtype = 0 then
                    segsperblock*segsize//maxrecsize*maxrecsize
                  else segsperblock*segsize - maxrecsize + 4;

if segsperblock*segsize < 2*maxrecsize then system(9, 1, <:<10>head i p:>);

if blocksperbuck1 < 1 then system(9, 2, <:<10>head i p:>);\f


<*store file parameters:*>

k:= i1;

for word:=

10 shift 12 + 40, <*i1*>
60,
5 shift 12 + 5,
0,
0,
500,
0,
0,
0,
0,
 
0, <*i2*>
segsperbuck,
segsinhead*segsize-i7,
  0,
  0,
  0,
  blocksperbuck1*(keypartsize+i12),
  bucktablesize,
  maxrecsize,
  minrecsize-1,
  blocksperbuck1 shift 12 add blocksperbuck,
  bytesperblock,
  isqrelease,

  0, <*i3*>
  i11-1+i8-i7,
  keypartsize+i11,
  0,
  0,
  0,
  0,
  0,
i11 shift 12 add segsinsharebucks,

  segsinshareblocks*segsize, <*i4*>
  i12-1,
  keypartsize+i12,
  0,
  round sqrt(blocksperbuck)*(keypartsize+i12),
  0,
  blocksperbuck*(keypartsize+i12),
  0,
i12 shift 12 add segsinshareblocks,

  segsperblock*segsize, <*i5*>
  -1,
  0,
  0,
  0,
  0,
  segsperblock * segsize,
  0,
  segsperbuck shift 12 add segsperblock,
  0,
  jlx3, <*i6*>
  0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,
0,

  0

  do  begin  storeword (word) at:(k);  k:= k+2  end;
\f



if k mod 4 <> 0 then
  storeword(0,k);
<*checksum:*>

sum:= long <:isq:> shift(-24);
for i:= 1 step 1 until (i7+3)//4 do
  sum:= sum + (-(z(i)extract 24)) + (-(z(i) shift (-24) extract 24));
storeword(sum extract 24) at:(i2);

bucktablehead:
outrec6(z, i8 -i7);
k:= 0;

for word:= 0, 0, 0, 0, segsinhead, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 do
  begin  storeword(word) at:(k);  k:= k+2  end;
setposition(z, 0, 0);
monres:= monitor(42, z, 0, ia);
if monres = 0 then
begin
  ia(6):= systime(7, 0, time);
  ia(9):= 22 shift 12;
  monitor(44, z, 0, ia);
end;

end head_file_i;
end

\f

▶EOF◀
DataMuseum.dk

RC4000/8000/9000

⟦5fd14d90e⟧ TextFile

Derivation

TextFile
