DataMuseum.dk

top - metrics - download

    Length: 3072 (0xc00)
    Types: TextFile
    Names: »tinittemcat«

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

TextFile

inittempcat = algol 
begin
message vk 1981.10.20 inittempcat;
comment
   ***********************************************************
   *                                                         *
   * This program is used to initalise the tempcat. It is    *
   * called in the following way:                            *
   *       inittempcat                                       *
   *                                                         *
   * Errormessages are:                                      *
   *      *** Tempcat does not exist                         *
   *      *** Creation of tempcat not ok                     *
   *                                                         *
   *********************************************************** ;
zone cat(128,1,stderror);
integer ik,i;
integer array tail(1:10),interval(1:8),ttail(1:17),entrybase(1:2);
real array tname(1:2);
integer field lbase,ubase;
\f


  procedure error(errorno);integer errorno;
  begin
    case errorno of 
    begin
      <*1*>write(out,<:<10>*** Tempcat does exist:>);
      <*2*>write(out,<:<10>*** Creation of tempcat not ok:>);
    end;
    write(out,<:<10> inittempcat not ok :>,<:<10>:>);
    goto halt;
  end error;

\f


  procedure inittempcat;
  begin
  comment
   **********************************************************
   *                                                        *
   * Thisprocedure is used to initialise tempcat, that is   *
   * insert -1 in all the words of tempcat.                 *
   *                                                        *
   **********************************************************;
    integer field a;
      setposition(cat,0,0);
      outrec6(cat,512);
      for ik := 1 step 1 until 256 do
      begin
        a:=ik*2;
        cat.a:=-1;
      end;
  end inittempcat;
tname(1):=real <:tempc:> add 97;
tname(2):=real <:t:>;
i:=1;open(cat,4,string tname(increase(i)),0);
i:=monitor(76)lookup head and tail:(cat,0,ttail);
system(11)get catalogbase:(0,interval);
lbase:=4;ubase:=6;
if i = 0 and ttail.lbase >= interval(7) and ttail.ubase <= interval(8)
   then error(1);
tail(1):=1;tail(2):=1;
tail(3):=0;tail(4):=0;tail(5):=6;
tail(9):=11 shift 12;
tail(7):=0;tail(8):=0;
tail(10):=0;
i:=monitor(40)create entry:(cat,0,tail);
if i <> 0 then error(2);
i:=monitor(50)permanent entry:(cat,3,tail);
if i<> 0 then error(2);
entrybase(1):=interval(5);entrybase(2):=interval(6);
i:=monitor(74)set entry base:(cat,0,entrybase);
if i <> 0 then error(2);
inittempcat;
close(cat,true);
write(out,<:<10>inittempcat ok:>,<:<10>:>);
halt:
fpproc(7)end_of_program:(0,0,0);
end ;
▶EOF◀