DataMuseum.dk

top - download

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

└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
    └─⟦a957ba283⟧ 
        └─ ⟦this⟧ »skrivindgtx « 

TextFile

skrivindg=set 1
skrivindg=algol
external
message procedure skrivindgang side 1. hko 860924;

procedure skrivindgang(linie,head_and_tail,nr,ord);
  value nr; integer                        nr;
  boolean                                     ord;
  long array           linie;
  integer array              head_and_tail;

<* skrivindgang udskriver en katalogindgang
   med samme format som benyttes af 'lookup'.

   kald:             skrivindgang(linie,head_and_tail);

   linie             (kald, long array) long array hvori katalog-
                     indgangen udskrives.

   head_and_tail     (kald, integer array) længde mindst
                     17 elementer. skal indeholde en katalog-
                     ingang, f. eks. tilvejebragt ved:
                        monitor(76,zentry,0,head_and_tail);

   nr                (kald, integer) indgang-nummer. Hvis nr<=0 så
                     udskrives nummer ikke.

   ord               (kald, boolean) hvis true udskrives tail(7)
                     til tail(10) som integers.

   fejlreaktioner:

       ingen.

   kaldte procedurer:

     ingen.
*>
\f

message procedure skrivindgang side 2. hko 860924;

  begin
     integer i,j,k,l,pos;
     integer array ib(1:8);
     real r;
     real array ra(1:2);
     real array field raf;
     boolean bs;
     long array navn(1:2);

     pos:=i:=1;
     bs:=false;
     raf:=6;
     if nr>0 then
     begin
       put_number(linie,pos,<<dddd>,nr);
       put_char(linie,pos,'sp');
     end;
     j:=put_text(linie,pos,head_and_tail.raf);
     put_char(linie,pos,'sp',12-j);
     i:=head_and_tail(8);
     if i shift (-12)>=2048 then
     begin                              <* modekind *>
       movestring(ra,1,case i extract 12//2 + 1 of (
             <:ip:>,<:kind.2:>,<:bs:>,<:kind.6:>,
             <:tw:>,<:tr:>,<:tp:>,<:lp:>,<:cr:>,<::>,<:pl:>));
       j:=put_text(linie,pos,ra);
       bs:= i extract 12 = 4;
       if i extract 12=10  or i extract 12=12 then
         j:=j+put_char(linie,pos,case (i shift (-12)-2046)//2 of (
               'o','e','n','f','t'))
       else if i extract 12=18 then
       begin
         if i shift (-12) extract 11 <128 then
           movestring(ra,1,case (i shift (-12)-2046)//2 of (
                 <:mtlh:>,<:mte:>,<:mtll:>,<:nrze:>))
          else
            movestring(ra,1,case (i shift (-12) -2046 -128)//2 of (
                 <:mthh:>,<:mth2:>,<:mthl:>));
         j:=j+put_text(linie,pos,ra);
       end
     end else
     begin
       j:=pos;
       put_number(linie,pos,<<d>,i);              <* size *>
       j:=pos-j;
     end;
     i:=1;
     raf:=16;
     k:=pos;
     put_char(linie,pos,'sp',7-j);
     put_text(linie,pos,head_and_tail.raf);
     put_char(linie,pos,'sp');
     j:=j+pos-k;
     i:=head_and_tail(16) shift (-12); <* contents *>
     i:=if (i=4 or i>32) then 13 else 14;
     if i<>13 and head_and_tail(13)<>0 then
     begin
       put_char(linie,pos,'sp',19-j);
       k:=pos;
       movestring(ra,1,<:d.:>);
       put_text(linie,pos,ra);
       put_number(linie,pos,<<dddddd>,systime(6,head_and_tail(13),r));
       put_char(linie,pos,'.');
       put_number(linie,pos,<<zddd>,(r-20)/100);
       put_char(linie,pos,'sp');
       j:=pos-k;
<*     j:=write(z,<:d.:>,<<dddddd>,systime(6,head_and_tail(13),r),
                 <<zddd>,<:.:>,(r-20)/100,"sp",1);
*>   end
     else
     begin
       i:=13;
       put_char(linie,pos,'sp',19-j);
       j:=0;
     end;
     k:=pos;
     for i:=i step 1 until 17 do
     begin
       if ord then
         put_number(linie,pos,<<d>,head_and_tail(i))
       else
       begin
         if head_and_tail(i) shift (-12) <>0 then
         begin
           put_number(linie,pos,<<d>,head_and_tail(i) shift (-12));
           put_char(linie,pos,'.');
         end;
         put_number(linie,pos,<<d>,head_and_tail(i) extract 12);
       end;
       put_char(linie,pos,'sp');
     end;
     j:=j+pos-k;
\f

message procedure skrivindgang side 3. hko 860924;

<*    k:=head_and_tail(1) extract 3;
      system(11,i,ib);    (* catalog bases *)
*>

     put_char(linie,pos,'sp',30-j);
     put_char(linie,pos,';');

<*    if bs then
      begin
        integer i,j;
        integer array wrk,ent(1:20);
        zone z1(1,1,stderror);
        long array field laf;

        tofrom(ent,head_and_tail,34);
        repeat
          tofrom(wrk,ent,34);
          getzone6(z1,ent);
          for i:=1,2,3,4 do
            ent(i+1):=wrk(i+8);
          setzone6(z1,ent);
          j:=monitor(76) lookup head and tail:(z1,1,ent);
        until j<>0;
        tofrom(navn,wrk.raf,8);
      end;
*>
     put_number(linie,pos,head_and_tail(1) extract 3);
     put_number(linie,pos,head_and_tail(2));
     put_number(linie,pos,head_and_tail(3));
     put_char(linie,pos,0,6);
  end skrivindgang;
end;
l skrivindg skrivindgtx
▶EOF◀