DataMuseum.dk

top - metrics - download

    Length: 3840 (0xf00)
    Types: TextFile
    Names: »tmtread«

└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
    └─⟦4334b4c0b⟧ 
        └─⟦162d2eb5b⟧ »talgprog« 
            └─⟦this⟧ 

TextFile

;ali time 5 0
mode list.yes
lookup tmtread
mtread=set 1
global mtread
lookup mtreadlist
if ok.yes
mode 15.yes
mtread=algol blocks.yes connect.no 
reads a magnetic tape to a bs area independant of blocklength
1979-08-22
Anders Lindgård
begin
integer maxz;
readifp(<:max:>,maxz,1000);
begin
integer i,j,k,block_size,cardc,char,file,char1,char2,char3,lastc,ii;
integer array field ia;
boolean list,odd,cards,ebcd,ebcdic,ascii;
integer array c(1:3),card(1:80),ebcd_t(0:255);
array iname,oname(1:3);
zone inp(maxz,1,repair),outp(128,1,stderror);
algol copy.ebcd;
algol copy.ebcdic;

procedure repair(z,s,b);
zone z; integer s,b;
if s shift(-21) extract 1=1 then
begin
  <*timer*>
end else
if s shift(-19) extract 1=1 then
begin
  alarm("nl",2,<:blocklength error:>,b,
        "nl",1,<:increase blocklength<10>call:<10>mtread max.<max>
where <max> > :>,maxz);
end else
if b>0 and s shift (-22) extract 1=1 then
begin
write(out,"nl",1,"*",2,<:parity error:>,"nl",1);
end else
if b>0 and s shift (-7) extract 1=1 then
begin
integer j,k,l,erc;
integer field in;
in:=b+2;
erc:=0;
j:=z.in;
for k:=0,-8,-16 do
begin
  l:=j shift k extract 8;
  if l=0 then
  begin
    erc:=erc+1;
    if ebcd or ebcdic then z.in:=integeror(z.in,255 shift (-k));
  end;
end;
if erc<0 or erc>2 then write(out,"nl",1,"*",3,<:word defect :>,erc);
  
end else stderror(z,s,b);

procedure insert(z,card,i,c,k);
value k; integer i,k;
integer array card,c;
zone z;
if c(k)>0 and c(k)<255 and -,list then
begin
integer l;
  card(i):=if ebcd or ebcdic then ebcdt(c(k)) 
          else c(k)-(if c(k)>128 then 128 else 0);
  i:=i+1;
  if i>80 then
  begin
    i:=1;
    if cards then write(z,"nl",1);
    for l:=1 step 1 until lastc do write(z,false add card(l),1);
  end;
end insert;

cleararray(oname); cleararray(iname);
if -,readinfp(iname,1) then alarm(<:input missing:>);
readbfp(<:list:>,list,false);
readbfp(<:odd:>,odd,false);
readbfp(<:ebcd:>,ebcd,false);
if ebcd then initebcd(ebcdt);
readbfp(<:ascii:>,ascii,true);
readbfp(<:ebcdic:>,ebcdic,-,ascii);
if ebcdic then init_ebcdic(ebcdt);
ascii:=ascii and -,ebcd and -,ebcdic;
if readbfp(<:even:>,odd,odd) then odd:=-,odd;
readifp(<:lastchar:>,lastc,72);
readifp(<:file:>,file,0);
readbfp(<:cards:>,cards,-,ascii);
ia:=0;
i:=1;
open(inp,if odd then 2 shift 12+18 else 18,string iname(increase(i)),0);
setposition(inp,file,0);
cardc:=1;
write(out,"nl",1,if ascii then <:ascii:> else
   if ebcd then <:ebcd:> else
   if ebcdic then <:ebcdic:> else <:?:>,"sp",2,<: mode:>);
outendcur(10);
connectlso;
for blocksize:=inrec6(inp,0) while blocksize>=2 do 
  begin
    if list then write(out,"nl",2,<:blocksize :>,blocksize);
    inrec6(inp,blocksize);
    j:=blocksize//2;
    for i:=1 step 1 until j do
    begin
    c(1):=inp.ia(i) shift (-16) extract 8;
    c(2):=inp.ia(i) shift ( -8) extract 8;
    c(3):=inp.ia(i) shift (  0) extract 8;
    if list then
    begin
        write(out,"nl",if i mod 6=1 then 1 else 0,
          if i mod 6<>1 then <:  ,  :> else <::>,
           << dd>,c(1),c(2),c(3),
         "sp",2);
    end;
     if ascii and -,cards then
     begin
       for ii:=1,2,3 do
       begin
       char1:=c(ii);
       if char1>128 then char1:=char1-128;
       if char1='em' then 
          write(out,<:<'<'>25<'>'>:>) else
       if char1>0 then outchar(out,char1);
       end;
     end
     else
     begin
        insert(out,card,cardc,c,1);
        insert(out,card,cardc,c,2);
        insert(out,card,cardc,c,3);
      end cards;
    end for i;
  end read;
end
write(out,"nl",2);
if fpout then closeout;
end;
mode list.no 15.no
▶EOF◀