|
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: 16128 (0x3f00)
Types: TextFile
Names: »retptocode«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦9929d5d85⟧ »cpsys«
└─⟦00964e8f7⟧ Bits:30007478 RC8000 Dump tape fra HCØ.
└─⟦b2ec5d50f⟧
└─⟦9929d5d85⟧ »cpsys«
└─⟦this⟧
; rc4000 6 time.10000
ptext=edit c.30 palgoltext
l./,clockbuf/, d,
l./type,act/, r/type,act,/bastop,/,
l./mess,re/, r/mess, //,
l./tbstate,/,
r/state,tbstate,/nopr,nopa,noco,P1,P2,P3,stataddr,maxact,/,
l./clockpda/, r/,clockpda//,
l./firstcommarea/, r/,lastcommarea/,firstLT,lastLT,messsize,k/,
l./time,timeint/, r/,timeint//,
l1, r/,c1//,
l./,nextproc/, r/,nextproc//,
l./noshift,totalruntime/, r/,totalruntime//,
l./booleanterm/, r/,return,tobedumped/,free/,
l2,i/
own boolean pstart,stopcount;
real timeint,totalruntime;
long L,lifetime;
/,
l./,Bfname/,r/,DE/(1:20);
/,d1,
l./timeint:=1;/,r;1;1/4;,
i/
lastLT:=40; comment number of elemnts in LT;
; comment maxact was 10 *** cg 771121;
maxact:=5; ; comment maximum saved actions;
comment lifetime for non active children;
lifetime:=extend 2*3600*10000;
free:=true; comment used in connection with kø-comm.;
/,
l./c1:=description(<:console1/, d1,
l./COMMAREA/, r/25/7/,
r/;/,
CODE(1:256*6+47+5), buf,ACT,ACTVAL(1:maxact),
LT(1:lastLT);
long array Cpustart(1:maxproc);/,
l./cleararray(Pignore);/, r/;/; cleararray(buf);
cleararray(Cpustart);
buf(maxact):=-1;
M(1):=0; M(2):=60;
buf(2):=sendmessage(<:clock:>,M);
ACT(2):=6; comment idle statistic;
ACTVAL(2):=0;
if false then
begin comment check non-active children;
buf(1):=sendmessage(<:clock:>,M);
ACT(1):=2;
end;
firstLT:=firstaddr(LT)-1;
LT(1):=0;
/,
l./lastcommarea:=/, d3,
l./totalruntime/, r/totalruntime:=//,l1,i/
totalruntime:=0.0;
/,
l./nextproc:=0/,r/nextproc:=/nopr:=nopa:=noco:=/,
l1,d2,i/
M(1):=0;
/,
l./DES(i):=0;/,
d./DES(17):=setbit/,
l./sendmessage(c1,/, r/c1/<:console1:>/,
l./dure checkmess;/, d./FIRST/,d,
l./dure writestat/, l./zonez/,r/3/6+4*6/,
l./blocksread/,l1,i/
<:<10>procc:>,nopr,<:<10>paren:>,nopa,<:<10>opcom:>,noco,
/,
l2,i/
for i:=0 step 2 until 6 do
write(z,wordload(stataddr+i),
case i shift (-1) + 1 of (<:s:>,<:o:>,<:i:>,<:f:>));
write(z,<:<10>:>);
/,
l./endwritestat;/,l1,i?
boolean procedure LIST(S_no);
value Sno; integer Sno;
begin zone z(30,1,noerror);
integer i,j,k,no; integer array I(1:1); real array N(1:1);
procedure noerror(z,i,j); zone z; integer i,j; ;
LIST:=true;
for no:=0,no+1 while no<maxact and buf(no)<>0 do;
if buf(no)<>0 or LT(1)<>0 then goto ENDLIST;
open(z,0,<:dummydum:>,0);
j:=S_no extract 5 - 1;
for j:=j+1 while j<maxproc and Ppda(j)=0 do;
if Ppda(j)=0 then j:=j+1;
Sno:=Sno shift (-5) shift 5 add j;
if j<=maxproc then
begin
redefarray(N,Ppda(j)+2,2); i:=1;
write(z,false add 32,12-
write(z,string N(increase(i))));
if Pterm(j)>0 then redefarray(N,Tpda(Pterm(j))+2,2); i:=1;
write(z,Pstate(j),TBstate(j),Pignore(j),
<: :>,if Pterm(j)>0 then string N(increase(i)) else <::>);
end else
begin
write(z,<:max:>);
i:=byteload(syspda+26) - maxproc-maxact;
j:=byteload(syspda+27) - 1;
k:=byteload(syspda+28);
for i:=i,j,k do write(z,if i<0 then 0 else i);
write(z,<:<10>:>);
end j>maxproc;
write(z,<:<10><25><25>:>);
getzone(z,M); redefarray(I,M(19)+1,lastLT);
k:=M(14) - M(19) - 1;
if k>lastLT+lastLT-2 then k:=lastLT+lastLT-2;
for i:=k shift (-1) + 1 step -1 until 1 do LT(i):=I(i);
if k<lastLT+lastLT-2 then LT(k shift (-1) +2):=0;
close(z,true);
M(1):=5 shift 12;
M(2):=firstLT; M(3):=firstLT + k;
buf(no):=sendmessage(S_no shift (-5),M);
ACT(no):=4;
ACTVAL(no):=S_no + 1;
LIST:=false;
ENDLIST:
end LIST;
?,
l./for type:=1 step 1 until 23 do/,r/23/21/,;*** cg 771121
l./r=real(case type of/,
l./relt:>,<:rest/,r/<:relt:>,<:rest:>,//,;*** cg 771121
l./gotoSYNER/, d1,i/
if r<>real<:pstar:> then
begin
COMMAREA(1):=HNAME(1); COMMAREA(2):=HNAME(2) + 32;
COMMAREA(3):=real<:xxunk:> shift (-8) extract 24;
COMMAREA(4):=real<:xxnow:> shift (-8) extract 24;
COMMAREA(5):=real<:xxn:> shift (-8) extract 24;
bytesmove:=9; goto ENDINT;
end;
if -,pstart then goto NOTALLOW;
type:=17;
if true then else
ACTION: if pstart then goto NOTALLOW;
/,
l./begin zone z(60/,
d./endlist;/,i/
begin comment list;
if LIST(sendadr shift 5 + 1) then goto NORESOURCES;
bytesmove:=-1;
goto ENDINT;
end list;
/,
l./comment offuser;/,
l./comment timeint;/, l./timeint:=i/,
r?timeint:=i?begin timeint:=1/i; callcode(CODE,12); end?,
l./comment run;/,
l./if bufferclaim>/,;*** cg 771121
i?
comment count number of active process in order to minimize
buffer waste *** cg 771121;
j:=1;
for i:=1 step 1 until maxproc do
if Ppda(i)<>0 then j:=j+1;
?,;*** cg 771121
l./-maxproc or/,r/ or/-maxact or/,
r/maxproc/j/,;*** cg 771121
l./comment dump;/, l./105shift 8 add 110/,i/
if HNAME(1)=114 shift 8 add 101 shift 8 add 109 then
begin comment remove_<next>;
i:=readname(HNAME);
if HNAME(1)<>114 shift 8 add 117 shift 8 add 110 then
begin
Pstate(procno):=8;
goto if i=-2 then OK else if i<0 then SYNER else NEXT2;
end else
if HNAME(1)=114 shift 8 add 117 shift 8 add 110
and Tpda(Pterm(procno))=sendadr then
begin comment NOTE sysstate must be zero;
if procno=currproc then
begin comment Stop current child;
waitanswer(changebuf,M);
changebuf:=stopint(Ppda(procno),i);
if i<>0 then goto IOER;
waitanswer(changebuf,M);
M(1):=0; changebuf:=sendmessage(pdumpareapda,M);
currproc:=0;
end;
M(1):=M(2):=M(3):=syspda;
M(4):=Ppda(procno);
M(5):=0;
M(6):=childfirstadr+2;
if modifyint(Ppda(procno),M) <> 0 then error(<:modify1:>,0);
Pstate(procno):=7;
if wordload(TBprocbuf(procno)+6)=Ppda(procno) then
begin getevent(TBprocbuf(procno)); sendanswer(1,TBprocbuf(procno),M); end;
if wordload(TBtermbuf(procno)+6)=owndescr and TBstate(procno)>=5 then
regretmess(TBtermbuf(procno));
TBstate(procno):=TBtermbuf(procno):=TBprocbuf(procno):=0;
Pbufadr(procno):=0;
Ptobemod(procno):=Ptorun(procno):=false;
cleanbuf(Ppda(procno));
end else
goto SYNER;
end else
/,
l./comment pstop;/, l1, r/c1/description(<:console1:>)/, l1, d2,i/
if currproc>0 then pda:=Ppda(currproc);
if -,pstart then
begin
pstart:=true;
/,
l1,r/byte/if currproc=0 then false else byte/,
l./ba:=/,r/ba/bastop/,
l./error(/,d2, l1,d4,i/
goto OK;
end pstart false;
pstart:=false;
/,
l./careaproc/,d1,
l./(ba,/,r/ba/bastop/,
; release and reservetext removed by cg 771121
l./comment releasetext/,l-1,d 9,
l./comment messall from/, l1, r/c1/description(<:console1:>)/,
l1,d,i"
begin zone z(4,1,noerror); real r; integer a1,a2;
integer array I(1:1);
procedure noerror(z,s,b); zone z; integer s,b; ;
for a1:=0,a1+1 while a1<maxact and buf(a1)<>0 do;
for a2:=a1,a2+1 while a2<maxact and buf(a2)<>0 do;
if a1=maxact or a2>=maxact or LT(1)<>0 then goto NORESOURCES;
open(z,0,<::>,0);
systime(1,0,r);
write(z,<:<10>:>,<<dd dd dd>,systime(2,r,r),<:, :>,
r,<::<10>:>,false,24-22);
getzone(z,M); redefarray(I,M(19)+1,lastLT);
for i:=1 step 1 until 24//3 do LT(i):=I(i);
close(z,true);
M(1):=3 shift 12;
M(2):=firstLT + 24//3*2; M(3):=firstLT + lastLT*2 - 2;
waitanswer(sendmessage(sendadr,M),M);
messsize:=M(2) + 24//3*2 - 2;
M(1):=5 shift 12; M(2):=firstLT; M(3):=firstLT+messsize;
buf(a1):=sendmessage(sendadr,M);
M(1):=0; M(2):=20;
buf(a2):=sendmessage(<:clock:>,M);
ACT(a1):=a2 shift 12 + 5; ACT(a2):=a1 shift 12 + 5;
ACTVAL(a1):=ACTVAL(a2):=0;
bytesmove:=-1;
goto ENDINT;
end;
",
l./comment endprogram/, l1, r/c1/description(<:console1:>)/,
l./comment submit /, l./ifwaitanswer/, d./gotoENDIN/,i/
j:=0;
for j:=j+1 while j<maxact and buf(j)<>0 do;
if buf(j)<>0 then goto NO_RESOURCES;
buf(j):=sendmessage(<:kæ124æ:>,M);
if buf(j)=0 then goto NO_RESOURCES;
ACT(j):=1;
ACTVAL(j):=sendadr;
goto REPSUB;
/,
l./SERROR:/, d./gotoENDI/,
l.*Breakexec;*, d.*endremove;*,
l./dure command(/, d./end command/,
l./dure parent_mess(/,d./end parent_mess/,
l./dure sense(buff,procno/,d./endmodify;/,
l./initp;/,l1,i/
j:=
initcode(CODE,<:pcode:>,Ppda,Pstate,Pterm,Pin,
Pout,Pbufadr,Pignore,TBstate,TBtermbuf,TBprocbuf,
TBfirstadr,Tpda,buf,
Cpustart,
Ptorun,Ptobemod,
terminalmode,oscomm,pstart,
currproc,time,maxproc,noshift,buff,cpuused,
ignoretimes,changebuf,childfirstadr,childlastadr,
maxdrumproc,childsegm,pdumpareapda2,pdumpareapda,
fppda,timeint,totalruntime,timeslice,firstcommarea,
syspda,TBsize,procno,maxTB,sysstate,P1,P2,P3,
stataddr);
if j<>(47+5)*2 then system(9,j,<:initerror:>);
callcode(CODE,12); comment start clock;
/,
l./MESSAGE:/,
d./end12;/,d./endca/, d./endfor-if/,
d./getevent/,d./end/,
i!
æ12æ
CHANGE_IO:
i:=if changeio(P1,procno) then 3 else 1;
getevent(buff); sendanswer(i,buff,M);
goto FIRST_EVENT;
PLOTSTAT:
begin integer array T(1:1); long field L1,L2;
comment plotter statistic;
lookuptail(<:plotstat:>,M);
redefarray(T,buff+8,8);
M(10):=M(10) + T(8); comment plotvecc;
M(9):=M(9) + T(7); comment plot1step;
M(8):=M(8) + 1; comment increase plot number;
L1:=14; L2:=12; M.L1:=M.L1 + T.L2; comment plotsteps;
L1:=10; L2:=8; M.L1:=M.L1 + T.L2; comment plotstepss;
L1:=6; M.L1:=M.L1 + T(2); comment penups;
changeentry(<:plotstat:>,M);
getevent(buff);
sendanswer(1,buff,M);
goto FIRST_EVENT;
end;
ACTION:
case ACT(P1) extract 12 of
begin
if free then
begin comment 1 from kæ124æ;
i:=waitanswer(buf(P1),M);
for j:=1 step 1 until 4 do M(j+8):=M(2+j);
M(8):=10;
j:=messadd+16;
if i=5 then i:=movetext(j,<:***p kæ124æ unknown<10>:>) else
if i>1 then i:=movetext(j,<:***p kæ124æ error:>) else
if M(1)<>0 then i:=movetext(j,<:***p submit error:>) else
begin
i:=M(2)//10000;
M(13):=32 shift 8 add 106 shift 8 add 111;
M(14):=98 shift 8 add 32 shift 8 add
(if i>0 then i+48 else 0);
P2:=M(2) mod 10000; P3:=P2 mod 1000; i:=P3 mod 100;
M(15):=(P2//1000+48) shift 8 add (P3//100+48) shift 8
add (i//10+48);
M(16):=(i mod 10 + 48) shift 8 add 10;
i:=16;
end;
M(1):=5 shift 12; M(2):=j-2; M(3):=j+i-2;
buf(P1):=sendmessage(ACTVAL(P1),M);
ACT(P1):=3;
free:=false;
end else goto NEXT_EVENT;
begin comment 2 check non active children;
waitanswer(buf(1),M);
L:=getclock;
P1:=description(<:operator:>);
for i:=1 step 1 until maxproc do
if Pstate(i)=4 then
begin
if L-doubleload(Ppda(i)+64)>lifetime
and wordload(wordload(Ppda(i)+42) + 4)=P1 then Pstate(i):=8;
end;
M(1):=0; M(2):=3600/4;
buf(1):=sendmessage(<:clock:>,M);
end 2;
begin comment 3 kø-communication finis;
waitanswer(buf(P1),M);
buf(P1):=0;
free:=true;
end 3;
begin comment 4 list;
waitanswer(buf(P1),M);
buf(P1):=LT(1):=0;
if ACTVAL(P1) extract 5 <=maxproc+1 then LIST(ACTVAL(P1));
end 4;
begin comment 5: mess;
P2:=ACT(P1) shift (-12);
regretmess(buf(P2)); waitanswer(buf(P1),M);
k:=ACTVAL(P1):=ACTVAL(P2):=ACTVAL(P1) + 1;
if k<=17 then
begin
k:=if k=1 then 10 else 48-2+k;
k:=wordload(wordload(74) + k+k);
M(1):=5 shift 12; M(2):=firstLT; M(3):=firstLT+messsize;
buf(P1):=sendmessage(k,M);
M(1):=0; M(3):=20;
buf(P2):=sendmessage(<:clock:>,M);
end else LT(1):=buf(P1):=buf(P2):=0;
end 5;
begin comment 6: idle time:
The tail of the catalog entry 'idlestat' has the following
signification:
tail 1: size of area
2: if zero the clock is not checked
3-5: not used
6: time in min. to next update
7: segment no
8: relative number
9-10: clock value for last update
The condition 1<=rel no<=253 must be fulfilled;
integer array BUF(1:256), T(1:10), A(1:8);
integer k; boolean b1,b2; real t;
own integer times;
waitanswer(buf(P1),M); j:=60;
if lookuptail(<:idlestat:>,T)=0 and T(8)>=1 and T(8)<=253
and (T(8)-1) extract 2=0
and careaproc(<:idlestat:>)=0 and reserveproc(<:idlestat:>,0)=0
then
begin
M(1):=3 shift 12;
M(2):=firstaddr(BUF) - 1; M(3):=M(2) + 510;
M(4):=T(7);
if waitanswer(sendmessage(<:idlestat:>,M),A)<>1 or A(1)<>0 then
goto E6;
monitorproc(88,A);
b1:=T(2)<>0 and (extend T(9) shift 24 add T(10) >=
extend A(1) shift 24 add A(2)
or extend A(1) shift 24 add A(2) >=
extend T(9) shift 24 add T(10)
+ extend 24*60*60*10000);
b2:=plstat;
if b1 or b2 then
begin zone z(8,1,error);
procedure error(z,s,b); zone z; integer s,b; ;
open(z,8,<:console1:>,0);
if b1 then
write(z,<:<10><10>***p illegal date.<10>The date has passed:>,
<< dd dd dd>,
systime(2,extend T(9) shift 24 add T(10)/10000,t),
t,<:.<10>Change date or clear tail(2) in idlestat.<10>:>);
if b2 and times<5 then
begin
write(z,<:<10><10>The memory of the microcomputer pl6800:>,
<:<10>is inconsistent, at:>,<< dd dd dd>,
systime(2,getclock/10000,t),t,<:<10>:>);
times:=times+1;
end;
close(z,true);
if b1 then goto E6;
end;
if -,b2 then times:=0;
T(9):=A(1);
if ACTVAL(P1)=0 then ACTVAL(P1):=A(1):=A(1) + 1 shift 23;
T(10):=A(2); i:=T(8);
for k:=1,2,3,4 do BUF(i+k-1):=A(k);
T(8):=i+4; T(2):=long<:idl:> shift (-24);
T(3):=long<:est:> shift (-24); T(4):=long<:at:> shift (-24);
if T(8)>256 then
begin T(7):=T(7)+1; T(8):=1; end;
M(1):=5 shift 12;
if waitanswer(sendmessage(<:idlestat:>,M),A)<>1 or A(1)<>0 then
goto E6;
changeentry(<:idlestat:>,T);
if T(6)>=5 and T(6)<=24*60 then j:=T(6);
end;
E6:
removeproc(<:idlestat:>);
M(1):=0; M(2):=j*60;
buf(P1):=sendmessage(<:clock:>,M);
end 6;
end case;
goto FIRST_EVENT;
PROC_COMM:
nopr:=nopr+1;
i:=description(<:console1:>); goto PC;
PARENT_COMM:
nopa:=nopa+1;
i:=Tpda(Pterm(procno));
PC:if proccommand(buff,i) then goto FIRST_EVENT
else goto NEXT_EVENT;
INTERPRE:
noco:=noco+1;
interprete(P1,P2,P3); P1:=bytesmove-2;
i:=14; goto CALL;
REMOVE:
if false then
begin
write(out,sysstate,currproc,time,procno,changebuf);
if currproc>0 then
write(out,<:<10> :>,<< ddddd>,Ppda(currproc),Pstate(currproc),TBstate(currproc),
TBtermbuf(currproc),TBprocbuf(currproc),Ptorun(currproc) extract 1,
Ptobemod(currproc) extract 1);
outend(10);
end else
startorremove(false,Tpda(Pterm(procno)),procno);
i:=16; goto CALL;
FIRST_EVENT:
i:=8; goto CALL;
NEXT_EVENT:
i:=10;
CALL:
goto (case (callcode(CODE,i)) of
(PROC_COMM,INTERPRE,PARENT_COMM,REMOVE,ACTION,
PLOTSTAT,CHANGE_IO));
!,
f
▶EOF◀