DataMuseum.dk

top - metrics - download

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

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

TextFile

(contract entry.proclib close6txt
cleaner=algol
end)
begin
algol copy.close6txt;
integer i,j;
boolean skipbits;
real array arr(1:2);
procedure error(cause);
integer cause;
begin
write(out,<:<10>***cleaner :>,
case cause of (
<:no object file:>,
<:syntax at skip:>,
<:sequence error at source:>,
<:object file could not be created:>,
<:object file protected or in use:>,
<:skip bracket not closed:>,
<:input source not area:>,
<:***:>),<:<10>:>);
goto abend;
end error;

if system(4,1,arr) <> 6 shift 12 + 10 then error(1);
system(4,3,arr);
skipbits:= false;
if arr(1) <> real <:skip:> then error(2);
i:= 4;
while system(4, i, arr) = 8 shift 12 +  4 do
begin
skipbits:= skipbits or (false add (1 shift arr(1)));
i:= i+1;
end;
 
begin
zone object,source(128*2,2,stderror);
integer array tail(1:10),indescr(1:20);
long array field name;
integer partition,slabel,currcharout;

procedure search (z);
<*******************>
zone z;
begin
integer class,pos,i,j;
boolean found;
integer array line(1:132);
 
 
repeat
pos:=1;
for class:=readchar(z,line(pos)) while class <> 8 do pos:=pos+1;
if (line(1) = 60   <* < *> and
(line(1+1) = 42 <* * *> and
(line(1+2) = 43 <* + *> and
(line(1+4) = 42 <* * *> and
line(1+5) = 62 <* > *> )))) then
begin
i:= line(1+3) - 48;
if (i > 0 and i < 10) and skipbits shift (-i) then
begin  <* skip until closing bracket *>
repeat
pos:=1;
for class:= readchar(z, line(pos)) while class <> 8 do pos:= pos+1;
if line(pos) = 25 then
begin
close(object, true);
error(6);
end;
found:= true;
for j:= 0 step 1 until 5 do
begin
if line(j+1) <> (case (j+1) of (60, 42, 45, i+48, 42, 62))
then found:= false;
end;
until found;
end
else
for i := 1 step 1 until pos do outchar(object,line(i));
end
else
for i:=1 step 1 until pos do outchar(object,line(i));
until line(pos) = 25;
end search;

system(4,0,arr);
i:=1;
open(object,4,string arr(increase(i)),0);
if monitor(42) lookup entry :(object,0,tail) <> 0 then
begin
tail(1):=50;
for i:=2 step 1 until 10 do tail(i):=0;
if monitor(40) create entry :(object,0,tail) <> 0 then error(4);
end;
if monitor(52,object,0,tail) + monitor(8,object,0,tail) <> 0 then error(5);
name:=2;
getzone6(in,indescr);
if indescr(1) <> 4 then error(7);
open(source,indescr(1),indescr.name,0);
search(source);
close(source,true);
outchar(object,25);
close6(object,true);
end;
abend:
end
▶EOF◀