DataMuseum.dk

top - metrics - download

    Length: 6144 (0x1800)
    Types: TextFile
    Names: »tinitmtpool«

└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
    └─⟦b2ec5d50f⟧ 
        └─⟦2cfec6318⟧ »incsys« 
            └─⟦this⟧ 
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ.  Detaljer om "HC8000" projekt.
    └─⟦0364f57e3⟧ 
        └─⟦70d387dbb⟧ »incsys« 
            └─⟦this⟧ 

TextFile

initmtpool =algol list.yes

begin
  message vk 1981.02.06 initmtpool;
  comment
     *******************************************************************
     *                                                                 *
     * This program initialises the mtpool. It can be called with two  *
     * parameters, one indicating how many totaltapes you will have    *
     * in the mtpool and the other indicating how many tapes you will  *
     * have in the whole mtpool.                                       *
     * The program shall be called in the following way:               *
     *                                                                 *
     *    <outfile>=initmtpool total.<integer> all.<integer>           *
     *                                                                 *
     * The error message are:                                          *
     *        *** Param error                                          *
     *        *** Mtpool does exist                                    *
     *        *** Mtpool can not be created                            *
     *        *** Connect error = <outres>                             *
     *                                                                 *
     ******************************************************************* ;

  boolean outp;
  integer outres,i;
  real array input(1:2);
  real array outarr(1:3);
\f


  procedure error(errorno);integer errorno;

  begin
    case errorno of
    begin
      <*1*>write(out,<:<10>*** Param error:>);
      <*2*>write(out,<:<10>*** Mtpool does exist:>);
      <*3*>write(out,<:<10>*** Mtpool can not be created :>);
      <*4*>write(out,<:<10>*** Connect error = :>,outres);
    end;
    write(out,<:<10> initmtpool 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(4);
    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
    comment
      This procedure reads the parameters in the FILE Processor com-
            mand, which called the algol program.;
    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


  real array inp,mtpool(1:2);
  integer array tail(1:10),ttail(1:17);
  zone mtrecord(128,1,stderror);
  integer j,k,noofttape,nooftape;
  integer array entrybase(1:2),interval(1:8);
  integer field mtnr,mtdate,mttotal,mtrsize,antal,mtno,lbase,ubase;
  real array field mtname,tadocname;
  system(11)get catalog base:(0,interval);
  mtrsize:=16;
  lbase:=4;ubase:=6;
  outp:=false;
  mtnr:=2;
  mtname:=2;
  mtdate:=12;
  mttotal:=14;
  mtno:=16;
  for i:=readparam(inp) while i<>0 do
  begin
    if i = -1 then openout;
    if inp(1) = real <:total:> then
    begin
      i:=readparam(inp);
      if i <> 1 then error(1) else noofttape:=inp(1);
    end;
    if inp(1) = real <:all:> then
    begin
      i:=readparam(inp);
      if i <> 1 then error(1) else nooftape:=inp(1);
    end;
  end;
  if noofttape > nooftape then
  error(1);
  mtpool(1):= real <:mtpoo:> add 108;
  mtpool(2):= real <::>;
  i:=1;
  open(mtrecord,4, string mtpool(increase(i)),0);
  tail(1):=3;
  tail(2):= 1;
  tail(3):= 0;
  for i:= 4 step 1 until 10 do tail(i):= 0;
  i:=monitor(76)lookup head and tail:(mtrecord,0,ttail);
  if i = 0 and ttail.lbase >= interval(7) and ttail.ubase <= interval(8)
     then error(2);
  tadocname:=2;
  tail.tadocname(1):= real <:disc2:>;
  tail.tadocname(2):= real <::>;
  i:= monitor(40) create entry :(mtrecord,0,tail);
  if i <> 0 then
  error(3);
  i:=monitor(50)permanent entry:(mtrecord,3,tail);
  if i<> 0 then
  error(3);
  entrybase(1):=interval(5);entrybase(2):=interval(6);
  i:=monitor(74)set entry base:(mtrecord,0,entrybase);
  if i <> 0 then
  error(3);
  outrec6(mtrecord,2);
  antal:=2;
  mtrecord.antal:=nooftape;
  for i:= 1 step 1 until nooftape do 
  begin
    outrec6(mtrecord,mtrsize);
    mtrecord.mtnr:=i;
    mtrecord.mtname(1):= real <:mtsa0:> add 48;
    j:=i mod 10 +48;
    k:=i//10 +48;
    mtrecord.mtname(2):=
    (((( 0.0 shift (-48))add k ) shift 8) add j) shift 32;
    mtrecord.mtdate:=0;
    if i <= noofttape then mtrecord.mttotal:=1 else mtrecord.mttotal:=0;
    mtrecord.mtno:=0;
  end;
  outrec6(mtrecord,mtrsize);
  mtrecord.mtnr:=-1;
  mtrecord.mtname(1):=-1;mtrecord.mtname(2):=-1;
  mtrecord.mtdate:=-1;mtrecord.mttotal:=-1;
  close(mtrecord,false);
  i:=monitor(42)lookupentry:(mtrecord,0,tail);
  tail(1):=nooftape//31+1;
  i:=monitor(44)changeentry:(mtrecord,0,tail);
  write(out,<:<10>initialisation ok:>,<:<10>:>);
halt:
if outp then closeout;
fpproc(7)end_of_program:(0,0,0);
end;
▶EOF◀