|
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: 96768 (0x17a00)
Types: TextFile
Names: »skrivproctx «
└─⟦110021343⟧ Bits:30007476 RC8000 Backup tape fra HT's bus-radio system
└─⟦a957ba283⟧
└─⟦this⟧ »skrivproctx «
skrivproces=set 1 disc
skrivproces=algol
external
message procedure skrivproces side 1 - 790620/hko,840204/bsa;
integer procedure skrivproces(z,procadr,term,procbeskr,måde);
value procadr, måde;
integer procadr, måde;
zone z;
integer array term,procbeskr;
<* proceduren skriver en procesbeskrivelse for
en intern proces.
kald: skrivproces(z,procadr,term,procbeskr,måde);
skrivproces (retur,integer) antal linier udskrevet.
z (kald,zone) angiver hvilket
dokument der skal skrives på.
procadr (kald,integer) hvis procadr er <>0
skrives 'proces adresse; <procadr>'.
term (kald,integer array) hvis første ord
er <>0 skrives indholdet som tekst,
idet det antages at term indeholder
navnet på den terminal hvorfra
processen er startet.
procbeskr (kald,integer array) skal indeholde en
fuldstændig procesbeskrivelse for en intern
proces, startende i ord -2.
måde (kald,integer) angiver udskriftmåden.
0: normal udskrift incl. discoplysninger
1: maximal ikke-disc oplysning, status- m.v.
alene = også discoplysninger
2=1<1: normale ikke-disc oplysninger
4=1<2: komprimerede ikke-disc oplysninger
8=1<3: discoplysninger
kaldte procedurer:
afslut_text,
claimproc,
hægt_string,
slices,
ud.
fejlreaktioner:
ingen.
Ændringshistorie:
=================
871211 hko: Layout for disc ressourcer og cpu-tid ændret.
910315 ho: Måde 2, 4 og 8 tilføjet.
*>
\f
message procedure skrivproces side 2 - 790313/hko;
begin
integer array ia,tekst(1:20);
integer bsant,bsmax,monrel;
system(5,64,ia);
monrel:=ia(1) shift (-12);
system(5,92,ia);
bsant:=(ia(3)-ia(1))//2;
bsmax:=bsant-1;
begin
integer array bs(1:bsant*(4+1+1)); <* bsnavn: 4 ord
slicelængde: 1 ord
rel. adresse: 1 ord *>
integer array pnavn(1:4);
long array field doc,laf;
boolean tilstand;
integer nr,linie,pos,i,j;
integer field slicelgd,reladr;
integer array field iaf;
real r,t;
slicelgd:=10;
reladr:=12;
laf:=iaf:=0;
linie:=0;
nr:=-1;
repeat
nr:=nr+1;
doc:=nr*12;
claimproc(0,nr,bs.doc,0,0,bs.doc.slicelgd);
slices(bs.doc.iaf,0,ia,tekst);
bs.doc.reladr:=tekst(1);
until nr=bsmax;
\f
message procedure skrivproces side 3 - 790613/hko, 880822/ho;
tofrom(pnavn,procbeskr,8);
if pnavn(1)=0 then
pnavn(1):=46 shift 8 add 46 shift 8 add 46;<*...*>
if måde<2 then write(z,"nl",0,"-",80,nl,1); linie:=linie+1;
if måde=0 or måde extract 3 <> 0 then
pos:=write(z,"nl",1,pnavn.laf); linie:=linie+1;
if term(1)<>0 and false then
begin
write(z,"sp",13-pos,<:fra: :>,"sp",2,term.laf,"nl",1,"sp",12);
linie:=linie+1;
pos:=13;
end
else
begin
write(z,"sp",13-pos);
pos:=13;
end;
if måde extract 1 = 1 then
begin
write(z,"sp",13-pos,<:tilstand: :>);
tilstand:=false add (procbeskr(5) extract 12);
pos:=1;
if -,(tilstand shift (-7)) then
begin
hægt_string(tekst,pos,<:kørende:>);
if -,(tilstand shift (0)) then
hægt_string(tekst,pos,<: efter fejl:>);
end
else
begin
hægt_string(tekst,pos,<:ventende på :>);
if tilstand shift (-5) then
begin <* start/stop *>
hægt_string(tekst,pos,if tilstand shift (-3) then
<:start fra:> else <:stop fra:>);
hægt_string(tekst,pos,if tilstand shift (-4) then
<: ophav:> else <: forfader:>);
end
else
begin
if tilstand shift (-2) then
begin
i:=tilstand extract 2+1;
hægtstring(tekst,pos,case i of (<:procfunc:>,
<:message:>,
<:answer:>,
<:event:>) );
end
else hægtstring(tekst,pos,<:cpu:>);
end;
end;
<* binær udskrift af tilstand: *>
for i:= 1,2 do afslut_text(tekst,pos);
write(z,tekst.laf,"sp",6);
for i:= -11 step 1 until 0 do
begin
outchar(z,48+(tilstand shift i) extract 1);
if i mod 4 = 0 and i<>0 then outchar(z,32);
end;
write(z,"nl",1,"sp",12);
linie:=linie+1;
end;
\f
message procedure skrivproces side 4 - 790620/hko;
j:=if måde shift(-1) extract 1 = 1 then 1
else if måde=0 or måde shift(-1) extract 1 = 1 then 2 else 4;
for i:=j step 1 until 3 do
begin
boolean første_linie;
første_linie:= ((måde=0 and i=2) or (måde>0 and i=1));
if første_linie then
write(z,<:baser::>,"sp",6)
else
begin
write(z,"nl",1,"sp",24);
linie:=linie+1;
end;
j:= case i of (34,38,36);
pos:=write(z,<<-ddddddd>,procbeskr(j),<:.:>,<<d>,procbeskr(j+1));
write(z,"sp",18-pos,case i of (<:katalog:>,<:standard:>,<:max:>));
end;
if måde=0 or måde extract 2<> 0 then
begin
pos:=0;
write(z,"nl",1,"sp",12,<:function: :>); linie:=linie+1;
j:=procbeskr(14) extract 12; <* function mask *>
for i:= 0 step 1 until 11 do
begin
if (j shift (i-11) extract 1) = 1 then pos:=pos+write(z,<< dd>,i);
end;
write(z,"sp",38-pos,<:pr::>,<< ddd>,procbeskr(16) shift (-12),"sp",3,
<:pk::>,procbeskr(16) extract 12);
end;
if måde extract 1 = 1 then
begin
j:=23-round(ln(extend 0 add procbeskr(6))/ln(2.0));
for i:= 1,2,3,4 do
begin
write(z,"nl",1,"sp",12,case i of (<:første adresse::>,
<:proces adresse::>,
<:identifik. bit::>,
<:proc.prioritet::>),
case i of (procbeskr(11),
procadr,
j,
procbeskr(15)));
linie:=linie+1;
end;
t:=procbeskr.laf(15)//10000;
write(z,"nl",1,"sp",12,<:starttidspunkt::>,<< dd dd dd>,
systime(4,t,r),r); linie:=linie+1;
r:=procbeskr.laf(14)/10000.0;
write( z,"nl",1,"sp",12,<:cputidsforbrug::>,<< ddddd.00'z>,r,<: sek:>);
end;
if måde=0 or måde extract 2 <>0 then
begin
write(z,"nl",2,"sp",12,<:ressourcekrav::>,
"nl",2,"sp",15,<:hovedlager::>,<< dddddd>,
procbeskr(12)-procbeskr(11),<: halvord:>,
"nl",1,"sp",15,<:areaproc::>,<<ddd>,procbeskr(13) extract 12,
"nl",0,"sp",3,<:mess. buf::>,procbeskr(13) shift (-12),
"nl",0,"sp",3,<:int.proc::>,procbeskr(14) shift (-12),
"nl",0);
linie:=linie+2+2+2+1+0+0+0;
end
else if måde shift(-2) extract 1 = 1 then
begin
write(z,"sp",13-pos,<:area::>,<<ddd>,procbeskr(13) extract 12,
<: buf::>,procbeskr(13) shift(-12),
<: size::>,<< d>,procbeskr(12)-procbeskr(11));
end;
\f
message procedure skrivproces side 5 - 870305/hko;
if måde<2 or måde shift(-3) extract 1 = 1 then
begin
write(z,"nl",1,"sp",15,
<:baggrundslager temp login perm:>,
"nl",1,"sp",18,
<:dokument seg/sl segm entr segm entr segm entr:>);
linie:=linie+1+1;
for nr:= 0 step 1 until bsmax do
begin
doc:=nr*12;
if bs.doc.slicelgd>0 then
begin
write(z,"nl",1,"sp",18); linie:=linie+1;
pos:=write(z,bs.doc);
write(z,"sp",11-pos,<<ddddd>,bs.doc.slicelgd);
iaf:=bs.doc.reladr;
for j:=0,2,3 do
if monrel<=8 then
begin
write(z,<<dddddd>,"sp",3,
procbeskr.iaf(j) extract 12 * bs.doc.slicelgd,
procbeskr.iaf(j) shift (-12));
end
else
begin
write(z,<<dddddd>,"sp",3,
procbeskr.iaf(2*j+1) * bs.doc.slicelgd,
procbeskr.iaf(2*j));
end;
end;
end;
end;
write(z,"nl",1); linie:=linie+1; ud(z);
skrivproces:=linie;
end;
end;
end
▶EOF◀