|
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: 194304 (0x2f700)
Types: TextFile
Names: »monprocs«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦20407c65c⟧ »kkmon0filer«
└─⟦this⟧
└─⟦667bb35d6⟧ Bits:30007480 RC8000 Dump tape fra HCØ.
└─⟦4334b4c0b⟧
└─⟦f781f2336⟧ »kkmon0filer«
└─⟦this⟧
\f
m. monprocs - monitor procedures
b.i30 w.
i0=81 04 09, i1=12 00 00
; if newtime (i0,i1) > oldtime (a133,a134) then oldtime:=newtime;
c.i0-a133
c.i0-a133-1, a133=i0, a134=i1, z.
c.i1-a134-1, a134=i1, z.
z.
i10=i0, i20=i1
i15=i10/100000 , i10=i10-i15*100000 , i25=i20/100000 , i20=i20-i25*100000
i14=i10/10000 , i10=i10-i14*10000 , i24=i20/10000 , i20=i20-i24*10000
i13=i10/1000 , i10=i10-i13*1000 , i23=i20/1000 , i20=i20-i23*1000
i12=i10/100 , i10=i10-i12*100 , i22=i20/100 , i20=i20-i22*100
i11=i10/10 , i10=i10-i11*10 , i21=i20/10 , i20=i20-i21*10
i2: <: date :>
(:i15+48:)<16+(:i14+48:)<8+46
(:i13+48:)<16+(:i12+48:)<8+46
(:i11+48:)<16+(:i10+48:)<8+32
(:i25+48:)<16+(:i24+48:)<8+46
(:i23+48:)<16+(:i22+48:)<8+46
(:i21+48:)<16+(:i20+48:)<8+ 0
i3: al. w0 i2. ; write date:
rs w0 x2+0 ; first free:=start(text);
al w2 0 ;
jl x3 ; return to slang(status ok);
jl. i3. ;
e.
j.
\f
; list of monitor procedures:
b16: ; start:
e0 ; 0 : set interrupt
e1 ; 2 : reset, priv
e2 ; 4 : process description
e3 ; 6 : initialise process
e4 ; 8 : reserve process
e5 ; 10 : release process
e6 ; 12 : include user
e7 ; 14 : exclude user
e8 ; 16 : send message
e9 ; 18 : wait answer
e10 ; 20 : wait message
e11 ; 22 : send answer
e12 ; 24 : wait event
e13 ; 26 : get event
c99 ; 28 : (type w0, not icluded in rc8000)
c99 ; 30 : (type w1, not icluded in rc8000)
c99 ; 32 : (type w2, not icluded in rc8000)
c99 ; 34 : (type w3, not icluded in rc8000)
e18 ; 36 : get clock
e19 ; 38 : set clock
e20 ; 40 : create entry
e21 ; 42 : lookup entry
e22 ; 44 : change entry
e23 ; 46 : rename entry
e24 ; 48 : remove entry
e25 ; 50 : permanent entry
e26 ; 52 : create area process
e27 ; 54 : create peripheral process
e28 ; 56 : create internal process
e29 ; 58 : start internal process
e30 ; 60 : stop internal process
e31 ; 62 : modify internal process
e32 ; 64 : remove process
e33 ; 66 : test event
e34 ; 68 : generate name
e35 ; 70 : copy
e36 ; 72 : set catalog base
e37 ; 74 : set entry base
e38 ; 76 : lookup head and tail
e39 ; 78 : set backing storage claims
e40 ; 80 : create pseudo process
e41 ; 82 : regret message
e42 ; 84 : general copy
e43 ; 86 : lookup aux entry
e44 ; 88 : clear statistics in entry
e45 ; 90 : permanent entry in aux catalog
e46 ; 92 : create entry lock process
e47 ; 94 : set priority
e48 ; 96 : relocate process
e49 ; 98 : set address base
e50 ; 100 : start io
e51 ; 102 : prepare backing storage
e52 ; 104 : insert entry
e53 ; 106 : insert backing storage
e54 ; 108 : delete backing storage
e55 ; 110 : delete entries
e56 ; 112 : connect main catalog
e57 ; 114 : remove main catalog
e58 ; 116 :set process extensions
c29 ; 118 : not used
e60 ; 120 : create aux entry and area process
e61 ; 122 : remove aux entry
e62 ; 124 : send pseudo message
b17=k-b16 ; max monitor call number
b. i20 w.
i0: 0 ; saved w0
i1: 0 ; saved w1
i2: 0 ; saved w2
i3: 0 ; saved w3
i8: 0 ; internal
; procedure deliver answer;
; comment: delivers an answer from a receiver to a sender. if the sender is waiting for the
; answer, it will be started. if the message is regretted (or sender removed), the
; buffer is returned to the mess buf pool.
; call: w2=buf, w3=link
; exit: w0, w1=unchanged, w2, w3=undef
; return address: link
d15: ds. w1 i1. ; save registers;
rs. w3 i3. ;
i9: dl w1 x2+6 ; internal:=sender(buf); (w0 := receiver(buf))
sh w1 -1 ; if internal<0 then
jl. i12. ; goto regretted;
rl w3 x1+a10 ;
sn w3 64 ; if kind(sender)=pseudo process then
rl w1 x1+a50 ; internal:=mainproc(sender);
sz w3 -1-64 ; if kind(sender) is neither internal nor pseudo process then
rl w1 x1+a250 ; internal:=driverproc(sender);
rs. w1 i8. ; save(internal);
bz w3 x1+a13 ; w3:=state(internal);
sn w3 a103 ; if state<>wait answer or
se w2 (x1+a30) ; save w2(internal)<>buf then
jl. i13. ; goto event;
rs w0 x1+a28 ; save w0(internal) := result := receiver(buf);
jl w3 d109 ; increase buf claim, remove release buf(internal, buf);
rl. w3 i8. ; restore(internal);
al w1 x2+8 ; from:=buf+8;
rl w2 x3+a29 ; answer:=save w1(internal);
wa w2 x3+a182 ; get physical address of answer area
jl w3 d14 ; move mess(from, answer);
i10: rl. w1 i8. ;
jl w3 d10 ; link internal(internal);
i11: dl. w1 i1. ; exit: restore(w0, w1);
jl. (i3.) ; return;
i12: al. w3 i11. ; regretted: remove release buf;
jl d106 ; goto exit;
i13: jl w3 d5 ; event:
al w1 x1+a15 ; remove(buf);
jl w3 d6 ; link(event q(internal), buf);
bz w0 x1-a15+a13;
se w0 a104 ; if state<>wait event then
jl. i11. ; goto exit;
al w0 1 ; result:=1; (i.e. answer);
rs w0 x1-a15+a28; save w0(internal) := result;
rs w2 x1-a15+a30; save w2(internal):=buf;
jl. i10. ; goto set result;
; procedure deliver message;
; comment: delivers the message to an internal process, and starts it if it is waiting for a message;
; call: w2=buf, w3=link
; exit: w0, w1=unchanged, w2, w3=undef
; return address: link
d16: ds. w1 i1. ; save registers;
ds. w3 i3. ;
rl w1 x2+4 ; internal:=receiver(buf);
rl w0 x1+a10 ;
sn w0 64 ; if kind(internal)=pseudo process then
rl w1 x1+a50 ; internal:=mainproc(internal);
sz w0 -1-64 ; if kind(internal) is neither internal process nor pseudo process then
rl w1 x1+a250 ; internal:=driverproc(internal);
sn w1 0 ; if internal not defined then
jl. i16. ; goto unknown;
rs. w1 i8. ; save(internal);
bz w0 x1+a13 ; w0:=state(internal);
se w0 a102 ; if state<>wait message then
jl. i15. ; goto event;
rl w2 x2+6 ;
rs w2 x1+a28 ; save w0(internal):=sender(buf);
rl w3 x1+a31 ; name:=save w3(internal);
wa w3 x1+a182 ; get phys. addr.
dl w1 x2+a11+2 ; move 4 words process name;
ds w1 x3+2 ;
dl w1 x2+a11+6 ;
ds w1 x3+6 ;
rl. w1 i8. ;
rl w2 x1+a29 ; mess := save w1(internal);
wa w2 x1+a182 ; get phys. addr.
rl. w1 i2. ; restore(buf);
al w1 x1+8 ;
jl w3 d14 ; move mess(buf+8, mess);
i14: rl. w1 i8. ; start driver:
jl w3 d10 ; link internal(internal);
rl. w1 i8. ;
rl. w2 i2. ;
jl w3 d108 ; claim buffer (internal, buf); notice: error exit if exceeded
rs w2 x1+a30 ; save w2(internal) := buf;
dl. w1 i1. ; restore(w0, w1);
jl. (i3.) ; return;
i15: al w1 x1+a15 ; event:
jl w3 d6 ; link(event q(internal), buf);
se w0 a104 ; if state<>wait event then
jl. i11. ; goto exit;
al w0 0 ; result:=0; (i.e. message);
rs w0 x1-a15+a28; save w0(internal) := result;
jl. i14. ; goto start driver;
i16: al w0 5 ; unknown:
rs w0 x2+4 ; receiver(buf) := 5; i.e. result := 5;
jl. i9. ; goto deliver answer;
; procedure deliver general event
;
; comment: when a process issues one of the following monitor calls:
; a. initialize process (switch = 0)
; b. reserve process (switch = 2)
; c. release process (switch = 4)
; concerning an external process, this procedure is called.
; the sender is stopped, and the process description is linked to the eventqueue
; of the driver process.
;
; the driver process must call ...wait event... in order to get the request.
; as soon as the driver process reaches a process description in the eventqueue,
; the process description will be removed from the eventqueue, and a message buffer
; (taken from the driver process) will be initialized with:
;
; links = out of queue
; receiver = - external process descr. addr. (odd)
; sender = senders - - -
; operation= switch
;
; this message buffer is given to the driver process.
;
; the driver process should now pay attention to the request and (sooner or later)
; answer the sender (and thereby restart it) by calling the monitor procedure
; ...send answer..., and return to another call of wait event.
;
; ---
;
; this is the normal way it should work, but there are - of course - some exceptions
; to the rule. the sender may be stopped and started - or even worse: it may have
; its instruction counter modified (i.e. parent break) before it is started.
;
; the special cases are:
; a. the sender is stopped while the process description is still in the event-
; queue of the driver process (i.e. not remarked by the driver).
; b. the sender is stopped after the driver process has started processing the
; request, but before the driver has answered the sender.
; c. the sender is answered after case b.
; d. the sender is started by its parent, after case b.
; e. the sender is modified (or removed) by its parent, after case b.
;
; ad a. the instruction counter of the sender may be decreased by 2 (i.e. the call
; will be repeated later) because the driver has not started processing of
; the request yet.
; ad b. the driver process has started processing of the request, i.e. the call may not
; be repeated as in case a.
; the sender must be left in a special state, so that a following ...start
; internal... , ...modify internal... or ...remove internal... will take
; special actions.
; ad c. the driver process has now terminated the request, but the sender is stopped by
; its parent.
; the state of the sender should just be changed to the usual ...waiting for start... .
; ad d. the sender may not be started yet, because the driver process has not termi-
; nated the request-handling. just leave the sender-state as it was before it
; was stopped (i.e. as before case b.).
; ad e. the parent of the sender must have rights to force the sender to proceed.
; since the driver process still presumes that the sender is stopped, the
; change is signalled by regretting the message buffer that contains informa-
; tion of the old request.
; (i.e. the driver process need not be aware of the state of the sender,
; because the call ...send answer... is completely blind, if the buffer is
; regretted).
;
;
; call: w0 = switch, w1 = sender, w2 = proc
; exit address: c99 (interrupt return)
d100:ls w0 -1 ; wait address(sender) :=
wa w0 4 ; switch shift (-1)
wa w0 4 ; + 2 * proc;
rs w0 x1+a40 ; (only nescessary in case driver is busy)
rl w3 x2+a10 ; driver := proc;
sn w3 64 ; if receiver is pseudo process then
rl w2 x2+a50 ; driver := main proc(receiver);
sz w3 -1-64 ; if receiver is neither internal nor pseudo process then
rl w2 x2+a250 ; driver := driver process(receiver);
; evt teste at w2 eksisterer
ds. w2 i2. ; save(sender, driver);
al w0 a101 ;
jl w3 d9 ; remove internal(sender, waiting for procfunc);
rl. w1 i2. ; w1 := driver;
rl. w2 i1. ; w2 := timequeuelink(sender);
al w2 x2+a16 ;
bz w0 x1+a13 ;
sn w0 a104 ; if state(driver) <> waiting for event then
jl. i17. ; begin
al w1 x1+a15 ; link(eventq(driver), sender descr);
al w3 c99 ; goto interrupt return;
jl d6 ; end;
d120: ; take general event:
i17: rs. w1 i8. ; save (driver);
bz w3 x1+a19 ; if bufclaim(driver) = 0 then
sn w3 0 ;
jl. i14. ; goto start driver;
al w3 x3-1 ; decrease(bufclaim(driver));
hs w3 x1+a19 ;
bz w3 x2-a16+a19; decrease(bufclaim(sender));
al w3 x3-1 ; (it is just to facilitate regretting etc,
hs w3 x2-a16+a19; so don't care for claims exceeded)
al w0 1 ; make save ic (sender) odd;
lo w0 x2-a16+a33; i.e. signal that the request
rs w0 x2-a16+a33; is being processed;
al w0 2.11 ; unpack switch:
la w0 x2-a16+a40; switch := wait addr(sender) extract 2 shift 1;
ls w0 1 ;
al w3 x2-a16 ; w3 := sender;
rl w2 b8 ; buf := next(mess buf pool);
rs w0 x2+8 ; operation(buf) := switch;
al w0 4 ;
rs w0 x1+a28 ; save w0(driver) := 4; i.e. result = imm. message
; unpack proc:
al w0 -1<2 ; proc := wait addr(sender) shift (-2) shift 1;
la w0 x3+a40 ;
ls w0 -1 ;
rx w3 0 ; sender(buf) := sender;
ac w3 x3+1 ; receiver(buf) := -proc-1; (i.e. odd, claimed)
ds w0 x2+6 ; (odd == immediate message)
jl w3 d5 ; remove(buf);
rs w2 x1+a30 ; save w2(driver) := buf;
al w3 c99 ; link internal(driver);
jl d10 ; goto interrupt return;
e.
c.(:a90>0 a.1:)-1
; coredump.
; only used in connection with power up. the dump is executed
; using the fpa with io device number 2.
; call: return:
; w0 destroyed
; w1 destroyed
; w2 destroyed
; w3 link destroyed
b. c10, d40, i50, r20 w.
d140: rs. w3 d32. ; coredump:
; start of coredump:
; change eventually contents of devicebase, unless already done.
i0: al. w0 d11. ; device base := local base;
rx w0 b65 ;
se w0 (b65) ; if device base <> old base then
rx. w0 d30. ; save(old device base);
sn w0 0 ; if saved old device base = 0 then
jl. i40. ; goto end coredump;
; restart coredump:
; the coredump starts from coreaddress zero
i10: al w1 -512 ; coreaddr := -512;
rs. w1 d21. ;
; next coreblock:
i11: rl. w1 d21. ; addr := coreaddr + 512;
al w1 x1+512 ;
di w0 x1+8 ; if addr = top core then
sx 2.111 ;
al w1 -1 ; endblock := true
se w1 -1 ; else
rs. w1 d21. ; coreaddr := addr;
rs. w1 d22. ;
al w0 0 ; retries := 0;
rs. w0 d31. ;
; send coreblock:
; initialize transfer-variables
; start the device and wait for interrupt
i15: al w0 0 ;
rs. w0 d13. ; interrupt := false;
rs. w0 d23. ; received command := illegal;
do. w0 (d10.) ; start device(irrell register);
rl. w1 d0. ; (get loopcount)
i16: ;
se. w0 (d13.) ; wait until interrupt
jl. i30. ; or timeout;
al w1 x1-1 ;
se w1 0 ; if interrupt then
jl. i16. ; goto after interrupt;
; the transfer did not terminate within a certain time:
; reset the device, and wait some time
i17: am. (d10.) ;
do w0 +2 ; reset device(irrell register);
; sx 2.010 ; if disconnected then
; jl. i40. ; goto end coredump;
rl. w1 d1. ; (get loop count)
i18: ;
al w1 x1-1 ; wait some time;
se w1 0 ;
jl. i18. ;
; prepare repeat of transfer:
; increase retries
; if too many then halt
; goto send coreblock
i20: rl. w1 d31. ;
al w1 x1+1 ; increase(retries);
rs. w1 d31. ;
sh w1 100 ; if retries < max then
jl. i15. ; goto send coreblock;
jl -1 ; halt;
; definition of dumpdevice:
r20 = 3 ; 3=fpa transmitter
; definition of coredump startchar and commandchars:
r10 = 253 ; coredump block
r0 = 128 ; send next block
r1 = 2 ; start coredump
r2 = 12 ; end coredump (= reject from ncp)
r3 = 1 ; retransmit
; timercounts:
d0: 100000 ; loopcount for transfer
d1: 100000 ; loopcount for reset
; device address:
d10: 1<23 + r20 < 3 ;
; device descriptor:
d11 = k - r20 < 3 ; device base for coredump
c0 ; channel program start
d12 ; standard status
d13 ; interrupt address
-1 ; interrupt data
; status area:
d12 = 0 ; (not used)
; interrupt word:
d13: 0 ; 0==false, else true
; coredump channel program:
c0: 0<8 , 0 , 12 ; clear core(0:7)
d20: r10<16+3<8+1<7, d20, 1 ; send startchar (from left char in the command)
d21 = k+2, 3<8+1<7, 0 , 768 ; send coreblock
3<8 , d22, 2 ; send coreaddr (two leftmost chars)
1<8 , d23, 1 ; receive command char
15<8 ; stop
; coreaddress: -1==endblock, else blockaddress
d22: 0 ;
; command character
d23: 0 ; (received in leftmost char)
; miscellaneous:
d30: 0 ; saved device base
d31: 0 ; retries
d32: 0 ; saved link
; after interrupt:
; don't care if the output was not actually made.
; switch out, depending on received command-character.
i30: rl. w0 d23. ;
ls w0 -16 ; w0 := received command, rigth justified;
sn w0 r0 ; if command = next then
jl. i11. ; goto next coreblock;
sn w0 r1 ; if command = start coredump then
jl. i10. ; goto restart;
sn w0 r2 ; if command = end then
jl. i40. ; goto end coredump;
sn w0 r3 ; if command = retransmit then
jl. i15. ; goto send coreblock;
jl. i20. ; goto prepare repeat;
; end of coredump:
; restore device base:
i40: rl. w0 d30. ;
rs w0 b65 ; device base := old device base;
jl. (d32.) ; exit: return;
e.
z.
\f
; procedure set interrupt(address, mask);
; call: return:
; save w0 mask unchanged
; save w1 unchanged
; save w2 unchanged
; save w3 address unchanged
b. i2 w.
e0: rl w2 x1+a31 ; address:=save w3 (cur);
al w0 x2+a180 ; (w0 = top of regdump)
se w2 0 ; if address <> 0 then
jl w3 d112 ; check within(address, top regdump);
rl w3 x1+a27 ;
sn w3 (x1+a170) ; if old intaddr = old escape address then
rs w2 x1+a170 ; escape address := address;
rl w0 x1+a176 ;
se w0 0 ; if monitor function <> set interrupt address then
am a170-a27; escape address := address
rs w2 x1+a27 ; else intaddr := address;
se w0 0 ;
am 4 ;
dl. w3 i1. ;
la w2 x1+a28 ; mask := save w0(cur) extract relevant bits;
la w3 x1+a32 ; status := status(cur) remove the corresponding bits;
sn w0 0 ;
ls w2 -3 ; (if set intaddr then oldfashioned rc4000 style)
lo w2 6 ; status(cur) := status 'or' mask;
rs w2 x1+a32 ;
gg w3 b91 ; move: user exception address(cur)
dl w1 x1+a170 ; user escape address(cur)
ds w1 x3+a325+a328; to: previous interrupt stack element;
jl c99 ; goto interrupt return;
8.3000 0000 ; i1-2: extract aritmetic bits (nb: oldfashioned rc4000-way)
i1: 8.7477 7777 ; : remove - -
8.2477 0000 ; i1+2: extract escape bits
8.5300 7777 ; i1+4: remove - -
e.
; procedure process description(name, result);
; call: return:
; save w0 result (=0, proc descr addr)
; save w1
; save w2
; save w3 name
b. i0 w.
e2: jl w3 d101 ; check and search name
al. w3 i0. ;+2 not found: w3:=zero address
rl w0 x3 ; result := proc descr;
jl r28 ; goto return prepared result;
i0: 0 ;
e.
; procedure initialize process(name, result);
; - reserve - ( - , - );
; call: return:
; save w0 result (=0, 1, 2, 3)
; save w1 unchanged
; save w2 unchanged
; save w3 name unchanged
e3: am 0-2 ; initialize:
e4: al w0 2 ; reserve: prepare result, in case of internal proc;
jl w3 d101 ; check and search name;
jl r3 ;+2 not found: goto result 3;
rl w2 x3 ;+4 proc:=name table(entry)
rl w3 x2+a10 ; if kind(proc) neither internal process
sz w3 -1-64 ; nor pseudo process then
jl. d100. ; deliver general event (w0=switch, w1=cur, w2=proc)
; and goto interrupt return;
jl r28 ; goto return prepared result;
; procedure release process (name);
; call: return:
; save w0 unchanged
; save w1 unchanged
; save w2 unchanged
; save w3 name unchanged
e5: jl w3 d101 ; check and search name;
jl c99 ;+2 not found: goto interrupt return;
rl w2 x3 ;+4 proc:=name table(entry);
al w0 4 ; switch:=4;
rl w3 x2+a10 ; if kind(proc) neither internal process
sz w3 -1-64 ; nor pseudo process then
jl. d100. ; deliver generel event (w0=switch, w1=cur, w2=proc)
; and goto interrupt return;
jl c99 ; goto interrupt return;
; procedure include user(name, device, result);
; - exclude - ( - , - , - );
; call: return:
; save w0 result (=0, 2, 3, 4)
; save w1 device unchanged
; save w2 unchanged
; save w3 name unchanged
b. i0 w.
e6: am d126-d123; include: switch := insert user;
e7: al w0 d123 ; exclude: switch := remove user;
rs. w0 i0. ; save(switch);
jl w3 d101 ; check and search name;
jl r3 ;+2 not found: goto result3;
rl w2 x3 ;+4 child:=name table(entry);
rs w2 x1+a28 ; save w0(cur) := child;
rl w3 x2+a10 ; w3:=kind(child);
sn w3 0 ; if kind<>0 or
se w1 (x2+a34) ; cur<>parent(child) then
jl r3 ; goto result 3;
rl w3 x1+a29 ; device:=save w1(cur);
ls w3 1 ;
wa w3 b4 ; entry:=2*device+first device;
sl w3 (b4) ; if entry<first device or
sl w3 (b5) ; entry>=first area then
jl r4 ; goto result 4;
rl w2 x3 ; proc:=name table(entry);
jl w3 d102 ; check user(cur, proc);
jl r2 ;+2 not user: goto result 2;
rl w1 x1+a28 ; restore(child);
jl. w3 (i0.) ; insert/remove user(child, proc);
rl w1 b1 ; restore(cur);
jl r0 ; goto result 0;
i0: 0 ; saved switch
e.
; procedure send pseudo message(pseudo proc, name, mess, buf);
; call return
; save w0 pseudo proc descr unch.
; save w1 mess unch.
; save w2 mess flag unch.
; save w3 name unch.
; procedure send message(name, mess, buf);
; call: return:
; save w0 unchanged
; save w1 mess unchanged
; save w2 mess flag unchanged
; save w3 name unchanged
b. i10 w.
; send pseudo message:
e62: rl w3 x1+a28 ; proc:= savew0(cur);
sh w3 0 ; if savew0 <= 0
jl c29 ; then goto internal 3;
rl w2 x3+a10 ;
se w2 64 ; if kind(proc) <> pseudo kind
jl c29 ; then goto internal 3;
rl w2 x3+a50 ;
se w2 (b1) ; if main(proc) <> cur
jl c29 ; then goto internal 3;
am -1 ; function:= send pseudo message;
; send message:
e8: al w0 0 ; function:= send message;
rs. w0 i7. ; save function;
rl w3 x1+a31 ; if savew3(cur) <= last of name table then
sh w3 (b7) ;
jl. i3. ; goto driver message;
i6: jl w3 d110 ; check mess area and name area(name);
wa w2 x1+a182 ; get phys. addr.
rl w3 x2+8 ; entry:=word(name+8);
sl w3 (b3) ; if entry<name table start or
sl w3 (b7) ; entry>=name table end then
jl. i1. ; goto search;
rl w3 x3 ; proc:=name table(entry);
dl w1 x2+2 ;
sn w0 (x3+a11) ; if name in call<>name in monitor then
se w1 (x3+a11+2) ;
jl. i1. ; goto search;
sn w0 0 ; if name(0)=0 then
jl. i2. ; goto unknown;
dl w1 x2+6 ;
sn w0 (x3+a11+4) ;
se w1 (x3+a11+6) ;
jl. i1. ;
; the receiver is found. now check bufclaim and deliver the message
; w3=proc
i0: rl. w0 i7. ; if function = send pseudo message then
sn w0 0 ; begin
jl. i10. ;
rl w0 x3+a10 ; if kind(receiver) <> internal
se w0 0 ; then goto internal 3;
jl c29 ; end;
i10: rl w1 b1 ;
bz w0 x1+a19 ; if buf claim(cur)=0 then
sn w0 0 ; goto decrease buffer claim;
jl d108 ; (which exits with save w2=0);
bs. w0 1 ; decrease (bufclaim(cur));
hs w0 x1+a19 ;
rl w2 b8 ; buf:=next(mess pool);
rs w3 x2+4 ; receiver(buf):=proc;
rl. w3 i7. ;
se w3 0 ; if function = send pseudo message
jl. i8. ; then sender(buf):= pseudo proc
rs w1 x2+6 ; else sender(buf):= cur;
jl. i9. ;
i8: rl w3 x1+a28 ;
rs w3 x2+6 ;
i9:
rl w3 x1+a30 ;
rs w3 x2+a139 ; mess flag(buf):=saved w2;
rs w2 x1+a30 ; save w2(cur):=buf;
rl w3 x1+a29 ; mess:=save w1(cur);
wa w3 x1+a182 ; get phys. addr.
dl w1 x3+2 ;
ds w1 x2+10 ; move 8 words from mess to buf;
dl w1 x3+6 ;
ds w1 x2+14 ;
dl w1 x3+10 ;
ds w1 x2+18 ;
dl w1 x3+14 ;
i4: ds w1 x2+22 ; move last:
jl w3 d5 ; remove(buf);
al w3 c99 ; deliver message(buf);
jl. d16. ; goto interrupt return;
; the name table address was illegal or not correct:
i1: rl w1 b1 ; w1:= cur
ws w2 x1+a182 ; logical address
jl w3 d11 ; search name(name.entry)
jl. i2. ; not found: goto unknown
wa w2 x1+a182 ; physical buffer address
rs w3 x2+8 ; word(name+8):=entry;
rl w3 x3 ; proc:=name table(entry);
jl. i0. ; goto found;
i2: rl w1 b1 ; unknown:
rl w2 b8 ; buf:=next(mess pool);
rl w3 x1+a30 ;
rs w3 x2+a139 ; mess.flag=saved w2
jl w3 d108 ; claim buffer(cur, buf);
rs w2 x1+a30 ; save w2(cur) := buf;
al w0 5 ; receiver(buf):=result:=5;
rl. w3 i7. ; if function = send pseudo message
se w3 0 ; then sender(buf):= pseudo proc
rl w1 x1+a28 ; else sender(buf):= cur;
ds w1 x2+6 ; sender(buf):=cur;
al w3 c99 ; deliver answer(buf);
jl. d15. ; goto interrupt return;
i3: sl w3 (b6) ; driver message:
sl w3 (b7) ; if save w3(cur) outside nametable then
jl. i6. ; continue normal;;
; test that save w1(cur) is an external proc description
rl w2 b4 ;
rl w3 x1+a29 ; for w2 := first device in name table
i5: sl w2 (b5) ; step 2 until top device do
jl c29 ;
al w2 x2+2 ; if save w1(cur) = entry(w2) then
se w3 (x2-2) ; goto found;
jl. i5. ; not found: goto internal 3;
rl w0 x3+a10 ; found:
sz w0 -1-64 ; if kind(proc) = internal process or pseudo process
se w1 (x3+a250) ; or cur <> driverproc(proc) then
jl c29 ; goto internal 3;
rl w2 b8 ; buf := next (mess buf pool);
jl w3 d108 ; claim buffer(buf);
rl w3 (x1+a31) ; receiver(buf) := name table(save w3(cur));
rl w0 x1+a29 ; sender(buf) := proc; i.e. save w1(cur);
ds w0 x2+6 ;
ld w1 -65 ;
ds w1 x2+10 ; clear rest of message;
ds w1 x2+14 ;
ds w1 x2+18 ;
jl. i4. ; goto move last;
i7: 0 ; save function;
e.
; procedure wait answer(buf, answer, result);
; call: return:
; save w0 result (=1, 2, 3, 4, 5)
; save w1 answer unchanged
; save w2 b uf unchanged
; save w3 unchanged
b. i5 w.
e9: jl w3 d103 ; check message area and buf;
rl w3 x2+6 ; proc:= sender(buf);
rl w0 x3+a10 ; if kind(proc) = pseudo kind then
se w0 64 ; begin
jl. i0. ; if main(proc) <> cur
rl w0 x3+a50 ; then goto internal 3
se w0 (b1) ; else goto ok;
jl c29 ; end
jl. i1. ; else
i0: se w1 (x2+6) ; if proc <> cur
jl c29 ; then goto internal 3;
i1: ; ok:
rl w0 x2+4 ; w0:=receiver(buf);
sz w0 -8 ; if answer not send then
jl d104 ; goto remove wait answer;
rs w0 x1+a28 ; save w0(cur):=result;
jl w3 d109 ; increase claim, remove release buf(cur, buf);
rl w3 b1 ; w3:=cur;
al w1 x2+8 ;
rl w2 x3+a29 ; move mess(buf+8, answer);
wa w2 x3+a182 ; get physical address of answer area
al w3 c99 ;
jl d14 ; goto interrupt return;
e.
; procedure wait message(name, mess, buf, result);
; call: return:
; save w0 result (=sender descr addr)
; save w1 mess unchanged
; save w2 buf
; save w3 name unchanged
b. i8 w.
e10: jl w3 d110 ; check mess area and name area;
al w3 -8 ;
al w2 x1+a15 ; buf:=event q(cur);
i2: rl w2 x2+0 ; next: buf:=next(buf);
sn w2 x1+a15 ; if buf=event q(cur) then
jl d105 ; goto remove wait message;
sz w3 (x2+4) ; if answer then
jl. i3. ;
jl. i2. ; goto next;
i3: sl w2 (b8+4) ; if buf not message buffer then
sl w2 (b8+6) ;
jl. i2. ; goto next; (i.e. some kind of general event);
sh w3 (x2+4) ; if message buffer not claimed then
jl w3 d108 ; claim buffer(cur,buf);
jl w3 d5 ; remove(buf);
rl w3 x2+6 ;
rs w3 x1+a28 ; save w0(cur):=sender(buf);
rs w2 x1+a30 ; save w2(cur):=buf;
sh w3 0 ; if sender(buf)<=0 then
al w3 x1 ; sender:=dummy name address;
rl w2 x1+a31 ; move 4 words process name
wa w2 x1+a182 ; add base of current process
dl w1 x3+a11+2 ; from sender
ds w1 x2+2 ;
dl w1 x3+a11+6 ;
ds w1 x2+6 ; to name parameter;
rl w2 b1 ;
rl w0 x2+a182 ; get base of current process
dl w3 x2+a30 ; mess:= save w1(cur)
wa w2 0 ; get physical address of message area
al w1 x3+8 ; w1:=buf+8;
al w3 c99 ; move mess(buf+8, mess);
jl d14 ; goto interrupt return;
; procedure send answer(buf, answer, result);
; call: return:
; save w0 result unchanged
; save w1 answer unchanged
; save w2 buf unchanged
; save w3 unchanged
e11: jl w3 d103 ; check message area and buf(cur);
ac w3 (x2+4) ; check state:
sh w3 -1 ; if receiver(buf)>0
jl c29 ; goto internal 3; (i.e. not claimed);
sz w3 2.1 ; make receiver even;
al w3 x3-1 ; (in case of immediate message)
rl w0 x3+a10 ; if kind(-receiver(buf))=pseudoproc then
sn w0 64 ;
rl w3 x3+a50 ; receiver:=-mainproc(-receiver);
sz w0 -1-64 ; if receiver is neither internal process nor pseudo process then
rl w3 x3+a250 ; receiver := driverproc(receiver);
se w1 x3 ; if -receiver<>cur then
jl c29 ; goto internal 3; (i.e. cur not receiver);
rl w3 x2+4 ; if receiver(buf) odd then
sz w3 2.1 ; goto immediate message;
jl. i4. ;
rl w0 x1+a28 ; result:=save w0(cur);
sl w0 1 ; if result<1 or
sl w0 6 ; result>5 then
jl c29 ; goto internal 3;
rs w0 x2+4 ; receiver(buf):=result;
bz w3 x1+a19 ;
al w3 x3+1 ; increase buf claim(cur);
hs w3 x1+a19 ;
rl w0 x1+a182 ;
rl w1 x1+a29 ;
wa w1 0 ; get physical address of answer area
al w2 x2+8 ;
jl w3 d14 ; move mess(answer, buf+8);
al w2 x2-8 ;
al w3 c99 ; deliver answer(buf);
jl. d15. ; goto interrupt return;
; immediate message
; originates from a call of initialize process etc
; entry: w1=cur, w2=buf, w3=receiver (negative, odd)
i4: ac w3 x3+1 ; make receiver even;
rs. w3 i8. ; save(receiver);
dl w0 x2+8 ;
ds. w0 i7. ; save(sender(buf), switch);
jl w3 d109 ; increase bufclaim, remove release buf(cur, buf);
; now the receiving driver has no responsibilities any longer
rl. w1 i6. ; restore(sender);
sh w1 0 ; if sender <= 0 then
jl c99 ; goto interrupt return; (i.e. regretted)
al w0 -1<1 ; make save ic(sender) even to
la w0 x1+a33 ; indicate that answer is received;
rs w0 x1+a33 ;
bz w3 x1+a19 ; increase(bufclaim(sender));
al w3 x3+1 ; (remember: the earlier decrease was just
hs w3 x1+a19 ; to facilitate...)
; maybe transfer result:
rl. w3 i7. ; restore(switch);
rl w2 b1 ; w2 := cur;
rl w0 x2+a28 ; result := save w0(cur);
se w3 4 ; if switch <> 4 then
rs w0 x1+a28 ; save w0(sender) := result; (i.e. unless release process)
; maybe do the final insertion/removal of user/reserver:
se w0 0 ; if result = 0 then
jl. i5. ; begin
rl w0 x2+a29 ; if save w1(cur) odd
sz w0 2.1 ;
al w3 x3+1 ; and switch = 0 then
sn w3 1 ;
al w3 2 ; switch := 2; i.e. reserve process;
rl. w2 i8. ; restore(receiver);
jl. x3+2 ; case switch(buf) of:
am d126-d125; switch=0: initialize proc: insert user(sender, receiver proc)
am d125-d124; switch=2: reserve proc: insert reserver( - , - - )
jl w3 d124 ; switch=4: release proc: remove reserver( - , - - )
i5: ; end;
bz w0 x1+a13 ; if state(sender) = waiting for proc func then
sn w0 a101 ; link internal(sender);
jl w3 d10 ; (i.e. start unless already stopped by parent)
jl c99 ; goto interrupt return;
i6: 0 ; saved sender(buf)
i7: 0 ; saved switch
i8: 0 ; saved receiver(buf)
e.
; procedure wait event(last buf, next buf, result);
; call: return:
; save w0 result (=0, 1)
; save w1 unchanged
; save w2 last buf unchanged
; save w3 unchanged
; procedure test event(last buf, next buf, result);
; call: return:
; saved w0 result (-1: empty, 0: message, 1: answer)
; saved w1 unchanged/sender(mess)/message flag
; saved w2 last buf next buf
; saved w3 unchanged
b. i20 w.
c96: rl w1 b1 ; entry to wait first event:
rl w2 x1+a302 ; goto wait-first-event entry
jl (x2+a304) ; in the driver process;
e33: am -1-0 ; test event: function:=inspect;
e12: al w0 0 ; wait event: function:=wait;
rs. w0 i0. ;
rl w2 x1+a30 ; last buf:=save w2(cur);
se w2 0 ; if last buf<>0 then
jl. i4. ; check event(cur, last buf);
al w2 x1+a15 ; else last buf:=event q(cur);
i3: al w3 x2 ;
al w0 0 ;
jl. i6. ; goto test buf;
i4: jl w3 d19 ; check event: call check event
jl. i3. ;
; scan the event queue, from last buf, until last buf or already waited buf.
; in the last case: release the claim.
;
; w0=0, w2=buf, w3=last buf
i5: rl w2 x2+0 ; next buf: buf:=next(buf);
sn w2 x3 ; if buf=last buf then
jl. i9. ; goto all buffers released;
i6: se w2 x1+a15 ; test buf: if buf=event q(cur) or
sh w0 (x2+4) ; receiver(buf)>=0 then
jl. i5. ; goto next buf;
sl w2 (b8+4) ;
sl w2 (b8+6) ; if buffer not message buffer then
jl. i5. ; goto next buf; (i.e. some kind of general event);
; an already claimed buffer is found
sh w0 (x2+6) ; if sender(buf)<0 then
jl. i7. ; begin comment regretted, perform the actual release;
sn w3 x2 ; if last buf=buf then
rl w3 x2+2 ; last buf:=last(buf);
al w0 x3 ; save last buf;
jl w3 d106 ; remove and release buf(buf);
rl w3 0 ; restore last buf;
rl w1 b1 ; restore cur;
jl. i8. ; end
i7: ; else
ws w0 x2+4 ; receiver(buf):=+receiver(buf);
rs w0 x2+4 ;
i8: ;
bz w2 x1+a19 ;
al w2 x2+1 ; increase(buffer claim(cur));
hs w2 x1+a19 ;
i9: ; buf released:
; at this point there should not be any claimed buffers in the queue...
; examine the next event in the queue
;
; w3=last buf
rl w2 x3+0 ; buf:=next(last buf);
sn w2 x1+a15 ; if buf=event q(cur) then
jl. i13. ; goto empty;
rs w2 x1+a30 ; save w2(proc):=buf;
; the buf may either be a message buffer, an interrupt operation
; or a general event
sl w2 (b8+4) ; if buf is not message buffer then
sl w2 (b8+6) ;
jl. i11. ; goto other operation;
rl w0 x2+4 ; save w0(cur):=
sz w0 -8 ; if 0<=receiver(buf)<8 then
am -1 ; 1 else 0;
al w0 1 ; i.e.: 0==message,
rs w0 x1+a28 ; 1==answer;
rl. w3 i0. ;
se w3 -1 ; if function=test event then
jl. i10. ; if event=message then
sn w0 0 ; saved w1:=sender(message)
am a142-a139; else
rl w3 x2+a139 ; saved w1:=message flag(answer);
rs w3 x1+a29 ;
i10: ;
sn w0 0 ; if message then
jl w3 d108 ; claim buffer(cur, buf);
jl c99 ; goto interrupt return;
i11: ; other operation:
rl w3 (b6) ;
sl w2 x3 ; if operation <> internal process then
sl w2 (b8+4) ;
jl. i12. ; goto interrupt operation;
jl w3 d5 ; remove(operation);
jl. d120. ; goto take general event;
i12: ; interrupt operation:
jl w3 d5 ; remove(operation);
al w3 c99 ; take interrupt operation;
jl d127 ; goto interrupt return;
; the queue was empty.
i13: rl. w0 i0. ; empty:
se w0 -1 ; if function<>test event then
jl d107 ; goto remove wait event;
rs w0 x1+a28 ; save w0:=-1(:=function);
jl c99 ; goto interrupt return;
i0: 0 ; function
e.
; procedure get event(buf);
; call: return:
; save w0 unchanged
; save w1 unchanged
; save w2 buf unchanged
; save w3 unchanged
b. i0 w.
e13: rl w2 x1+a30 ; buf:=save w2(cur);
jl w3 d19 ; check event(cur, buf);
rl w3 x2+4 ; if 0 <=receiver(buf)<8 then
sz w3 -8 ; begin comment answer;
jl. i0. ;
al w3 c99 ; increase claim, remove release buf(cur, buf);
jl d109 ; goto interrupt return;
i0: ; end;
; message: if not claimed by means of wait event then claim it now:
sl w3 0 ; if receiver>=0 then
jl w3 d108 ; claim buffer(cur, buf);
al w3 c99 ; remove(buf);
jl d5 ; goto interrupt return;
e.
; procedure regret message;
; call: return:
; save w1 unchanged
; save w1 unchanged
; save w2 buf unchanged
; save w3 unchanged
e41: jl w3 d12 ; check message(buf);
rl w3 x2+6 ; proc:= sender(buf);
sh w3 0 ;
ac w3 x3 ;
rl w0 x3+a10 ; if kind(proc) = pseudo kind
sn w0 64 ; then proc:= main(proc);
rl w3 x3+a50 ;
bz w0 x2+8 ;
sn w3 (b1) ; if proc <> cur or
sz w0 1 ; operation(buf) odd then
jl c29 ; goto internal 3;
al w3 c99 ; regretted message(buf);
jl d75 ; goto interrupt return;
; procedure get clock(time);
; call: return:
; save w0 time high
; save w1 time low
; save w2 unchanged
; save w3 unchanged
e18: jl w3 d7 ; update time;
dl w3 b13+2 ;
ds w3 x1+a29 ; save w0w1(cur):=time;
jl c99 ; goto interrupt return;
; procedure set clock(time);
; call: return:
; save w0 time high unchanged
; save w1 time low unchanged
; save w2 unchanged
; save w3 unchanged
e19: bz w0 x1+a22 ; mask:=function mask(cur);
so w0 1<4 ; if mask(7)=0 then
jl c29 ; goto internal 3;
jl w3 d7 ; update time;
dl w3 b70+2 ; last inspected:=
ss w3 b13+2 ; last inspected
aa w3 x1+a29 ; -time
ds w3 b70+2 ; +newtime;
dl w3 x1+a29 ;
ss w3 b13+2 ; clockchange:=
aa w3 b15+2 ; clockchange+
ds w3 b15+2 ; newtime - time;
dl w3 x1+a29 ; c. tested by clock driver;
ds w3 b13+2 ; time:=save w0w1(cur);
jl c99 ; goto interrupt return;
; call of process functions:
;
; make a primary check on the parameters to ensure that they are inside the calling process.
; notice especially that it is not always possible to check the consistence of the parameters,
; because the circumstances may change before procfunc has time to perform the function.
; special care must be taken, so that the call may be repeated: if the calling process is
; stopped before procfunc reaches the process, the call is deleted, and the ic of the process
; will be decreased to repeat the call as soon as the process is restarted.
b. i20 w.
e61: ; delete aux entry:
jl w3 d111 ; check name (save w2) area;
rl w2 x1+a29 ; first param := save w1(cur);
al w0 x2+a88-2 ; last param := first + entry size - 2;
al. w3 i3. ; check within (first, last);
jl d112 ; goto link call;
e60: ; create aux entry and area process:
jl w3 d111 ; check name (save w2) area;
e56: ; connect main catalog:
e52: ; insert entry:
am i6 ; switch := test entry area;
e51: ; prepare bs:
al. w0 i3. ; switch := link call;
rs. w0 i7. ; save switch;
rl w2 x1+a31 ; first param := save w3(cur);
al w0 x2+a88-2 ; last param := first param + catentrysize - 2;
jl w3 d112 ; check within(first,last);
bz w0 x2+28 ; last param := last slice(chaintable)
al w2 x2+a88-2 ; + first param + catentrysize - 2;
wa w0 4 ;
jl w3 d112 ; check within(first,last);
jl. (i7.) ; goto (saved switch);
i7: 0 ; saved switch
e53: ; insert bs:
e54: ; delete bs:
e55: ; delete entries:
jl w3 d111 ; check name (save w2) area;
jl. i3. ; goto link call;
e39: ; set bs claims:
jl w3 d111 ; check name(save w2) area;
; get size of param (save w1(cur)):
; set bs claims (continued):
am a110*4+4-12 ; size:=(maxkey+1)*4;
e28: ; create internal:
e31: ; modify internal:
am 12-8 ; size:=12;
e23: ; rename entry:
am 8-a88 ; size:=8;
e38: ; lookup head and tail:
i0: ; insert entry (continued):
am a88-a88+14 ; size:=catentry size;
e20: ; create entry:
e21: ; lookup entry:
e22: ; change entry:
al w0 a88-14-2 ; size:=catentry size-14; notice -2;
rl w2 x1+a29 ; first param:=save w1(cur);
wa w0 4 ; last param:=first param+size-2;
al. w3 i2. ; check within(first, last);
jl d112 ; goto check name(save w3);
e43: ; lookup-aux-entry:
al w0 a88-14-2 ; size:= catentrysize-14; NOTICE -2
rl w2 x1+a29 ; first param:= save w1(cur)
wa w0 4 ; last param := first param+size-2;
jl w3 d112 ; check within(first,last)
e44: al. w3 i2. ; clear-stat-entry:
jl d111 ; check name( save w2) area;
e46: ; create entry lock process:
rl w2 x1+a31 ; first param:=save w3(cur);
al w0 x2+8 ; last param:=first param+8;
am d112-d111; check within(first, last)
; instead of
e45: ; permanent entry in auxcat:
jl w3 d111 ; check name(save w2) area;
; check param (save w3(cur)):
e24: ; remove entry:
e25: ; permanent entry:
e26: ; create area process:
e27: ; create peripheral process:
e32: ; remove process:
e34: ; generate name:
e36: ; set catalog base:
e37: ; set entry interval:
e40: ; create pseudo process:
i2: jl w3 d17 ; check name area;
e57: ; remove main catalog:
; link the calling process to the process function queue.
; procfunc is activated if it is waiting for a call.
i3: i6=i0-i3 ;
al w0 a101 ; link call:
jl w3 d9 ; remove internal(wait proc func); (w2 := cur + a16)
; elem:=process q(cur);
rl w1 (b6) ; proc:=name table(first internal); i.e. proc func;
al w1 x1+a15 ;
jl w3 d6 ; link(event queue(proc func), elem);
al w1 x1-a15 ;
bz w0 x1+a13 ; if state(proc func)=wait message then
sn w0 a102 ;
jl w3 d10 ; link internal(proc func);
jl c99 ; goto interrupt return;
; procedure reset device: special meaning when called form proc func.
e1: rl w2 (b6) ; proc:=name table(first internal); i.e. proc func;
se w2 x1 ; if proc<>cur then
jl. i4. ; goto reset device;
rl w2 x1+a15 ; proc:=next(event q(cur)); i.e. calling process;
jl w3 d5 ; remove (proc) from proc func queue;
rs. w2 i7. ; save (proc);
al w0 a102 ;
sn w3 x1+a15 ; if next(proc)=event q(cur) (i.e. queue empty) then
jl w3 d9 ; remove internal(wait mess);
rl. w2 i7. ; restore (proc);
al w1 x2-a16 ;
al w3 c99 ; link internal(proc);
jl d10 ;
; reset device
; call: return:
; save w0 resettype result (=0,4)
; save w1 device unchanged
; save w2 unchanged
; save w3 unchanged
i4: rl w2 x1+a29 ; device := save w1(cur);
lx w2 g49 ; exchange bit 0;
wa w2 b65 ;
sl w2 (b67) ; if device address outside
sl w2 (b68) ; controller table then
jl r4 ; goto result 4;
rl w2 x2+a311 ; status addres := status(contr descr);
al w2 x2-a230 ;
jl w1 d130 ; clear device(proc);
rl w1 b1 ; w1 := cur;
al w0 0 ; result:=0;
rx w0 x1+a28 ; if save w0(cur) = 0 then
sn w0 0 ; result := power restart
am 6-3 ; else
al w0 3 ; result := timeout;
al w2 x2+a241 ; w2 := interrupt operation(proc);
al w3 c99 ; deliver interrupt;
jl d121 ; goto interrupt return;
e29: rl w2 (b6) ; start internal process
se w2 x1 ; if cur <> first internal (i.e. proc func) then
jl. i2. ; goto check name(save w3);
; proc func has issued a call of start process.
; all processes to be started are linked together, via wait-address, and the start of the
; chain is given in save w3.
i5: rl w1 x2+a31 ; rep: proc := save w3(proc func);
sn w1 0 ; if end chain then
jl c99 ; goto interrupt return;
rl w0 x1+a40 ; save w3(proc func) := wait address.proc;
rs w0 x2+a31 ;
rl w2 x1+a34 ; father := parent.proc;
bz w3 x2+a12 ;
al w3 x3+1 ; increase(stopcount(father));
hs w3 x2+a12 ;
al w0 a101 ;
hs w0 x1+a13 ; state.proc := waiting for process function; (prepare for not starting)
rl w0 x1+a33 ;
so w0 1 ; if save ic(proc) even then
jl w3 d10 ; link internal(proc);
rl w2 (b6) ;
jl. i5. ; goto rep;
e30: ; stop internal process:
bz w0 x1+a19 ; if buf claim(cur)=0 then
sn w0 0 ; goto claim buffer(cur, irrellevant);
jl d108 ; (there are no buffers, so save w2:=0 and exit);
; you may not actually claim the buffer for returning the answer yet, because the calling
; process may get stopped itself, before procfunc reaches it. when the call is repeated, the
; buffer might be claimed more than once.
jl. i2. ; goto check name area;
b.j10 w.
; procedure copy.
; call return
; save w0 x z
; save w1 x z
; save w2 x z
; save w3 x z
e35: ; copy message:
jl w3 d12 ; check message buf;
rl w3 x1+a29 ; first:=saved w1;
rl w0 x1+a31 ; last:=saved w3;
sl w3 (x1+a17) ; check:
sl w0 (x1+a18) ; if first<first addr(cur)
jl c29 ; or last>=top addr(cur)
ws w0 6 ; or first>last then
sh w0 -1 ; goto internal 3
jl c29 ;
;
ac w3 (x2+4) ; rec:= -(-receiver(mess))
so w3 2.1 ; if rec odd
sh w3 0 ; or rec<=0 then
jl c29 ; goto internal 3
rl w0 x3+a10 ;
sn w0 64 ; if rec is a pseudo process then
rl w3 x3+a50 ; rec:=main(rec);
rl w0 x3+a10 ;
sz w0 -1-64 ; if rec neither internal nor pseudo process then
rl w3 x3+a250 ; rec:=driver proc(rec);
se w3 x1 ; if rec<>cur then
jl c29 ; goto internal3;
bz w3 x2+8 ;
so w3 2.1 ; if operation(mes) even then
jl r3 ; goto result3;
; further checking is postponed until procfunc.
jl. i3. ; goto link call;
; procedure general copy
; copies an area in the calling process to or from an
; area described in a message buffer.
; the first word to be copied is defined by its position
; relative to the first address in the messagebuffer.
; call return
; save w0 result (=0,2,3)
; save w1 params halfwords moved
; save w2 buf
; save w3
; params+0 function (addr pair<1 + mode)
; +2 first
; +4 last
; +6 relative(mess data buffer)
j10=512 ; max number of bytes immidiately transferred
e42: ; general copy:
jl w3 d12 ; check message buf
rl w3 x1+a29 ; param:= parameter address(=cur.w1)
al w0 x3+6 ; if param<first addr(cur) or
sl w3 (x1+a17) ; param+6>=top addr(cur) then
sl w0 (x1+a18) ;
jl c29 ; goto internal 3
wa w3 x1+a182 ; w3:= abs addr of param
rl w0 x3+0 ;
rs. w0 j4. ; function:=function(param);
ls w0 -1 ; if addr pair>12 then
sl w0 14 ; goto internal 3
jl c29 ;
rs. w0 j0. ; pair:=function>1;
;
rl w0 x3+6 ; rel:= param.relative
sh w0 -1 ; if rel<0 then
jl c29 ; goto internal 3
rs. w0 j1. ; relative:=rel;
;
dl w0 x3+4 ; first:=param.first addr
; last:=param.last addr
sl w3 (x1+a17) ; check:
sl w0 (x1+a18) ; if first<first addr(cur) or
jl c29 ; last>=top addr(cur) or
ws w0 6 ; first>last then
sh w0 -1 ; goto internal 3
jl c29 ;
wa w0 x1+a182 ; abs first(cur):=first(cur)+base(cur);
ds. w0 j3. ; size(cur)-2:=last(cur)-first(cur);
;
rl w2 x1+a30 ; mess:=saved w2;
ac w3 (x2+4) ; rec:= -(-receiver(mess));
sh w3 0 ;*****aht. driver proc
ac w3 x3 ;*****
so w3 2.1 ; if rec odd
sh w3 0 ; or rec<=0 then
jl c29 ; goto internal 3;
rl w0 x3+a10 ;
sn w0 64 ; if rec is a pseudo process then
rl w3 x3+a50 ; rec:=main(rec);
rl w0 x3+a10 ;
sz w0 -1-64 ; if rec neither internal nor pseudo process then
rl w3 x3+a250 ; rec:=driver proc(rec);
se w3 x1 ; if rec<>cur then
jl c29 ; goto internal3;
rl w3 x2+a142 ; w3 := sender(mess);
bz w0 x2+a150 ;
sz w0 2.1 ; if operation(mess) even
sh w3 0 ; or sender <= 0 (i.e. regretted) then
jl r3 ; goto result 3;
rl w0 x3+a10 ; if kind(sender) = pseudo kind
sn w0 64 ; then sender := main(sender)
rl w3 x3+a50 ;
bz w0 x3+a13 ; if state(sender) = stopped then
sz w0 a105 ;
jl r2 ; goto result 2;
am. (j0.) ; first(mess):=first(mess+pair)+relative;
dl w1 x2+8+2 ; last(mess):=last(mess+pair+2);
wa. w0 j1. ;
sl w0 (x3+a17) ; if first(mess)<first(sender)
sl w1 (x3+a18) ; or last(mess)>last(sender) then
jl. i13. ; goto result3;
ws w1 0 ; size-2:=last(mess)-first(mess);
sh w1 -1 ; if size-2 < 0
jl c29 ; then goto internal 3;
wa w0 x3+a182 ; abs first(mess):=first(mess)+base(sender);
sl. w1 (j3.) ; if size>size(cur) then
rl. w1 j3. ; size:=size(cur);
al w3 x1+2 ;
rx w3 0 ;
rl. w2 j2. ;
; w0: size, w2: abs first(cur), w3: abs first(mess)
rl. w1 j4. ;
so w1 2.1 ; if mode=1 then from:=cur, to:=mess
rx w2 6 ; else from:=mess, to:=cur;
;
rl w1 b1 ;
sl w0 j10+1 ; if size>max number trf immidiately then
jl. i3. ; goto call link;
rs w0 x1+a29 ; saved w1:=size;
; move.
; w0: size, w1: , w2: from-addr, w3: to-addr
i8: ac w1 (0) ; remaining := - bytes;
so w1 1<1 ; if even number of words to move then
jl. i10. ; goto move fast;
rl w0 x2+0 ;
rs w0 x3+0 ;
al w3 x3+2 ; increase(to-address);
al w2 x2+2 ; increase(from-address);
al w1 x1+2 ; decrease(remaining); (remember: negative)
i10: ; move fast:
rs. w1 j5. ; save(remaining);
sl w1 i12 ; if remaining does no exceed size of move-table
jl. x1+i11. ; then switch out through table;
; (otherwise move a whole portion)
i9: ; start of move-table:
dl w1 x2+30 ;
ds w1 x3+30 ;
dl w1 x2+26 ;
ds w1 x3+26 ;
dl w1 x2+22 ;
ds w1 x3+22 ;
dl w1 x2+18 ;
ds w1 x3+18 ;
dl w1 x2+14 ;
ds w1 x3+14 ;
dl w1 x2+10 ;
ds w1 x3+10 ;
dl w1 x2+6 ;
ds w1 x3+6 ;
dl w1 x2+2 ;
ds w1 x3+2 ;
i11: ; top of move-table:
i12=i9-i11 ; size of move-table (notice: negative)
al w3 x3-i12 ; increase(to-address);
al w2 x2-i12 ; increase(from-address);
rl. w1 j5. ; restore(remaining);
al w1 x1-i12 ; decrease(remaining); (remember: negative)
sh w1 -1 ; if not all moved yet then
jl. i10. ; goto move fast;
; now return to result0.
rl w1 b1 ;
jl r0 ; exit: goto result0;
i13: rl w1 b1 ; exit3:
jl r3 ; goto result3;
j0: 0 ; pair
j1: 0 ; relative
j2: 0 ; abs first(cur)
j3: 0 ; size(cur)-2
j4: 0 ; function
j5: 0 ; remaining bytes (multiplum of 4 bytes)
e.
e. ; end of proc func block
; set priority.
; saved w0 result(=0,3)
; saved w1 priority
; saved w2
; saved w3 name addr(child)
b.i10,j10 w.
e47: jl w3 d17 ; check name(saved w3);
rl w2 x1+a31 ; name addr:=saved w3;
jl w3 d11 ; search name(name, entry);
jl r3 ; not found: goto result3;
rl w3 x3 ; found:
rs. w3 i0. ; child:=proc(entry);
se w1 (x3+a34) ; if parent(child)<>cur then
jl r3 ; goto result3;
rl w0 x3+a10 ;
se w0 0 ; if child not internal proc then
jl r3 ; goto result3;
rl w0 x1+a29 ; prio:=saved w1;
sh w0 -1 ; if prio<0 then
jl c29 ; goto internal3;
ws w0 x3+a301 ; increment:=prio-priority(proc);
rs. w0 i1. ;
; search descendents of process and the process itself, and increment their
; priority values. if they are in timeslice queue, then reinsert them to
; assure proper displacement in priority-queue.
rl w3 b6 ;
j0: rl w2 x3 ;
j1: sn. w2 (i0.) ;
jl. j3. ;
rl w2 x2+a34 ;
se w2 0 ;
jl. j1. ;
j2: al w3 x3+2 ;
se w3 (b7) ;
jl. j0. ;
jl r0 ; exit: goto result0;
j3: rl w2 x3 ;
rl w0 x2+a301 ;
wa. w0 i1. ; priority(proc):=priority(proc)+increment;
rs w0 x2+a301 ;
;* rl w0 x2+a16 ;
;* sn w0 x2+a16 ; if proc in time-slice-queue then
;* jl. j2. ;
;* rs. w3 i2. ; save w3;
;* al w2 x2+a16 ;
;* jl w3 d5 ;
;* jl w3 d10 ;
;* rl. w3 i2. ;
jl. j2. ;
i0: 0 ; proc(child)
i1: 0 ; increment
i2: 0 ; saved w3
e.
; procedure relocate(name,start address,result)
; call: return:
; save w0 result (= 3,6 )
; save w1 start address
; save w2
; save w3 name address
b.i10,j10 w.
e48: jl w3 d17 ; check name(save w3)
rl w2 x1+a31 ; name addr:= save w3
jl w3 d11 ; search name(name,entry)
jl r3 ; not found: goto result 3
rl w3 x3 ; found :
rs. w3 i0. ; child:= proc(name table entry)
rl w0 x1+a182 ;
rs. w0 i2. ; save address base of calling process
se w1 (x3+a34) ; if parent(child) <> cur
jl r3 ; then goto result 3
rl w0 x3+a10 ;
se w0 0 ; if kind(child) <> internal
jl r3 ; then goto result 3
bz w0 x3+a13 ; if state(child) <> waiting f. start by parent
se w0 a99 ; then goto result 3
jl r3 ;
rl w0 x1+a29 ;
rl w2 x3+a18 ; if child is relocated outside relevant part
ws w2 x3+a17 ; of core then goto internal 3
wa w2 0 ;
sh w2 0 ; if overflow
jl c29 ; then goto result 3
al w2 x2-1 ;
sl w0 (x1+a17) ;
sl w2 (x1+a18) ;
jl c29 ;
rl w0 x1+a29 ; displ:= new start address - old start address
ws w0 x3+a17 ;
rs. w0 i1. ;
rl w3 b6 ; search:
j0: rl w2 x3 ; proc:= next internal in name table
j1: sn. w2 (i0.) ; if proc = child then goto update else
jl. j3. ; begin
rl w2 x2+a34 ; while parent(proc) <> 0 do
se w2 0 ; if parent(proc)=child then goto update
jl. j1. ; else proc:= parent(proc);
j2: ; end;
al w3 x3+2 ; next:
se w3 (b7) ; if more internals in name table
jl. j0. ; then goto search
rl w1 b1 ;
jl r0 ; exit: goto result 0
j3: rl w2 x3 ; update: proc:= proc(name table entry)
rl. w0 i1. ; current base(proc):= current base(parent)+displ;
wa. w0 i2. ;
rs w0 x2+a182 ;
dl w1 x2+a174 ; current lower write limit(proc):=
wa. w0 i1. ; initial lower write limit(proc)+displ;
wa. w1 i1. ; current upper write limit(proc):=
ds w1 x2+a184 ; initial upper write limit(proc)+displ;
jl. j2. ; goto next;
i0: 0 ; save child
i1: 0 ; save displacement
i2: 0 ; save address base of parent
e.
; procedure change address base(name,displacement,result);
; call: return:
; save w0: result (= 3,6 )
; save w1: displacement
; save w2:
; save w3: name address
b.i10,j10 w.
e49:
jl w3 d17 ; check name(save w3)
rl w2 x1+a31 ; name addr:= save w3;
jl w3 d11 ; search name(name,entry);
jl r3 ; not found: goto result 3
rl w3 x3 ; found: proc:= proc(name table entry)
rl w0 x1+a29 ;
rs. w0 i0. ; save displacement
se w1 (x3+a34) ; if parent(proc) <> cur
jl r3 ; then goto result 3
rl w0 x3+a10 ;
se w0 0 ; if kind(proc) <> internal
jl r3 ; then goto result 3
bz w0 x3+a13 ;
se w0 a99 ; if state(proc) <> waiting f. start by parent
jl r3 ; then goto result 3
al w1 x3 ;
rl w3 b6 ; check if actual process has any children.
j1: rl w2 x3 ; in this case goto result 3
sn w1 (x2+a34) ;
jl r3 ;
al w3 x3+2 ;
se w3 (b7) ;
jl. j1. ;
dl w0 x1+a18 ; first addr(proc):= first addr(proc)-displ
ws. w0 i0. ; last addr(proc):= last addr(proc)-displ
ws. w3 i0. ;
ds w0 x1+a18 ;
dl w0 x1+a170 ; if exception addr(proc) <> 0 then
sn w3 0 ; exception addr(proc):=exception addr(proc)-displ;
jl. j2. ;
ws. w3 i0. ;
j2: sn w0 0 ; if escape addr(proc) <> 0 then
jl. j3. ; escape addr(proc):=escape addr(proc);
ws. w0 i0. ;
j3: ds w0 x1+a170 ;
rl w0 x1+a182 ; address base(proc):= address base(proc)+displacement;
wa. w0 i0. ;
rs w0 x1+a182 ;
rl w0 x1+a33 ; ic(proc):= ic(proc)-displacement;
ws. w0 i0. ;
rs w0 x1+a33 ;
rl w1 b1 ;
jl r0 ; exit: goto result 0
i0: 0 ; save displacement
e.
; procedure set process extension(first ext,last ext)
;
; save w0: result (return)
; save w1: first process ext (call)
; save w2: second process ext (call)
; save w3: -
e58:
c.a400-1
rl w2 x1+a29 ; first:= save w1(cur)
rl w0 x1+a30 ; last:= save w2(cur)
sl w2 (0) ; if last < first then
rx w2 0 ; exchange(first,last)
jl w3 d112 ; check within(first,last)
rl w3 x1+a30 ; w3:= sec. proc. ext.
rl w2 x1+a29 ; w2:= first proc. ext.
ds w3 x1+a306 ; insert log. addr in process description
wa w2 x1+a182 ;
wa w3 x1+a182 ;
ds w3 b28 ; insert phys. addr in monitor table
jl r0 ; goto result 0;
z.
c.a400
jl c29 ;
z.
; procedure start i/o;
; call: return:
; save w0 function select result (=0,1,2,3)
; save w1 cp start (logic addr) unchanged
; save w2 0 or buf unchanged
; save w3 device address unchanged
; the channelprogram is started using the device address in proc desc+a235.
; at start time the working register holds the io-device number extracted
; from the save w3 (only of importance in connection with rc8601).
; result = 0: channel program etc ok, the interrupt operation will arive
; (except after 'reset device')
; 1: message regretted, i.e. no transfer started
; 2: sender stopped , i.e. no transfer started
; 3: sender address error, i.e.no transfer started
; data command specifies buffers outside senders limits
; (should give the reaction: message unintelligible)
; the procedure returns always immediatly to the calling process
; (i.e. the driver), to the instruction just following the call.
; the driver may however specify (via function select) that
; execution should be resumed via 'wait first event' (unless
; result <> 0, in which case the normal resumption is made).
; in case of parameter errors the driver process is break'ed, as usual.
; parameter errors:
; illegal function select
; save w3 is not a device address
; device descriptor not governed by current process
; previous transfer not awaited (if not 'reset...')
; save w2 not message buffer
; state of message buffer not legal for transfer (***not implemented***)
; channel program too long for device description (or outside driver process)
; wait-command in channel program
; illegal address code
; address error (i.e. buffers outside limits (except sender limits) )
; illegal data- or skip-chain
;
; function select:
; function a. 1 = 0 : return to just after call
; = 1 : exit via the std return address
;
; function>1 a. 1 = 0 : no reset
; = 1 : reset device before start of operation
;
; function>2 = 0 : no operation
; = 1 : start channelprogram
; = 2 : start std wait program
; = 3 : start std control program
; address code:
; code = 0: data area in senders process (i.e. sender(buf))
; 2: - - - drivers process
; 4: - - - device descr
; 6: - - - message buffer
; 8: - - - core (no check)
;
; first logic address depends on address code:
; code = 0: logic address in senders process
; 2: logic address in drivers process
; 4: relative address in device descr (relative to a10)
; 6: relative address in message buffer (relative to a140)
; 8: absolute address, with no limit check
; timeout: (unit: 0.1 msec)
; if a channel program is not terminated with an interrupt within
; the specified period, a software timeout will be generated, which
; will deliver the interrupt operation to the driver.
; the device will be reset, exept after a wait-program.
; notice: if timeout = 0, no software timeout will be provided.
; channel program:
; the channel program must be in the drivers area, and will be
; copied to the device description.
;
; the channel program may contain commands with the following format:
; comm + a321: irrell < 12 + 4095
; comm + a322: irrell
; comm + a323: irrell
; in this case the command will be interpreted as a dummy-command,
; i.e. will not be copied into the device description
;
; if the program contains the commands 0,1,2,3 (i.e. sense, control,
; read, write with data buffer) without the skip-modification, the
; commands must have the following format:
; comm + a321: address code < 12 + command < 8 + modifs
; comm + a322: first logic address
; comm + a323: char count
; char count must be >= 0 (unless in sense commands, where is must be >= 12)
; (furthermore: if the command is a sense, the 'top chp addr' in the
; sense-area will be cleared)
;
; the stop-command must have the following format:
; comm + a321: 0 < 12 + 2.1111 < 8 + 0
; comm + a322: 0
; comm + a323: timeout
; (this may prepare for introducing 'jump'-commands with the same
; format as the 'stop', except for:
; comm + a322: continue-address )
b. f20, h40, i60, j50 w.
; function select table:
h0: f0 ; 0 : no operation
f1 ; 1 : start channelprogram
f2 ; 2 : start std wait program
f3 ; 3 : start std control program
j0=-h0.<1 ; top value of function select
; address code table:
h1: f10 ;0: sender area
f11 ;2: driver area
f12 ;4: device descr
f13 ;6: message buffer
f14 ;8: abs core address (no limit check)
j1=-h1. ; top address code
h5: 0 ; device descr address
h10: 0 ; sender area used: 0=false, else true
h11: 0 ; =h10+2 ; driver area used: 0=false, else true
h15: 0 ; first of sender area (logic addr)
h16: 0 ; =h15+2 ; top - - - ( - - )
h17: 0 ; sender process description address
h20: 0 ; abs first of channel program area in device descr
h21: 0 ; =h20+2 ; abs top - - - - - - -
h22: 0 ; last of current chp prog entry in device descr
h23: 0 ; old command
h25: 1<23 ; change bit 0
h26: -1<1 ; make addresses even
h27: 3 ; number of characters per word
h30: 2.1100 < 8 + 1 < 6; mask: databuffer-command without skip
h36: j36 ; mask: sign extended command field
h40: j32 ; std wait channel program
; format of channel program, in driver area:
; (used relative to w3 = last of entry)
j11 = -a320 + 2 ; (base of command)
j12 = j11 + a321 ; command field
j13 = j11 + a322 ; param 1 (=first logic address)
j14 = j11 + a323 ; param 2 (=char count, or timeout)
; format of channel program, in device description:
; (matches the format prescribed by the controller)
; (used relative to w2 = last of entry)
j20 = 6 ; (size of entry)
j21 = -j20 + 2 ; (base of command)
j22 = j21 + 0 ; command field
j23 = j21 + 2 ; param 1
j24 = j21 + 4 ; param 2
j30 = 2.0011 < 8 ; mask: sense command
j31 = 12 ; minimum char count in sense command
j34 = -1 < 8 + 1 < 6 ; mask: sense command without skip (sign extended)
j32 = 2.0100 < 8 ; wait command (sign extended)
j33 = -1 < 8 ; stop command (sign extended)
j37 = -1 < 0 ; dummy command (sign extended)
j35 = 1 < 7 + 1 < 6 ; data- + skip-chain
j36 = -1 < 8 ; sign extended command field
j40 = -1 ; status bit: status transfer error
e50: ; start i/o:
; this first part of the code checks some of the most important
; parameters.
; it should be possible to skip this checking, in case the driver
; contains no errors ???
rl w3 x1+a31 ; devaddr := save w3(cur);
sz w3 2.111 ; if devaddr not multiplum of 8 (bytes) then
jl c29 ; goto internal 3; i.e. not legal at all;
lx. w3 h25. ; change bit 0 in devaddr;
wa w3 b65 ; controller descr := controller table(devaddr);
sl w3 (b67) ; if controller descr outside
sl w3 (b68) ; controller table then
jl c29 ; goto internal 3;
rl w3 x3+a311 ; status addr := std status(controller descr);
al w3 x3-a230 ; device descr addr := proc(status addr);
rs. w3 h5. ;
se w1 (x3+a250) ; if cur <> driverproc(device) then
jl c29 ; goto internal 3;
rl w2 x1+a30 ;
se w2 0 ; if save w2(cur) <> 0 then
jl w3 d12 ; check message buf;
rl w3 x1+a28 ; function select := save w0(cur);
sl w3 0 ; if function select outside limits then
sl w3 j0 ;
jl c29 ; goto internal 3;
; at this point the following has been checked:
; save w3 is a legal device address, governed by the current process
; save w2 is zero or a legal message buffer address
; save w0 is a legal function select
; w1 = cur, w3 = function select
so w3 1<1 ; if function select.reset is on then
jl. i6. ; device descr := saved device descr;
rl. w2 h5. ; clear device(device descr);
jl w1 d129 ;
rl w1 b1 ; w1 := cur;
rl w3 x1+a28 ; function select:=save(w0);
i6: ls w3 -1 ; function select := function select > 1;
jl. (x3+h0.) ; switch out through function select table;
; general return actions:
; a result is delivered to the driver, indicating the result of the call.
; if result = ok and function select is odd, return to the driver is made
; via 'wait first event', else a normal return is made
i3: am 3-2 ; result 3: address error:
i2: am 2-1 ; result 2: sender stopped:
i1: am 1-0 ; result 1: message regretted:
i0: al w0 0 ; result 0: ok:
rl w1 b1 ; w1 := cur;
rl w2 x1+a28 ; function select := save w0(cur);
rs w0 x1+a28 ; save w0(cur) := result;
sn w0 0 ; if result <> 0 or
so w2 2.1 ; function select even then
jl c99 ; goto interrupt return;
rl w2 x1+a302 ; get save area address;
rl w0 x2+a304 ; save ic(cur) := wait-first-event entry;
rs w0 x1+a33 ;
jl c99 ; goto interrupt return;
; function select actions:
; function select = no operation.
; w1 = cur
f0=i0 ; goto result 0;
; function select = start std control program
; w1 = cur
f3: am. h40. ; first := std wait program;
; continue with std wait program;
; function select = start std wait program
; w1 = cur
f2: al w0 0 ; first := 0 (i.e. no start)
rs. w0 h20. ; abs first of channel program := first;
rl w0 x1+a29 ; timeout := save w1(cur);
al w3 0 ; transfer code := 0;
; (i.e. 'wait' not considered a transfer...)
jl. i50. ; goto init transfer code;
; function select = start channel program:
; w1 = cur
f1: ld w3 -100 ;
ds. w3 h11. ; sender area used := driver area used := false;
rs. w3 h23. ; old command := 0; (i.e. at least not data-chain)
ds. w3 h16. ; first,top sender area := 0; i.e. presume empty
rl w3 x1+a30 ; buf := save w2(cur);
sn w3 0 ; if buf = 0 then
jl. i10. ; goto buffer consistency checked;
; when a message buffer is specified, it is generally concerning a
; data-transfer to/from the sender area
;
; therefore the message buffer is checked once and for all, and the proper
; buffer limits are found
;
; if any errors are found, the buffer limits will be set to en empty
; buffer, thus any attempt to specify addresses within the sender area
; will provoke a buffer limit violation
; w1 = cur, w3 = buf
dl w2 x3+a142 ; w2 := sender(buf); (w1 := receiver(buf) )
sh w2 0 ; if sender <= 0 then
jl. i1. ; goto message regretted;
bz w0 x3+a145 ; if operation(buf) is even then
so w0 2.1 ;
jl. i10. ; goto message buffer checked;
; check that the buffer is a message sent to the driver:
sh w1 -1 ; if message received then
ac w1 x1 ; receiver := - receiver;
sh w1 7 ; if receiver <= 7 then
jl. i10. ; goto message buffer checked; i.e. an answer
rl w0 x1+a10 ; w0 := kind(receiver);
sn w0 64 ; if kind = pseudo process then
rl w1 x1+a50 ; receiver := mainproc (receiver);
sz w0 -1-64 ; if receiver is neither internal process nor
rl w1 x1+a250 ; pseudo process then
se w1 (b1) ; receiver := driverproc (receiver);
jl. i10. ; if receiver <> cur then goto message checked;
; now buf has shown out to be a message, sent to this driver
; w2 = sender(buf), w3 = buf
rl w0 x2+a10 ; w0 := kind(sender);
sn w0 64 ; if kind = pseudo process then
rl w2 x2+a50 ; sender := mainproc (sender);
sz w0 -1-64 ; if sender neither internal nor pseudo process then
rl w2 x2+a250 ; sender := driverproc (sender);
; w2 = internal process, which sent the message buffer
; w3 = message buffer
dl w1 x3+a152 ; w0w1 := first,last address(buf); (logic addresses)
la. w0 h26. ; make the limits even;
la. w1 h26. ;
sl w0 x1+1 ; if first address > last address then
jl. i10. ; goto message checked;
sl w0 (x2+a17) ; if first,last address area outside
sl w1 (x2+a18) ; the senders area then
jl. i10. ; goto message checked;
al w1 x1+2 ; first of sender area := first address;
ds. w1 h16. ; top - - - := last address + 2;
rs. w2 h17. ; save sender process description address;
; message buffer consistency checked:
; prepare moving of the channel program, i.e. get first,last of
; channel program area in device descr, and transform them to absolute
; addresses.
; check that the channel-program-source starts within the driver process.
;
; (all regs irrell)
i10: ; message checked:
rl. w1 h5. ; device descr := saved descr;
dl w3 x1+a227 ; abs first of chp area in device descr :=
wa w2 2 ; device descr + relative first of chp area;
wa w3 2 ; abs top of chp area in device descr :=
ds. w3 h21. ; device descr + relative top of chp area;
rl w1 b1 ; w1 := cur;
rl w3 x1+a29 ; first of channel program := save w1 (cur);
sl w3 (x1+a17) ; if first of channel program
sl w3 (x1+a18) ; is outside current process then
jl c29 ; goto internal 3;
wa w3 x1+a182 ; w3 := first of channel program
al w3 x3-2 ; + base (cur) - 2; i.e. last of entry
al w2 x2-2 ; w2 := last of current entry in device descr;
; next command:
; w1 = cur
; w2 = last of current entry in device descr (abs addr)
; w3 = last of current entry in driver process (abs addr)
i15: al w2 x2+j20 ; next command: increase(device pointer);
sl. w2 (h21.) ; if outside top of device descr area then
jl c29 ; goto internal 3; i.e. channel program too long
rs. w2 h22. ; save (last of current device entry);
i16: rl w1 b1 ; skip command:
al w3 x3+a320 ; increase(driver pointer);
sl w3 0 ; if overflow or
sl w3 (x1+a18) ; outside top of driver process then
jl c29 ; goto internal 3;
; move the command unchanged from driver area to device description:
dl w1 x3+j14 ; move (param 1, param 2);
ds w1 x2+j24 ;
rl w0 x3+j12 ; move (command);
rs w0 x2+j22 ;
sz. w0 (h30.) ; if command is not databuffer without skip then
jl. i30. ; goto test chain;
; the command is sense, control, read or write with databuffer.
; param 1 (i.e. the first logic addr) must be transformed to an absolute
; address, using the address code.
; check that the char count is not too small (command dependant).
;
; w0 = command word
; w1 = param 2 (=char count)
sz w0 j30 ; minimum := if not sense command then
am -j31+1-1; 0 else sense-char-count;
sh w1 j31-1 ; if char count < minimum then
jl c29 ; goto internal 3;
; compute size (and thereby last) of data buffer area
al w0 0 ; words := chars // number of chars per word;
wd. w1 h27. ;
ls w1 1 ; last byte used := words * 2
sn w0 0 ; - if chars mod (chars per word) = 0 then
al w1 x1-2 ; 2 else 0;
rl w0 x3+j13 ; w0 := first logic address;
wa w1 0 ; w1 := last logic address; (=last byte+first logic)
sl w0 x1+3 ; if first address > last address then
jl c29 ; goto internal 3; i.e. buffer wraps around top of core
; w0 = first logic address
; w1 = last logic address
; w3 = abs last of current chp entry
bz w2 x3+j12 ; w2 := address code(current command);
sh w2 j1-1 ; if address code inside limits then
jl. (x2+h1.) ; switch out through address code table;
jl c29 ; else goto internal 3; i.e. illegal address code
; address transformation actions:
; address code = sender area:
; w0 = first logic address
; w1 = last logic address
f10: sl. w0 (h15.) ; if buffer area outside sender area then
sl. w1 (h16.) ;
jl. i3. ; goto address error;
rl. w2 h17. ; sender descr := saved sender process descr;
rs. w2 h10. ; sender area used := true;
wa w0 x2+a182 ; transform first address to absolute address;
jl. i20. ; goto first address transformed;
; address code = driver area
; w0 = first logic address
; w1 = last logic address
f11: rl w2 b1 ; driver := cur;
sl w0 (x2+a17) ; if buffer area outside driver process then
sl w1 (x2+a18) ;
jl c29 ; goto internal 3;
rs. w2 h11. ; sender area used := true;
wa w0 x2+a182 ; transform first address to absolute address;
jl. i20. ; goto first address transformed;
; address code = device description
; w0 = first relative address
; w1 = last relative address
f12: rl. w2 h5. ;
sl w0 (x2+a220) ; if buffer area outside
sl w1 (x2+a221) ; private area (device descr) then
jl c29 ; goto internal 3;
wa w0 4 ; transform first relative address to absolute addr;
jl. i20. ; goto first address transformed;
; address code = message buffer
; w0 = first relative address
; w1 = last relative address
f13: sl w0 a145 ; if buffer area outside
sl w1 a146 ; message part of message buffer then
jl c29 ; goto internal 3;
rl w2 b1 ; buf := save w2 (cur);
wa w0 x2+a30 ; transform first relative address to absolute addr;
sh w0 x1 ; if buf <> 0 then
jl. i20. ; goto first address transformed
jl c29 ; else goto internal 3;
; address code = abs core address
; w0 = absolute first address
; w1 = absolute last address
f14: ; continue with first address transformed
; the legality of the buffer addresses has been checked,
; and the first address is now an absolute core address
; w0 = abs first address
; w3 = last of current chp entry
i20: ; first address transformed:
rl. w2 h22. ; restore (device pointer);
rs w0 x2+j23 ; move abs first address to channel program;
; now a complete command has been moved.
; check that the command does not change during data- or skip-chain
; w2 = last of device descr chp entry
; w3 = last of current chp entry
i30: ; test chain:
bl w0 x2+j22+1 ; command := command byte(current entry);
sn w0 j37 ; if command = dummy command then
jl. i16. ; goto skip command;
rl. w1 h23. ; prev command := old command;
rs. w0 h23. ; old command := command;
sz w1 j35 ; if previous command contained any chains then
jl. i31. ; begin
jl. i32. ; test that the two commands are equal:
i31: lx w1 0 ; if prev command <> command then
sz w1 j36 ; goto internal 3;
jl c29 ; end;
i32: ;
; to facilitate the drivers interpretation from the sense-commands,
; the first word of the sense area is cleared.
; thereby the driver can detect in a simple way, if that sense
; has been executed.
;
; w0 = command (sign extended)
; w2 = last of device descr chp entry
; w3 = last of current chp entry
sz w0 j34 ; if command = sense without skip then
jl. i33. ; begin
al w1 0 ; top chp addr (sense area) := 0;
am (x2+j23) ;
rs w1 +a315 ;
i33: ; end;
; a driver-supplied channel program may not contain a 'wait'-command,
; because this migth delay the terminating interrupt infinitly,
; thereby preventing the processes from being stopped.
;
; w0 = command (sign extended)
; w2 = last of device descr chp entry
; w3 = last of current chp entry
la. w0 h36. ; w0 := command bits of command;
sn w0 j32 ; if command = 'wait' then
jl c29 ; goto internal 3;
; if the channel program has not encountered the 'stop'-command
; then move and translate the next command
;
; w0 = command (sign extended)
; w2 = last of device descr chp entry
; w3 = last of current chp entry
rl w1 b1 ; w1 := cur;
se w0 j33 ; if command <> 'stop' then
jl. i15. ; goto next command;
; (maybe it should be tested, that param 1 = 0, i.e. not a 'jump' ?)
; rl w0 x2+j23 ;
; se w0 0 ;
; jl. jump-command
; get the timeout-parameter from param 2 of the 'stop' command:
rl w0 x2+j24 ; timeout := param 2;
; in case of transfer to/from senders area:
; check that the sender is not stopped
; increase stopcount to prevent further stopping of sender
;
; w0 = timeout
; w1 = driver
rl. w3 h10. ; if sender area used then
sn w3 0 ;
jl. i40. ; begin
rl. w3 h17. ; sender := saved sender descr addr;
bz w2 x3+a13 ; if state(sender) shows
se w2 a99 ; 'waiting for start' then
sn w2 a100 ;
jl. i2. ; goto sender stopped;
bz w2 x3+a12 ; increase (stopcount (sender));
al w2 x2+1 ;
hs w2 x3+a12 ;
i40: ; end;
; the driver should actually be put in such a state, that all pending
; transfers would be aborted, in case the driver is stopped.
; however, until further, this is only done by means of increasing
; the stopcount of the driver ( *** independant of transfer/no transfer
; to/from the driver area *** )
;
; w0 = timeout
; w1 = driver
; w3 = transfer code: 0 = no transfer to sender area
; >0 = sender descr addr
c.-1 ; ++++ not implemented ++++
rl. w2 h11. ;
sn w2 0 ; if driver area not used then
jl. i41. ; goto init transfer code field;
z. ; ++++
al w3 x3+1 ; make transfer code odd; i.e. driver transfer
bz w2 x1+a12 ; increase (stopcount (driver) );
al w2 x2+1 ;
hs w2 x1+a12 ;
c. -1; ++++ not implemented
i41: sn w3 0 ; if no transfers to the involved processes then
al w3 -1 ; transfer code := -1; i.e. transfer pending;
z. ; ++++
; initialize the 'transfer code' field in the device description
; (the field will be used, when the interrupt arrives,
; to decrease the involved stopcounts)
; w0 = timeout, w1 = cur, w3 = transfer code
i50: rl. w2 h5. ;
rl w1 x2+a225 ; if transfer code (device descr) <> 0 then
se w1 0 ; goto internal 3;
jl c29 ; (i.e. transfer still in progress)
rs w3 x2+a225 ; move transfer code to device descr;
; prepare timeout-operation:
;
; w0 = timeout
; w2 = device descr
; initialize controller table:
am (b1) ;
rl w3 +a31 ; entry:=logical device addr(device);
wa. w3 h25. ; + 1 < 23
wa w3 b65 ; base of controller table;
rl. w1 h20. ; chp start (controller table entry) :=
rs w1 x3+a310 ; abs first of channel program area;
se w1 0 ; if chpg start = 0 then
jl. i54. ; begin
al w2 x2+a242 ; oper:= timeout operation address;
jl. i53. ; goto check timeout;
; end;
; prepare for receiving an unusual status, i.e. in case the controller
; could not deliver the standard status informations
i54: al w3 0 ;
rs w3 x2+a230 ; chp addr (std status) := 0;
al w3 j40 ;
rs w3 x2+a233 ; event status (std status) := status transfer error;
al w2 x2+a242 ; oper := timeout operation address;
; start the device:
;
; at this point the monitor migth introduce another strategy,
; instead of just starting the device immediatly.
; if the interrupt numbers are sparce, or if the bus migth
; get overloaded, the actual starting can be delayed until
; the resources are sufficient.
;
; notice that the monitor/driver conventions do not imply that
; the transfer is started at once, i.e. buserrors or bustimeout
; etc. are not returned to the driver at the calltime, but
; when the interrupt-operation is received by the driver.
;
; under any circumstances the driver should have the result 0,
; indicating that the transfer has been accepted to start.
;
; w0 = timeout
; w2 = timeout operation
am (b1) ;
bz w1 +a31+1 ;
ls w1 -2 ; w1:=io-devno<1;
do w1 (x2-a242+a235) ; start device(device addr(device desc));
sx 2.111 ; if any exceptions then
jl. i55. ; goto not started;
; if the operation is in queue, there may be three reasons:
; 1. a wait program is still in progress, i.e. in timeout-queue
; (remove the operation and proceed, i.e. regret the wait-program)
; 2. a wait program is terminated by an event, i.e. in event queue
; (the operation may not be removed, because the driver has to
; reset the controller in order to proceed)
; 3. an uspecified channel program has terminated, i.e. in event queue
; (this situation is treated as if it was a wait-program,
; because it does not harm the monitor, but only confuses
; the driver process)
i53: ; check timeout:
sn w2 (x2+0) ; if timeout operation in queue then
jl. i52. ; begin
; search through the timeout-queue.
; if the operation is found here, then simply remove it and proceed,
; as if it had not been in queue
; if not found here, it must be in the event-queue of the driver.
; (just leave it there, because the driver must take proper action on it)
al w1 b69 ; elem := timeout-queue head;
i51: rl w1 x1+0 ; rep: elem := next(elem);
sn w1 b69 ; if end of timer-queue then
jl. i0. ; goto result 0; i.e. in event queue
se w1 x2 ; if elem = timeout operation then
jl. i51. ; goto rep;
; found in timeout-queue:
jl w3 d5 ; remove(timeout operation);
i52: ; end;
; w0 = timeout
; w2 = timeout operation
al w1 b69 ; head := timeout queue head;
rs w0 x2-a242+a244; save timeout in timeout-field(operation);
se w0 0 ; if timeout <> 0 then
jl w3 d6 ; link (timeout queue, timeout operation);
jl. i0. ; goto result 0; i.e. transfer started ok;
; the transfer could not actually be started, because of
; some kind of bus/controller error.
;
; the interrupt operation must be returned to the driver,
; together with indication of the kind of malfunction.
;
; w2 = linkfield of timeout operation
; ex = error kind
i55: sx 2.1 ; errorkind :=
am 1-2 ; if rejected then 1
al w0 2 ; else 2;
al. w3 i0. ; deliver interrupt(oper, error kind);
jl d121 ; goto result 0;
e. ; end of start i/o;
c.a400-1
\f
m. coroutine monitor
;************************** c o r o u t i n e m o n i t o r *************************
; locations in process extension 1 are used by cmonprocedures as described below:
;
; -2: signalch
; b27 +0: start
; +2: check_eventqueue
; +4: check_eventqueue
; +6:
; +8: generate_testoutput
; +10: inspect_chained
; +12: inspect_chained
; +14: timermess
; +16: timerscan
; +18: timerscan
; +20: generate_testoutput
; +22: " - "
; +24: " - "
\f
b.h50 w.
; procedure remove(elem);
;
; removes a given element from its queue and leaves the element
; linked to itself.
;
; call return
; w0: - unchanged
; w1: - next(elem)
; w2: elem elem
; w3: link link
h0: rl w1 x2 ; begin
rx w2 x2+2 ; prev(elem):= elem;
rs w1 x2 ; next(prev(elem)):= next(elem);
rx w2 x1+2 ; prev(next(elem)):= old prev(elem);
rs w2 x2 ; next(elem):= elem;
jl x3 ; end;
; procedure link(head,elem);
;
; links the element to the end of the queue;
;
; call return
; w0 - destroyed
; w1 head head
; w2 elem elem
; w3 link old last(head)
h1: al w0 x3 ; begin
rl w3 x1+2 ; old prev:= last(head);
rs w2 x1+2 ; prev(head):= elem;
rs w2 x3+0 ; next(old prev):= elem;
rs w1 x2+0 ; next(elem):= head;
rs w3 x2+2 ; prev(elem):= old prev;
rl w3 0 ;
jl x3 ; end;
\f
; procedure get_mess_ext(ref);
;
; returns a reference to the first free message buffer extension
; or 0 if no extensions are available. the extension is removed from the chain.
;
; call return
; w0: - destroyed
; w1: - destroyed
; w2: - ref or 0
; w3: link link
b.j5 w.
h7: rl w1 b28 ; begin
rl w2 x1+a588 ; ref:= cur.ext2.buffer_extension_head;
sn w2 0 ; if ref <> 0 then
jl. j0. ; begin
rl w0 x2 ; cur.ext2.buffer_extension_head:= next(ref);
rs w0 x1+a588 ;
al w2 x2+2 ; ref:= ref+2;
; end;
j0: jl x3 ; end;
e.
\f
; procedure answer arrived(buf,ref);
;
; is called from procedure 'check_event_queue' when an answer appears in
; the event queue and 'ref.open' is true, i. e. when a coroutine has
; called 'cwaitanswer(buf)'. the coroutine is activated and the answer
; descriptor is closed.
;
; call return
; w0: - destroyed
; w1: ref destroyed
; w2: buf buf
; w3: link link
b.j5 w.
c106: am (b27) ; begin
ds w3 +6 ; ext1(4,6):= (buf,link);
am (b28) ;
rl w3 +a544 ;
sn w3 0 ; if testoutput active
jl. j0. ; then generate testoutput(1<6);
jl. w3 h4. ;
3<22+1<6 ;
j0: al w0 0 ;
hs w0 x1 ; ref.open:= false;
rl w2 x1+2 ; corout:= ref.param1;
al w1 1 ; result:= ok;
rl w0 x2+a698 ; priority:= corout.priority;
jl. w3 c100. ; start(corout,priority,ok);
am (b27) ;
dl w3 +6 ; (buf,link):= ext1(4,6);
jl x3 ; end;
e.
\f
; procedure central wait;
;
; central waiting point in coroutine system. checks the eventqueue
; and schedules pending events. if the active queue is empty the
; monitor procedure wait event is called otherwise the first co-
; routine is started. if 'corout.user_exit' <> 0 a jump to 'user_exit' is
; made with register contents:
; w0: -
; w1: -
; w2: current_coroutine
; w3: link
b.j5
w.
h2: ; begin
; repeat
j0: jl. w3 h6. ; check event queue;
rl w2 b28 ; if active queue empty then
rl w3 x2+a546 ; begin
se w3 x2+a546 ; buf:= cur.ext2.last event;
jl. j1. ; wait event(buf,result);
rl w2 x2+a582 ;
jd 1<11+24 ;
jl. j0. ;
; end;
j1: al w2 x3-2 ; until active queue not empty;
rs w2 (b28) ; corout:= first in active queue;
rl w1 x2+a720 ; if corout.user_exit <> 0
se w1 0 ; then jump to user_exit;
jl w3 x1 ;
rl w3 (b28) ;
dl w1 x3+a712 ;
rl w2 x3+a714 ; restart corout;;
jl (x3) ; end;
e.
\f
; procedure check eventqueue;
;
; inspects the eventqueue starting at 'last event'('last event' = 0
; if the queue must be inspected from the start). pending events
; which have arrived after 'last event' are scheduled if
; 'event descriptor.open' = true. the scheduling is performed by calling
; either a 'cmon'-standard procedure (even procedure number in event
; descriptor) or a user defined procedure (odd procedure number which
; is used as index in the procedure table in process extension 2).
;
; a procedure ('user' or 'cmon') which is used for scheduling answers or messages
; must return with w2=0 if the answer/message is removed from the event queue
; - otherwise with w2='buf' ; i. e. the event queue must be inspected from the
; start when an event is removed by a scheduling procedure.
; exit to 'cmon'- or user-procedure with:
; w0: -
; w1: ref(event descriptor)
; w2: buf
; w3: link
b. j10 w.
h6: am (b27) ; begin
rs w3 +2 ; ext1(2):= link;
rl w3 b28 ;
rl w2 x3+a582 ; last_buf:= cur.ext2.last_event;
j0: jd 1<11+66 ; repeat
rl w3 b28 ;
sh w0 -1 ; test_event(last_buf,buf,result);
jl. j5. ; if result <> empty then
se w0 0 ; begin
jl. j2. ; if result = message
rl w1 x2+4 ;
ac w1 x1 ;
se w1 (b1) ; then ref:=
jl. j1. ; if buf.receiver = cur then cur.ext2.messdescr
rl w1 x3+a584 ; else buf.receiver.messdescr <* pseudoprocess *>
jl. j2. ;
j1: rl w1 x1+a60 ; else <* answer *> ref:= buf.ref;
j2: hl w0 x1 ;
sn w0 0 ;
jl. j0. ; if ref.open then
hl w0 x1+1 ; begin
sz w0 1 ; if even procedure number
jl. j3. ; then call cmonproc(buf,ref);
am (0) ;
jl w3 (130) ;
jl. j0. ; else
j3: ; begin <* odd procedure number *>
rl w3 x3+a586 ; <* use procedure number in event *>
hl w0 x1+1 ; <* descriptor as index in proce- *>
ls w0 +1 ; <* dure table in cur.ext2 *>
wa w0 x3 ;
am (0) ;
jl w3 (0) ; call userproc(buf,ref);
jl. j0. ; end;
; end;
; end;
; until result = empty;
j5: sn w2 0 ; <* if 'last_buf' points at a message , 'last_event'
jl. j6. ; <* must be reset as the message may be regretted
rl w0 x2+4 ; <* before next scan.
se w0 0 ;
sz w0 -8 ; cur.ext2.last_event:= if last_buf points at message
al w2 0 ; then 0
j6: rs w2 x3+a582 ; else last_buf;
am (b27) ; link:= ext1(2);
jl (2) ; end;
e.
\f
; procedure entry pass(priority);
;
; pending events are scheduled and calling coroutine is restarted
; with the priority given in call.
;
; call return
; w0: priority destroyed
; w1: - destroyed
; w2: - destroyed
; w3: link current coroutine
b.j5 w.
c102: am (b28) ; begin
rs w3 (0) ; current_coroutine.ic:= link;
am (b28) ;
rl w3 +a544 ;
sn w3 0 ; if testoutput active
jl. j0. ; then generate testoutput(testkind);
jl. w3 h4. ;
3<22+1<2 ;
j0: rl w2 (b28) ;
rl w1 x2+a710 ; result:= current_coroutine.result;
jl. w3 c100. ; start(current_coroutine,priority,result);
jl. h2. ; central wait;
e. ; end;
\f
; procedure entry inspect(priority,result);
;
; schedules pending events and checks if the active queue contains
; coroutines with priority higher than the call parameter 'priority'. in
; this case 'result' returns true (1).
;
; call return
; w0: priority result
; w1: - destroyed
; w2: - destroyed
; w3: link current coroutine
b.j5 w.
c103: am (b28) ; begin
rs w3 (0) ; current_coroutine.ic:= link;
am (b28) ;
rl w3 +a544 ;
sn w3 0 ; if testoutput is active then
jl. j0. ; generate testoutput(1<3);
jl. w3 h4. ;
3<22+1<3 ;
j0: rs w0 (b27) ; ext1(0):= priority;
jl. w3 h6. ; check_event_queue;
rl w0 (b27) ; priority:= ext1(0);
rl w3 b28 ;
rl w3 x3+a546 ; corout:= first in active queue;
sl w0 (x3-4) ;
am -1 ; result:= corout.prio > priority;
al w0 1 ;
rl w3 (b28) ;
jl (x3) ; end;
e.
\f
; procedure entry start(corout,priority,result);
;
; removes the coroutine from its queue (normally the timer queue) and
; inserts it in active queue according to the call parameter 'priority'.
; the call parameter 'result' is returned in w0 of
; the coroutine which is activated.
;
; call return
; w0: priority destroyed
; w1: result destroyed
; w2: corout corout
; w3: link current coroutine
b.j5
w.
c100: rs w3 (b27) ; begin
am (b28) ;
rl w3 +a544 ;
sn w3 0 ; if testoutput is active then
jl. j0. ; generate testoutput(1<0);
jl. w3 h4. ;
3<22+1<0 ;
j0: rs w1 x2+a710 ; corout.result:= result;
rs w0 x2+a698 ; corout.priority:= priority;
al w2 x2+2 ;
jl. w3 h0. ; remove(corout);
rl w1 0 ;
al w0 x2 ;
rl w2 b28 ; worse:= rear of active queue;
al w3 x2+a546 ; while worse.prio > prio and
al w1 x1+1 ; worse <> active queue head do
j1: rl w3 x3+2 ; worse:= prev(worse);
sn w3 x2+a546 ;
jl. j2. ; 'insert corout in the rear of
sh w1 (x3-4) ; other coroutines of the same
jl. j1. ; priority'
j2: rl w1 x3 ;
rl w2 0 ;
jl. w3 h1. ; link(worse,corout);
al w2 x2-2 ;
rl w3 (b28) ;
am (b27) ;
jl (0) ; end;
e.
\f
; procedure entry wait(timer,result);
;
; calling coroutine is suspended for max 'timer' seconds.
; 'timer' = 0 indicates no timeout. the return parameter 'result'
; indicates whether the coroutine was started by timeout or by
; the arrival of an internal or external event.
;
; call return
; w0: timer result
; w1: - destroyed
; w2: - -
; w3 link current coroutine
b.j5
w.
c101: am (b28) ; begin
rs w3 (0 ) ; current coroutine.return:= link;
am (b28) ;
rl w3 +a544 ;
sn w3 0 ; if testoutput active then
jl. j0. ; generate testoutput(1<1);
jl. w3 h4. ;
3<22+1<1 ;
j0: rl w2 (b28) ; current coroutine.timer:= timer;
rs w0 x2+a706 ;
al w2 x2+2 ;
jl. w3 h0. ; remove(current coroutine);
rl w3 b28 ;
al w1 x3+a552 ;
jl. w3 h1. ; link(timer queue head,current coroutine);
jl. h2. ; central wait;
; end;
e.
\f
; procedure entry csendmessage(mess,name,buf);
;
; allocates a message buffer extension and prepares it for cwaitanswer.
; then calls sendmessage.
;
; return parameter 'buf': 0 buffer claims exceeded
; 1 no free extensions
; >1 message buffer address
;
; call return
; w0: - destroyed
; w1: mess destroyed
; w2: name buffer address (or 0 or 1)
; w3: link current coroutine
b.j5,i5 w.
c104: am (b28) ; begin
rs w3 (0) ; current_coroutine.ic:= link;
am (b28) ;
rl w3 +a544 ;
sn w3 0 ;
jl. j0. ; if testoutput active
jl. w3 h4. ; then generate_testoutput(1<4);
3<22+1<4 ;
j0: ds w2 (b27) ;
jl. w3 h7. ; get_mess_ext(ref);
sn w2 0 ; if ref <> 0 <* extension available *> then
jl. j1. ; begin
rl. w0 i0. ; <* initialize answer descriptor *>
rs w0 x2 ; ref.open:= false; ref.proc:= 12;
rl w3 b27 ;
rs w2 x3+2 ; ext1(2):= ref;
rl w1 x3-2 ;
rl w3 x3 ; send message(mess,name,buf,ref);
jd 1<11+16 ;
se w2 0 ; if buffer claims exceeded
jl. j2. ; then release message buffer extension;
am (b27) ;
rl w1 (+2) ;
rl w3 b28 ;
al w0 x1-2 ;
rx w0 x3+a588 ;
rs w0 x1-2 ;
jl. j2. ;
j1: al w2 1 ; end
j2: rl w3 (b28) ; else buf:= 1; <* no free extensions *>
jl (x3) ; end;
i0: 0<12+12 ; answer descriptor init (open=false,proc='answer_arrived')
e.
\f
; procedure entry cwaitanswer(buf,timer,result);
;
; prepares the message buffer extension for receiving the answer. if
; the buffer has been answered, 'last_event' is reset as the buffer
; may have been skipped during an earlier inspection of the event queue.
; the coroutine waits for max. 'timer' seconds for the answer. when the
; coroutine is restarted the action depends on 'result':
;
; result = timeout : the answer descriptor is closed
;
; result = answer arrived : the answer is received in the answer
; area in process extension 2 and the message
; buffer extension is released.
;
; call return
; w0: timer result (timeout:0,wait_answer result:1,2,3,4,5)
; w1: - answer area in ext2 if result <> timeout
; w2: buf buf
; w3: link current coroutine
b.j10 w.
c105: rs w3 (b27) ; begin
am (b28) ;
rl w3 +a544 ;
sn w3 0 ;
jl. j0. ; if testoutput active
jl. w3 h4. ; then generate_testoutput(1<5);
3<22+1<5 ;
j0: rl w3 (b28) ;
rl w1 (b27) ; current_coroutine.return:= link;
ds w2 x3+a724 ; current_coroutine.buf:= buf;
rs w0 (b27) ; ext1(0):= timer;
rl w1 x2-2 ; with buf.ref do
al w0 1 ; begin
hs w0 x1 ; open:= true;
rs w3 x1+2 ; corout:= current_coroutine;
; end;
rl w0 x2+4 ;
sz w0 -8 ; if buf.state = answer pending
jl. j1. ; then last_event:= 0; <* inspect from start *>
al w0 0 ;
am (b28) ;
rs w0 +a582 ;
j1: rl w0 (b27) ; timer:= ext1(0);
jl. w3 c101. ; wait(timer,result);
rl w2 x3+a724 ; buf:= current_coroutine.buf;
rl w1 x2-2 ; ref:= buf.ref;
se w0 0 ; if result = timeout
jl. j2. ; then ref.open:= false
hs w0 x1 ;
jl. j4. ; else
j2: ; begin <* result = answer arrived *>
rl w3 b28 ; release message buffer extension;
al w0 x1-2 ;
rx w0 x3+a588 ;
rs w0 x1-2 ;
se w2 (x3+a582) ;
jl. j3. ;
al w0 0 ; if buf = last_event then last_event:= 0;
rs w0 x3+a582 ;
j3: al w1 x3+a590 ;
jd 1<11+18 ; wait answer(buf,cur.ext2.answer_area);
j4: rl w3 (b28) ; end;
jl (x3+a722) ; end;
e. ; end;
\f
; procedure entry signal binary(sem);
; procedure entry signal(sem);
;
; call return
; w0: - destroyed
; w1: - destroyed
; w2: sem destroyed
; w3: link current coroutine
b.j5 w.
c107: am 1 ; signal_binary:
c108: al w0 0 ; signal:
am (b28) ; begin
rs w3 (0) ;
am (b28) ;
rl w3 +a544 ;
sn w3 0 ; if testoutput active
jl. j0. ; then generate_testoutput(1<7);
jl. w3 h4. ;
3<22+1<7 ;
j0: rl w1 x2+4 ; with sem do
al w3 x1+1 ; begin
se w0 0 ; count:= count+1;
la w3 0 ; if binary
rs w3 x2+4 ; then count:= count and 1;
sl w1 0 ; if count <= 0 then
jl. j1. ; begin
rl w2 x2 ; corout:= next(sem);
jl. w3 h0. ; remove(corout);
al w2 x2+6 ;
rl w0 x2+a698 ; priority:= corout.prio;
al w1 1 ; result:= ok;
jl. w3 c100. ; start(corout,priority,result);
j1: rl w3 (b28) ; end;
jl (x3) ; end;
e. ; end;
\f
; procedure entry wait_semaphore(sem);
;
; call return
; w0: - destroyed
; w1: - destroyed
; w2: sem destroyed
; w3: link current coroutine
b.j5 w.
c109: am (b28) ; begin
rs w3 (0) ;
am (b28) ;
rl w3 +a544 ;
sn w3 0 ; if testoutput active
jl. j0. ; then generate_testoutput(1<8);
jl. w3 h4. ;
3<22+1<8 ;
j0: rl w1 x2+4 ; with sem do
al w1 x1-1 ; begin
rs w1 x2+4 ; count:= count-1;
rl w3 (b28) ;
sl w1 0 ; if count < 0 then
jl (x3) ; begin
rl w1 x3 ;
rs w1 x3+a722 ; current_coroutine.return:= link;
al w1 x2 ; head:= sem.coroutine_queue_head;
al w2 x3-6 ; elem:= current_coroutine.sem_queue_elem;
jl. w3 h1. ; link(head,elem);
al w0 0 ; timer:= 0 <* no timeout *>
jl. w3 c101. ; wait(timer);
rl w3 (b28) ; end;
jl (x3+a722) ; end with;
e. ; end;
\f
; procedure entry signal_chained(sem,oper);
;
; signals an operation to a chained semaphore. if the coroutine queue of
; the semaphore contains a coroutine which is waiting for an operation
; of this type,the coroutine is started. otherwise the operation is
; queued to the semaphore.
;
; two reserved types exist:
; 1<0: message
; 1<1: answer
;
; call return
; w0: - destroyed
; w1: operation destroyed
; w2: semaphore destroyed
; w3: link current coroutine
b.j10 w.
c110: am (b27) ; begin
rs w3 -2 ;
am (b28) ;
rl w3 +a544 ;
sn w3 0 ;
jl. j0. ; if testoutput active
jl. w3 h4. ; then generate_testoutput(1<9);
3<22+1<9 ;
j0: rl w3 x2 ; head:= sem.coroutine_queue_head;
j1: sn w3 x2 ; corout:= next(head); found:= false;
jl. j4. ; while corout <> head and -, found do
rl w0 x3-a694+a708; if logand(corout.mask,oper.type) <> 0 then
la w0 x1+4 ; begin
se w0 0 ;
jl. j3. ; found:= true;
rl w3 x3 ;
jl. j1. ;
j3: rs w1 x3-a694+a724; corout.latop:= operation;
rl w0 x1+4 ; type:= oper.type;
al w2 x3 ;
jl. w3 h0. ; remove(corout);
al w2 x2-a694 ;
rl w1 0 ; result:= type;
rl w0 x2+a698 ; priority:= corout.prio;
jl. w3 c100. ; start(corout,priority,result);
jl. j5. ; end
; else corout:= next(corout);
j4: rx w2 2 ; if -,found
al w1 x1+4 ; then link(sem.operation_queue,oper);
jl. w3 h1. ;
j5: rl w3 (b28) ;
am (b27) ;
jl (-2) ; end;
e.
\f
; procedure entry inspect_chained(sem,mask,oper,result);
;
; checks if 'sem_operation_queue' contains an operation which matches 'mask'.
; if no matching operation is found, 'oper' returns = 0,
; otherwise 'oper' refers to the first matching operation.
; 'result' returns 'true' (1) if the active queue contains coroutines of
; priorities higher than the priority of calling coroutine.
;
; call return
; w0: - (result= 0,1)
; w1: mask oper or 0
; w2: sem sem
; w3: link current coroutine
b.j10 w.
c111: am (b28) ; begin
rs w3 (0) ;
am (b28) ;
rl w3 +a544 ;
sn w3 0 ; if testoutput active
jl. j0. ; then generate_testoutput(1<10);
jl. w3 h4. ;
3<22+1<10 ;
j0: am (b27) ;
rs w2 +12 ; save(sem);
al w0 x1 ;
rl w1 x2+4 ; head:= sem.operation_queue_head;
j1: ; oper:= next(head); found:= false;
sn w1 x2+4 ; while oper <> head and -,found do
jl. j3. ; if logand(oper.type,mask) <> 0
rl w3 x1+4 ; then found:= true
la w3 0 ; else oper:= next(oper);
se w3 0 ;
jl. j4. ;
rl w1 x1 ;
jl. j1. ;
j3: al w1 0 ; if -,found then oper:= 0;
j4: rl w3 (b28) ;
rl w0 x3+a698 ; priority:= current_coroutine.prio;
rl w2 b28 ;
rl w2 x2+a546 ; corout:= first in active queue;
sh w0 (x2-4) ;
am -1 ;
al w0 1 ; result:= corout.prio > priority;
am (b27) ;
rl w2 +12 ;
jl (x3) ; end;
e.
\f
; procedure entry wait_chained(sem,mask,timer,oper);
;
; if 'sem.operation_queue' contains an operation
; which matches 'mask', the operation is removed from the queue . a 'pass'
; is executed if the active queue contains coroutines of priorities higher
; than the priority of calling coroutine. if no matching operation is found
; pending events are scheduled and the calling coroutine waits for max. 'timer'
; seconds for an operation to arrive.
;
; if the operation contains a message or an answer ('oper.type' = 1<0 or 1<1 ,
; resp ) , the buffer contents is copied to the common message-answer area in
; process extension 2. a buffer containing an answer is removed from the event
; queue by 'waitanswer'.
;
;
; call return
; w0: timer result ( 0(timeout) or oper.type)
; w1: mask oper (undefined if result = timeout)
; w2: sem destr.
; w3: link current_coroutine
b.j10 w.
c112: rs w3 (b27) ; begin
am (b28) ;
rl w3 +a544 ;
sn w3 0 ; if testoutput active
jl. j0. ; then generate_testoutput(1<11);
jl. w3 h4. ;
3<22+1<11 ;
j0: rx w1 (b27) ;
rl w3 (b28) ;
rs w1 x3+a722 ; current_coroutine.return:= link;
rx w1 (b27) ; current_coroutine.waitch_mask:= mask;
ds w1 x3+a708 ; current_coroutine.timer:= timer;
jl. w3 c111. ; inspect_chained(sem,mask,oper,result);
se w1 0 ; if oper = 0 then
jl. j1. ; begin <* wait in semaphore queue *>
al w1 x2 ; head:= sem.coroutine_queue_head;
al w2 x3+a694 ; elem:= current_coroutine.sem_queue_elem;
jl. w3 h1. ; link(head,elem);
rl w0 x2-a694+a706 ; timer:= current_coroutine.timer;
jl. w3 c101. ; wait(timer,result);
se w0 0 ; if result = timeout then
jl. j3. ; begin
rs w0 x3+a710 ; current_coroutine.result:= timeout;
al w2 x3+a694 ; elem:= current_coroutine.sem_queue_elem;
jl. w3 h0. ; remove(elem);
jl. j6. ; goto exit;
; end;
; end;
j1: rs w1 x3+a724 ; current_coroutine.latop:= oper;
rl w2 x1+4 ;
rs w2 x3+a710 ; current_coroutine.result:= oper.type;
al w2 x1 ;
jl. w3 h0. ; remove(oper);
rl w3 (b28) ; if waiting <* coroutines of higher
sn w0 0 ; priority in active queue *> then
jl. j2. ; begin
rl w0 x3+a698 ; priority:= current_coroutine.prio;
jl. w3 c102. ; pass(priority);
; end;
j2: rl w0 x3+a710 ;
j3: sz w0 -4 ; if oper.type = message or answer then
jl. j6. ; begin
rl w2 x3+a724 ; oper:= current_coroutine.latop;
rl w3 b28 ;
rl w2 x2+8 ; buf:= oper.buf;
se w0 1<1 ; if oper.type = answer then
jl. j5. ; begin
se w2 (x3+a582) ;
jl. j4. ; if buf = last_event
al w0 0 ; then last_event:= 0;
rs w0 x3+a582 ;
j4: al w1 x3+a590 ; area:= common message-answer area;
jd 1<11+18 ; waitanswer(buf,area);
jl. j6. ; end
j5: al w1 x3+a590 ; else
dl w0 x2+10 ; begin <* message *>
ds w0 x1+2 ;
dl w0 x2+14 ;
ds w0 x1+6 ;
dl w0 x2+18 ; <* copy to common massage-answer area *>
ds w0 x1+10 ;
dl w0 x2+22 ;
ds w0 x1+14 ; end;
; end;
j6: rl w3 (b28) ; exit:
rl w0 x3+a710 ; result:= current_coroutine.result;
rl w1 x3+a724 ; oper:= current_coroutine.latop; <* undef if timeout *>
jl (x3+a722) ;
e. ; end;
\f
; procedure entry sem_sendmessage(name,message,oper,sem.result);
;
; sends a massage to the process given by 'name'. when the answer arrives
; it is signalled to the chained semaphore 'sem'. the calling coroutine must
; provide the operation 'oper' which is used as:
;
; 1) message_buffer_extension and 2) answer_operation(sem_answer_proc)
; -6 (next operation) oper +0 next operation
; -4 (prev operation) +2 prev operation
; -2 (type) +4 type=answer(1<1)
; ext. +0 open,'sem_answer_proc' +6 -
; +2 answer_sem +8 buffer address
;
;
; call return
; w0: sem destr.
; w1: params destr.
; w2: oper buffer addres ( or 0 = claims exceeded )
; w3: link current coroutine
;
; 'params' points at a parameter area containing:
;
; params +0: name(1)
; +2: name(2)
; +4: name(3)
; +6: name(4)
; +8: name table address
; +10: mess(1)
; +12: mess(2)
; etc.
b.j5,i5 w.
c113: am (b28) ; begin
rs w3 (0) ;
am (b28) ;
rl w3 +a544 ;
sn w3 0 ; if testoutput active
jl. j0. ; then generate_testoutput(1<12);
jl. w3 h4. ;
3<22+1<12 ;
j0: rs w0 (b27) ; with oper.answer_descriptor do
rl. w0 i0. ; begin
rs w0 x2+6 ; proc:= sem_answerproc;
rl w0 (b27) ; open:= true;
rs w0 x2+8 ; answer_sem:= sem;
al w3 x1 ; end;
al w1 x1+10 ; name_address:= params;
; message_address:= params+10;
al w2 x2+6 ; ref:= oper.answer_descriptor;
jd 1<11+16 ; sendmessage(name_addres,message_address,ref,result);
rl w3 (b28) ;
jl (x3) ; end;
i0: 1<12+28 ; answer_descriptor init;
e.
\f
; procedure sem_answer_proc(ref,buf);
;
; this procedure is called from procedure 'check_event_queue' when an
; answer to a message, sent by 'sem_sendmessage, has arrived. 'ref'
; contains the address of the answer_descriptor and 'buf' contains the
; message buffer address. the answer is signalled to the chained semaphore
; given in answer_descriptor.
;
; call return
; w0: - destr.
; w1: ref destr.
; w2: buf buf
; w3: link link
b.j5 w.
c114: am (b27) ; begin
ds w3 +6 ;
am (b28) ;
rl w3 +a544 ;
sn w3 0 ; if testoutput active
jl. j0. ; then generate_testoutput(1<13);
jl. w3 h4. ;
3<22+1<13 ;
j0: al w0 0 ; with ref do
hs w0 x1 ; begin
al w0 1<1 ; open:= false;
rs w0 x1-2 ; type:= answer;
rx w2 x1+2 ; sem:= answer_sem;
al w1 x1-6 ; buffer:= buf;
jl. w3 c110. ; signal_chained(sem,operation);
am (b27) ; end;
dl w3 +6 ;
jl x3 ; end;
e.
\f
; procedure message_received(buf,ref);
;
; this procedure is called from 'check_event_queue' when a message is
; received and mess_descr.proc = 'message_received'. the message descriptor
; must contain an operation and the address of a chained semaphore.
;
; message_descriptor message_operation
; -6: next operation -
; -4: prev operation -
; -2: type type = message (1<0)
; mess_descr +0: open,'message_received' -
; +2: semaphore address buffer address
;
;
; call return
; w0: - destr.
; w1: ref destr.
; w2: buf 0 (the message buffer is removed)
; w3: link link
b.j5 w.
c115: am (b27) ; begin
rs w3 +6 ;
am (b28) ;
rl w3 +a544 ;
sn w3 0 ; if testoutput active
jl. j0. ; then generate_testoutput(1<14);
jl. w3 h4. ;
3<22+1<14 ;
j0: jd 1<11+26 ; getevent(buf);
al w0 0 ; with ref do
hs w0 x1 ; begin
al w0 1<0 ; open:= false; <* the message class must be
; explicitly opened by a
; receiving coroutine *>
rs w0 x1-2 ; oper.type:= message;
rx w2 x1+2 ; oper.buffer:= buf;
al w1 x1-6 ; sem:= message_sem;
jl. w3 c110. ; signal_chained(sem,oper);
am (b27) ; end;
rl w3 +6 ;
al w2 0 ; buf:= 0; <* has been removed *>
jl x3 ; end;
e.
\f
; procedure entry timer_message;
;
; sends a delay-message to 'clock'.
;
; call return
; w0: - unchanged
; w1: - destr.
; w2: - buf or 0
; w3: link current_coroutine
b.j5 w.
c116: am (b27) ; begin
rs w3 +14 ;
am (b28) ;
rl w3 +a544 ;
sn w3 0 ; if testoutput active
jl. j0. ; then generate_testoutput(1<15);
jl. w3 h4. ;
3<22+1<15 ;
j0: rl w3 b28 ;
al w1 x3+a626 ; mess:= cur.ext2.delaymess;
al w2 x3+a630 ; ref:= cur.ext2.answer_descr;
al w3 x3+a616 ; name:= <:clock:>;
jd 1<11+16 ; sendmessage(name,mess,ref,result);
rl w3 (b28) ;
am (b27) ;
rl w1 +14 ;
jl x1 ; end;
e.
\f
; procedure timerscan(ref,buf);
;
; this procedure is called from 'check_event_queue' when an answer arrives
; from 'clock'. the timer queue is inspected and coroutines which time out
; are started with result = timeout. after the inspection a delay-message is
; sent to 'clock'.
;
; call return
; w0: - destr.
; w1: ref destr.
; w2: buf 0 (the message buffer is removed)
; w3: link link
b.j5,i5 w.
c117: am (b27) ; begin
rs w3 +16 ; ext1(16):= link;
am (b28) ;
rl w3 +a544 ;
sn w3 0 ; if testoutput active
jl. j0. ; then generate_test_output(1<16);
jl. w3 h4. ;
3<22+1<16 ;
j0: rl w3 b28 ;
al w1 x3+a566 ; <* release messagebuffer *>
jd 1<11+18 ; wait_answer(cur.ext2.test_mess_area,buf);
j4: ;
al w2 x3+a552 ; corout:= first in timer queue;
j1: rl w2 x2 ; while corout <> timer queue head do
j3: sn w2 x3+a552 ; begin
jl. j2. ; corout:= next(corout);
rl w1 x2+4 ; with corout do
sh w1 0 ; begin
jl. j1. ; if timer > 0 then
al w1 x1-1 ; begin
rs w1 x2+4 ;
se w1 0 ; timer:= timer-1;
jl. j1. ; if timer = 0
rl w0 x2 ; then start(corout,prio,timeout);
am (b27) ;
rs w0 +18 ;
al w2 x2-2 ;
rl w0 x2+a698 ; end;
al w1 0 ; end;
jl. w3 c100. ;
am (b27) ;
rl w2 +18 ;
rl w3 b28 ;
jl. j3. ; end while;
j2: jl. w3 c116. ; timer_message;
am (b27) ;
rl w3 +16 ; link:= ext1(16);
al w2 0 ; buf:= 0; <* has been removed *>
jl x3 ; end;
e.
\f
; procedure entry cregretmessage(buf);
;
; this procedure is used to regret a message sent by csendmessage, i. e. the
; monitor procedure 'regretmessage' is called and the corresponding message
; buffer extension is released.
;
; call return
; w0: - destr.
; w1: - destr.
; w2: buf buf
; w3: link current_coroutine
b.j5 w.
c118: am (b28) ; begin
rs w3 (0) ;
am (b28) ;
rl w3 +a544 ;
sn w3 0 ; if testoutput active
jl. j0. ; then generate test_output(1<17);
jl. w3 h4. ;
3<22+1<17 ;
j0: jd 1<11+82 ; regretmessage(buf);
rl w1 x2-2 ; ref:= buf.ref;
rl w3 b28 ; ext:= next(message_buffer_ext_head);
al w0 x1-2 ; next(message_buffer_ext_head):= ref;
rx w0 x3+a588 ; next(ref):= ext;
rs w0 x1-2 ;
rl w3 (b28) ;
jl (x3) ; end;
e.
\f
; procedure entry testout
;
;
; this procedure creates a user test record defined by the registers
; as follows:
;
; call return
; w0: testrecord ident unch.
; w1: start address unch.
; w2: no_of_halfwords unch.
; w3: link current coroutine
b.j5 w.
c119: am (b28) ; begin
rs w3 (0) ;
am (b28) ; if test output active then
rl w3 +a544 ;
sn w3 0 ;
jl. j0. ;
jl. w3 h4. ; generate testoutput(1<18)
3<22+1<18;
j0: rl w3 (b28) ;
jl (x3) ; end;
e.
\f
; procedure generate testoutput(testkind);
;
; this procedure creates a testrecord or initiates the creation of a test
; record as follows:
;
; 1) if word 128 in monitor table is set ( <> 0 ) a message defining the
; test record is sent to the coroutine test output process.
;
; 2) otherwise a test record is written in the cyclical test output buffer.
; formats in the cyclical buffer:
;
; user test record coroutine function (signal etc.)
; +0 testkind testkind
; +2 time1 time1
; +4 time2 time2
; +6 user_ident,length w0
; +8 test information w1
; +10 - " - w2
; +12 - " - coroutine ident
; +14 etc. address of current coroutine
;
; testkind values:
; 1<0 : start
; 1<1 : wait
; 1<2 : pass
; 1<3 ; inspect
; 1<4 : csendmessage
; 1<5 : cwaitanswer
; 1<6 : answer_arrived
; 1<7 : signal_sem-signal_binary
; 1<8 : wait_semaphore
; 1<9 : signal_chained
; 1<10 : inspect_chained
; 1<11 : wait_chained
; 1<12 : sem_sendmessage
; 1<13 : sem_answer_proc
; 1<14 : message_received
; 1<15 : timer_message
; 1<16 : timer_scan
; 1<17 : cregretmessage
; 1<18 : user defined testrecord
;
; call return
; w0: - unchanged
; w1: - unchanged
; w2: - unchanged
; w3: link current coroutine
b.j10,i5
w.
h4: am (b27) ; begin
rs w3 +8 ; ext1(8):= link;
rl w3 b27 ;
ds w1 x3+22 ; save working registers
rs w2 x3+24 ;
rl w1 x3+8 ;
rl w3 (b28) ;
rl w0 x3+a716 ; if testkind is included in curr.corout.testm then
la w0 x1 ; begin
sn w0 0 ;
jl. j6. ;
rl w3 b141 ; if core(128) <> 0 then
sn w3 0 ; begin
jl. j1. ;
rl w3 b28 ;
al w1 x3+a566 ;
rs w0 x1 ; cur.ext2.testmess(1):= testkind;
al w3 x3+a556 ;
jd 1<11+16 ; send message(testmes,cmontest);
jd 1<11+18 ; wait answer;
jl. j6. ; else
j1: rl w3 b28 ; begin ! create record in cyclical buffer !
am (b27) ; if testkind = user record
rl w1 +24 ;
se. w0 (i0.) ; then length:= length(user record)
al w1 8 ; else length:= 8;
rl w2 x3+a540 ; if (start(next record)+length+8) >
wa w1 x3+a540 ; top(test buffer) then
al w1 x1+8 ; begin
sh w1 (x3+a542) ;
jl. j2. ;
al w1 0 ; insert dummy end record
rs w1 x2 ;
rl w2 x3+a538 ; start(next record):= start(test buffer);
; end;
j2: rs w0 x2 ; insert testkind in record
rl w3 0 ;
jd 1<11+36 ; get clock
ds w1 x2+4 ; insert time in test record
sn. w3 (i0.) ; if testkind = coroutine function then
jl. j3. ; begin
rl w3 (b28) ;
am (b27) ;
dl w1 +22 ;
ds w1 x2+8 ; insert w0,w1
am (b27) ;
rl w0 +24 ;
rs w0 x2+10 ; insert w2
rl w0 x3+a718 ;
ds w0 x2+14 ; insert coroutine_ident, addr. of curr,corout.
al w2 x2+14 ;
jl. j5. ; end
j3: rl w3 b27 ; else
dl w1 x3+22 ; begin <* user defined test record *>
rl w3 x3+24 ;
hs w0 x2+6 ; insert user identification
hs w3 x2+7 ; insert length
al w2 x2+8 ;
j4: rl w0 x1 ; transfer test information
rs w0 x2 ;
al w3 x3-2 ;
sh w3 0 ;
jl. j5. ;
al w2 x2+2 ;
al w1 x1+2 ;
jl. j4. ; end;
; end;
j5: rl w3 b28 ;
al w2 x2+2 ; update start(next record) in procees ext2
rs w2 x3+a540 ;
j6: rl w3 b27 ;
dl w1 x3+22 ; load working registers
rl w2 x3+24 ;
rl w3 x3+8 ; return:=ext1(8);
jl x3+2 ; end;
i0: +1<18 ; testkind f. user test record
e.
e.
z.
; procedure errorlog.
; called from driver when a abnormal result is received,
; or when a internal interupt is received.
; if the external process errorlog has received a buffer this procedure
; will produce a record. the format of the record depends on
; the kind of error.
; the procedure is called with w1 holding the process description of the failed
; process e.g. the current internal process in case of a internal
; interupt or the physical disc in case of a discerror.
;
;
;
; call return
; w0 unchanged
; w1 failed process unchanged
; w2 link unchanged
; w3 unchanged
b. i15 , j20 w.
g66 :ds. w1 i0. ; save all registers
ds. w3 i1. ;
dl w1 b19 ; save current buffer , current receiver
ds. w1 i3. ;
rl w1 b30 ; set current receiver := errorlog
rs w1 b19 ;
jl w3 g64 ; examine queue
jl. j15. ; +0 : queue empty ; return
rl w2 b30 ; +2 : mess in queue
al w2 x2+a70 ; c. w2= errorbuffer start
al w3 0 ;
rs w3 x2 ;
dl w1 b13+2 ; insert time in errorbuf
ds w1 x2+32 ;
rl. w1 i0. ; record type : goto case kind of
rl w0 x1+a10 ;
hs w0 x2+0 ;
sn w0 0 ;
jl. j0. ; internal interupts, monitor call break
sn w0 62 ;
jl. j1. ; discerror
se w0 86 ;
sn w0 88 ;
jl. j3. ; fpa transmission error
se w0 84 ;
sn w0 85 ;
jl. j5. ; subprocesserror
jl. j15. ; otherwise ... return
;
; before exit the registers contain
; w0 : kind.failed process
; w1 : process description of failed process
; w2 : errorbuffer start
;
;
j0: dl w0 x1+a11+2 ; internal interupt .
ds w0 x2+4 ; move name.failed process
dl w0 x1+a11+6 ;
ds w0 x2+8 ;
al w2 x2+10 ;
al w0 8 ; copy from process descr. w0,w1 w2 w3
al w1 x1+a28 ; status ic(logical) cause sb
jl. w3 j9. ;
rl w3 x1-a28+a182; copy last two instructions
wa w3 x1-a28+a33 ;
dl w1 x3-2 ;
ds w1 x2-10+28 ;
al w3 32 ; save size-2 of record and
jl. j13. ; goto copy errorbuf
;
;
j1: rs w1 x2+28 ; discerror
rl w3 x1+a244 ; copy i-o result, rem char.std status
rl w0 x1+a231 ;
ds w0 x2+20 ;
dl w0 x1+100 ; status: sum of all statusbits
ds w0 x2+24 ; e.g. std. status "or" statusarea1
rl w3 x1+102 ; ( "or" statusarea2)
rs w3 x2+26 ;
rl. w1 i2. ; copy from "current" buffer
dl w0 x1+a151 ; mess(1) - mess(2)
ds w0 x2+12 ; mess(4) - mess(5)
dl w0 x1+a153+2
ds w0 x2+16 ;
rl w1 x1+a141 ; get process descr. rec
sh w1 (b3) ; if receiver defined then
jl. j2. ;
dl w0 x1+a11+2 ;
ds w0 x2+4 ;
dl w0 x1+a11+6 ;
ds w0 x2+8 ;
j2: al w3 32 ; save size-2 of record
jl. j13. ; goto copy errorbuf
;
;
j3: zl w0 x1+44 ; fpa transmission error
wa w0 x1+42 ; copy from failed process
ds w1 x2+28 ; startbyte, statusbyte
dl w0 x1+a11+2 ; name
ds w0 x2+4
dl w0 x1+a11+6 ;
ds w0 x2+8 ;
dl w0 x1+a231 ; std status
ds w0 x2+12 ;
dl w0 x1+a233 ;
ds w0 x2+16
dl w0 x1+28 ; status from first sense
ds w0 x2+20 ;
dl w0 x1+32 ;
ds w0 x2+24 ;
dl w0 x1+36 ; copy status from second sense
ds w0 x2+36 ;
dl w0 x1+40 ;
ds w0 x2+40 ;
al w0 18 ; copy channelprogram
wa w1 x1+a226 ;
al w2 x2+42 ;
jl. w3 j9. ;
al w3 74 ; save size-2 of record
jl. j13. ; goto copy errorbuf
;
;
j5: rs w1 x2+28 ; subprocess error
hl w0 x1+36 ; copy from subprocess
hs w0 x2+1 ; subkind
dl w0 x1+a11+2 ;
ds w0 x2+4 ; name
dl w0 x1+a11+6 ;
ds w0 x2+8
dl w0 g29 ; copy first four words of mess from save area
ds w0 x2+12 ;
dl w0 g30 ;
ds w0 x2+16 ;
dl w0 g21 ; copy the answer from std answer area
ds w0 x2+20 ;
dl w0 g23
ds w0 x2+24 ;
rl w3 g24 ;
rs w3 x2+26 ;
al w3 32 ; save size-2
jl. j13. ; goto copy buf
;
;
;
; help procedure move doublewords.
; move the specified number if words as doublewords.
; odd number of words will cause one extra word to be moved.
; call return
; w0: no of words destroyed (zero)
; w1: from adr unchanged
; w2: to adr unchanged
; w3: link unchanged
;
;
j9: ds.w2 i13. ;
ds. w0 i15. ;
j10: dl w0 x1+2 ;
ds w0 x2+2 ;
al w1 x1+4 ;
al w2 x2+4 ;
rl. w3 i15. ; decrease word count
al w3 x3-2 ;
rs. w3 i15. ;
sl w3 1 ;
jl. j10. ;
dl. w2 i13. ; restore registers
dl. w0 i15. ;
jl x3 ;
;
;
0 ; from adr
i13: 0 ; to adr
0 ; link
i15: 0 ; word count
;
;
j12: rl w1 4 ; copy direct: setup parameters to procedure move doublewors
rl. w2 i10. ;
rl w2 x2+a151 ; first adr in messbuf
wa. w2 i9. ; + no of hw already moved
al w0 34 ; record size: 34 hw
jl. w3 j9. ;
al w1 34 ; goto update no of hw moved
rl. w2 i10. ;
jl. j14. ;
;
;
j13: rl w2 b30 ; copy errorbuffer (general copy)
rl w1 x2+a54 ; check buffer.
al w0 0 ; if buffer<> last used buffer then
se. w1 (i10.) ; set bufferadr and clear relative adr.
ds. w1 i10. ;
rl w0 x1+a150 ; change operation to odd
wa. w0 i11. ; to use gen. copy
rs w0 x1+a150 ;
al w2 x2+a70 ;
zl w1 x2+0 ; if kind of record = internal then
sn w1 0 ; goto move direct.
jl. j12. ; (we are in monitor mode and cant use general copy)
wa w3 4 ; else store first and last adr
ds. w3 i8. ;
al. w1 i6. ;
rl. w2 i10. ; setup parameters and call
jd 1<11+84 ; general copy
se w0 0 ; if not ok then !!!!!
jl. j11. ;
j14: wa. w1 i9. ; (copy direct continues here. w1=no of hw moved
rs. w1 i9. ; w2= mess buf adr)
rl w0 x2+a150 ; change operation to even
ws. w0 i11. ; makes it possible to regret the mess.
rs w0 x2+a150 ;
wa w1 x2+a151 ; update relative adr and check restsize in buf
al w1 x1+74 ;
sh w1 (x2+a152) ; if restsize < max record size then
jl. j15. ; deliver answer else goto return
j11: al w0 1 ; deliver result 1
rl. w1 i9. ;
rl w3 b30 ; check kind.record
rl w3 x3+a70 ; if kind.record =internal then
se w3 0 ; deliver answer else
jl. j16. ; deliver result
rs w0 x2+a141 ; set result in buffer
ds w1 x2+a151 ; no of bytes =sum of bytes moved
jl w3 d15 ; deliver answer (continue with restore parameters )
j17: al w0 0 ; reset special watched receiver
rs w0 b32 ;
jl w3 g64 ; if more messages in queue
jl. j15. ; then set next special watched receiver adr
rl w0 x2+a153 ;
rs w0 b32 ; (placed in connection to "deliver result" )
j15: dl. w1 i3. ; return : restore all parameters
ds w1 b19 ; restore current receiver and buffer
dl. w1 i0. ; restore all registers
dl. w3 i1. ;
jl x2 ;
j16: ds w1 g21 ; deliver result
jl w3 g19 ;
jl. j17. ; restore parameters
;
;
; parameter list :
;
0 ; save w0:
i0: 0 ; save w1: pd.failed process
0 ; save w2: link
i1: 0 ; save w3:
i2: 0 ; save current buffer
i3: 0 ; save current receiver
i6: 2<1+1 ; parameters for general copy: funtion
i7: 0 ; first adr in errorbuf
i8: 0 ; last adr in errorbuf
i9: 0 ; relative start to mess buf adr (no of hw moved)
i10: 0 ; buffer adr
i11: 1<12 ; change op even-odd
e. ; end of errorlog entry
b.i0 ; begin
w.i0: al. w2 i0. ; make room:
jl x3+0 ; autoloader(end monitor procedures);
jl. i0. ; after loading:
j0=k - b127 + 2
k = i0 ; goto make room;
e. ; end
e. ; end of monitor segment
\f
; segment 3: external processes
s. k = k, h132
w.b127=k, g70, k=k-2
m. driver proc save area - g,b names, reg dump (18, 16 hw)
; common driver central logic
; compatible with old conventions
; save area for std g-names, b-names
b086: 0,r.5 ; g20, g21, g22, g23, g24
0, r.3 ; b18, b19, work
b085 ; b20 = address of wait-next action
; interrupt routine
b087:0, r.a180>1 ; save area for registers
al. w1 b086. ;
rl w3 x1 ; print the whole save area and the registers
jd 1<11+34;
al w1 x1+2 ;
se. w1 b087.+a180;
jl. -8 ;
rl. w3 b087.+10; w3 := old ic + 2;
bz w0 x3-2 ;
jd 1<11+28; print(instruction code incl regs);
bl w0 x3-1 ;
jd 1<11+28; print(address part);
bl w0 x3-2 ;
h. se w0 , ks ; if instruction = <ks> then
w. jl. b085. ;
dl. w1 b087.+2; restore all registers
dl. w3 b087.+6;
xl. b087.+9;
jd. (b087.+10; and return disabled;
; else goto wait next;
b. e10, r5 w.
b. i0 w.
r5: am 5-3 ; result 5:
r3: am 3-2 ; result 3:
r2: am 2-1 ; result 2:
r1: am 1-0 ; result 1:
r0: al w0 0 ; result 0: finis the call:
e0: ; finis with prepared result:
; entry: w0=result
al. w1 0 ; answer area := dummy;
e1: rl. w2 i0. ; mess buff addr := saved mess buf;
jd 1<11+22; send answer;
b085:al w2 0 ; wait next:
jd 1<11+24; wait event;
b088:am (0) ; result: 0=message, 1=answer,
jl. +2 ; 2=interrupt, 4=immediate message
jl. e2. ;+2: message or answer:
jd x2 ;+4: interrupt: goto service address;
;+6: immediate message:
; immediate message is a call of
; initialize process
; reserve process
; release process
rs. w2 i0. ; save(buf);
rl w0 x2+8 ; switch := operation(buf);
rl w1 x2+6 ; internal := sender(buf);
sh w1 0 ; if sender <= 0 then
jl. e0. ; goto finis, undef result; (call is regretted)
ac w2 (x2+4) ; proc := -receiver(buf);
al w2 x2-1 ; (i.e. positive, even)
am (0) ;
jl. (+2) ; goto case switch of:
e5 ; switch=0: initialize process
e6 ; switch=2: reserve process
r0 ; switch=4: release process ( finis the call )
i0: 0 ; saved message buffer address
; message or answer:
; entry: w0=result from wait event, w2=buf
e2: rl w1 x2+6 ; sender := sender(buf);
jd 1<11+26; get event(buf); (buffer contents is irrell if answer)
se w0 1 ; if result from wait event = 0 then
jl. e3. ; goto message;
; answer:
; entry: w0=1, w1=sender
; skip the answer, unless message originated from a terminal
sl w0 (x1+a10) ; if kind(sender) = 0 then
jl. b085. ; goto wait next; (maybe testoutput message...)
bz w3 x1+a71+1 ;
al w3 x3+1 ; increase(attention buffer claim(terminal));
hs w3 x1+a71+1 ;
jl. b085. ; goto wait next;
; message:
; entry: w1=sender, w2=buf
e3: rl w3 b1 ; w3 := cur;
bz w0 x3+a19 ; increase (bufclaim(cur));
ba. w0 1 ;
hs w0 x3+a19 ; i.e. unclaim the buffer again...
ac w3 (x2+4) ; proc := -receiver(buf); (positive)
rs w3 x2+4 ; receiver(buf) := proc (i.e. positive);
ds w3 b19 ; save(buf,proc) in std locations;
; before exit to the different drivers, the registers contain:
; w0=undef, w1=sender, w2=buf, w3=proc
am (x3+a10) ;
jd. (+2) ; goto case kind(proc) of:
h3 ; (0: internal process
h4 ; 2: interval clock
h5 ; 4: backing store area
g2 ; 6:
g2 ; 8:
g2 ; 10:
g2 ; 12:
g2 ; 14:
g2 ; 16:
g2 ; 18:
g2 ; 20:
g2 ; 22:
g2 ; 24:
g2 ; 26:
g2 ; 28:
g2 ; 30:
g2 ; 32:
g2 ; 34:
g2 ; 36:
g2 ; 38:
g2 ; 40:
g2 ; 42:
g2 ; 44:
g2 ; 46:
g2 ; 48:
g2 ; 50:
g2 ; 52:
h7 ; 54: errorlog process
h22 ; 56: remoter process
g2 ; 58:
g2 ; 60:
h6 ; 62: disc (logical- and physical disc)
h3 ; 64: pseudo process
g2 ; 66:
g2 ; 68:
g2 ; 70:
h72 ; 72: rc8602 (sscir)
h74 ; 74: rc8602 (isrpy)
h76 ; 76: rc8601 (sscir)
h78 ; 78: rc8601 (isrpy)
h80 ; 80: mainproc(fpa)
g2 ; 82: hostproc(fpa)
h84 ; 84: subproc(fpa)
g2 ; 86: receiver(fpa)
g2 ; 88: transmitter(fpa)
h90 ; 90: host);
h3=g6 ; internal process, pseudo process
g2=g3 ; not defined
e. ; end common part of central logic
; initialize and reserve process:
; entry conditions: w0 = switch, w1 = internal, w2 = proc
b. i51 w.
e5: ; initialize process: switch = 0
e6: rs. w0 i9. ; reserve process: switch = 2
am (x2+a10) ;
jl. (2) ; goto case kind(proc) of:
i30 ; (0: internal process,
i31 ; 2: interval clock,
i11 ; 4: backing store area,
r3 ; 6:
r3 ; 8:
r3 ; 10:
r3 ; 12:
r3 ; 14:
r3 ; 16:
r3 ; 18:
r3 ; 20:
r3 ; 22:
r3 ; 24:
r3 ; 26:
r3 ; 28:
r3 ; 30:
r3 ; 32:
r3 ; 34:
r3 ; 36:
r3 ; 38:
r3 ; 40:
r3 ; 42:
r3 ; 44:
r3 ; 46:
r3 ; 48:
r3 ; 50:
r3 ; 52:
r3 ; 54:
i34 ; 56: remoter process
r3 ; 58:
r3 ; 60:
i17 ; 62: disc (logical- and physical discs)
i30 ; 64: pseudo processes
r3 ; 66:
r3 ; 68:
r3 ; 70:
i51 ; 72: rc8602 (sscir) (reservation not allowed )
r3 ; 74: rc8602 (isrpy) (does not exist)
i48 ; 76: rc8601 (sscir)
i48 ; 78: rc8601 (isrpy)
i36 ; 80: mainproc(fpa)
i37 ; 82: hostproc(fpa)
i38 ; 84: subproc(fpa)
i39 ; 86: receiver(fpa)
i40 ; 88: transmitter(fpa)
i41 ; 90: host);
i9: 0 ; saved switch
i11: ; backing store area:
jl w3 d102 ; check user(internal, proc);
jl. r3. ;+2 not user: goto result 3;
jl w3 d113 ; check any reserver(internal, proc);
jl. r1. ;+2 other reserver: goto result 1;
jl. r0. ;+4 internal is reserver: goto result 0;
rl. w0 i9. ;
sn w0 0 ; if initialize then
jl. r0. ; goto result 0;
dl w0 x2+a49 ; w3w0 := interval(proc);
al w3 x3+1 ;
sh w0 (x1+a44) ; if upper(proc) > upper(max(internal)) or
sh w3 (x1+a44-2) ; lower(proc) < lower(max(internal)) then
jl. r2. ; goto result 2;
jl. r0. ; goto include reserver;
i36: ; mainproc(fpa):
jl w3 d102 ; check user(internal, proc);
jl. r2. ;+2 not user: goto result 2;
jl w3 d113 ; check any reserver(internal, proc);
jl. r1. ;+2 other reserver: goto result 1;
jl. r0. ;+4 internal is reserver: goto result 0;
;+6
rl w3 b3 ;
i50: al w3 x3+2 ; for dev:=0 step 1 until found do
se w2 (x3) ; if proc(dev)=proc then found;
jl. i50. ;
rs. w3 i46. ;
rl w2 x3+2 ; rec:=proc(dev+1);
jl w3 d113 ; check any reserver(internal, rec);
jl. r1. ;+2 other reserver: goto result 1;
am 0 ;+4 internal is already reserver:
rl. w3 i46. ;
rl w2 x3+4 ; trm:=proc(dev+2);
jl w3 d113 ; check any reserver(internal,trm);
jl. r1. ; if other reserver then goto result 1;
am 0 ; if already res. then goto result 0;
jl. i49. ; goto set result;
i39: ; receiver(fpa):
i40: ; transmitter(fpa):
jl w3 d102 ; check user(internal, proc);
jl. r2. ;+2 not user: goto result 2;
jl w3 d113 ; check any reserver(internal, proc);
jl. r1. ;+2 other reserver: goto result 1;
jl. r0. ;+4 internal is reserver: goto result 0;
;+6
rl w2 x2+a50 ; main:=main(proc);
jl w3 d113 ; check any reserver(internal, main);
jl. r1. ;+2 other reserver: goto result 1;
am 0 ;+4 internal is already reserver:
jl. i49. ; goto setresult;
i29: ; reserve:
jl w3 d113 ; check any reserver(internal, proc);
jl. r1. ;+2 other reserver: goto result 1;
jl. r0. ;+4 internal is reserver: goto result 0;
;+6
i49: al w0 0 ; setresult: result := 0;
al. w1 1 ; w1 := odd, i.e. transform initialize to reserve;
jl. e1. ; goto include reserver;
i38: ; subproc(scc):
jl w3 d102 ; check user(internal, proc);
jl. r2. ;+2 not user: goto result 2;
jl w3 d113 ; check any reserver(internal, proc);
jl. r1. ;+2 other reserver: goto result 1;
am ;+4 internal is already reserver:
al w3 1 ; external state(proc) := initialized;
hs w3 x2+a56+1 ;
rl. w0 i9. ;
bl w3 x2+a63 ; if subkind(proc) <> typewriter
sn w0 0 ; or reserve process then
se w3 8 ;
am 1 ; make w1 odd; i.e. indicate reserve...
al. w1 0;here ; else w1 = even;
al w0 0 ; result := 0;
jl. e1. ; goto include reserver;
i17: ; disc driver:
jl w3 d102 ; check user(internal,proc);
jl. r2. ; if not user then goto result 2;
jl w3 d113 ; check any reserver(internal,proc);
jl. r1. ; if other reserver then goto result 1;
jl. r0. ; if already res. then goto result 0;
rl. w0 i9. ;
sn w0 0 ; if switch = reserve then
jl. i45. ; begin
rl w2 x2+a50 ; main:= mainproc.proc;
sn w2 0 ; if main <> 0 then
jl. i42. ; begin c. logical driver;
jl w3 d113 ; check any reserver(internal,main);
jl. r1. ; if other res. then goto result 1;
jl. r0. ; if already res. then goto result 0;
jl. i45. ; end else
i42: rs. w2 i46. ; begin c. physical driver;
rl w2 b4 ; i:= addr of 1st device in nametab;
i43: rs. w2 i47. ; repeat
rl w2 x2+0 ; proc:= nametable(i);
rl w3 x2+a10 ;
rl w0 x2+a50 ;
sn w3 62 ; if kind.proc = 62
se. w0 (i46.) ; and mainproc.proc = main then
jl. i44. ; begin c. logical driver;
jl w3 d113 ; check any res.(internal,proc);
jl. r1. ; if other then goto result 1;
jl. i44. ; end;
i44: am. (i47.) ;
al w2 2 ; i:= i + 2
se w2 (b5) ; until i = 1st area in nametable;
jl. i43. ; end;
i45: al w0 0 ; end; result:= 0;
al. w1 1 ; w1:= odd; c. change initialize to res.;
jl. e1. ; goto include reserver;
;
i46: 0 ; saved mainproc
i47: 0 ; saved nametable address
i48: ; rc8601:
jl w3 d102 ; check user(internal, proc);
jl. r2. ; not user: goto result2;
jl w3 d113 ; check any reserver(internal, proc);
jl. r1. ; other reserver: goto result1;
am ; allready reserver:
jl. i49. ; goto deliver answer;
i30 = e0 ; internal process
; pseudo process
i31 = e0 ; interval clock
i34 = e0 ; remoter process
i37 = e0 ; subhost process
i41 = e0 ; host process
i51=e0 ; rc8602
e. ; end of initialize/reserve process
e. ; end of driver central logic
\f
; pej 23.01.78 clock driver
; -----------------------------------------------------------------
; c l o c k d r i v e r c o d e
; -----------------------------------------------------------------
; this section contains the code executed by driverproc for
; processing messages to the clockdriver and for executing other
; actions related to the real time clock.
;
; messages have the following format:
;
; delay 0<12+mode
; seconds or interval(0:23)
; interval(24:47)
;
; wait for clockchange 2<12+mode
; seconds or interval(0:23)
; interval(24:47)
;
; wait for power restart 4<12+mode
; seconds or interval(0:23)
; interval(24:47)
;
; a maximum delay is specified by seconds or interval equal to -1.
;
; mode consists of a sum of one or more of following values:
;
; 2 time interval in 0.1 msecs. if not used then seconds.
; 4 real time delay, i.e. the message is returned when the
; clock reaches the value:
; curr value of real time clock + delay
; if not used, an effective delay is specified, i.e. the
; message will be returned when it has been in the event
; queue as long as specified.
;
; the answer has the following format:
; statusword, bit0 = intervention (see below)
; 0
; 0
;
; messages received are linked to the clock process in ascending
; order with respect to calculated time for expiration of delay.
; at each clock interrupt the queue is scanned and messages which
; have reached the expiration time are returned. also at each
; clock interrupt the timeout queue of devices is scanned.
; timers which have run out cause the clock to reset the device
; with timeout status.
;
; after power restart all devices are reset with power restart
; result and messages waiting for power restart are returned with
; status intervention.
;
; after a change of clock (monitor procedure set clock) messages
; waiting for clockchange are returned with status intervention.
; the same is performed at mode 4-messages if the new clockvalue
; exceeds the calculated expiration time. messages not using mode
; 4 will have the expected expiration time adjusted according to
; the clockchange and the entire message queue is resorted.
m. monclock (monitor interval clock driver)
b. i10, j60, a0=1<23, w. ; block including clock driver
\f
; pej 23.01.78 clock driver
; m e s s a g e r e c e i v e d
; ---------------------------------------------------------------
;
; this routine is entered when driverproc receives a message for
; the clock. the message is checked and time (clockvalue) for
; expiration of delay is inserted into the buffer.
h4 : dl. w1 i0. ; c. w2 = curr buf;
jl w3 g16 ; check operation(mode mask,oper mask);
rs. w2 i8. ; save received buffer
rl w1 b19 ; check for clockchange c.w1=cur receiver
jl. w3 j24. ;
rl. w2 i8. ; restore buffer
dl w0 x2+a152 ; delay:= interval(0:47).curr buf;
bz w1 x2+a150+1 ;
sz w1 2.10 ; if time in secs.mode.curr buf then
jl. j10. ; begin
al w0 x3+0 ; seconds:= delay(0:23);
sn w0 -1 ; if seconds = -1 then goto maxdelay
jl. j14. ; else delay:= seconds * 10000;
wm. w0 i1. ; end;
j10 : sl w3 0 ; if delay >= 0
sl w3 52 ; and delay <= 872415231 then
jl. j12. ; begin c. 24 hrs + 841.5231 secs;
sn w0 0 ; if delay = 0 then
se w3 0 ; begin
jl. j16. ; bytes:= chars:= 0; goto result 1;
ds w3 g22 ; end;
jl g7 ; end
j12 : sn w3 -1 ; else
se w3 -1 ; if delay <> -1
jl g5 ; then goto result 3
j14 : dl. w0 i2. ; else
ss w0 b13+2 ; maxdelay: delay:= max clock val - time;
j16 : aa w0 b13+2 ;
ds w0 x2+a152 ; time.curr buf:= delay + time;
; insert the messagebuffer in eventqueue of the driver (the event
; queue is sorted after delay expiration time) and continue at
; waitnext in driverproc. please note that the messagebuffer is
; not claimed.
rl w3 b20 ;
jl. j50. ; insert buf(curr buf);
\f
; pej 23.01.78 clock driver
; i n t e r r u p t r e c e i v e d
; ---------------------------------------------------------------
;
; this routine is entered when driverproc receives an interrupt
; operation for the clock.
;
; if a power restart has been executed, all devices are reset
; and messages queued to wait for power restart returned.
c35 : al w0 0 ; c. w1 = curr receiver;
al. w3 j38. ; set continue adr
rx w0 b75 ; p:= after power; after power:= 0;
sn w0 0 ; if p <> 0 then
jl. j24. ; begin
rl w2 b67 ; entry:= 1st controller tab entry;
j18 : rl w3 x2+a311 ; repeat
rl w1 x3+a235-a230; device:=
al w0 0 ; deviceaddr.proc.entry;
jd 1<11+2 ; reset device(device,power);
al w2 x2+a314 ; entry:= entry + entry length
se w2 (b68) ; until entry = top entry;
jl. j18. ;
rl w1 b19 ; buf:=
al w2 x1+a54 ; addr of mess q head.curr receiver;
j20 : rl w2 x2+a140 ; rep: buf:= next.buf;
j22 : al. w3 j38. ; prepare continue adr
sn w2 x1+a54 ; rep1: if buf<>addr mqhead.curr rec then
jl. j24. ; begin
bz w0 x2+a150 ; if operation.buf <> 4
se w0 4 ; then goto rep;
jl. j20. ; deliver intervention(buf);
al. w3 j22. ; goto rep1;
jl. j51. ; end;
; end;
\f
; pej 23.01.78 clock driver
; if the clock has been changed some messages may be returned
; (those waiting for clockchange and those waiting in real time
; delay). expiration time in messages waiting in effective time
; delay is adjusted and the message queue is resorted.
; called when a message or an interrupt is received
; called with w1=cur receiver and w3 holding the return adr
j24 : rl w0 b15 ; c. w1 = curr receiver;
lo w0 b15+2 ;
sn w0 0 ; if clockchange <> 0 then
jl x3 ; begin
rs. w3 i9. ; save return adr
al w2 x1+a54 ;
sn w2 (x1+a54) ; if mess q.curr rec -,empty then
jl. j36. ; begin
dl w0 x1+a55 ; help q head:=
ds. w0 i4. ; mess q head.curr receiver;
rs w2 x1+a54 ;
rs w2 x1+a55 ; mess q head.curr receiver:= empty;
al. w0 i3. ; next.last.help q head:=
rs. w0 (i4.) ; addr of help q head;
rl. w2 i3. ; buf:= next.help q head;
rs w0 x2+2 ; last.buf:= addr of help q head;
j26 : sn. w2 (i5.) ; rep: if buf <> addr of help q head then
jl. j36. ; begin
bz w0 x2+a150 ;
se w0 2 ; if operation.buf = 2 then
jl. j30. ; begin
j28 : jl. w3 j51. ; send: deliver intervention(buf);
jl. j26. ; goto rep;
j30 : dl w0 x2+a152 ; end;
bz w1 x2+a150+1 ;
so w1 2.100 ; if real time.mode.buf then
jl. j32. ; begin
ss w0 b13+2 ; if time > time.buf
sx 2.1 ; then goto send;
jl. j34. ; end
jl. j28. ; else
j32 : sn. w3 (i7.) ;
se. w0 (i2.) ; if time.buf <> max clock val
aa w0 b15+2 ; then time.buf:= time.buf
ds w0 x2+a152 ; + clockchange;
j34 : rl w0 x2+0 ; next:= next.buf;
rs. w0 i6. ;
jl w3 d5 ; remove(buf); c. from help q;
jl. w3 j50. ; insert buf(buf);
rl. w2 i6. ; buf:= next;
jl. j26. ; goto rep;
; end;
j36 : ld w0 -100 ; end;
ds w0 b15+2 ; clockchange:= 0;
rl w1 b19 ; end;
jl. (i9.) ;
\f
\f
; pej 23.01.78 clock driver
; scan the message queue and return buffers with delays expired.
j38 : rl w2 x1+a54 ; c. w1 = curr receiver;
sn w2 x1+a54 ; rep: buf:= next.mess q head.curr rec;
jl. j40. ; if buf = addr of mess q head.curr rec
dl w0 x2+a152 ; then goto check timeouts;
ss w0 b13+2 ;
sx 2.1 ; if time < time.buf
jl. j40. ; then goto check timeouts;
rs w2 b18 ; curr buf:= buf;
al. w3 j38. ; no operation; c. result 1, status 0;
jl g26 ; goto rep;
; scan the timeout queue of devices and reset with timeout result
; for timers which have run out. return to waitnext in driverproc.
j40 : dl w2 b13+2 ; check timeouts:
dl w0 b70+2 ; timeused:= time - last inspected;
ds w2 b70+2 ; last inspected:= time;
ss w2 0 ; if timeused >= 1<24
se w1 0 ; then timeused:= maximum;
al w2 -1 ; c. timeused is unsigned integer;
al w3 b69 ; dev:= addr of timeout q head;
j42 : rl w3 x3+0 ; rep: dev:= next.dev;
j44 : sn w3 b69 ; rep1: if dev = addr of timeout q head
je (b20) ; then goto waitnext; c. in driverproc;
rl w0 x3-a242+a244;
ws w0 4 ; timer.dev:=
rs w0 x3-a242+a244; timer.dev - timeused;
sx 2.1 ; if timer.dev was > timeused
jl. j42. ; then goto rep; c. unsigned comparison;
rl w1 x3-a242+a235; device:= deviceaddr.timeout op;
rl w3 x3+0 ; dev:= next.dev;
al w0 1 ;
jd 1<11+2 ; reset device(device,timeout);
jd. j44. ; goto rep1;
; variables
a0>0+a0>2+a0>4 ; operation and mode masks
i0 : a0>0+a0>2+a0>4+a0>6
i1 : 10000 ; constant 10000
i7 : 8.37777777 ; max clock value (doubleword)
i2 : 8.77777777 ;
i3 : 0 ; doubleword used for help q head
i4 : 0 ;
i5 : i3 ; addr of help q head
i6 : 0 ; work, saved buf in loop
i8 : 0 ; saved buffer from message received
i9 : 0 ; return adr for j24
\f
; pej 23.01.78 clock driver
; procedure insert buf(buf);
; ---------------------------------------------------------------
; inserts a messagebuffer in the eventqueue in front of a buffer
; with higher delay expiration time.
;
; registers: call exit
; w0 destroyed
; w1 destroyed
; w2 buf unchanged
; w3 link destroyed
;
; entry: j50; return: link+0
b. i3 w.
j50 : rl w1 b19 ; insert buf:
al w1 x1+a54 ; elem:= endq:=
rs. w1 i0. ; addr of mess q head.curr receiver;
rs. w3 i1. ;
i2 : rl w1 x1+0 ; rep: elem:= next.elem;
sn. w1 (i0.) ; if elem <> endq
jl. i3. ;
dl w0 x2+a152 ;
ss w0 x1+a152 ;
sx 2.1 ; and time.buf <= time.elem
jl. i2. ; then goto rep;
i3 : rl. w3 i1. ;
jl d6 ; link(elem,buf); c. return from there;
; procedure deliver intervention(buf)
; ---------------------------------------------------------------
; the procedure answers buf with status intervention and returns
; with the value of next.buf at calltime.
;
; registers: call exit
; w0 destroyed
; w1 curr receiver
; w2 buf next.buf
; w3 link destroyed
;
; entry: j51; return: link+0
j51 : rs. w3 i1. ; deliver intervention:
rs w2 b18 ; curr buf:= buf;
rl w0 x2+0 ;
rs. w0 i0. ; save next.buf;
rl w0 g49 ;
rs w0 g20 ; status.i/o answer:= bit 0;
al w0 1 ; result:= 1;
al w1 0 ; bytes:= characters:= 0;
jl w3 g28 ; no operation;
rl. w2 i0. ; w2:= saved next.buf;
jl. (i1.) ; return;
; variables
i0 : 0 ; for saving next.buf or endq
i1 : 0 ; saved link
e.
e. ; end of block containing clock driver
\f
; remoter process.
; jr 79.02.28
m. remoter
b.i4,j4 w.
h22: al w1 x3+a54 ; remoter:
jl w3 d6 ; link event(event queue(proc), buf);
rl w1 b3 ;
j0: al w1 x1+2 ; for dev:=first dev in name table until last do
sl w1 (b5) ; begin
jl (b20) ;
rl w3 x1 ; proc:=proc(dev);
rl w0 x3+a10 ; kind:=kind(proc);
sn w0 18 ; main:=main(proc);
jl. j1. ; if kind=18
rl w2 x3+a50 ; or (kind=84,85 and main<>0 and subkind=18) then
se w0 84 ;
sn w0 85 ;
sn w2 0 ;
jl. j0. ;
bl w2 x3+a63 ;
se w2 18 ;
jl. j0. ;
j1: rl w2 x3+a70 ; if state(proc)=2 then
se w2 2 ; answer(0):=0;
jl. j0. ; answer(2):=proc;
al w2 0 ; deliver result(1);
ds w3 g21 ; goto exit;
jl w3 g18 ; end;
jl (b20) ; exit: return;
e.
; errorlog process
; hsi 80.07.22
m. errorlog process
b. i10, j10 w.
i0=1<23
i0>19
j0: i0>0
i1: 1<12
h7: al w0 0 ; reset interrupt adr. (set by remove process)
rs w0 x3+a56 ;
dl. w1 j0. ; check operation
jl w3 g16 ;
rl w2 b18 ; if buffer size < max record size
rl w1 x2+a150 ;
ws. w1 i1. ;
rs w1 x2+a150 ; make operation even. ( allowing it to be regertted)
rl w1 x2+a151 ; then send answer: unintelligble
al w1 x1+74 ;
sh w1 (x2+a152) ; else link operation and retur to driverproc
jl. j1. ;
ld w1 -100 ; buffer too small : send answer
ds w1 g22 ;
al w1 8 ;
rs w1 g20 ; status: 1 shift 3
jl g5 ;
j1: jl w3 g17 ; link up (return if first in queue )
rl w0 x2+a153 ; if first in queue then
rs w0 b32 ; set pd of special watched receiver
jl (b20) ; return via wait event in driverproc
e.
; rc8601 driver.
; jr, 78.04.28
c.(:a80>11a.1:)-1
m. rc8601/02 (cdc1604/gier emulator)
b.i15,m6,p6,s6 w.
; the rc8601 and rc8602 are a rc800 cpu used for emulating the cdc 1604 and gier.
; the device responds two devicenumbers, and it is then controlled
; from two external processes -
; sscir, stop-start control and io-request,
; and
; isrpy, io-status reply.
; these processes are working totally independent, but as they should be
; driven in almost the same way they are using the same driver-code.
;
; the processes accept the operations-
; sscir : sense 0<12+0 , dummy , dummy
; autoload 1<12+0 , base addr, dummy (rc8601)
; 1<12+0 , first , last (rc8602)
; restart 2<12+0 , dummy , dummy
; 3<12+0 , first , last (rc8602)
; isrpy: (sense 0<12+0 , dummy , dummy
;only rc8601(stop 2<12+0 , dummy , dummy
; (ready 4<12+mode, dummy , dummy , channelnumber
; where
; base addr-448, base addr+131072 must be inside the sender process,
; and channelnumber <256,
; and
; mode holds any combination of the mode bits
; 1<0 channel ready
; 1<1 equipment ready
; 1<2 equipment error
;
; the format of the answer-
; event status
; function
; unitno<18+exf addr (only autoload)
; (io-result)
; where
; event status is the status delivered from the hardware,
; and
; function -2 power up
; -1 monitor timeout
; 0 stopped
; 1 ok after immidiate operation
; 2 error stop
; 3 exfer request
;
; format of the privat part of the process description-
s0=a56+2 ; current sender ident. bit
s1=s0+2 ; state
s2=s1+2 ; stopped(sender) (only sscir)
; state -
; 0 device ready
; 2 sscir busy with sense operation
; 4 sscir busy with autoload operation
; 6 sscir busy with rc8601 restart operation
; 8 sscir busy with rc8602 restart operation
; 10 isrpy busy with sense operation
; 12 isrpy busy with stop operation
; 14 isrpy busy with ready operation
;
; stopped -
; = 0 running
; <> 0 stopped
;
; parameters:
p0=76 ; kind of sscir process
p1=78 ; kind of isrpy process
p2=-448 ; rel first (start of sim area relative to base addr)
p3=131072 ; rel last (last of sim area relative to base addr)
; channelprogram:
i0: 0<12+0<8+0 ; address code (sender), operation
0 ; base addr
0 ; channelnumber
15<8 ; stop
0 ; dummy
i11: 0 ; timeout (in units of 0.1 millisec)
i1: p3 ;
a0=1<23
a0>0+a0>1+a0>2+a0>3 ; mask0
i2: a0>0
a0>0+a0>2+a0>4 ; mask1
i3: a0>0
a0>0+a0>2+a0>4 ; mask2
i4: a0>1+a0>2+a0>3+a0>4+a0>5+a0>6+a0>7+a0>8+a0>9+a0>10+a0>11+a0>12+a0>13+a0>14+a0>15
; table concerning channel program.
i5=k-2, 2<12+0<8, 0<12+1<8, 0<12+3<8, 0<12+1<8, 2<12+0<8, 0<12+1<8, 0<12+3<8
i6=k-2, 12, 0, 1, 0, 12, 1, i7: 0
i12: 120*10000 ; timeout f. 8601
i13: 15*10000 ; timeout f. 8602
; dummy status area.
i8: 0, r.4 ;
i9: 1<3 ;
; start.
b.j6 w.
h76: jl w3 g15 ; start(sscir): check reservation;
h72: bz w3 x2+8 ; if rc8602 then skip user/reserver check;
ls w3 1 ; index:=operation*2+2;
al w3 x3+2 ;
jl. j0. ; goto checkmess;
h78: jl w3 g15 ; start(isrpy): check reservation;
bz w3 x2+8 ; index:=operation+10;
al w3 x3+10 ; goto checkmess;
; check message.
; the message buffer is checked and the content is changed to -
; mess+8 command, mode(mess)
; +10 first address
; +12 last address
; +14 channelnumber(mess)
; +16 address code<12+command<8+mode
; +18 address
; +20 character count
; +22 index
j0: ; checkmess:
rs w3 x2+22 ; mess(22):=index;
sl w3 2 ; if index<2
sl w3 14+1 ; or index>14 or (isrpy and rc8602) then
h74: jl g5 ; goto result3;
jl. (x3+i10.) ; goto case index of
i10=k-2
j1 ; (check1, 2: sscir-sense
j2 ; check2, 4: sscir-autoload
j4 ; check4, 6: sscir-restart
j2 ; check2, 8: sscir-restart (rc8602)
j1 ; check1, 10: isrpy-sense
j4 ; check4, 12: isrpy-stop
j3 ; check3); 14: isrpy-ready
j1: al. w1 i8. ; check1: addr:=addr(dummy status area);
jl. j5. ; goto cont;
j2: rl w1 b19 ; check2:
rl w0 x1+a10 ;
se w0 p0 ; if proc=rc8601 then
jl. j6. ;
al w0 1 ; size:=1;
rs. w0 x3+i6. ;
rl w1 x2+10 ;
al w0 x1+p2 ;
wa. w1 i1. ; first:=first(mess)+rel first;
ds w1 x2+12 ; last:=first(mess)+rel last;
ws. w1 i1. ; addr:=first(mess);
jl. j5. ; goto cont;
j6: al w1 2 ; else
wa w1 x2+12 ;
ws w1 x2+10 ; size:=2+last-first;
al w0 x1 ;
ls w0 -1 ; size:=size.2*3;
wa w1 0 ;
rs. w1 x3+i6. ;
rl w1 x2+10 ; addr:= first(mess)
jl. j5. ; goto cont;
j3: rl w0 x2+14 ; check3:
sl w0 1 ; if channelno<1
sl w0 1<8 ; or channelno>=256 then
jl g5 ; goto result3;
rs. w0 i7. ; char count(10):=channelno;
j4: am (x2+6) ; check4:
rl w1 +a17 ; addr:=first(core(sender));
rs w1 x2+10 ; first address:=address;
al w0 x1+256 ; last address:=address+max size(:max channelnumber);
rs w0 x2+12 ;
; w1: addr, w2: buffer, w3: index.
j5: rl. w0 x3+i5. ; cont:
ba w0 x2+9 ; command:=command(index)+mode(mess);
ds w1 x2+18 ; mess(16:18):=command, addr;
rl. w0 x3+i6. ; char count:=char count(index);
rs w0 x2+20 ; mess(20):=char count;
dl. w1 i2. ; mask:=mask0;
sl w3 10 ; if index>=10 then
dl. w1 i3. ; mask:=mask1;
sl w3 14 ; if index>=14 then
dl. w1 i4. ; mask:=mask2;
jl w3 g16 ; check operation;
rl w1 b19 ;
jl w3 g17 ; link operation;
; goto next;
e.
; execute operation.
b.j4 w.
m0: rl w3 x2+a142 ; next: get current sender
sh w3 0 ; if -parent then
ac w3 x3 ; sender := - sender
rl w3 x3+a14 ; get ident(sender);
rs w3 x1+s0 ; store current sender ident in device descr;
rl w3 x2+22 ; get index;
sl w3 4 ; if -,operation = sense
sl w3 10 ; and kind(proc) = sscir (<=>index < 8) then
jl. j1.
rl w0 x1+s2
se w3 4 ; if index(mess) = autoload then
jl. j0.
lo w0 x1+s0 ; stopped(sender) := 0
lx w0 x1+s0
rs w0 x1+s2 ; else
jl. j1.
j0: so w0 (x1+s0) ; if stopped(sender) then
jl. j1.
al w0 0
rs w0 g20 ; status (mess) := 0
rs w0 g21 ; function(mess):=0;
rs w0 g23 ;***
jl. m3. ; goto result1;
j1: rs w3 x1+s1 ; state:=index;
al w0 2.111<8 ;
la. w0 x3+i5. ; operation(mess):=command;
ls w0 -8 ;
hs w0 x2+8 ;
; setup channelprogram.
dl w0 x2+18 ; command(chpg):=command(mess);
ds. w0 i0.+2 ; addr(chpg):=addr(mess);
rl w0 x2+20 ; char count(chpg):=char count(mess);
rs. w0 i0.+4 ;
rl w3 b19 ;
rl w3 x3+a10 ; timeout:
rl. w0 i12. ;
se w3 p0 ; if kind(rec) = rc8601 then
sn w3 p1 ; timeout:= 120 m.sec else
jl. j2. ; timeout:= 15 m.sec;
rl. w0 i13. ;
j2: rs. w0 i11.
; start channelprogram.
; if the device is isrpy the device addr in the call must have value
; io device number + 1.
rl w3 x1+a235 ; iodev addr:=iodev addr(proc);
al w0 1<2+1 ; function select:=start chpg, standard return;
al. w1 i0. ; start:=start of chpg;
jd 1<11+100 ; start io;
rs w0 g23 ;***
se w0 2 ; if io-result<>2 then
jl. m4. ; goto result3;
ld w0 -100 ; sender stopped:
ds w0 g21 ; status, function:=0,0;
jl. m3. ; goto result1;
e.
; after interrupt.
b.j6 w.
c38: ; service int(sscir):
c39: ; service int(isrpy):
rl w0 x1+s1 ;
sn w0 0 ; if state=0 then
jl. j3. ; goto get next;
rl w3 x1+a230+6 ;
rl w0 x1+a230+2 ; status(answer):=event status(std status);
ds w0 g21 ; function(answer):=rem char count(std status);
rl w3 x1+a230+4 ; unitno<18+exf addr(answer):=curr status(std status);
rs w3 g22 ;
rl w3 x1+a244 ;
rs w3 g23 ;***
se w3 0 ; if io-result<>ok then
jl. j0. ; goto error;
se w0 2 ; if function=2 then
jl. m3.
rl w0 x1+s2 ; stopped(sender):= 1;
lo w0 x1+s0
rs w0 x1+s2
; return answer to sender of messsage.
m3: am 1-3 ; result1: result:=1;
m4: am 3-4 ; result3: result:=3;
m5: al w0 4 ; result4: result:=4;
rl w3 x2+16 ;***
rs w3 g24 ;***
jl w3 g19 ; deliver result;
al w0 0 ;
rs w0 x1+s1 ; state:=ready;
j3: jl w3 g25 ; getnext: next operation;
jl. m0. ; goto next;
; after io-error.
j0: rl w0 x1+s2 ; error:
lo w0 x1+s0 ; stopped(sender):= 1;
rs w0 x1+s2
sn w3 6 ; if io-result=6 then
jl. j2. ; goto power up;
se w3 3 ; if io-result<>3 then
jl. m5. ; goto result4;
j1: am -1+2 ; timeout: function:=-1;
j2: al w0 -2 ; power up: function:=-2;
al w3 0 ;
ds w0 g21 ; status:=0;
jl. m3. ; goto result1;
e.
e. ; end of rc8601.
z.
h72=g2, h74=g2, h76=g2, h78=g2
▶EOF◀