|
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: 96768 (0x17a00)
Types: TextFile
Names: »procstx «
└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
└─⟦a957ba283⟧
└─ ⟦this⟧ »procstx «
procs=set 1 disc1
scope user procs
procs=algol connect.no
begin
message procs 880530/ho side 1;
<* Program procs skriver en liste over interne processer og frie hoved-
lager områder.
Kald:
=====
1 1 1
(<udfil>=) procs (alle) (døde)
0 0 0
Parameter 'alle' angiver at også monitors processer listes.
Parameter 'døde' angiver at også nedlagte processer listes.
Kaldte procedurer:
==================
closefp,
openfp.
Ændringshistorie:
=================
880530 ho: Original version.
900523 ho: Prioritet skrives også.
*>
\f
message procs 900523/ho side 2;
boolean
alle, døde;
integer
int_ant, første_int, adr,
int_størrelse,
noofrecs, result, explanation,
reclgd,
ant, nr,
sadr, maxadr, prevtop, tilstand,
i, j, k;
integer field
parent,
faddr, taddr,
pdesc,
buf, area,
status, prio;
integer array
keydescr(1:2<*noofkeys*>,1:2),
param(1:7),
proc(-2:60),
wrkstore(1:10),
ia(1:20);
integer array field
iaf;
long array
hostnavn(1:2),
filnavn(1:2),
rec(1:10),
procs(1:10*24);
long field
starttid,
cpu;
long
ll;
long array field
laf,
navn;
real
r, t,
eof;
real array
names(1:6);
real array field
raf;
zone
z(1,1,stderror),
zu, zp, z1, z2(128,1,stderror);
\f
message procs 900523/ho side 3;
copyout;
parent:=2;
faddr:=4;
taddr:=6;
pdesc:=8;
navn:=8;
buf:=18;
area:=20;
cpu:=24;
starttid:=28;
status:=30;
prio:=32;
reclgd:=32;
iaf:= 2;
hostnavn(1):=hostnavn(2):= long<::>;
open(z,0,<:jobhost:>,0);
if monitor(42)lookup:(z,0,ia)=0 then tofrom(hostnavn,ia.iaf,8);
close(z,true);
ll:=0;
laf:=raf:=0;
openfp(zu,0);
alle:=findfpparam(<:alle:>,true,ia)>=0;
døde:=findfpparam(<:døde:>,true,ia)>=0;
system(5,78,ia);
intant:=(ia(2)-ia(1))//2;
første_int:=ia(1);
wrkstore(1):=28;
wrkstore(2):=1;
open(zp,4,<::>,0);
i:=monitor(40)create entry:(zp,0,wrkstore);
if i>0 then
system(9,i+0*write(zu,"nl",1,<:*** procs: create entry :>,
case i of (<::>,<:catalog fejl:>,<::>,<:ingen bs-ressourcer:>,<::>,<::>,
<:intet maincatalog:>)),<:monitor40:>);
\f
message procs 900523/ho side 4;
begin
integer array intprocref(1:intant);
system(5,første_int,intprocref);
int_størrelse:=(intprocref(2)-intprocref(1));
ant:=0;
for i:=1 step 1 until intant do
begin
adr:=intprocref(1)-4+intstørrelse*(i-1);
iaf:=-6;
system(5,adr,proc.iaf);
if testbit(1) or testbit(2) then outchar(zu,'ff');
if testbit(2) then
begin
write(zu,"nl",2,<:PROCESBESKRIVELSE:>,i,"nl",2);
skrivtotal(zu,proc.iaf.raf,intstørrelse,0);
end;
iaf:=0;
rec.parent:=proc(25); <*parent descr addr*>
if true <*!!!!!*> and proc(50)<proc(11) then
begin
rec.faddr:=proc(11)+ <*første addr*>
proc(49); <*curr. base*>
rec.taddr:=proc(12)+ <*top addr*>
proc(49); <*curr. base*>
end
else
begin
rec.faddr:=proc(50); <*første addr*>
rec.taddr:=proc(51); <*top addr*>
end;
rec.pdesc:=adr+4; <*proc descr addr *>
rec.buf:=proc(13)shift (-12);
rec.area:=proc(13) extract 12;
rec.cpu:=proc.laf(14);
rec.starttid:=proc.laf(15);
rec.status:=proc(5);
rec.prio:=proc(15);
raf:=0;
laf:=0;
tofrom(rec.navn,proc.laf,8);
if alle or rec.iaf(5)<> 0 and rec.iaf(2)>8 then
begin
if testbit(1) then
begin
write(zu,"nl",2,<:PROC-REC:>,i,"nl",2);
skrivtotal(zu,rec.raf,reclgd,0);
end;
open(z2,0,rec.navn,0);
close(z2,true);
j:=monitor(4,z2,0,ia);
<* if j=0 and rec.faddr>8 then rec.status:=0; *>
if rec.navn.iaf(1)=0 then
rec.navn.iaf(1):='.' shift 8 add '.' shift 8 add '.';
outrec6(zp,reclgd);
tofrom(zp,rec,reclgd);
ant:=ant+1;
end;
end;
end;
setposition(zp,0,0);
\f
message procs 890202/ho side 5;
param(1):=1;<*blocklength*>
param(2):=1;<*clear input*>
param(3):=0;
param(4):=1;<*fixedlength*>
param(5):=reclgd;<*rec.length*>
param(6):=2;<*nooofkeys*>
param(7):=1;<*runtime alarm*>
keydescr(1,1):= +2;<*integer*> keydescr(1,2):=faddr;
keydescr(2,1):= +2; keydescr(2,2):=taddr;
for i:=1 step 1 until 6 do names(i):=real<::>;
raf:=2;
getzone6(zp,ia);
tofrom(names,ia.raf,8);
noofrecs:=ant;
eof:=real<::>;
mdsortproc(param,keydescr,names,eof,noofrecs,result,explanation);
\f
message procs 900523/ho side 6;
raf:=8;
tofrom(filnavn,names.raf,8);
open(z1,4,filnavn,0);
write(zu,"nl",1,<:PROCES_______ST.ADR._STØRREL._BUF_AREA ________CPU:>,
<:_PR_STAT_______STARTTID:>,"nl",1);
write(zu,"-",79,"nl",1);
prevtop:=8; sadr:=maxadr:=0;
for i:=1 step 1 until ant do
begin
inrec6(z1,reclgd);
tofrom(rec,z1,reclgd);
if rec.navn(1) = long <:s:> then <*s*>
begin
sadr:=rec.pdesc;
maxadr:=rec.taddr;
end;
if i=2 then prevtop:=rec.faddr;
if (rec.status<>0 or døde) and (alle or true) then
begin
if alle or (not alle and i>3) then
begin
if rec.faddr>prevtop and prevtop > 0 then
begin
write(zu,<: *** frit__:>,<< ddddddd>,prevtop,
rec.faddr-prevtop,"nl",1);
end;
end;
j:=write(zu,rec.navn);
write(zu,"sp",12-j,<< ddddddd>,
rec.faddr,rec.taddr-rec.faddr,
<< dddd>,
rec.buf,rec.area,
<<dd ddd ddd.d>,rec.cpu/10000.0,
<<-dd>,rec.prio,"sp",1);
k:=rec.status extract 12;
tilstand:= if k=0 <*ikke eksist.*> 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. procesfunc*> 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;
if tilstand=12 then
write(zu,<<dddd>,rec.status extract 12)
else
write(zu,"sp",1,case tilstand+1 of (<:nex:>,
<:run:>,<:wcp:>,<:rer:>,<:wSp:>,
<:wSa:>,<:wsp:>,<:wsa:>,<:wpf:>,
<:wme:>,<:wan:>,<:wev:>,<:???:>));
\f
message procs 890202/ho side 7;
t:=rec.starttid/10000.0;
if t>200000.0 then
write(zu,<< zd dd dd>,systime(4,t,r),r);
write(zu,"nl",1);
if i=ant then
begin
if rec.taddr<maxadr then
begin
write(zu,<: *** frit__:>,<< ddddddd>,rec.taddr,
maxadr-rec.taddr,"nl",1);
end;
end;
if rec.faddr > 0 and rec.taddr > prevtop and rec.pdesc <> sadr then
prevtop:=rec.taddr;
end;
end;<* for i:=1 step 1 until ant *>
monitor(48)remove entry:(zp,0,ia);
monitor(48)remove entry:(z1,0,ia);
write(zu,"-",79,"nl",1);
write(zu,"sp",12-write(zu,hostnavn),<: d.:>,
<<zddddd>,systime(5,0,r),".",1,r,"nl",1);
closefp(zu,true);
trapmode:=1 shift 10;
message procs 880530/ho slut;
end
procs
end
▶EOF◀