|
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: 6912 (0x1b00)
Types: TextFile
Names: »bsusetx «
└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
└─⟦a957ba283⟧
└─⟦this⟧ »bsusetx «
bsuse=set 1 disc1
scope user bsuse
bsuse=algol connect.no
begin
message bsuse 920115/cl side 1;
<* Program bsuse skriver en liste over interne processer med bs-claim på
en udvalgt disc.
Kald:
=====
1 1
(<udfil>=) bsuse (<doknavn>)
0 0
Parameter <doknavn> udeladt giver udskrift for 'første' disc.
Kaldte procedurer:
==================
claimproc,
slices,
fpparguppe,
closefp,
openfp.
Ændringshistorie:
=================
920115 cl: Original version.
*>
\f
message bsuse 920115/cl side 2;
integer bsant,bsmax;
integer array ia(1:20);
system(5,92,ia);
bsant:= (ia(3)-ia(1))//2;
bsmax:=bsant-1;
begin
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,
internals,
slicelgd, reladr;
integer array
bs(1:6),typ(0:0),
keydescr(1:2<*noofkeys*>,1:2),
param(1:7),
proc(-2:62+(8*bsant)),
wrkstore(1:10),
tekst,ia(1:20);
integer array field
bsclaim,
chain,
iaf;
long array
docnavn(1:2),
hostnavn(1:2),
filnavn(1:2),
rec(1:15),
procs(1:15*24);
long field
starttid,
cpu;
long
ll;
long array field
laf,
doc,
navn;
real
r, t,
eof;
real array
names(1:6);
real array field
raf;
zone
zu, zp, z1, z2(128,1,stderror);
\f
message bsuse 920115/cl side 3;
parent:=2;
faddr:=4;
taddr:=6;
pdesc:=8;
navn:=8;
buf:=18;
area:=20;
cpu:=24;
starttid:=28;
status:=30;
prio:=32;
internals:= 34;
bsclaim:= 34;
reclgd:= bsclaim+16;
doc:=0;
slicelgd:=10;
reladr:=12;
hostnavn(1):=hostnavn(2):=long<::>;
iaf:=2;
open(z1,0,<:jobhost:>,0); close(z1,true);
if monitor(42,z1,0,ia)=0 then tofrom(hostnavn,ia.iaf,8);
ll:=0;
iaf:=laf:=raf:=0;
i:=fppargruppe(1,typ,docnavn.iaf);
if i<>1 then
docnavn(1):=docnavn(2):=0;
i:=-1;
repeat
i:=i+1;
claimproc(0,i,bs.doc,0,0,bs.slicelgd);
slices(bs,0,ia,tekst);
bs.reladr:=tekst(1);
until i=bsmax or docnavn(1)=0 or
(docnavn(1)=bs.doc(1) and docnavn(2)=bs.doc(2));
if docnavn(1)<>0 and (docnavn(1)<>bs.doc(1) or docnavn(2)<>bs.doc(2)) then
system(9,0*write(out,"nl",1,<:*** bsuse: ukendt dokument :>,docnavn),
<:<'nl'>:>);
chain:= bs.reladr-2;
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(out,"nl",1,<:*** bsuse: create entry :>,
case i of (<::>,<:catalog fejl:>,<::>,<:ingen bs-ressourcer:>,<::>,<::>,
<:intet maincatalog:>)),<:monitor40:>);
openfp(zu,0);
\f
message bsuse 920115/cl 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(2) then
begin
write(zu,"nl",2,<:PROCESBESKRIVELSE:>,i,"nl",2);
skrivhele(zu,proc.iaf.raf,intstørrelse,0);
end;
iaf:=0;
rec.parent:=proc(25); <*parent descr addr*>
if proc(50)<proc(11) then
begin
rec.faddr:=proc(11); <*første addr*>
rec.taddr:=proc(12); <*top addr*>
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);
rec.internals:= proc(14) shift (-12);
tofrom(rec.bsclaim,proc.chain,16);
raf:=0;
laf:=0;
tofrom(rec.navn,proc.laf,8);
if 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);
skrivhele(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 bsuse 920115/cl 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 bsuse 920115/cl side 6;
raf:=8;
tofrom(filnavn,names.raf,8);
open(z1,4,filnavn,0);
<*
123456789012345678901234567890123456789012345678901234567890123456789012345678
xxxxxxxxxxx T E M P L O G I N P E R M
PROCES SLICES SEGMTS ENTR SLICES SEGMTS ENTR SLICES SEGMTS ENTR
*>
write(zu,"sp",11,
<: T E M P L O G I N P E R M:>,
"nl",1);
write(zu,<:PROCES_____:>,
<:SLICES SEGMENTS ENTR SLICES SEGMENTS ENTR SLICES SEGMENTS ENTR:>,
"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 then
begin
j:=write(zu,rec.navn);
write(zu,"sp",12-j);
for k:= 0,2,3 do
write(zu,<< dddd>,rec.bsclaim(k*2+2),
<< dddddddd>,rec.bsclaim(k*2+2)*bs.slicelgd,
<< ddddd>,rec.bsclaim(k*2+1),if k<3 then <: :> else <::>);
write(zu,"nl",1);
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,"sp",4,bs.doc,<: slicelength=:>,<<d>,bs.slicelgd,"nl",1);
closefp(zu,true);
trapmode:=1 shift 10;
message bsuse 920115/cl slut;
end;
end
▶EOF◀