|
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: 44544 (0xae00)
Types: TextFile
Names: »palgoltext«
└─⟦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⟧
; Heinrich Bjerregaard. 12. april 1975.
; p, Kurt Ludvigsen, 8 september 1972
; changed by Anders Lindgård 11 marts 1976
prun=algol index.no message.no
begin
integer buff, i, j, res, f, lastevent, instr, sh,
operatorbuf, clockbuf,
changebuf, type, act, sysstate,
maxproc, maxTB, maxT,
mess, recadr, sendadr, kind,
state, tbstate, procno,
childsegm, childfirstadr, childlastadr, childkey,
syspda, clockpda, pdumpareapda, pdumpareapda2, fppda,
firstcommarea, lastcommarea,
catkey, time, timeint, timeslice,
currproc, nextproc, sysconpda,c1,
noshift, totalruntime, maxdrumproc,maxbc,maxac,
ignoretimes,bytesmove,cpuused,TBsize;
boolean terminalmode, oscomm, return, tobedumped,
disc,TEST;
integer array M, DES(1:17), Bfname(1:7), Bname(1:1);
redefarray(Bname,firstaddr(Bfname)+6,4);
TEST:=lookupentry(<:ptest:>)>0;
maxT:=18;
TBsize:=52;
childsegm:=27;
catkey:=22;
timeint:=1;
timeslice:=7;
ignoretimes:=3;
cpuused:=30;
terminalmode:=true;
maxdrumproc:=12;
syspda:=owndescr;
maxproc:=maxTB:=byteload(syspda+28);
sysconpda:=description(<:console1:>);
c1:=description(<:console1:>);
if c1=0 then c1:=sysconpda;
if maxdrumproc>maxproc then maxdrumproc:=maxproc;
if TEST then
begin
comment check resources;
boolean error;
integer i,j,k,l,m,pbuf,parea,pint,psize,pk,pr,pcat,pf;
zone c1(128,1,ignore);
procedure ignore(z,s,b);
zone z; integer s,b;
;
procedure check(act,cor,txt);
value act,cor; integer act,cor;
string txt;
if act<cor then
begin
write(c1,<:<10>too few :>,txt,<:, is :>,act,
<: should be :>,cor);
setposition(c1,0,0);
error:=true;
end;
error:=false;
pbuf:=byteload(syspda+26)+3;
parea:=byteload(syspda+27)+3;
pint:=byteload(syspda+28);
psize:=wordload(syspda+24)-wordload(syspda+22);
pr:=byteload(syspda+32); pk:=byteload(syspda+33);
pf:=byteload(syspda+29);
pcat:=wordload(syspda+30);
open(c1,8,<:console1:>,0);
check(pbuf,61,<:buffers:>);
check(parea,44,<:areas:>);
check(pint,6,<:internals:>);
check(psize,20000,<:bytes:>);
if pk<>2 then begin
write(c1,<:<10>pk<>2:>);
error:=true;
end;
i:=j:=k:=0;
for m:=2,3, 0 step 1 until 11, 23-0 step -1 until 23-20 do
begin
if j=0 and k=0 then l:=1 else
if k=0 then l:=2 else l:=3;
if -,testbit(case l of (pr,pf,pcat),m) then
begin
write(c1,<:<10>wrong :>,case l of (<:protection:>,
<:function:>,<:catalog:>),<: mask, bit :>,
case l of (m,12-m,23-m),<: is missing:>);
end;
if m=3 then j:=1;
if m=11 then k:=1;
end;
if error then begin
rep:
write(c1,<:<10>remove p and create it with the correct resources:>,
<:<10>as agreed with the RC4000 department:>);
setposition(c1,0,0);
wait (20);
goto rep;
end;
end;
begin
integer array Ppda, Pstate, Pterm, Pin, Pout, Pbufadr,
Pignore(1:maxproc),
TBstate, TBtermbuf, TBprocbuf,
TBfirstadr(1:maxTB),
TBarea(1:maxTB,1:TBsize//2),
Tpda(1:maxT),
COMMAREA(1:25);
boolean array Ptorun, Ptobemod(1:maxproc), CHILD(1:childsegm*512),
Tallow(1:maxT);
procedure error(str,type);
value type; integer type;
string str;
begin
integer array mess(1:8);
array field a;
cleararray(M);
M(1):=13 shift 13 add type;
a:=2;
movestring(M.a,1,str);
waitanswer(sendmessage(parent,M),M);
end error;
\f
comment initialisation;
f:=firstaddr(TBarea)-1;
for i:=1 step 1 until maxTB do
begin
TBfirstadr(i):=f+(i-1)*TBsize;
end init of TB;
cleararray(TBstate); cleararray(TBtermbuf); cleararray(TBprocbuf);
cleararray(TBarea);
cleararray(Ppda); cleararray(Pstate); cleararray(Pbufadr);
cleararray(Pterm); cleararray(Pin); cleararray(Pout);
cleararray(Ptorun); cleararray(Ptobemod);
cleararray(Tpda); cleararray(Tallow);
cleararray(Pignore);
Tpda(1):=sysconpda;
Tallow(1):=true;
messadd:=firstaddr(M);
childfirstadr:=firstaddr(CHILD);
childlastadr:=childfirstadr+childsegm*512-2;
\f
for i:=1 step 1 until 12 do M(i):=0;
if lookuptail(<:pdumparea:>,M)=0 then
begin
if M(1)<maxdrumproc*childsegm then
begin
i:=removeentry(<:pdumparea:>);
if i<>0 and i<>3 then system(9,i,<:remove:>);
end
else goto PERMENTRY;
end;
M(1):=maxdrumproc*childsegm;
i:=createentry(<:pdumparea:>,M);
if i<>0 then system(9,i,<:pdumparea:>);
PERMENTRY:
i:=permentry(<:pdumparea:>,catkey);
if i<>0 then system(9,i,<:permanent:>);
i:=careaproc(<:pdumparea:>);
if i<>0 and i<>3 then system(9,i,<:creation:>);
i:=reserveproc(<:pdumparea:>,0);
if i<>0 then system(9,i,<:reservation:>);
if maxdrumproc<maxproc then
begin
if lookuptail(<:pdumparea2:>,M)=0 then
begin
if M(1)<(maxproc-maxdrumproc)*childsegm then
begin
i:=removeentry(<:pdumparea2:>);
if i<>0 and i<>3 then system(9,i,<:remove2:>);
end
else
goto PERMENTRY2;
end;
M(1):=(maxproc-maxdrumproc)*childsegm;
if createentry(<:pdumparea2:>,M)<>0 then error(<:pdumparea2:>,3);
PERMENTRY2:
if permentry(<:pdumparea2:>,catkey)<>0 then error(<:permanent2:>,3);
i:=careaproc(<:pdumparea2:>);
if i<>0 and i<>3 then error(<:pdumparea2:>,3);
if reserveproc(<:pdumparea2:>,0)<>0 then error(<:reservation2:>,3);
end;
\f
reserveproc(program-2,0);
pdumpareapda2:=description(<:pdumparea2:>);
fppda:=description(<:fp:>);
pdumpareapda:=description(<:pdumparea:>);
i:=byteload(syspda+32) shift 12;
for j:=12 step 1 until 23 do
if -,testbit(i,j) then
begin childkey:=19-j; goto OUTK; end;
OUTK:
firstcommarea:=firstaddr(COMMAREA);
lastcommarea:=firstcommarea+50-2;
movetext(firstaddr(Bfname),<:<10>dump on :>);
operatorbuf:=att;
changebuf:=0;
blocksread:=totalruntime:=noshift:=0;
sysstate:=0;
time:=0;
terminalmode:=true;
oscomm:=false;
currproc:=nextproc:=0;
clockpda:=description(<:clock:>);
M(1):=0; M(2):=timeint;
clockbuf:=sendmessage(clockpda,M);
changebuf:=sendmessage(pdumpareapda,M);
for i:=1 step 1 until 17 do DES(i):=0;
for i:=12 do DES(1):=setbit(DES(1),i,1);
for i:=7, 9, 12 do DES(2):=setbit(DES(2),i,1);
for i:=5, 10, 11 do DES(3):=setbit(DES(3),i,1);
for i:=7, 8, 9, 12 do DES(4):=setbit(DES(4),i,1);
for i:=1, 4, 12 do DES(5):=setbit(DES(5),i,1);
for i:=1, 2, 4, 7, 9, 12 do DES(6):=setbit(DES(6),i,1);
for i:=1, 2, 4, 5, 10, 11 do DES(7):=setbit(DES(7),i,1);
for i:=1, 2, 4, 7, 8, 9, 12 do DES(8):=setbit(DES(8),i,1);
for i:=1, 3, 12 do DES(9):=setbit(DES(9),i,1);
for i:=1, 3, 7, 9, 12 do DES(10):=setbit(DES(10),i,1);
for i:=1, 3, 5, 10, 11 do DES(11):=setbit(DES(11),i,1);
for i:=1, 3, 7, 8, 9, 12 do DES(12):=setbit(DES(12),i,1);
for i:=0, 1, 4, 12 do DES(13):=setbit(DES(13),i,1);
for i:=0, 1, 2, 4, 7, 9, 12 do DES(14):=setbit(DES(14),i,1);
for i:=0, 1, 2, 4, 5, 10, 11 do DES(15):=setbit(DES(15),i,1);
for i:=0, 1, 2, 4, 7,8,9, 12 do DES(16):=setbit(DES(16),i,1);
for i:=0, 12 do DES(17):=setbit(DES(17),i,1);
\f
begin
\f
procedure initp;
begin
integer i, ba, j;
M(1):=3 shift 12;
M(2):=childfirstadr;
M(3):=childfirstadr+510;
M(4):=0;
if careaproc(<:pinitarea:>) <>0 or
waitanswer(sendmessage(<:pinitarea:>,M),M)<>1 then error(<:pinit:>,0) else
begin
for i:=1 step 1 until 10 do
begin
j:=childfirstadr+(i-1)*48;
if byteload(j)<>0 then interprete(j,j+46,sysconpda);
end i;
removeproc(<:pinitarea:>);
end;
messall(<:p has been removed
is now restarted:>,1,false);
end initp;
procedure messall(text,time,readc1);
value time,readc1; integer time;
boolean readc1;
string text;
if TEST or readc1 then
begin
integer pda,nt,i,ba;
integer array M,A(1:8),buff(1:maxT);
array txt(1:20);
real t1,t2;
zone z(20,1,dummy);
procedure dummy(z,i,j);
zone z; integer i,j;
;
open(z,0,<:dummy:>,-1);
outrec(z,20);
cleararray(z);
setposition(z,0,0);
cleararray(txt);
nt:=wordload(74);
M(1):=5 shift 12;
M(2):=firstaddr(txt);
M(3):=M(2)+78;
txt(1):=txt(20):=real <:<10>:>;
if readc1 then begin
integer array c1M(1:8);
c1M(1):=3 shift 12;
c1M(2):=M(2)+4;
c1M(3):=M(2)+80;
waitanswer(sendmessage(c1,c1M),c1M);
end else
movestring(txt,2,text);
if time<>0 then begin
systime(1,0,t1);
t1:=systime(2,t1,t2);
write(z,<< dd dd dd>,t1,t2);
close(z,false);
for i:=1,2,3 do txt(15+i):=z(i);
end;
j:=1;
for i:=2,10,48 step 1 until 63 do begin
pda:=wordload(nt+2*i);
buff(j):=sendmessage(pda,M);
j:=j+1;
end;
waitanswer(buff(1),A);
wait(10);
for j:=2 step 1 until maxT do
if buff(j)=0 then else
if checkbuf(buff(j)) then getevent(buff(j))
else regretmess(buff(j));
end messall;
procedure readtext(pda,txt,bytes);
value pda,bytes; integer pda,bytes; array txt;
begin
integer array M,A(1:8);
cleararray(txt);
M(1):=3 shift 12;
M(2):=firstaddr(txt);
M(3):=M(2)+bytes;
waitanswer(sendmessage(pda,M),A);
end readtext;
procedure checkmess;
begin
pda:=wordload(buff+6);
if wordload(buff+8)=7 shift 12 and
wordload(buff+16)=351417 then begin
if oscomm or sysstate<>0 then goto NEXTEVENT else
proccommand(buff,c1);
end else begin
getevent(buff);
ba:=buff;
result:=2;
senda;
end;
goto FIRSTEVENT;
end;
procedure writestat(pda);
value pda; integer pda;
begin zone z(((6+8)*3)//6+5,1,noerror);
real array N(1:1); integer i,j,k;
procedure noerror(z,i,j);
zone z; integer i,j;
;
redefarray(N,pda+2,2);
i:=1;
open(z,8,string N(increase(i)),-1);
k:=(getclock-doubleload(syspda+60))/600000;
i:=k//(24*60);
j:=(k-i*(24*60))//60;
write(z,<:<10>p:>,<< dd>,i,j,k mod 60);
k:=doubleload(syspda+56)/10000;
i:=k//3600;
j:=(k-i*3600)//60;
write(z,<:, :>,<< dd>,i,j,k mod 60);
write(z,<< ddd ddd>,<:<10>total:>,totalruntime,
<:<10>shift:>,noshift,<:<10>block:>,blocksread,
<:<10>:>);
close(z,true);
end writestat;
procedure startorremove(B,pda,no);
value B,pda,no; boolean B; integer pda,no;
begin
integer i,j; real t1,t2; real array CHILD(1:2),N(1:1);
long k;
zone z(15,1,noerror);
procedure noerror(z,s,b);
zone z; integer s,b; ;
if pda>0 then
begin
redefarray(N,pda+2,2);
i:=1;
open(z,8,string N(increase(i)),-1);
i:=1; nameload(Ppda(no)+2,CHILD);
systime(1,0,t1);
write(z,<:<10>:>,string CHILD(increase(i)),
if B then <: started:> else <: removed:>,
<< dd dd dd>,systime(2,t1,t2),t2,<:.<10>:>);
if -,B then
begin
k:=doubleload(Ppda(no)+56)/10;
write(z,<:Run time:>);
if k<1000 then write(z,k,<: ms:>) else
if k<120000 then write(z,<< ddd.dd>,k/1000,<: s:>) else
begin
k:=k/1000;
i:=k//3600; k:=k-i*3600;
j:=k//60; k:=k-j*60;
if i>0 then write(z,i,<:h:>);
if j>0 then write(z,j,<:m:>);
if k>0 then write(z,k,<:s:>);
end;
write(z,<:.<10>:>);
end -,B;
close(z,true);
end;
end startorremove;
\f
boolean procedure proccommand(buff,terminal);
value buff, terminal;
integer buff, terminal;
comment takes care of a command from a p-process;
begin
integer ba, res, f, l;
integer array NAME(1:4);
proccommand:=true;
for ba:=1 step 1 until 4 do NAME(ba):=wordload(buff+8+ba*2);
if careaproc(NAME)<>0 then
begin
res:=2;
goto EPC;
end;
begin
boolean array C(1:512);
M(1):=3 shift 12;
f:=M(2):=firstaddr(C);
l:=M(3):=f+510;
M(4):=0;
ba:=sendmessage(description(NAME),M);
if ba=0 then
begin proccommand:=false; removeproc(NAME); goto ENDPC; end;
proccommand:=true;
res:=waitanswer(ba,M);
interprete(f,l,terminal);
res:=if COMMAREA(1)=114 shift 8 add 101 shift 8 add 97 then 1 else 3;
removeproc(NAME);
end;
EPC:
getevent(buff);
sendanswer(res,buff,M);
ENDPC:
end proccommand;
boolean procedure changeio(ioaddr,child);
value ioaddr,child; integer ioaddr,child;
begin
comment changes the input/output for the childprocess given by the
number child to the terminal given by the address ioaddr.
The result is true if trouble, otherwise false;
changeio:=false;
if -,checkpda(ioaddr) then goto E1;
for j:=1 step 1 until child-1,child+1 step 1 until maxproc do
if Pterm(child)=Pterm(j) then goto Used;
Tpda(Pterm(child)):=0;
Used:
j:=findterm(ioaddr);
if j=0 then
for j:=1 step 1 until maxT do
if Tpda(j)=0 then begin Tpda(j):=ioaddr; goto Found; end;
Found:
if j>maxT then
E1:begin changeio:=true; goto OUT; end;
Pterm(child):=j;
OUT:
end changeio;
\f
procedure interprete(firstadr,lastadr,sendadr);
value firstadr, lastadr, sendadr;
integer firstadr, lastadr, sendadr;
comment interpretes the commands in the area from firstadr to
lastadr,
deliveres the appropriate answer in the COMMAREA;
begin
integer i, bufferclaim, areaclaim, funcmask, catalogmask,
inpda, outpda, procpda, ba, procno, termno, type,
char,charlast,charshift,charno;
integer array NAME, HNAME(1:4), BUF(1:1);
real r;
boolean pass, perunits,convert;
procedure nextchar;
begin
if charshift>0 then
begin
charno:=charno + 1;
if charno > charlast then
begin char:=10; goto OUT; end;
charshift:=-16;
end;
char:=BUF(charno) shift charshift extract 8;
charshift:=charshift + 8;
if (char<=45 and char<>10 and char<>32 and char<>0)
or (char>=58 and char<=96)
or char>=126 then goto SYNER;
OUT:
end nextchar;
integer procedure readint;
begin
for i:=0 while char=32 or char=0 do nextchar;
if char=10 then
begin readint:=-2; goto ENDRI; end;
readint:=-1;
if -,(char>47 and char<58) then goto ENDRI;
REPI:
if char<>32 and char<>10 and char<>46 and char<>47 then
begin
if -,(char>47 and char<58) then goto SYNER;
i:=i*10+(char-48);
nextchar;
goto REPI;
end;
readint:=i;
ENDRI:
end readint;
\f
integer procedure readname(NAME);
integer array NAME;
comment reads a textstring into NAME;
begin
integer nidx, nsh;
for i:=0 while char=32 or char=0 do nextchar;
if char=10 then begin readname:=-2; goto OUT; end;
if char>=48 and char<=57 then begin readname:=-1; goto OUT; end;
for nidx:=1 step 1 until 4 do NAME(nidx):=0;
nidx:=1; nsh:=16;
REPN:
if char<>32 and char<>10 and char<>46 and char<>47 then
begin
if -,((char>96 and char<126)or(char>47 and char<58)) then
goto SYNER;
NAME(nidx):=NAME(nidx) add (char shift nsh);
if nsh=0 then
begin
nidx:=nidx+1;
if nidx>4 then goto SYNER;
nsh:=16;
end
else nsh:=nsh-8;
nextchar;
goto REPN;
end;
readname:=nidx;
OUT:
end readname;
\f
charlast:=(lastadr-firstadr) shift (-1) + 1;
redefarray(BUF,firstadr,charlast);
charno:=1; charshift:=-16;
nextchar;
if sendadr<0 or char=10 then goto OK;
disc:=pass:=perunits:=convert:=false;
bufferclaim:=5;
areaclaim:=6;
maxbc:=10;
maxac:=7;
catalogmask:=1 shift 23;
inpda:=outpda:=sendadr;
funcmask:=1 shift 11+1 shift 10+1 shift 9+1 shift 8+1 shift 7
+1 shift 6+1 shift 5;
termno:=findterm(sendadr);
if termno=0 then
begin
for termno:=1 step 1 until maxT do
if Tpda(termno)=0 then
begin
Tpda(termno):=sendadr;
goto OUTT;
end;
end;
OUTT:
if termno>maxT then goto NORESOURCES;
NEXT:
i:=readname(HNAME);
if i=-2 then goto OK;
if i=-1 then goto SYNER;
NEXT2:
HNAME(2):=HNAME(2) - HNAME(2) extract 8;
r:=0.0 shift 24 add HNAME(1) shift 24 add HNAME(2);
for type:=1 step 1 until 23 do
if r=real(case type of (
<:conso:>,<:list:>,<:pass:>,<:stat:>,<:user:>,
<:offus:>,<:timei:>,<:slice:>,<:main:>,<:chang:>,<:cpuus:>,
<:new:>,<:proc:>,<:call:>,<:mode:>,<:inter:>,<:pstop:>,
<:relt:>,<:rest:>,<:mess:>,<:end:>,<:submi:>,<:conve:>)) then
goto ACTION;
goto SYNER;
ACTION:
case type of
begin
\f
begin
comment consolename;
nameload(sendadr+2,COMMAREA);
COMMAREA(5):=10 shift 8 add 114 shift 8 add 101;
COMMAREA(6):=97 shift 8 add 100 shift 8 add 121;
bytesmove:=12;
goto ENDINT;
end;
begin zone z(60,1,noerror);
integer i,j,k; real array N(1:1);
procedure noerror(z,i,j); zone z; integer i,j; ;
comment list;
redefarray(N,sendadr+2,2); i:=1;
open(z,8,string N(increase(i)),-1);
for j:=1 step 1 until maxproc do
if Ppda(j)<>0 then
begin
redefarray(N,Ppda(j)+2,2); i:=1;
write(z,false add 32,12-
write(z,<:<10>:>,string N(increase(i))));
redefarray(N,Tpda(Pterm(j))+2,2); i:=1;
write(z,Pstate(j),TBstate(j),Pignore(j),
<: :>,string N(increase(i)));
end j;
write(z,<:<10>max:>);
i:=byteload(syspda+26) - maxproc;
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>:>);
close(z,true);
goto OK;
end list;
T3:begin
comment password;
if readname(NAME)<0 then goto SYNER;
if description(NAME)<>0 then goto NAMECONFL;
T3a: if headandtail(NAME,M)<>0 or M(8)<>0 then goto UNKNOWN;
if M(1) extract 12<>21 then
begin
if -,Tallow(termno) then goto NOTALLOW;
end;
if M(13)>0 then bufferclaim:=M(13);
if M(14)>0 then areaclaim:=M(14);
if M(15)<>0 then funcmask:=M(15)extract 12;
catalogmask:=M(16);
perunits:=M(17)=1;
pass:=true;
goto T12;
end;
begin
comment stat;
if sendadr<>sysconpda then goto NOTALLOW;
writestat(sendadr);
goto NEXT;
end;
\f
begin
comment user;
i:=readint; if i<0 then goto SYNER;
if lookuptail(<:catalog:>,M)<>0 or
i<>M(10) extract 12 then goto NOTALLOW;
Tallow(termno):=true;
goto NEXT;
end;
begin comment offuser;
Tallow(termno):=false;
goto NEXT;
end;
begin
comment timeint;
i:=readint; if i<0 then goto SYNER;
if i>0 and i<timeslice and sendadr=sysconpda and Tallow(termno)
then timeint:=i else goto NOTALLOW;
goto NEXT;
end;
begin
comment slice;
i:=readint; if i<0 then goto SYNER;
if i>0 and i>timeint and sendadr=sysconpda and Tallow(termno)
then timeslice:=i else goto NOTALLOW;
goto NEXT;
end;
begin
comment change sysconsole. main.
it is checked that the calling console is console1 or console2;
if Tpda(termno)=description(<:console1:>) or
Tpda(termno)=description(<:console2:>) then sysconpda:=sendadr else
goto NOTALLOW;
goto NEXT;
end;
begin comment change frequency;
i:=readint; if i<0 then goto SYNER;
if i>=0 and i<100 and sendadr=sysconpda and Tallow(termno)
then ignoretimes:=i else goto NOTALLOW;
goto NEXT;
end;
begin comment max cpu allowed to use;
i:=readint; if i<0 then goto SYNER;
if i>0 and i<101 and sendadr=sysconpda and Tallow(termno)
then cpuused:=i else goto NOTALLOW;
goto NEXT;
end;
begin
comment new;
if sendadr<>sysconpda then goto SYNER;
readname(NAME);
T12:
REPNEW:
i:=readname(HNAME); if i=-1 then goto SYNER;
if i=-2 and pass then HNAME(1):=real<:run:>;
if HNAME(1)=112 shift 8 add 101 shift 8 add 114 then
begin
comment peripheral units;
if -,Tallow(termno) then goto NOTALLOW;
perunits:=true;
goto REPNEW;
end
else
if HNAME(1)=98 shift 8 add 117 shift 8 add 102 then
begin
comment buf;
if -,(Tallow(termno) or pass) then goto NOTALLOW;
i:=readint; if i<0 then goto SYNER;
if -,pass or i<bufferclaim
or (pass and Tallow(termno)) then bufferclaim:=i;
if -,Tallow(termno) and pass and bufferclaim>maxbc then
bufferclaim:=maxbc;
goto REPNEW;
end
else
if HNAME(1)=97 shift 8 add 114 shift 8 add 101 then
begin
comment area;
i:=readint; if i<0 then goto SYNER;
if -,pass or i<areaclaim
or (pass and Tallow(termno)) then areaclaim:=i;
if -,Tallow(termno) and (pass and areaclaim>maxac) then
areaclaim:=maxac;
goto REPNEW;
end
else
if HNAME(1)=99 shift 8 add 97 shift 8 add 116 then
begin
comment cat;
if -,Tallow(termno) then goto NOTALLOW;
REPCAT:
i:=readint;
if i<0 then goto REPNEW;
if i>23 then goto SYNER else
begin
catalogmask:=setbit(catalogmask,23-i,1);
goto REPCAT;
end;
end
else
if HNAME(1)=102 shift 8 add 117 shift 8 add 110 then
begin
comment func;
if -,Tallow(termno) then goto NOTALLOW;
REPFUNC:
i:=readint;
if i<0 then goto REPNEW;
if i>11 then goto SYNER else
begin
funcmask:=setbit(funcmask,11-i,1);
goto REPFUNC;
end
end
\f
else
if HNAME(1)=105 shift 8 add 110 shift 8 add 0 then
begin
comment in;
if readname(HNAME)<0 then goto SYNER;
inpda:=description(HNAME);
if inpda=0 then
begin
if lookuptail(HNAME,M)<>0 then goto IOER;
if careaproc(HNAME)<>0 then goto IOER;
inpda:=description(HNAME);
end;
goto REPNEW;
end
else
if HNAME(1)=111 shift 8 add 117 shift 8 add 116 then
begin
comment out;
if readname(HNAME)<0 then goto SYNER;
outpda:=description(HNAME);
if outpda=0 then
begin
if lookuptail(HNAME,M)<>0 then goto IOER;
if careaproc(HNAME)<>0 then goto IOER;
outpda:=description(HNAME);
end;
goto REPNEW;
end
else
if HNAME(1)=116 shift 8 add 101 shift 8 add 114 then
begin
integer pda;
comment term;
if -,Tallow(termno) then goto NOTALLOW;
if readname(HNAME)<0 then goto SYNER;
pda:=description(HNAME);
if pda=0 then goto IOER;
termno:=findterm(pda);
if termno=0 then
begin
for termno:=1 step 1 until maxT do
if Tpda(termno)=0 then
begin
Tpda(termno):=pda;
goto OUTTT;
end;
end;
OUTTT: if termno>maxT then goto NORESOURCES;
goto REPNEW;
end
else
if HNAME(1)=100 shift 8 add 105 shift 8 add 115 then
begin
comment disc;
disc:=true;
goto REPNEW;
end
else
\f
if HNAME(1)=114 shift 8 add 117 shift 8 add 110 or pass then
begin
comment run;
M(1):=childfirstadr;
M(2):=childlastadr+2;
if bufferclaim>
wordload(syspda+26)shift(-12)-maxproc or
areaclaim>
(wordload(syspda+26)extract 12 )-1 then goto NORESOURCES;
M(3):=bufferclaim shift 12 add areaclaim;
M(4):=funcmask;
M(5):=catalogmask;
M(6):=setbit((-1)extract 8,7-childkey,0) shift 12 add childkey;
procno:=0;
if disc then begin
for i:=maxdrumproc+1 step 1 until maxproc do
if Ppda(i)=0 then
begin procno:=i; goto OUTP; end;
end;
for i:=1 step 1 until maxproc do
if Ppda(i)=0 then
begin procno:=i; goto OUTP; end;
OUTP:
if procno=0 then goto NORESOURCES;
i:=createint(NAME,M);
if i=3 then goto NAMECONFL else if i<>0 then goto NORESOURCES;
Pstate(procno):=7;
Pterm(procno):=termno;
Pin(procno):=inpda;
Pout(procno):=outpda;
Pbufadr(procno):=0;
M(1):=if inpda<>sendadr then inpda else syspda;
M(2):=syspda;
M(3):=if outpda<>sendadr then outpda else syspda;
M(4):=Ppda(procno):=description(NAME);
M(5):=0;
M(6):=childfirstadr+2;
if modifyint(NAME,M)<>0 then error(<:modify:>,3);
if perunits then includeall(Ppda(procno)) else
for i:=0 step 1 until 12,48 step 1 until 67 do
include(Ppda(procno),i);
startorremove(true,Tpda(termno),procno);
bytesmove:=0;
goto ENDINT;
end run else goto UNKNOWN;
end new;
\f
begin
comment proc <name> remove, start, stop, dump, break,
include <no>, exclude <no>, remove <next>;
if readname(NAME)<0 then goto SYNER;
procpda:=description(NAME);
if readname(HNAME)<0 then goto SYNER;
procno:=0;
for i:=0,i+1 while i<maxproc and Ppda(i)<>procpda do;
if procpda<>0 and Ppda(i)=procpda then procno:=i else goto UNKNOWN;
if sendadr<>Tpda(Pterm(procno)) and sendadr<>sysconpda then
goto NOTALLOW;
if HNAME(1)=115 shift 8 add 116 shift 8 add 97 then
begin
comment start;
Pstate(procno):=1;
end
else
if HNAME(1)=115 shift 8 add 116 shift 8 add 111 then
begin
comment stop;
Pstate(procno):=6;
end
else
if HNAME(1)=100 shift 8 add 117 shift 8 add 109 then
begin comment dump;
Pstate(procno):=9;
end
else
if HNAME(1)=98 shift 8 add 114 shift 8 add 101 then
begin comment break;
Pstate(procno):=12;
end
else
if HNAME(1)=105 shift 8 add 110 shift 8 add 99 then
begin
comment include;
REPINC:
i:=readint;
if i<0 then goto NEXT;
i:=include(procpda,i);
if i<>0 then goto DEVUNKNOWN;
goto REPINC;
end
else
if HNAME(1)=101 shift 8 add 120 shift 8 add 99 then
begin
comment exclude;
REPEXC:
i:=readint;
if i<0 then goto NEXT;
i:=exclude(procpda,i);
if i<>0 then goto DEVUNKNOWN;
goto REPEXC;
end
else
if HNAME(1)=116 shift 8 add 101 shift 8 add 114 then
begin comment term <name>;
if readname(HNAME)<0 then goto SYNER;
i:=description(HNAME); if i=0 then goto UNKNOWN;
if changeio(i, procno) then goto NORESOURCES;
goto NEXT;
end
else goto SYNER;
end proc;
begin integer i;
comment call;
REPCALL:
i:=readint;
if i<0 then goto NEXT;
if i<8 or i>9 then begin
if -,Tallow(termno) then goto NOTALLOW; end;
if readname(NAME)<0 then goto SYNER;
i:=createper(NAME,i);
if i=3 then goto NAMECONFL else
if i=4 then goto DEVUNKNOWN else
if i>0 then goto NOTALLOW;
goto REPCALL;
end call;
begin
comment mode;
if Tallow(termno) and sendadr=sysconpda then begin
readname(HNAME);
if HNAME(1)=121 shift 8 add 101 shift 8 add 115 then
terminalmode:=true else
if HNAME(1)=110 shift 8 add 111 shift 8 add 10 then
terminalmode:=false else goto SYNER;
end else goto NOTALLOW;
goto NEXT;
end mode;
begin
comment pseudointerrupt;
if Tallow(termno) or sendadr=sysconpda then begin
if readname(HNAME)<0 then goto SYNER;
i:=pseudoint(HNAME);
if i<>0 then goto NOTALLOW;
end else goto NOTALLOW;
goto NEXT;
end interrupt;
begin
comment pstop;
if sendadr=c1 then begin
array start(1:3);
boolean stopcount;
pda:=Ppda(currproc);
stopcount:=byteload(pda+10)=0;
if stopcount then ba:=stopint(pda,0);
error(<:pstop:>,0);
releaseproc(<:ptext:>);
removeproc(<:ptext:>);
messall(<:p is stopped :>,1,false);
rep:
waitanswer(att,M);
if M(2)<>c1 then goto rep;
readtext(c1,start,8);
if start(1)<>real <:pstar:> add 116 then goto rep;
messall(<:now p is running again:>,1,false);
careaproc(<:ptext:>);
reserveproc(<:ptext:>,0);
if stopcount then begin
waitanswer(ba,M);
startint(pda);
end;
end else goto SYNER;
end pstop;
begin
comment releasetext;
if Tallow(termno) and sendadr=sysconpda then
releaseproc(<:ptext:>) else goto NOTALLOW;
end;
begin
comment reservetext;
careaproc(<:ptext:>);
reserveproc(<:ptext:>,0);
end;
begin
comment messall from console1;
if sendadr<>c1 then goto NOTALLOW;
messall(<::>,0,true);
end;
begin
comment endprogram;
if sendadr<>c1 or -,Tallow(termno) then goto NOTALLOW;
write(out,<:<12>blocksread :>,blocksread);
endprogram(true);
end;
begin comment submit <bsfile>/submit <bsfile>.print;
REPSUB:
i:=readname(NAME);
if i=-2 then goto OK;
if i=-1 then goto SYNER;
j:=0;
if char=46 or char=47 or convert then begin
goto NOTALLOW;
j:=30000;
if -,convert then begin
if readname(HNAME)<0 then goto SYNER;
if HNAME(1)<>112 shift 8 add 114 shift 8 add 105
then goto SYNER;
end submit.print;
end;
M(1):=12 shift 12+(if j=0 then 1 else 0);
for i:=1,2,3,4 do M(i+1):=NAME(i);
M(6):=j;
if waitanswer(sendmessage(<:kø:>,M),M)<>1 or M(1)<>0 then goto SERROR;
j:=M(2);
for i:=1 step 1 until 4 do COMMAREA(i):=NAME(i);
COMMAREA(5):=32 shift 8 add 106 shift 8 add 111;
COMMAREA(6):=98 shift 8 add 32 shift 8 add (j//1000+48);
i:=j mod 1000; j:=i mod 100;
COMMAREA(7):=(i//100+48) shift 8 add (j//10+48) shift 8
add(j mod 10+48);
bytesmove:=14;
goto ENDINT;
end;
begin
comment convert <bsfile>;
convert:=true;
type:=22;
goto REPSUB;
end convert;
end case;
\f
OK:
COMMAREA(1):=114 shift 8 add 101 shift 8 add 97;
COMMAREA(2):=100 shift 8 add 121 shift 8 add 0;
bytesmove:=3;
comment ready;
goto ENDINT;
SYNER:
COMMAREA(1):=115 shift 8 add 121 shift 8 add 110;
COMMAREA(2):=116 shift 8 add 97 shift 8 add 120;
COMMAREA(3):=32 shift 8 add 101 shift 8 add 114;
COMMAREA(4):=114 shift 8 add 111 shift 8 add 114;
bytesmove:=8;
comment syntax error;
goto ENDINT;
UNKNOWN:
COMMAREA(1):=117 shift 8 add 110 shift 8 add 107;
COMMAREA(2):=110 shift 8 add 111 shift 8 add 119;
COMMAREA(3):=110 shift 8 add 0 shift 8 add 0;
bytesmove:=5;
comment unknown;
goto ENDINT;
IOER:
COMMAREA(1):=105 shift 8 add 110 shift 8 add 32;
COMMAREA(2):=111 shift 8 add 117 shift 8 add 116;
COMMAREA(3):=32 shift 8 add 101 shift 8 add 114;
COMMAREA(4):=114 shift 8 add 111 shift 8 add 114;
bytesmove:=8;
comment in out error;
goto ENDINT;
NAMECONFL:
COMMAREA(1):=110 shift 8 add 97 shift 8 add 109;
COMMAREA(2):=101 shift 8 add 32 shift 8 add 99;
COMMAREA(3):=111 shift 8 add 110 shift 8 add 102;
COMMAREA(4):=108 shift 8 add 105 shift 8 add 99;
COMMAREA(5):=116 shift 8 add 0 shift 8 add 0;
bytesmove:=9;
comment name conflict;
goto ENDINT;
NOTALLOW:
COMMAREA(1):=110 shift 8 add 111 shift 8 add 116;
COMMAREA(2):=32 shift 8 add 97 shift 8 add 108;
COMMAREA(3):=108 shift 8 add 111 shift 8 add 119;
COMMAREA(4):=101 shift 8 add 100 shift 8 add 0;
bytesmove:=7;
comment not allowed;
goto ENDINT;
NORESOURCES:
COMMAREA(1):=110 shift 8 add 111 shift 8 add 32;
COMMAREA(2):=114 shift 8 add 101 shift 8 add 115;
COMMAREA(3):=111 shift 8 add 117 shift 8 add 114;
COMMAREA(4):=99 shift 8 add 101 shift 8 add 115;
bytesmove:=8;
comment no resources;
goto ENDINT;
DEVUNKNOWN:
COMMAREA(1):=100 shift 8 add 101 shift 8 add 118;
COMMAREA(2):=105 shift 8 add 99 shift 8 add 101;
COMMAREA(3):= 32 shift 8 add 117 shift 8 add 110;
COMMAREA(4):=107 shift 8 add 110 shift 8 add 111;
COMMAREA(5):=119 shift 8 add 110 shift 8 add 0;
bytesmove:=9;
comment device unknown;
SERROR:
COMMAREA(1):=115 shift 8 add 117 shift 8 add 98;
COMMAREA(2):=109 shift 8 add 105 shift 8 add 116;
COMMAREA(3):= 32 shift 8 add 101 shift 8 add 114;
COMMAREA(4):=114 shift 8 add 111 shift 8 add 114;
bytesmove:=8;
comment submit error;
goto ENDINT;
ENDINT:
if bytesmove<0 then
begin bytesmove:=2; COMMAREA(1):=0; end else
if bytesmove extract 1=1 then
begin bytesmove:=bytesmove+1;
COMMAREA(bytesmove//2):=COMMAREA(bytesmove//2) add 10;
end else
begin bytesmove:=bytesmove+2; COMMAREA(bytesmove//2):=10; end;
end interprete;
boolean procedure Breakexec;
begin
Breakexec:=false;
if Pstate(currproc)=9 then
begin
if generaten(Bname)<>0 or reservesegm(Bname,(M(3)+2-M(2))//512)<>0
or careaproc(Bname)<>0 or reserveproc(Bname,0)<>0 then
begin Pstate(currproc):=6; removeproc(Bname); Breakexec:=true; end;
M(2):=firstaddr(Bfname); M(3):=M(2)+14;
pda:=Tpda(Pterm(currproc));
sysstate:=4; Pstate(currproc):=10;
end else
if Pstate(currproc)=10 then
begin
M(4):=0; pda:=description(Bname);
sysstate:=4; Pstate(currproc):=11;
end else
begin
permentry(Bname,0);
removeproc(Bname); Pstate(currproc):=10;
Breakexec:=true;
end;
end Breakexec;
\f
procedure remove(procno);
value procno;
integer procno;
comment removes procno;
begin
integer tbstate, pda;
tbstate:=TBstate(procno);
if tbstate>0 and TBtermbuf(procno)>0 then TBstate(procno):=21else
TBstate(procno):=TBtermbuf(procno):=TBprocbuf(procno):=0;
tbstate:=TBstate(procno);
pda:=Ppda(procno);
removeproc(pda);
for pda:=Pin(procno),Pout(procno) do
begin
if pda<>syspda then
begin
if wordload(pda)=4 then removeproc(pda);
end;
end;
if tbstate=0 then Ppda(procno):=0;
Pstate(procno):=Pterm(procno):=Pin(procno):=
Pout(procno):=Pbufadr(procno):=Pignore(procno):=0;
Ptobemod(procno):=Ptorun(procno):=false;
end remove;
\f
boolean procedure command(buff);
value buff;
integer buff;
comment takes care of the OS communication;
begin
own integer times, sendadr;
if times=0 then
begin
comment answer from operator;
waitanswer(buff,M);
sendadr:=M(2);
M(1):=3 shift 12;
M(2):=firstcommarea;
M(3):=lastcommarea;
operatorbuf:=sendmessage(sendadr,M);
times:=1;
command:=true;
oscomm:=true;
end
else
if times=1 then
begin
comment a serie of commands in COMMAREA;
if sysstate=0 then
begin
waitanswer(buff,M);
interprete(firstcommarea,lastcommarea,
if M(3)=0 then -1 else sendadr);
M(1):=5 shift 12;
M(2):=firstcommarea;
M(3):=firstcommarea+bytesmove-2;
operatorbuf:=sendmessage(sendadr,M);
times:=2;
command:=true;
end
else command:=false;
end
else
if times=2 then
begin
comment communication finished;
waitanswer(buff,M);
operatorbuf:=att;
times:=0;
command:=true;
oscomm:=false;
end
else error(<:command:>,3);
end command;
\f
boolean procedure parent_mess(buff,procno);
value buff, procno;
integer buff, procno;
comment takes action of a parentmessage, as follows from the
BOSS manual;
begin
boolean pause;
integer ba, i, res, pda;
integer array T(1:4);
if mess=7 shift 12 then
begin
if sysstate=0 then parent_mess:=proccommand(buff,Tpda(Pterm(procno)))
else parent_mess:=false;
goto ENDPL;
end;
pause:= mess extract 1 = 1;
if Pstate(procno)=0 or Pstate(procno)=6 or Pstate(procno)>=8 then
goto ENDPAR;
for i:=4 step 1 until 6 do
COMMAREA(i):= case (i-3) of (
if pause then 10 shift 8 add 112 shift 8 add 97
else 10 shift 8 add 109 shift 8 add 101,
if pause then 117 shift 8 add 115 shift 8 add 101
else 115 shift 8 add 115 shift 8 add 97,
if pause then 32 shift 8 add 0 shift 8 add 0
else 103 shift 8 add 101 shift 8 add 32 );
nameload(Ppda(procno)+2,T);
T(4):=T(4) add 32;
for i:=7 step 1 until 10 do
COMMAREA(i):=T(i-6);
for i:=11 step 1 until 17 do
COMMAREA(i):=wordload(buff+8+(i-10)*2);
M(1):=5 shift 12;
M(2):=firstcommarea+6;
M(3):=firstcommarea+32;
ba:=sendmessage(Tpda(Pterm(procno)),M);
if ba=0 then
begin parent_mess:=false; goto ENDPL; end;
res:=waitanswer(ba,M);
if mess=1 shift 13 add 1 then Pstate(procno):=8 else
if pause then Pstate(procno):=6;
ENDPAR:
parent_mess:=true;
getevent(buff);
M(1):=M(2):=M(3):=0;
sendanswer(1,buff,M);
ENDPL:
end parent_mess;
\f
integer procedure findterm(pda);
value pda;
integer pda;
comment finds the number of the terminal with PDA=pda,
0 if none;
begin
integer i;
if pda>0 then
for i:=1 step 1 until maxT do
if Tpda(i)=pda then
begin
findterm:=i;
goto FTEND;
end;
findterm:=0;
FTEND:
end findterm;
boolean procedure sense(buff,procno);
value buff, procno;
integer buff, procno;
comment executes sense of a terminal;
begin
integer pda, res, ba;
sense:=false;
M(1):=0;
ba:=sendmessage(Tpda(Pterm(procno)),M);
if ba=0 then goto ENDS;
res:=waitanswer(ba,M);
getevent(buff);
sendanswer(res,buff,M);
sense:=true;
ENDS:
end sense;
\f
integer procedure modify(procno);
value procno;
integer procno;
comment modifyes procno for input or output;
begin
integer tbfirst, state, firstadr, lastadr, procbuf;
state:=TBstate(procno);
procbuf:=TBprocbuf(procno);
tbfirst:=TBfirstadr(procno);
coreaddr:=procbuf+10;
firstadr:=wordl;
from:=to:=tbfirst;
bytes:=0;
if state=4 then
begin
coreaddr:=procbuf+12;
lastadr:=wordl;
bytes:=lastadr-firstadr+2;
if bytes>TBsize then bytes:=TBsize;
from:=firstadr;
TBstate(procno):=5;
end
else
if state=3 then
begin
ba:=TBtermbuf(procno);
result:=waita;
bytes:=M(2);
to:=firstadr;
getevent(procbuf);
M(1):=0;
ba:=procbuf;
TBstate(procno):=TBtermbuf(procno):=TBprocbuf(procno):=0;
end;
if bytes>0 then moveb;
if state=3 then senda;
modify:=bytes;
Ptobemod(procno):=false;
end modify;
\f
initp;
goto FIRSTEVENT;
\f
MESSAGE:
procno:=0;
coreaddr:=buff+6;
pda:=wordl;
if pda>0 then
for i:=1 step 1 until maxproc do
if Ppda(i)=pda then procno:=i;
if procno=0 then check_mess
else
begin
coreaddr:=buff+8;
mess:=wordl;
if mess=0 then
goto (if sense(buff,procno) then FIRST_EVENT else NEXT_EVENT)
else
if mess=3 shift 12 or mess=5 shift 12 then goto I_O_MESSAGE
else
if -,oscomm then
begin if parent_mess(buff,procno) then goto FIRSTEVENT; end;
goto NEXTEVENT;
end;
\f
I_O_MESSAGE:
tbstate:=TBstate(procno);
if tbstate>=6 then goto NEXT_EVENT;
if tbstate=0 then
begin
TBstate(procno):=tbstate:=if mess =3 shift 12 then 1 else 4;
TBprocbuf(procno):=buff;
end;
tobedumped:=currproc=procno;
if tbstate=4 and tobedumped then
begin
tobedumped:=modify(currproc)>16;
tbstate:=TBstate(procno):=5;
end
else
if tbstate=4 then Ptobemod(procno):=true;
if tbstate=1 or tbstate=5 then
begin
M(1):=if tbstate=1 then 19 shift 12 else 21 shift 12;
i:=M(2):=TBfirstadr(procno);
coreaddr:=buff+12;
j:=wordl;
coreaddr:=coreaddr-2;
j:=j-wordl;
if j>TBsize-2 then j:=TBsize-2;
M(3):=i+j;
M(4):=Ppda(procno);
pda:=Tpda(Pterm(procno));
i:=sendm;
if i=0 then goto NEXT_EVENT;
TBtermbuf(procno):=i;
tbstate:=TBstate(procno):=tbstate+1;
if tobedumped then goto FIND_NEXT;
end;
goto NEXT_EVENT;
\f
comment buff = the BA,
mess = the answer;
COMM_ANSWER:
if command(buff) then goto FIRST_EVENT else goto NEXT_EVENT;
\f
I_O_ANSWER:
tbstate:=TBstate(procno);
if tbstate=2 then
begin
TBstate(procno):=3;
Ptobemod(procno):=true;
if procno=currproc then
begin modify(currproc); goto FIRST_EVENT; end;
if terminalmode then Ptorun(procno):=true;
goto NEXT_EVENT;
end;
if tbstate=6 then
begin
i:=TBprocbuf(procno);
getevent(i);
ba:=buff;
result:=waita;
M(1):=0;
ba:=i;
senda;
end
else
if tbstate=21 and Pstate(procno)=0 then
begin
ba:=buff;
waita;
Ppda(procno):=0;
end
else goto NEXT_EVENT;
TBstate(procno):=TBprocbuf(procno):=TBtermbuf(procno):=0;
if procno<>currproc and terminalmode and tbstate<>21 then
Ptorun(procno):=true;
goto FIRST_EVENT;
\f
CLOCK:
time:=time+1;
if time<timeslice then
begin
if terminalmode and sysstate=0 then
for i:=1 step 1 until maxproc do
if i<>currproc and Ptorun(i) then goto FIND_NEXT;
totalruntime:=totalruntime+timeint;
ba:=clockbuf;
waita;
M(1):=0;
M(2):=timeint;
pda:=clockpda;
clockbuf:=sendm;
goto FIRST_EVENT;
end;
FIND_NEXT:
time:=0;
nextproc:=0; return:=false;
for procno:=currproc+1 step 1 until maxproc,
1 step 1 until currproc do
if Pignore(procno)>0 then Pignore(procno):=Pignore(procno)-1 else
if Pstate(procno)>0 then
begin
case Pstate(procno) of
begin
begin nextproc:=procno; goto FOUND; end;
;
begin
comment waiting for message, state=3;
coreaddr:=lastevent:=Ppda(procno)+14;
for coreaddr:=wordl while coreaddr<>lastevent and -,return do
begin
coreaddr:=coreaddr+4;
i:=wordl;
return:=i<0 or i>5;
coreaddr:=coreaddr-4;
end;
end;
begin
comment waiting for answer, state=4,
Pbufadr holds then BA of the answer;
return:=Ptobemod(procno) and Pbufadr(procno)=TBprocbuf(procno);
coreaddr:=lastevent:=Ppda(procno)+14;
for coreaddr:=wordl while -,return and coreaddr<>lastevent do
return:=Pbufadr(procno)=coreaddr;
end;
\f
begin
comment waiting for event, state=5,
Pbufadr holds the BA of lastbuffer;
coreaddr:=Pbufadr(procno);
return:=(Ptobemod(procno) and coreaddr=TBprocbuf(procno))
or (wordl)<>Ppda(procno)+14;
end;
;
begin nextproc:=procno; goto FOUND; end;
if currproc<>procno then begin nextproc:=procno; goto FOUND; end;
begin nextproc:=procno; goto FOUND; end break;
begin comment break is executed; end;
end case;
if return then
begin Pstate(procno):=1;
nextproc:=procno; goto FOUND;
end;
end for;
FOUND:
i:=if currproc=0 then 1 else
if Pstate(currproc)=8 then 3 else
if Ptobemod(currproc) then 4 else 2;
j:=if nextproc=0 then 1 else
if Pstate(nextproc)=8 then 3 else
if Ptobemod(nextproc) then 4 else 2;
type:=DES(if i=4 and currproc=nextproc then 17 else
if i=2 and j=2 and currproc=nextproc then 1 else (i-1)*4+j);
if nextproc>0 then Ptorun(nextproc):=false;
if currproc<>nextproc then noshift:=noshift+1;
\f
CHANGE:
for act:=sysstate step 1 until 12 do
if testbit(type,act) then
begin
case act+1 of
begin
modify(currproc);
begin
comment stop current, act=1;
pda:=Ppda(currproc);
Pignore(currproc):=if doubleload(pda+56)*100
//(getclock-doubleload(pda+60))<cpuused then 0
else ignoretimes;
ba:=changebuf;
waita;
changebuf:=stopi;
sysstate:=2;
goto FIRST_EVENT;
end 1;
begin
comment check instr, act=2;
coreaddr:=Ppda(currproc)+48;
coreaddr:=wordl;
instr:=wordl;
if (instr shift (-18)) extract 6=14 and
(instr shift (-11)) extract 1 =1 and
Pstate(currproc)=1 then
begin
instr:=instr extract 10;
i:=Pstate(currproc):=if instr=20 then 3 else
if instr=18 then 4 else
if instr=24 then 5 else 1;
coreaddr:=Ppda(currproc)+42;
if i>3 then Pbufadr(currproc):=wordl;
if i=5 and Pbufadr(currproc)=0 then
Pbufadr(currproc):=Ppda(currproc)+14;
end;
end 2;
remove(currproc);
begin
comment dump current, break act=4;
ba:=changebuf;
waita;
M(1):=5 shift 12;
M(2):=childfirstadr;
M(3):=childlastadr;
if Pstate(currproc)<9 then
A: begin
M(4):=childsegm*
((if currproc>maxdrumproc then currproc-maxdrumproc
else currproc)-1);
pda:=if currproc>maxdrumproc then pdumpareapda2
else pdumpareapda;
sysstate:=5;
end else if Breakexec then goto A;
changebuf:=sendm;
goto FIRST_EVENT;
end 4;
if currproc<>nextproc then remove(nextproc);
;
begin
comment load next, act=7;
ba:=changebuf;
waita;
M(1):=3 shift 12;
M(2):=childfirstadr;
M(3):=childlastadr;
M(4):=childsegm*
((if nextproc>maxdrumproc then nextproc-maxdrumproc
else nextproc)-1);
pda:=if nextproc>maxdrumproc then pdumpareapda2
else pdumpareapda;
if Pstate(nextproc)=7 then
begin
M(3):=childfirstadr+3584;
M(4):=0;
pda:=fppda;
Pstate(nextproc):=1;
end;
changebuf:=sendm;
sysstate:=8;
goto FIRSTEVENT;
end 7;
modify(nextproc);
if Pstate(nextproc)<9 then
begin
comment start next, act=9;
pda:=Ppda(nextproc);
starti;
end 9;
currproc:=0;
begin
comment goto FINDNEXT, act=11;
sysstate:=0;
goto FIND_NEXT;
end 11;
begin
comment return, act=12;
totalruntime:=totalruntime+timeint;
ba:=clockbuf;
waita;
M(1):=0;
M(2):=timeint;
pda:=clockpda;
clockbuf:=sendm;
sysstate:=0;
currproc:=nextproc;
goto FIRSTEVENT;
end 12;
end case;
end for-if;
\f
FIRST_EVENT: buff:=0;
NEXT_EVENT: res:=wait_event(buff);
if res=0 and sysstate=0 then goto MESSAGE else
if res=0 then goto NEXT_EVENT else
if buff=changebuf and sysstate>0 then goto CHANGE else
if buff=changebuf then goto NEXT_EVENT else
if buff=operatorbuf then goto COMM_ANSWER
else
if buff=clockbuf and sysstate=0 then goto CLOCK
else
if buff=clockbuf then begin time:=0; goto CLOCK end else
begin
for procno:=1 step 1 until maxTB do
if TBtermbuf(procno)=buff then goto IO_ANSWER;
getevent(buff);
goto FIRSTEVENT;
end;
end;
end;
ENDPROG:
end
head
(end
prun 0)
▶EOF◀