DataMuseum.dk

top - metrics - download

    Length: 4608 (0x1200)
    Types: TextFile
    Names: »tlistmtpool«

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

TextFile

listmtpool=algol 

begin
  message vk 1982.03.21 listmtpool ;

  comment
     *******************************************************
     *                                                     *
     * This program is used to list the mtpool. It can be  *
     * called in the following way :                       *
     *                                                     *
     *      <outfile>=listmtpool                           *
     *                                                     *
     * Errormessages are :                                 *
     *      *** Mtpool does not exist                      *
     *      *** Connect error = <outres>                   *
     *                                                     *
     ******************************************************* ;
  boolean outp;
  integer outres,i;
  real array input(1:2);
  real array outarr(1:3);
  zone zhelp(1,1,stderror);
  integer array tail(1:10);
  integer lineno,pageno;
  procedure pageshift;
  begin
    lineno:=lineno+1;
    if lineno >= 63 then
    begin
      lineno:=1;
      write(out,<:<12>:>,"sp",60,<:pageno:>,pageno);
      pageno:=pageno+1;
    end;
  end;


  procedure error(errorno);integer errorno;
  begin
    case errorno of
    begin
      <*1*>write(out,<:<10>Mtpool does not exist:>);
      <*2*>write(out,<:<10>***Connect error = :>,outres);
    end;
    write(out,<:<10>list 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 list;
  begin
    integer ntape,i,j,k,mtrsize;
    integer field antal,mttotal,mtnr,mtdate;
    real array field name;
    real array mtpool(1:2);
    zone mtrecord(128,1,stderror);

    procedure outshortclock(shortclock);
    integer shortclock;
    begin
      real r1;
      integer r;
      r:=shortclock;
      write(out,<: used on :>,<<zddddd.dddd>,systime(6,r,r1)+r1/1000000);
    end;
    mtpool(1):= real <:mtpoo:> add 108;
    mtpool(2):= real <::>;
    antal:=2;name:=2;mtdate:=12;mtrsize:=16;mttotal:=14;mtnr:=2;
    i:=1;
    lineno:=1;pageno:=1;
    open(mtrecord,4,string mtpool(increase(i)),0);
    i:=monitor(42)look up entry:(mtrecord,0,tail);
    if i <> 0 then error(1);
    inrec6(mtrecord,2);
    ntape:=mtrecord.antal;
    lineno:=63;pageshift;
    write(out,<:<10>List of mtpool:>,<:<10>--------------:>);
    pageshift;
    for i:=1 step 1 until ntape do
    begin
      j:=1;inrec6(mtrecord,mtrsize);
      if mtrecord.mtnr <> -1 then
      begin
        if mtrecord.mtnr < 10 then
        write(out,<:<10> nr   :>,mtrecord.mtnr)
        else
        write(out,<:<10> nr  :>,mtrecord.mtnr);
        write(out,<:   :>,string mtrecord.name(increase(j)));
        if mtrecord.mttotal extract 4 = 0 
        then write(out,<:  daily  :>);
        if mtrecord.mttotal extract 4 = 1 then write(out,<:  weekly :>);
        if mtrecord.mttotal extract 4 = 2 then write(out,<:  mountly:>);
        write(out,"sp",2);
        if mtrecord.mtdate <> 0 then
        outshortclock(mtrecord.mtdate) else
        write(out,<: not used:>);
        if mtrecord.mttotal shift (-10) extract 1 = 0 and
            mtrecord.mtdate <> 0 then
        write(out,<:  continuation tape:>);
      pageshift;
      end;
    end;
    write(out,<:<10> :>,<:<10>:>);
    close(mtrecord,true);
  end;
  outp:=false;
  if readparam(input) = - 1 then openout;
  list;
  write(out,<:<10>:>);
  if outp then closeout;
halt:
  fpproc(7)end_of_program:(0,0,0);

end;
▶EOF◀