|
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: 67584 (0x10800)
Types: TextFile
Names: »kkmc«
└─⟦621cfb9a2⟧ Bits:30002817 RC8000 Dump tape fra HCØ. Detaljer om "HC8000" projekt.
└─⟦0364f57e3⟧
└─⟦this⟧ »kkmc«
\f
m. moncentral - monitor central logic
b.i30 w.
i0=81 04 06, 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
; segment 1 : enter monitor after load
; the monitor is entered in word 8. the words +2,+4 must at entry contain -
; +2 load flag, writetext
; +4 medium
; where
; load flag: 1 autoload of device controllers
; 0 no autoload
s. i2
w.
i0: i2. ; length of segment 1
0 ; init cat switch: writetext
i1: 0 ; init cat switch: medium
; entry from autoloader:
al. w3 i0. ; calculate top address of
rl w2 x3 ; last segment;
wa w3 4 ;
se w2 0 ; (i.e. until segment size = 0)
jl. -6 ;
al. w2 i2. ; insert start address of segment 2;
dl. w1 i1. ; get init cat switches
jd x3-2 ; jump to segment 10
i2: ; first word of segment 2
; exit with:
; w0, w1 = init cat switches
; w2 = start address of segment 2
e. ; end segment 1
b. v100, r28, g70, f20, e62, d140, c200
\f
; segment 2: monitor
s. k = 8, j0
w.b127=k, j0, k=k-2
; segment structure:
; monitor table (b names)
; interrupt response (c names)
; utility procedures (d names)
; monitor procedures (e names)
; name table (f names)
; process descriptions (f names)
; buffers (f names)
;
; (g and h and i names are used locally)
; monitor table
; all addresses are absolute addresses
; an integer after the semicolon means, that the address can't
; be changed, because it - unfortunately - has been published
; or because they have a hardware-function
b65: 0-0-0 ; 8: base of controller description table
b66: c25 ; 10: power up entry
b67: 0-0-0 ; first controller table entry
b68: 0-0-0 ; top controller table entry
b69: b69 ; queue head: software timeout
b69 ; (for devices)
b70: 0 , 0 ; time when last inspected
b72: 0-0-0 ; b53 ; start of interrupt table
b73: 0-0-0 ; b54 ; max external interrupt number
b0: 0-0-0 ; b53 - b16 ; (relative start of interrupt table
b74: a198 ; device address of this cpu
b75: 0 ; after powerfail (0==false, else true)
b18: 0 ; current buffer address
b19: 0 ; current receiver
b20: c96 ; address of simple wait event procedure
b21: 0-0-0 ; owner of std-driver-locations
b101:0 ; return from subprocs
b102:0-0-0 ; a66 ; start of table(subproc-drivers)
b103:0 ; address of entry for send message for linkdriver areas
b76: 0 ; start of secondary interrupt chain
b30: 0-0-0 ; errorlog proc
b31: g66 ; errorlog entry
r. (:64-k+2:) > 1 ; 60-62 reserved for testprograms
a135<12+a136 ; 64: release, version of monitor
b1: 0 ; 66: current process
b2: b2 ; time slice queue head: next process
b2 ; last process
b3: 0-0-0 ; 72: name table start
b4: 0-0-0 ; 74: first device in name table
b5: 0-0-0 ; 76: first area in name table
b6: 0-0-0 ; 78: first internal in name table
b7: 0-0-0 ; 80: name table end
b8: b8 ; mess buf pool queue head: next buf
b8 ; last buf
0-0-0 ; 86: first byte of mess buf pool area
0-0-0 ; 88: last byte of mess buf pool area
a6 ; 90: size of message buffer
b22: 0-0-0 ; 92: first drum chain in name table
b23: 0-0-0 ; 94: first disc chain in name table
b24: 0-0-0 ; 96: chain end in name table
b25: 0 ; 98: main cat chain table
0-0-0 ;(100) not used ???
b10: a85 ; maximum time slice
b11: 0 ;104: time slice (of current process)
0 ;106: zero (earlier: micro seconds)
b13: 0 , 0 ;108:110: time (unit of 0.1 milli seconds)
b14: 0 ; last sensed clock value
0 ; (not used)
b12: 0-0-0 ;116: number of storage bytes
a111<12 + a109 ;118: min global key, min aux cat key ?????
b15: 0 , 0 ; clockchange, after set clock:
; newtime - oldtime
c.a400-1
b27: 0 ;124: first process extension(cur)
b28: 0 ;126: second process extension(cur)
b141:0 ;128: coroutine testoutput address
; links to cmon procedures:
b140:c100 ;130: address of cmon procedure start
c101 ;132: - '' - wait
c102 ;134: - '' - pass
c103 ;136: - '' - inspect
c104 ;138: - '' - csendmessage
c105 ;140: - '' - cwaitanswer
c106 ;142: - '' - answer_arrived
c107 ;144: - '' - signal_binary
c108 ;146: - '' - signal_sem
c109 ;148: - '' - wait_sem
c110 ;150: - '' - signal_chained
c111 ;152: - '' - inspect_chained
c112 ;154: - '' - wait_chained
c113 ;156: - '' - sem_send_mess
c114 ;158: - '' - sem_answer_proc
c115 ;160: - '' - message_received
c116 ;162: - '' - timer_message
c117 ;164: - '' - timer_scan
c118 ;166: - '' - cregretmessage
c119 ;168: - '' - user testoutput
z.
b26 = b5 ; use area processes as pseudo processes
; definition of general registers in rc8000
b90 = 8.14 * 2 ; ilevc : interrupt level limit copy
b91 = 8.15 * 2 ; inf : current interrupt stack element address
b92 = 8.17 * 2 ; size : top available core address
b93 = 8.20 * 2 ; montop : 1 < 11 - top monitor procedure number
b94 = 8.62 * 2 ; clock
b95 = 8.57 * 2 ; ir : used to clear selected bits in interrupt reg
b97 = 8.60 * 2 ; dswr : data swithes
b98 = 8.61 * 2 ; regsel : register swithes
b99 = 8.60 * 2 ; display
;
b100= 8.21*2 ; cpukind: 0: /45
; -1: /15, /25, /35
; 50: /50
; 55: /55
; definition of interrupt stack.
; parameters are relative to base of stack element (i.e. 1,3,5,..)
b.j0
j0=-1 , j0=j0+2 ; base of stack element
a326=j0 , j0=j0+2 ; regdump
a327=j0 , j0=j0+2 ; exception routine
a328=j0 , j0=j0+2 ; escape routine
a329=j0 , j0=j0+2 ; monitor call entry
a330=j0 , j0=j0+2 ; external interrupt entry
a331=j0 , j0=j0+2 ; interrupt limits, disabled/enabled
a325=j0-a326 ; size of interrupt stack element
e.
; external interrupt entry:
;
; when an external interrupt occurs, or when 'user exception first'
; or 'user escape first' are zero, the cpu will save all registers
; in the current process descrition.
; exit is made to here with:
; w1 = top register dump
; w2 = 2 * interrupt number
; ex = 0
c1: wa w2 b0 ; monfunc := cause + int.table.base - mon.proc.base;
; monitor call entry:
;
; if the current process executes a montor call, the cpu will
; save all the registers in the current process description.
; exit is made to here with:
; w1 = top register dump
; w2 = monitor function
; ex = 0
c0: al w1 x1-a178 ; w1 := current process;
jl. (x2+b16.) ; switch out through int.table or monproc.table;
; second level external interrupt entry:
;
; exit is made to here with:
; w1 = top register dump
; w2 = 2 * interrupt number
c8: sn w2 2*6 ; if cause = powerfail then
jl c6 ; goto power fail routine;
jl -3<1 ; halt;
; program errors in the current process are transferred to here,
; (as external interrupts):
;
; w1 = cur
c2: ; internal interrupts, overflow, spill, escape errors:
c3: ; monitor bugs (i.e. exception- or escape-addresses
; outside write-limits of process)
c4: ; bus error in operand transfer: (no strategy yet)
c5: ; bus error in instruction fetch: (- - - )
jl w2 (b31) ; call errorlog
al w0 a96 ; state := running after error;
jl w3 d9 ; remove internal(cur, running after error);
jl c99 ; goto interrupt return;
; parameter errors in monitor call:
;
; all monitor procedures check that the parameters are
; within certain limits.
; if the parameters are wrong, the calling process is break'ed.
;
; (all regs irrellevant)
b. j10 w. ;
; definitin of exception regdump:
j0 = a29 - a28 ; w0, w1
j1 = a31 - a28 ; w2, w3
j2 = a33 - a28 ; status, ic
j3 = a177- a28 ; cause, sb
a180 = j3 + 2 ; top of exception regdump = new rel ic
c29: ; internal 3:
rl w1 b1 ;
al w3 6 ;
rs w3 x1+a176 ; cause (cur) := 6; i.e. monitor call break;
rl w2 x1+a27 ; w2 := exception address (cur);
sn w2 0 ; if exception address = 0 then
jl c2 ; goto internal interrupt;
al w3 x2 ; save w2 and
jl w2 (b31) ; call errorlog
al w2 x3 ; restore w2
wa w2 x1+a182 ; w2 := abs exception address;
dl w0 x1+a29 ; move: save w0
ds w0 x2+j0 ; save w1
dl w0 x1+a31 ; save w2
ds w0 x2+j1 ; save w3
dl w0 x1+a33 ; save status
ds w0 x2+j2 ; save ic
; rs w0 x1+a28 ; save w0 := save ic;
; al w0 14<2+0 ;
; rs w0 x1+a29 ; save w1 := 'jd'-instruction;
dl w0 x1+a177 ; save cause (= 6)
ds w0 x2+j3 ; save sb to user exception addres;
; rs w0 x1+a30 ; save w2 := save sb;
; rs w3 x2+a31 ; save w3 := save cause (= 6);
ws w2 x1+a182 ; w2 := logic user exception address;
al w2 x2+a180 ;
rs w2 x1+a33 ; save ic := exception address + no of regdump bytes
e. ;
;. ..... husk at nulstille addresse-bits i status .....
; continue with interrupt return;
; interrupt return:
; a new internal process may have been put up in front of
; the time slice queue, due to an external interrupt, or because
; the current monitor call was 'send message' or the like.
; therefore it must be tested, that the current process is still
; the one in front. if not: select that one.
c24: ; dummy interrupt
c99: ; interrupt return:
dl w2 b2 ; w1 := cur; w2 := first in time slice queue;
sn w1 x2-a16 ; if cur = first then
ri a179 ; return interrupt;
; (preferably without reloading limit-copies)
; initialize the previous interrupt stack element:
al w2 x2-a16 ; cur := new cur; i.e. first in time slice queue;
rs w2 b1 ;
rl w0 x2+a35 ; time slice := quantum(new current);
rs w0 b11 ;
gg w3 b91 ; w3 := inf (= address of current stack element);
dl w1 x2+a170 ; move: user escape address (cur)
; user exception address (cur)
ds w1 x3+a325+a328;
al w0 x2+a28 ; address of regdump area (cur)
rs w0 x3+a325+a326; to: previous interrupt stack element;
c.a400-1
; insert process extension addresses in monitor table
dl w1 x2+a306 ;
wa w0 x2+a182 ;
wa w1 x2+a182 ;
ds w1 b28 ;
z.
; if the new current process is a driver process then maybe
; exchange driver std-locations:
rl w0 x2+a302 ; if the new current process has not
se w0 0 ; defined a 'wait first event'
sn w2 (b21) ; or the new cur = owner of std-locations then
ri a179 ; return interrupt;
; (limit-copies must be initialized)
; the contents of the std-driver-locations have to be exchanged:
;
; save the old contents in the outpointed process description:
;
rl w3 b21 ; w3 := previous owner of std locations;
dl w1 g21 ; move: g20
ds w1 x3+a302+4 ; g21
dl w1 g23 ; g22
ds w1 x3+a302+8 ; g23
rl w1 g24 ; g24
rs w1 x3+a302+10; b18
dl w1 b19 ; b19
ds w1 x3+a302+14; to: previous process description;
; restore the std-locations from the new current process:
rs w2 b21 ; new owner := current process;
dl w1 x2+a302+4 ; move: g20
ds w1 g21 ; g21
dl w1 x2+a302+8 ; g22
ds w1 g23 ; g23
rl w1 x2+a302+10; g24
rs w1 g24 ; b18
dl w1 x2+a302+14; b19
ds w1 b19 ; from: new current process;
ri a179 ; return interrupt;
; (limit-copies must be initialized)
; power failure:
;
; may occur at any level
;
; save the current interrupt stack entry address, unless
; already saved
; (this should prevent powerfail-cascades from disturbing the system)
b. h10, i10 w. ;
c6: gg w2 b91 ; w2 := current stack element;
rl w3 h0 ; w3 := previous power up element;
sn w3 0 ; if previous element is free then
rs w2 h0 ; power up element := current stack element;
al w2 0 ; ilevc := 0;
gp w2 b90 ; (i.e. the following will provoke a systemfault)
jl -1<1 ; halt;
h0: b49 ; power up element: initially monitor element
; power up:
;
; initialize: montop (i.e. max monitor function)
; size (i.e. core size)
; inf (i.e. power up element)
;
; clear any pending interrupt bits, because they may be irrellevant
;
; entry conditions:
; inf register = 1
; totally disabled
c25: al w3 -1<11 ; montop := 1 < 11
ac w3 x3+b17 ; - top monitor function number;
gp w3 b93 ;
rl w3 b12 ; size := number of storage bytes;
gp w3 b92 ;
c.(:a90>0 a.1:)-1
jl. w3 d140. ; dump core via fpa
z.
al w3 6 ; ilevc := 0 < 12 + 6;
gp w3 b90 ; i.e. enable for powerfail;
rl w3 h0 ; w3 := power up element;
sn w3 0 ; if power up element = 0 then
jl -2<1 ; halt; i.e. power fail was not serviced;
rs w3 b75 ; after powerfail := true;
; (should be tested by clockdriver)
rl w2 b73 ; intno := max external interrupt number;
i0: gp w2 b95 ; rep: clear (intno) in cpu;
al w2 x2-1 ; intno := intno - 1;
sl w2 6+1 ; if intno > powerfail then
jl i0 ; goto rep;
al w1 0 ; (prepare a new h0...)
je k+2 ; (if any power fail during this start up,
jd k+2 ; it will be 'serviced' now, i.e. systemfault)
; the following sequence of instructions have to be executed
; without any disturbance, else the system won't work
rs w1 h0 ; clear previous power up element;
; (i.e. prevent two consecutive powerups)
gp w3 b91 ; inf := power up element;
ri a179 ; return interrupt;
; (the limit-copies must be initialized)
e. ; end of power fail/restart
; procedure deliver external interrupt
;
; when an external interrupt is accepted by the monitor,
; control is transferred out into the corresponding
; device description, which should contain:
;
; dev descr + a240 : jl w2 c51
;
; return must be made to the standard interrupt return action,
; which will take care of a possible selection of the driver.
;
; call: w2 = dev descr + a241
; return address = interrupt return
c51: rl w3 x2-a241+a230; w3 := top of executed channel program;
al w0 4 ; result := 4; (i.e. prepare for abnormal termination)
se w3 0 ; if top command address defined then
bl w3 x3-6+1 ; w3 := last command executed;
sn w3 -1<8 ; if last command = 'stop' then
al w0 0 ; result := 0;
sn w3 4<8 ; if last command = 'wait' then
al w0 5 ; result := 5;
c50: al w3 c99 ; link := interrupt return;
; continue with deliver interrupt
; procedure deliver interrupt
; function: delivers the interrupt operation in the event queue
; of the corresponding driver process.
; the driver process is started, if it was waiting for
; an event.
;
; call: w0 = result (=0, 1, 2, 3, 4, 5, 6), w2 = operation, w3 = link
; exit: all regs undef
; return address: link
b. h10 w. ;
d121:rs w3 h0 ; save (return);
jl w1 d131 ; set result and descrease all stopcounts;
; w2 = device descr
rl w1 x2+a250 ; driver := driverproc (device descr);
sh w1 0 ; if driver undefined then
jl (h0) ; return;
al w2 x2+a241 ; oper := timeout operation (device descr);
rl w3 h0 ; restore (return);
bz w0 x1+a13 ; state := state(driver);
sn w0 a104 ; if driver is waiting for event then
jl d127 ; goto take interrupt;
al w1 x1+a15 ; link (event queue (driver) , oper);
jl d6 ; return;
h0: 0 ; saved return;
e. ;
; procedure take interrupt
; function: let the driver receive the interrupt operation at once
;
; call: w1 = driver process, w2 = interrupt operation, w3 = link
; exit: all regs undef
; return address: link
d127:al w2 x2-a241+a246;
rs w2 x1+a30 ; save w2 (driver) := address of driver service inst
al w0 2 ; save w0 (driver) := 2; i.e. indicate interrupt;
rs w0 x1+a28 ; link internal (driver);
; (only relevant after deliver interrupt)
jl d10 ; return;
; procedure prepare driver(proc)
; function: initializes current external process and current buffer
; exits to the interrupt address given in proc:
; int addr : normal exit
;
; the call must be made like this:
;
; proc + a246: jl w1 c30 ; driver service instruction
; ---
; proc + a245: interrupt address
; ---
; proc + a54 : next message buf
;
; call: w1 = proc + a247
; exit: w0 = result(proc), w1 = proc, w2 = buf(proc)
; int.addr : normal exit
c30: al w1 x1-a247 ;
rs w1 b19 ; current receiver := buf;
rl w2 x1+a54 ;
rs w2 b18 ; current buffer address := next mess(proc);
rl w0 x1+a244 ; result := timeout(proc);
jl (x1+a245) ; goto interrupt address(proc);
; procedure clear device
;
; function: everything is cleared-up in the device description,
; i.e. the controller is reset (except after 'wait'-program)
; a possible pending interrupt is cleared
; a possible pending interrupt operation is removed
; if any stopcounts were increased, they will be decreased
;
; call: w1 = link, w2 = device descr
; exit: w2 = unchanged, w0, w1, w3 = undef
; return address: link
d129: ; unconditionally reset:
am a235-a225; (point at something <> 0)
d130: ; conditionally reset:
rl w0 x2+a225 ; get transfer code to see if transfer in progress;
rl w3 x2+a235 ; w3 := device address(device description);
; it should be noted, that the controller is not reset when a wait-program is timed out
se w0 0 ; if transfer code <> 0 then
do w3 x3+2.01<1 ; reset device (device address);
ls w3 1 ; entry := device address
ls w3 -1 ; (remove bit 0)
wa w3 b65 ; + controller table base;
rl w0 x3+a313 ; w0 := interrupt number(controller table (entry));
gp w0 b95 ; clear interrupt bit in cpu;
al w2 x2+a242 ; oper := timeout operation(device descr);
; continue with set result and decrease all stopcounts
; (result = undef)
; procedure set result and decrease all stopcounts
;
; call: w0 = result: 0 = transfer terminated by stop
; 1 = bus reject when started
; 2 = bus timeout when started (i.e. disconnected)
; (3 = software timeout)
; 4 = transfer terminated, before stop
; 5 = wait-program terminated
; (6 = power restart)
; w1 = link w2 = timeout operation
; exit: w2 = device description, w0, w1, w3 = undef
d131:rs w0 x2-a241+a244; save result in timeout-field;
se w2 (x2) ; (if in timer queue then
jl w3 d5 ; remove(timeout operation); )
al w2 x2-a241 ; w2 := device descr;
; continue with decrease all stopcounts
; procedure decrease all stopcounts
;
; function: if any stopcounts increased, then decrease them again
; transfer code(device descr) := 0
;
; call: w1 = link, w2 = device descr
b. h10, i10 w. ;
d132:ds w2 h1 ; save (link, device descr);
rl w1 x2+a225 ; get transfer code(device descr);
sn w1 -1 ; if no transfer to processes then
jl i1 ; goto clear up;
so w1 2.1 ; if transfer code odd then
jl i0 ; begin i.e. transfer to/from driver area;
rl w1 x2+a250 ; driver := driver process (device descr);
jl w3 d133 ; decrease stopcount(driver);
rl w2 h1 ; restore(device descr);
al w1 -1<1 ;
la w1 x2+a225 ; restore (transfer code) (even)
i0: ; end;
sn w1 0 ; if transfer code shows transfer to/from sender the
jl i1 ; begin
jl w3 d133 ; decrease stopcount(sender);
rl w2 h1 ; restore (device descr);
; end;
i1: al w1 0 ; clear up:
rs w1 x2+a225 ; transfer code(device descr) := 0; i.e. no transfer
jl (h0) ; return;
h0: 0 ; saved return
h1: 0 ; saved device descr
e. ;
; procedure decrease stopcount
;
; function: the stopcount of the process is decreased by 1.
; if the stopcount becomes zero, and the process is waiting
; to be stopped, the process is stopped now (i.e. put in
; the state 'waiting for start by...'), and the following will
; be done:
; if the process was stopped by its parent, the stop-answer
; will be send to the parent (as defined by the wait-address
; in the process), indicating that the stopping has been
; accomplished.
; the decrease-action is repeated for the parent etc.etc.
;
; call: w1 = process, w3 = link
; exit: all regs undef
; return address: link
b. i10 w. ;
d133: ; decrease stopcount:
i0: al w0 -1 ; loop:
ba w0 x1+a12 ; stopcount (process) :=
hs w0 x1+a12 ; stopcount (process) - 1;
bz w2 x1+a13 ;
sn w0 0 ; if stopcount <> 0 or
so w2 a105 ; process not waiting for being stopped then
jl x3 ; return;
al w0 x2+a106 ; state (process) := state (process)
hs w0 x1+a13 ; + 'waiting for start';
; prepare for repeating the loop:
rl w2 x1+a40 ; buf := wait address(process);
rl w1 x1+a34 ; process := parent (process);
se w0 a99 ; if state <> 'waiting for start by parent' then
jl i0 ; goto loop;
; prepare the buffer for returning the answer:
al w0 1 ; receiver(buf) := result := 1;
rs w0 x2+a141 ;
al w0 x3 ; (save return)
jl. w3 d15. ; deliver answer(buf);
rl w3 0 ; (restore return)
jl i0 ; goto loop;
e. ;
; return result in save w0(cur);
; entry: w1=cur
r5: am 5-4 ;
r4: am 4-3 ;
r3: am 3-2 ;
r2: am 2-1 ;
r1: am 1-0 ;
r0: al w0 0 ;
r28: rs w0 x1+a28 ; save w0:=result;
jl c99 ; goto interrupt return;
; elementary link-procedures:
; procedure remove(elem);
; comment: removes a given element from its queue and leaves the element linked to itself.
; call: w2=elem, w3=link
; exit: w0, w1, w2=unchanged, w3=next(elem)
; return address: link
b. i1 w.
d5: rs w3 i0 ; save return;
rl w3 x2 ; w3 := next(elem);
rx w2 x2+2 ; w2 := prev(elem); prev(elem) := elem;
rs w3 x2 ; next(w2) := next(elem);
rx w2 x3+2 ; w2 := elem; prev(next(elem)) := old prev(elem);
rs w2 x2 ; next(elem) := elem;
jl (i0) ; return;
; procedure increase bufclaim, remove release buf;
; comment: bufclaim(cur) is increased, continue with release buf
; call: w1=cur, w2=buf, w3=link
; exit: w0, w1=undef, w2, w3=unchanged
; return address: link
d109: ;
al w0 1 ;
ba w0 x1+a19 ; increase(bufclaim(cur));
hs w0 x1+a19 ;
; continue with d106
; procedure remove release buf;
; comment: removes the buffer from its queue, continue with release mess buf
; call: w2=buf, w3=link
; exit: w0, w2, w3=unchanged, w1=undef
; return address: link
d106: ;
al w1 x3 ; save return
jl w3 d5 ; remove (buf);
al w3 x1 ; restore return;
; continue with d13
; procedure release mess buf(buf);
; comment: clears sender and receiver and links the buffer to the pool.
; call: w2=buf, w3=link
; exit: w0=unchanged, w1=undef, w2, w3=unchanged
; return address: link
d13: al w1 0 ; sender(buf):=0;
rs w1 x2+4 ; receiver(buf):=0;
rs w1 x2+6 ;
c. (:a128>2 a. 1:) - 1; if rc6000 then
rl w1 b8 ; head:=next(mess buf pool); (i.e. link in front of pool)
z. ; else
c. - (:a128>2 a. 1:) ;
al w1 b8 ; head := mess buf pool head; (i.e. link in rear);
z. ;
; procedure link(head, elem);
; comment: links the element to the end of the queue
; call: w1=head, w2=elem, w3=link
; exit: w0, w1, w2=unchanged, w3=old last(head);
d6: rs w3 i0 ; save return;
rl w3 x1+2 ; old last:=last(head);
rs w2 x1+2 ; last(head):=elem;
rs w2 x3+0 ; next(old last):=elem;
rs w1 x2+0 ; next(elem):=head;
rs w3 x2+2 ; last(elem):=old last;
jl (i0) ; return;
i0: 0 ; saved return: remove, link
e.
; procedure remove user(internal, proc);
; procedure remove reserver(internal, proc);
; comment: removes the id-bit of internal from the reserver- and-or userbits
; call: w1=internal, w2=proc, w3=link
; exit: w0=undef, w1,w2,w3=unchanged
; return address: link
b. i0 w.
d123:rs w3 i0 ;
ba w2 x1+a14 ; w2:=addr of rel. halfword;
bz w0 x2+a402 ; w0:=userbits.curr.intproc;
bz w3 x1+a14+1 ; w3:=userbit.intproc
sz w0 x3 ; if userbit.curr.intproc is on then
bs w0 x1+a14+1 ; remove userbit.curr.intproc;
hs w0 x2+a402 ; return userbits;
bs w2 x1+a14 ; reset w2 to addr(extproc)
d124:rl w0 x2+a52 ; w0:=reserver.proc;
sn w0 (x1+a14) ; if intproc is reserver then
al w0 0 ; remove intproc as reserver
rs w0 x2+a52 ; clear reserver;
jl (i0) ; return;
i0:0
e.
; procedure insert reserver(internal, proc);
; procedure insert user(internal, proc);
; comment: adds the id-bit of internal to reserver- and-or userbits
; call: w1=internal, w2=proc, w3=link
; exit: w0=undef, w1,w2,w3=unchanged
; return address: link
d125:
rl w0 x1+a14 ; w0:=idbit.intproc;
rs w0 x2+a52 ; extproc.reserver:=idbit.intproc;
d126:
ba w2 x1+a14 ;
bz w0 x2+a402 ; w0:=userbits.curr.intproc;
lo w0 x1+a14 ; set curr.intproc as user of extproc;
hs w0 x2+a402 ;
bs w2 x1+a14 ; reset w2;
jl x3 ; return
; procedure check user;
;
; call: w1=internal, w2=proc, w3=link
; exit: w0=undef, w1, w2, w3=unchanged
; return address: link+2: cur was user
; link : cur was not user
d102: ;
ba w2 x1+a14 ;
bz w0 x2+a402 ; w0:=userbits.curr.intproc;
bs w2 x1+a14 ; reset w2;
sz w0 (x1+a14) ; if curr.intproc is user then
jl x3+2 ; return to link+2: i.e. user
jl x3 ; return to link: not user
; procedure check any reserver;
;
; call: w1=internal, w2=proc, w3=link
; exit: w0=undef, w1, w2, w3=unchanged
; return address: link : other process is reserver
; link+2: internal is reserver
; link+4: not reserved by anyone
d113: ;
rl w0 x2+a52 ; if reserver(proc)=0 then
sn w0 0 ;
jl x3+4 ; return to link+4; i.e. not reserved
se w0 (x1+a14) ; if reserver(proc) <> idbit(cur) then
jl x3 ; return to link; i.e. other reserver;
jl x3+2 ; return to link+2; i.e. already reserved
; procedure check mess area and name(save w3) area;
; procedure check name(save w3) area;
; procedure check name(save w2) area;
; comment: checks that the areas are within the process
; call: w1=cur, w3=link
; exit: w0=undef, w1=unchanged, w2=name, w3=unchanged
; return address: link: within process
; c29 : not within process
d110: ; check message area and name area:
rl w2 x1+a29 ;
al w0 x2+14 ; mess:=save w1(cur);
sh w0 0 ;
jl c29 ; if overflow or
sl w2 (x1+a17) ; mess<first addr(cur) or
sl w0 (x1+a18) ; mess+14>=top addr(cur) then
jl c29 ; goto internal 3;
d17: am a31-a30; check name(save w3) area:
d111: ; check name(save w2) area:
rl w2 x1+a30 ;
al w0 x2+6 ;
; procedure check within(first, last);
; comment: checks that the specified area is within the process
; call: w0=last, w1=cur, w2=first, w3=link
; exit: w0, w1, w2, w3=unchanged
; return address: link: within process
; c29 : not within process
d112: ; check within:
sh w0 0 ;
jl c29 ; if overflow or
sl w2 (x1+a17) ; first<first addr(cur) or
sl w0 (x1+a18) ; last>=top addr(cur) then
jl c29 ; goto internal 3;
jl x3 ; return;
; procedure check message area and buf (=d18+d12);
;
; call: w1=cur, w3=link
; exit: w0=undef, w1=cur, w2=buf, w3=unchanged
; return address: link: ok
; c29 : mess area outside cur
; c29 : buf not message buf
d103: ;
rl w2 x1+a29 ; mess:=save w1(cur);
al w0 x2+14 ;
sh w0 0 ; if overflow or
jl c29 ;
sl w2 (x1+a17) ; mess<first addr(cur) or
sl w0 (x1+a18) ; mess+14>=top addr(cur) then
jl c29 ; goto internal 3;
; procedure check message buf;
; comment: checks whether the save w2 of the internal process is a message buffer address
; call: w1=internal, w3=link
; exit: w0=undef, w1=cur, w2=buf, w3=unchanged
; return address: link: buffer ok
; c29 : save w2 not message buffer
d12: rl w2 x1+a30 ; buf:=save w2(internal);
sl w2 (b8+4) ; if buf<mess buf pool start or
sl w2 (b8+6) ; buf >=mess buf pool end then
jl c29 ; goto internal 3;
al w1 x2 ;
ws w1 b8+4 ; if (buf-pool start) mod mess buf size
al w0 0 ; <>0 then
wd w1 b8+8 ; goto internal 3;
rl w1 b1 ; w1:=cur;
sn w0 0 ;
jl x3 ; return;
jl c29 ;
; procedure check event(proc, buf);
; comment: checks that buf is the address of an operation in the event queue of the internal process
; call: w1=proc, w2=buf, w3=link
; exit: w0=undef, w1, w2, w3=unchanged
; return address: link: buffer address ok
; c29 : buf is not in the queue
b. i0 w.
d19: al w0 x2 ;
al w2 x1+a15 ; oper:=event q(proc);
i0: rl w2 x2+0 ; next: oper:=next(oper);
sn w2 x1+a15 ; if oper=event q(proc) then
jl c29 ; goto internal 3; (i.e. not in queue);
se w0 x2 ; if buf<>oper then
jl i0 ; goto next;
jl x3 ; return;
e.
; procedure check and search name (=d17+d11);
;
; call: w1=cur, save w3(cur)=name, w3=link
; exit: w0, w1=unchanged, w2=name, w3=entry
; return address: link: entry not found
; link+2: entry found
; c29 : name area outside current process
b. i20 w.
d101: ;
ds w1 i1 ; save(w0, cur);
rl w2 x1+a31 ; name:=save w3(cur);
al w0 x2+6 ;
sh w0 0 ; if overflow or
jl c29 ;
sl w2 (x1+a17) ; name<first addr(cur) or
sl w0 (x1+a18) ; name+6>=top addr(cur) then
jl c29 ; goto internal 3;
dl w1 x1+a43 ; w0w1:=catbase(cur);
jl i14 ; goto search name(name, entry, base);
; the following procedures searches the name table for a given entry and delivers its entry in
; the name table. if name is undefined, the entry is name table end.
; procedure search name(name, entry);
; call: w2=name, w3=link
; exit: w0, w1, w2=unchanged, w3=entry
; return address: link : name not found, w3=(b7)
; link+2: name found
d11: ds w1 i1 ; save(w0, w1);
am (b1) ;
dl w1 +a43 ; base:=catbase(cur);
i14: al w3 x3+1 ; link := link + 1; i.e. destinguish between normal and error return;
; procedure search name(name, entry, base);
; call: w0, w1=base, w2=name, w3=link
; exit: w0, w1=undef, w2=unchanged, w3=entry
; return address: link : name not found, w3=(b7)
; link : name found, w3 <> (b7)
d71: ds w3 i3 ; save (name, return);
i4: al w1 x1-1;used ;
bs w0 i4+1 ;
ds w1 i6 ; base:=base+(1, -1);
dl w1 d73 ;
ds w1 i8 ; min base:=extreme;
rl w1 b7 ;
rs w1 i9 ; found:=name table end;
rl w1 b1 ; get physical name address
wa w2 x1+a182 ;
dl w1 x2+6 ;
ds w1 i13 ; move name to last name in name table;
dl w1 x2+2 ;
sn w0 0 ; if name(0)<>0 then
jl i18 ;
ds w1 i11 ;
rl w3 b3 ; for entry:=name table start
jl i17 ;
i15: dl w1 i11 ;
i16: al w3 x3+2 ; step 2 until name table end do
i17: rl w2 x3 ;
sn w1 (x2+a11+2) ; begin
se w0 (x2+a11+0) ; proc:=name table(entry);
jl i16 ;
dl w1 i13 ;
sn w0 (x2+a11+4) ;
se w1 (x2+a11+6) ; if name.proc=name and
jl i15 ;
sn w2 c98 ;
jl i18 ;
dl w1 x2+a49 ;
sl w0 (i7) ; lower.proc>=lower.min and
sl w0 (i5) ; lower.proc<=lower.base and
jl i15 ;
sh w1 (i8) ; upper.proc<=upper.min and
sh w1 (i6) ; upper.proc>=upper base then
jl i15 ; begin
ds w1 i8 ; min:=interval.proc;
rs w3 i9 ; found:=entry;
jl i15 ; end;
i18: ; end;
dl w0 i0 ; restore(w0, w1, w2);
dl w2 i2 ; w3:=found;
sn w3 (b7) ; if w3=name table end then
jl (i3) ; return to link
am (i3) ; else
jl +1 ; return to link+1;
i9: 0 ;i0-2: found (i.e. current best entry, or (b7))
i0: 0 ;i1-2: saved w0
i1: 0 ;i2-2: saved w1
i2: 0 ;i3-2: saved w2
i3: 0 ; saved return
i5: 0 ;i6-2: lower base+1 for search
i6: 0 ; upper base-1 for search
i7: 0 ;i8-2: lower minimum
i8: 0 ; upper minimum
; the last entry in name table must point here:
c98 = k-a11
i10: 0 ; name to search for
i11: 0 ;
i12: 0 ;
i13: 0 ;
a107 ; max base lower
d72: a108 ; max base upper
a107-1 ; extreme lower
d73: a108+1 ; extreme upper
e.
; procedure claim buffer
;
; call: w1=cur, w2=buf, w3=link
; exit: w0=undef, w1, w2, w3=unchanged
; return address: link: claim decreased ok
; c99 : claims exceeded, save w2(cur):=0
b. i0 w.
d108: ;
bz w0 x1+a19 ; if bufclaim(cur)=0 then
sn w0 0 ;
jl i0 ; goto no buffer;
bs. w0 1 ;
hs w0 x1+a19 ; decrease(bufclaim(cur));
ac w0 (x2+4) ;
rs w0 x2+4 ; receiver(buf):=-receiver(buf);
jl x3 ; return to link;
i0: rs w0 x1+a30 ; no buffer: save w2(cur):=0;
jl c99 ; goto interrupt return;
e.
; procedure regretted message
; comment simulates the release of a message buffer, as in wait answer. the bufclaim of the
; sender is increased. the buffer is removed and released (unless in state: received)
;
; call: w2=buf, w3=link
; exit: w0, w1, w2=unchanged, w3=undef
b. i20 w.
i0: 0 ; saved w0
i1: 0 ; saved w1
i2: 0 ; saved w2
i3: 0 ; saved w3
i8: 0 ; internal
d75: rs w3 i3 ; save(return);
ds w1 i1 ; save(w0, w1);
rl w1 x2+6 ; proc:=sender(buf);
sh w1 0 ; if proc<=0 then
jl i6 ; goto exit; (message already regretted);
ac w0 x1 ; (only relevant from remove process);
rs w0 x2+6 ; sender(buf):=-proc; (i.e. regretted);
rl w0 x1+a10 ; if kind(proc) = pseudo kind
sn w0 64 ; then proc:= main(proc);
rl w1 x1+a50 ; if proc is neither internal process nor
sz w0 -1-64 ; pseudo process
rl w1 x1+a250 ; then proc:= driver proc(proc);
bz w3 x1+a19 ;
al w3 x3+1 ; increase(bufclaim(proc));
hs w3 x1+a19 ;
; check if the buffer is claimed by receiver, or contains an answer:
rl w1 x2+4 ; receiver:=receiver(buf);
sh w1 0 ; if receiver<=0 then
jl i6 ; goto exit; (i.e. claimed);
sh w1 5 ; if receiver<=5 then
jl i5 ; goto remove and release; (i.e. an answer);
; the message is neither answered nor claimed:
rl w0 x1+a10 ; kind:=kind(receiver);
se w0 0 ; if receiver is internal process or
sn w0 64 ; pseudo process then
jl i5 ; goto remove and release;
i4: se w2 (x1+a54) ; if buf is first in queue then
jl i5 ;
al w0 -1 ; decrease(interrupt addr(proc))
wa w0 x1+a56 ;
sz w0 1 ; unless already odd
rs w0 x1+a56 ;
i5: jl w3 d106 ; remove release(buf);
i6: dl w1 i1 ; exit: restore(w0, w1);
jl (i3) ; return;
; procedure move mess(from, to);
; comment: moves 8 message (or answer) words from a given storage address to another.
; call: w1=from, w2=to, w3=link
; exit: w0=undef, w1, w2=unchanged, w3=undef
; return address: link
d14: rs w3 i3 ;
dl w0 x1+2 ;
ds w0 x2+2 ;
dl w0 x1+6 ; move 8 words from (from) to (to);
ds w0 x2+6 ;
dl w0 x1+10 ;
ds w0 x2+10 ;
dl w0 x1+14 ;
ds w0 x2+14 ;
jl (i3) ; return;
e.
; procedure update time(slice);
; comment: senses the timer and updates current time slice and time;
;
; call: w3=link
; exit: w0=undef, w1=unchanged, w2=slice, w3=unchanged
; return address: link
b. i9 w.
d7: gg w2 b94 ;
al w0 x2 ; new value:=sense(timer);
ws w2 b14 ; increase:=new value-clock;
rs w0 b14 ; clock:=new value;
sh w2 -1 ; if increase<0 then
wa w2 i9 ; increase:=increase+size of clock;
; comment: timer overflowed...;
al w0 x2 ;
wa w2 b11 ; slice:=slice+increase;
rs w2 b11 ;
wa w0 b13+2 ;
rs w0 b13+2 ; time low:=time low+increase;
sx 2.01 ;
jl i8 ; if carry then
jl x3 ;
i8: al w0 1 ; time high:=time high+1;
wa w0 b13 ;
rs w0 b13 ;
jl x3 ; return;
i9: 1<16 ; increase when timer overflows;
; the following entries removes the current process from the timequeue, and initializes state.
; call: w1=cur
; return address: interrupt return
d105: ; remove wait message:
; bz w0 x1+a19 ;
; sn w0 0 ; if buf claim(cur)=0 then
; jl d108 ; goto claim buffer (and exit with save w2=0);
am a102-a104 ; state:=wait message;
d107: ; remove wait event:
am a104-a103 ; state:=wait event;
d104: ; remove wait answer:
al w0 a103 ; state:=wait answer;
al w3 c99 ; return:=interrupt return;
; continue with remove internal;
; procedure remove internal(internal, proc state);
; comment: removes the internal process from the timer queue and sets its state
; after this a new current process is selected.
; call: w0=proc state, w1=cur, w3=link
; exit: w0, w1=undef, w2=cur+a16, w3=undef
; return address: link
d9: rs w3 i0 ; save(return);
hs w0 x1+a13 ; state(cur):=proc state;
jl w3 d7 ; update time(slice);
rs w2 x1+a35 ; quantum(cur):=slice;
dl w3 b13+2 ;
ds w3 x1+a39+2 ; start wait(cur):=time;
al w2 x1+a16 ;
rl w3 i0 ;
jl d5 ; remove(cur+a16);
; return;
i0: 0 ; saved return
; procedure link internal(proc);
; comment: links the internal process to the timer queue. the timer queue is kept as a
; sorted list, according to the priority. (the smaller the priority is, the better
; is the priority).
; if the time quantum is less than the maximum time slice, the process will be
; linked up in front of other processes with the same priority. otherwise in the
; rear (the time quamtum of the process is transferred to runtime(proc), except
; the amount which is already used of the next quantum).
; call: w1=proc, w3=link
; exit: w0, w1, w2, w3=undef
d10: bz w0 x1+a13 ; if state(proc) = running then
sn w0 a95 ;
jl x3 ; return;
rs w3 i0 ; save(return);
al w0 a95 ;
hs w0 x1+a13 ; state(proc):=running;
al w2 x1+a16 ;
rl w3 x1+a301 ; priority:=priority(proc);
rl w1 x1+a35 ;
sl w1 (b10) ; if quantum(proc)>=max slice then
jl i3 ; goto insert in rear;
al w3 x3-1 ; (code facility);
al w1 b2 ; worse:=timer q head;
i1: rl w1 x1 ; next: worse:=next(worse);
sl w3 (x1-a16+a301) ; if priority(worse)<priority then
jl i1 ; goto next;
i2: ; insert process:
jl w3 d6 ; link(worse, proc+a16);
se w3 b2 ; if proc is not linked as the front
jl (i0) ; internal then return;
rl w1 b1 ;
jl w3 d7 ; update time(slice);
rs w2 x1+a35 ; quantum(cur):=slice; (may actually be >= max slice);
sh w2 (b10) ; if old quantum <= max slice then
jl (i0) ; return;
; the following will take care of the round-robin time scheduling;
rl w2 (b2) ; proclink := second proc in timer queue;
jl w3 d5 ; remove(proclink);
rl w3 x2-a16+a301; priority:=priority(proc); (as above)
rl w1 x2-a16+a35 ; quantum:=quantum(proc); (as above)
; the process has been in front of the queue for more than the max time slice.
; the run time should be updated with all the quantum, but this would give the process a
; complete time slice next time. instead the used quantum is split in two parts:
; the amount by which it exceeds a multiplum of the max slice, and the rest. these parts
; are the increase in runtime and the new quantum.
; finally the process is inserted in the rear of the timer queue, according to priority.
i3: al w0 a85-1 ; w0 := mask for extracting new quantum;
la w0 2 ; quantum(proc) := quantum(proc) extract slice;
rs w0 x2-a16+a35;
ws w1 0 ;
al w0 0 ;
aa w1 x2-a16+a36+2; add the remaining part of quantum to
ds w1 x2-a16+a36+2; runtime(proc);
; at this point there is at least one process in the timer queue,
; i.e. either the dummy process or a 'better' process
; the following is intended for skipping quickly the dummy process:
rl w1 b2+2 ; worse := rear of timer queue; (normally dummy process);
sl w3 (x1-a16+a301); if priority >= priority(worse) then
jl i5 ; goto found; (only in case of inserting dummy process)
al w3 x3+1 ; (code facility)
i4: rl w1 x1+2 ; next: worse:=last(worse);
sn w1 b2 ; if worse<>timer q head and
jl i5 ;
sh w3 (x1-a16+a301) ; priority(worse)>priority then
jl i4 ; goto next;
; notice: the loop went one step to far . . .;
i5: rl w1 x1 ; now w1 has been repaired;
jl i2 ; goto insert proc;
e.
\f
; to facilitate the error recovery the interrupt stack and the
; stationary pointers of the monitor table are placed at fixed
; addresses.
b128=1200, 0,r.(:b128-k+2:)>1-6
a130 ; date of options
a131 ; time of options
0, r.4 ; room for machine id.
m. copies of some mon table entries, int stack, mon reg dump (24, 32, 26 hw)
; copy of some monitor pointers:
0-0-0 ; b3: 72: name table start
0-0-0 ; b4: 74: first device in name table
0-0-0 ; b5: 76: first area in name table
0-0-0 ; b6: 78: first internal in name table
0-0-0 ; b7: 80: name table end
0-0-0 ; b8+4: 86: first byte of mess buf pool area
0-0-0 ; b8+6: 88: last byte of mess buf pool area
0-0-0 ; b22: 92: first drum chain in name table
0-0-0 ; b23: 94: first disc chain in name table
0-0-0 ; b24: 96: chain end in name table
b50 ; start of interrupt stack
0-0-0 ; b86: driver proc save area
; definition of interrupt stack:
b50: 0 ; end of stack
b49=k-1 ; terminating stack-address
; power fail element:
0 ; (irrellevant regdump)
0 ; (exception disabled)
0 ; (escape disabled)
0 ; (monitor call not permitted in monitor)
c8 ; external interrupt, second level
1 < 23 + 0 ; monitor mode + totally disabled
; monitor element:
b52 ; monitor regdump
0 ; monitor exception routine
0 ; monitor escape routine
c0 ; monitor call entry
c1 ; external interrupt entry, first level
1 < 23 + 6 ; monitor mode + disable all but power/bus error
; user element:
0-0-0 ; user regdump (initialized by select internal)
0-0-0 ; user exception ( - - - - )
0-0-0 ; user escape ( - - - - )
; monitor regdump area
;
; used when initializing the whole system,
; and to hold the working registers etc. in case of
; powerfailure or buserror during monitor code
b52: 0 ; w0 = 0 (irrellevant)
0 ; w1 = 0 (irrellevant)
0 ; w2 = 0 (irrellevant)
0 ; w3 = 0 (irrellevant)
1 < 23 ; status = monitor mode
c99 ; ic = interrupt return
0 ; cause = 0 (irrellvant)
0 ; sb = 0 (irrellvant)
0 ; cpa = 0 (irrellevant)
0 ; base = 0 (irrellevant)
8 ; lower write limit
8.3777 7777 ; upper write limit = all possible core
0 < 12 + 6 ; interrupt limits
\f
; comment: the following utility procedures are used by external
; processes during input/output;
; procedure deliver result(result)
; comment: moves the general input/output answer to the beginning of the driver process.
; (the last 3 words of the message buffer are copied too, so they will remain unchanged).
; the answer is send with the specified result to the sender of the buffer.
;
; call: w0 = result, w3 = link, b18 = buffer
; exit: w0 = undef, w1 = proc (= b19), w2 = undef, w3= unchanged
; return address: link: answer delivered
; (internal 3 if buf not claimed and claims exceeded)
b. i10 w.
g3: am 5-4 ; result 5:
g4: am 4-3 ; result 4:
g5: am 3-2 ; result 3:
g6: am 2-1 ; result 2:
g7: al w0 1 ; result 1: w0 := result;
rl w3 b20 ; return := wait-next action in driver process;
jl g19 ; goto deliver result;
g18: al w0 1 ; result 1: w0 := result;
g19: ; deliver result:
jd k+2 ; disable;
ds w0 i3 ; save(link, result);
rl w1 b1 ;
rl w2 b18 ; buf := current buffer;
ac w3 (x2+4) ;
sl w3 0 ; if receiver(buf) > 0 then
jl i0 ; begin comment: buf not claimed, see link operation;
bz w0 x1+a19 ; if bufclaim(cur) <> 0 then
sn w0 0 ; begin
jl i0 ; decrease(bufclaim(cur));
bs. w0 1 ; receiver(buf) := -receiver(buf);
hs w0 x1+a19 ; end; (i.e. claims exceeded will provoke a break below);
rs w3 x2+4 ; end;
i0: rl w0 x1+a182 ;
rl w1 x1+a302 ;
wa w1 0 ; get physical address of save area
dl w0 x2+a151 ; save first four words of mess.
ds w0 g29 ; (used by errorlog )
dl w0 x2+a153 ;
ds w0 g30 ;
dl w0 x2+22 ; move last 3 words from buf
ds w0 x1+14 ; to area;
rl w0 x2+18 ; (to retain compatibility with old conventions)
rl w3 g24 ;
ds w0 x1+10 ; move the 5 std answer words
dl w0 g23 ; to area;
ds w0 x1+6 ;
dl w0 g21 ;
ds w0 x1+2 ; (you are disabled, so do not worry about timeslicing...);
dl w0 i3 ; restore (link, result);
am (b1) ;
rl w1 +a302 ; get logical address of save area
jd 1<11+22; send answer(result, area, buf);
rl w1 b19 ; w1 := current receiver;
rl w2 x1 ; if kind of receiver=subprocess then
se w2 84 ; check status
sn w2 85 ; else return
jl. i1. ;
jd x3 ;
i1: rl w2 g20 ; if one or more of statusbits 1,2,4,9,10,11
se. w1 (b32.) ; or if receiver = special watched receiver
sz. w2 (i5.) ; then
jl w2 (b31) ; call errorlog
jd x3 ; restore link and return
i2: 0 ; saved link
i3: 0 ; saved result
b32: 0 ; proc adr for special watched receiver
m. statusmask for errorlog
i5: 8.36070000 ; status mask: bit 1 2 3 4 9 10 11
; procedure link operation (buf)
; comment: links a message to the receiver and returns to the receiver, in case it is the only
; message in the queue (and interrupt address is even).
; otherwise it returns to the wait-next action in the driver process.
;
; call: w2 = buf, w3 = link
; exit: w0 = operation, w1 = proc, w2 = unchanged, w3 = unchanged
; return address: link: single in queue
; (b20): others in queue
; (b20): interrupt addr odd (i.e. driver busy)
g17: jd k+2 ; link operation:
rs w3 i3 ; save return;
ac w3 (x2+4) ;
sh w3 0 ; if receiver(buf) < 0 then
jl i4 ; begin comment: buf claimed. now release claim;
rs w3 x2+4 ; receiver(buf) := -receiver(buf); i.e. positive;
rl w1 b1 ;
bz w3 x1+a19 ; increase(buf claim(cur));
al w3 x3+1 ;
hs w3 x1+a19 ; end;
i4: am (b19) ;
al w1 +a54 ;
jl w3 d6 ; link(mess q(proc), buf);
se w3 x1 ; if old last <> mess q(proc) then
c33: jl (b20) ; goto wait next(driver process);
al w1 x1-a54 ; w1 := proc;
rl w0 x1+a56 ; w0 := interrupt addr(proc);
so w0 2.1 ; if interrupt addr(proc) is odd then
jl w3 g64 ;+2 goto wait next(driver process);
jl (b20) ;+2 examine queue: empty => goto wait next;
jl (i3) ; return
e.
; procedure check user
; comment: checks whether an external process is used
; by the current internal process. if the external is reserved
; it is also checked whether it is reserved by the current
; internal process.
; call: return:
; w0 destroyed
; w1 cur cur
; w2 buf buf
; w3 link link
b. i5 w.
g14: ; check user;
sn w1 (b1) ; if curr.intproc=sender then
jl x3 ; return (sender=driverproc)
ds w3 i3 ; save w2 w3;
rl w2 b19 ; w2:= extproc;
jl w3 d113 ; check reserver;
jl g6 ; return 0 other reservers goto result 2 else
jl i0 ; return 2 intproc is reserver goto nornal return else
; return 4 no reservers
jl w3 d102 ; check user
jl g6 ; if not user then result 2 else
i0:
rl w2 i2 ;
jl (i3) ; normal return;
i2: 0 ; save w2;
i3: 0 ; save w3;
e. ; end
; procedure check reservation
; comment: checks whether an external process is reserved
; by the current internal process.
; call: return:
; w0 reserved
; w1 cur cur
; w2 buf buf
; w3 link link
b.i24 ; begin
w.
g15: ; check reserver;
sn w1 (b1) ; if curr.intproc= sender then
jl x3 ; return (sender=driverproc);
am (b19) ;
rl w0 a52 ; w0:=reserver.extproc;
sn w0 (x1+a14) ; if intproc is reserver then
jl x3 ; normal return else
jl g6 ; result 2;
e. ; end
; procedure check operation(oper mask, mode mask)
; comment: checks whether the operation and mode are
; within the repertoire of the receiver. the legal values are
; defined by two bitpatterns in which bit i=1 indicates
; that operation (or mode) number i is allowed. if the
; operation is odd, it is checked whether the input/output
; area is within the internal process.
; call: return:
; w0 oper mask destroyed
; w1 mode mask destroyed
; w2 buf buf
; w3 link destroyed
b.i24 ; begin
w.g16:rs w3 i0 ;
bz w3 x2+9 ;
ls w1 x3+0 ;
bz w3 x2+8 ;
ls w0 x3+0 ;
sh w0 -1 ; if mode mask(mode(buf))=0
sl w1 0 ; or oper mask (operation(buf))=0
jl g5 ; then goto result 3;
so w3 1 ;
jl (i0) ;
rl w1 x2+6 ;
dl w0 x2+12 ; if odd(operation(buf))
la w3 g50 ; make first and
la w0 g50 ; last address in buf even;
sl w3 (x1+a17) ; and (first addr(buf)<first addr(sender)
sl w0 (x1+a18) ; or last addr(buf)>=top addr(sender)
jl g5 ;
sh w0 x3-2 ; or first addr(buf)>last addr(buf))
jl g5 ; then goto result 3;
ds w0 x2+12 ; message even;
jl (i0) ;
i0: 0 ;
e. ; end
; input/output answer:
w.g20: 0 ; status
g21: 0 ; bytes
g22: 0 ; characters
g23: 0 ; file count
g24: 0 ; block count
g40: 0 ; word5
g41: 0 ; word6
g42: 0 ; word7
0 ; mess(1) operation
g29: 0 ; mess(2) first
0 ; mess(3) last
g30: 0 ; mess(4) segment no
; procedure next operation
; comment: examines the message queue of the receiver and
; returns to the receiver if there is a message from a
; not-stopped sender. otherwise it returns to the current
; internal process.
; call: return:
; w0 oper
; w1 proc
; w2 buf
; w3 link sender
b.i24 ; begin
w.g25:rs w3 i2 ;
jl w3 g64 ; examine queue(
jl c33 ; dummy interrupt);
jl (i2) ;
i2: 0 ;
e. ; end
; procedure examine queue(queue empty)
; call: return:
; w0 operation
; w1 proc
; w2 buf
; w3 link sender
b.i24 ; begin
w.g64:rs w3 i2 ;
i0: rl w1 b19 ; exam q:proc:=current receiver;
rl w2 x1+a54 ; buf:=next(mess q(proc));
sn w2 x1+a54 ; if buf=mess q(proc)
jl (i2) ; then goto queue empty;
rs w2 b18 ;
rl w3 x2+6 ; internal:=sender(buf);
xl x2+8 ;
sh w3 -1 ;
ac w3 x3+0 ;
bz w0 x3+a13 ;
rl w3 x2+6 ; if state(internal)=stopped
sx 2.1 ; and operation(buf)(23)=1
so w0 a105 ; or internal<0
sh w3 -1 ; then
jl i1 ; begin
bz w0 x2+8 ;
am (i2) ; no operation;
jl 2 ; goto exam q;
i1: jl w3 g26 ; end;
jl i0 ; oper:=byte(buf+8);
i2: 0 ;
e. ; end
; procedure no operation
; call: return:
; w0 destroyed
; w1 proc
; w2 destroyed
; w3 link destroyed
b.i24 ; begin
w.g26:al w0 1 ;
g27:al w1 0 ;
rs w1 g20 ; status:=
g28:rs w1 g21 ; bytes:=
rs w1 g22 ; character:=0;
jl g19 ; deliver result(1);
e. ; end
; procedure increase stop count
; comment: increases the stop count of the sender by 1.
; call: return:
; w0 unchanged
; w1 unchanged
; w2 buf buf
; w3 link destroyed
b.i24 ; begin
w.g31:rs w3 i0 ;
am (x2+6) ;
bz w3 a12 ;
al w3 x3+1 ; stop count(sender(buf)):=
am (x2+6) ; stop count(sender(buf))+1;
hs w3 a12 ;
jl (i0) ;
i0: 0 ;
e. ; end
; procedure decrease stop count
; comment: the stop count of the sender is decreased by 1
; if the operation is odd. if stop count becomes zero and the
; sender is waiting to be stopped, the sender is stopped
; and the stop count of its parent is decreased by 1.
; if the parent has stopped its child, an answer is sent to
; the parent in the buffer defined by the wait address of
; the child.
; call: return:
; w0 destroyed
; w1 destroyed
; w2 destroyed
; w3 link destroyed
b.i24 ; begin
w.g32:rs w3 i3 ;
rl w2 b18 ;
bz w0 x2+8 ;
rl w3 x2+6 ; internal:=sender(buf);
sz w0 1 ; if odd(operation(buf))
sh w3 -1 ; and internal>=0 then
jl (i3) ; begin
bz w0 x3+a12 ;
bs. w0 1 ; stop count(internal):=
hs w0 x3+a12 ; stop count(internal)-1;
i0: se w0 0 ; exam stop:
jl (i3) ; if stop count(internal)=0
bz w1 x3+a13 ; and state(internal)=wait stop
so w1 a105 ; then
jl (i3) ; begin
al w1 x1+a106 ; child state:=
hs w1 x3+a13 ; state(internal):=wait start;
rl w2 x3+a40 ; buf:=wait address(internal);
rl w3 x3+a34 ; internal:=parent(internal);
bz w0 x3+a12 ;
bs. w0 1 ; stop count(internal):=
hs w0 x3+a12 ; stop count(internal)-1;
se w1 a99 ; if child state<>wait start parent
jl i0 ; then goto exam stop;
; let the current driver claim the buffer, so that
; it may send the answer:
rl w1 b1 ;
ac w0 x1 ; receiver(buf) := -cur; (i.e. claimed)
rs w0 x2+4 ;
bz w3 x1+a19 ; decrease(bufclaim(cur));
al w3 x3-1 ; (even if claims would be exceeded)
hs w3 x1+a19 ;
rl w1 x1+a17 ; answer area := first addr(cur);
al w0 1 ; result := 1;
jd 1<11+22; send answer;
jd (i3) ; return disabled;
i2: 0 ;
i3: 0 ;
e. ; end
; procedure exam sender(sender stopped)
; call: return:
; w0 unchanged
; w1 unchanged
; w2 unchanged
; w3 link link
b.i24 ; begin
w.g34:rs w3 i0 ;
am (b18) ;
rl w3 6 ; internal:=sender(buf);
sh w3 -1 ;
jl (i0) ; if internal<0
bz w3 x3+a13 ;
sz w3 a105 ; or state(internal)=stopped
jl (i0) ; then goto sender stopped;
rl w3 i0 ;
jl x3+2 ;
i0: 0 ;
e. ; end
; procedure follow chain(no. of slices,chain table index, slice)
; the return value is the chain table index of entry number <no.
; of slices> in the chain starting at <chain table index>
; call: return:
; w0 n.o.s. destroyed
; w1 unchanged
; w2 c.t.i. slice
; w3 link destroyed
b.i8
w.d74:rs w3 i3 ; save return
ac w3 (0) ;
as w3 1 ; count := -2 * no. of slices
jl. i2. ; goto test; repeat:
i0: sl w3 -30 ; if count >= -30
jl. x3+i1. ; then goto advance(-count)
ba w2 x2 ;
r. 16 ;
i1: al w3 x3+32 ; count := count + 32
i2: sh w3 -2 ; test: if count < 0
jl. i0. ; then goto repeat
jl (i3) ; return
i3: 0 ;
e. ;
; bitpatterns:
g48: 3 ; constant 3 (= number of chars per word)
g50: 8.7777 7776 ; first 23 bits
g51: 8.7777 0000 ; first 12 bits
g52: 8.0000 7777 ; last 12 bits
g53: 8.0000 0377 ; last 8 bits
g49: 1<23 ; bit 0
g62: 1<18 ; bit 5
g65: 8.3777 7777 ; last 23 bits
g63: 1 ; bit 23
▶EOF◀