|
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: 59136 (0xe700)
Types: TextFile
Names: »pslangtext«
└─⟦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⟧
\f
;pcode=set 6
;pcode=slang type.yes
; Heinrich Bjerregaard.
; HCØ 21.06.74.
s. a64, b24, c12, e36,f6; begin code
w. ;
k=0 m.internal loop for OS p
21 06 74 ; slang
12 40 00 ;
am 2 ; entry 1: 0
am 2 ; entry 2: 2
am 2 ; entry 3: 4
am 2 ; entry 4: 6
am 2 ; entry 5: 8
am 2 ; entry 6: 10
am 2 ; entry 7: 12
am 2 ; entry 8: 14
am 2 ; entry 9: 16
am 2 ; entry 10:18
al w2 0 ;
rs. w1 b0. ; save base of code
rs. w3 b1. ; save return address
jl. x2 ; goto After
jl. e18. ;18 .. REMOVE CHILD
jl. (b14.) ;16 or REMOVE
jl. e11. ;14 or Interprete
jl. e15. ;12 or INITIALIZE
jl. e4. ;10 or NEXT_EVENT
jl. e3. ; 8 or FIRST_EVENT
jl. e2. ; 6 or CLOCK
jl. e7. ; 4 or I_O_MESSAGE
jl. e1. ; 2 or CHANGE
jl. e0. ; 0 or FINDNEXT;
; NOTE procedures defined by e-names must allways at entry has
; the absolute address of base of code in register w1.
; RETURN:
; Declarations:
; integer arrays:
a1 =10 ; Ppda
a2 =12 ; Pstate
a3 =14 ; Pterm
a4 =16 ; Pin
a5 =18 ; Pout
a6 =20 ; Pbufadr
a7 =22 ; Pignore
a8 =24 ; TBstate
a9 =26 ; TBtermbuf
a10=28 ; TBprocbuf
a11=30 ; TBfirstadr
a15=32 ; Tpda
a16=34 ; buf
; long arrays:
a18=a16+2 ; Cpustart
; boolean arrays:
a20=a18+2 ; Ptorun
a21=a20+2 ; Ptobemod
; booleans:
a25=a21+2 ; terminalmode
a26=a25+2 ; oscomm
a27=a26+2 ; pstart
; integers:
a30=a27 +2 ; currproc
a31=a30 +2 ; time
a32=a30 +4 ; maxproc
a33=a30 +6 ; noshift
a34=a30 +8 ; buff
a35=a30+10 ; cpuused
a36=a30+12 ; ignoretimes
a37=a30+14 ; changebuf
a38=a30+16 ; childfirstadr
a39=a30+18 ; childlastadr
a40=a30+20 ; maxdrumproc
a41=a30+22 ; childsegm
a42=a30+24 ; pdumpareapda2
a43=a30+26 ; pdumpareapda
a44=a30+28 ; fppda
a45=a30+30 ; timeint (changed to type real)
a46=a30+32 ; totalruntime (changed to type real)
a47=a30+34 ; timeslice
a48=a30+36 ; firstcommarea
a49=a30+38 ; syspda
a50=a30+40 ; TBsize
a51=a30+42 ; procno
a52=a30+44 ; maxTB
a53=a30+46 ; sysstate
a54=a30+48 ; P1
a55=a30+50 ; P2
a56=a30+52 ; P3
a57=a30+54 ; stataddr
; Operator buffer constants:
; The buffer input areas are placed in the bottom of the
; code to avoid bytevalues.
c0=4 ; maxop (0,2: means 2 buffers)
c1=60 ; length of each area in bytes
\f
; FIND_NEXT:
b. i12, j48, w. ; begin
i0: 0 ; procno
i1: 0 ; maxproc or currproc
i2: 0 ;
i3: 1<6+1<12 ; mask for DES
e0: rl w0 (x1+a53) ;
se w0 0 ; if sysstate <> 0 then
jd -1 ; hard error;
rs w0 (x1+a31) ; time:=0;
rs. w0 b2. ; nextproc:=0;
rs. w0 i2. ;
rl w2 (x1+a30) ;
rl w3 (x1+a32) ;
ds. w3 i1. ;
j0: rl. w2 i0. ; for procno:=currproc+1 step 1
al w2 x2+1 ; until maxproc,
rs. w2 i0. ; 1 step 1 until currproc do
j1: sh. w2 (i1.) ; begin
jl. j2. ;
rl. w0 i2. ;
se w0 0 ;
jl. j20. ;
al w2 1 ;
rl w3 (x1+a30) ;
ds. w3 i1. ;
rs. w2 i2. ;
jl. j1. ;
j2: ls w2 1 ; if Pignore(procno)>0 then
am (x1+a7) ; begin
rl w3 x2-2 ; Pignore(procno):=Pignore(procno)-1;
sh w3 0 ; goto Endloop;
jl. j4. ; end;
al w3 x3-1 ;
am (x1+a7) ;
rs w3 x2-2 ;
jl. j0. ;
j4: am (x1+a2) ; goto case Pstate(procno)+1 of
rl w3 x2-2 ;
ls w3 1 ;
jl. x3+2 ;
jl. j0. ;0 (empty action (no process)
jl. j5. ;1 running
jl. j0. ;2 empty action
jl. j6. ;3 waiting for message
jl. j8. ;4 waiting for answer
jl. j10. ;5 waiting for event
jl. j0. ;6 empty action
jl. j16. ;7 process found (creation)
jl. j12. ;8 process found (remove)
jl. j16. ;9 process found (dump)
jl. j0. ;10 empty action (excecution of dump)
jl. j0. ;11 - - - -
jl. j16. ;12 process found (break));
; Running:
b. h24, w. ; begin
j5: am (x1+a8) ;
rl w3 x2-2 ;
se w3 0 ; if TBstate(procno)=0
sn w3 3 ; or TBstate(procno)=3 or TBstate(procno)=4 then
jl. j16. ; goto Process found;
sn w3 4 ;
jl. j16. ;
jl. j0. ;
e. ; end running;
; Waiting for message:
b. h24, w. ; begin
j6: am (x1+a1) ;
rl w3 x2-2 ;
al w2 x3+14 ;
al w3 x3+14 ;
h0: rl w2 x2 ; look for a message
sn w2 x3 ;
jl. j0. ;
rl w0 x2+4 ; if found then
sl w0 0 ; goto Process found and set state;
sl w0 6 ;
jl. j14. ;
jl. h0. ;
e. ; end waiting for message;
; Waiting for answer:
b. h24, w. ; begin
j8: am (x1+a1) ;
rl w3 x2-2 ;
am (x1+a6) ; if Ptobemod(procno) and
rl w0 x2-2 ; Pbufadr(procno)=TBprocbuf(procno)
am (x1+a10) ; then
se w0 (x2-2) ; goto Process found and set state;
jl. h0. ;
ls w2 -1 ;
am (x1+a21) ;
hl w2 x2-1 ;
sz w2 1 ;
jl. j14. ;
h0: al w2 x3+14 ; look for an answer
al w3 x3+14 ;
h1: rl w2 x2 ; if found then
sn w2 x3 ; goto Process found and set state;
jl. j0. ;
se w0 x2 ;
jl. h1. ;
jl. j14. ;
e. ; end waiting for answer;
; Waiting for event:
b. h24, w. ; begin
j10: am (x1+a1) ;
rl w3 x2-2 ;
am (x1+a6) ;
rl w0 (x2-2) ;
se w0 x3+14 ; if wordload(Pbufadr(procno))<>
jl. j14. ; Ppda(procno)+14
; or Ptobemod(procno) then
ls w2 -1 ; goto Process found and set state;
am (x1+a21) ;
hl w0 x2-1 ;
sz w0 1 ;
jl. j14. ;
jl. j0. ;
e. ; end waiting for event;
j12: rl w2 (x1+a30) ;
se. w2 (i0.) ; if currproc<>procno then
jl. j16. ; goto Process found;
jl. j0. ;
e36: rl. w2 b2. ; Found:
rs. w2 i0. ;
ls w2 1 ;
am (x1+a2) ; if Pstate(procno)>=6 then
rl w0 x2-2 ; goto return;
sl w0 6 ;
jl x3 ;
j14: rl. w2 i0. ; Process found and set state:
ls w2 1 ;
al w0 1 ;
am (x1+a2) ; Pstate(procno):=1;
rs w0 x2-2 ;
j16: rl. w2 i0. ; Process found:
rs. w2 b2. ; nextproc:=procno;
jl. j20. ; goto Found;
; end for-loop;
j20: rl w2 (x1+a30) ; Found:
jl. w3 j32. ; i:=getindex(currproc);
rs. w2 b3. ; j:=getindex(nextproc);
rl. w2 b2. ;
jl. w3 j32. ;
rl. w0 b3. ;
rl w3 (x1+a30) ;
sn w0 2 ; if i=2
sl w2 3 ; and (j=1
jl. j21. ; or (j=2 and currproc=nextproc)) then
se w2 2 ;
jl. j40. ;
se. w3 (b2.) ; index:=
jl. j21. ;
j40: ls w3 1 ; (if Pstate(currproc)=1
am (x1+a2) ; then 5 else 18)
rl w3 x3-2 ; else
sn w3 1 ;
am 5-18 ;
al w3 18 ;
jl. j26. ;
j21: sn w0 4 ;
se. w3 (b2.) ; index:=if i=4 and currproc=nextproc
jl. j22. ; then 17 else if
al w3 17 ; i=2 and j=2 and currproc=nextproc
jl. j26. ; then 1 else (i-1)*4+j;
j22: sn w0 2 ;
se w2 2 ;
jl. j24. ;
se. w3 (b2.) ;
jl. j24. ;
al w3 1 ;
jl. j26. ;
j24: bs. w0 1 ;
ls w0 2 ;
wa w2 0 ;
al w3 x2 ;
j26: bz. w2 x3+b12. ;
sz w2 1<6 ;
lx. w2 i3. ; type:=DES(index);
rs. w2 b3. ;
rl. w2 b2. ;
sh w2 0 ; if nextproc=0 then
jl. e1. ; goto CHANGE;
; al w0 0 ; Ptorun(nextproc):=false;
; am (x1+a20) ;
; hs w0 x2-1 ;
j28: rl w2 (x1+a30) ;
sn. w2 (b2.) ; if currproc<>nextproc then
jl. j30. ; noshift:=noshift+1;
rl w2 (x1+a33) ;
al w2 x2+1 ;
rs w2 (x1+a33) ;
j30: jl. e1. ; goto CHANGE;
; integer procedure getindex(proc);
; call: return:
; w0 not used destroyed
; w1 base of code unchanged
; w2 proc result
; w3 link unchanged
b. h24, w. ; begin
j32: sn w2 0 ; begin
jl. h1. ;
ls w2 1 ;
am (x1+a2) ; getindex:=if proc=0 then 1 else
rl w0 x2-2 ; if Pstate(proc)=8 then 3 else
sn w0 8 ; if Ptobemod(proc) then 4 else 2;
jl. h3. ;
ls w2 -1 ;
am (x1+a21) ;
hl w0 x2-1 ;
so w0 1 ;
jl. h2. ;
h4: am 1 ;
h3: am 1 ;
h2: am 1 ;
h1: al w2 1 ;
jl x3 ;
e. ; end get index;
e. ; end FIND_NEXT;
\f
; Exits:
; RETURN:
e26: am 1 ; result:=CHANGE_IO
e25: am 1 ; or PLOTSTAT
e24: am 1 ; or ACTION
e23: am 1 ; or REMOVE
e22: am 1 ; or PARENT_COMM
e21: am 1 ; or INTERPRE
e20: al w1 1 ; or PROC_COMM;
rs. w3 b14. ; save return address;
jl. (b1.) ;
; Global variables:
b0: 0 ; base of code
b1: 0 ; return address
b2: 0 ; nextproc
b3: 0 ; type
b5: 3<12+0 ; input
b6: 5<12+0 ; output
b7: 0,r.5 ; message area: M
b8: 0,r.8 ; answer area: Ans
b9: <:clock:>,0,0,0 ;
b10: 0 ; clockbuf
b11: 2,0,5*1000 ; clockM
; DES:
; Bit 1<6 is now used instead of bit 1<12. In this
; way the information needed can be hold in halfwords.
h. ; ;; 98 76 54 32 10
b12: 0 ; tobedumped
2.00 00 00 00 00 00 ; 1
2.00 10 11 00 00 00 ; 2
2.11 00 00 10 00 00 ; 3
2.00 11 11 00 00 00 ; 4
2.00 00 00 00 00 00 ; 5
2.00 10 11 01 01 10 ; 6
2.00 00 00 10 00 00 ; 7
2.00 11 11 01 01 10 ; 8
2.00 00 01 00 10 10 ; 9
2.00 10 11 00 10 10 ; 10
2.11 00 00 10 10 10 ; 11
2.00 11 11 00 10 10 ; 12
2.00 00 00 00 00 01 ; 13
2.00 10 11 01 00 11 ; 14
2.00 00 00 10 00 01 ; 15
2.00 11 11 01 00 11 ; 16
2.00 00 00 00 00 01 ; 17
2.11 00 00 01 01 10 ; 18
w.
b13: 0,r.4 ; sense, output, input, finis
b14: 0 ; return address
e15: jl. e30. ; kangaroo jump
e16: jl. e23. ; kangaroo jump
e17: jl. e0. ; kangaroo jump
e18: jl. e31. ; kangaroo jump
\f
; CHANGE:
b. i12, j24, w. ; begin
i0: 0 ; act
i1: 100 ;
e1: rl w2 (x1+a53) ;
rs. w2 i0. ;
; jl.w3e23. ; test
j0: rl. w2 i0. ; for act:=sysstate step 1 until 12 do
al w2 x2+1 ; if testbit(type,act) then
rx. w2 i0. ; begin
rl. w1 b0. ;
sl w2 13 ;
jl. j21. ;
al w3 1 ;
ls w3 x2 ;
la. w3 b3. ;
sn w3 0 ;
jl. j0. ;
ls w2 1 ;
jl. x2+2 ; case act+1 of
jl. j2. ;0 (modify current,
jl. j4. ;1 stop current,
jl. j6. ;2 check instruction,
jl. j8. ;3 remove current,
jl. j10. ;4 dump - break,
jl. j7. ;5 remove next,
jl. j0. ;6 empty action,
jl. j12. ;7 load next,
jl. j1. ;8 modify next,
jl. j14. ;9 start next,
jl. j16. ;10 reset currproc,
jl. j18. ;11 find next,
jl. j20. ;12 return);
j1: rl. w2 b2. ; proc:=nextproc;
jl. 4 ;
j2: rl w2 (x1+a30) ; proc:=currproc;
jl. w3 f0. ; modify(proc);
jl. j0. ;
; Stop current:
b. h24, w. ; begin
j4: rl w2 (x1+a30) ;
ls w2 1 ;
am (x1+a1) ;
rl w3 x2-2 ; pda:=Ppda(currproc);
rs. w3 b8.+4 ;
ls w2 1 ;
am (x1+a18) ;
dl w0 x2-2 ;
ds. w0 b8.+2 ; k:=runtime - Cpustart(currproc);
am. (b8.+4) ;
dl w0 56 ; Cpustart(currproc):=runtime;
am (x1+a18) ;
ds w0 x2-2 ;
ss. w0 b8.+2 ; Pignore(currproc):=
wd. w0 i1. ; if k*100//timeslice < cpuused
al w3 0 ; then 0 else ignoretimes;
wd w0 (x1+a47) ;
al w3 0 ;
am (x1+a35) ;
sl w0 (0) ;
rl w3 (x1+a36) ;
ls w2 -1 ;
am (x1+a7) ;
rs w3 x2-2 ;
rl. w3 b8.+4 ;
rl w2 (x1+a37) ;
al. w1 b8. ;
jd 1<11+18 ; wait answer(answer,changebuf);
jl. w2 f2. ; move name(pda);
jd 1<11+60 ; stop internal proc(changebuf,name);
rl. w1 b0. ;
rs w2 (x1+a37) ;
al w2 2 ;
rs w2 (x1+a53) ; sysstate:=2;
jl. e3. ; goto FIRST_EVENT;
e. ; end stop current;
; Check instruction:
b. h24, w. ; begin
h0: jd 1<11 ;
h1: 0 ;
j6: rl w2 (x1+a30) ;
ls w2 1 ;
am (x1+a1) ;
rl w3 x2-2 ;
rs. w3 h1. ;
rl w3 (x3+48) ;
ws. w3 h0. ;
sl w3 18 ;
sl w3 25 ;
jl. j0. ;
am (x1+a2) ;
rl w0 x2-2 ;
se w0 1 ; if Pstate(currproc)<>1 then
jl. j0. ; goto return;
jl. x3-16 ; goto
jl. h3. ; wait answer
jl. h4. ; or wait message
jl. j0. ; or ignore send answer
; or wait event;
am 1 ; Wait event:
h2: al w0 4 ; Wait answer1:
am (x1+a2) ; Pstate(currproc):=4
rs w0 x2-2 ; or 5;
rl. w3 h1. ;
rl w3 x3+42 ; Pbufadr(currproc):=buf;
am (x1+a6) ;
rs w3 x2-2 ; if wait event and
sn w3 0 ; Pbufadr(currproc)=0 then
se w0 5 ; Pbufadr(currproc):=next event;
jl. j0. ;
rl. w3 h1. ;
al w3 x3+14 ;
am (x1+a6) ;
rs w3 x2-2 ;
jl. j0. ;
h3: rl. w3 h1. ; Wait answer:
rl w3 x3+42 ;
rl w3 x3+4 ;
sh w3 0 ;
ac w3 x3 ;
rl w3 x3 ; if receiver.kind<>backing store then
se w3 4 ; goto Wait answer1;
jl. h2. ;
jl. j0. ;
h4: al w0 3 ; Wait message:
am (x1+a2) ;
rs w0 x2-2 ; Pstate(currproc):=3;
jl. j0. ;
e. ; end check instr;
j7: rl. w2 b2. ; if currproc<>nextproc then
am (x1+a30) ; remove(nextproc);
se w2 (0) ;
jl. w3 f1. ;
jl. j0. ;
j8: rl w2 (x1+a30) ; remove(currproc);
jl. w3 f1. ;
jl. j0. ;
; Dump current:
b. h24, w. ; begin
h0: <:<10>:>,0,r.4 ;
<: dump on :> ;
h1: 0,r.4 ; wrk-name
h2: 0,r.8,7<12,0 ; tail
j10: rl w2 (x1+a37) ;
al. w1 b8. ;
jd 1<11+18 ; wait answer(answer,changebuf);
rl. w1 b0. ;
rl. w3 b6. ;
rl w0 (x1+a38) ; M(1):=5 shift 12;
ds. w0 b7.+2 ; M(2):=childfirstadr;
rl w0 (x1+a39) ; M(3):=childlastadr;
rs. w0 b7.+4 ;
rl w2 (x1+a30) ;
ls w2 1 ;
am (x1+a2) ;
rl w0 x2-2 ;
sl w0 9 ; if Pstate(currproc)<9
sl w0 12 ; or Pstate(currproc)>=12 then
jl. 4 ;
jl. h6. ;
h4: rl w0 (x1+a30) ; A:begin
rl w2 (x1+a40) ;
rl w3 (x1+a43) ;
sh w0 x2 ; M(4):=((if currproc>maxdrumproc then
jl. h5. ; currproc-maxdrumproc else
ws w0 4 ; maxdrumproc)-1)*childsegm;
rl w3 (x1+a42) ;
h5: bs. w0 1 ;
al w2 x3 ; pda:=if currproc>maxdrumproc then
wm w0 (x1+a41) ; pdumparea2 else
rs. w0 b7.+6 ; pdumparea;
al w0 5 ;
rs w0 (x1+a53) ; sysstate:=5;
jl. h20. ; goto S;
; end;
h6: se w0 9 ; Break:
jl. h12. ; if Pstate(currproc)=9 then
am (x1+a1) ; begin
rl w2 x2-2 ;
dl w0 x2+4 ; move name of sender
ds. w0 h0.+4 ;
dl w0 x2+8 ;
ds. w0 h0.+8 ;
al. w3 h1. ;
jd 1<11+68 ; generate name(wrk);
rl. w2 b7.+4 ;
al w2 x2+510 ;
ws. w2 b7.+2 ;
ls w2 -9 ;
rs. w2 h2. ;
al. w1 h2. ;
jd 1<11+40 ; create entry(wrk,M(3)+510-M(2)//512);
al w1 0 ;
jd 1<11+50 ; permanent entry(wrk,0);
jd 1<11+52 ; create area process(wrk);
jd 1<11+ 8 ; reserve process(wrk);
sn w0 0 ;
jl. h10. ; if error in calling monitor
am -4 ; or finish then
h8: al w0 10 ;F: begin
rl. w1 b0. ; remove process(wrk);
rl w2 (x1+a30) ;
ls w2 1 ;
am (x1+a2) ; Pstate(currproc):= 6
rs w0 x2-2 ; or 10;
jd 1<11+64 ;
jl. h4. ; goto A;
; end;
h10: al. w2 h0. ;
al w3 x2+22 ; M(2):=first of text;
ds. w3 b7.+4 ; M(3):=last of text;
rl. w1 b0. ;
rl w3 (x1+a30) ;
ls w3 1 ;
am (x1+a3) ;
rl w2 x3-2 ;
ls w2 1 ; pda:=Tpda(Pterm(currproc));
am (x1+a15) ; sysstate:=4;
rl w2 x2-2 ;
al w0 4 ; Pstate(currproc):=10;
rs w0 (x1+a53) ;
al w0 10 ;
am (x1+a2) ;
rs w0 x3-2 ; goto S;
jl. h20. ; end
; else
h12: se w0 10 ; if Pstate(currproc)=10 then
jl. h14. ; begin
al w0 0 ;
rs. w0 b7.+6 ; M(4):=0;
al w0 11 ;
am (x1+a2) ;
rs w0 x2-2 ; Pstate(currproc):=11;
al w0 4 ;
rs w0 (x1+a53) ; sysstate:=4;
al. w2 h1.-2 ; pda:=first of name - 2;
jl. h20. ; goto S;
; end else
h14: al. w3 h1. ; goto F;
jl. h8. ;
j11: ;
h20: al w3 x2 ; S:
jl. w2 f2. ; move name(receiver);
al. w1 b7. ;
jd 1<11+16 ; send message(mess,buf,name);
rl. w1 b0. ;
rs w2 (x1+a37) ; changebuf:=buf;
jl. e3. ; goto FIRST_EVENT;
e. ; end dump/break;
; Load next:
b. h24, w. ; begin
h0: 3584 ; fp-size
j12: rl w2 (x1+a37) ;
al. w1 b8. ;
jd 1<11+18 ; wait answer(answer,changebuf);
rl. w1 b0. ;
rl. w3 b5. ;
rl w0 (x1+a38) ; M(1):=3 shift 12;
ds. w0 b7.+2 ; M(2):=childfirstadr;
rl. w2 b2. ;
ls w2 1 ;
am (x1+a2) ;
rl w3 x2-2 ; if Pstate(nextproc)=7 then
se w3 7 ; begin
jl. h4. ;
al w3 1 ;
am (x1+a2) ; Pstate(nextproc):=1;
rs w3 x2-2 ;
rl w2 (x1+a44) ; pda:=fppda;
wa. w0 h0. ;
al w1 0 ; M(3):=childfirstadr+fpsize;
ds. w1 b7.+6 ; M(4):=0;
jl. h8. ; end
; else
h4: rl. w0 b2. ; begin
rl w3 (x1+a40) ;
rl w2 (x1+a43) ;
sh w0 x3 ; M(3):=childlastadr;
jl. h6. ; M(4):=((if nextproc>maxdrumproc then
ws w0 6 ; nextproc-maxdrumproc else
rl w2 (x1+a42) ; nextproc)-1)*childsegm;
h6: bs. w0 1 ; pda:=if nextproc>maxdrumproc then
wm w0 (x1+a41) ; pdumparea2 else
rl w3 (x1+a39) ; pdumparea;
ds. w0 b7.+6 ; end;
h8: rl. w1 b0. ;
al w0 8 ;
rs w0 (x1+a53) ; sysstate:=8;
jl. j11. ; goto S;
e. ; end load next;
; Start next:
b. h24, w. ; begin
j14: rl. w2 b2. ;
ls w2 1 ;
am (x1+a2) ;
rl w0 x2-2 ; if Pstate(nextproc)<9
sl w0 9 ; or Pstate(nextproc)>=12 then
sl w0 12 ; begin
jl. 4 ;
jl. j0. ;
am (x1+a1) ; pda:=Ppda(nextproc);
rl w3 x2-2 ;
ds. w3 b7.+2 ;
jl. w2 f2. ; move name(pda);
se w0 12 ; if Pstate(nextproc) = 12 then
jl. h20. ; begin
rl. w2 b7. ;
rl. w1 b0. ;
al w0 1 ; Pstate(nextproc):=1;
am (x1+a2) ;
rs w0 x2-2 ;
rl. w1 b7.+2 ;
rl w2 x1+36 ; intaddr:=Ppda(nextproc).interrupt addr;
sn w2 0 ; if intaddr=0 then
jl. h6. ; goto Modif;
dl w0 x1+40 ;
ds w0 x2+2 ;
dl w0 x1+44 ; move register dump to
ds w0 x2+6 ; int_addr of child and forward
dl w0 x1+48 ;
ds w0 x2+10 ;
al w0 8 ;
rs w0 x2+12 ;
h6: al w0 x2+14 ; Modif:
rs. w0 b8.+10 ;
al. w3 b8. ;
al w1 x3 ; modify child(int_addr + 14);
jd 1<11+62 ; end break;
h20: jd 1<11+58 ; start internal proc(name);
jl. j0. ; end;
e. ; end start next;
; Reset currproc:
j16: al w0 0 ;
rs w0 (x1+a30) ; currproc:=0;
jl. j0. ;
; Find next:
j18: al w0 0 ;
rs w0 (x1+a53) ; sysstate:=0;
jl. e0. ; goto FIND_next;
; Return:
b. h24, w. ; begin
j20: rl. w0 b2. ;
rs w0 (x1+a30) ; currproc:=nextproc;
j21: al w3 0 ;
rs w3 (x1+a53) ; sysstate:=0;
j24: dl w0 (x1+a45) ; New clock buf:
fa w0 (x1+a46) ;
ds w0 (x1+a46) ; totalruntime:=totalruntime+timeint;
rl. w2 b10. ;
al. w1 b8. ;
jd 1<11+18 ; wait answer(answer,clockbuf);
al. w1 b11. ;
al. w3 b9. ;
jd 1<11+16 ; send message(mess,buf,<:clock:>);
rl. w1 b0. ;
rs. w2 b10. ; clockbuf:=buf;
jl. e3. ; goto FIRST_EVENT;
e. ; end return;
; CLOCK:
b. h24, w. ; begin
e2: rl w2 (x1+a31) ;
al w2 x2+1 ;
rs w2 (x1+a31) ; time:=time+1;
rl w3 (x1+a47) ;
sl w2 x3 ; if time>=timeslice then
jl. e0. ; goto FIND_NEXT;
c.-1
rl w0 (x1+a25) ;
rl w3 (x1+a53) ;
sz w0 1 ;
se w3 0 ; if terminalmode and sysstate=0 then
jl. h8. ; begin
rl w0 (x1+a30) ;
rl w3 (x1+a32) ;
h2: sn w0 x3 ; for i:=maxproc step -1 until 1 do
jl. h4. ; if i<>currproc and Ptorun(i) then
am (x1+a20) ; goto FIND_NEXT;
hl w2 x3-1 ;
sz w2 1 ; end;
jl. e0. ;
h4: al w3 x3-1 ;
se w3 0 ;
jl. h2. ;
z.
h8: jl. j24. ; goto New clock buf;
e. ; end CHANGE;
e. ; end clock;
\f
; FIRST_EVENT:
e3: al w0 0 ;
rs w0 (x1+a34) ; buff:=0;
jl. e4. ; goto NEXT_EVENT;
; NEXT_EVENT:
b. h24, w. ; begin
e4: rl w2 (x1+a34) ;
jd 1<11+24 ; wait event(res,buff);
rs w2 (x1+a34) ;
rl w3 x1+6 ;
rl w3 x3+48 ;
sn w2 x3 ; if buff=spare mess buf then
jl. e4. ; goto NEXT_EVENT;
rl w3 (x1+a27) ;
sz w3 1 ; if pstart then
jl. h3. ; goto Checkopbuf;
rl w3 (x1+a53) ;
sn w0 0 ;
se w3 0 ; if res=0
jl. 4 ; and sysstate=0 then
jl. e5. ; goto MESSAGE;
sn w0 0 ; if res=0 then
jl. e4. ; goto NEXT_EVENT;
rl w0 (x1+a37) ;
sn w0 x2 ; if buff=changebuf
sh w3 0 ; and sysstate>0 then
jl. 4 ; goto CHANGE;
jl. e1. ;
sn w0 x2 ; if buff=changebuf then
jl. e4. ; goto NEXT_EVENT;
se w3 0 ; if sysstate=0 then
jl. h5. ; begin
h3: al w3 -2 ; Checkopbuf:
h4: al w3 x3+2 ; for k:=0 step 2 until maxop do
rl. w0 x3+c2. ; if operatorbuf(k)=buff then
sn w0 x2 ; goto COMMAND;
jl. e10. ;
se w3 c0 ;
jl. h4. ;
rl w3 (x1+a27) ;
sz w3 1 ; if pstart then
jl. e4. ; goto NEXT_EVENT;
sn. w2 (b10.) ; if buff=clockbuf then
jl. e2. ; goto CLOCK;
; end;
h5: se. w2 (b10.) ; if buff=clockbuf then
jl. h6. ; begin
al w0 0 ; time:=0;
rs w0 (x1+a31) ; goto CLOCK;
jl. e2. ; end;
h6: rl w3 (x1+a52) ;
ls w3 1 ;
h7: am (x1+a9) ; for procno:=maxTB step -1 until 1 do
se w2 (x3-2) ; if TBtermbuf(procno)=buff then
jl. h8. ; goto I_O_ANSWER;
ls w3 -1 ;
rs w3 (x1+a51) ;
jl. e8. ;
h8: al w3 x3-2 ;
se w3 0 ;
jl. h7. ;
al w3 2 ;
h10: am (x1+a16) ; i:=0;
rl w0 x3-2 ; for i:=i+1 while buf(i)<>-1
se w0 x2 ; and buf(i)<>buff do;
jl. h11. ;
ls w3 -1 ; if buf(i)=buff then
rs w3 (x1+a54) ; begin
jl. e24. ; p1:=i;
h11: al w3 x3+2 ; goto ACTION;
se w0 -1 ; end;
jl. h10. ;
rl w3 (x1+a53) ;
se w3 0 ; if sysstate>0 then
jl. e4. ; goto NEXT_EVENT;
rl w3 x2+6 ;
sn w3 0 ; if buff error then
jl. e3. ; goto FIRST_EVENT;
jd 1<11+26 ; get event(buff);
jl. e3. ; goto FIRST_EVENT;
e. ; end nextevent;
\f
; MESSAGE:
b. i12, j24, w. ;
i0: 50<12,60<12 ; operation
e5: al w0 0 ; begin
rs w0 (x1+a51) ;
rl w2 (x1+a34) ;
rl w0 x2+6 ;
sh w0 0 ; if buff.sender<=0 then
jl. e9. ; goto CHECK_MESS;
rl w3 x2+8 ;
sn. w3 (i0.) ; if buff.operation = 50 shift 12 then
jl. e25. ; goto PLOTSTAT;
j2: rl w3 (x1+a32) ;
ls w3 1 ;
j4: am (x1+a1) ; for i:=maxproc step -1 until 1 do
sn w0 (x3-2) ; if buff.sender=Ppda(i) then
jl. j6. ; goto FOUND;
al w3 x3-2 ;
se w3 0 ; goto CHECK_MESS;
jl. j4. ;
jl. e9. ;
j6: ls w3 -1 ; FOUND:
rs w3 (x1+a51) ; procno:=i;
rl w3 x2+8 ;
sn w3 0 ; if buff.operation=0 then
jl. e6. ; goto SENSE;
se. w3 (b5.) ; if buff.operation=3 shift 12
sn. w3 (b6.) ; or buff.operation=5 shift 12 then
jl. e7. ; goto I_O_MESSAGE;
rl w0 (x1+a26) ;
sz w0 1 ; if oscomm then
jl. e4. ; goto NEXT_EVENT;
se. w3 (i0.+2) ; if buff.operation = 60 shift 12 then
jl. j8. ; begin comment change child terminal;
rl w0 x2+10 ; P1:=buff.ioaddress;
rs w0 (x1+a54) ; goto CHANGE_IO;
jl. e26. ; end;
j8: jl. e12. ; goto PARENT_MESS;
e. ; end message;
\f
; SENSE:
b. h24, w. ; begin
h0: 0 ; pda of terminal
e6: al w0 0 ;
rs. w0 b7. ; M(1):=0;
rl. w3 b13. ;
al w3 x3+1 ; nosense:=nosense+1;
rs. w3 b13. ;
rl w3 (x1+a51) ;
ls w3 1 ;
am (x1+a3) ;
rl w3 x3-2 ;
ls w3 1 ;
am (x1+a15) ; move name(Tpda(Pterm(procno)));
rl w3 x3-2 ;
rs. w3 h0. ; save pda;
jl. w2 f2. ;
al. w1 b7. ;
jd 1<11+16 ; send message(M,ba,name);
rl. w1 b0. ;
sn w2 0 ; if ba=0 then
jl. e4. ; goto NEXT_EVENT;
al. w1 b8. ;
jd 1<11+18 ; wait answer(result,Ans,ba);
rl. w3 b0. ;
rl w2 (x3+a34) ;
jd 1<11+26 ; get event(buff);
rl. w3 h0. ;
rs. w3 b8.+6 ; ans(4):=pda of terminal;
jd 1<11+22 ; send answer(result,Ans,buff);
rl. w1 b0. ;
jl. e3. ; goto FIRST_EVENT;
e. ; end sense;
\f
; I_O_MESSAGE:
b. i12, j24, w. ; begin
i0: 19<12, 21<12 ;
e7: rl w3 (x1+a51) ;
ls w3 1 ;
am (x1+a8) ;
rl w0 x3-2 ;
sl w0 6 ; if TBstate(procno)>=6 then
jl. e4. ; goto NEXT_EVENT;
se w0 0 ; if TBstate(procno)=0 then
jl. j4. ; begin
rl w2 (x1+a34) ;
am (x1+a10) ;
rs w2 x3-2 ; TBprocbuf(procno):=buff;
rl w2 x2+8 ;
se. w2 (b5.) ;
am 3 ;
al w0 1 ; TBstate(procno):=
am (x1+a8) ; if buff.operation=3 shift 12 then 1
rs w0 x3-2 ; else 4;
; end;
j4: rl w2 (x1+a30) ;
ls w2 1 ;
sn w2 x3 ; tobedumped:=currproc=procno;
am -1 ;
al w2 0 ;
hs. w2 b12. ;
se w2 0 ; if tobedumped
se w0 4 ; and TBstate(procno)=4 then
jl. j6. ; begin
rl w2 (x1+a30) ;
jl. w3 f0. ; j:=modify(currproc);
sh w1 6 ;
am 1 ;
al w2 -1 ;
rl. w1 b0. ; tobedumped:=j>6;
hs. w2 b12. ;
rl w3 (x1+a51) ;
ls w3 1 ;
al w0 5 ;
am (x1+a8) ; TBstate(procno):=5;
rs w0 x3-2 ; end
jl. j8. ; else
j6: se w0 4 ; if Tbstate(procno)=4 then
jl. j8. ; Ptobemod(procno):=true;
al w2 -1 ;
ls w3 -1 ;
am (x1+a21) ;
hs w2 x3-1 ;
ls w3 1 ;
j8: se w0 1 ; if TBstate(procno)<>1
sn w0 5 ; and TBstate(procno)<>5 then
jl. j10. ; goto ENDIO;
jl. j20. ;
j10: hs. w0 j13. ;
hs. w3 j15. ;
al w2 x3 ;
se w0 1 ;
am 2 ;
rl. w3 i0. ; M(1):=if TBstate(procno)=1 then
am (x1+a11) ; 19 shift 12 else 21 shift 12;
rl w0 x2-2 ;
ds. w0 b7.+2 ; M(2):=TBfirstadr(procno);
rl w3 (x1+a34) ;
rl w0 x3+12 ;
ws w0 x3+10 ; j:=buff.lastaddr-buff.firstaddr;
rl w3 (x1+a50) ;
al w3 x3-2 ; if j>TBsize-2 then
sl w0 x3+2 ; then j:=TBsize-2;
al w0 x3 ;
wa. w0 b7.+2 ;
rs. w0 b7.+4 ; M(3):=M(2)+j;
am (x1+a1) ;
rl w0 x2-2 ;
rs. w0 b7.+6 ; M(4):=Ppda(procno);
am (x1+a3) ;
rl w3 x2-2 ;
ls w3 1 ;
am (x1+a15) ;
rl w3 x3-2 ;
jl. w2 f2. ; move name(Tpda(Pterm(procno)));
al. w1 b7. ;
jd 1<11+16 ; send message(M,ba,name);
rl. w1 b0. ;
sn w2 0 ; if ba=0 then
jl. e4. ; goto NEXT_EVENT;
j13=k+1
al w0 0 ;
j15=k+1
al w3 0 ;
am (x1+a9) ;
rs w2 x3-2 ; TBtermbuf(procno):=ba;
ba. w0 1 ;
am (x1+a8) ;
rs w0 x3-2 ; TBstate(procno):=TBstate(Procno)+1;
hl. w0 b12. ;
sz w0 1 ; if tobedumped then
jl. e0. ; goto FIND_NEXT;
j20: jl. e4. ; ENDIO: goto NEXT_EVENT;
e. ; end iomessage;
\f
; I_O_ANSWER:
b. i12, j24, w. ; begin
e8: rl w2 (x1+a51) ;
al w3 x2 ;
ls w3 1 ;
am (x1+a8) ;
rl w0 x3-2 ;
se w0 2 ; if Tbstate(procno)=2 then
jl. j8. ; begin
al w0 3 ;
am (x1+a8) ;
rs w0 x3-2 ; TBstate(procno):=3;
al w0 -1 ;
am (x1+a21) ;
hs w0 x2-1 ; Ptobemod(procno):=true;
rl w3 (x1+a30) ;
am (x1+a53) ;
am (0) ;
se w3 x3 ; if sysstate=0 then
jl. j6. ; begin
se w3 x2 ; if currproc=procno then
jl. j5. ; begin
jl. w3 f0. ; modify(currproc);
rl. w1 b0. ; goto FIRST_EVENT;
jl. e3. ; end;
j5: rs. w2 b2. ; nextproc:=procno; goto Found;
jl. w3 e36. ; end;
j6:
c.-1, rl w3 (x1+a25) ; if terminalmode then
so w3 1 ; Ptorun(procno):=true;
jl. e4. ;
am (x1+a20) ; goto NEXT_EVENT;
hs w0 x2-1 ;
z.
jl. e4. ; end;
j8: se w0 6 ; if TBstate(procno)=6 then
jl. j12. ; begin
am (x1+a10) ;
rl w2 x3-2 ;
hs. w3 j11. ;
jd 1<11+26 ; get event(TBprocbuf(procno));
al w3 x2 ;
rl w2 (x1+a34) ;
al. w1 b8. ;
jd 1<11+18 ; wait answer(result,Ans,buff);
al w2 x3 ;
al w3 0 ;
rs w3 x1 ; Ans(1):=0;
sn w0 1 ; if result<>1 then
jl. j10. ; begin
al w0 1 ; result:=1;
rs w3 x1+2 ; bytes:=chars:=0;
rs w3 x1+4 ; end;
j10: jd 1<11+22 ; send answer(result,Ans,TBprocbuf(procno));
rl. w1 b0. ;
j11=k+1
al w3 0 ;
jl. j16. ; goto Clear;
; end else
j12: se w0 21 ; if TBstate(procno)<>21
jl. e4. ; or Pstate(procno)<>0 then
am (x1+a2) ; goto NEXT_EVENT;
rl w0 x3-2 ;
se w0 0 ;
jl. e4. ;
am (x1+a1) ;
rs w0 x3-2 ; Ppda(procno):=0;
rl w2 (x1+a34) ;
al. w1 b8. ;
jd 1<11+18 ; wait answer(Ans,buff);
rl. w1 b0. ;
j16: al w0 0 ; Clear:
am (x1+a8) ; state:=TBstate(procno);
rx w0 x3-2 ; TBstate(procno):=0;
hs. w0 j17. ;
al w0 0 ;
am (x1+a9) ;
rs w0 x3-2 ; TBtermbuf(procno):=0;
am (x1+a10) ;
rs w0 x3-2 ; TBprocbuf(procno):=0;
j17=k+1
al w0 0 ;
sn w0 21 ; if state=21 then
jl. e3. ; goto FIRST_EVENT;
rl w0 (x1+a25) ;
ls w3 -1 ;
rl w2 (x1+a30) ;
sz w0 1 ; if -,terminalmode
sn w3 x2 ; or currproc=procno then
jl. e3. ; goto FIRST_EVENT;
rl w0 (x1+a53) ; if sysstate=0 then
se w0 0 ; begin
jl. j18. ; nextproc:=procno;
rs. w3 b2. ; goto Found; (in FIND_NEXT)
jl. w3 e36. ; end;
j18:; al w0 -1 ;
; am (x1+a20) ;
; hs w0 x3-1 ; Ptorun(procno):=true;
jl. e3. ; goto FIRST_EVENT;
e. ; end ioanswer;
\f
; CHECK_MESS:
b. h24, w. ; begin
h0: 7<12 ;
h1: 351417 ;
e9: rl w2 (x1+a34) ;
rl w0 x2+8 ;
rl w3 x2+16 ;
sn. w0 (h0.) ; if buff.operation=7 shift 12
se. w3 (h1.) ; and buff.16=351417 then
jl. h4. ; begin
rl w0 (x1+a26) ;
rl w3 (x1+a53) ;
so w0 1 ; if oscomm
se w3 0 ; or sysstate<>0 then
jl. e4. ; goto NEXT_EVENT else
jl. e20. ; goto PROC_COMM;
; end;
h4: jd 1<11+26 ; get event(buff);
al w0 2 ;
al. w1 b8. ;
jd 1<11+22 ; send answer(2,Ans,buff);
rl. w1 b0. ;
jl. e3. ; goto FIRST_EVENT;
e. ; end checkmess;
\f
; COMMAND:
b. h24, w. ; begin
h0: 0 ; k
e10: rl. w0 x3+c4. ;
rs. w3 h0. ; save k
se w0 0 ; if times(k)=0 then
jl. h2. ; begin
al. w1 b8. ; comment answer from operator;
al w0 1 ;
rs. w0 x3+c4. ; times(k):=1;
jd 1<11+18 ; wait answer(Ans,buff);
rl. w1 b5. ;
rl. w2 x3+c3. ; M(1):=3 shift 12;
ds. w2 b7.+2 ; M(2):=first of input area(k);;
al w2 x2+c1-2 ; M(3):=last of input area(k);
rs. w2 b7.+4 ;
rl. w3 b8.+2 ;
am. (h0.) ; oldsendaddress(k):=Ans(2);
rs. w3 c5. ;
jl. w2 f2. ; move name(Ans(2));
al. w1 b7. ;
jd 1<11+16 ; send message(M,operatorbuf(k),name);
rl. w1 b0. ;
am. (h0.) ;
rs. w2 c2. ;
al w0 -1 ;
rs w0 (x1+a26) ; oscomm:=true;
jl. e3. ; goto FIRST_EVENT;
; end;
h2: se w0 1 ; if times=1 then
jl. h4. ; begin
rl w0 (x1+a53) ;
se w0 0 ; if sysstate<>0 then
jl. e4. ; goto NEXT_EVENT;
al w0 2 ;
rs. w0 x3+c4. ; times(k):=2;
al. w1 b8. ;
jd 1<11+18 ; wait answer(Ans,buff);
rl. w1 b0. ;
rl. w2 x3+c3. ;
rs w2 (x1+a54) ; P1:=first of input area(k);
wa. w2 b8.+2 ;
al w2 x2-2 ;
rs w2 (x1+a55) ; P2:=P1 + bytes transferred - 2;
rl. w0 b8.+4 ;
al w2 -1 ;
se w0 0 ; P3:=if Ans(3)=0 then -1
rl. w2 x3+c5. ; else oldsendaddress(k);
rs w2 (x1+a56) ;
jl. e21. ; goto INTERPRE;
e11: rl. w3 b6. ; After Interpre:
rl w0 (x1+a48) ; M(1):=5 shift 12;
ds. w0 b7.+2 ; M(2):=firstcommarea;
wa w0 (x1+a54) ; M(3):=firstcommarea+P1;
rs. w0 b7.+4 ;
am. (h0.) ;
rl. w3 c5. ;
jl. w2 f2. ; move name(oldsendaddress(k));
al. w1 b7. ;
jd 1<11+16 ; send message(M,operatorbuf(k),name);
am. (h0.) ;
rs. w2 c2. ;
rl. w1 b0. ;
jl. w3 e0. ; goto FIND_NEXT;
; end;
h4: al w0 0 ; comment times(k)=2, communication finised;
rs. w0 x3+c4. ; times(k):=0;
rs w0 (x1+a26) ; oscomm:=false;
al. w1 b8. ;
jd 1<11+18 ; wait answer(Ans,buff);
jl. w3 f3. ;
am. (h0.) ; operatorbuf(k):=sendtooperator;
rs. w2 c2. ;
jl. e3. ; goto FIRST_EVENT;
e. ; end command;
\f
; PARENT_MESS:
; Takes care of a parentmessage, as follows from
; the BOSS manual.
b. h24, w. ; begin
h0: 7<12, 2<12+1, 32 ;
h1: 0,r.14 ; text area
h2: <:<10>pause :> ;
h3: <:<10>message :> ;
h4: 0 ; buff.operation
h5: 0 ; procno
e12: se. w3 (h0.) ; if buff.operation=7 shift 12 then
jl. h6. ; begin
rl w0 (x1+a53) ;
se w0 0 ; if sysstate<>0 then
jl. e3. ; goto FIRST_EVENT;
jl. e22. ; goto PARENT_COMM;
; end;
h6: rs. w3 h4. ;
rl w2 (x1+a51) ;
ls w2 1 ;
am (x1+a2) ;
rl w0 x2-2 ;
se w0 0 ; if Pstate(procno)=0
sn w0 6 ; or Pstate(procno)=6
jl. h12. ; or Pstate(procno)>=8 then
sl w0 8 ; goto Returnmessage;
jl. h12. ;
rs. w2 h5. ;
rl. w2 h4. ;
sn. w2 (h0.+2) ; if buff.operation=finis then
jl. h10. ; goto Newremove;
so w2 1 ; if buff.operation extract 1=1 then
am h3-h2 ; move <:pause:> else
al. w2 h2. ; move <:message:>;
dl w0 x2+2 ;
ds. w0 h1.+2 ;
rl w0 x2+4 ;
rs. w0 h1.+4 ;
rl. w2 h5. ;
am (x1+a1) ;
rl w2 x2-2 ; move name of parent;
dl w0 x2+4 ;
ds. w0 h1.+8 ;
dl w0 x2+8 ;
lo. w0 h0.+4 ;
ds. w0 h1.+12 ;
rl w2 (x1+a34) ;
dl w0 x2+12 ;
ds. w0 h1.+16 ;
dl w0 x2+16 ; move textstring from
ds. w0 h1.+20 ; the message;
dl w0 x2+20 ;
ds. w0 h1.+24 ;
rl w0 x2+22 ;
rs. w0 h1.+26 ;
rl. w2 b6. ;
al. w3 h1. ; M(1):=5 shift 12;
ds. w3 b7.+2 ; M(2):=first of text;
al w3 x3+26 ;
rs. w3 b7.+4 ; M(3):=last of text;
rl. w2 h5. ;
am (x1+a3) ;
rl w2 x2-2 ;
ls w2 1 ;
am (x1+a15) ;
rl w3 x2-2 ;
jl. w2 f2. ; move name(Tpda(Pterm(procno)));
al. w1 b7. ;
jd 1<11+16 ; send message(M,ba,name);
rl. w1 b0. ;
sn w2 0 ; if ba=0 then
jl. e4. ; goto NEXT_EVENT;
al. w1 b8. ;
jd 1<11+18 ; wait answer(Ans,ba);
rl. w2 h4. ;
sn. w2 (h0.+2) ; if buff.operation=1 shift 13 add 1 then
jl. h10. ; Pstate(procno):=8 else
so w2 1 ; if buff.operation extract 1=1 then
jl. h12. ; Pstate(procno):=6;
am -2 ;
h10: al w3 8 ; Newremove:
rl. w1 b0. ;
rl. w2 h5. ;
am (x1+a2) ;
rs w3 x2-2 ;
se w3 8 ; if remove process then
jl. h12. ; begin
rl. w3 b13.+6 ;
al w3 x3+1 ; finis:=finis+1;
rs. w3 b13.+6 ; goto REMOVE;
jl. w3 e16. ; end;
h12: rl. w1 b0. ; Returnmessage:
rl w2 (x1+a34) ;
jd 1<11+26 ; get event(buff);
ld w0 -65 ;
ds. w0 b8.+2 ; Ans(1):=Ans(2):=0;
al w0 1 ;
al. w1 b8. ; result:=1;
jd 1<11+22 ; send answer(result,Ans,buff);
rl. w1 b0. ;
jl. e17. ; goto FIND_NEXT;
e. ; end parentmess;
\f
; Procedures called from outside:
b. h24, w. ; begin
h0: 0,0 ; k,absaddr
h1: c1 ;
f.
h2: 10000 ;
w.
e30: dl w3 (x1+a45) ; INITIALIZE:
fm. w3 h2. ;
cf w3 0 ;
al w2 0 ;
ds. w3 b11.+4 ; set interval clock
al. w3 b13. ;
rs w3 (x1+a57) ; set stataddr
rl. w0 b10. ; oldbuf:=clockbuf;
al. w1 b11. ;
al. w3 b9. ;
jd 1<11+16 ; send message(M,clockbuf,<:clock:>);
rs. w2 b10. ;
sn w0 0 ;
jl. h3. ; if oldbuf<>0 then
al. w1 b8. ; begin
rl w2 0 ; wait answer(A,oldbuf,<:clock:>);
jd 1<11+18 ; return;
jl. (b1.) ; end;
h3: al w3 -2 ;
al. w0 c6. ; absaddr:=start of input area;
h4: al w3 x3+2 ; for k:=0 step 2 until maxop do
ds. w0 h0.+2 ; begin
jl. w3 f3. ; operatorbuf(k):=sendtooperator;
dl. w0 h0.+2 ; abs addr of input area(k):=absaddr;
rs. w2 x3+c2. ; absaddr:=absaddr+length of input area;
rs. w0 x3+c3. ; end;
wa. w0 h1. ;
se w3 c0 ;
jl. h4. ;
jl. (b1.) ; return;
e. ; end initialize;
; REMOVE CHILD(procno);
b. h24, w. ; begin
e31: rl w2 (x1+a51) ;
jl. w3 f1. ; remove(proc);
jl. (b1.) ; return;
e. ; end remove;
\f
; Common procedures:
; integer procedure modify(proc);
; Modifies the process proc for input or output.
; Call: return:
; w0 not used destroyed
; w1 base of code bytes modified
; w2 proc destroyed
; w3 link -
b. h24, w. ; begin
h0: 0 ; proc
h1: 0 ; link
f0: ls w2 1 ;
ds. w3 h1. ; save proc, link
am (x1+a8) ;
rl w0 x2-2 ; state:=TBstate(proc);
se w0 4 ; if state=4 then
jl. h2. ; begin
al w0 5 ;
am (x1+a8) ; TBstate(proc):=5;
rs w0 x2-2 ;
rl. w0 b13.+2 ;
ba. w0 1 ;
rs. w0 b13.+2 ; nooutput:=nooutput+1;
rl w0 (x1+a50) ;
jl. w3 f4. ; movecore;
jl. h6. ; end
; else
h2: se w0 3 ; if state=3 then
jl. h4. ; begin
rl. w0 b13.+4 ;
ba. w0 1 ;
rs. w0 b13.+4 ; noinput:=noinput+1;
am (x1+a9) ;
rl w2 x2-2 ;
al. w1 b8. ;
jd 1<11+18 ; wait answer(answer,TBtermbuf(proc));
hs. w0 h10. ; save result
rl. w2 h0. ;
rl. w1 b0. ;
rl. w0 b8.+2 ;
jl. w3 f4. ; movecore;
jd 1<11+26 ; get event(buf addr);
h10=k+1 ;
al w0 0 ; Note ;
sn w0 1 ; if result<>1 then
jl. h3. ; begin
al w1 0 ; bytes moved:=0;
; end;
h3: al w0 0 ; Ans(1):=0;
ds. w1 b8.+2 ; Ans(2):=bytes moved;
ls w1 -1 ; Ans(3):=chars moved;
wa. w1 b8.+2 ;
rs. w1 b8.+4 ;
al w0 1 ;
al. w1 b8. ;
jd 1<11+22 ; send answer(result,Ans,buf addr);
rl w1 x1+2 ;
rl. w2 h0. ;
rl. w3 b0. ;
al w0 0 ;
am (x3+a8) ;
rs w0 x2-2 ; TBstate(proc):=0;
am (x3+a9) ;
rs w0 x2-2 ; TBtermbuf(proc):=0;
am (x3+a10) ;
rs w0 x2-2 ; TBprocbuf(proc):=0;
jl. h6. ; end
; else
h4: al w1 0 ; bytes:=0;
h6: rl. w2 h0. ;
ls w2 -1 ;
am -2000 ;
rl. w3 b0.+2000 ;
al w0 0 ;
am (x3+a21) ;
hs w0 x2-1 ; Ptobemod(proc):=false;
jl. (h1.) ; modify:=bytes;
e. ; end modify;
\f
; procedure remove(proc);
; call: return:
; w0 not used destroyed
; w1 base of code unchanged
; w2 proc destroyed
; w3 link -
b. h24, w. ; begin
h0: 0 ; proc
h1: 0 ; link
h2: 0 ; link1
f1: ls w2 1 ; save proc
ds. w3 h1. ; save link
am (x1+a1) ; pda:=Ppda(proc);
rl w3 x2-2 ;
al w0 0 ;
am (x1+a8) ;
rs w0 x2-2 ; TBstate(proc):=0;
am (x1+a9) ;
rs w0 x2-2 ; TBtermbuf(proc):=0;
am (x1+a10) ;
rs w0 x2-2 ; TBprocbuf(proc):=0;
am (x1+a1) ;
rs w0 x2-2 ; Ppda(proc):=0;
jl. w2 h20. ; removeproc(pda);
am (x1+a4) ;
rl w3 x2-2 ; pda:=Pin(proc);
rl w0 (x1+a49) ;
se w0 x3 ; if pda<>syspda then
jl. w2 h18. ; removeproc(pda);
am (x1+a5) ;
rl w3 x2-2 ; pda:=Pout(proc);
rl w0 (x1+a49) ;
se w0 x3 ; if pda<>syspda then
jl. w2 h18. ; removeproc(pda);
al w0 0 ;
am (x1+a2) ;
rs w0 x2-2 ; Pstate(proc):=0;
am (x1+a3) ; Pterm(proc):=0;
rs w0 x2-2 ;
am (x1+a4) ;
rs w0 x2-2 ; Pin(proc):=0;
am (x1+a5) ;
rs w0 x2-2 ; Pout(proc):=0;
am (x1+a6) ;
rs w0 x2-2 ; Pbufadr(proc):=0;
am (x1+a7) ;
rs w0 x2-2 ; Pignore(proc):=0;
ls w2 -1 ;
am (x1+a21) ;
hs w0 x2-1 ; Ptobemod(proc):=false;
; am (x1+a20) ;
; hs w0 x2-1 ; Ptorun(proc):=false;
jl. (h1.) ; return;
; procedure removeproc(pda);
h18: rs. w2 h2. ; save link
rl w0 x3 ; if pda.kind<>4 then
se w0 4 ; goto Stop;
jl. h22. ;
h20: rs. w2 h2. ; save link
jl. w2 f2. ; move name(pda);
jd 1<11+64 ; remove process(name);
h22: rl. w2 h0. ; Stop:
am -2000 ;
rl. w1 b0.+2000 ; restore w1,w2
jl. (h2.) ; return;
e. ; end remove;
; procedure move name(pda);
; Moves a name from a process description to a
; place inside this process.
; call: return:
; w0 not used unchanged
; w1 - -
; w2 link -
; w3 process descrip address of name
b. h24, w. ; begin
h0: 0 ;
h1: 0 ;
f2: ds. w2 h1. ; save w1,w2
dl w2 x3+4 ;
am -2000 ;
ds. w2 b8.+2+2000; move name
dl w2 x3+8 ;
am -2000 ;
ds. w2 b8.+6+2000;
am -2000 ;
al. w3 b8.+2000 ;
dl. w2 h1. ; restore w1,w2
jl x2 ; return;
e. ; end move name;
; procedure sendtooperator;
; Sends a buffer to the operator.
; call: return:
; w0 not used destroyed
; w1 not used base of code
; w2 not used buffer address
; w3 link destroyed
b. h24, w. ; begin
h0: 0 ; link
h1: <:operator:>,0,0 ;
f3: rs. w3 h0. ; save link
al w0 0 ;
am -2000 ;
al. w1 b7.+2000 ;
rs w0 x1 ; M(1):=0;
al. w3 h1. ;
jd 1<11+16 ; send message(M,w2,<:operator:>);
am -2000 ;
rl. w1 b0.+2000 ;
jl. (h0.) ;
e. ; end sendtooperator;
\f
; procedure movecore;
; Moves a number of bytes between the linebuffer and the
; child by first and last address in TBprocbuf and limited
; by maxbytes.
; call: return:
; w0 maxbytes destroyed
; w1 base of code bytes moved
; w2 proc buf
; w3 link destroyed
b. h24, w. ; begin
h0: 0,0 ; proc,link
h1: 0,0,0 ; move, maxbytes, buf
f4: ds. w3 h0.+2 ; save proc and link
am (x1+a10) ;
rl w2 x2-2 ;
rs. w2 h1.+4 ; buf:=TBprocbuf(proc);
rl w3 x2+12 ;
ws w3 x2+10 ; bytes:=buf.last-buf.first+2;
al w3 x3+2 ;
sl w0 x3+1 ; if bytes<maxbytes then
al w0 x3 ; maxbytes:=bytes;
rs. w0 h1. ;
rs. w0 h1.+2 ; move:=maxbytes;
sh w0 0 ;
jl. h10. ;
rl w0 (x1+a38) ; if move<=0
rl w3 (x1+a39) ; or buf.first<childfirstadr
sh w0 (x2+10) ; or buf.last>childlastadr then
sh w3 (x2+12) ; goto Bytes0;
jl. h10. ;
rl. w3 h0. ;
am (x1+a11) ;
rl w3 x3-2 ; to:=first address of linebuffer;
bz w0 x2+8 ;
rl w2 x2+10 ; from:=buf.first;
se w0 5 ; if buf.operation=input then
rx w2 6 ; exchange(to,from);
h4: rl. w1 h1. ; Test8:
sh w1 7 ; if move<8 then
jl. h6. ; goto Test2;
al w1 x1-8 ;
rs. w1 h1. ; move:=move-8;
dl w1 x2+2 ;
ds w1 x3+2 ;
dl w1 x2+6 ;
ds w1 x3+6 ;
al w2 x2+8 ; from:=from+8;
al w3 x3+8 ; to:=to+8;
jl. h4. ; goto Test8;
h6: sh w1 1 ; Test2:
jl. h8. ; if move=0 then
rl w0 x2 ; goto Stop;
rs w0 x3 ;
al w1 x1-2 ; move:=move-2;
al w2 x2+2 ; from:=from+2;
al w3 x3+2 ; to:=to+2;
jl. h6. ; goto Test2;
h8: dl. w2 h1.+4 ; Stop:
jl. (h0.+2) ;
h10: al w1 0 ; Bytes0:
rl. w2 h1.+4 ;
jl. (h0.+2) ;
e. ; end movecore;
; Variables for operator communication:
c0=c0>1+1
c2: 0,r.c0 ; operatorbuf
c3: 0,r.c0 ; address of each input area
c4: 0,r.c0 ; times
c5: 0,r.c0 ; old send addresses
; Input areas:
h.
c6: 0,r.c1*c0 ;
e.
▶EOF◀