|
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: »kerneltxt «
└─⟦9ccaf6601⟧ Bits:30008165 Bånd med SW8000 kildetekst/release værktøjer
└─⟦39138f30b⟧
└─⟦this⟧ »kerneltxt «
<*******************************************************************>
<* Central logik til tascat. *>
<* *>
<* Reduceret udgave af centralogic i ALGOL Coroutine System *>
<* *>
<* Udskrifter af test m.m. til current output er fjernet ! *>
<* *>
<* Henning Godske 880111 *>
<*******************************************************************>
<**************************************************************>
<* Revision history *>
<* *>
<* 86.12.01 kernel release 1.0 *>
<* 88.01.11 time mess ændret fra 0 shift 12 + 2 til *>
<* 2 shift 12 + 6 *>
<* release 1.1 *>
<**************************************************************>
external long procedure kernel(traped);
procedure traped;
begin
integer max_sem,max_cor,sem_basis,cor_basis;
integer array ia(1:13);
system(5,co_own_base,ia);
maxsem:=ia(1);
sem_basis:=ia(2);
cor_basis:=ia(4);
max_cor:=(ia(3)-cor_basis) shift (-4);
begin
integer <* constant semafor *>
sem_mess_pool,
sem_mess,
sem_answ_pool,
sem_free,
sem_io,
sem_virt,
sem_ready;
integer <* reference *> array mess(1:1);
zone zt,zmess(1,1,stderror);
integer array timemess(1:12);
boolean array virt_arr(1:max_cor);
integer timebufadr, timersetup;
integer cor,sem,cause,state, term_cor, virt_error;
long antal, res, newnexttimeout, nexttimeout;
boolean take_message;
procedure init;
begin
integer ny_sem;
cause :=4;
virterror :=
timebufadr :=
timersetup :=
sem_mess_pool :=0;
sem_mess :=-1;
sem_answ_pool :=-2;
sem_virt :=-5;
sem_free :=-6;
sem_io :=-8;
sem_ready :=-9;
for cor:=1 step 1 until max_cor do
begin
virt_arr(cor):=false;
system(12,cor,ia);
nysem:=sem:=where(cor);
case ia(8)+1 of
begin
ny_sem := sem_free; <* empty *>
if sem <= sem_virt then ny_sem := sem_ready; <* pass. *>
ny_sem := sem_io; <* i/o *>
trap(199) <*passivated by activate *>
end;
if sem<>ny_sem then
cor_to_sem(ny_sem,cor);
end;
open(zt,2,<:clock:>,0);
getshare6(zt,timemess,1);
timemess(4):=(2 shift 12) + 6;
nexttimeout:=extend 1 shift 46;
initref(mess);
antal:=0;
dump;
end;
procedure dump;
begin
if cause < 1 and cor>0 then
cor_to_sem(sem_free,cor);
regret_timemess;
end;
integer procedure where(cor);
value cor;
integer cor;
begin
integer array ia(1:4);
for cor:=cor shift 4 + cor_basis, ia(4) while ia(1)<2048 do
begin
where:=(cor-sem_basis)//8;
system(5,cor-6,ia);
end;
end;
procedure virt;
begin
integer i;
if cause=-2 then
begin
virt_arr(term_cor):=true;
virt_arr( cor):=false add term_cor;
cor_to_sem(sem_virt,cor);
virt_error:=virt_error+1;
cause:=3;
end else
begin
virt_arr(term_cor):=false;
for i:=1 step 1 until max_cor do
if virt_arr(i) extract 12 = term_cor then
begin
cor_to_sem(sem_ready,i);
virt_arr(i):=false;
end;
end;
end;
procedure delay;
begin
newnexttimeout:=extend co_time shift 10 + co_time_base;
if newnexttimeout<nexttimeout then
begin
regret_timemess;
timemess(5):=co_time shift (-14);
timemess(6):=co_time shift 10;
setshare6(zt,timemess,1);
timebufadr:=monitor(16,zt,1,timemess);
timersetup:=timersetup+1;
nexttimeout:=newnexttimeout;
end;
end;
procedure regret_timemess;
begin
if timebufadr<>0 then timebufadr:=monitor(82,zt,1,timemess);
nexttimeout:=extend 1 shift 46;
end;
procedure event(proc);
value proc;
integer proc;
begin
integer result,nr,co_last_buf,co_next_buf;
state:=1;
co_last_buf:=co_next_buf:=co_8000_event:=0;
repeat
result:= monitor(if state=1 then proc else 66,zmess,co_next_buf,ia);
case result+2 of
begin
<* no event *>
begin
end;
<* message *>
if wait(sem_mess_pool,mess) > 0 then
begin
system(5,co_next_buf+2,mess);
mess(1):=mess(3);
mess(2):=abs mess(2);
mess(3):=co_next_buf;
if signal(sem_mess,mess) then
begin
state:=3;
monitor(26,zt,co_next_buf,mess); <* zt and mess dummy parameter *>
co_next_buf:=co_last_buf;
end else
begin
co_8000_event:=1;
wait(sem_mess,mess);
signal(sem_mess_pool,mess);
end;
end;
<* answer *>
if co_next_buf = time_buf_adr then
begin
regret_timemess;
co_next_buf:=co_last_buf;
if state=1 then state:=2;
end else
begin
co_last_buf:=co_next_buf;
wait_select:=co_next_buf;
if wait(sem_answ_pool,mess) > 0 then
begin
if signal(mess(3),mess) then state:=3
end else
if ia(1)<>0 then
begin
nr:=abs ia(1);
system(12,nr,ia);
if co_next_buf=ia(1) then
begin
state:=3;
cor_to_sem(sem_ready,nr);
end else co_8000_event:=1
end else co_8000_event:=1
end;
end;
until result=-1;
end;
init;
trap(error);
for antal:= antal+1 while cause > 0 do
begin
wait_select:=0;
wait_time := state:=0;
if co_8000_event <> 0 then event(66);
res:=schedule(cor);
while cor=0 do
begin
if state=0 then event(66);
if state<>3 then co_time:=0;
res:=schedule(cor);
if cor=0 then
begin
delay;
event(24);
end;
end;
cause:=res extract 24;
term_cor:=res shift (-24) extract 24;
if cause=2 then cor_to_sem(sem_io,term_cor) else
if cause=-2 or virt_arr(term_cor) then virt;
end;
dump;
kernel:=res;
if false then
error:
disable
begin
cause:=-4;
dump;
kernel:=res;
traped(200);
end;
end;
end;
end;
▶EOF◀