DataMuseum.dk

top - metrics - download

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

└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
    └─⟦b2ec5d50f⟧ 
        └─⟦this⟧ »tinitsavcat« 

TextFile

initsavecat=algol list.no
begin
message vk 1981.11.29 initsavecat;
comment
   ************************************************************
   *                                                          *
   * This program is used to initialise the dumpcat.That is   *
   * to insert 0 in the first word of each segment and -1 in  *
   * all other words of dumpcat.                              *
   * The program is called in the following way:              *
   *      initsavecat hashentries.<integer> bittsize.<integer>*
   *                                                          *
   * Errormessage are :                                       *
   *      *** Param error                                     *
   *      *** Savecat does allready exist                     *
   *      *** Connect error = <integer>                       *
   *      *** Creation of dumpcat not ok                      *
   *                                                          *
   ************************************************************ ;
  boolean outp;
  integer outres,i,ik,hashentries,dumpensize,bittsize,tapeantal;
  integer field a,b,lbase,ubase,antal;
  integer array interval(1:8),ttail(1:17),tail(1:10),entrybase(1:2);
  real array input(1:2),outarr(1:3);
  real array dumpname,mtpool(1:2);
  zone cat(128,1,stderror);
  zone mtrecord(128,1,stderror);
\f


  procedure error(errorno);integer errorno;
  begin
    case errorno of
    begin
      <*1*>write(out,<:<10>*** Param error:>);
      <*2*>write(out,<:<10>*** Savecat does allready exist:>);
      <*3*>write(out,<:<10>*** Connect error =:>,outres);
      <*4*>write(out,<:<10>*** Creation of savecat not ok:>);
    end;
    write(out,<:<10>initialisation not ok:>,<:<10>:>);
    goto halt;
  end;
\f


  procedure openout;
  begin
    real array outname(1:2);
    outp:=true;
    outname(1):=input(1);outname(2):=input(2);
    fpproc(29)stack current out:(0,out,outarr);
    fpproc(28)connect out:(outres,out,outname);
    if outres <> 0 then
    begin
      outp:=false;
      fpproc(30)unstack out:(0,out,outarr);
      error(2);
    end;
  end;
  procedure closeout;
  begin
    if outp then
    begin
      fpproc(34)close up:(0,out,25);
      fpproc(30)unstack out:(0,out,outarr);
    end;
  end;
\f



  integer procedure readparam(val);real array val;
  begin
    own integer q;
    integer ik;
    readparam:=0;
    if q>=0 then q:=q+1;
    if q=1 then
    begin
      ik:=system(4,1,val);
      if ik = 6 shift 12 +10 then 
      begin
        system(4,0,val);
        readparam := -1;
      end
      else if ik<> 0 then goto p;
    end
    else
    if q > 0 then
    begin
p:    ik:=system(4,q-1,val);
      if ik = 0 then q := -1 else
      readparam := (if i shift (-12) = 8 then 2 else 0)
      +(if i extract 12 = 10 then 2 else 1)
    end
  end readparam;
\f


  procedure inittempcat;
  begin
    for i:=0 step 1 until hashentries do
    begin
      setposition(cat,0,i);
      outrec6(cat,512);
      for ik:=2 step 1 until 256 do
      begin
        a:=ik*2;
        cat.a:=-1;
      end;
      a:=2;
      cat.a:=0;
    end;
  end;

  dumpname(1):= real <:savec:> add 97;
  dumpname(2):= real <:t:>;
  antal:=2;lbase:=4;ubase:=6;
  hashentries:=0;bittsize:=0;
  outp:=false;
  if readparam(input) = -1 then openout;
  while readparam(input) <> 0 do
  begin
    if input(1) = real <:hashe:> add 110 and input(2) = real <:tries:>
       then
       begin
         i:=readparam(input);
         if i <> 1 then error(1);
         hashentries:=input(1);
       end;
    if input(1) = real <:bitts:> add 105 and input(2) = real <:ze:>
       then
       begin
         i:=readparam(input);
         if i <> 1 then error(1);
         bittsize:=input(1);
       end;
   end;
   if hashentries = 0 then hashentries:=217;;
   if bittsize = 0 then
   begin
     i:=1;
     mtpool(1):= real <:mtpoo:> add 108;
     mtpool(2):= real <::>;
     open(mtrecord,4,string mtpool(increase(i)),0);
     if monitor(42)lookup entry:(mtrecord,0,tail) <> 0 then bittsize:=1;
     inrec6(mtrecord,2);
     tapeantal:=mtrecord.antal;
     while tapeantal > 0 do
     begin
       bittsize:=bittsize+1;
       tapeantal:=tapeantal-24;
     end;
   end;
   i:=1;
   open(cat,4,string dumpname(increase(i)),0);
   system(11)get catalog base:(0,interval);
   i:=monitor(76)lookup head and tail:(cat,0,ttail);
   if i = 0 and ttail.lbase >= interval(7) and ttail.ubase <= interval(8)
      then error(2);
   tail(1):=hashentries;
   tail(2):= 1;
   for i:=3 step 1 until 10 do tail(i):=0;
   tail(9):= 11 shift 12;tail(10):= 16 + ( bittsize*2);
   i:=monitor(40)create entry:(cat,0,tail);
   if i <> 0 then error(4);
   i:=monitor(50)permanententry:(cat,3,tail);
   if i <> 0 then error(4);
   entrybase(1):=interval(5);entrybase(2):=interval(6);
   i:=monitor(74)set entry base:(cat,0,entrybase);
   if i <> 0 then error(4);
   inittempcat;
   close(cat,true);
   monitor(42)lookup entry:(cat,0,tail);
   tail(1):=hashentries;
   tail(6):=dumpensize;
   monitor(44)change entry:(cat,0,tail);
   write(out,<:<10>initialisation ok:>,<:<10>:>);
halt:
if outp then closeout;
fpproc(7)end_of_program:(0,0,0);
end;
▶EOF◀