|
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 - download
Length: 10752 (0x2a00)
Types: TextFile
Names: »monareatx «
└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
└─⟦a957ba283⟧
└─ ⟦this⟧ »monareatx «
monarea=set 1 disc1
scope user monarea
monarea=algol connect.no
begin
message monarea 891129/ho side 1a;
<* Program MONAREA udskriver areaprocesserne brugt af en given intern
proces.
Hvis udskrift sker til terminal vil den, hvis ikke stop er anført ved
kaldet, blive gentaget hver 10. sek., indtil den interne proces der
overvåges bliver fjernet, eller der bliver sendt att til den kaldende
proces efterfulgt af en stop-kommando, eller efter <max> repetitioner.
Efter attention kan der svares 'stop' eller angives et nyt procesnavn.
KALD:
=====
1
(<udfil>=) (MONAREA!MONAREAW!MONPROC!MONPROCW)
0 1 1
<procesnavn> (stop(.<max>) ) ,
0 0
*
(<indgangnavn>)
0
ÆNDRINGSHISTORIE:
=================
890803 ho: Original version.
891129 ho: Stopparameter indført o. a. småændringer.
901122 ho: Udskrift af sum af tilvækst i læst/skrevet tilføjet
910131 ho: Nyt procesnavn og stop efter max muliggjort.
910215 ho: Udskrift af (katalog-)indgange tilføjet
920327 cl: katalogindgange i wis-format (monareaw/monprocw)
udvidet katalogformat (rc9000 multipartitioner)
kun udskrift af tilgåede area's (monproc/monprocw)
*>
\f
message monarea 910215/ho side 1b;
integer proc_addr, area_size, max, nr, i, j, k, tilstand, rel,
ant_filer, kat_størrelse, antal_nøgler, partitioner, segmno,
index, første_fil,
first_area, first_internal, table_end, ant_intern,
ant_area, bit_arr_size, iwr, ird, stopcnt;
integer field proc, ant_indg;
integer array ia(1:20), c(1:1);
integer array field addr, paddr, cur, indgang;
boolean terminal, id, stop, fundet, wis, alle_ud, rsvd, wrpr;
boolean array test(1:1);
boolean array field baf;
long nøglesum;
long array procnavn, filnavn, name(1:2), linie(1:30);
long array field slaf, laf, laf0, enavn;
real r1, r, t, gl_t, ny_t, gl_c, ny_c;
zone zcat, zu(128,1,stderror), z(1,1,stderror);
procedure skriv_navn(z,navn);
zone z;
integer array field navn;
begin
boolean alfa,efter_alfa;
integer pos,tegn;
efter_alfa:=alfa:=false;
pos:=1;
repeat
alfa:=læs_tegn(c.addr.navn,pos,tegn)>96 and tegn<126
or (pos>2 and tegn>47 and tegn<58);
outchar(z,if alfa then tegn else
if -,efter_alfa and tegn=0 then 46<*.*> else
if tegn=0 then 32 else 33<*!*>);
efter_alfa:=efter_alfa or alfa;
until pos=12;
end skriv_navn;
\f
message monarea 910131/ho side 2;
reflectcore(c);
addr:=2;
replacechar(1,'.'); replacechar(4,',');
i:=system(4,1,name);
if i <> (6 shift 12 + 10) then i:=system(4,0,name);
wis:= name(2) shift (-32) extract 8 = 'w';
alle_ud:= name(1) shift 24 <> long<:pro:>;
første_fil:=2;
i:=system(4,1,procnavn);
if i = (6 shift 12 + 10) then
begin i:=system(4,2,procnavn); første_fil:=3; end;
if i<> (4 shift 12 + 10) then
begin
write(out,<:*** monarea: proces-navn mangler:>,"nl",1);
goto slut_kørsel;
end;
i:=system(4,første_fil,filnavn);
while i<>0 and (i<>(4 shift 12 +10) or filnavn(1)=long<:stop:>) do
begin
første_fil:=første_fil+1;
i:=system(4,første_fil,filnavn);
end;
ant_filer:=if i=(4 shift 12+10) then 1 else 0;
open(zcat,4,<:catalog:>,0);
monitor(42,zcat,0,ia);
katstørrelse:=ia(1);
antalnøgler:=ia(8);
partitioner:=ia(1)//ia(8);
stop:=findfpparam(<:stop:>,true,ia)>=0;
stopcnt:=ia(1);
forfra:
open(z,0,procnavn,0);
paddr:=proc_addr:=monitor(4,z,0,ia);
close(z,true);
if proc_addr=0 then
begin
write(out,<:*** monarea: processen :>,procnavn,<: findes ikke:>,"nl",1);
goto slut_kørsel;
end;
baf:=0;
rel:=c.addr.paddr.baf(11) extract 12 -4096;
id:=c.addr.paddr.baf(12);
first_area:=c.addr(76//2);
first_internal:=c.addr(78//2);
table_end:=c.addr(80//2);
ant_area:=(first_internal-first_area)//2;
ant_intern:=(table_end-first_internal)//2;
bit_arr_size:=((ant_intern+23)//24)*2*2;
i:=(first_internal-first_area)//2;
area_size:=j:=c.addr(first_area//2+1)-c.addr(first_area//2);
baf:=-1;
slaf:=18;
laf0:=laf:=0;
openfp(zu,0);
getzone6(zu,ia);
closefp(zu,false);
terminal:= ia(1) extract 12 =8;
\f
message monarea 891129/ho side 3;
begin
integer array ADR, WR, RD(1:ant_area);
boolean array set(1:ant_area);
for i:=1 step 1 until ant_area do
begin
set(i):=false;
ADR(i):=WR(i):=RD(i):=0;
end;
max:=0;
paddr:=monitor(4,z,0,ia);
systime(1,0,gl_t);
gl_c:=c.addr.paddr.laf0(14)/10000.0;
igen:
paddr:=monitor(4,z,0,ia);
k:=if paddr=0 then 0 else c.addr.paddr(5) extract 12;
tilstand:=if k=0 then 0
else if k=11<*running*> then 1
else if k=200<*w.f.CPU*> then 2
else if k=8<*running after error*> then 3
else if k=176<*w.f.stop by parent*> then 4
else if k=160<*w.f.stop by ancest*> then 5
else if k=184<*w.f.start by parent*> then 6
else if k=168<*w.f.start by ancest*> then 7
else if k=204<*w.f.procesfunction*> then 8
else if k=141<*w.f.message*> then 9
else if k=142<*w.f.answer*> then 10
else if k=143<*w.f.event*> then 11
else 12;
t:=if paddr=0 then 0.0 else c.addr.paddr.laf0(15)/10000.0;
systime(1,0,ny_t);
ny_c:=c.addr.paddr.laf0(14)/10000.0;
r:=ny_t-gl_t;
if r<0.1 then r:=0.1;
openfp(zu,0);
write(zu,"nl",1,"ff",1,
<:PROCES: :>,proc_navn,"sp",1,case tilstand+1 of (<:NEX:>,
<:RUN:>,<:WCP:>,<:RER:>,<:WSP:>,<:WSA:>,<:WsP:>,<:WsA:>,<:WPF:>,
<:WME:>,<:WAN:>,<:WEV:>,<:???:>),<< zd dd dd>,systime(5,0,r1),r1,
<: CPU::>,<<dd.ddd>,ny_c-gl_c,<: =:>,<<ddd.d>,(ny_c-gl_c)/r*100.0,
<: %:>,"nl",1,
<* <: STARTET::>,systime(4,t,r),r,"nl",1,*>
<:AREA LOW BASE HIGH BASE WRITE READ ACCESS' SEGM DOCUMENT:>);
gl_c:=ny_c; gl_t:=ny_t;
\f
message monarea 901123/ho side 4;
for i:=1 step 1 until max do set(i):=false;
proc:=first_area;
while proc<first_internal do
begin
cur:=c.addr.proc;
proc:=proc+2;
if (c.addr.cur.baf(rel) and id) extract 12<>0 then
begin
fundet:=false; j:=0;
for i:=1 step 1 until max do
begin
if ADR(i)=0 and j=0 then j:=i;
if ADR(i)=cur then
begin fundet:=true; nr:=i; i:=max+1; end;
end;
if not fundet then
begin
if j<>0 then
nr:=j
else
nr:=max:=max+1;
ADR(nr):=cur;
end;
set(nr):=true;
iwr:=c.addr.cur(14)-WR(nr);
ird:=c.addr.cur(15)-RD(nr);
WR(nr):=c.addr.cur(14);
RD(nr):=c.addr.cur(15);
rsvd:= (c.addr.cur(6) shift (-12) extract 12 -4096) = rel and
((false add (c.addr.cur(6) extract 12)) and id) extract 12 <> 0;
wrpr:= (c.addr.cur.baf(rel-2-bit_arr_size) and id) extract 12<>0;
if (iwr+ird <> 0) or alle_ud then
begin
outchar(zu,'nl');
skriv_navn(zu,cur);
j:=write(zu,<<-ddddddd>,c.addr.cur(-2),<:.:>,<<z>,c.addr.cur(-1));
write(zu,"sp",18-j,<< ddddddd>,WR(nr),RD(nr));
i:=if iwr<0 or ird<0 then -1 else iwr+ird;
if i>999 then i:=-1;
if i<0 then write(zu,<: -:>)
else write(zu,<< bdddddd>,i);
write(zu,<< ddddddd>,c.addr.cur(9),"sp",2);
write(zu,"sp",12-write(zu,c.addr.cur.slaf));
if rsvd then write(zu,<:R:>);
if wrpr then write(zu,<:W:>);
end;
end;
end;
if testbit(1) then write(zu,"nl",1,<:bi-arr-size :>,bit_arr_size,
ant_intern,table_end,first_internal);
ud(zu);
j:=0;
for i:=1 step 1 until max do
begin
if set(i) then j:=i
else ADR(i):=WR(i):=RD(i):=0;
end;
if max>j then max:=j;
\f
message monarea 910215/ho side 5a;
if ant_filer>0 then
begin
write(zu,"nl",1,"-",79);
ant_indg:=512;
enavn:=6;
index:=første_fil;
i:=1;
while i<>0 do
begin
i:=system(4,index,filnavn);
index:=index+1;
if i=(4 shift 12+10) and filnavn(1)<>long<:stop:> then
begin
integer i, j, k, nr, ant;
<* j:=hashnøgle(filnavn,katstørrelse); *>
nøglesum:= filnavn(1) + filnavn(2);
nøglesum:= nøglesum shift (-24) + nøglesum extract 24;
nøglesum:= nøglesum extract 24 +
(nøglesum shift (-12) shift 36)//(extend 1 shift 36);
nøglesum:= nøglesum shift 24 shift (-24);
segmno:= nøglesum mod katstørrelse;
j:= segmno mod antalnøgler;
setposition(zcat,0,segmno);
inrec6(zcat,512);
ant:=zcat.ant_indg;
nr:=k:=0;
while nr<ant do
begin
indgang:=k*34;
if zcat.indgang(1) shift(-3) extract 9 = j then
begin
if zcat.indgang.enavn(1)=filnavn(1) and
zcat.indgang.enavn(2)=filnavn(2) then
begin
skrivindg(linie,zcat.indgang,0,wis);
put_char(linie,81,0,6);
write(zu,"nl",1,linie);
end;
nr:=nr+1;
end;
k:=k+1;
if k>15 then
begin
k:=0;
getposition(zcat,0,i);
if i=katstørrelse-1 then setposition(zcat,0,0);
inrec6(zcat,512);
end;
end;
end;
end;
ud(zu);
end;
\f
message monarea 910131/ho side 5b;
name(1):=name(2):=0;
i:=monitor(4,z,0,ia);
if not stop_by_att(name) and i<>0 and terminal and (not stop or stopcnt>0) then
begin
stopcnt:=stopcnt-1;
closefp(zu,false);
if name(1)<>0 then
begin
tofrom(proc_navn,name,8);
goto forfra;
end;
systime(1,0,t);
ventetid(10.0+gl_t-t);
goto igen
end
else
begin
outchar(zu,'nl');
if i=0 then
write(zu,<:Processen: :>,proc_navn,<: eksisterer ikke!:>,"nl",1);
end;
end;
closefp(zu,false);
slut_kørsel:
trapmode:=1 shift 10;
message monarea 890720/ho slut;
end
lookup monarea monareatx
end
▶EOF◀