DataMuseum.dk

top - metrics - download

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

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

TextFile

lookup discmove
if ok.yes
(scope temp discmove
clear temp discmove)
discmove=set 1
discmove=algol list.yes
1980-08-07
begin
boolean list;
integer lb,ub,segm,i,j,k,char,res,minsiz,maxsiz;
integer array field rec,tail;
long array field doc,name;
integer array bases(1:8),t(1:10);
array field d;
long array tname,disc,ename,fname,odoc(1:3);


rec:=0;
d:=0;
name:=6;
tail:=14;
doc:=16;
lookup_tail(<:catalog:>,t);
segm:=t(1);
readbfp(<:list:>,list,true);
readifp(<:min:>,minsiz,0);
readifp(<:max:>,maxsiz,63);
cleararray(disc);
if -,readlsfp(disc.d) then alarm("nl",1,"*",3,<:document not specified:>);
connectcuri(<:catalog:>);
setposition(in,0,0);
system(11,0,bases);
lb:=bases(5); ub:=bases(6);
for segm:=segm step -1 until 1 do
begin
  inrec6(in,512);
  for rec:=0 step 34 until 512-34 do
  begin
    if in.rec(1)<>-1 then
    begin
      if lb=in.rec(2) and ub=in.rec(3) then
      begin
        if in.rec.tail(1)>minsiz and in.rec.tail(1)<=maxsiz and
           in.rec(1) extract 3>=3 and
           (in.rec.doc(1)<>disc(1) or in.rec.doc(2)<>disc(2)) and
           in.rec.doc(1)<>long <:disc3:> then
        begin
        res:=generaten(tname);
        if res<>0 then alarm("nl",1,"*",3,<:generate name:>,res);
        for i:=1,2 do odoc(i):=in.rec.doc(i);
        for i:=1,2 do in.rec.doc(i):=disc(i);
        for i:=1,2 do fname(i):=in.rec.name(i);
        if false then write(out,"nl",1,"*",1,
            true,14,fname,
            true,14,tname,
            true,14,in.rec.doc);
        for i:=1 step 1 until 10 do t(i):=in.rec.tail(i);
        res:=createentry(tname,t);
        if res<>0 then alarm("nl",1,"*",3,<:create entry no resources:>,res);
        res:=permentry(tname,in.rec(1)extract(3));
        if res<>0 then alarm("nl",1,"*",3,<:permanent key :>,in.rec(1) extract 3,
           <: no resources:>,res);
        res:=set_en_base(tname,lb,ub);
        if res<>0 then alarm("nl",1,"*",3,<:set entry base :>,res,lb,ub);
        if list then write(out,"nl",1,true,12,fname,<< dddd>,
             in.rec(8),"sp",2,odoc,<: to :>,disc);
        i:=j:=1;
        disccopy(string fname(increase(i)),string tname(increase(j)));
        generaten(ename);
        res:=renameentry(fname,ename);
        if res<>0 then alarm("nl",1,"*",3,fname,
          <: cannot be renamed to :>,ename,res);
        res:=renameentry(tname,fname);
        if res<>0 then alarm("nl",1,"*",3,tname,
          <: cannot be renamed to :>,fname,res);
        removeentry(ename);
      end size>0;
      end user base;
    end entry;
  end record;
end segments;
end;
global discmove
▶EOF◀