|
DataMuseum.dkPresents historical artifacts from the history of: RC3500 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about RC3500 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 12288 (0x3000)
Types: TextFileVerbose
Names: »punchprom1t«
└─⟦2c55ea56f⟧ Bits:30001844 SW-save af projekt 1000, Alarm-system
└─⟦093e2ad1c⟧
└─⟦this⟧ »punchprom1t«
job hlv 3 1000 time 11 0 size 50000 perm mini 1000 10
(mode list.yes
punchprom1=set 1 mini
scope project punchprom1
punchprom1=algol list.yes xref.no bossline.yes
finis)
\f
begin
comment <area=>punchprom <func> <areas>
<func>::= mode.<modetype>, prom.<promparams>, check.<checkparams>
<modetype>::=8:8,4:<auto>,0:<boot>
<promparams>::= <firstadr>.<size>.<part>
<checkparams>::= <size>.<no-of-proms>.<mask>
<firstadr>, <size>, <no-of-proms>, <mask>::= integer
<part>::= l : r
version: 800825 hlv;
integer check,esc,mode,i,i0,j,p1,p2,sourceno,word, count;
long l;
real r;
integer field inf1;
integer array filename(0:11);
integer firstadr, promsize, promside,promno, errcnt, toterrcnt;
integer array table(0:255);
zone zi(128*2,2,stderror),zo(128,1,stderror), ptr(12,2,stderror);
procedure punch_word(mode);
value mode; integer mode;
begin
integer i,n,p;
word:=word extract 16;
for i:=word shift(-8), word extract 8 do
begin
check:=check+i;
if mode=8 then write(zo, false add i, 1) else
begin
for p:=i shift(-4) + 16, i extract 4 do
begin
p:=if p=0 then 96 else p+64;
p:=p extract 8;
write(zo, false add p, 1);
end;
end;
end;
end punch;
boolean procedure opennextsource(z, sourceno);
integer sourceno;
zone z;
begin
integer i, j, k, cnt, pno, file, block;
boolean first;
real array field ra;
integer array arr(1:10);
real array rarr(1:2);
procedure alarm;
begin
write(out, <:<10>connect file:>, <<-d>, sourceno, <:<10>:>);
goto slut;
end;
first:=true;
if sourceno>1 then close(z, true);
opennextsource:=true;
pno:=1;
if system(4, pno, rarr)=6 shift 12 + 10 then pno:=pno+1;
cnt:=k:=0;
for j:=system(4, pno, rarr) while cnt<>sourceno and(j<>0 or k<>0) do
begin
if k=4 shift 12 + 10 and (j shift(-12)=4 or j=0) then
cnt:=cnt+1;
k:=j;
pno:=pno+1;
end;
if cnt<>sourceno or pno<>2 and sourceno=0 then opennextsource:=false else
begin
system(4, pno-2, rarr);
cnt:=0;
for i:=0 step 1 until 11 do filename(i):=rarr(1+i//6)
shift(8*(i mod 6)-40)extract 8;
\f
loop:
i:=1;
if sourceno<>0 and mode >= 0 then
begin
write(out,<:<10>sourcefile: :>);
j:=12-write(out,string rarr(increase(i)));i:=1;
write(out,false add 32,j,<: segm: :>,count//750,
<: bytes: :>,((count mod 768)-3*(count//768)));
end;
open(z, 4, string rarr(increase(i)), 0);
if monitor(42, z, j, arr)<>0 then
begin
for j:=1 step 1 until 10 do arr(j):=0; arr(1):=1;
if monitor(40,z,j,arr)<>0 then alarm;
goto out1;
end;
if first then
begin
file:=arr(7);
block:=arr(8);
first:=false;
end;
if arr(1)<0 then
begin
ra:=2;
rarr(1):=arr.ra(1);
rarr(2):=arr.ra(2);
end;
if arr(1)=1 shift 23 + 4 then
begin
cnt:=cnt+1;
if cnt=100 then alarm;
close(z, false);
goto loop;
end;
if arr(1)<0 then
begin
j:=arr(1) shift(-12) extract 11;
k:=arr(1) extract 12;
if k>20 or k extract 1=1 or arr(1)=0 or j extract 1=1 or
j>(if k=10 or k=12 then 6 else if k=16 then 4 else if
k=18 then 2 else 0) then alarm;
j:=arr(1)extract 23;
if k=20 then j:=j+(14-20);
close(z, false);
k:=1;
open(z, j, string rarr(increase(k)), 0);
end not bsarea;
k:=arr(1) extract 12;
if k<>10 and k<>16 then setposition(z,file,block);
if sourceno<>0 then sourceno:=sourceno+1;
end;
out1:
end opennextsource;
\f
procedure examineparams;
begin
integer names;
names:=3;
begin
boolean first;
integer pno, j, i,paramfct;
real array rarr(1:2), name(1:names, 1:2);
integer array field ia;
procedure alarm;
begin
write(out, <:<10>params<10>:>);
goto slut;
end;
integer procedure type;
begin
type:= if i extract 12=4 then 1 else if rarr(1)=real<:yes:>
then 2 else if rarr(1)=real<:no:> then 3 else 4;
end;
for j:=1 step 1 until names do name(j,1):=name(j,2):=real<::>;
name(1,1):= real<:mode:>;
name(2,1):= real<:prom:>;
name(3,1):= real<:check:>;
mode:=8;
pno:=1;
if system(4,pno,rarr)=6 shift 12 + 10 then pno:=pno+1;
for j:=system(4,pno,rarr) while j<>0 do
begin
if j<>4 shift 12 + 10 then alarm;
for paramfct:=1 step 1 until names do
if name(paramfct,1)=rarr(1) and
name(paramfct,2)=rarr(2) then goto ud; ud:
first:=true;
for i:=system(4,increase(pno)+1,rarr)while i shift(-12)=8 do
begin comment .param;
case paramfct of
begin
begin comment mode;
if type=1 then
begin
if rarr(1)<>8 then alarm;
mode:=rarr(1);
paramfct:= names+2;
end else
if rarr(1)=real<:auto:> then
begin
mode:= 4;
paramfct:= names+2;
end else
if rarr(1)=real<:boot:> then
begin
mode:=0;
paramfct:=names+2;
end;
end mode first param;
begin comment prom;
if type = 1 then firstadr:= rarr(1) else alarm;
i:= system(4,increase(pno)+1,rarr);
if i shift (-12) <> 8 then alarm;
if type = 1 then promsize:= rarr(1) else alarm;
i:= system(4,increase(pno)+1,rarr);
if i shift (-12) <> 8 then alarm;
if type = 4 then
begin
if rarr(1) = real<:l:> then promside:= -8 else
if rarr(1) = real<:r:> then promside:= 0
else alarm;
end else alarm;
mode:= -1;
end prom;
begin comment check;
if type = 1 then promsize:= rarr(1) else alarm;
i:= system(4,increase(pno)+1,rarr);
if i shift (-12) = 8 and type = 1 then firstadr:= rarr(1) else alarm;
i:= system(4,increase(pno)+1,rarr);
if i shift (-12) = 8 and type = 1 then promside:= rarr(1) else alarm;
mode:= -2;
end check;
if -, first then alarm;comment not known;
alarm; comment no more points might follow;
end case paramfct of;
first:= false;
end paramlist;
end outer loop;
end inner block;
end examin params;
\f
;comment programstart;
examineparams;
if mode = -2 then
begin comment check;
open(ptr,8 shift 12 + 10,<:reader:>,0);
write(out,<:<10>prom compare, size: :>,promsize,<:, no of proms: :>,
firstadr,<:, mask: :>,promside,false add 10,2);
sourceno:= 1; toterrcnt:= 0;
for i:= 0 step 1 until 255 do table(i):= 7 shift 12 + i;
intable(table); table_index:= 0;
if -,opennextsource(zi,sourceno) then goto slut;
for promno:= 1 step 1 until firstadr do
begin
write(out,<:<10>prom no: :>,promno,false add 10,1);
errcnt:= 0;
for i:= readchar(ptr,p1) while p1<>255 do ;
for i:= readchar(zi ,p2) while p2<>255 do ;
for count:= 0 step 1 until promsize do
begin
readchar(ptr,p1); readchar(zi,p2);
if logand(p1,promside) <> logand(p2,promside) then
begin
if errcnt < 20 then write(out,<:adr: :>,count,<:, ptr: :>,
logand(p1,promside),<:, disc: :>,
logand(p2,promside),<:<10>:>);
errcnt:= errcnt + 1;
end;
end;
write(out,<:<10>:>,errcnt,<: errors in prom no: :>,promno,
false add 10,2);
end;
write(out,<:<10>:>,toterrcnt,<: errors in total compare<10>:>);
close(zi,true);
close(ptr,true);
goto slut;
end check;
if -,opennextsource(zo,0) then
open(zo,4 shift 12 +12,<:punch:>,0);
if mode>0 then write(zo,false,100,false add 64,1);
if mode=0 then goto mode0;
if mode < 0 then
begin <* prom *>
count:= 0;
sourceno:= 1;
write(zo,false,100,false add 255,1);
for i0:= 0 while opennextsource(zi,sourceno) do
begin
promblock:
inrec6(zi,512);
for inf1:= 2 step 2 until 512 do
begin
word:= zi.inf1;
if word < 0 then
begin
if count < firstadr then count:= firstadr;
write(out,<:<10>input too short, prom filled with :>,
firstadr+promsize-count,<: zeros<10>:>);
write(zo,false add 255,firstadr+promsize-count);
count:= firstadr + promsize;
end;
if count >= firstadr then
begin
if count < firstadr + promsize then
write(zo,false add ((word shift promside) extract 8),1)
else
begin
write(zo,false,100);
write(out,<:<10>prom punched succesfully<10>:>);
goto slut2;
end;
end;
count:= count + 1;
end block;
goto promblock;
promslut:
end source;
write(out,<:<10>*** input too short, prom incomplete ***<10>:>);
goto slut2;
end prom;
check:=0;
if mode=4 then
begin
count:=0;
sourceno:=1;
for i0:=0 while opennextsource(zi, sourceno) do
begin
nb:
inrec6(zi, 512);
for inf1:=2 step 2 until 512 do
begin
if zi.inf1<0 then goto sl1;
count:=count+2;
end;
goto nb;
sl1:
end;
word:=(count+258) extract 16;
punchword(mode);
end mode=4;
sourceno:= 1;
for i0:= 0 while opennextsource(zi,sourceno) do
begin
nextblock:
inrec6(zi,512);
for inf1:=2 step 2 until 512 do
begin
word:= zi.inf1;
if word<0 then goto slut1;
punch_word(mode);
end;
goto next_block;
slut1:
end;
word:=check;
punchword(mode);
goto slut;
\f
mode0:
sourceno:=1;count:=0;
for inf1:=2 while opennextsource(zi,sourceno) do
for inf1:=inf1 while inf1=2 do
if count mod 768=0 then
begin check:=0;
count:=count+write(zo,false,1,false add(765 shift(-8)extract 8),1,
false add(765 extract 8),1);
end else
if count mod 768=753 then
begin
<* write(out,<:<10>segmentno: :>,<<ddd>,count//768,<: checksum: :>);
for i:=-15,-12,-9,-6,-3,0 do outchar(out,48+((check shift i)extract 3)); *>
count:=count+15;
outchar(zo,check shift(-8)extract 8);
outchar(zo,check extract 8);outchar(zo,0);
for i:=0 step 1 until 11 do outchar(zo,filename(i));
end else
begin inrec6(zi,2);word:=zi.inf1;
if word<0 then inf1:=0 else
for i:=word shift(-8)extract 8,word extract 8 do
begin check:=(check-i)extract 16;
count:=count+write(zo,false add i,1);
end;
end;
i:=count mod 768;
if i<>0 then
begin <*fill last datasegment*>
if i<753 then write(zo,false,753-i);
write(zo,false add(check shift(-8)extract 8),1,
false add(check extract 8),1,false,1);
for i:=0 step 1 until 11 do outchar(zo,filename(i));
end <*fill last data segment*>;
write(zo,false,2,false add 15,1,<:rc3500fpaloader:>);
write(zo,true,2,false add((-3)extract 8),1);
write(zo,<:end rc3500bootloader :>);
write(out,<:<10>rc3500-bootloader: :>,(count//750)+1,<: segments<10>:>);
slut:
write(zo,false add 3,1,false add 25,3,false,100);
slut2:
close(zo,true);
monitor(42,zo,i,filename);
systime(1,0,r);l:=625*r;
filename(6):=l shift(-15)extract 24;
monitor(44,zo,i,filename);
end;
«eof»