|
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: 37632 (0x9300)
Types: TextFile
Names: »monitor3tx «
└─⟦01e83a425⟧ Bits:30008166 Bånd med SW8010 og SW8500 source code
└─⟦75ff9bef3⟧
└─⟦this⟧ »monitor3tx «
; jz.fgs.1984.03.13 algol 8, monitor, segment 1 page ...1...
;algol 8 standard procedure monitor(fnc, z, i, ia);
;
;the procedure is the algol equivalent to the monitor procedures,
;and in most cases it will only transform the parameters to the
;form required by the monitor.
;the procedure occupies three physical segments of each 512 bytes.
;segment one must stay in core while segment two or three are
;executing, so no inter segment references between segment two
;and three exists (except for chainhead (prep bs,
;insert entry, connect main catalog)).
;b. h100 ; outer block with fp names already defined.
b. g1, e5 ; global block with tail names
w.
s. g10,f13,d12,c29,a24, b0 ; global slang segment
w.
b. j23 ; block for segment 1
k=0
h.
g2: g4, g4 ; rel of last point, rel of last abs word
j0: 13, 0 ; rs entry 13 last used
j1: 30, 0 ; - - 30 saved stack ref,saved w3
j2: 4, 0 ; - - 4 take expression
j3: 17, 0 ; - - 17 index alarm
j4: 39, 0 ; - - 39 trap base
j5: 21, 0 ; - - 21 general alarm
j6: 6, 0 ; - - 6 end register expression
j9: 1<11+1, 0 ; address of segment 2
j11: 1<11+2, 0 ; address of segment 3
j21: 85, 0 ; rs entry 85 current activity no
j22: 88, 0 ; rs entry 88 call passivate 2;
j23: 12, 0 ; rs entry 12 uv
g4=k-2-g2
c. h57<2 ; def of number of parameters in
b0=6 ; create internal process;
z. ; if sys2 then params=6
c. h57<3 ; else
b0=9 ; if sys3 then params=9
z. ;
\f
; jz.fgs 1984.04.04 algol 8, monitor, segment 1 page ...2...
;entry table:
h.
g0=k-2
;action param bits array ;
;no z i ia length ; fnc, monitor procedure name
1 <8+ 1<7 ; 4 process description
1 <8+ 1<7 ; 6 initialize process
1 <8+ 1<7 ; 8 reserve process
1 <8+ 1<7 ; 10 release process
1 <8+ 1<7+1<6 ; 12 include user
1 <8+ 1<7+1<6 ; 14 exclude user
2 <8+ 1<6 ; 16 send message
3 <8+ 1<6+1<5+ 8 ; 18 wait answer
8 <8+ 1<7+1<6+1<5+ 8 ; 20 wait message
4 <8+ 1<6+1<5+ 9 ; 22 send answer
9 <8+ 1<7+1<6+1<5+ 8 ; 24 wait event
5 <8+ 1<6 ; 26 get event
8 <8+ 1<7+1<6+1<5+ 4 ; 28 test users,protectors,reserver
1 <8+ 1<7 ; 30 set write protect
1 <8+ 1<7 ; 32 remove write protect
0, 0, 0 ; 34 - 38 not allowed
0 <8+ 1<7+ 1<5+ 10 ; 40 create entry
0 <8+ 1<7+ 1<5+ 10 ; 42 lookup entry
0 <8+ 1<7+ 1<5+ 10 ; 44 change entry
0 <8+ 1<7+ 1<5+ 4 ; 46 rename entry
1 <8+ 1<7 ; 48 remove entry
1 <8+ 1<7+1<6 ; 50 permanent entry
1 <8+ 1<7 ; 52 create area process
1 <8+ 1<7+1<6 ; 54 create peripheral process
10 <8+ 1<7+ 1<5+ b0 ; 56 create internal process
6 <8+ 1<7+1<6 ; 58 start internal process
7 <8+ 1<6 ; 60 stop internal process
0 <8+ 1<7+ 1<5+ 6 ; 62 modify internal process
1 <8+ 1<7 ; 64 remove process
9 <8+ 1<7+1<6+1<5+ 8 ; 66 test event
1 <8+ 1<7 ; 68 generate name
14 <8+ 1<7+1<6+1<5+ 9 ; 70 copy
c. h57<3 ; if monitor 3 then the following entries are included:
11 <8+ 1<7+ 1<5+ 2 ; 72 set catalog base
11 <8+ 1<7+ 1<5+ 2 ; 74 change entry interval
0 <8+ 1<7+ 1<5+ 17 ; 76 lookup entry head and tail
12 <8+ 1<7+ 1<5+ 12 ; 78 set backing storage claims
1 <8+ 1<7 ; 80 create pseudo process
13 <8+ 1<7+1<6 ; 82 regret message
\f
; jz.fgs 1987.07.08 algol 8, monitor, segment 1 page ...2a...
; entry table continued:
;
;action param bits array ;
;no z i ia length ; fnc, monitor procedure name
14 <8+ 1<7+1<6+1<5+ 9 ; 84 general copy
0 <8+ 1<7+ 1<5+ 21 ; 86 lookup aux entry
0 <8+ 1<7+ 1<5+ 21 ; 88 clear statistics in aux entry
1 <8+ 1<7+1<6+1<5+ 4 ; 90 permanent filedescriptor
1 <8+ 1<7 ; 92 create entry lock process
1 <8+ 1<7+1<6 ; 94 set priority
1 <8+ 1<7+1<6 ; 96 relocate process
1 <8+ 1<7+1<6 ; 98 change address space
0 ; 100 not allowed
15 <8 ; 102 prepare bs
15 <8+ 1<5+ 17 ; 104 insert entry
0 <8+ 1<5+ 21 ; 106 insert backing storage
0 <8+ 1<5+ 21 ; 108 delete backing storage
0 <8+ 1<5+ 21 ; 110 delete entries
15 <8+ 1<5+ 4 ; 112 connect main catalog
1 <8 ; 114 remove main catalog
0 ; 116
12 <8+ 1<7+ 1<5+ 12 ; 118 lookup backing storage claims
0 <8+ 1<7+ 1<5+ 21 ; 120 create aux entry
0 <8+ 1<5+ 21 ; 122 remove aux entry
2 <8+ 1<6+1<5+ 2 ; 124 send pseudo message
1 <8+ 1<7+1<6 ; 126 set common protected area (cpa)
z. ;
;action table:
g1: c5 ; 0 array simple
c6 ; 1 simple
c7 ; 2 send message / send pseudo message
c8 ; 3 wait answer
c9 ; 4 send answer
c10; 5 get event
c11; 6 start internal process
c12; 7 stop internal process
c13; 8 wait message
c14; 9 wait event / test event
c15; 10 create internal process
c18; 11 array simple doubleword
c19; 12 set / lookup backing storage claims
c20; 13 regret message
c23; 14 copy / general copy
c24; 15 chainhead / prepare bs / insert entry / connect maincat
\f
; fgs 1987.07.08 algol 6, monitor, segment 1 page ...3...
w.
e0: 0 ; start of external list
0 ;
s3 ; date
s4 ; time
e1: rl. w2 (j0.) ; monitor:
ds. w3 (j1.) ; w2:= saved stack ref:= last used;
dl w1 x2+8 ; get fnc param:
so w0 16 ; addr:= formal 2.fnc;
jl. w3 (j2.) ; if expr then addr:= take expr(addr);
ds. w3 (j1.) ; saved stack ref:= w2;
dl w1 x1 ; value:= store(addr);
rl w3 x2+6 ;
sz w3 1 ; if real
cf w1 0 ; then round(value);
rs w1 x2+8 ; fnc:= value;
sz w1 1 ; if fnc = uneven
jl. c3. ; or fnc > maximum monitor function
sh w1 (:g1-g0-1:)<1; or fnc < 4
sh w1 3 ; then entry error;
jl. c3. ;
ls w1 -1 ;
bz. w1 x1+g0. ; fncbyte:= entry table(fnc//2);
sn w1 0 ; if fncbyte = 0
jl. c3. ; then entry error;
rs w1 x2+6 ;
so w1 1<7 ; if param bit = get name addr.z then
jl. a0. ; begin
rl w3 x2+12 ; zone descriptor:= formal2.z;
al w3 x3+h1+2 ; name addr:= process name.zone descriptor;
rs w3 x2+10 ; end;
a0: so w1 1<5 ; if param bit = get addr of ia then
jl. a1. ; begin
dl w1 x2+20 ; dope:= formal2.a + byte1.formal1.ia;
ba w1 0 ;
al w3 x1 ;
al w1 1 ; index := 1;
a14: ls w1 1 ; check index: index := index < 1;
sh w1 (x3-2) ; if index > upper index value
sh w1 (x3) ; or index <= lower index value - k then
jl. w3 (j3.) ; goto index alarm;
se w1 2 ; if index = 2 (1<1) then
jl. a15. ; begin <*find addr of ia (1)*>
wa w1 (x2+20) ; addr (ia (1)) :=
rs w1 x2+20 ; index + baseword;
al w1 2.11111; index := min last index :=
la w1 x2+6 ; fnc byte.min array length;
jl. a14. ; goto check index;
a15: ; end;
rl w1 x2+6 ;
\f
;rc 5.8.69 algol 6, monitor, segment 1 page 4
a1: so w1 1<6 ; if param bit = get addr of i then
jl. a3. ; begin
dl w1 x2+16 ; addr:= formal2.i;
so w0 16 ;
jl. w3 (j2.) ; if expr then addr:= take expr(addr);
ds. w3 (j1.) ; saved stack ref:= w2;
rs w1 x2+14 ; addr.i:= addr;
rl w1 x1 ; value.i:= store(addr);
rs w1 x2+16 ; end;
a3: rl w3 x2+6 ; get action:
ls w3 -8 ; action number:= fncbyte shift (-8);
bl. w3 x3+g1. ; action:= action table(action number);
sl w3 0 ; if action > 0
jl. x3+g2. ; then goto action; comment on segment 1;
ac w3 x3 ; segment 2:
hs. w3 a4. ; action rel:= -action;
rl. w3 (j9.) ; action segm:= segment 2;
a4=k+1; action rel ;
jl x3 ; goto(action segm, action rel);
;the formal cells in the stack are now used as follows:
;
; x2+ 6: fncbyte
; + 8: value of fnc
;
; +10: name addr.z or addr of share(z,i)
; +12: zone descriptor address
;
; +14: address of i
; +16: value of i
;
; +18: unchanged
; +20: address of first element in ia
\f
; jz.fgs.1980.12.22 algol 8, monitor, segment 1 page ...5...
; procedure modify trap;
;
;the procedure modifies the trap routine in the running system, so
;possible interrupts caused by parameter errors in call of the
;monitor procedures are caught and send to the error procedure
; entry error.
;this use of the trap routine implies that segment 1 must stay in core
;while segment 2 or 3 are executing, so segment 3 is not referred to
;from segment 2 or vice versa
; procedure reset trap;
;
;the procedure restores the trap routine in running system to the
;original state.
;
;registers: entry exit
; w0: - unchanged
; w1: - unchanged
; w2: - unchanged
; w3: return unchanged
b. a5 w.
c0: ds. w0 f1. ; modify trap: save(w3,w0);
am. (j4.) ; saved trap:=
dl w0 6 ; trap base(4:6);
ds. w0 a2. ;
al. w3 c2. ; w3:= address of error procedure;
rl. w0 a1. ; w0:= instruction(jl.(-2));
a0: am. (j4.) ; set trap:
ds w0 6 ; trap(4:6):= (w3,w0);
dl. w0 f1. ; restore(w3,w0);
jl x3 ; return;
c1: ds. w0 f1. ; reset trap: save(w3,w0);
dl. w0 a2. ; (w3,w0):= saved trap;
jl. a0. ; goto set trap;
a1: jl. (-2) ; trap instruction
0 ; saved trap cell 6
a2: 0 ; saved trap cell 8
f0: 0 ; saved w3
f1: 0 ; saved w0
e.
\f
;jz.fgs.1984.03.13 algol 8, monitor, segment 1 page ...6...
;procedure entry error;
;
;the procedure may be called via the modified trap routine in the
;running system, entry 1, and in this case the trap is reset, or
;it may be called from the monitor procedure segments, entry 2.
c2: jl. w3 c1. ; entry from rs: reset trap;
c3: dl. w3 (j1.) ; normal entry:
rl w1 x2+8 ;
jl. w3 c29. ; alarm(<:entry:>,fnc);
<:<10>entry<32>:> ;
;procedure field error;
;
;the procedure may be called either from segment 2 or segment 3
;in both cases the trap is reset
;
;registers:
; w0: destroyed
; w1: field index (call)
; w2: -
; w3: destroyed
d6: jl. w3 c1. ; field error: reset trap;
al w3 -12 ;
jl. c29. ; general alarm (<:field:>, w1);
;procedure get share(i,z);
; value i; integer i; zone z;
;
;the procedure gets the address of share number i in the zone z.
;
;registers: entry exit
; w0: - undefined
; w1: - address of share
; w2: stack ref unchanged
; w3: return address of zone descriptor
;the address of the share is also stored in formal1.z
b. a5 w.
c4: rs. w3 a0. ; get share:
rl w3 x2+12 ; save return;
al w1 h6 ; share := share descr length *
wm w1 x2+16 ; i;
sn w0 0 ; if integer overflow then
sh w1 -1 ; goto
jl. c16. ; share alarm;
al w1 x1-h6 ; share := share - share descr length;
wa w1 x3+h0+6 ; share:= share + first share.z;
sh w1 (x3+h0+8) ; if share > last share.z
jl. a2. ; then share alarm;
jl. c16. ;
a2: rs w1 x2+10 ;
jl. (a0.) ; return;
a0: 0 ; saved return
e.
c16: rl w1 x2+16 ; share alarm: w1 := i;
jl. w3 c29. ; goto alarm;
<:<10>share<32>:> ;
c17: jl. w3 c29. ; share state alarm:
<:<10>sh.state :> ; goto alarm (return addr, w1);
c29: al w0 x3 ; alarm: w0 := return addr;
jl. w3 (j5.) ; goto general alarm (w0, w1);
\f
; jz.fgs.1984.03.13 algol 8, monitor, segment1 page ...7...
;action array simple and action simple:
;action array simple doubleword:
;w0 result (return)
;w1 address of ia or value of i (call)
;w2 -
;w3 name address.z (call)
c18: am (x2+20) ; array simple doubleword:
dl w1 +2 ; w0w1:= first two words of ia;
jl. c6. ; goto simple;
c5: rl w1 x2+20 ; array simple: w1:= addr.ia;
c6: rl w3 x2+8 ; simple:
al w3 x3-2048 ; comment w1 is born with value of i;
hs. w3 a5. ;
jl. w3 c0. ; modify trap;
bl. w0 a5. ; w0:=fctn;
se w0 -1<11+96; if fctn <> 96 <*relocate process*> then
jl. a2. ; goto not relocate else
rl. w3 (j11.) ;
jl x3+c22 ; goto relocate process (segment 3);
a2: rl w3 x2+10 ; not relocate: w3 := name addr.z;
sn w0 -1<11+90; if fctn = 90 <*permanent filedescr*> then
rl w2 x2+20 ; w2 := addr of docname (ia(1));
sl w0 -1<11+106; if fnc < 106
sn w0 -1<11+126; or fnc = 126 then
jl. a12. ; goto maybe docname still in ia (18);
al w2 x1+34 ; w2 := addr of docname (ia(18));
a12: se w0 -1<11+88; if fnc = 88
sn w0 -1<11+86; or fnc = 86 then
al w2 x1+34 ; w2:=addr of docname (ia (18));
sn w0 -1<11+86; if entry = 86 <*lookup aux entry*> then
al w1 x1+14 ; w1 := addr tail part ia;
rl. w0 f1. ; reset w0;
a5=k+1; monitor proc no;
jd ; call monitor procedure(1<11 + fnc);
dl. w3 (j1.) ; restore(stackref); <*86, 88, 90, 106, ... : w2 used*>
d0: jl. w3 c1. ; exit reset: reset trap;
rl w1 0 ; monitor:= result;
jl. w3 (j6.) ; goto end register expression;
\f
; jz.fgs 1984.03.13 algol 8, monitor, segment 1 page ...7a...
;send message: send pseudo message:
;w0 - w0 pseudo process descr addr (call)
;w1 message addr (call) w1 message addr (call)
;w2 message flag (call) w2 message flag (call)
; buffer addr (return) buffer addr (return)
;w3 name addr (call) w3 name addr (call)
c7: jl. w3 c4. ; send message:
rl w1 x1 ;
sh w1 1 ; if share state = pending message
sh w1 -1 ; or share state = running child then
jl. c17. ; goto share state alarm;
a6: rl w3 x2+8 ; w3 := fnc;
al w3 x3-2048 ; w3 := mon proc no;
hs. w3 a13. ;
sn w3 -1<11+124; if send pseudo message then
rl w0 (x2+20) ; w0 := ia (1);
am (x2+10) ;
al w1 6 ; w1:= message addr.share;
jl. w3 c0. ; modify trap;
rl w3 x2+12 ;
al w3 x3+h1+2 ; w3:= name addr.z;
rl. w2 (j21.) ; w2 := current activity no;
a13 = k + 1;mon proc no;
jd ; send message;
al w0 x2 ; comment w2:= buffer addr;
dl. w3 (j1.) ; restore(stack ref);
rs w0 (x2+10) ; share state:= result:= buffer address;
jl. d0. ; goto exit reset;
\f
; jz.fgs 1981.05.14 algol 8, monitor, segment 1 page ...8...
;wait answer
;w0 result (return)
;w1 answer address (call)
;w2 buffer address (call)
;w3 -
c8: jl. w3 c4. ; wait answer:
rl w1 x1 ; get share(i,z);
sh w1 1 ; if share state <= 1 then share state alarm;
jl. c17. ; comment share state is then buffer address;
al w0 x2 ; w0 := w2;
al w2 x3 ; w2 := zone address;
jl. w3 (j22.) ; call passivate 2; (w2 are saved);
dl. w1 (j23.) ; restore(w0,w1);
rl w2 0 ; restore w2;
ds. w3 (j1.) ; (saved sref,w3) := (w2, segbase);
rx w2 2 ; w2:= share state;
rl w1 x1+20 ; w1:= answer addr; comment ia;
jl. w3 c0. ; modify trap;
jd 1<11+18; wait answer;
c21: ; set share state and exit;
dl. w3 (j1.) ; restore(stack ref);
al w3 0 ;
rs w3 (x2+10) ; share state:= free;
jl. d0. ; goto exit reset;
;send answer:
;w0 result (call)
;w1 answer address (call)
;w2 buffer address (call)
;w3 -
c9: rl w1 x2+20 ; send answer: w1:= answer addr.ia;
rl w0 x1+16 ; w0:= result:= ia(9);
rl w2 x2+16 ; w2:= buffer address:= i;
jl. w3 c0. ; modify trap;
jd 1<11+22; send answer;
jl. d0. ; goto exit reset;
;get event:
;w0 -
;w1 -
;w2 buffer address (call)
;w3 -
c10: rl. w3 (j11.) ; get event: moved to
jl x3+c26 ; segment 3, page 15;
\f
;rc 22.7.71 algol 6, monitor, segment 1 page 9
; jz 1979.05.22 algol 8 this page is moved to segment 2 (page 11b)
\f
;rc 22.7.71 algol 6, monitor, segment 1 page 10
j10:
c.j10-506
m.code on segment 1 too long
z.
c.502-j10,0,r.252-j10>1 z. ; fill rest of segment with zeroes
<:monitor<0>:>, 0 ; alarm text on segment 1
i.
e. ; end segment 1
\f
;jz.fgs 1980.12.22 algol 8, monitor, segment 2 page ...11...
b. j30 ; block for segment 2
k=0
h.
g3: g5 , g5 ; rel of last point, rel of last abs word
j1: 30 , 0 ; rs entry 30 saved stack ref, saved w3
j6: 6 , 0 ; - - 6 end register expression
j7: 18 , 0 ; - - 18 zone index alarm
j11: 38 , 0 ; - - 38 console process address
; ****used as base in wait event page 12
j13: 13 , 0 ; rs entry 13 last used
j21: 85 , 0 ; rs entry 85 current activity number
j8: -1 , 0 ; address of segment 1
j9 : 1<11 o. 1 , 0 ; address of segment 3
g5=k-2-g3 ; no of abs words and points
w.
;start internal process
;w0 result (return)
;w1 -
;w2 -
;w3 name address (call)
c11=-k
rl w3 x2+10 ; start internal process: w3:= name addr.z;
jd 1<11+4 ; proc descr addr:= get process description;
sn w0 0 ; if proc descr addr = does not xist
jl. a9. ; then entry error;
rl w1 0 ; check if the process is inside the
rl w0 x1+22 ; zone buffer:
sh w0 (x3+h0+2-h1-2);if first core.proc descr > last of buffer
sh w0 (x3+h0-h1-2) ;or first core.proc descr <= base buffer
jl. a9. ;then entry error;
rl w0 x1+24 ;
am (x3+h0+2-h1-2);
sh w0 1 ;if top core.proc descr > last of buffer + 1
sh w0 (x3+h0 -h1-2);or top core.proc descr <= base buffer
jl. a9. ; then entry error;
rs. w1 f4. ;
rl. w3 (j8.) ;
jl w3 x3+c4 ; get share(i,z);
rl w1 x1 ;
se w1 0 ; if share state <> free
sn w1 1 ; and share state <> after wait
jl. a8. ; then share state alarm;
rl. w3 (j8.) ;
jl w3 x3+c17 ;
a8: rl. w3 (j8.) ;
jl w3 x3+c0 ; modify trap;
rl w3 x2+12 ;
al w3 x3+h1+2 ; w3:= name address.z;
jd 1<11+58; start internal process;
ac. w3 (f4.) ;
sn w0 0 ; if result = process started
rs w3 (x2+10) ; then share state:= -proc descr addr;
d4: dl. w3 (j1.) ; restore (stack ref);
rl. w3 (j8.) ;
jl w3 x3+d0 ; goto exit reset;
f4: 0 ; proc descr addr;
\f
;jz.fgs 1981.05.14 algol 6, monitor, segment2 page ...11a...
a9: rl. w3 (j8.) ; entry error:
jl w3 x3+c3 ; call entry error on segm 1
;stop internal process
;w0 result (return)
;w1 -
;w2 message flag (call), buffer address (return)
;w3 name address (call)
c12=-k
rl. w3 (j8.) ;
jl w3 x3+c4 ; stop internal process:
rl w1 x1 ; get share(i,z);
rl. w3 (j8.) ;
sl w1 0 ; if share state>= 0
jl w3 x3+c17 ; then share state alarm;
ac w1 x1 ; proc descr addr:= -share state;
rl. w3 (j8.) ;
jl w3 x3+c0 ; modify trap;
dl w0 x1+4 ; proc name:= name.proc descr;
ds. w0 f6. ;
dl w0 x1+8 ;
ds. w0 f7. ;
al. w3 f5. ; w3:= name addr.proc name;
al w1 x2 ; save(stack ref);
rl. w2 (j21.) ; w2 := current activity number;
jd 1<11+60; stop internal process;
sn w0 0 ; if result = stop initiated
rs w2 (x1+10) ; then share state:= buffer address;
jl. d4. ; goto exit reset;
f5: 0, f6: 0, 0, f7: 0; proc name
\f
; jz.fgs 1983.02.09 algol 8, monitor, segment 2 page ...11b...
;wait message test users, protectors, reserver
;w0 result (return) w0 result (return)
;w1 message address (call ) w1 internal name address (call )
;w2 buffer address (return) w2 answer (return)
;w3 name address (call ) w3 external name address (call )
c13 = -k
; wait message/test users, protectors, reserver:
rl w3 x2+8 ; w3 := fnc;
al w3 x3-2048 ; w3 := mon proc no;
hs. w3 a24. ;
rl w1 x2+20 ;
rl. w3 (j8.) ;
jl w3 x3+c0 ; w1 := message address.ia; modify trap;
rl w3 x2+10 ; w3:= name address.z;
a24=k+1 ; mon proc no:
jd ; wait message;
al w1 x2 ;
dl. w3 (j1.) ; restore(stack ref);
rs w1 (x2+14) ; i:= buffer address;
rl. w3 (j8.) ;
jl x3+d0 ; goto exit reset;
;set/lookup backing storage claims
;w0 result (return)
;w1 claim list address (call)
;w2 bs device name address (call)
;w3 process name address (call)
c19 = -k
rl w3 x2+8 ; set / lookup backing storage claims:
al w3 x3-2048 ; w3 := fnc;
hs. w3 a23. ; mon proc no := 1<11 + w3;
rl. w3 (j8.) ;
jl w3 x3+c0 ; modify trap;
rl w3 x2+10 ; w3 := name addr.z;
rl w2 x2+20 ; w2 := name addr. bs device;
al w1 x2+8 ; w1 := claim list address;
a23=k + 1 ; mon proc no:
jd ; set / lookup backing storage claims;
dl. w3 (j1.) ; restore(stack ref);
rl. w3 (j8.) ;
jl x3+d0 ; goto exit reset;
;regret message
;w0 -
;w1 -
;w2 buffer address (call)
;w3 -
c20 = -k
rl. w3 (j9.) ; regret message: entry from segment 1;
jl x3+c28 ; goto code on segment 3 (return to segment 1);
\f
; jz.fgs 1983.02.09 algol 8, monitor, segment 2 page ...12...
;wait event ; test event
;
; w0 result (return) ; w0 result (return)
; w1 - ; w1 event id (return) not used
; w2 prev buffer (call) ; w2 prev buffer (call)
; next buffer (return) ; next buffer (return)
; w3 - ; w3 -
c14=-k
rx w2 2 ; wait event:
rs. w1 f11. ; save stackref;
rl. w3 (j8.) ; w2:= last buf addr:= i;
jl w3 x3+c0 ; modify trap;
rl w3 x1+8 ;
al w3 x3-2048 ;
hs. w3 f12. ; monitor entry := fnc;
f12 = k + 1; monitor entry
a10: jd 0 ; rep: call monitor(entry=monitor entry);
sn w0 -1 ; if result = -1 then
jl. a21. ; goto empty;
am. (j11.) ; if next buf addr = spare mess buf
sn w2 (-6) ; then goto rep; ****spare mess buf uses
jl. a10. ; rs entry 38 as base - nasty solution****
a21: rl. w3 (j8.) ; empty:
jl w3 x3+c1 ; reset trap;
rl. w1 f11. ; restore stackref;
rx w2 2 ;
sn w0 -1 ; if empty then
al w1 0 ; next buffer addr := 0;
ds. w1 f3. ; save (result,next buf addr);
se w0 0 ; if result = answer
jl. d11. ; then goto may be answer;
rl w1 x1+6 ; message:
sh w1 0 ; sender:= buffer(6);
ac w1 x1 ; if sender < 0 then sender:= -sender;
dl w0 x1+4 ; name.z:=
am (x2+10) ; name.process description.sender;
ds w0 2 ;
dl w0 x1+8 ;
am (x2+10) ;
ds w0 6 ;
rl. w1 f3. ; copy message:
rl w2 x2+20 ;
dl w0 x1+10 ; ia:= message buffer(8:22);
ds w0 x2+2 ;
dl w0 x1+14 ;
ds w0 x2+6 ;
dl w0 x1+18 ;
ds w0 x2+10 ;
dl w0 x1+22 ;
ds w0 x2+14 ;
dl. w3 (j1.) ;
d2: rs w1 (x2+14) ; set i and exit: i:= buffer address;
rl. w1 f2. ; monitor:= result;
jl. w3 (j6.) ; goto end register expression;
d11: se w0 1 ; may be answer:
jl. d2. ; if result <> answer then
rl w3 x1-2 ; goto set i and exit;
rs w3 (x2+20) ; ia(first) := buf.message extension;
jl. d2. ; goto set i and exit;
f2: 0 ; saved result
f3: 0 ; saved buffer address
f11: 0 ; saved stackref
\f
; jz 1979.09.26 algol 8, monitor, segment 2 page 13
;create internal process
;w0 result (return)
;w1 parameter address (call)
;w2 -
;w3 name address (call)
f8: 0, r.9 ; param(1:9)
c15=-k
rl w1 (x2+20) ; create internal process:
jl. w3 d3. ;
al w1 x1-3 ;
rs. w1 f8. ; param(1):=
am (x2+20) ; bufindx(ia(first));
rl w1 2 ;
jl. w3 d3. ;
al w1 x1+1 ;
rs. w1 f8.+2 ; param(2):= bufindx(ia(second));
rl w3 x2+20 ;
dl w1 x3+6 ; for j:= 3 step 1 until b0 do
ds. w1 f8.+6 ; param(j):= ia(first-1+j);
dl w1 x3+10 ;
ds. w1 f8.+10 ;
c. h57<3 ; if sys 3 then
dl w1 x3+14 ; begin
ds. w1 f8.+14 ;
rl w1 x3+16 ;
rs. w1 f8.+16 ;
z. ; end;
al. w1 f8. ; w1:= parameter address.param;
rl. w3 (j8.) ;
jl x3+c6 ; goto simple;
d3: rx w3 x2+12 ; integer procedure bufindx(ix);
al w0 x1 ; value ix; integer ix;
ls w0 2 ; begin
wa w0 x3+h0 ; bufindx:= k:= ix*4 + base buffer.z;
sh w0 (x3+h0+2) ; if k <= base buffer.z
sh w0 (x3+h0) ; or k > last of buffer.z
jl. w3 (j7.) ; then zone alarm(<:index:>,ix);
rl w1 0 ;
rx w3 x2+12 ;
jl x3 ; end;
\f
; jz.fgs.1980.12.22 algol 6, monitor, segment 2 page ...13a...
; copy
; w0 result (return)
; w1 first storage (call), bytes transferred (return)
; w2 buf addr (call)
; w3 last storage (call), char transferred (return)
c23=-k ; copy:
rl. w3 (j8.) ; modify trap;
jl w3 x3+c0 ;
rl w3 x2+8 ; if fnc
se w3 70 ; <>70 then
jl. c25. ; goto general copy;
rl w1 x2+12 ;
rl w3 x1+h3+2 ; w3:=last byte.zone
rl w1 x1+h3 ; w1:=record base.zone+1;
al w1 x1+1 ;
rl w2 x2+16 ; w2:=buf addr;
jd 1<11+70 ; call copy;
al w2 x3 ; w2:=characters;
am. (j1.) ;
am (-2) ;
rl w3 20 ; w3:=addr.ia;
se w0 0 ; if result<>0
ld w2 -100 ; then bytes:=characters:=0;
ds w2 x3+4 ; ia(2):=bytes; ia(3):=characters;
sl w0 3 ; ia(9):= if result>=3
am 2 ; then 3
al w2 1 ; else 1;
rs w2 x3+16 ;
al w2 0 ; ia(1):=0;
rs w2 x3 ;
jl. d4. ; goto restore, exit reset;
; end copy;
\f
; jz.fgs.1980.12.22 algol 8, monitor, segment 2 page ...13b...
; general copy
; w0 result (return)
; w1 parameter address (call), halfs moved (return)
; w2 message buffer address (call)
; w3 not used
a22: rl w1 0 ; field alarm:
rl. w3 (j8.) ; w1 := field index;
jl x3+d6 ; goto field error;
c25: ; general copy:
rl w1 x2+20 ; w1:=param address; <*addr of ia (lower)*>
rl w3 x2+12 ; w3:=zone address;
rl w0 x1+ 2 ; first:=ia(2); <*first field index*>
sh w0 (x3+h3+4) ; if first>zone.record length
sh w0 0 ; or first<=0 then
jl. a22. ; goto field alarm;
wa w0 x3+h3+0 ; ia(2):=
rs w0 x1+ 2 ; ia(2)+zone.record base;
rl w0 x1+ 4 ; last:=ia(3); <*last field index*>
sh w0 (x3+h3+4) ; if last>zone.record length
sh w0 0 ; or last<=0 then
jl. a22. ; goto field alarm;
wa w0 x3+h3+0 ; ia(3):=
rs w0 x1+ 4 ; ia(3)+zone.record base
rl w2 x2+16 ; w2:=message buffer address;
jd 1<11+84; call monitor general copy;
rl. w2 (j13.) ; restore last used;
rl w3 x2+20 ; w3:=address of ia (lower);
se w0 0 ; if result <> 0 then
al w1 0 ; halfs moved:=0;
rs w1 x3+2 ; ia(2):=halfs moved;
al w1 1 ; ia(9):=
sn w0 3 ; if result=3
al w1 3 ; then 3
rs w1 x3+16 ; else 1;
jl. d4. ; goto reset trap;
; chainhead
; w0 result(return)
; w1 entry adress (call)
; w2 ---
; w3 chainhead address (call)
c24=-k
rl. w3 (j9.) ; chainhead: entry from segment 1;
jl x3+c27 ; goto code on segment 3 (returns to segm 1);
\f
;jz.fgs.1980.12.22 algol 8, monitor, segment 2 page 14
j10:
c.j10-506
m.code on segment 2 too long
z.
c.502-j10,0,r.252-j10>1 z.; fill rest of segment 2 with zeroes
<:monitor<0>:>, 0 ; alarm text on segment 2
i.
e. ; end segment 2
\f
;fgs.1983.02.09 algol 8, monitor, segment 3 page ...15...
b. j30 ; block for segment 3
k=0
h.
g6: g7 , g7 ; rel of last point, rel of last abs word
j1: -2 , 0 ; address of segment 1
j30: 30 , 0 ; rs entry 30 saved stackref, saved w3
g7 = k-2-g6
w.
;get event:
;w0 -
;w1 -
;w2 buffer address (call)
;w3 -
c26: rl. w3 (j1.) ; get event: entry from segm 1;
rl w2 x2+16 ; w2 := buffer addr := i; w3 := segtable segm 1;
rl w1 x2+4 ; receiver := buffer (4);
sl w1 1 ; if receiver <= 0
sl w1 6 ; or receiver >= 6 then
jl. a7. ; goto message else
jl x3+c3 ; goto entry error on segment 1;
a7: jl w3 x3+c0 ; message : modify trap;
jd 1<11+26; get event;
jl. d12. ; goto restore stackref, exit reset;
;regret message
;w0 -
;w1 -
;w2 buffer address (call)
;w3 -
c28: rl. w3 (j1.) ; regret message: entry from segment 2;
jl w3 x3+c4 ;
rl w1 x1 ; get share(i,z);
rl. w3 (j1.) ;
sh w1 0 ; if share state <= 0 then
jl x3+c17 ; share state alarm;
al w2 x1 ;
jl w3 x3+c0 ; modify trap;
jd 1<11+82; regret message;
rl. w3 (j1.) ;
jl x3+c21 ; goto set share state and exit;
\f
; fgs 1983.05.09 algol 8, monitor, segment 3 page ...15a...
;chainhead:
;w0 result (return)
;w1 entry address (call)
;w2 ---
;w3 chainhead adress (call)
c27: rl w3 x2+12 ; chainhead: entry from segment 2;
rl w3 x3+h3 ;
al w3 x3+1 ;
rs w3 x2+10 ; insert address of zone record
rl w0 x2+8 ; in stack
rl. w3 (j1.) ;
jl x3+c5 ; goto array simple on segment 1;
\f
; jz.fgs 1983.02.09 algol 8, monitor segment 3 page ...15b...
;relocate process
;w0 result (return)
;w1 start address (call)
;w2 -
;w3 name address (call)
a11: dl. w3 (j30.) ; field alarm: restore stack ref;
rl w1 x2+16 ; w1 := field index;
rl. w3 (j1.) ;
jl x3+d6 ; goto field alarm;
c22: rl w3 x2+10 ; relocate process: w3 := name addr.z;
jd 1<11+ 4; w0 := process descr addr;
se w0 0 ; if process exists then
jl. d5. ; goto exists;
al w0 3 ; result := 3;
rl. w3 (j1.) ;
jl x3+d0 ; goto exit reset;
d5: ld w1 -24 ; exists: w1 := proc descr addr; w0 := 0;
rl w0 x1+24 ; w0 := top address;
ws w0 x1+22 ; w0 := top - first; <*size*>
rl w1 x2+16 ; w1 := field index; <*value of i*>
so w1 1 ; if field index even then
al w1 x1-1 ; field index odd (one less);
rl w2 x2+12 ; w2 := zone address; <*stack ref destroyed*>
sh w1 (x2+h3+4) ; if field index>z.record length
sh w1 0 ; or field index<=0 then
jl. a11. ; goto field alarm;
wa w0 2 ; w0 := field index + size;
am (x2+h3+4) ;
sl w0 2 ; if field index+size > z.record length+1 then
jl. a11. ; goto field alarm;
wa w1 x2+h3+0 ; w1 := field index + z.record base; <*start addr*>
jd 1<11+96; relocate process;
d12: dl. w3 (j30.) ; restore stackref;
rl. w3 (j1.) ;
jl w3 x3+d0 ; goto exit reset;
\f
; jz.fgs.1980.12.22 algol 8, monitor, segment 3 page ...16...
j10:
c.j10-506
m.code on segment 3 too long
z.
c.502-j10, 0, r.252-j10>1 z. ; fill rest of segment 3 with zeroes
<:monitor<0>:>, 0 ; alarm text on segment 3
i.
e.
\f
;jz.fgs.1980.12.22 algol 8, monitor page ...17...
i.
e. ; end global slang segment
;tail to be inserted into the catalog:
g0:g1: ; first and last tail
3 ; 3 segments
0, r.4 ; empty document name
1 <23 + e1 ; entry point
3 <18+25<12+19<6+8 ; int proc, sp int arr, sp addr int, sp zone
13<18 ; sp val int
4 <12 + e0 ; 4, start of external list
3 <12 ; code segments, bytes in permanent core
m. jz.fgs.1987.07.08 algol 8, monitor procedures
\f
▶EOF◀