|
|
DataMuseum.dkPresents historical artifacts from the history of: RC4000/8000/9000 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC4000/8000/9000 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 1536 (0x600)
Types: TextFile
Names: »ramconx«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦this⟧ »ramconx«
;pal
clear user ramcon
ramcon=set 1 disc5
scope user ramcon
ramcon=algol list.no
\f
RAMAN KATALOG CON
external procedure ramcon(s1,s2,op);
integer s1,s2,op;
begin
long array BS(1:2);
boolean OK;
integer array t(1:10);
integer j,i,seg; integer field b;
zone ZBS(128,1,stderror);
for i:=s1 step 1 until s2 do
begin ramng(i,BS,1);
write(out,"nl",1,<:RA:>,<<ddd>,i);
if lookuptail(BS,t) <> 0 then
begin goto L;
end;
seg:=t(1); if t(8)>0 then seg:=seg-1;
OK:=true;
open(ZBS,4,BS,0);
if t(8)>0 then setposition(ZBS,0,1);
for j:=1 step 1 until seg do
begin inrec6(ZBS,512);
b:=2;
if j<seg and ZBS.b <> 255 then OK:=false;
if j=seg then
begin if ZBS.b < 65536 or ZBS.b > 65791 then OK:=false;
end;
if op>0 then
write(out,<< ddd>,ZBS.b);
end;
if t(8)>0 then
begin setposition(ZBS,0,0);
inrec(ZBS,128); if ZBS(21) <> i then OK:=false;
if op>0 then write(out,"nl",1,<:RA:>,<<ddd>,ZBS(21));
end
else
begin if op>0 then write(out,"nl",1,<:RA:>,<<d>,i);
end;
write(out,<< dd>,t(1),<< dddd>,t(9),t(10));
write(out,if OK then <: OK:> else <: NOT OK:>);
close(ZBS,true);
L:
end i; end; end
\f
▶EOF◀