|
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: »ramputx«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦this⟧ »ramputx«
clear user put
put=set 1 disc5
scope user put
put=algol
\f
RAMAN ANALYSE PUT
external procedure put(navn,n1,n2,S);
long array navn; integer n1,n2; array S;
begin integer s1,s2,p1,p2,q,r,j,k,d;
zone z(128,1,stderror);
s1:=(n1-1)//128; p1:=n1-s1*128; q:=1-p1; r:=128+q;
s2:=(n2-1)//128; p2:=n2-s2*128;
d:=s2-s1;
open(z,4,navn,0);
setposition(z,0,s1+2); swoprec(z,128);
if d=0 then
begin for j:=p1 step 1 until p2 do z(j):=S(j+q);
goto slut;
end
else for j:=p1 step 1 until 128 do z(j):=S(j+q);
for k:=0 step 1 until d-2 do
begin swoprec(z,128);
for j:=1 step 1 until 128 do
z(j):=S(r+j+k*128);
end;
swoprec(z,128);
for j:=1 step 1 until p2 do z(j):=S(j+r+k*128);
slut: close (z,true); end; end
\f
▶EOF◀