|
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: 330240 (0x50a00)
Types: TextFile
Names: »mon8part1«
└─⟦a8311e020⟧ Bits:30003039 RC 8000 Monitor Kildetekst
└─⟦9ab0fc1ed⟧
└─⟦this⟧ »mon8part1«
1 0 b.a800,b200 w.
2 0
2 0 m.
2 0 mondef - monitor definitions
3 0
3 0 ; release number and date of monitor base text:
4 0 a133=79 07 24 ; date of monitor
5 0 a134=12 00 00 ; time of monitor
6 0 a135=8 ; release number
7 0 a136=0 ; version number
8 0
8 0 b.i30 w.
9 0 i0=82 06 15, i1=12 00 00
10 0
10 0 ; if newtime (i0,i1) > oldtime (a133,a134) then oldtime:=newtime;
11 0 c.i0-a133
12 0 c.i0-a133-1, a133=i0, a134=i1, z.
13 0 c.i1-a134-1, a134=i1, z.
14 0 z.
15 0
15 0 i10=i0, i20=i1
16 0
16 0 i15=i10/100000 , i10=i10-i15*100000 , i25=i20/100000 , i20=i20-i25*100000
17 0 i14=i10/10000 , i10=i10-i14*10000 , i24=i20/10000 , i20=i20-i24*10000
18 0 i13=i10/1000 , i10=i10-i13*1000 , i23=i20/1000 , i20=i20-i23*1000
19 0 i12=i10/100 , i10=i10-i12*100 , i22=i20/100 , i20=i20-i22*100
20 0 i11=i10/10 , i10=i10-i11*10 , i21=i20/10 , i20=i20-i21*10
21 0
21 0 i2: <: date :>
22 24 (:i15+48:)<16+(:i14+48:)<8+46
23 26 (:i13+48:)<16+(:i12+48:)<8+46
24 28 (:i11+48:)<16+(:i10+48:)<8+32
25 30
25 30 (:i25+48:)<16+(:i24+48:)<8+46
26 32 (:i23+48:)<16+(:i22+48:)<8+46
27 34 (:i21+48:)<16+(:i20+48:)<8+ 0
28 36
28 36 i3: al. w0 i2. ; write date:
29 38 rs w0 x2+0 ; first free:=start(text);
30 40 al w2 0 ;
31 42 jl x3 ; return to slang(status ok);
32 44
32 44 jl. i3. ;
33 46 e.
34 46 j.
34 0 date 82.06.15 12.00.00
35 0
35 0
35 0 ; rc 4000 system tape
36 0 ; per brinch hansen
37 0 ; this tape is an autoload version of the rc 4000 multiprogramming
38 0 ; system. it is written in the slang 3 language and consists of
39 0 ; 10 segments surrounded by a global block:
40 0 ;
41 0 ; global block, definitions:
42 0 ; a names define system constants;
43 0 ; b names define entries in the monitor table;
44 0 ; segment 1; start monitor segment 10:
45 0 ; contains a jump to segment 10;
46 0 ; segment 2, monitor:
47 0 ; contains interrupt response code and monitor procedures;
48 0 ; segment 3, external processes:
49 0 ; contains send message and code for input/output;
50 0 ; segment 4, process descriptions:
51 0 ; contains name table, process descriptions, and message buffers;
52 0 ; segment 5, initialize monitor:
53 0 ; executed and removed immediately after loading;
54 0 ; segment 6, process functions:
55 0 ; contains code for catalog administration and the
56 0 ; creation and removal of processes;
57 0 ; segment 7, initialize process functions:
58 0 ; executed and removed immediately after loading;
59 0 ; segment 8, operating system s:
60 0 ; contains code which allows the operators to
61 0 ; create and control new process from consoles;
62 0 ; segment 9, initialize catalog
63 0 ; starts the multiprogramming system and is
64 0 ; itself immediately executed as a part of the
65 0 ; process s; it can initialize the backing store
66 0 ; with catalog entries and binary programs
67 0 ; input from paper tape or magnetic tape;
68 0 ; segment 10: move monitor:
69 0 ; allocates segment 2 - 9 after autoloading
70 0
70 0
70 0 ; global block, definitions
71 0
71 0 ; size options:
72 0 ; a1 = no of area processes
73 0 ; a3 = no of internal processes
74 0 ; a5 = no of message buffers
75 0 ; a7 = no of pseudoprocesses
76 0 ; a87 = inspection interval
77 0 ; a109 = min aux-cat key
78 0 ; a110 = max cat key
79 0 ; a111 = min key for entries between standard and max interval
80 0 ; a112 = no. of bs-devices
81 0 ; a113 = no. of drum chains
82 0 ; a114 = size of drum chains
83 0 ; a115 = no. of disc chains
84 0 ; a116 = size of disc chains
85 0 ; a117 = no of messagebuffers assigned to consoles
86 0 ; a118 = update aux cat
87 0
87 0
87 0 ; predefinition of option variables:
88 0 a1=0 ;
89 0 a3=0 ;
90 0 a5=0 ;
91 0 a9=0 ; number of subdevices
92 0 a80=-1-1<11 ; all drivers included excl. rc8601
93 0 a82=-1 ; ... with statistics on
94 0 a84=-1 ; ... and test on
95 0 a85=256 ; max time slice in 0.1 ms
96 0 a89=8.4777 7777; standard interrupt mask
97 0 a90= 1<0 ; special facility mask : fpacoredump 1<0
98 0 a91=0 ;
99 0 a92=1<10+1<21 ;
100 0 a93=1<23 ;
101 0 a109=2 ;
102 0 a110=3 ;
103 0 a111=3 ;
104 0 a113=0 ; number of drums
105 0 a114=0 ;
106 0 a116=0 ;
107 0 a128=0 ; a128=0 : std monitor gen.
108 0 ; >0 : option gen.
109 0 ; a128 o. 1<1 : read special s size options in segment 6
110 0 ; a128 o. 1<2 : rc 6000 monitor
111 0 a123=0 ; net-identification(jobhost)
112 0 a124=0 ; home-region(jobhost)
113 0 ; a125= ; job host identification
114 0 a130=00 00 00 ; date, time of options
115 0 a131=00 00 00 ; (yy mm dd, hh mm ss)
116 0 a198=1<23+0<3 ; device addr of cpu
117 0 a199=2 ; device number of mainconsole
118 0 a400=0 ; coroutine monitor inclusion (default no)
119 0
119 0 ; **** definition of coroutine monitor formats:
120 0 ;
121 0 ; coroutine description;
122 0 a694 = -6 ; next in semaphore queue
123 0 a696 = -4 ; previous in semaphore queue
124 0 a698 = -2 ; priority
125 0 a700 = 0 ; save ic (return)
126 0 a702 = 2 ; next coroutine
127 0 a704 = 4 ; prev coroutine
128 0 a706 = 6 ; timer
129 0 a708 = 8 ; mask f. waitchained
130 0 a710 = 10 ; save w0(for test purposes only) or result
131 0 a712 = 12 ; save w1
132 0 a714 = 14 ; save w2
133 0 a716 = 16 ; testmask
134 0 a718 = 18 ; ident
135 0 a720 = 20 ; user exit (0 or exit addr)
136 0 a722 = 22 ; return address for waitsem,waitchained,cwaitanswer
137 0 a724 = 24 ; ref. to operation (waitchained) or buf (cwaitanswer)
138 0
138 0 ; operation:
139 0 a670 = +0 ; next operation
140 0 a672 = +2 ; prev operation
141 0 a674 = +4 ; type
142 0
142 0 ; chained semaphore:
143 0 a650 = +0 ; next coroutine
144 0 a652 = +2 ; prev coroutine
145 0 a654 = +4 ; next operation
146 0 a656 = +6 ; prev operation
147 0
147 0 ; simple semaphore:
148 0 a660 = +0 ; next coroutine
149 0 a662 = +2 ; prev coroutine
150 0 a664 = +4 ; count
151 0
151 0
151 0 ; second process extension.
152 0 ; contains key variables of the coroutine system .
153 0 a538 = -12 ; start of testbuffer
154 0 a540 = -10 ; start of next record in test buffer
155 0 a542 = -8 ; top of test buffer
156 0 a544 = -6 ; test output flag (1 = on)
157 0
157 0 a546 = -4 ; next in active queue
158 0 a548 = -2 ; prev in active queue
159 0 a550 = 0 ; current coroutine
160 0 a552 = 2 ; next in timer queue
161 0 a554 = 4 ; prev in timer queue
162 0 a556 = 6 ; name of the testoutput process
163 0 a566 = 16 ; start of testoutput message
164 0 a582 = 32 ; last event pointer
165 0 a584 = 34 ; message decriptor pointer(cur)
166 0 a586 = 36 ; start of table containing references to user defined procedures
167 0 a588 = 38 ; first message buffer extension
168 0 a590 = 40 ; start of common message-answer area
169 0 a616 = 56 ; name of 'clock'
170 0 a626 = 66 ; start of 'clock'-message
171 0 a630 = 70 ; answer descriptor for answer from 'clock'
172 0 t.
172 0* type
173 0 \f
173 0 ; monitor options.
174 0
174 0 m.
174 0 nye mon options (newopt) - 79.08.01 12.00.00
175 0
175 0 a130= 79 03 27 ; date
176 0 a131= 19 00 00 ; time
177 0
177 0 a1= 133 ; areas
178 0 a3= 11 ; internals
179 0 a5= 157 ; message buffers
180 0 a80= -1 ; all drivers included
181 0 a90= 0 ; fpa power dump excluded
182 0 ; a82= 0 ; statistics off
183 0 ; a84= 0 ; testoutput off
184 0 a115= 4 ; number of discs
185 0 a116=2046 ; max number of slices in disc slice tabel
186 0 a117= 18 ; number of mess buffers reserved for subprocesses
187 0 a125=117 ; jobhost identification
188 0 n.m.
188 0 monitor size options included
189 0
189 0 ; a2 = size of area process description
190 0 ; a4 = size of internal process description
191 0 ; a8 = size of pseudoprocesses
192 0
192 0 a112 = a113 + a115
193 0 a8=0
194 0 a118 = a112-2, a119 = a118
195 0
195 0 ; a88 = size of catalog entry
196 0 ; a89 = standard interrupt mask
197 0 ; a85 = max time slice in 0.1 msec
198 0 ; a107 = min lower limit in bases
199 0 ; a108 = max upper limit in bases
200 0
200 0 a88=34, a107=8.4000 0001, a108=8.3777 7776
201 0
201 0 ; driver options.
202 0 ; the inclusion of drivers is controlled by the parameters a80, a82 and a84.
203 0 ; a80 determines whether a driver shall be included, and a82 and a84 whether
204 0 ; it shall be included with statistics and/or testoutput.
205 0 ;
206 0 ; a80 = driver inclusion
207 0 ; a82 = statistics
208 0 ; a84 = testoutput
209 0 ;
210 0 ; the function of the bits in the parameters are -
211 0 ; 1<0 : clock
212 0 ; 1<1 : disc (dsc 801)
213 0 ; 1<2 : mainproc
214 0 ; 1<3 : receiver (fpa 801)
215 0 ; 1<4 : transmitter (fpa 801)
216 0 ; 1<5 : hostproc
217 0 ; 1<6 : subprocs
218 0 ; 1<7 ; host, subhost
219 0 ; 1<11 : rc8601
220 0 ; 1<12 ; subdriver terminal
221 0 ; 1<13 ; - magtape
222 0 ; 1<14 ; - disc
223 0 ; 1<15 ; - flexible disc
224 0
224 0
224 0 ; testoptions:
225 0 ; testoptions are used during debugging of the system.
226 0 ; they are defined by bits in the identifier a92 as follows:
227 0 ; testcase i a92=a92 o. 1<i 0<=i<=17
228 0 ; teststatus a92=a92 o. 1<18
229 0 ; testcall a92=a92 o. 1<19
230 0 ; testoutput a92=a92 o. 1<20
231 0 ; print w, type w
232 0 ; procfunc interrupt a92=a92 o. 1<21
233 0 ; procfunc testbuffer a92=a92 o. 1<22
234 0 ; testoptions in s are defined by bits in the identifier a93
235 0 ; as explained in s.
236 0 a48 = -4 ; lower limit(interval)
237 0 a49 = -2 ; upper limit(interval)
238 0 a10 = 0 ; kind
239 0 a11 = 2 ; name
240 0 a12 = 10, a13 = 11 ; stop count, state
241 0 a14 = 12 ; identification bit
242 0 a15 = 14 ; next event
243 0 ; last event
244 0 a16 = 18 ; next process
245 0 ; last process
246 0 a17 = 22 ; first address (logical)
247 0 a18 = 24 ; top address (logical)
248 0 a19 = 26, a20 = 27 ; buffer claim, area claim
249 0 a21 = 28, a22 = 29 ; internal claim, function mask
250 0 a301= 30 ; priority
251 0 a24 = 32, a25 = 33 ; mode (= protection register, protection key)
252 0 a26 = 34 ; interrupt mask
253 0 a27 = 36 ; user exception address (interrupt address) (logical)
254 0 a170= 38 ; user escape address (logical)
255 0 a171= 40 ; initial cpa
256 0 a172= 42 ; - base
257 0 a173= 44 ; - lower write limit (physical)
258 0 a174= 46 ; - top - - (physical)
259 0 a175= 48 ; - interrupt levels
260 0 a34 = 50 ; parent description address
261 0 a35 = 52 ; quantum
262 0 a36 = 54 ; run time
263 0 a38 = 58 ; start run
264 0 a39 = 62 ; start wait
265 0 a40 = 66 ; wait address
266 0 a42 = 68, a43 = 70 ; catalog base
267 0 a44 = 74 ; max interval
268 0 a45 = 78 ; standard interval
269 0 a28 = 80 ; save w0, = first of regdump
270 0 a29 = 82 ; - w1
271 0 a30 = 84 ; - w2
272 0 a31 = 86 ; - w3
273 0 a32 = 88 ; - status
274 0 a33 = 90 ; - ic (logical)
275 0 a176= 92 ; - cause
276 0 a177= 94 ; - sb
277 0 a176= 96 ; top of regdump
278 0 a181= 96 ; current cpa = first of fixed parameters
279 0 a182= 98 ; - base
280 0 a183= 100 ; - lower write limit (physical)
281 0 a184= 102 ; - top - - (physical)
282 0 a185= 104 ; - interrupt levels
283 0 a179= a181-a28 ; (displacement between fixed params and first of regdump)
284 0 ; a180: ; see c29
285 0 a302= 106 ; save area address
286 0 ; save area for g20-g24, b18, b19
287 0 a303= 124 ; top of save area
288 0 a46 = 124 ; bs claims start
289 0 ; chain0: key0: slices , entries
290 0 ; key1: - , -
291 0 ; key2: - , -
292 0 ; key3: - , -
293 0 ; (........................)
294 0 ; chain1: key0: - , -
295 0 ; (........................)
296 0 ; bs claims top
297 0 ; calculate size of process-
298 0 a4=a46+(:a110<1+2:)*a112-a48
299 0 a4 = a4 ; size of internal process
300 0 a35 = 52 ; <quantum>
301 0 a36 = 54 ; <run time>
302 0 a38 = 58 ; <start run>
303 0 a39 = 62 ; <start wait>
304 0 a40 = 66 ; <wait address>
305 0 a42 = 68, a43 = 70 ; <catalog base>
306 0 a44 = 74 ; <max interval>
307 0 a45 = 78 ; <standard interval>
308 0 b. j0 w.
309 0 j0 = 80
310 0 a28 = j0, j0 = j0+2 ; save w0, = first of regdump
311 0 a29 = j0, j0 = j0+2 ; - w1
312 0 a30 = j0, j0 = j0+2 ; - w2
313 0 a31 = j0, j0 = j0+2 ; - w3
314 0 a32 = j0, j0 = j0+2 ; - status
315 0 a33 = j0, j0 = j0+2 ; - ic
316 0 a176= j0, j0 = j0+2 ; - cause
317 0 a177= j0, j0 = j0+2 ; - sb
318 0 a178= j0 ; top of regdump
319 0 a181= j0, j0 = j0+2 ; current cpa = first of fixed parameters
320 0 a182= j0, j0 = j0+2 ; - base
321 0 a183= j0, j0 = j0+2 ; - lower write limit
322 0 a184= j0, j0 = j0+2 ; - top - -
323 0 a185= j0, j0 = j0+2 ; - interrupt levels
324 0 a179= a181-a28 ; (displacement between fixed params and first of regdump)
325 0 ; a180: see c29
326 0 a302= j0, j0 = j0+2 ; save area address
327 0 j0 = j0+14; save area for g20-g24, b18, b19
328 0 a303= j0 ; top of save area
329 0 a305= j0, j0 = j0+2 ; first process extension
330 0 a306= j0, j0 = j0+2 ; second process extension
331 0 a46 = j0 ; bs claims start
332 0 j0=j0+(:a110<1+2:)*a112; top of bs claim list
333 0 ; a48 = first of internal process
334 0 ; j0 = top - - -
335 0 a4 = j0-a48 ; size of internal process
336 0 e.
337 0 a23 = 27 ; use area processes as pseudoprocesses
338 0
338 0 ; format of save area:
339 0 ; 8 words, used by deliver-result-procedures
340 0 a304 = 16 ; address of wait first event
341 0
341 0 ; internal process states:
342 0
342 0 ; actual bitpatterns are relevant to process functions only
343 0 a95 = 2.01001000 ; running
344 0 a96 = 2.00001000 ; running after error
345 0 a97 = 2.10110000 ; waiting for stop by parent
346 0 a98 = 2.10100000 ; waiting for stop by ancestor
347 0 a99 = 2.10111000 ; waiting for start by parent
348 0 a100= 2.10101000 ; waiting for start by ancestor
349 0 a101= 2.11001100 ; waiting for process function
350 0 a102= 2.10001101 ; waiting for message
351 0 a103= 2.10001110 ; waiting for answer
352 0 a104= 2.10001111 ; waiting for event
353 0
353 0
353 0 ; bit patterns used to test or change the above states:
354 0 a105 = 2.00100000; waiting for stop or start
355 0 a106 = 2.00001000; waiting for start
356 0
356 0 \f
356 0 ; format of area process description:
357 0
357 0 a349= -6 ; <start of process>
358 0 a250= -6 ; <driver proc descr address>
359 0 a48 = -4 ; <lower limit>
360 0 a49 = -2 ; <upper limit>
361 0
361 0 a10 = 0 ; <kind>
362 0 a11 = 2 ; <name>
363 0 a50 = 10, a51 = 11 ; <process descr addr of bs device>
364 0 a52 = 12 ; <reserved>
365 0 a53 = 14 ; <users>
366 0 a60 = 16 ; <first slice>
367 0 a61 = 18 ; <number of segments>
368 0 a62 = 20 ; <document name>
369 0 a411= 28 ; number of times written
370 0 a412= 30 ; number of times read
371 0 a2 = a412+2-a349 ; size of area process
372 0
372 0 ; format of pseudo process
373 0 a48 = -4, a49 = -2 ; <interval>
374 0 a10 = 0 ; <kind>
375 0 a11 = 2 ; <name>
376 0 a50 = 10 ; <main process>
377 0 a60 = 16 ; <mess descr>
378 0
378 0 \f
378 0 ; format of device description:
379 0
379 0 ; definition of device-dependant part of device-description
380 0
380 0 b. j0 w.
381 0
381 0 j0 = 0 ; (used to set up the definitions)
382 0
382 0 ; pointers to private area in device descriptor, used by driver and start-io:
383 0
383 0 a220= j0, j0 = j0+2 ; first of private area, rel to a10
384 0 a221= j0, j0 = j0+2 ; top of private area, rel to a10
385 0
385 0 ; the following word is used to indicate a transfer in progress
386 0 ; (sender descr) a.1 = 1 : transfer to driver process
387 0 ; (sender descr) a.(-2)>0: transfer to sender process
388 0 ; (sender descr) = 0 : no transfer
389 0 a225= j0, j0 = j0+2 ; transfer code
390 0
390 0 ; pointers to channel program area, in device descriptor, used by start-io:
391 0
391 0 a226= j0, j0 = j0+2 ; first of channel program area, rel to a10
392 0 a227= a226+2,j0=j0+2; top of channel program area, rel to a10
393 0
393 0 ; standard status area: used when the controller delivers an interrupt:
394 0
394 0 a230= j0, j0 = j0+8 ; channel program address
395 0 a231= a230+2 ; remaining character count
396 0 a232= a230+4 ; current status
397 0 a233= a230+6 ; event status
398 0
398 0 ; device address, also used as index to controller table:
399 0
399 0 a235= j0, j0 = j0+2 ; device address
400 0
400 0 ; interrupt operation, as needed by monitor interrupt response:
401 0
401 0 a240= j0, j0 = j0+2 ; <jl w2 c51> (monitor service instruction)
402 0 a241= a240+2 ; <after jl w2 ...>
403 0 a242= a241, j0=j0+2 ; next operation link
404 0 a243= a242+2,j0=j0+2; prev operation link
405 0 a244= j0, j0 = j0+2 ; timeout / result from start-io
406 0
406 0 ; interrupt operation, as needed by driver process:
407 0
407 0 a245= a244+2,j0=j0+2; interrupt address in driver code (logic addr)
408 0 a246= j0, j0 = j0+2 ; <jl w1 c30> (driver service instruction)
409 0 a247= a246+2 ; <after jl w1 ...>
410 0
410 0 ; which driver process governs this device ? (used by monitor):
411 0
411 0 a250= j0, j0 = j0+2 ; driver description addr (abs addr)
412 0
412 0 ; the last of these fields should have been adjacent to the
413 0 ; field 'interval low' i.e. relative to a48:
414 0
414 0 j0 = j0 - a48
415 0 a220=a220-j0, a221=a221-j0
416 0 a225=a225-j0, a226=a226-j0, a227=a227-j0
417 0 a230=a230-j0, a231=a231-j0, a232=a232-j0, a233=a233-j0
418 0 a235=a235-j0
419 0 a240=a240-j0, a241=a241-j0, a242=a242-j0, a243=a243-j0,
420 0 a244=a244-j0, a245=a245-j0, a246=a246-j0, a247=a247-j0,
421 0 a250=a250-j0
422 0
422 0 ; some of the above given field were known under another name
423 0 ; in the earlier versions of this monitor:
424 0
424 0 ; a50 = a235 ; device address
425 0 ; a56 = a245 ; interrupt address
426 0
426 0 e.
427 0
427 0 ; a48 lower interval
428 0 ; a49 upper interval
429 0 ; a10 kind
430 0 ; a11 name
431 0 ; a52 reserver
432 0 ; a53 users
433 0 a54 = 16 ; next message
434 0 a55 = 18 ; previous message
435 0 ; a70 optional parameters
436 0 ; etc
437 0
437 0
437 0
437 0 ; format of peripheral process description:
438 0 ; a250 driver process description address
439 0 a48 = -4, a49 = -2 ; <interval>
440 0
440 0 a10 = 0 ; <kind>
441 0 a11 = 2 ; <name>
442 0 a50 = 10 ; <device number*64>
443 0 a52 = 12 ; <reserved>
444 0 a53 = 14 ; <users>
445 0 a54 = 16 ; <next message>
446 0 a55 = 18 ; <last message>
447 0 a56 = 20 ; <interrupt address>
448 0
448 0 ; optional parameters for peripheral devices:
449 0 a70 = 22 ; <parameter 0>
450 0 a71 = 24 ; <parameter 1>
451 0 a72 = 26 ; <parameter 2>
452 0 a73 = 28 ; <parameter 3>
453 0 a74 = 30 ; <parameter 4>
454 0 a75 = 32 ; <parameter 5>
455 0 a76 = 34 ; <parameter 6>
456 0 a77 = 36 ; <parameter 7>
457 0 a78 = 38 ; <parameter 8>
458 0
458 0 ; parameters used in connection with subprocesses:
459 0 a63 = a70+14
460 0 a64 = a63+2
461 0
461 0 ; format of controller description
462 0
462 0 a310= 0 ; first of channel program
463 0 a311= 2 ; first of std status
464 0 a312= 4 ; interrupt destination
465 0 a313= 6 ; interrupt number
466 0 a314= 8 ; size of controller description
467 0
467 0 ; format of std status
468 0
468 0 a315= 0 ; top of last executed command
469 0 a316= 2 ; remaining character count
470 0 a317= 4 ; current status
471 0 a318= 6 ; event status
472 0
472 0 ; format of logic channel program (as demanded by the start i/o procedure)
473 0
473 0 a321= 0 ; address code < 12 + command < 8 + modif
474 0 a322= 2 ; param 1
475 0 a323= 4 ; param 2
476 0
476 0 a320= 6 ; size of channel program entry
477 0
477 0 \f
477 0 ; format of message buffer:
478 0
478 0 a139=-2 ; mess flag (saved w2 in send message)
479 0 a140= 0 ; links: next buffer, previous buffer
480 0 a141= 4 ; receiver (or result)
481 0 a142= 6 ; sender
482 0 a145= 8 ; start of message/answer
483 0 a150= a145 ; operation < 12 + mode status word
484 0 a151= a145+2 ; first storage address number of bytes
485 0 a152= a145+4 ; last storage address number of chars
486 0 a153= a145+6 ; first segment number
487 0 a146= 24 ; top of message/answer
488 0 a6 = a146-a139 ; size of message buffer
489 0
489 0
489 0 ; message buffer states:
490 0
490 0 ; the possible states of a message buffer are defined by the
491 0 ; values of the sender and receiver parameters:
492 0 ;
493 0 ; sender param: receiver param: state:
494 0 ; 0 0 buffer available
495 0 ; sender descr receiver descr message pending from existing sender
496 0 ; sender descr -receiver descr message received from existing sender
497 0 ;-sender descr receiver descr regretted message pending
498 0 ;-sender descr -receiver descr regretted message received
499 0 ; sender descr 1 normal answer pending
500 0 ; sender descr 2 dummy answer pending (message rejected)
501 0 ; sender descr 3 dummy answer pending (message unintelligible)
502 0 ; sender descr 4 dummy answer pending (receiver malfunction)
503 0 ; sender descr 5 dummy answer pending (receiver does not exist)
504 0
504 0
504 0
504 0 ; the possible states of a message buffer are defined by the values of the sender and
505 0 ; receiver fields in the buffer:
506 0 ;
507 0 ; sender: receiver: state:
508 0 ; 1. 0 0 free
509 0 ; 2. sender addr receiver addr message pending
510 0 ; 3. sender addr -receiver addr message received
511 0 ; 4. -sender addr receiver addr (not possible)
512 0 ; 5. -sender addr -receiver addr message received, but regretted by sender
513 0 ; 6. sender addr -receiver addr - 1 immediate-message received
514 0 ; 7. -sender addr -receiver addr - 1 immediate-message received, but regretted by sender ('s parent)
515 0 ; 8. sender addr 1 pending answer, result = normal
516 0 ; 9. sender addr 2 - - result = rejected
517 0 ; 10. sender addr 3 - - result = unintelligible
518 0 ; 11. sender addr 4 - - result = malfunction
519 0 ; 12. sender addr 5 - - result = unknown
520 0 ;
521 0 ; explanations:
522 0 ; sender addr > 0 : message buffer claim of the sender has been decreased
523 0 ; receiver addr > 0 : message buffer has not been detected by the receiver, i.e. mess
524 0 ; buf claim of sender is untouched. the message buffer may be removed
525 0 ; from the receivers queue without further actions.
526 0 ; receiver addr < 0 : mess buf claim of receiver has been decreased, indicating that the
527 0 ; receiver has deposited a mess buff in the pool, while the receiver
528 0 ; is processing the original one.
529 0 ; sender addr < 0 : the sender has regretted the message, or has been removed. the mess buf
530 0 ; claim of the sender has been increased, i.e. the sender may now use
531 0 ; the deposited message buffer.
532 0 ; 1 <= receiver <= 5 : the mess buf claim of the receiver has been readjusted, i.e. the
533 0 ; receiver has regained its deposited mess buf claim
534 0 ; receiver addr odd : immediate message
535 0 ;
536 0 ;
537 0 ; the following table shows how the different monitor procedures react upon the possible
538 0 ; bufferstates. the table contains the new state.
539 0 ;
540 0 ; <-----------------sender/parent----------------->
541 0 ; remove <-------------receiver-------------><---drivers--->
542 0 ; process/
543 0 ; send regret wait stop wait get wait send link next
544 0 ; message message answer process event event message answer operation
545 0 ;
546 0 ; 1 free 2 illegal illegal 3 illegal illegal - illegal illegal -
547 0 ; 2 message pending - 1 unch. - 3 3 3 illegal 2 2
548 0 ; 3 message received - 5 unch. - 2-3 3 - 8-12 2 -
549 0 ; 5 mess rec, but regr. - illegal illegal - 1 5 - 1 1 -
550 0 ; 8-12 pending answer - 1 1 - unch. 1 - illegal illegal -
551 0 ;
552 0 ; modify/
553 0 ; remove
554 0 ; process
555 0 ;
556 0 ; 6 imm. mess received - 7 illegal - illegal illegal - 1 illegal -
557 0 ; 7 imm. mess rec.,regr - - illegal - illegal illegal - 1 illegal -
558 0 ;
559 0 \f
559 0
559 0 m.
559 0 moncentral - monitor central logic
560 0
560 0 b.i30 w.
561 0 i0=82 01 25, i1=12 00 00
562 0
562 0 ; if newtime (i0,i1) > oldtime (a133,a134) then oldtime:=newtime;
563 0 c.i0-a133
564 0 c.i0-a133-1, a133=i0, a134=i1, z.
565 0 c.i1-a134-1, a134=i1, z.
566 0 z.
567 0
567 0 i10=i0, i20=i1
568 0
568 0 i15=i10/100000 , i10=i10-i15*100000 , i25=i20/100000 , i20=i20-i25*100000
569 0 i14=i10/10000 , i10=i10-i14*10000 , i24=i20/10000 , i20=i20-i24*10000
570 0 i13=i10/1000 , i10=i10-i13*1000 , i23=i20/1000 , i20=i20-i23*1000
571 0 i12=i10/100 , i10=i10-i12*100 , i22=i20/100 , i20=i20-i22*100
572 0 i11=i10/10 , i10=i10-i11*10 , i21=i20/10 , i20=i20-i21*10
573 0
573 0 i2: <: date :>
574 24 (:i15+48:)<16+(:i14+48:)<8+46
575 26 (:i13+48:)<16+(:i12+48:)<8+46
576 28 (:i11+48:)<16+(:i10+48:)<8+32
577 30
577 30 (:i25+48:)<16+(:i24+48:)<8+46
578 32 (:i23+48:)<16+(:i22+48:)<8+46
579 34 (:i21+48:)<16+(:i20+48:)<8+ 0
580 36
580 36 i3: al. w0 i2. ; write date:
581 38 rs w0 x2+0 ; first free:=start(text);
582 40 al w2 0 ;
583 42 jl x3 ; return to slang(status ok);
584 44
584 44 jl. i3. ;
585 46 e.
586 46 j.
586 0 date 82.01.25 12.00.00
587 0 \f
587 0
587 0
587 0
587 0 ; segment 1 : enter monitor after load
588 0 ; the monitor is entered in word 8. the words +2,+4 must at entry contain -
589 0 ; +2 load flag, writetext
590 0 ; +4 medium
591 0 ; where
592 0 ; load flag: 1 autoload of device controllers
593 0 ; 0 no autoload
594 0
594 0 s. i2
595 0 w.
596 0
596 0 i0: i2. ; length of segment 1
597 2 0 ; init cat switch: writetext
598 4 i1: 0 ; init cat switch: medium
599 6
599 6 ; entry from autoloader:
600 6 al. w3 i0. ; calculate top address of
601 8 rl w2 x3 ; last segment;
602 10 wa w3 4 ;
603 12 se w2 0 ; (i.e. until segment size = 0)
604 14 jl. -6 ;
605 16 al. w2 i2. ; insert start address of segment 2;
606 18 dl. w1 i1. ; get init cat switches
607 20 jd x3-2 ; jump to segment 10
608 22 i2: ; first word of segment 2
609 22
609 22 ; exit with:
610 22 ; w0, w1 = init cat switches
611 22 ; w2 = start address of segment 2
612 22
612 22 e. ; end segment 1
613 22
613 22
613 22 b. v100, r28, g70, f20, e65, d140, c200
614 22 \f
614 22
614 22 ; segment 2: monitor
615 22
615 22 s. k = 8, j0
616 8 w.b127=k, j0, k=k-2
617 8 ; segment structure:
618 8 ; monitor table (b names)
619 8 ; interrupt response (c names)
620 8 ; utility procedures (d names)
621 8 ; monitor procedures (e names)
622 8 ; name table (f names)
623 8 ; process descriptions (f names)
624 8 ; buffers (f names)
625 8 ;
626 8 ; (g and h and i names are used locally)
627 8
627 8 ; monitor table
628 8
628 8 ; all addresses are absolute addresses
629 8 ; an integer after the semicolon means, that the address can't
630 8 ; be changed, because it - unfortunately - has been published
631 8 ; or because they have a hardware-function
632 8
632 8 b65: 0-0-0 ; 8: base of controller description table
633 10 b66: c25 ; 10: power up entry
634 12 b67: 0-0-0 ; first controller table entry
635 14 b68: 0-0-0 ; top controller table entry
636 16 b69: b69 ; queue head: software timeout
637 18 b69 ; (for devices)
638 20 b70: 0 , 0 ; time when last inspected
639 24 b72: 0-0-0 ; b53 ; start of interrupt table
640 26 b73: 0-0-0 ; b54 ; max external interrupt number
641 28 b0: 0-0-0 ; b53 - b16 ; (relative start of interrupt table
642 30 b74: a198 ; device address of this cpu
643 32 b75: 0 ; after powerfail (0==false, else true)
644 34
644 34 b18: 0 ; current buffer address
645 36 b19: 0 ; current receiver
646 38 b20: c96 ; address of simple wait event procedure
647 40 b21: 0-0-0 ; owner of std-driver-locations
648 42 b101:0 ; return from subprocs
649 44 b102:0-0-0 ; a66 ; start of table(subproc-drivers)
650 46 b103:0 ; address of entry for send message for linkdriver areas
651 48 b76: 0 ; start of secondary interrupt chain
652 50 b30: 0-0-0 ; errorlog proc
653 52 b31: g66 ; errorlog entry
654 54 r. (:64-k+2:) > 1 ; 60-62 reserved for testprograms
655 64 a135<12+a136 ; 64: release, version of monitor
656 66 b1: 0 ; 66: current process
657 68 b2: b2 ; time slice queue head: next process
658 70 b2 ; last process
659 72 b3: 0-0-0 ; 72: name table start
660 74 b4: 0-0-0 ; 74: first device in name table
661 76 b5: 0-0-0 ; 76: first area in name table
662 78 b6: 0-0-0 ; 78: first internal in name table
663 80 b7: 0-0-0 ; 80: name table end
664 82 b8: b8 ; mess buf pool queue head: next buf
665 84 b8 ; last buf
666 86 0-0-0 ; 86: first byte of mess buf pool area
667 88 0-0-0 ; 88: last byte of mess buf pool area;( last word of last monitor table)
668 90 a6 ; 90: size of message buffer
669 92 b22: 0-0-0 ; 92: first drum chain in name table
670 94 b23: 0-0-0 ; 94: first disc chain in name table
671 96 b24: 0-0-0 ; 96: chain end in name table
672 98 b25: 0 ; 98: main cat chain table
673 100 0-0-0 ;(100) not used ???
674 102 b10: a85 ; maximum time slice
675 104 b11: 0 ;104: time slice (of current process)
676 106 0 ;106: zero (earlier: micro seconds)
677 108 b13: 0 , 0 ;108:110: time (unit of 0.1 milli seconds)
678 112 b14: 0 ; last sensed clock value
679 114 0 ; (not used)
680 116 b12: 0-0-0 ;116: number of storage bytes
681 118 a111<12 + a109 ;118: min global key, min aux cat key ?????
682 120 b15: 0 , 0 ; clockchange, after set clock:
683 124 ; newtime - oldtime
684 124 c.a400-1
685 124 b27: 0 ;124: first process extension(cur)
686 124 b28: 0 ;126: second process extension(cur)
687 124 b141:0 ;128: coroutine testoutput address
688 124 ; links to cmon procedures:
689 124 b140:c100 ;130: address of cmon procedure start
690 124 c101 ;132: - '' - wait
691 124 c102 ;134: - '' - pass
692 124 c103 ;136: - '' - inspect
693 124 c104 ;138: - '' - csendmessage
694 124 c105 ;140: - '' - cwaitanswer
695 124 c106 ;142: - '' - answer_arrived
696 124 c107 ;144: - '' - signal_binary
697 124 c108 ;146: - '' - signal_sem
698 124 c109 ;148: - '' - wait_sem
699 124 c110 ;150: - '' - signal_chained
700 124 c111 ;152: - '' - inspect_chained
701 124 c112 ;154: - '' - wait_chained
702 124 c113 ;156: - '' - sem_send_mess
703 124 c114 ;158: - '' - sem_answer_proc
704 124 c115 ;160: - '' - message_received
705 124 c116 ;162: - '' - timer_message
706 124 c117 ;164: - '' - timer_scan
707 124 c118 ;166: - '' - cregretmessage
708 124 c119 ;168: - '' - user testoutput
709 124 z.
710 124 b26 = b5 ; use area processes as pseudo processes
711 124
711 124 ; definition of general registers in rc8000
712 124
712 124 b90 = 8.14 * 2 ; ilevc : interrupt level limit copy
713 124 b91 = 8.15 * 2 ; inf : current interrupt stack element address
714 124 b92 = 8.17 * 2 ; size : top available core address
715 124 b93 = 8.20 * 2 ; montop : 1 < 11 - top monitor procedure number
716 124 b94 = 8.62 * 2 ; clock
717 124 b95 = 8.57 * 2 ; ir : used to clear selected bits in interrupt reg
718 124 b97 = 8.60 * 2 ; dswr : data swithes
719 124 b98 = 8.61 * 2 ; regsel : register swithes
720 124 b99 = 8.60 * 2 ; display
721 124 ;
722 124 b100= 8.21*2 ; cpukind: 0: /45
723 124 ; -1: /15, /25, /35
724 124 ; 50: /50
725 124 ; 55: /55
726 124
726 124 ; definition of interrupt stack.
727 124 ; parameters are relative to base of stack element (i.e. 1,3,5,..)
728 124
728 124 b.j0
729 124 j0=-1 , j0=j0+2 ; base of stack element
730 124
730 124 a326=j0 , j0=j0+2 ; regdump
731 124 a327=j0 , j0=j0+2 ; exception routine
732 124 a328=j0 , j0=j0+2 ; escape routine
733 124 a329=j0 , j0=j0+2 ; monitor call entry
734 124 a330=j0 , j0=j0+2 ; external interrupt entry
735 124 a331=j0 , j0=j0+2 ; interrupt limits, disabled/enabled
736 124
736 124 a325=j0-a326 ; size of interrupt stack element
737 124
737 124 e.
738 124
738 124 ; external interrupt entry:
739 124 ;
740 124 ; when an external interrupt occurs, or when 'user exception first'
741 124 ; or 'user escape first' are zero, the cpu will save all registers
742 124 ; in the current process descrition.
743 124 ; exit is made to here with:
744 124 ; w1 = top register dump
745 124 ; w2 = 2 * interrupt number
746 124 ; ex = 0
747 124
747 124 c1: wa w2 b0 ; monfunc := cause + int.table.base - mon.proc.base;
748 126
748 126 ; monitor call entry:
749 126 ;
750 126 ; if the current process executes a montor call, the cpu will
751 126 ; save all the registers in the current process description.
752 126 ; exit is made to here with:
753 126 ; w1 = top register dump
754 126 ; w2 = monitor function
755 126 ; ex = 0
756 126
756 126 c0: al w1 x1-a178 ; w1 := current process;
757 128 jl. (x2+b16.) ; switch out through int.table or monproc.table;
758 130
758 130 ; second level external interrupt entry:
759 130 ;
760 130 ; exit is made to here with:
761 130 ; w1 = top register dump
762 130 ; w2 = 2 * interrupt number
763 130
763 130 c8: sn w2 2*6 ; if cause = powerfail then
764 132 jl c6 ; goto power fail routine;
765 134 jl -3<1 ; halt;
766 136
766 136 ; program errors in the current process are transferred to here,
767 136 ; (as external interrupts):
768 136 ;
769 136 ; w1 = cur
770 136 c2: ; internal interrupts, overflow, spill, escape errors:
771 136 c3: ; monitor bugs (i.e. exception- or escape-addresses
772 136 ; outside write-limits of process)
773 136 c4: ; bus error in operand transfer: (no strategy yet)
774 136 c5: ; bus error in instruction fetch: (- - - )
775 136 jl w2 (b31) ; call errorlog
776 138 al w0 a96 ; state := running after error;
777 140 jl w3 d9 ; remove internal(cur, running after error);
778 142 jl c99 ; goto interrupt return;
779 144
779 144 ; parameter errors in monitor call:
780 144 ;
781 144 ; all monitor procedures check that the parameters are
782 144 ; within certain limits.
783 144 ; if the parameters are wrong, the calling process is break'ed.
784 144 ;
785 144 ; (all regs irrellevant)
786 144
786 144 b. j10 w. ;
787 144 ; definitin of exception regdump:
788 144 j0 = a29 - a28 ; w0, w1
789 144 j1 = a31 - a28 ; w2, w3
790 144 j2 = a33 - a28 ; status, ic
791 144 j3 = a177- a28 ; cause, sb
792 144 a180 = j3 + 2 ; top of exception regdump = new rel ic
793 144
793 144 c29: ; internal 3:
794 144 rl w1 b1 ;
795 146 al w3 6 ;
796 148 rs w3 x1+a176 ; cause (cur) := 6; i.e. monitor call break;
797 150
797 150 rl w2 x1+a27 ; w2 := exception address (cur);
798 152 sn w2 0 ; if exception address = 0 then
799 154 jl c2 ; goto internal interrupt;
800 156 al w3 x2 ; save w2 and
801 158 jl w2 (b31) ; call errorlog
802 160 al w2 x3 ; restore w2
803 162
803 162 wa w2 x1+a182 ; w2 := abs exception address;
804 164
804 164 dl w0 x1+a29 ; move: save w0
805 166 ds w0 x2+j0 ; save w1
806 168 dl w0 x1+a31 ; save w2
807 170 ds w0 x2+j1 ; save w3
808 172 dl w0 x1+a33 ; save status
809 174 ds w0 x2+j2 ; save ic
810 176 ; rs w0 x1+a28 ; save w0 := save ic;
811 176 ; al w0 14<2+0 ;
812 176 ; rs w0 x1+a29 ; save w1 := 'jd'-instruction;
813 176 dl w0 x1+a177 ; save cause (= 6)
814 178 ds w0 x2+j3 ; save sb to user exception addres;
815 180 ; rs w0 x1+a30 ; save w2 := save sb;
816 180 ; rs w3 x2+a31 ; save w3 := save cause (= 6);
817 180 ws w2 x1+a182 ; w2 := logic user exception address;
818 182 al w2 x2+a180 ;
819 184 rs w2 x1+a33 ; save ic := exception address + no of regdump bytes
820 186 e. ;
821 186 ;. ..... husk at nulstille addresse-bits i status .....
822 186 ; continue with interrupt return;
823 186
823 186 ; interrupt return:
824 186 ; a new internal process may have been put up in front of
825 186 ; the time slice queue, due to an external interrupt, or because
826 186 ; the current monitor call was 'send message' or the like.
827 186 ; therefore it must be tested, that the current process is still
828 186 ; the one in front. if not: select that one.
829 186
829 186 c24: ; dummy interrupt
830 186 c99: ; interrupt return:
831 186 dl w2 b2 ; w1 := cur; w2 := first in time slice queue;
832 188 sn w1 x2-a16 ; if cur = first then
833 190 ri a179 ; return interrupt;
834 192 ; (preferably without reloading limit-copies)
835 192
835 192 ; initialize the previous interrupt stack element:
836 192 al w2 x2-a16 ; cur := new cur; i.e. first in time slice queue;
837 194 rs w2 b1 ;
838 196 rl w0 x2+a35 ; time slice := quantum(new current);
839 198 rs w0 b11 ;
840 200 gg w3 b91 ; w3 := inf (= address of current stack element);
841 202 dl w1 x2+a170 ; move: user escape address (cur)
842 204 ; user exception address (cur)
843 204 ds w1 x3+a325+a328;
844 206 al w0 x2+a28 ; address of regdump area (cur)
845 208 rs w0 x3+a325+a326; to: previous interrupt stack element;
846 210
846 210 c.a400-1
847 210 ; insert process extension addresses in monitor table
848 210 dl w1 x2+a306 ;
849 210 wa w0 x2+a182 ;
850 210 wa w1 x2+a182 ;
851 210 ds w1 b28 ;
852 210 z.
853 210
853 210 ; if the new current process is a driver process then maybe
854 210 ; exchange driver std-locations:
855 210
855 210 rl w0 x2+a302 ; if the new current process has not
856 212 se w0 0 ; defined a 'wait first event'
857 214 sn w2 (b21) ; or the new cur = owner of std-locations then
858 216 ri a179 ; return interrupt;
859 218 ; (limit-copies must be initialized)
860 218
860 218 ; the contents of the std-driver-locations have to be exchanged:
861 218 ;
862 218 ; save the old contents in the outpointed process description:
863 218 ;
864 218 rl w3 b21 ; w3 := previous owner of std locations;
865 220 dl w1 g21 ; move: g20
866 222 ds w1 x3+a302+4 ; g21
867 224 dl w1 g23 ; g22
868 226 ds w1 x3+a302+8 ; g23
869 228 rl w1 g24 ; g24
870 230 rs w1 x3+a302+10; b18
871 232 dl w1 b19 ; b19
872 234 ds w1 x3+a302+14; to: previous process description;
873 236
873 236 ; restore the std-locations from the new current process:
874 236 rs w2 b21 ; new owner := current process;
875 238 dl w1 x2+a302+4 ; move: g20
876 240 ds w1 g21 ; g21
877 242 dl w1 x2+a302+8 ; g22
878 244 ds w1 g23 ; g23
879 246 rl w1 x2+a302+10; g24
880 248 rs w1 g24 ; b18
881 250 dl w1 x2+a302+14; b19
882 252 ds w1 b19 ; from: new current process;
883 254
883 254 ri a179 ; return interrupt;
884 256 ; (limit-copies must be initialized)
885 256
885 256 ; power failure:
886 256 ;
887 256 ; may occur at any level
888 256 ;
889 256 ; save the current interrupt stack entry address, unless
890 256 ; already saved
891 256 ; (this should prevent powerfail-cascades from disturbing the system)
892 256
892 256 b. h10, i10 w. ;
893 256 c6: gg w2 b91 ; w2 := current stack element;
894 258 rl w3 h0 ; w3 := previous power up element;
895 260 sn w3 0 ; if previous element is free then
896 262 rs w2 h0 ; power up element := current stack element;
897 264 al w2 0 ; ilevc := 0;
898 266 gp w2 b90 ; (i.e. the following will provoke a systemfault)
899 268 jl -1<1 ; halt;
900 270
900 270 h0: b49 ; power up element: initially monitor element
901 272
901 272 ; power up:
902 272 ;
903 272 ; initialize: montop (i.e. max monitor function)
904 272 ; size (i.e. core size)
905 272 ; inf (i.e. power up element)
906 272 ;
907 272 ; clear any pending interrupt bits, because they may be irrellevant
908 272 ;
909 272 ; entry conditions:
910 272 ; inf register = 1
911 272 ; totally disabled
912 272
912 272 c25: al w3 -1<11 ; montop := 1 < 11
913 274 ac w3 x3+b17 ; - top monitor function number;
914 276 gp w3 b93 ;
915 278
915 278 rl w3 b12 ; size := number of storage bytes;
916 280 gp w3 b92 ;
917 282 c.(:a90>0 a.1:)-1
918 282 jl. w3 d140. ; dump core via fpa
919 282 z.
920 282
920 282
920 282 al w3 6 ; ilevc := 0 < 12 + 6;
921 284 gp w3 b90 ; i.e. enable for powerfail;
922 286
922 286 rl w3 h0 ; w3 := power up element;
923 288 sn w3 0 ; if power up element = 0 then
924 290 jl -2<1 ; halt; i.e. power fail was not serviced;
925 292 rs w3 b75 ; after powerfail := true;
926 294 ; (should be tested by clockdriver)
927 294
927 294 rl w2 b73 ; intno := max external interrupt number;
928 296 i0: gp w2 b95 ; rep: clear (intno) in cpu;
929 298 al w2 x2-1 ; intno := intno - 1;
930 300 sl w2 6+1 ; if intno > powerfail then
931 302 jl i0 ; goto rep;
932 304 al w1 0 ; (prepare a new h0...)
933 306
933 306 je k+2 ; (if any power fail during this start up,
934 308 jd k+2 ; it will be 'serviced' now, i.e. systemfault)
935 310
935 310 ; the following sequence of instructions have to be executed
936 310 ; without any disturbance, else the system won't work
937 310 rs w1 h0 ; clear previous power up element;
938 312 ; (i.e. prevent two consecutive powerups)
939 312 gp w3 b91 ; inf := power up element;
940 314 ri a179 ; return interrupt;
941 316 ; (the limit-copies must be initialized)
942 316 e. ; end of power fail/restart
943 316
943 316 ; procedure deliver external interrupt
944 316 ;
945 316 ; when an external interrupt is accepted by the monitor,
946 316 ; control is transferred out into the corresponding
947 316 ; device description, which should contain:
948 316 ;
949 316 ; dev descr + a240 : jl w2 c51
950 316 ;
951 316 ; return must be made to the standard interrupt return action,
952 316 ; which will take care of a possible selection of the driver.
953 316 ;
954 316 ; call: w2 = dev descr + a241
955 316 ; return address = interrupt return
956 316
956 316 c51: rl w3 x2-a241+a230; w3 := top of executed channel program;
957 318 al w0 4 ; result := 4; (i.e. prepare for abnormal termination)
958 320 se w3 0 ; if top command address defined then
959 322 bl w3 x3-6+1 ; w3 := last command executed;
960 324 sn w3 -1<8 ; if last command = 'stop' then
961 326 al w0 0 ; result := 0;
962 328 sn w3 4<8 ; if last command = 'wait' then
963 330 al w0 5 ; result := 5;
964 332
964 332 c50: al w3 c99 ; link := interrupt return;
965 334 ; continue with deliver interrupt
966 334
966 334 ; procedure deliver interrupt
967 334 ; function: delivers the interrupt operation in the event queue
968 334 ; of the corresponding driver process.
969 334 ; the driver process is started, if it was waiting for
970 334 ; an event.
971 334 ;
972 334 ; call: w0 = result (=0, 1, 2, 3, 4, 5, 6), w2 = operation, w3 = link
973 334 ; exit: all regs undef
974 334 ; return address: link
975 334
975 334 b. h10 w. ;
976 334 d121:rs w3 h0 ; save (return);
977 336 jl w1 d131 ; set result and descrease all stopcounts;
978 338 ; w2 = device descr
979 338
979 338 rl w1 x2+a250 ; driver := driverproc (device descr);
980 340 sh w1 0 ; if driver undefined then
981 342 jl (h0) ; return;
982 344
982 344 al w2 x2+a241 ; oper := timeout operation (device descr);
983 346 rl w3 h0 ; restore (return);
984 348
984 348 bz w0 x1+a13 ; state := state(driver);
985 350 sn w0 a104 ; if driver is waiting for event then
986 352 jl d127 ; goto take interrupt;
987 354
987 354 al w1 x1+a15 ; link (event queue (driver) , oper);
988 356 jl d6 ; return;
989 358 h0: 0 ; saved return;
990 360 e. ;
991 360
991 360 ; procedure take interrupt
992 360 ; function: let the driver receive the interrupt operation at once
993 360 ;
994 360 ; call: w1 = driver process, w2 = interrupt operation, w3 = link
995 360 ; exit: all regs undef
996 360 ; return address: link
997 360
997 360 d127:al w2 x2-a241+a246;
998 362 rs w2 x1+a30 ; save w2 (driver) := address of driver service inst
999 364
999 364 al w0 2 ; save w0 (driver) := 2; i.e. indicate interrupt;
1000 366 rs w0 x1+a28 ; link internal (driver);
1001 368 ; (only relevant after deliver interrupt)
1002 368 jl d10 ; return;
1003 370
1003 370 ; procedure prepare driver(proc)
1004 370 ; function: initializes current external process and current buffer
1005 370 ; exits to the interrupt address given in proc:
1006 370 ; int addr : normal exit
1007 370 ;
1008 370 ; the call must be made like this:
1009 370 ;
1010 370 ; proc + a246: jl w1 c30 ; driver service instruction
1011 370 ; ---
1012 370 ; proc + a245: interrupt address
1013 370 ; ---
1014 370 ; proc + a54 : next message buf
1015 370 ;
1016 370 ; call: w1 = proc + a247
1017 370 ; exit: w0 = result(proc), w1 = proc, w2 = buf(proc)
1018 370 ; int.addr : normal exit
1019 370
1019 370 c30: al w1 x1-a247 ;
1020 372 rs w1 b19 ; current receiver := buf;
1021 374 rl w2 x1+a54 ;
1022 376 rs w2 b18 ; current buffer address := next mess(proc);
1023 378 rl w0 x1+a244 ; result := timeout(proc);
1024 380 jl (x1+a245) ; goto interrupt address(proc);
1025 382
1025 382 ; procedure clear device
1026 382 ;
1027 382 ; function: everything is cleared-up in the device description,
1028 382 ; i.e. the controller is reset (except after 'wait'-program)
1029 382 ; a possible pending interrupt is cleared
1030 382 ; a possible pending interrupt operation is removed
1031 382 ; if any stopcounts were increased, they will be decreased
1032 382 ;
1033 382 ; call: w1 = link, w2 = device descr
1034 382 ; exit: w2 = unchanged, w0, w1, w3 = undef
1035 382 ; return address: link
1036 382
1036 382 d129: ; unconditionally reset:
1037 382 am a235-a225; (point at something <> 0)
1038 384 d130: ; conditionally reset:
1039 384 rl w0 x2+a225 ; get transfer code to see if transfer in progress;
1040 386 rl w3 x2+a235 ; w3 := device address(device description);
1041 388 ; it should be noted, that the controller is not reset when a wait-program is timed out
1042 388 se w0 0 ; if transfer code <> 0 then
1043 390 do w3 x3+2.01<1 ; reset device (device address);
1044 392
1044 392 ls w3 1 ; entry := device address
1045 394 ls w3 -1 ; (remove bit 0)
1046 396 wa w3 b65 ; + controller table base;
1047 398
1047 398 rl w0 x3+a313 ; w0 := interrupt number(controller table (entry));
1048 400 gp w0 b95 ; clear interrupt bit in cpu;
1049 402
1049 402 al w2 x2+a242 ; oper := timeout operation(device descr);
1050 404 ; continue with set result and decrease all stopcounts
1051 404 ; (result = undef)
1052 404
1052 404 ; procedure set result and decrease all stopcounts
1053 404 ;
1054 404 ; call: w0 = result: 0 = transfer terminated by stop
1055 404 ; 1 = bus reject when started
1056 404 ; 2 = bus timeout when started (i.e. disconnected)
1057 404 ; (3 = software timeout)
1058 404 ; 4 = transfer terminated, before stop
1059 404 ; 5 = wait-program terminated
1060 404 ; (6 = power restart)
1061 404 ; w1 = link w2 = timeout operation
1062 404 ; exit: w2 = device description, w0, w1, w3 = undef
1063 404
1063 404 d131:rs w0 x2-a241+a244; save result in timeout-field;
1064 406 se w2 (x2) ; (if in timer queue then
1065 408 jl w3 d5 ; remove(timeout operation); )
1066 410 al w2 x2-a241 ; w2 := device descr;
1067 412 ; continue with decrease all stopcounts
1068 412
1068 412 ; procedure decrease all stopcounts
1069 412 ;
1070 412 ; function: if any stopcounts increased, then decrease them again
1071 412 ; transfer code(device descr) := 0
1072 412 ;
1073 412 ; call: w1 = link, w2 = device descr
1074 412
1074 412 b. h10, i10 w. ;
1075 412 d132:ds w2 h1 ; save (link, device descr);
1076 414 rl w1 x2+a225 ; get transfer code(device descr);
1077 416 sn w1 -1 ; if no transfer to processes then
1078 418 jl i1 ; goto clear up;
1079 420
1079 420 so w1 2.1 ; if transfer code odd then
1080 422 jl i0 ; begin i.e. transfer to/from driver area;
1081 424
1081 424 rl w1 x2+a250 ; driver := driver process (device descr);
1082 426 jl w3 d133 ; decrease stopcount(driver);
1083 428
1083 428 rl w2 h1 ; restore(device descr);
1084 430 al w1 -1<1 ;
1085 432 la w1 x2+a225 ; restore (transfer code) (even)
1086 434 i0: ; end;
1087 434 sn w1 0 ; if transfer code shows transfer to/from sender the
1088 436 jl i1 ; begin
1089 438
1089 438 jl w3 d133 ; decrease stopcount(sender);
1090 440 rl w2 h1 ; restore (device descr);
1091 442 ; end;
1092 442 i1: al w1 0 ; clear up:
1093 444 rs w1 x2+a225 ; transfer code(device descr) := 0; i.e. no transfer
1094 446 jl (h0) ; return;
1095 448
1095 448 h0: 0 ; saved return
1096 450 h1: 0 ; saved device descr
1097 452 e. ;
1098 452
1098 452 ; procedure decrease stopcount
1099 452 ;
1100 452 ; function: the stopcount of the process is decreased by 1.
1101 452 ; if the stopcount becomes zero, and the process is waiting
1102 452 ; to be stopped, the process is stopped now (i.e. put in
1103 452 ; the state 'waiting for start by...'), and the following will
1104 452 ; be done:
1105 452 ; if the process was stopped by its parent, the stop-answer
1106 452 ; will be send to the parent (as defined by the wait-address
1107 452 ; in the process), indicating that the stopping has been
1108 452 ; accomplished.
1109 452 ; the decrease-action is repeated for the parent etc.etc.
1110 452 ;
1111 452 ; call: w1 = process, w3 = link
1112 452 ; exit: all regs undef
1113 452 ; return address: link
1114 452
1114 452 b. i10 w. ;
1115 452 d133: ; decrease stopcount:
1116 452 i0: al w0 -1 ; loop:
1117 454 ba w0 x1+a12 ; stopcount (process) :=
1118 456 hs w0 x1+a12 ; stopcount (process) - 1;
1119 458 bz w2 x1+a13 ;
1120 460 sn w0 0 ; if stopcount <> 0 or
1121 462 so w2 a105 ; process not waiting for being stopped then
1122 464 jl x3 ; return;
1123 466
1123 466 al w0 x2+a106 ; state (process) := state (process)
1124 468 hs w0 x1+a13 ; + 'waiting for start';
1125 470
1125 470 ; prepare for repeating the loop:
1126 470 rl w2 x1+a40 ; buf := wait address(process);
1127 472 rl w1 x1+a34 ; process := parent (process);
1128 474 se w0 a99 ; if state <> 'waiting for start by parent' then
1129 476 jl i0 ; goto loop;
1130 478
1130 478 ; prepare the buffer for returning the answer:
1131 478 al w0 1 ; receiver(buf) := result := 1;
1132 480 rs w0 x2+a141 ;
1133 482 al w0 x3 ; (save return)
1134 484 jl. w3 d15. ; deliver answer(buf);
1135 486 rl w3 0 ; (restore return)
1136 488 jl i0 ; goto loop;
1137 490 e. ;
1138 490
1138 490 ; return result in save w0(cur);
1139 490 ; entry: w1=cur
1140 490 r5: am 5-4 ;
1141 492 r4: am 4-3 ;
1142 494 r3: am 3-2 ;
1143 496 r2: am 2-1 ;
1144 498 r1: am 1-0 ;
1145 500 r0: al w0 0 ;
1146 502 r28: rs w0 x1+a28 ; save w0:=result;
1147 504 jl c99 ; goto interrupt return;
1148 506
1148 506 ; elementary link-procedures:
1149 506
1149 506 ; procedure remove(elem);
1150 506 ; comment: removes a given element from its queue and leaves the element linked to itself.
1151 506 ; call: w2=elem, w3=link
1152 506 ; exit: w0, w1, w2=unchanged, w3=next(elem)
1153 506 ; return address: link
1154 506
1154 506 b. i1 w.
1155 506
1155 506 d5: rs w3 i0 ; save return;
1156 508 rl w3 x2 ; w3 := next(elem);
1157 510 rx w2 x2+2 ; w2 := prev(elem); prev(elem) := elem;
1158 512 rs w3 x2 ; next(w2) := next(elem);
1159 514 rx w2 x3+2 ; w2 := elem; prev(next(elem)) := old prev(elem);
1160 516 rs w2 x2 ; next(elem) := elem;
1161 518 jl (i0) ; return;
1162 520
1162 520 ; procedure increase bufclaim, remove release buf;
1163 520 ; comment: bufclaim(cur) is increased, continue with release buf
1164 520 ; call: w1=cur, w2=buf, w3=link
1165 520 ; exit: w0, w1=undef, w2, w3=unchanged
1166 520 ; return address: link
1167 520
1167 520 d109: ;
1168 520 al w0 1 ;
1169 522 ba w0 x1+a19 ; increase(bufclaim(cur));
1170 524 hs w0 x1+a19 ;
1171 526 ; continue with d106
1172 526
1172 526 ; procedure remove release buf;
1173 526 ; comment: removes the buffer from its queue, continue with release mess buf
1174 526 ; call: w2=buf, w3=link
1175 526 ; exit: w0, w2, w3=unchanged, w1=undef
1176 526 ; return address: link
1177 526
1177 526 d106: ;
1178 526 al w1 x3 ; save return
1179 528 jl w3 d5 ; remove (buf);
1180 530 al w3 x1 ; restore return;
1181 532 ; continue with d13
1182 532
1182 532 ; procedure release mess buf(buf);
1183 532 ; comment: clears sender and receiver and links the buffer to the pool.
1184 532 ; call: w2=buf, w3=link
1185 532 ; exit: w0=unchanged, w1=undef, w2, w3=unchanged
1186 532 ; return address: link
1187 532
1187 532 d13: al w1 0 ; sender(buf):=0;
1188 534 rs w1 x2+4 ; receiver(buf):=0;
1189 536 rs w1 x2+6 ;
1190 538 c. (:a128>2 a. 1:) - 1; if rc6000 then
1191 538 rl w1 b8 ; head:=next(mess buf pool); (i.e. link in front of pool)
1192 538 z. ; else
1193 538 c. - (:a128>2 a. 1:) ;
1194 538 al w1 b8 ; head := mess buf pool head; (i.e. link in rear);
1195 540 z. ;
1196 540
1196 540 ; procedure link(head, elem);
1197 540 ; comment: links the element to the end of the queue
1198 540 ; call: w1=head, w2=elem, w3=link
1199 540 ; exit: w0, w1, w2=unchanged, w3=old last(head);
1200 540
1200 540 d6: rs w3 i0 ; save return;
1201 542 rl w3 x1+2 ; old last:=last(head);
1202 544 rs w2 x1+2 ; last(head):=elem;
1203 546 rs w2 x3+0 ; next(old last):=elem;
1204 548 rs w1 x2+0 ; next(elem):=head;
1205 550 rs w3 x2+2 ; last(elem):=old last;
1206 552 jl (i0) ; return;
1207 554 i0: 0 ; saved return: remove, link
1208 556 e.
1209 556
1209 556 ; procedure remove user(internal, proc);
1210 556 ; procedure remove reserver(internal, proc);
1211 556 ; comment: removes the id-bit of internal from the reserver- and-or userbits
1212 556 ; call: w1=internal, w2=proc, w3=link
1213 556 ; exit: w0=undef, w1,w2,w3=unchanged
1214 556 ; return address: link
1215 556
1215 556 d123:rl w0 x2+a53 ; users.proc :=
1216 558 sz w0 (x1+a14) ; users.proc exclusive internal;
1217 560 ws w0 x1+a14 ;
1218 562 rs w0 x2+a53 ;
1219 564
1219 564 d124:rl w0 x2+a52 ; reserver.proc :=
1220 566 sz w0 (x1+a14) ; reserver.proc exclusive internal;
1221 568 ws w0 x1+a14 ;
1222 570 rs w0 x2+a52 ;
1223 572
1223 572 jl x3 ; return;
1224 574
1224 574 ; procedure insert reserver(internal, proc);
1225 574 ; procedure insert user(internal, proc);
1226 574 ; comment: adds the id-bit of internal to reserver- and-or userbits
1227 574 ; call: w1=internal, w2=proc, w3=link
1228 574 ; exit: w0=undef, w1,w2,w3=unchanged
1229 574 ; return address: link
1230 574
1230 574 d125:rl w0 x2+a52 ; reserver.proc :=
1231 576 lo w0 x1+a14 ; reserver.proc inclusive internal;
1232 578 rs w0 x2+a52 ;
1233 580
1233 580 d126:rl w0 x2+a53 ; users.proc :=
1234 582 lo w0 x1+a14 ; users.proc inclusive internal;
1235 584 rs w0 x2+a53 ;
1236 586
1236 586 jl x3 ; return;
1237 588
1237 588 ; procedure check user;
1238 588 ;
1239 588 ; call: w1=internal, w2=proc, w3=link
1240 588 ; exit: w0=undef, w1, w2, w3=unchanged
1241 588 ; return address: link+2: cur was user
1242 588 ; link : cur was not user
1243 588
1243 588 d102: ;
1244 588 rl w0 x2+a53 ; if user(proc) logand idbit(internal) = 1 then
1245 590 sz w0 (x1+a14) ;
1246 592 jl x3+2 ; return to link+2; i.e. user
1247 594 jl x3 ; return to link; i.e. not user
1248 596
1248 596 ; procedure check any reserver;
1249 596 ;
1250 596 ; call: w1=internal, w2=proc, w3=link
1251 596 ; exit: w0=undef, w1, w2, w3=unchanged
1252 596 ; return address: link : other process is reserver
1253 596 ; link+2: internal is reserver
1254 596 ; link+4: not reserved by anyone
1255 596
1255 596 d113: ;
1256 596 rl w0 x2+a52 ; if reserver(proc)=0 then
1257 598 sn w0 0 ;
1258 600 jl x3+4 ; return to link+4; i.e. not reserved
1259 602 se w0 (x1+a14) ; if reserver(proc) <> idbit(cur) then
1260 604 jl x3 ; return to link; i.e. other reserver;
1261 606 jl x3+2 ; return to link+2; i.e. already reserved
1262 608
1262 608 ; procedure check mess area and name(save w3) area;
1263 608 ; procedure check name(save w3) area;
1264 608 ; procedure check name(save w2) area;
1265 608 ; comment: checks that the areas are within the process
1266 608 ; call: w1=cur, w3=link
1267 608 ; exit: w0=undef, w1=unchanged, w2=name, w3=unchanged
1268 608 ; return address: link: within process
1269 608 ; c29 : not within process
1270 608
1270 608 d110: ; check message area and name area:
1271 608 rl w2 x1+a29 ;
1272 610 al w0 x2+14 ; mess:=save w1(cur);
1273 612 sh w0 0 ;
1274 614 jl c29 ; if overflow or
1275 616 sl w2 (x1+a17) ; mess<first addr(cur) or
1276 618 sl w0 (x1+a18) ; mess+14>=top addr(cur) then
1277 620 jl c29 ; goto internal 3;
1278 622
1278 622 d17: am a31-a30; check name(save w3) area:
1279 624 d111: ; check name(save w2) area:
1280 624 rl w2 x1+a30 ;
1281 626 al w0 x2+6 ;
1282 628
1282 628 ; procedure check within(first, last);
1283 628 ; comment: checks that the specified area is within the process
1284 628 ; call: w0=last, w1=cur, w2=first, w3=link
1285 628 ; exit: w0, w1, w2, w3=unchanged
1286 628 ; return address: link: within process
1287 628 ; c29 : not within process
1288 628
1288 628 d112: ; check within:
1289 628 sh w0 0 ;
1290 630 jl c29 ; if overflow or
1291 632 sl w2 (x1+a17) ; first<first addr(cur) or
1292 634 sl w0 (x1+a18) ; last>=top addr(cur) then
1293 636 jl c29 ; goto internal 3;
1294 638 jl x3 ; return;
1295 640
1295 640 ; procedure check message area and buf (=d18+d12);
1296 640 ;
1297 640 ; call: w1=cur, w3=link
1298 640 ; exit: w0=undef, w1=cur, w2=buf, w3=unchanged
1299 640 ; return address: link: ok
1300 640 ; c29 : mess area outside cur
1301 640 ; c29 : buf not message buf
1302 640
1302 640 d103: ;
1303 640 rl w2 x1+a29 ; mess:=save w1(cur);
1304 642 al w0 x2+14 ;
1305 644 sh w0 0 ; if overflow or
1306 646 jl c29 ;
1307 648 sl w2 (x1+a17) ; mess<first addr(cur) or
1308 650 sl w0 (x1+a18) ; mess+14>=top addr(cur) then
1309 652 jl c29 ; goto internal 3;
1310 654
1310 654 ; procedure check message buf;
1311 654 ; comment: checks whether the save w2 of the internal process is a message buffer address
1312 654 ; call: w1=internal, w3=link
1313 654 ; exit: w0=undef, w1=cur, w2=buf, w3=unchanged
1314 654 ; return address: link: buffer ok
1315 654 ; c29 : save w2 not message buffer
1316 654
1316 654 d12: rl w2 x1+a30 ; buf:=save w2(internal);
1317 656 sl w2 (b8+4) ; if buf<mess buf pool start or
1318 658 sl w2 (b8+6) ; buf >=mess buf pool end then
1319 660 jl c29 ; goto internal 3;
1320 662 al w1 x2 ;
1321 664 ws w1 b8+4 ; if (buf-pool start) mod mess buf size
1322 666 al w0 0 ; <>0 then
1323 668 wd w1 b8+8 ; goto internal 3;
1324 670 rl w1 b1 ; w1:=cur;
1325 672 sn w0 0 ;
1326 674 jl x3 ; return;
1327 676 jl c29 ;
1328 678
1328 678 ; procedure check event(proc, buf);
1329 678 ; comment: checks that buf is the address of an operation in the event queue of the internal process
1330 678 ; call: w1=proc, w2=buf, w3=link
1331 678 ; exit: w0=undef, w1, w2, w3=unchanged
1332 678 ; return address: link: buffer address ok
1333 678 ; c29 : buf is not in the queue
1334 678
1334 678 b. i0 w.
1335 678 d19: al w0 x2 ;
1336 680 al w2 x1+a15 ; oper:=event q(proc);
1337 682 i0: rl w2 x2+0 ; next: oper:=next(oper);
1338 684 sn w2 x1+a15 ; if oper=event q(proc) then
1339 686 jl c29 ; goto internal 3; (i.e. not in queue);
1340 688 se w0 x2 ; if buf<>oper then
1341 690 jl i0 ; goto next;
1342 692 jl x3 ; return;
1343 694 e.
1344 694
1344 694 ; procedure check and search name (=d17+d11);
1345 694 ;
1346 694 ; call: w1=cur, save w3(cur)=name, w3=link
1347 694 ; exit: w0, w1=unchanged, w2=name, w3=entry
1348 694 ; return address: link: entry not found
1349 694 ; link+2: entry found
1350 694 ; c29 : name area outside current process
1351 694 b. i20 w.
1352 694
1352 694 d101: ;
1353 694 ds w1 i1 ; save(w0, cur);
1354 696 rl w2 x1+a31 ; name:=save w3(cur);
1355 698 al w0 x2+6 ;
1356 700 sh w0 0 ; if overflow or
1357 702 jl c29 ;
1358 704 sl w2 (x1+a17) ; name<first addr(cur) or
1359 706 sl w0 (x1+a18) ; name+6>=top addr(cur) then
1360 708 jl c29 ; goto internal 3;
1361 710 dl w1 x1+a43 ; w0w1:=catbase(cur);
1362 712 jl i14 ; goto search name(name, entry, base);
1363 714
1363 714 ; the following procedures searches the name table for a given entry and delivers its entry in
1364 714 ; the name table. if name is undefined, the entry is name table end.
1365 714
1365 714 ; procedure search name(name, entry);
1366 714 ; call: w2=name, w3=link
1367 714 ; exit: w0, w1, w2=unchanged, w3=entry
1368 714 ; return address: link : name not found, w3=(b7)
1369 714 ; link+2: name found
1370 714
1370 714 d11: ds w1 i1 ; save(w0, w1);
1371 716 am (b1) ;
1372 718 dl w1 +a43 ; base:=catbase(cur);
1373 720 i14: al w3 x3+1 ; link := link + 1; i.e. destinguish between normal and error return;
1374 722
1374 722 ; procedure search name(name, entry, base);
1375 722 ; call: w0, w1=base, w2=name, w3=link
1376 722 ; exit: w0, w1=undef, w2=unchanged, w3=entry
1377 722 ; return address: link : name not found, w3=(b7)
1378 722 ; link : name found, w3 <> (b7)
1379 722
1379 722 d71: ds w3 i3 ; save (name, return);
1380 724 i4: al w1 x1-1;used ;
1381 726 bs w0 i4+1 ;
1382 728 ds w1 i6 ; base:=base+(1, -1);
1383 730 dl w1 d73 ;
1384 732 ds w1 i8 ; min base:=extreme;
1385 734 rl w1 b7 ;
1386 736 rs w1 i9 ; found:=name table end;
1387 738 rl w1 b1 ; get physical name address
1388 740 wa w2 x1+a182 ;
1389 742 dl w1 x2+6 ;
1390 744 ds w1 i13 ; move name to last name in name table;
1391 746 dl w1 x2+2 ;
1392 748 sn w0 0 ; if name(0)<>0 then
1393 750 jl i18 ;
1394 752 ds w1 i11 ;
1395 754 rl w3 b3 ; for entry:=name table start
1396 756 jl i17 ;
1397 758 i15: dl w1 i11 ;
1398 760 i16: al w3 x3+2 ; step 2 until name table end do
1399 762 i17: rl w2 x3 ;
1400 764 sn w1 (x2+a11+2) ; begin
1401 766 se w0 (x2+a11+0) ; proc:=name table(entry);
1402 768 jl i16 ;
1403 770 dl w1 i13 ;
1404 772 sn w0 (x2+a11+4) ;
1405 774 se w1 (x2+a11+6) ; if name.proc=name and
1406 776 jl i15 ;
1407 778 sn w2 c98 ;
1408 780 jl i18 ;
1409 782 dl w1 x2+a49 ;
1410 784 sl w0 (i7) ; lower.proc>=lower.min and
1411 786 sl w0 (i5) ; lower.proc<=lower.base and
1412 788 jl i15 ;
1413 790 sh w1 (i8) ; upper.proc<=upper.min and
1414 792 sh w1 (i6) ; upper.proc>=upper base then
1415 794 jl i15 ; begin
1416 796 ds w1 i8 ; min:=interval.proc;
1417 798 rs w3 i9 ; found:=entry;
1418 800 jl i15 ; end;
1419 802 i18: ; end;
1420 802 dl w0 i0 ; restore(w0, w1, w2);
1421 804 dl w2 i2 ; w3:=found;
1422 806 sn w3 (b7) ; if w3=name table end then
1423 808 jl (i3) ; return to link
1424 810 am (i3) ; else
1425 812 jl +1 ; return to link+1;
1426 814
1426 814 i9: 0 ;i0-2: found (i.e. current best entry, or (b7))
1427 816 i0: 0 ;i1-2: saved w0
1428 818 i1: 0 ;i2-2: saved w1
1429 820 i2: 0 ;i3-2: saved w2
1430 822 i3: 0 ; saved return
1431 824 i5: 0 ;i6-2: lower base+1 for search
1432 826 i6: 0 ; upper base-1 for search
1433 828 i7: 0 ;i8-2: lower minimum
1434 830 i8: 0 ; upper minimum
1435 832
1435 832 ; the last entry in name table must point here:
1436 832 c98 = k-a11
1437 832 i10: 0 ; name to search for
1438 834 i11: 0 ;
1439 836 i12: 0 ;
1440 838 i13: 0 ;
1441 840
1441 840 a107 ; max base lower
1442 842 d72: a108 ; max base upper
1443 844 a107-1 ; extreme lower
1444 846 d73: a108+1 ; extreme upper
1445 848 e.
1446 848
1446 848
1446 848 ; procedure claim buffer
1447 848 ;
1448 848 ; call: w1=cur, w2=buf, w3=link
1449 848 ; exit: w0=undef, w1, w2, w3=unchanged
1450 848 ; return address: link: claim decreased ok
1451 848 ; c99 : claims exceeded, save w2(cur):=0
1452 848
1452 848 b. i0 w.
1453 848 d108: ;
1454 848 bz w0 x1+a19 ; if bufclaim(cur)=0 then
1455 850 sn w0 0 ;
1456 852 jl i0 ; goto no buffer;
1457 854 bs. w0 1 ;
1458 856 hs w0 x1+a19 ; decrease(bufclaim(cur));
1459 858 ac w0 (x2+4) ;
1460 860 rs w0 x2+4 ; receiver(buf):=-receiver(buf);
1461 862 jl x3 ; return to link;
1462 864 i0: rs w0 x1+a30 ; no buffer: save w2(cur):=0;
1463 866 jl c99 ; goto interrupt return;
1464 868 e.
1465 868
1465 868 ; procedure regretted message
1466 868 ; comment simulates the release of a message buffer, as in wait answer. the bufclaim of the
1467 868 ; sender is increased. the buffer is removed and released (unless in state: received)
1468 868 ;
1469 868 ; call: w2=buf, w3=link
1470 868 ; exit: w0, w1, w2=unchanged, w3=undef
1471 868
1471 868 b. i20 w.
1472 868 i0: 0 ; saved w0
1473 870 i1: 0 ; saved w1
1474 872 i2: 0 ; saved w2
1475 874 i3: 0 ; saved w3
1476 876 i8: 0 ; internal
1477 878 d75: rs w3 i3 ; save(return);
1478 880 ds w1 i1 ; save(w0, w1);
1479 882 rl w1 x2+6 ; proc:=sender(buf);
1480 884 sh w1 0 ; if proc<=0 then
1481 886 jl i6 ; goto exit; (message already regretted);
1482 888 ac w0 x1 ; (only relevant from remove process);
1483 890 rs w0 x2+6 ; sender(buf):=-proc; (i.e. regretted);
1484 892 rl w0 x1+a10 ; if kind(proc) = pseudo kind
1485 894 sn w0 64 ; then proc:= main(proc);
1486 896 rl w1 x1+a50 ; if proc is neither internal process nor
1487 898 sz w0 -1-64 ; pseudo process
1488 900 rl w1 x1+a250 ; then proc:= driver proc(proc);
1489 902
1489 902 bz w3 x1+a19 ;
1490 904 al w3 x3+1 ; increase(bufclaim(proc));
1491 906 hs w3 x1+a19 ;
1492 908 ; check if the buffer is claimed by receiver, or contains an answer:
1493 908 rl w1 x2+4 ; receiver:=receiver(buf);
1494 910 sh w1 0 ; if receiver<=0 then
1495 912 jl i6 ; goto exit; (i.e. claimed);
1496 914 sh w1 5 ; if receiver<=5 then
1497 916 jl i5 ; goto remove and release; (i.e. an answer);
1498 918 ; the message is neither answered nor claimed:
1499 918 rl w0 x1+a10 ; kind:=kind(receiver);
1500 920 se w0 0 ; if receiver is internal process or
1501 922 sn w0 64 ; pseudo process then
1502 924 jl i5 ; goto remove and release;
1503 926 i4: se w2 (x1+a54) ; if buf is first in queue then
1504 928 jl i5 ;
1505 930 al w0 -1 ; decrease(interrupt addr(proc))
1506 932 wa w0 x1+a56 ;
1507 934 sz w0 1 ; unless already odd
1508 936 rs w0 x1+a56 ;
1509 938 i5: jl w3 d106 ; remove release(buf);
1510 940 i6: dl w1 i1 ; exit: restore(w0, w1);
1511 942 jl (i3) ; return;
1512 944
1512 944 ; procedure move mess(from, to);
1513 944 ; comment: moves 8 message (or answer) words from a given storage address to another.
1514 944 ; call: w1=from, w2=to, w3=link
1515 944 ; exit: w0=undef, w1, w2=unchanged, w3=undef
1516 944 ; return address: link
1517 944
1517 944 d14: rs w3 i3 ;
1518 946 dl w0 x1+2 ;
1519 948 ds w0 x2+2 ;
1520 950 dl w0 x1+6 ; move 8 words from (from) to (to);
1521 952 ds w0 x2+6 ;
1522 954 dl w0 x1+10 ;
1523 956 ds w0 x2+10 ;
1524 958 dl w0 x1+14 ;
1525 960 ds w0 x2+14 ;
1526 962 jl (i3) ; return;
1527 964 e.
1528 964
1528 964
1528 964 ; procedure update time(slice);
1529 964 ; comment: senses the timer and updates current time slice and time;
1530 964 ;
1531 964 ; call: w3=link
1532 964 ; exit: w0=undef, w1=unchanged, w2=slice, w3=unchanged
1533 964 ; return address: link
1534 964
1534 964 b. i9 w.
1535 964 d7: gg w2 b94 ;
1536 966 al w0 x2 ; new value:=sense(timer);
1537 968 ws w2 b14 ; increase:=new value-clock;
1538 970 rs w0 b14 ; clock:=new value;
1539 972 sh w2 -1 ; if increase<0 then
1540 974 wa w2 i9 ; increase:=increase+size of clock;
1541 976 ; comment: timer overflowed...;
1542 976 al w0 x2 ;
1543 978 wa w2 b11 ; slice:=slice+increase;
1544 980 rs w2 b11 ;
1545 982
1545 982 wa w0 b13+2 ;
1546 984 rs w0 b13+2 ; time low:=time low+increase;
1547 986 sx 2.01 ;
1548 988 jl i8 ; if carry then
1549 990 jl x3 ;
1550 992
1550 992 i8: al w0 1 ; time high:=time high+1;
1551 994 wa w0 b13 ;
1552 996 rs w0 b13 ;
1553 998 jl x3 ; return;
1554 1000 i9: 1<16 ; increase when timer overflows;
1555 1002
1555 1002 ; the following entries removes the current process from the timequeue, and initializes state.
1556 1002 ; call: w1=cur
1557 1002 ; return address: interrupt return
1558 1002
1558 1002 d105: ; remove wait message:
1559 1002 ; bz w0 x1+a19 ;
1560 1002 ; sn w0 0 ; if buf claim(cur)=0 then
1561 1002 ; jl d108 ; goto claim buffer (and exit with save w2=0);
1562 1002 am a102-a104 ; state:=wait message;
1563 1004 d107: ; remove wait event:
1564 1004 am a104-a103 ; state:=wait event;
1565 1006 d104: ; remove wait answer:
1566 1006 al w0 a103 ; state:=wait answer;
1567 1008 al w3 c99 ; return:=interrupt return;
1568 1010 ; continue with remove internal;
1569 1010
1569 1010 ; procedure remove internal(internal, proc state);
1570 1010 ; comment: removes the internal process from the timer queue and sets its state
1571 1010 ; after this a new current process is selected.
1572 1010 ; call: w0=proc state, w1=cur, w3=link
1573 1010 ; exit: w0, w1=undef, w2=cur+a16, w3=undef
1574 1010 ; return address: link
1575 1010
1575 1010 d9: rs w3 i0 ; save(return);
1576 1012 hs w0 x1+a13 ; state(cur):=proc state;
1577 1014 jl w3 d7 ; update time(slice);
1578 1016 rs w2 x1+a35 ; quantum(cur):=slice;
1579 1018 dl w3 b13+2 ;
1580 1020 ds w3 x1+a39+2 ; start wait(cur):=time;
1581 1022 al w2 x1+a16 ;
1582 1024 rl w3 i0 ;
1583 1026 jl d5 ; remove(cur+a16);
1584 1028 ; return;
1585 1028
1585 1028 i0: 0 ; saved return
1586 1030
1586 1030 ; procedure link internal(proc);
1587 1030 ; comment: links the internal process to the timer queue. the timer queue is kept as a
1588 1030 ; sorted list, according to the priority. (the smaller the priority is, the better
1589 1030 ; is the priority).
1590 1030 ; if the time quantum is less than the maximum time slice, the process will be
1591 1030 ; linked up in front of other processes with the same priority. otherwise in the
1592 1030 ; rear (the time quamtum of the process is transferred to runtime(proc), except
1593 1030 ; the amount which is already used of the next quantum).
1594 1030 ; call: w1=proc, w3=link
1595 1030 ; exit: w0, w1, w2, w3=undef
1596 1030 d10: bz w0 x1+a13 ; if state(proc) = running then
1597 1032 sn w0 a95 ;
1598 1034 jl x3 ; return;
1599 1036
1599 1036 rs w3 i0 ; save(return);
1600 1038 al w0 a95 ;
1601 1040 hs w0 x1+a13 ; state(proc):=running;
1602 1042
1602 1042 al w2 x1+a16 ;
1603 1044 rl w3 x1+a301 ; priority:=priority(proc);
1604 1046 rl w1 x1+a35 ;
1605 1048 sl w1 (b10) ; if quantum(proc)>=max slice then
1606 1050 jl i3 ; goto insert in rear;
1607 1052
1607 1052 al w3 x3-1 ; (code facility);
1608 1054 al w1 b2 ; worse:=timer q head;
1609 1056 i1: rl w1 x1 ; next: worse:=next(worse);
1610 1058 sl w3 (x1-a16+a301) ; if priority(worse)<priority then
1611 1060 jl i1 ; goto next;
1612 1062 i2: ; insert process:
1613 1062 jl w3 d6 ; link(worse, proc+a16);
1614 1064 se w3 b2 ; if proc is not linked as the front
1615 1066 jl (i0) ; internal then return;
1616 1068 rl w1 b1 ;
1617 1070 jl w3 d7 ; update time(slice);
1618 1072 rs w2 x1+a35 ; quantum(cur):=slice; (may actually be >= max slice);
1619 1074 sh w2 (b10) ; if old quantum <= max slice then
1620 1076 jl (i0) ; return;
1621 1078 ; the following will take care of the round-robin time scheduling;
1622 1078 rl w2 (b2) ; proclink := second proc in timer queue;
1623 1080 jl w3 d5 ; remove(proclink);
1624 1082 rl w3 x2-a16+a301; priority:=priority(proc); (as above)
1625 1084 rl w1 x2-a16+a35 ; quantum:=quantum(proc); (as above)
1626 1086
1626 1086 ; the process has been in front of the queue for more than the max time slice.
1627 1086 ; the run time should be updated with all the quantum, but this would give the process a
1628 1086 ; complete time slice next time. instead the used quantum is split in two parts:
1629 1086 ; the amount by which it exceeds a multiplum of the max slice, and the rest. these parts
1630 1086 ; are the increase in runtime and the new quantum.
1631 1086 ; finally the process is inserted in the rear of the timer queue, according to priority.
1632 1086
1632 1086 i3: al w0 a85-1 ; w0 := mask for extracting new quantum;
1633 1088 la w0 2 ; quantum(proc) := quantum(proc) extract slice;
1634 1090 rs w0 x2-a16+a35;
1635 1092 ws w1 0 ;
1636 1094 al w0 0 ;
1637 1096 aa w1 x2-a16+a36+2; add the remaining part of quantum to
1638 1098 ds w1 x2-a16+a36+2; runtime(proc);
1639 1100
1639 1100 ; at this point there is at least one process in the timer queue,
1640 1100 ; i.e. either the dummy process or a 'better' process
1641 1100 ; the following is intended for skipping quickly the dummy process:
1642 1100 rl w1 b2+2 ; worse := rear of timer queue; (normally dummy process);
1643 1102 sl w3 (x1-a16+a301); if priority >= priority(worse) then
1644 1104 jl i5 ; goto found; (only in case of inserting dummy process)
1645 1106
1645 1106 al w3 x3+1 ; (code facility)
1646 1108 i4: rl w1 x1+2 ; next: worse:=last(worse);
1647 1110 sn w1 b2 ; if worse<>timer q head and
1648 1112 jl i5 ;
1649 1114 sh w3 (x1-a16+a301) ; priority(worse)>priority then
1650 1116 jl i4 ; goto next;
1651 1118
1651 1118 ; notice: the loop went one step to far . . .;
1652 1118 i5: rl w1 x1 ; now w1 has been repaired;
1653 1120 jl i2 ; goto insert proc;
1654 1122 e.
1655 1122 \f
1655 1122
1655 1122 ; to facilitate the error recovery the interrupt stack and the
1656 1122 ; stationary pointers of the monitor table are placed at fixed
1657 1122 ; addresses.
1658 1122
1658 1122 b128=1200, 0,r.(:b128-k+2:)>1-6
1659 1188 a130 ; date of options
1660 1190 a131 ; time of options
1661 1192 0, r.4 ; room for machine id.
1662 1200
1662 1200 m.
1662 1200 copies of some mon table entries, int stack, mon reg dump (24, 32, 26 hw)
1663 1200
1663 1200 ; copy of some monitor pointers:
1664 1200
1664 1200 0-0-0 ; b3: 72: name table start
1665 1202 0-0-0 ; b4: 74: first device in name table
1666 1204 0-0-0 ; b5: 76: first area in name table
1667 1206 0-0-0 ; b6: 78: first internal in name table
1668 1208 0-0-0 ; b7: 80: name table end
1669 1210 0-0-0 ; b8+4: 86: first byte of mess buf pool area
1670 1212 0-0-0 ; b8+6: 88: last byte of mess buf pool area
1671 1214 0-0-0 ; b22: 92: first drum chain in name table
1672 1216 0-0-0 ; b23: 94: first disc chain in name table
1673 1218 0-0-0 ; b24: 96: chain end in name table
1674 1220 b50 ; start of interrupt stack
1675 1222 0-0-0 ; b86: driver proc save area
1676 1224
1676 1224 ; definition of interrupt stack:
1677 1224
1677 1224 b50: 0 ; end of stack
1678 1226 b49=k-1 ; terminating stack-address
1679 1226
1679 1226 ; power fail element:
1680 1226 0 ; (irrellevant regdump)
1681 1228 0 ; (exception disabled)
1682 1230 0 ; (escape disabled)
1683 1232 0 ; (monitor call not permitted in monitor)
1684 1234 c8 ; external interrupt, second level
1685 1236 1 < 23 + 0 ; monitor mode + totally disabled
1686 1238
1686 1238 ; monitor element:
1687 1238 b52 ; monitor regdump
1688 1240 0 ; monitor exception routine
1689 1242 0 ; monitor escape routine
1690 1244 c0 ; monitor call entry
1691 1246 c1 ; external interrupt entry, first level
1692 1248 1 < 23 + 6 ; monitor mode + disable all but power/bus error
1693 1250
1693 1250 ; user element:
1694 1250 0-0-0 ; user regdump (initialized by select internal)
1695 1252 0-0-0 ; user exception ( - - - - )
1696 1254 0-0-0 ; user escape ( - - - - )
1697 1256
1697 1256 ; monitor regdump area
1698 1256 ;
1699 1256 ; used when initializing the whole system,
1700 1256 ; and to hold the working registers etc. in case of
1701 1256 ; powerfailure or buserror during monitor code
1702 1256
1702 1256 b52: 0 ; w0 = 0 (irrellevant)
1703 1258 0 ; w1 = 0 (irrellevant)
1704 1260 0 ; w2 = 0 (irrellevant)
1705 1262 0 ; w3 = 0 (irrellevant)
1706 1264 1 < 23 ; status = monitor mode
1707 1266 c99 ; ic = interrupt return
1708 1268 0 ; cause = 0 (irrellvant)
1709 1270 0 ; sb = 0 (irrellvant)
1710 1272
1710 1272 0 ; cpa = 0 (irrellevant)
1711 1274 0 ; base = 0 (irrellevant)
1712 1276 8 ; lower write limit
1713 1278 8.3777 7777 ; upper write limit = all possible core
1714 1280 0 < 12 + 6 ; interrupt limits
1715 1282 \f
1715 1282
1715 1282
1715 1282
1715 1282 ; comment: the following utility procedures are used by external
1716 1282 ; processes during input/output;
1717 1282
1717 1282 ; procedure deliver result(result)
1718 1282 ; comment: moves the general input/output answer to the beginning of the driver process.
1719 1282 ; (the last 3 words of the message buffer are copied too, so they will remain unchanged).
1720 1282 ; the answer is send with the specified result to the sender of the buffer.
1721 1282 ;
1722 1282 ; call: w0 = result, w3 = link, b18 = buffer
1723 1282 ; exit: w0 = undef, w1 = proc (= b19), w2 = undef, w3= unchanged
1724 1282 ; return address: link: answer delivered
1725 1282 ; (internal 3 if buf not claimed and claims exceeded)
1726 1282
1726 1282 b. i10 w.
1727 1282 g3: am 5-4 ; result 5:
1728 1284 g4: am 4-3 ; result 4:
1729 1286 g5: am 3-2 ; result 3:
1730 1288 g6: am 2-1 ; result 2:
1731 1290 g7: al w0 1 ; result 1: w0 := result;
1732 1292 rl w3 b20 ; return := wait-next action in driver process;
1733 1294 jl g19 ; goto deliver result;
1734 1296 g18: al w0 1 ; result 1: w0 := result;
1735 1298
1735 1298 g19: ; deliver result:
1736 1298 jd k+2 ; disable;
1737 1300 ds w0 i3 ; save(link, result);
1738 1302
1738 1302 rl w1 b1 ;
1739 1304 rl w2 b18 ; buf := current buffer;
1740 1306 ac w3 (x2+4) ;
1741 1308 sl w3 0 ; if receiver(buf) > 0 then
1742 1310 jl i0 ; begin comment: buf not claimed, see link operation;
1743 1312 bz w0 x1+a19 ; if bufclaim(cur) <> 0 then
1744 1314 sn w0 0 ; begin
1745 1316 jl i0 ; decrease(bufclaim(cur));
1746 1318 bs. w0 1 ; receiver(buf) := -receiver(buf);
1747 1320 hs w0 x1+a19 ; end; (i.e. claims exceeded will provoke a break below);
1748 1322 rs w3 x2+4 ; end;
1749 1324 i0: rl w0 x1+a182 ;
1750 1326 rl w1 x1+a302 ;
1751 1328 wa w1 0 ; get physical address of save area
1752 1330 dl w0 x2+a151 ; save first four words of mess.
1753 1332 ds w0 g29 ; (used by errorlog )
1754 1334 dl w0 x2+a153 ;
1755 1336 ds w0 g30 ;
1756 1338
1756 1338 dl w0 x2+22 ; move last 3 words from buf
1757 1340 ds w0 x1+14 ; to area;
1758 1342 rl w0 x2+18 ; (to retain compatibility with old conventions)
1759 1344 rl w3 g24 ;
1760 1346 ds w0 x1+10 ; move the 5 std answer words
1761 1348 dl w0 g23 ; to area;
1762 1350 ds w0 x1+6 ;
1763 1352 dl w0 g21 ;
1764 1354 ds w0 x1+2 ; (you are disabled, so do not worry about timeslicing...);
1765 1356
1765 1356 dl w0 i3 ; restore (link, result);
1766 1358 am (b1) ;
1767 1360 rl w1 +a302 ; get logical address of save area
1768 1362 jd 1<11+22; send answer(result, area, buf);
1769 1364
1769 1364 rl w1 b19 ; w1 := current receiver;
1770 1366 rl w2 x1 ; if kind of receiver=subprocess then
1771 1368 se w2 84 ; check status
1772 1370 sn w2 85 ; else return
1773 1372 jl. i1. ;
1774 1374 jd x3 ;
1775 1376
1775 1376 i1: rl w2 g20 ; if one or more of statusbits 1,2,4,9,10,11
1776 1378 se. w1 (b32.) ; or if receiver = special watched receiver
1777 1380 sz. w2 (i5.) ; then
1778 1382 jl w2 (b31) ; call errorlog
1779 1384 jd x3 ; restore link and return
1780 1386
1780 1386 i2: 0 ; saved link
1781 1388 i3: 0 ; saved result
1782 1390 b32: 0 ; proc adr for special watched receiver
1783 1392 m.
1783 1392 statusmask for errorlog
1784 1392 i5: 8.36070000 ; status mask: bit 1 2 3 4 9 10 11
1785 1394
1785 1394 ; procedure link operation (buf)
1786 1394 ; comment: links a message to the receiver and returns to the receiver, in case it is the only
1787 1394 ; message in the queue (and interrupt address is even).
1788 1394 ; otherwise it returns to the wait-next action in the driver process.
1789 1394 ;
1790 1394 ; call: w2 = buf, w3 = link
1791 1394 ; exit: w0 = operation, w1 = proc, w2 = unchanged, w3 = unchanged
1792 1394 ; return address: link: single in queue
1793 1394 ; (b20): others in queue
1794 1394 ; (b20): interrupt addr odd (i.e. driver busy)
1795 1394
1795 1394 g17: jd k+2 ; link operation:
1796 1396 rs w3 i3 ; save return;
1797 1398 ac w3 (x2+4) ;
1798 1400 sh w3 0 ; if receiver(buf) < 0 then
1799 1402 jl i4 ; begin comment: buf claimed. now release claim;
1800 1404 rs w3 x2+4 ; receiver(buf) := -receiver(buf); i.e. positive;
1801 1406 rl w1 b1 ;
1802 1408 bz w3 x1+a19 ; increase(buf claim(cur));
1803 1410 al w3 x3+1 ;
1804 1412 hs w3 x1+a19 ; end;
1805 1414
1805 1414 i4: am (b19) ;
1806 1416 al w1 +a54 ;
1807 1418 jl w3 d6 ; link(mess q(proc), buf);
1808 1420 se w3 x1 ; if old last <> mess q(proc) then
1809 1422 c33: jl (b20) ; goto wait next(driver process);
1810 1424
1810 1424 al w1 x1-a54 ; w1 := proc;
1811 1426 rl w0 x1+a56 ; w0 := interrupt addr(proc);
1812 1428 so w0 2.1 ; if interrupt addr(proc) is odd then
1813 1430 jl w3 g64 ;+2 goto wait next(driver process);
1814 1432 jl (b20) ;+2 examine queue: empty => goto wait next;
1815 1434 jl (i3) ; return
1816 1436
1816 1436 e.
1817 1436
1817 1436
1817 1436 ; procedure check user
1818 1436 ; comment: checks whether an external process is used
1819 1436 ; by the current internal process. if the external is reserved
1820 1436 ; it is also checked whether it is reserved by the current
1821 1436 ; internal process.
1822 1436 ; call: return:
1823 1436 ; w0 destroyed
1824 1436 ; w1 cur cur
1825 1436 ; w2 buf buf
1826 1436 ; w3 link link
1827 1436
1827 1436 b.i24 ; begin
1828 1436 w.g14:am (b19) ;
1829 1438 rl w0 a52 ;
1830 1440 sn w1 (b1) ; if cur = sender then
1831 1442 jl x3 ; return ok;
1832 1444 se w0 0 ; mask:=if reserved(proc)<>0
1833 1446 jl i0 ; then reserved(proc)
1834 1448 am (b19) ; else user(proc);
1835 1450 rl w0 a53 ; bit:=identification(cur);
1836 1452 i0: so w0 (x1+a14) ; if mask(bit)=0
1837 1454 jl g6 ; then goto result 2;
1838 1456 jl x3+0 ;
1839 1458 e. ; end
1840 1458
1840 1458 ; procedure check reservation
1841 1458 ; comment: checks whether an external process is reserved
1842 1458 ; by the current internal process.
1843 1458 ; call: return:
1844 1458 ; w0 reserved
1845 1458 ; w1 cur cur
1846 1458 ; w2 buf buf
1847 1458 ; w3 link link
1848 1458
1848 1458 b.i24 ; begin
1849 1458 w.g15:am (b19) ;
1850 1460 rl w0 a52 ; mask:=reserved(proc);
1851 1462 sn w1 (b1) ; if sender = cur then
1852 1464 jl x3 ; return ok;
1853 1466 so w0 (x1+a14) ; bit:=identification(cur);
1854 1468 jl g6 ; if mask(bit)=0
1855 1470 jl x3+0 ; then goto result 2;
1856 1472 e. ; end
1857 1472
1857 1472 ; procedure check operation(oper mask, mode mask)
1858 1472 ; comment: checks whether the operation and mode are
1859 1472 ; within the repertoire of the receiver. the legal values are
1860 1472 ; defined by two bitpatterns in which bit i=1 indicates
1861 1472 ; that operation (or mode) number i is allowed. if the
1862 1472 ; operation is odd, it is checked whether the input/output
1863 1472 ; area is within the internal process.
1864 1472 ; call: return:
1865 1472 ; w0 oper mask destroyed
1866 1472 ; w1 mode mask destroyed
1867 1472 ; w2 buf buf
1868 1472 ; w3 link destroyed
1869 1472
1869 1472 b.i24 ; begin
1870 1472 w.g16:rs w3 i0 ;
1871 1474 bz w3 x2+9 ;
1872 1476 ls w1 x3+0 ;
1873 1478 bz w3 x2+8 ;
1874 1480 ls w0 x3+0 ;
1875 1482 sh w0 -1 ; if mode mask(mode(buf))=0
1876 1484 sl w1 0 ; or oper mask (operation(buf))=0
1877 1486 jl g5 ; then goto result 3;
1878 1488 so w3 1 ;
1879 1490 jl (i0) ;
1880 1492 rl w1 x2+6 ;
1881 1494 dl w0 x2+12 ; if odd(operation(buf))
1882 1496 la w3 g50 ; make first and
1883 1498 la w0 g50 ; last address in buf even;
1884 1500 sl w3 (x1+a17) ; and (first addr(buf)<first addr(sender)
1885 1502 sl w0 (x1+a18) ; or last addr(buf)>=top addr(sender)
1886 1504 jl g5 ;
1887 1506 sh w0 x3-2 ; or first addr(buf)>last addr(buf))
1888 1508 jl g5 ; then goto result 3;
1889 1510 ds w0 x2+12 ; message even;
1890 1512 jl (i0) ;
1891 1514 i0: 0 ;
1892 1516 e. ; end
1893 1516
1893 1516 ; input/output answer:
1894 1516 w.g20: 0 ; status
1895 1518 g21: 0 ; bytes
1896 1520 g22: 0 ; characters
1897 1522 g23: 0 ; file count
1898 1524 g24: 0 ; block count
1899 1526
1899 1526 g40: 0 ; word5
1900 1528 g41: 0 ; word6
1901 1530 g42: 0 ; word7
1902 1532 0 ; mess(1) operation
1903 1534 g29: 0 ; mess(2) first
1904 1536 0 ; mess(3) last
1905 1538 g30: 0 ; mess(4) segment no
1906 1540
1906 1540
1906 1540 ; procedure next operation
1907 1540 ; comment: examines the message queue of the receiver and
1908 1540 ; returns to the receiver if there is a message from a
1909 1540 ; not-stopped sender. otherwise it returns to the current
1910 1540 ; internal process.
1911 1540 ; call: return:
1912 1540 ; w0 oper
1913 1540 ; w1 proc
1914 1540 ; w2 buf
1915 1540 ; w3 link sender
1916 1540
1916 1540 b.i24 ; begin
1917 1540 w.g25:rs w3 i2 ;
1918 1542 jl w3 g64 ; examine queue(
1919 1544 jl c33 ; dummy interrupt);
1920 1546 jl (i2) ;
1921 1548 i2: 0 ;
1922 1550 e. ; end
1923 1550
1923 1550 ; procedure examine queue(queue empty)
1924 1550 ; call: return:
1925 1550 ; w0 operation
1926 1550 ; w1 proc
1927 1550 ; w2 buf
1928 1550 ; w3 link sender
1929 1550
1929 1550 b.i24 ; begin
1930 1550 w.g64:rs w3 i2 ;
1931 1552 i0: rl w1 b19 ; exam q:proc:=current receiver;
1932 1554 rl w2 x1+a54 ; buf:=next(mess q(proc));
1933 1556 sn w2 x1+a54 ; if buf=mess q(proc)
1934 1558 jl (i2) ; then goto queue empty;
1935 1560 rs w2 b18 ;
1936 1562 rl w3 x2+6 ; internal:=sender(buf);
1937 1564 xl x2+8 ;
1938 1566 sh w3 -1 ;
1939 1568 ac w3 x3+0 ;
1940 1570 bz w0 x3+a13 ;
1941 1572 rl w3 x2+6 ; if state(internal)=stopped
1942 1574 sx 2.1 ; and operation(buf)(23)=1
1943 1576 so w0 a105 ; or internal<0
1944 1578 sh w3 -1 ; then
1945 1580 jl i1 ; begin
1946 1582 bz w0 x2+8 ;
1947 1584 am (i2) ; no operation;
1948 1586 jl 2 ; goto exam q;
1949 1588 i1: jl w3 g26 ; end;
1950 1590 jl i0 ; oper:=byte(buf+8);
1951 1592 i2: 0 ;
1952 1594 e. ; end
1953 1594
1953 1594 ; procedure no operation
1954 1594 ; call: return:
1955 1594 ; w0 destroyed
1956 1594 ; w1 proc
1957 1594 ; w2 destroyed
1958 1594 ; w3 link destroyed
1959 1594
1959 1594 b.i24 ; begin
1960 1594 w.g26:al w0 1 ;
1961 1596 g27:al w1 0 ;
1962 1598 rs w1 g20 ; status:=
1963 1600 g28:rs w1 g21 ; bytes:=
1964 1602 rs w1 g22 ; character:=0;
1965 1604 jl g19 ; deliver result(1);
1966 1606 e. ; end
1967 1606
1967 1606 ; procedure increase stop count
1968 1606 ; comment: increases the stop count of the sender by 1.
1969 1606 ; call: return:
1970 1606 ; w0 unchanged
1971 1606 ; w1 unchanged
1972 1606 ; w2 buf buf
1973 1606 ; w3 link destroyed
1974 1606
1974 1606 b.i24 ; begin
1975 1606 w.g31:rs w3 i0 ;
1976 1608 am (x2+6) ;
1977 1610 bz w3 a12 ;
1978 1612 al w3 x3+1 ; stop count(sender(buf)):=
1979 1614 am (x2+6) ; stop count(sender(buf))+1;
1980 1616 hs w3 a12 ;
1981 1618 jl (i0) ;
1982 1620 i0: 0 ;
1983 1622 e. ; end
1984 1622
1984 1622 ; procedure decrease stop count
1985 1622 ; comment: the stop count of the sender is decreased by 1
1986 1622 ; if the operation is odd. if stop count becomes zero and the
1987 1622 ; sender is waiting to be stopped, the sender is stopped
1988 1622 ; and the stop count of its parent is decreased by 1.
1989 1622 ; if the parent has stopped its child, an answer is sent to
1990 1622 ; the parent in the buffer defined by the wait address of
1991 1622 ; the child.
1992 1622 ; call: return:
1993 1622 ; w0 destroyed
1994 1622 ; w1 destroyed
1995 1622 ; w2 destroyed
1996 1622 ; w3 link destroyed
1997 1622
1997 1622 b.i24 ; begin
1998 1622 w.g32:rs w3 i3 ;
1999 1624 rl w2 b18 ;
2000 1626 bz w0 x2+8 ;
2001 1628 rl w3 x2+6 ; internal:=sender(buf);
2002 1630 sz w0 1 ; if odd(operation(buf))
2003 1632 sh w3 -1 ; and internal>=0 then
2004 1634 jl (i3) ; begin
2005 1636 bz w0 x3+a12 ;
2006 1638 bs. w0 1 ; stop count(internal):=
2007 1640 hs w0 x3+a12 ; stop count(internal)-1;
2008 1642 i0: se w0 0 ; exam stop:
2009 1644 jl (i3) ; if stop count(internal)=0
2010 1646 bz w1 x3+a13 ; and state(internal)=wait stop
2011 1648 so w1 a105 ; then
2012 1650 jl (i3) ; begin
2013 1652 al w1 x1+a106 ; child state:=
2014 1654 hs w1 x3+a13 ; state(internal):=wait start;
2015 1656 rl w2 x3+a40 ; buf:=wait address(internal);
2016 1658 rl w3 x3+a34 ; internal:=parent(internal);
2017 1660 bz w0 x3+a12 ;
2018 1662 bs. w0 1 ; stop count(internal):=
2019 1664 hs w0 x3+a12 ; stop count(internal)-1;
2020 1666 se w1 a99 ; if child state<>wait start parent
2021 1668 jl i0 ; then goto exam stop;
2022 1670
2022 1670 ; let the current driver claim the buffer, so that
2023 1670 ; it may send the answer:
2024 1670 rl w1 b1 ;
2025 1672 ac w0 x1 ; receiver(buf) := -cur; (i.e. claimed)
2026 1674 rs w0 x2+4 ;
2027 1676 bz w3 x1+a19 ; decrease(bufclaim(cur));
2028 1678 al w3 x3-1 ; (even if claims would be exceeded)
2029 1680 hs w3 x1+a19 ;
2030 1682 rl w1 x1+a17 ; answer area := first addr(cur);
2031 1684 al w0 1 ; result := 1;
2032 1686 jd 1<11+22; send answer;
2033 1688 jd (i3) ; return disabled;
2034 1690 i2: 0 ;
2035 1692 i3: 0 ;
2036 1694 e. ; end
2037 1694
2037 1694 ; procedure exam sender(sender stopped)
2038 1694 ; call: return:
2039 1694 ; w0 unchanged
2040 1694 ; w1 unchanged
2041 1694 ; w2 unchanged
2042 1694 ; w3 link link
2043 1694
2043 1694 b.i24 ; begin
2044 1694 w.g34:rs w3 i0 ;
2045 1696 am (b18) ;
2046 1698 rl w3 6 ; internal:=sender(buf);
2047 1700 sh w3 -1 ;
2048 1702 jl (i0) ; if internal<0
2049 1704 bz w3 x3+a13 ;
2050 1706 sz w3 a105 ; or state(internal)=stopped
2051 1708 jl (i0) ; then goto sender stopped;
2052 1710 rl w3 i0 ;
2053 1712 jl x3+2 ;
2054 1714 i0: 0 ;
2055 1716 e. ; end
2056 1716
2056 1716 ; procedure follow chain(no. of slices,chain table index, slice)
2057 1716 ; the return value is the chain table index of entry number <no.
2058 1716 ; of slices> in the chain starting at <chain table index>
2059 1716 ; call: return:
2060 1716 ; w0 n.o.s. destroyed
2061 1716 ; w1 unchanged
2062 1716 ; w2 c.t.i. slice
2063 1716 ; w3 link destroyed
2064 1716
2064 1716 b.i8
2065 1716 w.d74:rs w3 i3 ; save return
2066 1718 ac w3 (0) ;
2067 1720 as w3 1 ; count := -2 * no. of slices
2068 1722 jl. i2. ; goto test; repeat:
2069 1724 i0: sl w3 -30 ; if count >= -30
2070 1726 jl. x3+i1. ; then goto advance(-count)
2071 1728 ba w2 x2 ;
2072 1730 r. 16 ;
2073 1760 i1: al w3 x3+32 ; count := count + 32
2074 1762 i2: sh w3 -2 ; test: if count < 0
2075 1764 jl. i0. ; then goto repeat
2076 1766 jl (i3) ; return
2077 1768 i3: 0 ;
2078 1770 e. ;
2079 1770
2079 1770 ; bitpatterns:
2080 1770
2080 1770 g48: 3 ; constant 3 (= number of chars per word)
2081 1772 g50: 8.7777 7776 ; first 23 bits
2082 1774 g51: 8.7777 0000 ; first 12 bits
2083 1776 g52: 8.0000 7777 ; last 12 bits
2084 1778 g53: 8.0000 0377 ; last 8 bits
2085 1780 g49: 1<23 ; bit 0
2086 1782 g62: 1<18 ; bit 5
2087 1784 g65: 8.3777 7777 ; last 23 bits
2088 1786 g63: 1 ; bit 23
2089 1788 \f
2089 1788
2089 1788 m.
2089 1788 monprocs - monitor procedures
2090 1788
2090 1788 b.i30 w.
2091 1788 i0=82 02 23, i1=12 00 00
2092 1788
2092 1788 ; if newtime (i0,i1) > oldtime (a133,a134) then oldtime:=newtime;
2093 1788 c.i0-a133
2094 1788 c.i0-a133-1, a133=i0, a134=i1, z.
2095 1788 c.i1-a134-1, a134=i1, z.
2096 1788 z.
2097 1788
2097 1788 i10=i0, i20=i1
2098 1788
2098 1788 i15=i10/100000 , i10=i10-i15*100000 , i25=i20/100000 , i20=i20-i25*100000
2099 1788 i14=i10/10000 , i10=i10-i14*10000 , i24=i20/10000 , i20=i20-i24*10000
2100 1788 i13=i10/1000 , i10=i10-i13*1000 , i23=i20/1000 , i20=i20-i23*1000
2101 1788 i12=i10/100 , i10=i10-i12*100 , i22=i20/100 , i20=i20-i22*100
2102 1788 i11=i10/10 , i10=i10-i11*10 , i21=i20/10 , i20=i20-i21*10
2103 1788
2103 1788 i2: <: date :>
2104 1812 (:i15+48:)<16+(:i14+48:)<8+46
2105 1814 (:i13+48:)<16+(:i12+48:)<8+46
2106 1816 (:i11+48:)<16+(:i10+48:)<8+32
2107 1818
2107 1818 (:i25+48:)<16+(:i24+48:)<8+46
2108 1820 (:i23+48:)<16+(:i22+48:)<8+46
2109 1822 (:i21+48:)<16+(:i20+48:)<8+ 0
2110 1824
2110 1824 i3: al. w0 i2. ; write date:
2111 1826 rs w0 x2+0 ; first free:=start(text);
2112 1828 al w2 0 ;
2113 1830 jl x3 ; return to slang(status ok);
2114 1832
2114 1832 jl. i3. ;
2115 1834 e.
2116 1834 j.
2116 1788 date 82.02.23 12.00.00
2117 1788 \f
2117 1788
2117 1788 ; list of monitor procedures:
2118 1788 b16: ; start:
2119 1788
2119 1788 e0 ; 0 : set interrupt
2120 1790 e1 ; 2 : reset, priv
2121 1792 e2 ; 4 : process description
2122 1794 e3 ; 6 : initialise process
2123 1796 e4 ; 8 : reserve process
2124 1798 e5 ; 10 : release process
2125 1800 e6 ; 12 : include user
2126 1802 e7 ; 14 : exclude user
2127 1804 e8 ; 16 : send message
2128 1806 e9 ; 18 : wait answer
2129 1808 e10 ; 20 : wait message
2130 1810 e11 ; 22 : send answer
2131 1812 e12 ; 24 : wait event
2132 1814 e13 ; 26 : get event
2133 1816 c99 ; 28 : (type w0, not icluded in rc8000)
2134 1818 c99 ; 30 : (type w1, not icluded in rc8000)
2135 1820 c99 ; 32 : (type w2, not icluded in rc8000)
2136 1822 c99 ; 34 : (type w3, not icluded in rc8000)
2137 1824 e18 ; 36 : get clock
2138 1826 e19 ; 38 : set clock
2139 1828 e20 ; 40 : create entry
2140 1830 e21 ; 42 : lookup entry
2141 1832 e22 ; 44 : change entry
2142 1834 e23 ; 46 : rename entry
2143 1836 e24 ; 48 : remove entry
2144 1838 e25 ; 50 : permanent entry
2145 1840 e26 ; 52 : create area process
2146 1842 e27 ; 54 : create peripheral process
2147 1844 e28 ; 56 : create internal process
2148 1846 e29 ; 58 : start internal process
2149 1848 e30 ; 60 : stop internal process
2150 1850 e31 ; 62 : modify internal process
2151 1852 e32 ; 64 : remove process
2152 1854 e33 ; 66 : test event
2153 1856 e34 ; 68 : generate name
2154 1858 e35 ; 70 : copy
2155 1860 e36 ; 72 : set catalog base
2156 1862 e37 ; 74 : set entry base
2157 1864 e38 ; 76 : lookup head and tail
2158 1866 e39 ; 78 : set backing storage claims
2159 1868 e40 ; 80 : create pseudo process
2160 1870 e41 ; 82 : regret message
2161 1872 e42 ; 84 : general copy
2162 1874 e43 ; 86 : lookup aux entry
2163 1876 e44 ; 88 : clear statistics in entry
2164 1878 e45 ; 90 : permanent entry in aux catalog
2165 1880 e46 ; 92 : create entry lock process
2166 1882 e47 ; 94 : set priority
2167 1884 e48 ; 96 : relocate process
2168 1886 e49 ; 98 : set address base
2169 1888 e50 ; 100 : start io
2170 1890 e51 ; 102 : prepare backing storage
2171 1892 e52 ; 104 : insert entry
2172 1894 e53 ; 106 : insert backing storage
2173 1896 e54 ; 108 : delete backing storage
2174 1898 e55 ; 110 : delete entries
2175 1900 e56 ; 112 : connect main catalog
2176 1902 e57 ; 114 : remove main catalog
2177 1904 e58 ; 116 :set process extensions
2178 1906 c29 ; 118 : not used
2179 1908 e60 ; 120 : create aux entry and area process
2180 1910 e61 ; 122 : remove aux entry
2181 1912 e62 ; 124 : send pseudo message
2182 1914 e63 ; 126 : set cpa
2183 1916
2183 1916 b17=k-b16 ; max monitor call number
2184 1916
2184 1916
2184 1916
2184 1916 b. i20 w.
2185 1916
2185 1916 i0: 0 ; saved w0
2186 1918 i1: 0 ; saved w1
2187 1920 i2: 0 ; saved w2
2188 1922 i3: 0 ; saved w3
2189 1924 i8: 0 ; internal
2190 1926
2190 1926
2190 1926 ; procedure deliver answer;
2191 1926 ; comment: delivers an answer from a receiver to a sender. if the sender is waiting for the
2192 1926 ; answer, it will be started. if the message is regretted (or sender removed), the
2193 1926 ; buffer is returned to the mess buf pool.
2194 1926 ; call: w2=buf, w3=link
2195 1926 ; exit: w0, w1=unchanged, w2, w3=undef
2196 1926 ; return address: link
2197 1926
2197 1926 d15: ds. w1 i1. ; save registers;
2198 1928 rs. w3 i3. ;
2199 1930
2199 1930 i9: dl w1 x2+6 ; internal:=sender(buf); (w0 := receiver(buf))
2200 1932 sh w1 -1 ; if internal<0 then
2201 1934 jl. i12. ; goto regretted;
2202 1936
2202 1936 rl w3 x1+a10 ;
2203 1938 sn w3 64 ; if kind(sender)=pseudo process then
2204 1940 rl w1 x1+a50 ; internal:=mainproc(sender);
2205 1942 sz w3 -1-64 ; if kind(sender) is neither internal nor pseudo process then
2206 1944 rl w1 x1+a250 ; internal:=driverproc(sender);
2207 1946 rs. w1 i8. ; save(internal);
2208 1948
2208 1948 bz w3 x1+a13 ; w3:=state(internal);
2209 1950 sn w3 a103 ; if state<>wait answer or
2210 1952 se w2 (x1+a30) ; save w2(internal)<>buf then
2211 1954 jl. i13. ; goto event;
2212 1956
2212 1956 rs w0 x1+a28 ; save w0(internal) := result := receiver(buf);
2213 1958 jl w3 d109 ; increase buf claim, remove release buf(internal, buf);
2214 1960
2214 1960 rl. w3 i8. ; restore(internal);
2215 1962 al w1 x2+8 ; from:=buf+8;
2216 1964 rl w2 x3+a29 ; answer:=save w1(internal);
2217 1966 wa w2 x3+a182 ; get physical address of answer area
2218 1968 jl w3 d14 ; move mess(from, answer);
2219 1970 i10: rl. w1 i8. ;
2220 1972 jl w3 d10 ; link internal(internal);
2221 1974 i11: dl. w1 i1. ; exit: restore(w0, w1);
2222 1976 jl. (i3.) ; return;
2223 1978
2223 1978 i12: al. w3 i11. ; regretted: remove release buf;
2224 1980 jl d106 ; goto exit;
2225 1982
2225 1982 i13: jl w3 d5 ; event:
2226 1984 al w1 x1+a15 ; remove(buf);
2227 1986 jl w3 d6 ; link(event q(internal), buf);
2228 1988 bz w0 x1-a15+a13;
2229 1990 se w0 a104 ; if state<>wait event then
2230 1992 jl. i11. ; goto exit;
2231 1994 al w0 1 ; result:=1; (i.e. answer);
2232 1996 rs w0 x1-a15+a28; save w0(internal) := result;
2233 1998 rs w2 x1-a15+a30; save w2(internal):=buf;
2234 2000 jl. i10. ; goto set result;
2235 2002
2235 2002 ; procedure deliver message;
2236 2002 ; comment: delivers the message to an internal process, and starts it if it is waiting for a message;
2237 2002 ; call: w2=buf, w3=link
2238 2002 ; exit: w0, w1=unchanged, w2, w3=undef
2239 2002 ; return address: link
2240 2002
2240 2002 d16: ds. w1 i1. ; save registers;
2241 2004 ds. w3 i3. ;
2242 2006 rl w1 x2+4 ; internal:=receiver(buf);
2243 2008 rl w0 x1+a10 ;
2244 2010 sn w0 64 ; if kind(internal)=pseudo process then
2245 2012 rl w1 x1+a50 ; internal:=mainproc(internal);
2246 2014 sz w0 -1-64 ; if kind(internal) is neither internal process nor pseudo process then
2247 2016 rl w1 x1+a250 ; internal:=driverproc(internal);
2248 2018 sn w1 0 ; if internal not defined then
2249 2020 jl. i16. ; goto unknown;
2250 2022 rs. w1 i8. ; save(internal);
2251 2024
2251 2024 bz w0 x1+a13 ; w0:=state(internal);
2252 2026 se w0 a102 ; if state<>wait message then
2253 2028 jl. i15. ; goto event;
2254 2030
2254 2030 rl w2 x2+6 ;
2255 2032 rs w2 x1+a28 ; save w0(internal):=sender(buf);
2256 2034 rl w3 x1+a31 ; name:=save w3(internal);
2257 2036 wa w3 x1+a182 ; get phys. addr.
2258 2038 dl w1 x2+a11+2 ; move 4 words process name;
2259 2040 ds w1 x3+2 ;
2260 2042 dl w1 x2+a11+6 ;
2261 2044 ds w1 x3+6 ;
2262 2046
2262 2046 rl. w1 i8. ;
2263 2048 rl w2 x1+a29 ; mess := save w1(internal);
2264 2050 wa w2 x1+a182 ; get phys. addr.
2265 2052 rl. w1 i2. ; restore(buf);
2266 2054 al w1 x1+8 ;
2267 2056 jl w3 d14 ; move mess(buf+8, mess);
2268 2058
2268 2058 i14: rl. w1 i8. ; start driver:
2269 2060 jl w3 d10 ; link internal(internal);
2270 2062 rl. w1 i8. ;
2271 2064 rl. w2 i2. ;
2272 2066 jl w3 d108 ; claim buffer (internal, buf); notice: error exit if exceeded
2273 2068 rs w2 x1+a30 ; save w2(internal) := buf;
2274 2070 dl. w1 i1. ; restore(w0, w1);
2275 2072 jl. (i3.) ; return;
2276 2074
2276 2074 i15: al w1 x1+a15 ; event:
2277 2076 jl w3 d6 ; link(event q(internal), buf);
2278 2078 se w0 a104 ; if state<>wait event then
2279 2080 jl. i11. ; goto exit;
2280 2082 al w0 0 ; result:=0; (i.e. message);
2281 2084 rs w0 x1-a15+a28; save w0(internal) := result;
2282 2086 jl. i14. ; goto start driver;
2283 2088
2283 2088 i16: al w0 5 ; unknown:
2284 2090 rs w0 x2+4 ; receiver(buf) := 5; i.e. result := 5;
2285 2092 jl. i9. ; goto deliver answer;
2286 2094
2286 2094 ; procedure deliver general event
2287 2094 ;
2288 2094 ; comment: when a process issues one of the following monitor calls:
2289 2094 ; a. initialize process (switch = 0)
2290 2094 ; b. reserve process (switch = 2)
2291 2094 ; c. release process (switch = 4)
2292 2094 ; concerning an external process, this procedure is called.
2293 2094 ; the sender is stopped, and the process description is linked to the eventqueue
2294 2094 ; of the driver process.
2295 2094 ;
2296 2094 ; the driver process must call ...wait event... in order to get the request.
2297 2094 ; as soon as the driver process reaches a process description in the eventqueue,
2298 2094 ; the process description will be removed from the eventqueue, and a message buffer
2299 2094 ; (taken from the driver process) will be initialized with:
2300 2094 ;
2301 2094 ; links = out of queue
2302 2094 ; receiver = - external process descr. addr. (odd)
2303 2094 ; sender = senders - - -
2304 2094 ; operation= switch
2305 2094 ;
2306 2094 ; this message buffer is given to the driver process.
2307 2094 ;
2308 2094 ; the driver process should now pay attention to the request and (sooner or later)
2309 2094 ; answer the sender (and thereby restart it) by calling the monitor procedure
2310 2094 ; ...send answer..., and return to another call of wait event.
2311 2094 ;
2312 2094 ; ---
2313 2094 ;
2314 2094 ; this is the normal way it should work, but there are - of course - some exceptions
2315 2094 ; to the rule. the sender may be stopped and started - or even worse: it may have
2316 2094 ; its instruction counter modified (i.e. parent break) before it is started.
2317 2094 ;
2318 2094 ; the special cases are:
2319 2094 ; a. the sender is stopped while the process description is still in the event-
2320 2094 ; queue of the driver process (i.e. not remarked by the driver).
2321 2094 ; b. the sender is stopped after the driver process has started processing the
2322 2094 ; request, but before the driver has answered the sender.
2323 2094 ; c. the sender is answered after case b.
2324 2094 ; d. the sender is started by its parent, after case b.
2325 2094 ; e. the sender is modified (or removed) by its parent, after case b.
2326 2094 ;
2327 2094 ; ad a. the instruction counter of the sender may be decreased by 2 (i.e. the call
2328 2094 ; will be repeated later) because the driver has not started processing of
2329 2094 ; the request yet.
2330 2094 ; ad b. the driver process has started processing of the request, i.e. the call may not
2331 2094 ; be repeated as in case a.
2332 2094 ; the sender must be left in a special state, so that a following ...start
2333 2094 ; internal... , ...modify internal... or ...remove internal... will take
2334 2094 ; special actions.
2335 2094 ; ad c. the driver process has now terminated the request, but the sender is stopped by
2336 2094 ; its parent.
2337 2094 ; the state of the sender should just be changed to the usual ...waiting for start... .
2338 2094 ; ad d. the sender may not be started yet, because the driver process has not termi-
2339 2094 ; nated the request-handling. just leave the sender-state as it was before it
2340 2094 ; was stopped (i.e. as before case b.).
2341 2094 ; ad e. the parent of the sender must have rights to force the sender to proceed.
2342 2094 ; since the driver process still presumes that the sender is stopped, the
2343 2094 ; change is signalled by regretting the message buffer that contains informa-
2344 2094 ; tion of the old request.
2345 2094 ; (i.e. the driver process need not be aware of the state of the sender,
2346 2094 ; because the call ...send answer... is completely blind, if the buffer is
2347 2094 ; regretted).
2348 2094 ;
2349 2094 ;
2350 2094 ; call: w0 = switch, w1 = sender, w2 = proc
2351 2094 ; exit address: c99 (interrupt return)
2352 2094
2352 2094 d100:ls w0 -1 ; wait address(sender) :=
2353 2096 wa w0 4 ; switch shift (-1)
2354 2098 wa w0 4 ; + 2 * proc;
2355 2100 rs w0 x1+a40 ; (only nescessary in case driver is busy)
2356 2102 rl w3 x2+a10 ; driver := proc;
2357 2104 sn w3 64 ; if receiver is pseudo process then
2358 2106 rl w2 x2+a50 ; driver := main proc(receiver);
2359 2108 sz w3 -1-64 ; if receiver is neither internal nor pseudo process then
2360 2110 rl w2 x2+a250 ; driver := driver process(receiver);
2361 2112 ; evt teste at w2 eksisterer
2362 2112 ds. w2 i2. ; save(sender, driver);
2363 2114 al w0 a101 ;
2364 2116 jl w3 d9 ; remove internal(sender, waiting for procfunc);
2365 2118
2365 2118 rl. w1 i2. ; w1 := driver;
2366 2120 rl. w2 i1. ; w2 := timequeuelink(sender);
2367 2122 al w2 x2+a16 ;
2368 2124
2368 2124 bz w0 x1+a13 ;
2369 2126 sn w0 a104 ; if state(driver) <> waiting for event then
2370 2128 jl. i17. ; begin
2371 2130
2371 2130 al w1 x1+a15 ; link(eventq(driver), sender descr);
2372 2132 al w3 c99 ; goto interrupt return;
2373 2134 jl d6 ; end;
2374 2136 d120: ; take general event:
2375 2136 i17: rs. w1 i8. ; save (driver);
2376 2138 bz w3 x1+a19 ; if bufclaim(driver) = 0 then
2377 2140 sn w3 0 ;
2378 2142 jl. i14. ; goto start driver;
2379 2144
2379 2144 al w3 x3-1 ; decrease(bufclaim(driver));
2380 2146 hs w3 x1+a19 ;
2381 2148
2381 2148 bz w3 x2-a16+a19; decrease(bufclaim(sender));
2382 2150 al w3 x3-1 ; (it is just to facilitate regretting etc,
2383 2152 hs w3 x2-a16+a19; so don't care for claims exceeded)
2384 2154
2384 2154 al w0 1 ; make save ic (sender) odd;
2385 2156 lo w0 x2-a16+a33; i.e. signal that the request
2386 2158 rs w0 x2-a16+a33; is being processed;
2387 2160
2387 2160 al w0 2.11 ; unpack switch:
2388 2162 la w0 x2-a16+a40; switch := wait addr(sender) extract 2 shift 1;
2389 2164 ls w0 1 ;
2390 2166
2390 2166 al w3 x2-a16 ; w3 := sender;
2391 2168
2391 2168 rl w2 b8 ; buf := next(mess buf pool);
2392 2170 rs w0 x2+8 ; operation(buf) := switch;
2393 2172 al w0 4 ;
2394 2174 rs w0 x1+a28 ; save w0(driver) := 4; i.e. result = imm. message
2395 2176
2395 2176 ; unpack proc:
2396 2176 al w0 -1<2 ; proc := wait addr(sender) shift (-2) shift 1;
2397 2178 la w0 x3+a40 ;
2398 2180 ls w0 -1 ;
2399 2182
2399 2182 rx w3 0 ; sender(buf) := sender;
2400 2184 ac w3 x3+1 ; receiver(buf) := -proc-1; (i.e. odd, claimed)
2401 2186 ds w0 x2+6 ; (odd == immediate message)
2402 2188
2402 2188 jl w3 d5 ; remove(buf);
2403 2190 rs w2 x1+a30 ; save w2(driver) := buf;
2404 2192 al w3 c99 ; link internal(driver);
2405 2194 jl d10 ; goto interrupt return;
2406 2196 e.
2407 2196 c.(:a90>0 a.1:)-1
2408 2196
2408 2196 ; coredump.
2409 2196 ; only used in connection with power up. the dump is executed
2410 2196 ; using the fpa with io device number 2.
2411 2196 ; call: return:
2412 2196 ; w0 destroyed
2413 2196 ; w1 destroyed
2414 2196 ; w2 destroyed
2415 2196 ; w3 link destroyed
2416 2196
2416 2196 b. c10, d40, i50, r20 w.
2417 2196
2417 2196 d140: rs. w3 d32. ; coredump:
2418 2196
2418 2196 ; start of coredump:
2419 2196 ; change eventually contents of devicebase, unless already done.
2420 2196
2420 2196 i0: al. w0 d11. ; device base := local base;
2421 2196 rx w0 b65 ;
2422 2196 se w0 (b65) ; if device base <> old base then
2423 2196 rx. w0 d30. ; save(old device base);
2424 2196 sn w0 0 ; if saved old device base = 0 then
2425 2196 jl. i40. ; goto end coredump;
2426 2196
2426 2196 ; restart coredump:
2427 2196 ; the coredump starts from coreaddress zero
2428 2196
2428 2196 i10: al w1 -512 ; coreaddr := -512;
2429 2196 rs. w1 d21. ;
2430 2196
2430 2196 ; next coreblock:
2431 2196
2431 2196 i11: rl. w1 d21. ; addr := coreaddr + 512;
2432 2196 al w1 x1+512 ;
2433 2196 di w0 x1+8 ; if addr = top core then
2434 2196 sx 2.111 ;
2435 2196 al w1 -1 ; endblock := true
2436 2196 se w1 -1 ; else
2437 2196 rs. w1 d21. ; coreaddr := addr;
2438 2196 rs. w1 d22. ;
2439 2196
2439 2196 al w0 0 ; retries := 0;
2440 2196 rs. w0 d31. ;
2441 2196
2441 2196 ; send coreblock:
2442 2196 ; initialize transfer-variables
2443 2196 ; start the device and wait for interrupt
2444 2196
2444 2196 i15: al w0 0 ;
2445 2196 rs. w0 d13. ; interrupt := false;
2446 2196 rs. w0 d23. ; received command := illegal;
2447 2196 do. w0 (d10.) ; start device(irrell register);
2448 2196 rl. w1 d0. ; (get loopcount)
2449 2196 i16: ;
2450 2196 se. w0 (d13.) ; wait until interrupt
2451 2196 jl. i30. ; or timeout;
2452 2196 al w1 x1-1 ;
2453 2196 se w1 0 ; if interrupt then
2454 2196 jl. i16. ; goto after interrupt;
2455 2196
2455 2196 ; the transfer did not terminate within a certain time:
2456 2196 ; reset the device, and wait some time
2457 2196
2457 2196 i17: am. (d10.) ;
2458 2196 do w0 +2 ; reset device(irrell register);
2459 2196 ; sx 2.010 ; if disconnected then
2460 2196 ; jl. i40. ; goto end coredump;
2461 2196 rl. w1 d1. ; (get loop count)
2462 2196 i18: ;
2463 2196 al w1 x1-1 ; wait some time;
2464 2196 se w1 0 ;
2465 2196 jl. i18. ;
2466 2196
2466 2196 ; prepare repeat of transfer:
2467 2196 ; increase retries
2468 2196 ; if too many then halt
2469 2196 ; goto send coreblock
2470 2196
2470 2196 i20: rl. w1 d31. ;
2471 2196 al w1 x1+1 ; increase(retries);
2472 2196 rs. w1 d31. ;
2473 2196 sh w1 100 ; if retries < max then
2474 2196 jl. i15. ; goto send coreblock;
2475 2196
2475 2196 jl -1 ; halt;
2476 2196
2476 2196 ; definition of dumpdevice:
2477 2196
2477 2196 r20 = 3 ; 3=fpa transmitter
2478 2196
2478 2196 ; definition of coredump startchar and commandchars:
2479 2196
2479 2196 r10 = 253 ; coredump block
2480 2196
2480 2196 r0 = 128 ; send next block
2481 2196 r1 = 2 ; start coredump
2482 2196 r2 = 12 ; end coredump (= reject from ncp)
2483 2196 r3 = 1 ; retransmit
2484 2196
2484 2196 ; timercounts:
2485 2196
2485 2196 d0: 100000 ; loopcount for transfer
2486 2196 d1: 100000 ; loopcount for reset
2487 2196
2487 2196 ; device address:
2488 2196
2488 2196 d10: 1<23 + r20 < 3 ;
2489 2196
2489 2196 ; device descriptor:
2490 2196
2490 2196 d11 = k - r20 < 3 ; device base for coredump
2491 2196
2491 2196 c0 ; channel program start
2492 2196 d12 ; standard status
2493 2196 d13 ; interrupt address
2494 2196 -1 ; interrupt data
2495 2196
2495 2196 ; status area:
2496 2196
2496 2196 d12 = 0 ; (not used)
2497 2196
2497 2196 ; interrupt word:
2498 2196
2498 2196 d13: 0 ; 0==false, else true
2499 2196
2499 2196 ; coredump channel program:
2500 2196
2500 2196 c0: 0<8 , 0 , 12 ; clear core(0:7)
2501 2196 d20: r10<16+3<8+1<7, d20, 1 ; send startchar (from left char in the command)
2502 2196 d21 = k+2, 3<8+1<7, 0 , 768 ; send coreblock
2503 2196 3<8 , d22, 2 ; send coreaddr (two leftmost chars)
2504 2196 1<8 , d23, 1 ; receive command char
2505 2196 15<8 ; stop
2506 2196
2506 2196 ; coreaddress: -1==endblock, else blockaddress
2507 2196
2507 2196 d22: 0 ;
2508 2196
2508 2196 ; command character
2509 2196
2509 2196 d23: 0 ; (received in leftmost char)
2510 2196
2510 2196 ; miscellaneous:
2511 2196
2511 2196 d30: 0 ; saved device base
2512 2196 d31: 0 ; retries
2513 2196 d32: 0 ; saved link
2514 2196
2514 2196 ; after interrupt:
2515 2196 ; don't care if the output was not actually made.
2516 2196 ; switch out, depending on received command-character.
2517 2196
2517 2196 i30: rl. w0 d23. ;
2518 2196 ls w0 -16 ; w0 := received command, rigth justified;
2519 2196
2519 2196 sn w0 r0 ; if command = next then
2520 2196 jl. i11. ; goto next coreblock;
2521 2196 sn w0 r1 ; if command = start coredump then
2522 2196 jl. i10. ; goto restart;
2523 2196 sn w0 r2 ; if command = end then
2524 2196 jl. i40. ; goto end coredump;
2525 2196 sn w0 r3 ; if command = retransmit then
2526 2196 jl. i15. ; goto send coreblock;
2527 2196
2527 2196 jl. i20. ; goto prepare repeat;
2528 2196
2528 2196 ; end of coredump:
2529 2196 ; restore device base:
2530 2196
2530 2196 i40: rl. w0 d30. ;
2531 2196 rs w0 b65 ; device base := old device base;
2532 2196 jl. (d32.) ; exit: return;
2533 2196 e.
2534 2196 z.
2535 2196 \f
2535 2196
2535 2196
2535 2196 ; procedure set interrupt(address, mask);
2536 2196 ; call: return:
2537 2196 ; save w0 mask unchanged
2538 2196 ; save w1 unchanged
2539 2196 ; save w2 unchanged
2540 2196 ; save w3 address unchanged
2541 2196
2541 2196 b. i2 w.
2542 2196 e0: rl w2 x1+a31 ; address:=save w3 (cur);
2543 2198
2543 2198 al w0 x2+a180 ; (w0 = top of regdump)
2544 2200 se w2 0 ; if address <> 0 then
2545 2202 jl w3 d112 ; check within(address, top regdump);
2546 2204
2546 2204 rl w3 x1+a27 ;
2547 2206 sn w3 (x1+a170) ; if old intaddr = old escape address then
2548 2208 rs w2 x1+a170 ; escape address := address;
2549 2210
2549 2210 rl w0 x1+a176 ;
2550 2212 se w0 0 ; if monitor function <> set interrupt address then
2551 2214 am a170-a27; escape address := address
2552 2216 rs w2 x1+a27 ; else intaddr := address;
2553 2218
2553 2218 se w0 0 ;
2554 2220 am 4 ;
2555 2222 dl. w3 i1. ;
2556 2224 la w2 x1+a28 ; mask := save w0(cur) extract relevant bits;
2557 2226 la w3 x1+a32 ; status := status(cur) remove the corresponding bits;
2558 2228 sn w0 0 ;
2559 2230 ls w2 -3 ; (if set intaddr then oldfashioned rc4000 style)
2560 2232 lo w2 6 ; status(cur) := status 'or' mask;
2561 2234 rs w2 x1+a32 ;
2562 2236 gg w3 b91 ; move: user exception address(cur)
2563 2238 dl w1 x1+a170 ; user escape address(cur)
2564 2240 ds w1 x3+a325+a328; to: previous interrupt stack element;
2565 2242 jl c99 ; goto interrupt return;
2566 2244
2566 2244 8.3000 0000 ; i1-2: extract aritmetic bits (nb: oldfashioned rc4000-way)
2567 2246 i1: 8.7477 7777 ; : remove - -
2568 2248 8.2477 0000 ; i1+2: extract escape bits
2569 2250 8.5300 7777 ; i1+4: remove - -
2570 2252
2570 2252 e.
2571 2252
2571 2252 ; procedure process description(name, result);
2572 2252 ; call: return:
2573 2252 ; save w0 result (=0, proc descr addr)
2574 2252 ; save w1
2575 2252 ; save w2
2576 2252 ; save w3 name
2577 2252
2577 2252 b. i0 w.
2578 2252 e2: jl w3 d101 ; check and search name
2579 2254 al. w3 i0. ;+2 not found: w3:=zero address
2580 2256 rl w0 x3 ; result := proc descr;
2581 2258 jl r28 ; goto return prepared result;
2582 2260 i0: 0 ;
2583 2262 e.
2584 2262
2584 2262 ; procedure initialize process(name, result);
2585 2262 ; - reserve - ( - , - );
2586 2262 ; call: return:
2587 2262 ; save w0 result (=0, 1, 2, 3)
2588 2262 ; save w1 unchanged
2589 2262 ; save w2 unchanged
2590 2262 ; save w3 name unchanged
2591 2262
2591 2262 e3: am 0-2 ; initialize:
2592 2264 e4: al w0 2 ; reserve: prepare result, in case of internal proc;
2593 2266 jl w3 d101 ; check and search name;
2594 2268 jl r3 ;+2 not found: goto result 3;
2595 2270 rl w2 x3 ;+4 proc:=name table(entry)
2596 2272 rl w3 x2+a10 ; if kind(proc) neither internal process
2597 2274 sz w3 -1-64 ; nor pseudo process then
2598 2276 jl. d100. ; deliver general event (w0=switch, w1=cur, w2=proc)
2599 2278 ; and goto interrupt return;
2600 2278 jl r28 ; goto return prepared result;
2601 2280
2601 2280 ; procedure release process (name);
2602 2280 ; call: return:
2603 2280 ; save w0 unchanged
2604 2280 ; save w1 unchanged
2605 2280 ; save w2 unchanged
2606 2280 ; save w3 name unchanged
2607 2280
2607 2280 e5: jl w3 d101 ; check and search name;
2608 2282 jl c99 ;+2 not found: goto interrupt return;
2609 2284 rl w2 x3 ;+4 proc:=name table(entry);
2610 2286 al w0 4 ; switch:=4;
2611 2288 rl w3 x2+a10 ; if kind(proc) neither internal process
2612 2290 sz w3 -1-64 ; nor pseudo process then
2613 2292 jl. d100. ; deliver generel event (w0=switch, w1=cur, w2=proc)
2614 2294 ; and goto interrupt return;
2615 2294 jl c99 ; goto interrupt return;
2616 2296
2616 2296 ; procedure include user(name, device, result);
2617 2296 ; - exclude - ( - , - , - );
2618 2296 ; call: return:
2619 2296 ; save w0 result (=0, 2, 3, 4)
2620 2296 ; save w1 device unchanged
2621 2296 ; save w2 unchanged
2622 2296 ; save w3 name unchanged
2623 2296
2623 2296 b. i0 w.
2624 2296 e6: am d126-d123; include: switch := insert user;
2625 2298 e7: al w0 d123 ; exclude: switch := remove user;
2626 2300 rs. w0 i0. ; save(switch);
2627 2302 jl w3 d101 ; check and search name;
2628 2304 jl r3 ;+2 not found: goto result3;
2629 2306 rl w2 x3 ;+4 child:=name table(entry);
2630 2308 rs w2 x1+a28 ; save w0(cur) := child;
2631 2310 rl w3 x2+a10 ; w3:=kind(child);
2632 2312 sn w3 0 ; if kind<>0 or
2633 2314 se w1 (x2+a34) ; cur<>parent(child) then
2634 2316 jl r3 ; goto result 3;
2635 2318 rl w3 x1+a29 ; device:=save w1(cur);
2636 2320 ls w3 1 ;
2637 2322 wa w3 b4 ; entry:=2*device+first device;
2638 2324 sl w3 (b4) ; if entry<first device or
2639 2326 sl w3 (b5) ; entry>=first area then
2640 2328 jl r4 ; goto result 4;
2641 2330 rl w2 x3 ; proc:=name table(entry);
2642 2332 jl w3 d102 ; check user(cur, proc);
2643 2334 jl r2 ;+2 not user: goto result 2;
2644 2336
2644 2336 rl w1 x1+a28 ; restore(child);
2645 2338 jl. w3 (i0.) ; insert/remove user(child, proc);
2646 2340 rl w1 b1 ; restore(cur);
2647 2342 jl r0 ; goto result 0;
2648 2344 i0: 0 ; saved switch
2649 2346 e.
2650 2346
2650 2346 ; procedure send pseudo message(pseudo proc, name, mess, buf);
2651 2346 ; call return
2652 2346 ; save w0 pseudo proc descr unch.
2653 2346 ; save w1 mess unch.
2654 2346 ; save w2 mess flag unch.
2655 2346 ; save w3 name unch.
2656 2346
2656 2346
2656 2346 ; procedure send message(name, mess, buf);
2657 2346 ; call: return:
2658 2346 ; save w0 unchanged
2659 2346 ; save w1 mess unchanged
2660 2346 ; save w2 mess flag unchanged
2661 2346 ; save w3 name unchanged
2662 2346 b. i10 w.
2663 2346 ; send pseudo message:
2664 2346 e62: rl w3 x1+a28 ; proc:= savew0(cur);
2665 2348 sh w3 0 ; if savew0 <= 0
2666 2350 jl c29 ; then goto internal 3;
2667 2352 rl w2 x3+a10 ;
2668 2354 se w2 64 ; if kind(proc) <> pseudo kind
2669 2356 jl c29 ; then goto internal 3;
2670 2358 rl w2 x3+a50 ;
2671 2360 se w2 (b1) ; if main(proc) <> cur
2672 2362 jl c29 ; then goto internal 3;
2673 2364 am -1 ; function:= send pseudo message;
2674 2366 ; send message:
2675 2366 e8: al w0 0 ; function:= send message;
2676 2368 rs. w0 i7. ; save function;
2677 2370 rl w3 x1+a31 ; if savew3(cur) <= last of name table then
2678 2372 sh w3 (b7) ;
2679 2374 jl. i3. ; goto driver message;
2680 2376 i6: jl w3 d110 ; check mess area and name area(name);
2681 2378 wa w2 x1+a182 ; get phys. addr.
2682 2380 rl w3 x2+8 ; entry:=word(name+8);
2683 2382 sl w3 (b3) ; if entry<name table start or
2684 2384 sl w3 (b7) ; entry>=name table end then
2685 2386 jl. i1. ; goto search;
2686 2388 rl w3 x3 ; proc:=name table(entry);
2687 2390 dl w1 x2+2 ;
2688 2392 sn w0 (x3+a11) ; if name in call<>name in monitor then
2689 2394 se w1 (x3+a11+2) ;
2690 2396 jl. i1. ; goto search;
2691 2398 sn w0 0 ; if name(0)=0 then
2692 2400 jl. i2. ; goto unknown;
2693 2402 dl w1 x2+6 ;
2694 2404 sn w0 (x3+a11+4) ;
2695 2406 se w1 (x3+a11+6) ;
2696 2408 jl. i1. ;
2697 2410
2697 2410 ; the receiver is found. now check bufclaim and deliver the message
2698 2410 ; w3=proc
2699 2410 i0: rl. w0 i7. ; if function = send pseudo message then
2700 2412 sn w0 0 ; begin
2701 2414 jl. i10. ;
2702 2416 rl w0 x3+a10 ; if kind(receiver) <> internal
2703 2418 se w0 0 ; then goto internal 3;
2704 2420 jl c29 ; end;
2705 2422 i10: rl w1 b1 ;
2706 2424 bz w0 x1+a19 ; if buf claim(cur)=0 then
2707 2426 sn w0 0 ; goto decrease buffer claim;
2708 2428 jl d108 ; (which exits with save w2=0);
2709 2430 bs. w0 1 ; decrease (bufclaim(cur));
2710 2432 hs w0 x1+a19 ;
2711 2434 rl w2 b8 ; buf:=next(mess pool);
2712 2436 rs w3 x2+4 ; receiver(buf):=proc;
2713 2438 rl. w3 i7. ;
2714 2440 se w3 0 ; if function = send pseudo message
2715 2442 jl. i8. ; then sender(buf):= pseudo proc
2716 2444 rs w1 x2+6 ; else sender(buf):= cur;
2717 2446 jl. i9. ;
2718 2448 i8: rl w3 x1+a28 ;
2719 2450 rs w3 x2+6 ;
2720 2452 i9:
2721 2452 rl w3 x1+a30 ;
2722 2454 rs w3 x2+a139 ; mess flag(buf):=saved w2;
2723 2456 rs w2 x1+a30 ; save w2(cur):=buf;
2724 2458 rl w3 x1+a29 ; mess:=save w1(cur);
2725 2460 wa w3 x1+a182 ; get phys. addr.
2726 2462 dl w1 x3+2 ;
2727 2464 ds w1 x2+10 ; move 8 words from mess to buf;
2728 2466 dl w1 x3+6 ;
2729 2468 ds w1 x2+14 ;
2730 2470 dl w1 x3+10 ;
2731 2472 ds w1 x2+18 ;
2732 2474 dl w1 x3+14 ;
2733 2476 i4: ds w1 x2+22 ; move last:
2734 2478 jl w3 d5 ; remove(buf);
2735 2480 al w3 c99 ; deliver message(buf);
2736 2482 jl. d16. ; goto interrupt return;
2737 2484
2737 2484 ; the name table address was illegal or not correct:
2738 2484
2738 2484 i1: rl w1 b1 ; w1:= cur
2739 2486 ws w2 x1+a182 ; logical address
2740 2488 jl w3 d11 ; search name(name.entry)
2741 2490 jl. i2. ; not found: goto unknown
2742 2492 wa w2 x1+a182 ; physical buffer address
2743 2494 rs w3 x2+8 ; word(name+8):=entry;
2744 2496 rl w3 x3 ; proc:=name table(entry);
2745 2498 jl. i0. ; goto found;
2746 2500
2746 2500 i2: rl w1 b1 ; unknown:
2747 2502 rl w2 b8 ; buf:=next(mess pool);
2748 2504 rl w3 x1+a30 ;
2749 2506 rs w3 x2+a139 ; mess.flag=saved w2
2750 2508 jl w3 d108 ; claim buffer(cur, buf);
2751 2510 rs w2 x1+a30 ; save w2(cur) := buf;
2752 2512 al w0 5 ; receiver(buf):=result:=5;
2753 2514 rl. w3 i7. ; if function = send pseudo message
2754 2516 se w3 0 ; then sender(buf):= pseudo proc
2755 2518 rl w1 x1+a28 ; else sender(buf):= cur;
2756 2520 ds w1 x2+6 ; sender(buf):=cur;
2757 2522 al w3 c99 ; deliver answer(buf);
2758 2524 jl. d15. ; goto interrupt return;
2759 2526
2759 2526 i3: sl w3 (b5) ; driver message:
2760 2528 sl w3 (b7) ; if save w3(cur) outside nametable then
2761 2530 jl. i6. ; continue normal;;
2762 2532 ; test that save w1(cur) is an external proc description
2763 2532 rl w2 b4 ;
2764 2534 rl w3 x1+a29 ; for w2 := first device in name table
2765 2536 i5: sl w2 (b5) ; step 2 until top device do
2766 2538 jl c29 ;
2767 2540 al w2 x2+2 ; if save w1(cur) = entry(w2) then
2768 2542 se w3 (x2-2) ; goto found;
2769 2544 jl. i5. ; not found: goto internal 3;
2770 2546 rl w0 x3+a10 ; found:
2771 2548 sz w0 -1-64 ; if kind(proc) = internal process or pseudo process
2772 2550 se w1 (x3+a250) ; or cur <> driverproc(proc) then
2773 2552 jl c29 ; goto internal 3;
2774 2554 rl w2 b8 ; buf := next (mess buf pool);
2775 2556 jl w3 d108 ; claim buffer(buf);
2776 2558 rl w3 (x1+a31) ; receiver(buf) := name table(save w3(cur));
2777 2560 rl w0 x1+a29 ; sender(buf) := proc; i.e. save w1(cur);
2778 2562 ds w0 x2+6 ;
2779 2564 ld w1 -65 ;
2780 2566 ds w1 x2+10 ; clear rest of message;
2781 2568 ds w1 x2+14 ;
2782 2570 ds w1 x2+18 ;
2783 2572 rs w1 x2-2 ; set message flag :=0
2784 2574 jl. i4. ; goto move last;
2785 2576 i7: 0 ; save function;
2786 2578 e.
2787 2578
2787 2578 ; procedure wait answer(buf, answer, result);
2788 2578 ; call: return:
2789 2578 ; save w0 result (=1, 2, 3, 4, 5)
2790 2578 ; save w1 answer unchanged
2791 2578 ; save w2 b uf unchanged
2792 2578 ; save w3 unchanged
2793 2578 b. i5 w.
2794 2578
2794 2578 e9: jl w3 d103 ; check message area and buf;
2795 2580 rl w3 x2+6 ; proc:= sender(buf);
2796 2582 rl w0 x3+a10 ; if kind(proc) = pseudo kind then
2797 2584 se w0 64 ; begin
2798 2586 jl. i0. ; if main(proc) <> cur
2799 2588 rl w0 x3+a50 ; then goto internal 3
2800 2590 se w0 (b1) ; else goto ok;
2801 2592 jl c29 ; end
2802 2594 jl. i1. ; else
2803 2596 i0: se w1 (x2+6) ; if proc <> cur
2804 2598 jl c29 ; then goto internal 3;
2805 2600 i1: ; ok:
2806 2600 rl w0 x2+4 ; w0:=receiver(buf);
2807 2602 sz w0 -8 ; if answer not send then
2808 2604 jl d104 ; goto remove wait answer;
2809 2606 rs w0 x1+a28 ; save w0(cur):=result;
2810 2608 jl w3 d109 ; increase claim, remove release buf(cur, buf);
2811 2610 rl w3 b1 ; w3:=cur;
2812 2612 al w1 x2+8 ;
2813 2614 rl w2 x3+a29 ; move mess(buf+8, answer);
2814 2616 wa w2 x3+a182 ; get physical address of answer area
2815 2618 al w3 c99 ;
2816 2620 jl d14 ; goto interrupt return;
2817 2622 e.
2818 2622
2818 2622 ; procedure wait message(name, mess, buf, result);
2819 2622 ; call: return:
2820 2622 ; save w0 result (=sender descr addr)
2821 2622 ; save w1 mess unchanged
2822 2622 ; save w2 buf
2823 2622 ; save w3 name unchanged
2824 2622
2824 2622 b. i8 w.
2825 2622
2825 2622 e10: jl w3 d110 ; check mess area and name area;
2826 2624 al w3 -8 ;
2827 2626 al w2 x1+a15 ; buf:=event q(cur);
2828 2628 i2: rl w2 x2+0 ; next: buf:=next(buf);
2829 2630 sn w2 x1+a15 ; if buf=event q(cur) then
2830 2632 jl d105 ; goto remove wait message;
2831 2634 sz w3 (x2+4) ; if answer then
2832 2636 jl. i3. ;
2833 2638 jl. i2. ; goto next;
2834 2640 i3: sl w2 (b8+4) ; if buf not message buffer then
2835 2642 sl w2 (b8+6) ;
2836 2644 jl. i2. ; goto next; (i.e. some kind of general event);
2837 2646 sh w3 (x2+4) ; if message buffer not claimed then
2838 2648 jl w3 d108 ; claim buffer(cur,buf);
2839 2650 jl w3 d5 ; remove(buf);
2840 2652 rl w3 x2+6 ;
2841 2654 rs w3 x1+a28 ; save w0(cur):=sender(buf);
2842 2656 rs w2 x1+a30 ; save w2(cur):=buf;
2843 2658 sh w3 0 ; if sender(buf)<=0 then
2844 2660 al w3 x1 ; sender:=dummy name address;
2845 2662 rl w2 x1+a31 ; move 4 words process name
2846 2664 wa w2 x1+a182 ; add base of current process
2847 2666 dl w1 x3+a11+2 ; from sender
2848 2668 ds w1 x2+2 ;
2849 2670 dl w1 x3+a11+6 ;
2850 2672 ds w1 x2+6 ; to name parameter;
2851 2674 rl w2 b1 ;
2852 2676 rl w0 x2+a182 ; get base of current process
2853 2678 dl w3 x2+a30 ; mess:= save w1(cur)
2854 2680 wa w2 0 ; get physical address of message area
2855 2682 al w1 x3+8 ; w1:=buf+8;
2856 2684 al w3 c99 ; move mess(buf+8, mess);
2857 2686 jl d14 ; goto interrupt return;
2858 2688
2858 2688 ; procedure send answer(buf, answer, result);
2859 2688 ; call: return:
2860 2688 ; save w0 result unchanged
2861 2688 ; save w1 answer unchanged
2862 2688 ; save w2 buf unchanged
2863 2688 ; save w3 unchanged
2864 2688
2864 2688 e11: jl w3 d103 ; check message area and buf(cur);
2865 2690 ac w3 (x2+4) ; check state:
2866 2692 sh w3 -1 ; if receiver(buf)>0
2867 2694 jl c29 ; goto internal 3; (i.e. not claimed);
2868 2696 sz w3 2.1 ; make receiver even;
2869 2698 al w3 x3-1 ; (in case of immediate message)
2870 2700 rl w0 x3+a10 ; if kind(-receiver(buf))=pseudoproc then
2871 2702 sn w0 64 ;
2872 2704 rl w3 x3+a50 ; receiver:=-mainproc(-receiver);
2873 2706 sz w0 -1-64 ; if receiver is neither internal process nor pseudo process then
2874 2708 rl w3 x3+a250 ; receiver := driverproc(receiver);
2875 2710 se w1 x3 ; if -receiver<>cur then
2876 2712 jl c29 ; goto internal 3; (i.e. cur not receiver);
2877 2714
2877 2714 rl w3 x2+4 ; if receiver(buf) odd then
2878 2716 sz w3 2.1 ; goto immediate message;
2879 2718 jl. i4. ;
2880 2720
2880 2720 rl w0 x1+a28 ; result:=save w0(cur);
2881 2722 sl w0 1 ; if result<1 or
2882 2724 sl w0 6 ; result>5 then
2883 2726 jl c29 ; goto internal 3;
2884 2728 rs w0 x2+4 ; receiver(buf):=result;
2885 2730 bz w3 x1+a19 ;
2886 2732 al w3 x3+1 ; increase buf claim(cur);
2887 2734 hs w3 x1+a19 ;
2888 2736 rl w0 x1+a182 ;
2889 2738 rl w1 x1+a29 ;
2890 2740 wa w1 0 ; get physical address of answer area
2891 2742 al w2 x2+8 ;
2892 2744 jl w3 d14 ; move mess(answer, buf+8);
2893 2746 al w2 x2-8 ;
2894 2748 al w3 c99 ; deliver answer(buf);
2895 2750 jl. d15. ; goto interrupt return;
2896 2752
2896 2752 ; immediate message
2897 2752 ; originates from a call of initialize process etc
2898 2752
2898 2752 ; entry: w1=cur, w2=buf, w3=receiver (negative, odd)
2899 2752 i4: ac w3 x3+1 ; make receiver even;
2900 2754 rs. w3 i8. ; save(receiver);
2901 2756 dl w0 x2+8 ;
2902 2758 ds. w0 i7. ; save(sender(buf), switch);
2903 2760 jl w3 d109 ; increase bufclaim, remove release buf(cur, buf);
2904 2762 ; now the receiving driver has no responsibilities any longer
2905 2762
2905 2762 rl. w1 i6. ; restore(sender);
2906 2764 sh w1 0 ; if sender <= 0 then
2907 2766 jl c99 ; goto interrupt return; (i.e. regretted)
2908 2768
2908 2768 al w0 -1<1 ; make save ic(sender) even to
2909 2770 la w0 x1+a33 ; indicate that answer is received;
2910 2772 rs w0 x1+a33 ;
2911 2774
2911 2774 bz w3 x1+a19 ; increase(bufclaim(sender));
2912 2776 al w3 x3+1 ; (remember: the earlier decrease was just
2913 2778 hs w3 x1+a19 ; to facilitate...)
2914 2780
2914 2780 ; maybe transfer result:
2915 2780 rl. w3 i7. ; restore(switch);
2916 2782 rl w2 b1 ; w2 := cur;
2917 2784 rl w0 x2+a28 ; result := save w0(cur);
2918 2786 se w3 4 ; if switch <> 4 then
2919 2788 rs w0 x1+a28 ; save w0(sender) := result; (i.e. unless release process)
2920 2790
2920 2790 ; maybe do the final insertion/removal of user/reserver:
2921 2790 se w0 0 ; if result = 0 then
2922 2792 jl. i5. ; begin
2923 2794 rl w0 x2+a29 ; if save w1(cur) odd
2924 2796 sz w0 2.1 ;
2925 2798 al w3 x3+1 ; and switch = 0 then
2926 2800 sn w3 1 ;
2927 2802 al w3 2 ; switch := 2; i.e. reserve process;
2928 2804 rl. w2 i8. ; restore(receiver);
2929 2806 jl. x3+2 ; case switch(buf) of:
2930 2808 am d126-d125; switch=0: initialize proc: insert user(sender, receiver proc)
2931 2810 am d125-d124; switch=2: reserve proc: insert reserver( - , - - )
2932 2812 jl w3 d124 ; switch=4: release proc: remove reserver( - , - - )
2933 2814 i5: ; end;
2934 2814
2934 2814 bz w0 x1+a13 ; if state(sender) = waiting for proc func then
2935 2816 sn w0 a101 ; link internal(sender);
2936 2818 jl w3 d10 ; (i.e. start unless already stopped by parent)
2937 2820
2937 2820 jl c99 ; goto interrupt return;
2938 2822
2938 2822 i6: 0 ; saved sender(buf)
2939 2824 i7: 0 ; saved switch
2940 2826 i8: 0 ; saved receiver(buf)
2941 2828
2941 2828 e.
2942 2828
2942 2828 ; procedure wait event(last buf, next buf, result);
2943 2828 ; call: return:
2944 2828 ; save w0 result (=0, 1)
2945 2828 ; save w1 unchanged
2946 2828 ; save w2 last buf unchanged
2947 2828 ; save w3 unchanged
2948 2828
2948 2828 ; procedure test event(last buf, next buf, result);
2949 2828 ; call: return:
2950 2828 ; saved w0 result (-1: empty, 0: message, 1: answer)
2951 2828 ; saved w1 unchanged/sender(mess)/message flag
2952 2828 ; saved w2 last buf next buf
2953 2828 ; saved w3 unchanged
2954 2828
2954 2828
2954 2828 b. i20 w.
2955 2828 c96: rl w1 b1 ; entry to wait first event:
2956 2830 rl w2 x1+a302 ; goto wait-first-event entry
2957 2832 jl (x2+a304) ; in the driver process;
2958 2834
2958 2834 e33: am -1-0 ; test event: function:=inspect;
2959 2836
2959 2836 e12: al w0 0 ; wait event: function:=wait;
2960 2838 rs. w0 i0. ;
2961 2840 rl w2 x1+a30 ; last buf:=save w2(cur);
2962 2842 se w2 0 ; if last buf<>0 then
2963 2844 jl. i4. ; check event(cur, last buf);
2964 2846 al w2 x1+a15 ; else last buf:=event q(cur);
2965 2848 i3: al w3 x2 ;
2966 2850 al w0 0 ;
2967 2852 jl. i6. ; goto test buf;
2968 2854 i4: jl w3 d19 ; check event: call check event
2969 2856 jl. i3. ;
2970 2858
2970 2858 ; scan the event queue, from last buf, until last buf or already waited buf.
2971 2858 ; in the last case: release the claim.
2972 2858 ;
2973 2858 ; w0=0, w2=buf, w3=last buf
2974 2858 i5: rl w2 x2+0 ; next buf: buf:=next(buf);
2975 2860 sn w2 x3 ; if buf=last buf then
2976 2862 jl. i9. ; goto all buffers released;
2977 2864 i6: se w2 x1+a15 ; test buf: if buf=event q(cur) or
2978 2866 sh w0 (x2+4) ; receiver(buf)>=0 then
2979 2868 jl. i5. ; goto next buf;
2980 2870 sl w2 (b8+4) ;
2981 2872 sl w2 (b8+6) ; if buffer not message buffer then
2982 2874 jl. i5. ; goto next buf; (i.e. some kind of general event);
2983 2876
2983 2876 ; an already claimed buffer is found
2984 2876 sh w0 (x2+6) ; if sender(buf)<0 then
2985 2878 jl. i7. ; begin comment regretted, perform the actual release;
2986 2880 sn w3 x2 ; if last buf=buf then
2987 2882 rl w3 x2+2 ; last buf:=last(buf);
2988 2884 al w0 x3 ; save last buf;
2989 2886 jl w3 d106 ; remove and release buf(buf);
2990 2888 rl w3 0 ; restore last buf;
2991 2890 rl w1 b1 ; restore cur;
2992 2892 jl. i8. ; end
2993 2894 i7: ; else
2994 2894 ws w0 x2+4 ; receiver(buf):=+receiver(buf);
2995 2896 rs w0 x2+4 ;
2996 2898 i8: ;
2997 2898 bz w2 x1+a19 ;
2998 2900 al w2 x2+1 ; increase(buffer claim(cur));
2999 2902 hs w2 x1+a19 ;
3000 2904 i9: ; buf released:
3001 2904
3001 2904 ; at this point there should not be any claimed buffers in the queue...
3002 2904 ; examine the next event in the queue
3003 2904 ;
3004 2904 ; w3=last buf
3005 2904 rl w2 x3+0 ; buf:=next(last buf);
3006 2906 sn w2 x1+a15 ; if buf=event q(cur) then
3007 2908 jl. i13. ; goto empty;
3008 2910 rs w2 x1+a30 ; save w2(proc):=buf;
3009 2912
3009 2912 ; the buf may either be a message buffer, an interrupt operation
3010 2912 ; or a general event
3011 2912 sl w2 (b8+4) ; if buf is not message buffer then
3012 2914 sl w2 (b8+6) ;
3013 2916 jl. i11. ; goto other operation;
3014 2918 rl w0 x2+4 ; save w0(cur):=
3015 2920 sz w0 -8 ; if 0<=receiver(buf)<8 then
3016 2922 am -1 ; 1 else 0;
3017 2924 al w0 1 ; i.e.: 0==message,
3018 2926 rs w0 x1+a28 ; 1==answer;
3019 2928 rl. w3 i0. ;
3020 2930 se w3 -1 ; if function=test event then
3021 2932 jl. i10. ; if event=message then
3022 2934 sn w0 0 ; saved w1:=sender(message)
3023 2936 am a142-a139; else
3024 2938 rl w3 x2+a139 ; saved w1:=message flag(answer);
3025 2940 rs w3 x1+a29 ;
3026 2942 i10: ;
3027 2942 sn w0 0 ; if message then
3028 2944 jl w3 d108 ; claim buffer(cur, buf);
3029 2946 jl c99 ; goto interrupt return;
3030 2948
3030 2948 i11: ; other operation:
3031 2948 rl w3 (b6) ;
3032 2950 sl w2 x3 ; if operation <> internal process then
3033 2952 sl w2 (b8+4) ;
3034 2954 jl. i12. ; goto interrupt operation;
3035 2956
3035 2956 jl w3 d5 ; remove(operation);
3036 2958 jl. d120. ; goto take general event;
3037 2960
3037 2960 i12: ; interrupt operation:
3038 2960 jl w3 d5 ; remove(operation);
3039 2962 al w3 c99 ; take interrupt operation;
3040 2964 jl d127 ; goto interrupt return;
3041 2966
3041 2966 ; the queue was empty.
3042 2966 i13: rl. w0 i0. ; empty:
3043 2968 se w0 -1 ; if function<>test event then
3044 2970 jl d107 ; goto remove wait event;
3045 2972 rs w0 x1+a28 ; save w0:=-1(:=function);
3046 2974 jl c99 ; goto interrupt return;
3047 2976
3047 2976 i0: 0 ; function
3048 2978 e.
3049 2978
3049 2978
3049 2978 ; procedure get event(buf);
3050 2978 ; call: return:
3051 2978 ; save w0 unchanged
3052 2978 ; save w1 unchanged
3053 2978 ; save w2 buf unchanged
3054 2978 ; save w3 unchanged
3055 2978
3055 2978 b. i0 w.
3056 2978 e13: rl w2 x1+a30 ; buf:=save w2(cur);
3057 2980 jl w3 d19 ; check event(cur, buf);
3058 2982 rl w3 x2+4 ; if 0 <=receiver(buf)<8 then
3059 2984 sz w3 -8 ; begin comment answer;
3060 2986 jl. i0. ;
3061 2988 al w3 c99 ; increase claim, remove release buf(cur, buf);
3062 2990 jl d109 ; goto interrupt return;
3063 2992 i0: ; end;
3064 2992
3064 2992 ; message: if not claimed by means of wait event then claim it now:
3065 2992 sl w3 0 ; if receiver>=0 then
3066 2994 jl w3 d108 ; claim buffer(cur, buf);
3067 2996
3067 2996 al w3 c99 ; remove(buf);
3068 2998 jl d5 ; goto interrupt return;
3069 3000 e.
3070 3000
3070 3000
3070 3000 ; procedure regret message;
3071 3000 ; call: return:
3072 3000 ; save w1 unchanged
3073 3000 ; save w1 unchanged
3074 3000 ; save w2 buf unchanged
3075 3000 ; save w3 unchanged
3076 3000
3076 3000 e41: jl w3 d12 ; check message(buf);
3077 3002 rl w3 x2+6 ; proc:= sender(buf);
3078 3004 sh w3 0 ;
3079 3006 ac w3 x3 ;
3080 3008 rl w0 x3+a10 ; if kind(proc) = pseudo kind
3081 3010 sn w0 64 ; then proc:= main(proc);
3082 3012 rl w3 x3+a50 ;
3083 3014 bz w0 x2+8 ;
3084 3016 sn w3 (b1) ; if proc <> cur or
3085 3018 sz w0 1 ; operation(buf) odd then
3086 3020 jl c29 ; goto internal 3;
3087 3022 al w3 c99 ; regretted message(buf);
3088 3024 jl d75 ; goto interrupt return;
3089 3026
3089 3026 ; procedure get clock(time);
3090 3026 ; call: return:
3091 3026 ; save w0 time high
3092 3026 ; save w1 time low
3093 3026 ; save w2 unchanged
3094 3026 ; save w3 unchanged
3095 3026
3095 3026 e18: jl w3 d7 ; update time;
3096 3028 dl w3 b13+2 ;
3097 3030 ds w3 x1+a29 ; save w0w1(cur):=time;
3098 3032 jl c99 ; goto interrupt return;
3099 3034
3099 3034 ; procedure set clock(time);
3100 3034 ; call: return:
3101 3034 ; save w0 time high unchanged
3102 3034 ; save w1 time low unchanged
3103 3034 ; save w2 unchanged
3104 3034 ; save w3 unchanged
3105 3034
3105 3034 e19: bz w0 x1+a22 ; mask:=function mask(cur);
3106 3036 so w0 1<4 ; if mask(7)=0 then
3107 3038 jl c29 ; goto internal 3;
3108 3040 jl w3 d7 ; update time;
3109 3042 dl w3 b70+2 ; last inspected:=
3110 3044 ss w3 b13+2 ; last inspected
3111 3046 aa w3 x1+a29 ; -time
3112 3048 ds w3 b70+2 ; +newtime;
3113 3050 dl w3 x1+a29 ;
3114 3052 ss w3 b13+2 ; clockchange:=
3115 3054 aa w3 b15+2 ; clockchange+
3116 3056 ds w3 b15+2 ; newtime - time;
3117 3058 dl w3 x1+a29 ; c. tested by clock driver;
3118 3060 ds w3 b13+2 ; time:=save w0w1(cur);
3119 3062 jl c99 ; goto interrupt return;
3120 3064
3120 3064 ; call of process functions:
3121 3064 ;
3122 3064 ; make a primary check on the parameters to ensure that they are inside the calling process.
3123 3064 ; notice especially that it is not always possible to check the consistence of the parameters,
3124 3064 ; because the circumstances may change before procfunc has time to perform the function.
3125 3064 ; special care must be taken, so that the call may be repeated: if the calling process is
3126 3064 ; stopped before procfunc reaches the process, the call is deleted, and the ic of the process
3127 3064 ; will be decreased to repeat the call as soon as the process is restarted.
3128 3064
3128 3064 b. i20 w.
3129 3064
3129 3064 e61: ; delete aux entry:
3130 3064 jl w3 d111 ; check name (save w2) area;
3131 3066 rl w2 x1+a29 ; first param := save w1(cur);
3132 3068 al w0 x2+a88-2 ; last param := first + entry size - 2;
3133 3070 al. w3 i3. ; check within (first, last);
3134 3072 jl d112 ; goto link call;
3135 3074
3135 3074 e60: ; create aux entry and area process:
3136 3074 jl w3 d111 ; check name (save w2) area;
3137 3076 e56: ; connect main catalog:
3138 3076 e52: ; insert entry:
3139 3076 am i6 ; switch := test entry area;
3140 3078 e51: ; prepare bs:
3141 3078 al. w0 i3. ; switch := link call;
3142 3080 rs. w0 i7. ; save switch;
3143 3082
3143 3082 rl w2 x1+a31 ; first param := save w3(cur);
3144 3084 al w0 x2+a88-2 ; last param := first param + catentrysize - 2;
3145 3086 jl w3 d112 ; check within(first,last);
3146 3088
3146 3088 bz w0 x2+28 ; last param := last slice(chaintable)
3147 3090 al w2 x2+a88-2 ; + first param + catentrysize - 2;
3148 3092 wa w0 4 ;
3149 3094 jl w3 d112 ; check within(first,last);
3150 3096 jl. (i7.) ; goto (saved switch);
3151 3098 i7: 0 ; saved switch
3152 3100
3152 3100 e53: ; insert bs:
3153 3100 e54: ; delete bs:
3154 3100 e55: ; delete entries:
3155 3100 jl w3 d111 ; check name (save w2) area;
3156 3102 jl. i3. ; goto link call;
3157 3104
3157 3104 e39: ; set bs claims:
3158 3104 jl w3 d111 ; check name(save w2) area;
3159 3106
3159 3106 ; get size of param (save w1(cur)):
3160 3106 ; set bs claims (continued):
3161 3106 am a110*4+4-12 ; size:=(maxkey+1)*4;
3162 3108 e28: ; create internal:
3163 3108 e31: ; modify internal:
3164 3108 am 12-8 ; size:=12;
3165 3110 e23: ; rename entry:
3166 3110 am 8-a88 ; size:=8;
3167 3112 e38: ; lookup head and tail:
3168 3112 i0: ; insert entry (continued):
3169 3112 am a88-a88+14 ; size:=catentry size;
3170 3114 e20: ; create entry:
3171 3114 e21: ; lookup entry:
3172 3114 e22: ; change entry:
3173 3114 al w0 a88-14-2 ; size:=catentry size-14; notice -2;
3174 3116 rl w2 x1+a29 ; first param:=save w1(cur);
3175 3118 wa w0 4 ; last param:=first param+size-2;
3176 3120 al. w3 i2. ; check within(first, last);
3177 3122 jl d112 ; goto check name(save w3);
3178 3124 e43: ; lookup-aux-entry:
3179 3124 al w0 a88-14-2 ; size:= catentrysize-14; NOTICE -2
3180 3126 rl w2 x1+a29 ; first param:= save w1(cur)
3181 3128 wa w0 4 ; last param := first param+size-2;
3182 3130 jl w3 d112 ; check within(first,last)
3183 3132 e44: al. w3 i2. ; clear-stat-entry:
3184 3134 jl d111 ; check name( save w2) area;
3185 3136
3185 3136
3185 3136 e46: ; create entry lock process:
3186 3136 rl w2 x1+a31 ; first param:=save w3(cur);
3187 3138 al w0 x2+8 ; last param:=first param+8;
3188 3140 am d112-d111; check within(first, last)
3189 3142 ; instead of
3190 3142 e45: ; permanent entry in auxcat:
3191 3142 jl w3 d111 ; check name(save w2) area;
3192 3144
3192 3144 ; check param (save w3(cur)):
3193 3144 e24: ; remove entry:
3194 3144 e25: ; permanent entry:
3195 3144 e26: ; create area process:
3196 3144 e27: ; create peripheral process:
3197 3144 e32: ; remove process:
3198 3144 e34: ; generate name:
3199 3144 e36: ; set catalog base:
3200 3144 e37: ; set entry interval:
3201 3144 e40: ; create pseudo process:
3202 3144 i2: jl w3 d17 ; check name area;
3203 3146 e57: ; remove main catalog:
3204 3146
3204 3146 ; link the calling process to the process function queue.
3205 3146 ; procfunc is activated if it is waiting for a call.
3206 3146 i3: i6=i0-i3 ;
3207 3146 al w0 a101 ; link call:
3208 3148 jl w3 d9 ; remove internal(wait proc func); (w2 := cur + a16)
3209 3150 ; elem:=process q(cur);
3210 3150 rl w1 (b6) ; proc:=name table(first internal); i.e. proc func;
3211 3152 al w1 x1+a15 ;
3212 3154 jl w3 d6 ; link(event queue(proc func), elem);
3213 3156 al w1 x1-a15 ;
3214 3158 bz w0 x1+a13 ; if state(proc func)=wait message then
3215 3160 sn w0 a102 ;
3216 3162 jl w3 d10 ; link internal(proc func);
3217 3164 jl c99 ; goto interrupt return;
3218 3166
3218 3166 ; procedure reset device: special meaning when called form proc func.
3219 3166 e1: rl w2 (b6) ; proc:=name table(first internal); i.e. proc func;
3220 3168 se w2 x1 ; if proc<>cur then
3221 3170 jl. i4. ; goto reset device;
3222 3172 rl w2 x1+a15 ; proc:=next(event q(cur)); i.e. calling process;
3223 3174 jl w3 d5 ; remove (proc) from proc func queue;
3224 3176 rs. w2 i7. ; save (proc);
3225 3178 al w0 a102 ;
3226 3180 sn w3 x1+a15 ; if next(proc)=event q(cur) (i.e. queue empty) then
3227 3182 jl w3 d9 ; remove internal(wait mess);
3228 3184 rl. w2 i7. ; restore (proc);
3229 3186 al w1 x2-a16 ;
3230 3188 al w3 c99 ; link internal(proc);
3231 3190 jl d10 ;
3232 3192
3232 3192 ; reset device
3233 3192 ; call: return:
3234 3192 ; save w0 resettype result (=0,4)
3235 3192 ; save w1 device unchanged
3236 3192 ; save w2 unchanged
3237 3192 ; save w3 unchanged
3238 3192
3238 3192 i4: rl w2 x1+a29 ; device := save w1(cur);
3239 3194 lx w2 g49 ; exchange bit 0;
3240 3196 wa w2 b65 ;
3241 3198 sl w2 (b67) ; if device address outside
3242 3200 sl w2 (b68) ; controller table then
3243 3202 jl r4 ; goto result 4;
3244 3204
3244 3204 rl w2 x2+a311 ; status addres := status(contr descr);
3245 3206 al w2 x2-a230 ;
3246 3208 jl w1 d130 ; clear device(proc);
3247 3210 rl w1 b1 ; w1 := cur;
3248 3212 al w0 0 ; result:=0;
3249 3214 rx w0 x1+a28 ; if save w0(cur) = 0 then
3250 3216 sn w0 0 ; result := power restart
3251 3218 am 6-3 ; else
3252 3220 al w0 3 ; result := timeout;
3253 3222 al w2 x2+a241 ; w2 := interrupt operation(proc);
3254 3224 al w3 c99 ; deliver interrupt;
3255 3226 jl d121 ; goto interrupt return;
3256 3228
3256 3228 e29: rl w2 (b6) ; start internal process
3257 3230 se w2 x1 ; if cur <> first internal (i.e. proc func) then
3258 3232 jl. i2. ; goto check name(save w3);
3259 3234 ; proc func has issued a call of start process.
3260 3234 ; all processes to be started are linked together, via wait-address, and the start of the
3261 3234 ; chain is given in save w3.
3262 3234 i5: rl w1 x2+a31 ; rep: proc := save w3(proc func);
3263 3236 sn w1 0 ; if end chain then
3264 3238 jl c99 ; goto interrupt return;
3265 3240
3265 3240 rl w0 x1+a40 ; save w3(proc func) := wait address.proc;
3266 3242 rs w0 x2+a31 ;
3267 3244 rl w2 x1+a34 ; father := parent.proc;
3268 3246 bz w3 x2+a12 ;
3269 3248 al w3 x3+1 ; increase(stopcount(father));
3270 3250 hs w3 x2+a12 ;
3271 3252 al w0 a101 ;
3272 3254 hs w0 x1+a13 ; state.proc := waiting for process function; (prepare for not starting)
3273 3256 rl w0 x1+a33 ;
3274 3258 so w0 1 ; if save ic(proc) even then
3275 3260 jl w3 d10 ; link internal(proc);
3276 3262 rl w2 (b6) ;
3277 3264 jl. i5. ; goto rep;
3278 3266
3278 3266 e30: ; stop internal process:
3279 3266 bz w0 x1+a19 ; if buf claim(cur)=0 then
3280 3268 sn w0 0 ; goto claim buffer(cur, irrellevant);
3281 3270 jl d108 ; (there are no buffers, so save w2:=0 and exit);
3282 3272
3282 3272 ; you may not actually claim the buffer for returning the answer yet, because the calling
3283 3272 ; process may get stopped itself, before procfunc reaches it. when the call is repeated, the
3284 3272 ; buffer might be claimed more than once.
3285 3272 jl. i2. ; goto check name area;
3286 3274
3286 3274 b.j10 w.
3287 3274
3287 3274 ; procedure copy.
3288 3274 ; call return
3289 3274 ; save w0 x z
3290 3274 ; save w1 x z
3291 3274 ; save w2 x z
3292 3274 ; save w3 x z
3293 3274
3293 3274 e35: ; copy message:
3294 3274 jl w3 d12 ; check message buf;
3295 3276 rl w3 x1+a29 ; first:=saved w1;
3296 3278 rl w0 x1+a31 ; last:=saved w3;
3297 3280
3297 3280 sl w3 (x1+a17) ; check:
3298 3282 sl w0 (x1+a18) ; if first<first addr(cur)
3299 3284 jl c29 ; or last>=top addr(cur)
3300 3286 ws w0 6 ; or first>last then
3301 3288 sh w0 -1 ; goto internal 3
3302 3290 jl c29 ;
3303 3292 ;
3304 3292 ac w3 (x2+4) ; rec:= -(-receiver(mess))
3305 3294 so w3 2.1 ; if rec odd
3306 3296 sh w3 0 ; or rec<=0 then
3307 3298 jl c29 ; goto internal 3
3308 3300 rl w0 x3+a10 ;
3309 3302 sn w0 64 ; if rec is a pseudo process then
3310 3304 rl w3 x3+a50 ; rec:=main(rec);
3311 3306 rl w0 x3+a10 ;
3312 3308 sz w0 -1-64 ; if rec neither internal nor pseudo process then
3313 3310 rl w3 x3+a250 ; rec:=driver proc(rec);
3314 3312 se w3 x1 ; if rec<>cur then
3315 3314 jl c29 ; goto internal3;
3316 3316
3316 3316 bz w3 x2+8 ;
3317 3318 so w3 2.1 ; if operation(mes) even then
3318 3320 jl r3 ; goto result3;
3319 3322
3319 3322 ; further checking is postponed until procfunc.
3320 3322 jl. i3. ; goto link call;
3321 3324
3321 3324
3321 3324
3321 3324 ; procedure general copy
3322 3324 ; copies an area in the calling process to or from an
3323 3324 ; area described in a message buffer.
3324 3324 ; the first word to be copied is defined by its position
3325 3324 ; relative to the first address in the messagebuffer.
3326 3324 ; call return
3327 3324 ; save w0 result (=0,2,3)
3328 3324 ; save w1 params halfwords moved
3329 3324 ; save w2 buf
3330 3324 ; save w3
3331 3324 ; params+0 function (addr pair<1 + mode)
3332 3324 ; +2 first
3333 3324 ; +4 last
3334 3324 ; +6 relative(mess data buffer)
3335 3324
3335 3324 j10=512 ; max number of bytes immidiately transferred
3336 3324
3336 3324 e42: ; general copy:
3337 3324 jl w3 d12 ; check message buf
3338 3326 rl w3 x1+a29 ; param:= parameter address(=cur.w1)
3339 3328 al w0 x3+6 ; if param<first addr(cur) or
3340 3330 sl w3 (x1+a17) ; param+6>=top addr(cur) then
3341 3332 sl w0 (x1+a18) ;
3342 3334 jl c29 ; goto internal 3
3343 3336 wa w3 x1+a182 ; w3:= abs addr of param
3344 3338 rl w0 x3+0 ;
3345 3340 rs. w0 j4. ; function:=function(param);
3346 3342 ls w0 -1 ; if addr pair>12 then
3347 3344 sl w0 14 ; goto internal 3
3348 3346 jl c29 ;
3349 3348 rs. w0 j0. ; pair:=function>1;
3350 3350 ;
3351 3350 rl w0 x3+6 ; rel:= param.relative
3352 3352 sh w0 -1 ; if rel<0 then
3353 3354 jl c29 ; goto internal 3
3354 3356 rs. w0 j1. ; relative:=rel;
3355 3358 ;
3356 3358 dl w0 x3+4 ; first:=param.first addr
3357 3360 ; last:=param.last addr
3358 3360 sl w3 (x1+a17) ; check:
3359 3362 sl w0 (x1+a18) ; if first<first addr(cur) or
3360 3364 jl c29 ; last>=top addr(cur) or
3361 3366 ws w0 6 ; first>last then
3362 3368 sh w0 -1 ; goto internal 3
3363 3370 jl c29 ;
3364 3372 wa w0 x1+a182 ; abs first(cur):=first(cur)+base(cur);
3365 3374 ds. w0 j3. ; size(cur)-2:=last(cur)-first(cur);
3366 3376 ;
3367 3376 rl w2 x1+a30 ; mess:=saved w2;
3368 3378 ac w3 (x2+4) ; rec:= -(-receiver(mess));
3369 3380 sh w3 0 ;*****aht. driver proc
3370 3382 ac w3 x3 ;*****
3371 3384 so w3 2.1 ; if rec odd
3372 3386 sh w3 0 ; or rec<=0 then
3373 3388 jl c29 ; goto internal 3;
3374 3390 rl w0 x3+a10 ;
3375 3392 sn w0 64 ; if rec is a pseudo process then
3376 3394 rl w3 x3+a50 ; rec:=main(rec);
3377 3396 rl w0 x3+a10 ;
3378 3398 sz w0 -1-64 ; if rec neither internal nor pseudo process then
3379 3400 rl w3 x3+a250 ; rec:=driver proc(rec);
3380 3402 se w3 x1 ; if rec<>cur then
3381 3404 jl c29 ; goto internal3;
3382 3406
3382 3406 rl w3 x2+a142 ; w3 := sender(mess);
3383 3408 bz w0 x2+a150 ;
3384 3410 sz w0 2.1 ; if operation(mess) even
3385 3412 sh w3 0 ; or sender <= 0 (i.e. regretted) then
3386 3414 jl r3 ; goto result 3;
3387 3416 rl w0 x3+a10 ; if kind(sender) = pseudo kind
3388 3418 sn w0 64 ; then sender := main(sender)
3389 3420 rl w3 x3+a50 ;
3390 3422
3390 3422 bz w0 x3+a13 ; if state(sender) = stopped then
3391 3424 sz w0 a105 ;
3392 3426 jl r2 ; goto result 2;
3393 3428
3393 3428 am. (j0.) ; first(mess):=first(mess+pair)+relative;
3394 3430 dl w1 x2+8+2 ; last(mess):=last(mess+pair+2);
3395 3432 wa. w0 j1. ;
3396 3434 sl w0 (x3+a17) ; if first(mess)<first(sender)
3397 3436 sl w1 (x3+a18) ; or last(mess)>last(sender) then
3398 3438 jl. i13. ; goto result3;
3399 3440
3399 3440 ws w1 0 ; size-2:=last(mess)-first(mess);
3400 3442 sh w1 -1 ; if size-2 < 0
3401 3444 jl c29 ; then goto internal 3;
3402 3446 wa w0 x3+a182 ; abs first(mess):=first(mess)+base(sender);
3403 3448 sl. w1 (j3.) ; if size>size(cur) then
3404 3450 rl. w1 j3. ; size:=size(cur);
3405 3452 al w3 x1+2 ;
3406 3454 rx w3 0 ;
3407 3456 rl. w2 j2. ;
3408 3458
3408 3458 ; w0: size, w2: abs first(cur), w3: abs first(mess)
3409 3458
3409 3458 rl. w1 j4. ;
3410 3460 so w1 2.1 ; if mode=1 then from:=cur, to:=mess
3411 3462 rx w2 6 ; else from:=mess, to:=cur;
3412 3464 ;
3413 3464 rl w1 b1 ;
3414 3466 sl w0 j10+1 ; if size>max number trf immidiately then
3415 3468 jl. i3. ; goto call link;
3416 3470
3416 3470 rs w0 x1+a29 ; saved w1:=size;
3417 3472
3417 3472 ; move.
3418 3472 ; w0: size, w1: , w2: from-addr, w3: to-addr
3419 3472
3419 3472 i8: ac w1 (0) ; remaining := - bytes;
3420 3474 so w1 1<1 ; if even number of words to move then
3421 3476 jl. i10. ; goto move fast;
3422 3478 rl w0 x2+0 ;
3423 3480 rs w0 x3+0 ;
3424 3482 al w3 x3+2 ; increase(to-address);
3425 3484 al w2 x2+2 ; increase(from-address);
3426 3486 al w1 x1+2 ; decrease(remaining); (remember: negative)
3427 3488
3427 3488 i10: ; move fast:
3428 3488 rs. w1 j5. ; save(remaining);
3429 3490 sl w1 i12 ; if remaining does no exceed size of move-table
3430 3492 jl. x1+i11. ; then switch out through table;
3431 3494 ; (otherwise move a whole portion)
3432 3494 i9: ; start of move-table:
3433 3494 dl w1 x2+30 ;
3434 3496 ds w1 x3+30 ;
3435 3498 dl w1 x2+26 ;
3436 3500 ds w1 x3+26 ;
3437 3502 dl w1 x2+22 ;
3438 3504 ds w1 x3+22 ;
3439 3506 dl w1 x2+18 ;
3440 3508 ds w1 x3+18 ;
3441 3510 dl w1 x2+14 ;
3442 3512 ds w1 x3+14 ;
3443 3514 dl w1 x2+10 ;
3444 3516 ds w1 x3+10 ;
3445 3518 dl w1 x2+6 ;
3446 3520 ds w1 x3+6 ;
3447 3522 dl w1 x2+2 ;
3448 3524 ds w1 x3+2 ;
3449 3526 i11: ; top of move-table:
3450 3526 i12=i9-i11 ; size of move-table (notice: negative)
3451 3526
3451 3526 al w3 x3-i12 ; increase(to-address);
3452 3528 al w2 x2-i12 ; increase(from-address);
3453 3530 rl. w1 j5. ; restore(remaining);
3454 3532 al w1 x1-i12 ; decrease(remaining); (remember: negative)
3455 3534 sh w1 -1 ; if not all moved yet then
3456 3536 jl. i10. ; goto move fast;
3457 3538
3457 3538 ; now return to result0.
3458 3538 rl w1 b1 ;
3459 3540 jl r0 ; exit: goto result0;
3460 3542
3460 3542 i13: rl w1 b1 ; exit3:
3461 3544 jl r3 ; goto result3;
3462 3546
3462 3546 j0: 0 ; pair
3463 3548 j1: 0 ; relative
3464 3550 j2: 0 ; abs first(cur)
3465 3552 j3: 0 ; size(cur)-2
3466 3554 j4: 0 ; function
3467 3556 j5: 0 ; remaining bytes (multiplum of 4 bytes)
3468 3558 e.
3469 3558 e. ; end of proc func block
3470 3558
3470 3558
3470 3558 ; set priority.
3471 3558 ; saved w0 result(=0,3)
3472 3558 ; saved w1 priority
3473 3558 ; saved w2
3474 3558 ; saved w3 name addr(child)
3475 3558 b.i10,j10 w.
3476 3558 e47: jl w3 d17 ; check name(saved w3);
3477 3560 rl w2 x1+a31 ; name addr:=saved w3;
3478 3562 jl w3 d11 ; search name(name, entry);
3479 3564 jl r3 ; not found: goto result3;
3480 3566 rl w3 x3 ; found:
3481 3568 rs. w3 i0. ; child:=proc(entry);
3482 3570 se w1 (x3+a34) ; if parent(child)<>cur then
3483 3572 jl r3 ; goto result3;
3484 3574 rl w0 x3+a10 ;
3485 3576 se w0 0 ; if child not internal proc then
3486 3578 jl r3 ; goto result3;
3487 3580 rl w0 x1+a29 ; prio:=saved w1;
3488 3582 sh w0 -1 ; if prio<0 then
3489 3584 jl c29 ; goto internal3;
3490 3586 ws w0 x3+a301 ; increment:=prio-priority(proc);
3491 3588 rs. w0 i1. ;
3492 3590 ; search descendents of process and the process itself, and increment their
3493 3590 ; priority values. if they are in timeslice queue, then reinsert them to
3494 3590 ; assure proper displacement in priority-queue.
3495 3590 rl w3 b6 ;
3496 3592 j0: rl w2 x3 ;
3497 3594 j1: sn. w2 (i0.) ;
3498 3596 jl. j3. ;
3499 3598 rl w2 x2+a34 ;
3500 3600 se w2 0 ;
3501 3602 jl. j1. ;
3502 3604 j2: al w3 x3+2 ;
3503 3606 se w3 (b7) ;
3504 3608 jl. j0. ;
3505 3610 jl r0 ; exit: goto result0;
3506 3612
3506 3612 j3: rl w2 x3 ;
3507 3614 rl w0 x2+a301 ;
3508 3616 wa. w0 i1. ; priority(proc):=priority(proc)+increment;
3509 3618 rs w0 x2+a301 ;
3510 3620 ;* rl w0 x2+a16 ;
3511 3620 ;* sn w0 x2+a16 ; if proc in time-slice-queue then
3512 3620 ;* jl. j2. ;
3513 3620 ;* rs. w3 i2. ; save w3;
3514 3620 ;* al w2 x2+a16 ;
3515 3620 ;* jl w3 d5 ;
3516 3620 ;* jl w3 d10 ;
3517 3620 ;* rl. w3 i2. ;
3518 3620 jl. j2. ;
3519 3622
3519 3622 i0: 0 ; proc(child)
3520 3624 i1: 0 ; increment
3521 3626 i2: 0 ; saved w3
3522 3628
3522 3628 e.
3523 3628
3523 3628
3523 3628 ; procedure relocate(name,start address,result)
3524 3628 ; call: return:
3525 3628 ; save w0 result (= 3,6 )
3526 3628 ; save w1 start address
3527 3628 ; save w2
3528 3628 ; save w3 name address
3529 3628
3529 3628 b.i10,j10 w.
3530 3628 e48: jl w3 d17 ; check name(save w3)
3531 3630 rl w2 x1+a31 ; name addr:= save w3
3532 3632 jl w3 d11 ; search name(name,entry)
3533 3634 jl r3 ; not found: goto result 3
3534 3636 rl w3 x3 ; found :
3535 3638 rs. w3 i0. ; child:= proc(name table entry)
3536 3640 rl w0 x1+a182 ;
3537 3642 rs. w0 i2. ; save address base of calling process
3538 3644 se w1 (x3+a34) ; if parent(child) <> cur
3539 3646 jl r3 ; then goto result 3
3540 3648 rl w0 x3+a10 ;
3541 3650 se w0 0 ; if kind(child) <> internal
3542 3652 jl r3 ; then goto result 3
3543 3654 bz w0 x3+a13 ; if state(child) <> waiting f. start by parent
3544 3656 se w0 a99 ; then goto result 3
3545 3658 jl r3 ;
3546 3660 rl w0 x1+a29 ;
3547 3662 rl w2 x3+a18 ; if child is relocated outside relevant part
3548 3664 ws w2 x3+a17 ; of core then goto internal 3
3549 3666 wa w2 0 ;
3550 3668 sh w2 0 ; if overflow
3551 3670 jl c29 ; then goto result 3
3552 3672 al w2 x2-1 ;
3553 3674 sl w0 (x1+a17) ;
3554 3676 sl w2 (x1+a18) ;
3555 3678 jl c29 ;
3556 3680 rl w0 x1+a29 ; displ:= new start address - old start address
3557 3682 ws w0 x3+a17 ;
3558 3684 rs. w0 i1. ;
3559 3686 rl w3 b6 ; search:
3560 3688 j0: rl w2 x3 ; proc:= next internal in name table
3561 3690 j1: sn. w2 (i0.) ; if proc = child then goto update else
3562 3692 jl. j3. ; begin
3563 3694 rl w2 x2+a34 ; while parent(proc) <> 0 do
3564 3696 se w2 0 ; if parent(proc)=child then goto update
3565 3698 jl. j1. ; else proc:= parent(proc);
3566 3700 j2: ; end;
3567 3700 al w3 x3+2 ; next:
3568 3702 se w3 (b7) ; if more internals in name table
3569 3704 jl. j0. ; then goto search
3570 3706 rl w1 b1 ;
3571 3708 jl r0 ; exit: goto result 0
3572 3710 j3: rl w2 x3 ; update: proc:= proc(name table entry)
3573 3712 rl. w0 i1. ; current base(proc):= current base(parent)+displ;
3574 3714 wa. w0 i2. ;
3575 3716 rs w0 x2+a182 ;
3576 3718 dl w1 x2+a174 ; current lower write limit(proc):=
3577 3720 wa. w0 i1. ; initial lower write limit(proc)+displ;
3578 3722 wa. w1 i1. ; current upper write limit(proc):=
3579 3724 ds w1 x2+a184 ; initial upper write limit(proc)+displ;
3580 3726 jl. j2. ; goto next;
3581 3728
3581 3728 i0: 0 ; save child
3582 3730 i1: 0 ; save displacement
3583 3732 i2: 0 ; save address base of parent
3584 3734 e.
3585 3734 ; procedure change address base(name,displacement,result);
3586 3734 ; call: return:
3587 3734 ; save w0: result (= 1,3,6 )
3588 3734 ; save w1: displacement
3589 3734 ; save w2:
3590 3734 ; save w3: name address
3591 3734
3591 3734 b.i10,j10 w.
3592 3734 e49:
3593 3734 jl w3 d17 ; check name(save w3)
3594 3736 rl w2 x1+a31 ; name addr:= save w3;
3595 3738 jl w3 d11 ; search name(name,entry);
3596 3740 jl r3 ; not found: goto result 3
3597 3742 rl w3 x3 ; found: proc:= proc(name table entry)
3598 3744 rl w0 x1+a29 ;
3599 3746 la w0 g50 ; remove lsb
3600 3748 rs. w0 i0. ; save displacement
3601 3750 se w1 (x3+a34) ; if parent(proc) <> cur
3602 3752 jl r3 ; then goto result 3
3603 3754 rl w0 x3+a10 ;
3604 3756 se w0 0 ; if kind(proc) <> internal
3605 3758 jl r3 ; then goto result 3
3606 3760 bz w0 x3+a13 ;
3607 3762 se w0 a99 ; if state(proc) <> waiting f. start by parent
3608 3764 jl r3 ; then goto result 3
3609 3766 al w1 x3 ;
3610 3768 rl w3 b6 ; check if actual process has any children.
3611 3770 j1: rl w2 x3 ; in this case goto result 3
3612 3772 sn w1 (x2+a34) ;
3613 3774 jl r3 ;
3614 3776 al w3 x3+2 ;
3615 3778 se w3 (b7) ;
3616 3780 jl. j1. ;
3617 3782 dl w0 x1+a18 ; first addr(proc):= first addr(proc)-displ
3618 3784 ws. w0 i0. ; last addr(proc):= last addr(proc)-displ
3619 3786 ws. w3 i0. ;
3620 3788 sh w3 -1 ; if logical address < 0 or
3621 3790 jl r1 ; wraps around top of core then
3622 3792 sh w0 x3 ; goto result 1
3623 3794 jl r1 ;
3624 3796 ds w0 x1+a18 ;
3625 3798 dl w0 x1+a170 ; if exception addr(proc) <> 0 then
3626 3800 sn w3 0 ; exception addr(proc):=exception addr(proc)-displ;
3627 3802 jl. j2. ;
3628 3804 ws. w3 i0. ;
3629 3806 j2: sn w0 0 ; if escape addr(proc) <> 0 then
3630 3808 jl. j3. ; escape addr(proc):=escape addr(proc);
3631 3810 ws. w0 i0. ;
3632 3812 j3: ds w0 x1+a170 ;
3633 3814 rl w0 x1+a182 ; address base(proc):= address base(proc)+displacement;
3634 3816 wa. w0 i0. ;
3635 3818 rs w0 x1+a182 ;
3636 3820 rl w0 x1+a33 ; ic(proc):= ic(proc)-displacement;
3637 3822 ws. w0 i0. ;
3638 3824 rs w0 x1+a33 ;
3639 3826 rl w1 b1 ;
3640 3828 jl r0 ; exit: goto result 0
3641 3830
3641 3830 i0: 0 ; save displacement
3642 3832 e.
3643 3832
3643 3832 ; procedure set cpa
3644 3832 ; set the cparegister of an internal process.
3645 3832 ;
3646 3832 ; call return
3647 3832 ;
3648 3832 ; save w0 result (=0,2,3,4 )
3649 3832 ; save w1 cpa
3650 3832 ; save w2
3651 3832 ; save w3 name adr(proc)
3652 3832 ;
3653 3832
3653 3832 b. i10, j10 w.
3654 3832
3654 3832 e63: jl w3 d101 ; check and search name
3655 3834 jl r3 ; not found: result 3
3656 3836 rl w3 x3 ; found :
3657 3838 rs. w3 i1. ; save proc
3658 3840 rl w0 x3+a10 ; if process not an internal process
3659 3842 se w0 0 ; then goto result 3
3660 3844 jl r3 ;
3661 3846 se w1 (x3+a34) ; if parent(proc) <> cur
3662 3848 jl r3 ; then goto result 3
3663 3850 zl w0 x3+a13 ; if state(child) <> waiting for start by parent
3664 3852 se w0 a99 ; then goto result 2
3665 3854 jl r2 ;
3666 3856 rl w0 x1+a29 ; save cpa value
3667 3858 la w0 g50 ;
3668 3860 rs. w0 i0. ;
3669 3862 al w0 x3 ; if the process has any children
3670 3864 rl w3 b6 ; then goto result 2
3671 3866 j1: rl w2 x3 ;
3672 3868 sn w0 (x2+a34) ;
3673 3870 jl r2 ;
3674 3872 al w3 x3+2 ;
3675 3874 se w3 (b7) ;
3676 3876 jl. j1. ;
3677 3878 rl. w0 i0. ;
3678 3880 rl w3 0 ;
3679 3882 rl w2 +88 ;
3680 3884 sn w0 0 ; if cpa := 0 then
3681 3886 al w3 x2 ; cpa := last word of last monitor table
3682 3888 am. (i1.) ; if cpa:= 1 then
3683 3890 rl w2 +a171 ;
3684 3892 sn w0 1 ; cpa:= initial cpa(child)
3685 3894 al w3 x2 ;
3686 3896 rl. w2 i1. ;
3687 3898 sh w3 (x2+a171) ; check cpa:
3688 3900 sh w3 7 ; if cpa > initial cpa(child) or
3689 3902 jl r4 ; cpa < 7 then
3690 3904 rs w3 x2+a181 ; goto result 4 else
3691 3906 jl r0 ; goto result 0 ; end
3692 3908 i0: 0 ; saved cpa
3693 3910 i1: 0 ; saved proc
3694 3912
3694 3912 e.
3695 3912
3695 3912
3695 3912
3695 3912 ; procedure set process extension(first ext,last ext)
3696 3912 ;
3697 3912 ; save w0: result (return)
3698 3912 ; save w1: first process ext (call)
3699 3912 ; save w2: second process ext (call)
3700 3912 ; save w3: -
3701 3912 e58:
3702 3912
3702 3912 c.a400-1
3703 3912 rl w2 x1+a29 ; first:= save w1(cur)
3704 3912 rl w0 x1+a30 ; last:= save w2(cur)
3705 3912 sl w2 (0) ; if last < first then
3706 3912 rx w2 0 ; exchange(first,last)
3707 3912 jl w3 d112 ; check within(first,last)
3708 3912 rl w3 x1+a30 ; w3:= sec. proc. ext.
3709 3912 rl w2 x1+a29 ; w2:= first proc. ext.
3710 3912 ds w3 x1+a306 ; insert log. addr in process description
3711 3912 wa w2 x1+a182 ;
3712 3912 wa w3 x1+a182 ;
3713 3912 ds w3 b28 ; insert phys. addr in monitor table
3714 3912 jl r0 ; goto result 0;
3715 3912 z.
3716 3912 c.a400
3717 3912 jl c29 ;
3718 3914 z.
3719 3914
3719 3914
3719 3914
3719 3914
3719 3914 ; procedure start i/o;
3720 3914 ; call: return:
3721 3914 ; save w0 function select result (=0,1,2,3)
3722 3914 ; save w1 cp start (logic addr) unchanged
3723 3914 ; save w2 0 or buf unchanged
3724 3914 ; save w3 device address unchanged
3725 3914
3725 3914 ; the channelprogram is started using the device address in proc desc+a235.
3726 3914 ; at start time the working register holds the io-device number extracted
3727 3914 ; from the save w3 (only of importance in connection with rc8601).
3728 3914
3728 3914 ; result = 0: channel program etc ok, the interrupt operation will arive
3729 3914 ; (except after 'reset device')
3730 3914 ; 1: message regretted, i.e. no transfer started
3731 3914 ; 2: sender stopped , i.e. no transfer started
3732 3914 ; 3: sender address error, i.e.no transfer started
3733 3914 ; data command specifies buffers outside senders limits
3734 3914 ; (should give the reaction: message unintelligible)
3735 3914
3735 3914 ; the procedure returns always immediatly to the calling process
3736 3914 ; (i.e. the driver), to the instruction just following the call.
3737 3914 ; the driver may however specify (via function select) that
3738 3914 ; execution should be resumed via 'wait first event' (unless
3739 3914 ; result <> 0, in which case the normal resumption is made).
3740 3914 ; in case of parameter errors the driver process is break'ed, as usual.
3741 3914
3741 3914 ; parameter errors:
3742 3914 ; illegal function select
3743 3914 ; save w3 is not a device address
3744 3914 ; device descriptor not governed by current process
3745 3914 ; previous transfer not awaited (if not 'reset...')
3746 3914 ; save w2 not message buffer
3747 3914 ; state of message buffer not legal for transfer (***not implemented***)
3748 3914 ; channel program too long for device description (or outside driver process)
3749 3914 ; wait-command in channel program
3750 3914 ; illegal address code
3751 3914 ; address error (i.e. buffers outside limits (except sender limits) )
3752 3914 ; illegal data- or skip-chain
3753 3914 ;
3754 3914 ; function select:
3755 3914 ; function a. 1 = 0 : return to just after call
3756 3914 ; = 1 : exit via the std return address
3757 3914 ;
3758 3914 ; function>1 a. 1 = 0 : no reset
3759 3914 ; = 1 : reset device before start of operation
3760 3914 ;
3761 3914 ; function>2 = 0 : no operation
3762 3914 ; = 1 : start channelprogram
3763 3914 ; = 2 : start std wait program
3764 3914 ; = 3 : start std control program
3765 3914 ; function>12 = 0 ; data= deviceno. < 1 (w3 > 2 )
3766 3914 ; function>12 < > 0 ; data = function > 12
3767 3914
3767 3914
3767 3914 ; address code:
3768 3914 ; code = 0: data area in senders process (i.e. sender(buf))
3769 3914 ; 2: - - - drivers process
3770 3914 ; 4: - - - device descr
3771 3914 ; 6: - - - message buffer
3772 3914 ; 8: - - - core (no check)
3773 3914 ;
3774 3914 ; first logic address depends on address code:
3775 3914 ; code = 0: logic address in senders process
3776 3914 ; 2: logic address in drivers process
3777 3914 ; 4: relative address in device descr (relative to a10)
3778 3914 ; 6: relative address in message buffer (relative to a140)
3779 3914 ; 8: absolute address, with no limit check
3780 3914
3780 3914 ; timeout: (unit: 0.1 msec)
3781 3914 ; if a channel program is not terminated with an interrupt within
3782 3914 ; the specified period, a software timeout will be generated, which
3783 3914 ; will deliver the interrupt operation to the driver.
3784 3914 ; the device will be reset, exept after a wait-program.
3785 3914 ; notice: if timeout = 0, no software timeout will be provided.
3786 3914
3786 3914 ; channel program:
3787 3914 ; the channel program must be in the drivers area, and will be
3788 3914 ; copied to the device description.
3789 3914 ;
3790 3914 ; the channel program may contain commands with the following format:
3791 3914 ; comm + a321: irrell < 12 + 4095
3792 3914 ; comm + a322: irrell
3793 3914 ; comm + a323: irrell
3794 3914 ; in this case the command will be interpreted as a dummy-command,
3795 3914 ; i.e. will not be copied into the device description
3796 3914 ;
3797 3914 ; if the program contains the commands 0,1,2,3 (i.e. sense, control,
3798 3914 ; read, write with data buffer) without the skip-modification, the
3799 3914 ; commands must have the following format:
3800 3914 ; comm + a321: address code < 12 + command < 8 + modifs
3801 3914 ; comm + a322: first logic address
3802 3914 ; comm + a323: char count
3803 3914 ; char count must be >= 0 (unless in sense commands, where is must be >= 12)
3804 3914 ; (furthermore: if the command is a sense, the 'top chp addr' in the
3805 3914 ; sense-area will be cleared)
3806 3914 ;
3807 3914 ; the stop-command must have the following format:
3808 3914 ; comm + a321: 0 < 12 + 2.1111 < 8 + 0
3809 3914 ; comm + a322: 0
3810 3914 ; comm + a323: timeout
3811 3914 ; (this may prepare for introducing 'jump'-commands with the same
3812 3914 ; format as the 'stop', except for:
3813 3914 ; comm + a322: continue-address )
3814 3914
3814 3914 b. f20, h40, i60, j50 w.
3815 3914
3815 3914 ; function select table:
3816 3914 h0: f0 ; 0 : no operation
3817 3916 f1 ; 1 : start channelprogram
3818 3918 f2 ; 2 : start std wait program
3819 3920 f3 ; 3 : start std control program
3820 3922 j0=-h0.<1 ; top value of function select
3821 3922
3821 3922 ; address code table:
3822 3922 h1: f10 ;0: sender area
3823 3924 f11 ;2: driver area
3824 3926 f12 ;4: device descr
3825 3928 f13 ;6: message buffer
3826 3930 f14 ;8: abs core address (no limit check)
3827 3932 j1=-h1. ; top address code
3828 3932
3828 3932 h5: 0 ; device descr address
3829 3934
3829 3934 h10: 0 ; sender area used: 0=false, else true
3830 3936 h11: 0 ; =h10+2 ; driver area used: 0=false, else true
3831 3938
3831 3938 h15: 0 ; first of sender area (logic addr)
3832 3940 h16: 0 ; =h15+2 ; top - - - ( - - )
3833 3942 h17: 0 ; sender process description address
3834 3944
3834 3944 h20: 0 ; abs first of channel program area in device descr
3835 3946 h21: 0 ; =h20+2 ; abs top - - - - - - -
3836 3948 h22: 0 ; last of current chp prog entry in device descr
3837 3950 h23: 0 ; old command
3838 3952
3838 3952 h25: 1<23 ; change bit 0
3839 3954 h26: -1<1 ; make addresses even
3840 3956 h27: 3 ; number of characters per word
3841 3958
3841 3958 h30: 2.1100 < 8 + 1 < 6; mask: databuffer-command without skip
3842 3960 h36: j36 ; mask: sign extended command field
3843 3962
3843 3962 h40: j32 ; std wait channel program
3844 3964
3844 3964 ; format of channel program, in driver area:
3845 3964 ; (used relative to w3 = last of entry)
3846 3964 j11 = -a320 + 2 ; (base of command)
3847 3964 j12 = j11 + a321 ; command field
3848 3964 j13 = j11 + a322 ; param 1 (=first logic address)
3849 3964 j14 = j11 + a323 ; param 2 (=char count, or timeout)
3850 3964
3850 3964 ; format of channel program, in device description:
3851 3964 ; (matches the format prescribed by the controller)
3852 3964 ; (used relative to w2 = last of entry)
3853 3964 j20 = 6 ; (size of entry)
3854 3964 j21 = -j20 + 2 ; (base of command)
3855 3964 j22 = j21 + 0 ; command field
3856 3964 j23 = j21 + 2 ; param 1
3857 3964 j24 = j21 + 4 ; param 2
3858 3964
3858 3964 j30 = 2.0011 < 8 ; mask: sense command
3859 3964 j31 = 12 ; minimum char count in sense command
3860 3964 j34 = -1 < 8 + 1 < 6 ; mask: sense command without skip (sign extended)
3861 3964
3861 3964 j32 = 2.0100 < 8 ; wait command (sign extended)
3862 3964 j33 = -1 < 8 ; stop command (sign extended)
3863 3964 j37 = -1 < 0 ; dummy command (sign extended)
3864 3964
3864 3964 j35 = 1 < 7 + 1 < 6 ; data- + skip-chain
3865 3964 j36 = -1 < 8 ; sign extended command field
3866 3964
3866 3964 j40 = -1 ; status bit: status transfer error
3867 3964
3867 3964
3867 3964 e50: ; start i/o:
3868 3964 ; this first part of the code checks some of the most important
3869 3964 ; parameters.
3870 3964 ; it should be possible to skip this checking, in case the driver
3871 3964 ; contains no errors ???
3872 3964 rl w3 x1+a31 ; devaddr := save w3(cur);
3873 3966 sz w3 2.111 ; if devaddr not multiplum of 8 (bytes) then
3874 3968 jl c29 ; goto internal 3; i.e. not legal at all;
3875 3970
3875 3970 lx. w3 h25. ; change bit 0 in devaddr;
3876 3972 wa w3 b65 ; controller descr := controller table(devaddr);
3877 3974 sl w3 (b67) ; if controller descr outside
3878 3976 sl w3 (b68) ; controller table then
3879 3978 jl c29 ; goto internal 3;
3880 3980
3880 3980 rl w3 x3+a311 ; status addr := std status(controller descr);
3881 3982 al w3 x3-a230 ; device descr addr := proc(status addr);
3882 3984 rs. w3 h5. ;
3883 3986 se w1 (x3+a250) ; if cur <> driverproc(device) then
3884 3988 jl c29 ; goto internal 3;
3885 3990
3885 3990 rl w2 x1+a30 ;
3886 3992 se w2 0 ; if save w2(cur) <> 0 then
3887 3994 jl w3 d12 ; check message buf;
3888 3996
3888 3996 zl w3 x1+a28+1 ; function select := save w0(cur);
3889 3998 sl w3 0 ; if function select outside limits then
3890 4000 sl w3 j0 ;
3891 4002 jl c29 ; goto internal 3;
3892 4004
3892 4004 ; at this point the following has been checked:
3893 4004 ; save w3 is a legal device address, governed by the current process
3894 4004 ; save w2 is zero or a legal message buffer address
3895 4004 ; save w0 is a legal function select
3896 4004
3896 4004 ; w1 = cur, w3 = function select
3897 4004
3897 4004 so w3 1<1 ; if function select.reset is on then
3898 4006 jl. i6. ; device descr := saved device descr;
3899 4008 rl. w2 h5. ; clear device(device descr);
3900 4010 jl w1 d129 ;
3901 4012 rl w1 b1 ; w1 := cur;
3902 4014 zl w3 x1+a28+1 ; function select:=save(w0);
3903 4016 i6: ls w3 -1 ; function select := function select > 1;
3904 4018 jl. (x3+h0.) ; switch out through function select table;
3905 4020
3905 4020 ; general return actions:
3906 4020 ; a result is delivered to the driver, indicating the result of the call.
3907 4020 ; if result = ok and function select is odd, return to the driver is made
3908 4020 ; via 'wait first event', else a normal return is made
3909 4020
3909 4020 i3: am 3-2 ; result 3: address error:
3910 4022 i2: am 2-1 ; result 2: sender stopped:
3911 4024 i1: am 1-0 ; result 1: message regretted:
3912 4026 i0: al w0 0 ; result 0: ok:
3913 4028
3913 4028 rl w1 b1 ; w1 := cur;
3914 4030 rl w2 x1+a28 ; function select := save w0(cur);
3915 4032 rs w0 x1+a28 ; save w0(cur) := result;
3916 4034 sn w0 0 ; if result <> 0 or
3917 4036 so w2 2.1 ; function select even then
3918 4038 jl c99 ; goto interrupt return;
3919 4040
3919 4040 rl w2 x1+a302 ; get save area address;
3920 4042 rl w0 x2+a304 ; save ic(cur) := wait-first-event entry;
3921 4044 rs w0 x1+a33 ;
3922 4046 jl c99 ; goto interrupt return;
3923 4048
3923 4048 ; function select actions:
3924 4048
3924 4048 ; function select = no operation.
3925 4048 ; w1 = cur
3926 4048 f0=i0 ; goto result 0;
3927 4048
3927 4048 ; function select = start std control program
3928 4048 ; w1 = cur
3929 4048 f3: am. h40. ; first := std wait program;
3930 4050 ; continue with std wait program;
3931 4050
3931 4050 ; function select = start std wait program
3932 4050 ; w1 = cur
3933 4050 f2: al w0 0 ; first := 0 (i.e. no start)
3934 4052 rs. w0 h20. ; abs first of channel program := first;
3935 4054
3935 4054 rl w0 x1+a29 ; timeout := save w1(cur);
3936 4056
3936 4056 al w3 0 ; transfer code := 0;
3937 4058 ; (i.e. 'wait' not considered a transfer...)
3938 4058 jl. i50. ; goto init transfer code;
3939 4060
3939 4060 ; function select = start channel program:
3940 4060 ; w1 = cur
3941 4060 f1: ld w3 -100 ;
3942 4062 ds. w3 h11. ; sender area used := driver area used := false;
3943 4064 rs. w3 h23. ; old command := 0; (i.e. at least not data-chain)
3944 4066 ds. w3 h16. ; first,top sender area := 0; i.e. presume empty
3945 4068
3945 4068 rl w3 x1+a30 ; buf := save w2(cur);
3946 4070 sn w3 0 ; if buf = 0 then
3947 4072 jl. i10. ; goto buffer consistency checked;
3948 4074
3948 4074 ; when a message buffer is specified, it is generally concerning a
3949 4074 ; data-transfer to/from the sender area
3950 4074 ;
3951 4074 ; therefore the message buffer is checked once and for all, and the proper
3952 4074 ; buffer limits are found
3953 4074 ;
3954 4074 ; if any errors are found, the buffer limits will be set to en empty
3955 4074 ; buffer, thus any attempt to specify addresses within the sender area
3956 4074 ; will provoke a buffer limit violation
3957 4074
3957 4074 ; w1 = cur, w3 = buf
3958 4074
3958 4074 dl w2 x3+a142 ; w2 := sender(buf); (w1 := receiver(buf) )
3959 4076 sh w2 0 ; if sender <= 0 then
3960 4078 jl. i1. ; goto message regretted;
3961 4080
3961 4080 bz w0 x3+a145 ; if operation(buf) is even then
3962 4082 so w0 2.1 ;
3963 4084 jl. i10. ; goto message buffer checked;
3964 4086
3964 4086 ; check that the buffer is a message sent to the driver:
3965 4086 sh w1 -1 ; if message received then
3966 4088 ac w1 x1 ; receiver := - receiver;
3967 4090 sh w1 7 ; if receiver <= 7 then
3968 4092 jl. i10. ; goto message buffer checked; i.e. an answer
3969 4094
3969 4094 rl w0 x1+a10 ; w0 := kind(receiver);
3970 4096 sn w0 64 ; if kind = pseudo process then
3971 4098 rl w1 x1+a50 ; receiver := mainproc (receiver);
3972 4100 sz w0 -1-64 ; if receiver is neither internal process nor
3973 4102 rl w1 x1+a250 ; pseudo process then
3974 4104 se w1 (b1) ; receiver := driverproc (receiver);
3975 4106 jl. i10. ; if receiver <> cur then goto message checked;
3976 4108
3976 4108 ; now buf has shown out to be a message, sent to this driver
3977 4108 ; w2 = sender(buf), w3 = buf
3978 4108 rl w0 x2+a10 ; w0 := kind(sender);
3979 4110 sn w0 64 ; if kind = pseudo process then
3980 4112 rl w2 x2+a50 ; sender := mainproc (sender);
3981 4114 sz w0 -1-64 ; if sender neither internal nor pseudo process then
3982 4116 rl w2 x2+a250 ; sender := driverproc (sender);
3983 4118 ; w2 = internal process, which sent the message buffer
3984 4118 ; w3 = message buffer
3985 4118 dl w1 x3+a152 ; w0w1 := first,last address(buf); (logic addresses)
3986 4120 la. w0 h26. ; make the limits even;
3987 4122 la. w1 h26. ;
3988 4124 sl w0 x1+1 ; if first address > last address then
3989 4126 jl. i10. ; goto message checked;
3990 4128
3990 4128 sl w0 (x2+a17) ; if first,last address area outside
3991 4130 sl w1 (x2+a18) ; the senders area then
3992 4132 jl. i10. ; goto message checked;
3993 4134 al w1 x1+2 ; first of sender area := first address;
3994 4136 ds. w1 h16. ; top - - - := last address + 2;
3995 4138 rs. w2 h17. ; save sender process description address;
3996 4140
3996 4140 ; message buffer consistency checked:
3997 4140 ; prepare moving of the channel program, i.e. get first,last of
3998 4140 ; channel program area in device descr, and transform them to absolute
3999 4140 ; addresses.
4000 4140 ; check that the channel-program-source starts within the driver process.
4001 4140 ;
4002 4140 ; (all regs irrell)
4003 4140
4003 4140 i10: ; message checked:
4004 4140 rl. w1 h5. ; device descr := saved descr;
4005 4142 dl w3 x1+a227 ; abs first of chp area in device descr :=
4006 4144 wa w2 2 ; device descr + relative first of chp area;
4007 4146 wa w3 2 ; abs top of chp area in device descr :=
4008 4148 ds. w3 h21. ; device descr + relative top of chp area;
4009 4150
4009 4150 rl w1 b1 ; w1 := cur;
4010 4152 rl w3 x1+a29 ; first of channel program := save w1 (cur);
4011 4154 sl w3 (x1+a17) ; if first of channel program
4012 4156 sl w3 (x1+a18) ; is outside current process then
4013 4158 jl c29 ; goto internal 3;
4014 4160
4014 4160 wa w3 x1+a182 ; w3 := first of channel program
4015 4162 al w3 x3-2 ; + base (cur) - 2; i.e. last of entry
4016 4164 al w2 x2-2 ; w2 := last of current entry in device descr;
4017 4166
4017 4166 ; next command:
4018 4166 ; w1 = cur
4019 4166 ; w2 = last of current entry in device descr (abs addr)
4020 4166 ; w3 = last of current entry in driver process (abs addr)
4021 4166 i15: al w2 x2+j20 ; next command: increase(device pointer);
4022 4168 sl. w2 (h21.) ; if outside top of device descr area then
4023 4170 jl c29 ; goto internal 3; i.e. channel program too long
4024 4172 rs. w2 h22. ; save (last of current device entry);
4025 4174
4025 4174 i16: rl w1 b1 ; skip command:
4026 4176 al w3 x3+a320 ; increase(driver pointer);
4027 4178 sl w3 0 ; if overflow or
4028 4180 sl w3 (x1+a18) ; outside top of driver process then
4029 4182 jl c29 ; goto internal 3;
4030 4184
4030 4184 ; move the command unchanged from driver area to device description:
4031 4184 dl w1 x3+j14 ; move (param 1, param 2);
4032 4186 ds w1 x2+j24 ;
4033 4188 rl w0 x3+j12 ; move (command);
4034 4190 rs w0 x2+j22 ;
4035 4192 sz. w0 (h30.) ; if command is not databuffer without skip then
4036 4194 jl. i30. ; goto test chain;
4037 4196
4037 4196 ; the command is sense, control, read or write with databuffer.
4038 4196 ; param 1 (i.e. the first logic addr) must be transformed to an absolute
4039 4196 ; address, using the address code.
4040 4196 ; check that the char count is not too small (command dependant).
4041 4196 ;
4042 4196 ; w0 = command word
4043 4196 ; w1 = param 2 (=char count)
4044 4196
4044 4196 sz w0 j30 ; minimum := if not sense command then
4045 4198 am -j31+1-1; 0 else sense-char-count;
4046 4200 sh w1 j31-1 ; if char count < minimum then
4047 4202 jl c29 ; goto internal 3;
4048 4204
4048 4204 ; compute size (and thereby last) of data buffer area
4049 4204 al w0 0 ; words := chars // number of chars per word;
4050 4206 wd. w1 h27. ;
4051 4208 ls w1 1 ; last byte used := words * 2
4052 4210 sn w0 0 ; - if chars mod (chars per word) = 0 then
4053 4212 al w1 x1-2 ; 2 else 0;
4054 4214
4054 4214 rl w0 x3+j13 ; w0 := first logic address;
4055 4216 wa w1 0 ; w1 := last logic address; (=last byte+first logic)
4056 4218 sl w0 x1+3 ; if first address > last address then
4057 4220 jl c29 ; goto internal 3; i.e. buffer wraps around top of core
4058 4222
4058 4222 ; w0 = first logic address
4059 4222 ; w1 = last logic address
4060 4222 ; w3 = abs last of current chp entry
4061 4222 bz w2 x3+j12 ; w2 := address code(current command);
4062 4224 sh w2 j1-1 ; if address code inside limits then
4063 4226 jl. (x2+h1.) ; switch out through address code table;
4064 4228 jl c29 ; else goto internal 3; i.e. illegal address code
4065 4230
4065 4230 ; address transformation actions:
4066 4230
4066 4230 ; address code = sender area:
4067 4230 ; w0 = first logic address
4068 4230 ; w1 = last logic address
4069 4230 f10: sl. w0 (h15.) ; if buffer area outside sender area then
4070 4232 sl. w1 (h16.) ;
4071 4234 jl. i3. ; goto address error;
4072 4236
4072 4236 rl. w2 h17. ; sender descr := saved sender process descr;
4073 4238 rs. w2 h10. ; sender area used := true;
4074 4240 wa w0 x2+a182 ; transform first address to absolute address;
4075 4242 jl. i20. ; goto first address transformed;
4076 4244
4076 4244 ; address code = driver area
4077 4244 ; w0 = first logic address
4078 4244 ; w1 = last logic address
4079 4244 f11: rl w2 b1 ; driver := cur;
4080 4246 sl w0 (x2+a17) ; if buffer area outside driver process then
4081 4248 sl w1 (x2+a18) ;
4082 4250 jl c29 ; goto internal 3;
4083 4252
4083 4252 rs. w2 h11. ; sender area used := true;
4084 4254 wa w0 x2+a182 ; transform first address to absolute address;
4085 4256 jl. i20. ; goto first address transformed;
4086 4258
4086 4258 ; address code = device description
4087 4258 ; w0 = first relative address
4088 4258 ; w1 = last relative address
4089 4258 f12: rl. w2 h5. ;
4090 4260 sl w0 (x2+a220) ; if buffer area outside
4091 4262 sl w1 (x2+a221) ; private area (device descr) then
4092 4264 jl c29 ; goto internal 3;
4093 4266
4093 4266 wa w0 4 ; transform first relative address to absolute addr;
4094 4268 jl. i20. ; goto first address transformed;
4095 4270
4095 4270 ; address code = message buffer
4096 4270 ; w0 = first relative address
4097 4270 ; w1 = last relative address
4098 4270 f13: sl w0 a145 ; if buffer area outside
4099 4272 sl w1 a146 ; message part of message buffer then
4100 4274 jl c29 ; goto internal 3;
4101 4276
4101 4276 rl w2 b1 ; buf := save w2 (cur);
4102 4278 wa w0 x2+a30 ; transform first relative address to absolute addr;
4103 4280 sh w0 x1 ; if buf <> 0 then
4104 4282 jl. i20. ; goto first address transformed
4105 4284 jl c29 ; else goto internal 3;
4106 4286
4106 4286 ; address code = abs core address
4107 4286 ; w0 = absolute first address
4108 4286 ; w1 = absolute last address
4109 4286 f14: ; continue with first address transformed
4110 4286
4110 4286 ; the legality of the buffer addresses has been checked,
4111 4286 ; and the first address is now an absolute core address
4112 4286 ; w0 = abs first address
4113 4286 ; w3 = last of current chp entry
4114 4286 i20: ; first address transformed:
4115 4286 rl. w2 h22. ; restore (device pointer);
4116 4288 rs w0 x2+j23 ; move abs first address to channel program;
4117 4290
4117 4290 ; now a complete command has been moved.
4118 4290 ; check that the command does not change during data- or skip-chain
4119 4290 ; w2 = last of device descr chp entry
4120 4290 ; w3 = last of current chp entry
4121 4290 i30: ; test chain:
4122 4290 bl w0 x2+j22+1 ; command := command byte(current entry);
4123 4292 sn w0 j37 ; if command = dummy command then
4124 4294 jl. i16. ; goto skip command;
4125 4296 rl. w1 h23. ; prev command := old command;
4126 4298 rs. w0 h23. ; old command := command;
4127 4300 sz w1 j35 ; if previous command contained any chains then
4128 4302 jl. i31. ; begin
4129 4304 jl. i32. ; test that the two commands are equal:
4130 4306
4130 4306 i31: lx w1 0 ; if prev command <> command then
4131 4308 sz w1 j36 ; goto internal 3;
4132 4310 jl c29 ; end;
4133 4312 i32: ;
4134 4312
4134 4312 ; to facilitate the drivers interpretation from the sense-commands,
4135 4312 ; the first word of the sense area is cleared.
4136 4312 ; thereby the driver can detect in a simple way, if that sense
4137 4312 ; has been executed.
4138 4312 ;
4139 4312 ; w0 = command (sign extended)
4140 4312 ; w2 = last of device descr chp entry
4141 4312 ; w3 = last of current chp entry
4142 4312 sz w0 j34 ; if command = sense without skip then
4143 4314 jl. i33. ; begin
4144 4316 al w1 0 ; top chp addr (sense area) := 0;
4145 4318 am (x2+j23) ;
4146 4320 rs w1 +a315 ;
4147 4322 i33: ; end;
4148 4322
4148 4322 ; a driver-supplied channel program may not contain a 'wait'-command,
4149 4322 ; because this migth delay the terminating interrupt infinitly,
4150 4322 ; thereby preventing the processes from being stopped.
4151 4322 ;
4152 4322 ; w0 = command (sign extended)
4153 4322 ; w2 = last of device descr chp entry
4154 4322 ; w3 = last of current chp entry
4155 4322 la. w0 h36. ; w0 := command bits of command;
4156 4324 sn w0 j32 ; if command = 'wait' then
4157 4326 jl c29 ; goto internal 3;
4158 4328
4158 4328 ; if the channel program has not encountered the 'stop'-command
4159 4328 ; then move and translate the next command
4160 4328 ;
4161 4328 ; w0 = command (sign extended)
4162 4328 ; w2 = last of device descr chp entry
4163 4328 ; w3 = last of current chp entry
4164 4328
4164 4328 rl w1 b1 ; w1 := cur;
4165 4330 se w0 j33 ; if command <> 'stop' then
4166 4332 jl. i15. ; goto next command;
4167 4334
4167 4334 ; (maybe it should be tested, that param 1 = 0, i.e. not a 'jump' ?)
4168 4334 ; rl w0 x2+j23 ;
4169 4334 ; se w0 0 ;
4170 4334 ; jl. jump-command
4171 4334
4171 4334
4171 4334 ; get the timeout-parameter from param 2 of the 'stop' command:
4172 4334 rl w0 x2+j24 ; timeout := param 2;
4173 4336
4173 4336 ; in case of transfer to/from senders area:
4174 4336 ; check that the sender is not stopped
4175 4336 ; increase stopcount to prevent further stopping of sender
4176 4336 ;
4177 4336 ; w0 = timeout
4178 4336 ; w1 = driver
4179 4336
4179 4336 rl. w3 h10. ; if sender area used then
4180 4338 sn w3 0 ;
4181 4340 jl. i40. ; begin
4182 4342
4182 4342 rl. w3 h17. ; sender := saved sender descr addr;
4183 4344 bz w2 x3+a13 ; if state(sender) shows
4184 4346 se w2 a99 ; 'waiting for start' then
4185 4348 sn w2 a100 ;
4186 4350 jl. i2. ; goto sender stopped;
4187 4352
4187 4352 bz w2 x3+a12 ; increase (stopcount (sender));
4188 4354 al w2 x2+1 ;
4189 4356 hs w2 x3+a12 ;
4190 4358 i40: ; end;
4191 4358
4191 4358 ; the driver should actually be put in such a state, that all pending
4192 4358 ; transfers would be aborted, in case the driver is stopped.
4193 4358 ; however, until further, this is only done by means of increasing
4194 4358 ; the stopcount of the driver ( *** independant of transfer/no transfer
4195 4358 ; to/from the driver area *** )
4196 4358 ;
4197 4358 ; w0 = timeout
4198 4358 ; w1 = driver
4199 4358 ; w3 = transfer code: 0 = no transfer to sender area
4200 4358 ; >0 = sender descr addr
4201 4358
4201 4358 c.-1 ; ++++ not implemented ++++
4202 4358 rl. w2 h11. ;
4203 4358 sn w2 0 ; if driver area not used then
4204 4358 jl. i41. ; goto init transfer code field;
4205 4358 z. ; ++++
4206 4358
4206 4358 al w3 x3+1 ; make transfer code odd; i.e. driver transfer
4207 4360
4207 4360 bz w2 x1+a12 ; increase (stopcount (driver) );
4208 4362 al w2 x2+1 ;
4209 4364 hs w2 x1+a12 ;
4210 4366
4210 4366 c. -1; ++++ not implemented
4211 4366 i41: sn w3 0 ; if no transfers to the involved processes then
4212 4366 al w3 -1 ; transfer code := -1; i.e. transfer pending;
4213 4366 z. ; ++++
4214 4366
4214 4366 ; initialize the 'transfer code' field in the device description
4215 4366 ; (the field will be used, when the interrupt arrives,
4216 4366 ; to decrease the involved stopcounts)
4217 4366 ; w0 = timeout, w1 = cur, w3 = transfer code
4218 4366 i50: rl. w2 h5. ;
4219 4368 rl w1 x2+a225 ; if transfer code (device descr) <> 0 then
4220 4370 se w1 0 ; goto internal 3;
4221 4372 jl c29 ; (i.e. transfer still in progress)
4222 4374 rs w3 x2+a225 ; move transfer code to device descr;
4223 4376
4223 4376 ; prepare timeout-operation:
4224 4376 ;
4225 4376 ; w0 = timeout
4226 4376 ; w2 = device descr
4227 4376
4227 4376 ; initialize controller table:
4228 4376 am (b1) ;
4229 4378 rl w3 +a31 ; entry:=logical device addr(device);
4230 4380 wa. w3 h25. ; + 1 < 23
4231 4382 wa w3 b65 ; base of controller table;
4232 4384
4232 4384 rl. w1 h20. ; chp start (controller table entry) :=
4233 4386 rs w1 x3+a310 ; abs first of channel program area;
4234 4388 se w1 0 ; if chpg start = 0 then
4235 4390 jl. i54. ; begin
4236 4392 al w2 x2+a242 ; oper:= timeout operation address;
4237 4394 jl. i53. ; goto check timeout;
4238 4396 ; end;
4239 4396
4239 4396 ; prepare for receiving an unusual status, i.e. in case the controller
4240 4396 ; could not deliver the standard status informations
4241 4396 i54: al w3 0 ;
4242 4398 rs w3 x2+a230 ; chp addr (std status) := 0;
4243 4400 al w3 j40 ;
4244 4402 rs w3 x2+a233 ; event status (std status) := status transfer error;
4245 4404
4245 4404 al w2 x2+a242 ; oper := timeout operation address;
4246 4406
4246 4406 ; start the device:
4247 4406 ;
4248 4406 ; at this point the monitor migth introduce another strategy,
4249 4406 ; instead of just starting the device immediatly.
4250 4406 ; if the interrupt numbers are sparce, or if the bus migth
4251 4406 ; get overloaded, the actual starting can be delayed until
4252 4406 ; the resources are sufficient.
4253 4406 ;
4254 4406 ; notice that the monitor/driver conventions do not imply that
4255 4406 ; the transfer is started at once, i.e. buserrors or bustimeout
4256 4406 ; etc. are not returned to the driver at the calltime, but
4257 4406 ; when the interrupt-operation is received by the driver.
4258 4406 ;
4259 4406 ; under any circumstances the driver should have the result 0,
4260 4406 ; indicating that the transfer has been accepted to start.
4261 4406 ;
4262 4406 ; w0 = timeout
4263 4406 ; w2 = timeout operation
4264 4406 am (b1) ; if function > 12 = 0 then
4265 4408 zl w1 +a28 ;
4266 4410 se w1 0 ;
4267 4412 jl. i56. ;
4268 4414 am (b1) ;
4269 4416 bz w1 +a31+1 ;
4270 4418 ls w1 -2 ; w1:=io-devno<1;
4271 4420 i56: do w1 (x2-a242+a235) ; start device(device addr(device desc));
4272 4422
4272 4422 sx 2.111 ; if any exceptions then
4273 4424 jl. i55. ; goto not started;
4274 4426
4274 4426 ; if the operation is in queue, there may be three reasons:
4275 4426 ; 1. a wait program is still in progress, i.e. in timeout-queue
4276 4426 ; (remove the operation and proceed, i.e. regret the wait-program)
4277 4426 ; 2. a wait program is terminated by an event, i.e. in event queue
4278 4426 ; (the operation may not be removed, because the driver has to
4279 4426 ; reset the controller in order to proceed)
4280 4426 ; 3. an uspecified channel program has terminated, i.e. in event queue
4281 4426 ; (this situation is treated as if it was a wait-program,
4282 4426 ; because it does not harm the monitor, but only confuses
4283 4426 ; the driver process)
4284 4426
4284 4426 i53: ; check timeout:
4285 4426 sn w2 (x2+0) ; if timeout operation in queue then
4286 4428 jl. i52. ; begin
4287 4430
4287 4430 ; search through the timeout-queue.
4288 4430 ; if the operation is found here, then simply remove it and proceed,
4289 4430 ; as if it had not been in queue
4290 4430 ; if not found here, it must be in the event-queue of the driver.
4291 4430 ; (just leave it there, because the driver must take proper action on it)
4292 4430
4292 4430 al w1 b69 ; elem := timeout-queue head;
4293 4432 i51: rl w1 x1+0 ; rep: elem := next(elem);
4294 4434 sn w1 b69 ; if end of timer-queue then
4295 4436 jl. i0. ; goto result 0; i.e. in event queue
4296 4438
4296 4438 se w1 x2 ; if elem = timeout operation then
4297 4440 jl. i51. ; goto rep;
4298 4442
4298 4442 ; found in timeout-queue:
4299 4442 jl w3 d5 ; remove(timeout operation);
4300 4444 i52: ; end;
4301 4444
4301 4444 ; w0 = timeout
4302 4444 ; w2 = timeout operation
4303 4444
4303 4444 al w1 b69 ; head := timeout queue head;
4304 4446 rs w0 x2-a242+a244; save timeout in timeout-field(operation);
4305 4448 se w0 0 ; if timeout <> 0 then
4306 4450 jl w3 d6 ; link (timeout queue, timeout operation);
4307 4452
4307 4452 jl. i0. ; goto result 0; i.e. transfer started ok;
4308 4454
4308 4454 ; the transfer could not actually be started, because of
4309 4454 ; some kind of bus/controller error.
4310 4454 ;
4311 4454 ; the interrupt operation must be returned to the driver,
4312 4454 ; together with indication of the kind of malfunction.
4313 4454 ;
4314 4454 ; w2 = linkfield of timeout operation
4315 4454 ; ex = error kind
4316 4454
4316 4454 i55: sx 2.1 ; errorkind :=
4317 4456 am 1-2 ; if rejected then 1
4318 4458 al w0 2 ; else 2;
4319 4460
4319 4460 al. w3 i0. ; deliver interrupt(oper, error kind);
4320 4462 jl d121 ; goto result 0;
4321 4464
4321 4464 e. ; end of start i/o;
4322 4464 c.a400-1
4323 4464 \f
4323 4464 m. coroutine monitor
4324 4464
4324 4464 ;************************** c o r o u t i n e m o n i t o r *************************
4325 4464
4325 4464
4325 4464
4325 4464 ; locations in process extension 1 are used by cmonprocedures as described below:
4326 4464 ;
4327 4464 ; -2: signalch
4328 4464 ; b27 +0: start
4329 4464 ; +2: check_eventqueue
4330 4464 ; +4: check_eventqueue
4331 4464 ; +6:
4332 4464 ; +8: generate_testoutput
4333 4464 ; +10: inspect_chained
4334 4464 ; +12: inspect_chained
4335 4464 ; +14: timermess
4336 4464 ; +16: timerscan
4337 4464 ; +18: timerscan
4338 4464 ; +20: generate_testoutput
4339 4464 ; +22: " - "
4340 4464 ; +24: " - "
4341 4464 \f
4341 4464 b.h50 w.
4342 4464
4342 4464 ; procedure remove(elem);
4343 4464 ;
4344 4464 ; removes a given element from its queue and leaves the element
4345 4464 ; linked to itself.
4346 4464 ;
4347 4464 ; call return
4348 4464 ; w0: - unchanged
4349 4464 ; w1: - next(elem)
4350 4464 ; w2: elem elem
4351 4464 ; w3: link link
4352 4464
4352 4464 h0: rl w1 x2 ; begin
4353 4464 rx w2 x2+2 ; prev(elem):= elem;
4354 4464 rs w1 x2 ; next(prev(elem)):= next(elem);
4355 4464 rx w2 x1+2 ; prev(next(elem)):= old prev(elem);
4356 4464 rs w2 x2 ; next(elem):= elem;
4357 4464 jl x3 ; end;
4358 4464
4358 4464
4358 4464
4358 4464 ; procedure link(head,elem);
4359 4464 ;
4360 4464 ; links the element to the end of the queue;
4361 4464 ;
4362 4464 ; call return
4363 4464 ; w0 - destroyed
4364 4464 ; w1 head head
4365 4464 ; w2 elem elem
4366 4464 ; w3 link old last(head)
4367 4464
4367 4464
4367 4464 h1: al w0 x3 ; begin
4368 4464 rl w3 x1+2 ; old prev:= last(head);
4369 4464 rs w2 x1+2 ; prev(head):= elem;
4370 4464 rs w2 x3+0 ; next(old prev):= elem;
4371 4464 rs w1 x2+0 ; next(elem):= head;
4372 4464 rs w3 x2+2 ; prev(elem):= old prev;
4373 4464 rl w3 0 ;
4374 4464 jl x3 ; end;
4375 4464 \f
4375 4464
4375 4464 ; procedure get_mess_ext(ref);
4376 4464 ;
4377 4464 ; returns a reference to the first free message buffer extension
4378 4464 ; or 0 if no extensions are available. the extension is removed from the chain.
4379 4464 ;
4380 4464 ; call return
4381 4464 ; w0: - destroyed
4382 4464 ; w1: - destroyed
4383 4464 ; w2: - ref or 0
4384 4464 ; w3: link link
4385 4464
4385 4464 b.j5 w.
4386 4464 h7: rl w1 b28 ; begin
4387 4464 rl w2 x1+a588 ; ref:= cur.ext2.buffer_extension_head;
4388 4464 sn w2 0 ; if ref <> 0 then
4389 4464 jl. j0. ; begin
4390 4464 rl w0 x2 ; cur.ext2.buffer_extension_head:= next(ref);
4391 4464 rs w0 x1+a588 ;
4392 4464
4392 4464 al w2 x2+2 ; ref:= ref+2;
4393 4464 ; end;
4394 4464 j0: jl x3 ; end;
4395 4464 e.
4396 4464
4396 4464 \f
4396 4464 ; procedure answer arrived(buf,ref);
4397 4464 ;
4398 4464 ; is called from procedure 'check_event_queue' when an answer appears in
4399 4464 ; the event queue and 'ref.open' is true, i. e. when a coroutine has
4400 4464 ; called 'cwaitanswer(buf)'. the coroutine is activated and the answer
4401 4464 ; descriptor is closed.
4402 4464 ;
4403 4464 ; call return
4404 4464 ; w0: - destroyed
4405 4464 ; w1: ref destroyed
4406 4464 ; w2: buf buf
4407 4464 ; w3: link link
4408 4464
4408 4464 b.j5 w.
4409 4464 c106: am (b27) ; begin
4410 4464 ds w3 +6 ; ext1(4,6):= (buf,link);
4411 4464 am (b28) ;
4412 4464 rl w3 +a544 ;
4413 4464 sn w3 0 ; if testoutput active
4414 4464 jl. j0. ; then generate testoutput(1<6);
4415 4464 jl. w3 h4. ;
4416 4464 3<22+1<6 ;
4417 4464 j0: al w0 0 ;
4418 4464 hs w0 x1 ; ref.open:= false;
4419 4464 rl w2 x1+2 ; corout:= ref.param1;
4420 4464 al w1 1 ; result:= ok;
4421 4464 rl w0 x2+a698 ; priority:= corout.priority;
4422 4464 jl. w3 c100. ; start(corout,priority,ok);
4423 4464 am (b27) ;
4424 4464 dl w3 +6 ; (buf,link):= ext1(4,6);
4425 4464 jl x3 ; end;
4426 4464 e.
4427 4464
4427 4464 \f
4427 4464 ; procedure central wait;
4428 4464 ;
4429 4464 ; central waiting point in coroutine system. checks the eventqueue
4430 4464 ; and schedules pending events. if the active queue is empty the
4431 4464 ; monitor procedure wait event is called otherwise the first co-
4432 4464 ; routine is started. if 'corout.user_exit' <> 0 a jump to 'user_exit' is
4433 4464 ; made with register contents:
4434 4464 ; w0: -
4435 4464 ; w1: -
4436 4464 ; w2: current_coroutine
4437 4464 ; w3: link
4438 4464
4438 4464
4438 4464 b.j5
4439 4464 w.
4440 4464 h2: ; begin
4441 4464 ; repeat
4442 4464 j0: jl. w3 h6. ; check event queue;
4443 4464 rl w2 b28 ; if active queue empty then
4444 4464 rl w3 x2+a546 ; begin
4445 4464 se w3 x2+a546 ; buf:= cur.ext2.last event;
4446 4464 jl. j1. ; wait event(buf,result);
4447 4464 rl w2 x2+a582 ;
4448 4464 jd 1<11+24 ;
4449 4464 jl. j0. ;
4450 4464 ; end;
4451 4464 j1: al w2 x3-2 ; until active queue not empty;
4452 4464 rs w2 (b28) ; corout:= first in active queue;
4453 4464 rl w1 x2+a720 ; if corout.user_exit <> 0
4454 4464 se w1 0 ; then jump to user_exit;
4455 4464 jl w3 x1 ;
4456 4464 rl w3 (b28) ;
4457 4464 dl w1 x3+a712 ;
4458 4464 rl w2 x3+a714 ; restart corout;;
4459 4464 jl (x3) ; end;
4460 4464 e.
4461 4464 \f
4461 4464
4461 4464
4461 4464 ; procedure check eventqueue;
4462 4464 ;
4463 4464 ; inspects the eventqueue starting at 'last event'('last event' = 0
4464 4464 ; if the queue must be inspected from the start). pending events
4465 4464 ; which have arrived after 'last event' are scheduled if
4466 4464 ; 'event descriptor.open' = true. the scheduling is performed by calling
4467 4464 ; either a 'cmon'-standard procedure (even procedure number in event
4468 4464 ; descriptor) or a user defined procedure (odd procedure number which
4469 4464 ; is used as index in the procedure table in process extension 2).
4470 4464 ;
4471 4464
4471 4464 ; a procedure ('user' or 'cmon') which is used for scheduling answers or messages
4472 4464 ; must return with w2=0 if the answer/message is removed from the event queue
4473 4464 ; - otherwise with w2='buf' ; i. e. the event queue must be inspected from the
4474 4464 ; start when an event is removed by a scheduling procedure.
4475 4464
4475 4464 ; exit to 'cmon'- or user-procedure with:
4476 4464 ; w0: -
4477 4464 ; w1: ref(event descriptor)
4478 4464 ; w2: buf
4479 4464 ; w3: link
4480 4464
4480 4464 b. j10 w.
4481 4464 h6: am (b27) ; begin
4482 4464 rs w3 +2 ; ext1(2):= link;
4483 4464 rl w3 b28 ;
4484 4464 rl w2 x3+a582 ; last_buf:= cur.ext2.last_event;
4485 4464 j0: jd 1<11+66 ; repeat
4486 4464 rl w3 b28 ;
4487 4464 sh w0 -1 ; test_event(last_buf,buf,result);
4488 4464 jl. j5. ; if result <> empty then
4489 4464 se w0 0 ; begin
4490 4464 jl. j2. ; if result = message
4491 4464 rl w1 x2+4 ;
4492 4464 ac w1 x1 ;
4493 4464 se w1 (b1) ; then ref:=
4494 4464 jl. j1. ; if buf.receiver = cur then cur.ext2.messdescr
4495 4464 rl w1 x3+a584 ; else buf.receiver.messdescr <* pseudoprocess *>
4496 4464 jl. j2. ;
4497 4464 j1: rl w1 x1+a60 ; else <* answer *> ref:= buf.ref;
4498 4464 j2: hl w0 x1 ;
4499 4464 sn w0 0 ;
4500 4464 jl. j0. ; if ref.open then
4501 4464 hl w0 x1+1 ; begin
4502 4464 sz w0 1 ; if even procedure number
4503 4464 jl. j3. ; then call cmonproc(buf,ref);
4504 4464 am (0) ;
4505 4464 jl w3 (130) ;
4506 4464 jl. j0. ; else
4507 4464 j3: ; begin <* odd procedure number *>
4508 4464 rl w3 x3+a586 ; <* use procedure number in event *>
4509 4464 hl w0 x1+1 ; <* descriptor as index in proce- *>
4510 4464 ls w0 +1 ; <* dure table in cur.ext2 *>
4511 4464 wa w0 x3 ;
4512 4464 am (0) ;
4513 4464 jl w3 (0) ; call userproc(buf,ref);
4514 4464 jl. j0. ; end;
4515 4464 ; end;
4516 4464 ; end;
4517 4464 ; until result = empty;
4518 4464 j5: sn w2 0 ; <* if 'last_buf' points at a message , 'last_event'
4519 4464 jl. j6. ; <* must be reset as the message may be regretted
4520 4464 rl w0 x2+4 ; <* before next scan.
4521 4464 se w0 0 ;
4522 4464 sz w0 -8 ; cur.ext2.last_event:= if last_buf points at message
4523 4464 al w2 0 ; then 0
4524 4464 j6: rs w2 x3+a582 ; else last_buf;
4525 4464 am (b27) ; link:= ext1(2);
4526 4464 jl (2) ; end;
4527 4464 e.
4528 4464 \f
4528 4464
4528 4464
4528 4464 ; procedure entry pass(priority);
4529 4464 ;
4530 4464 ; pending events are scheduled and calling coroutine is restarted
4531 4464 ; with the priority given in call.
4532 4464 ;
4533 4464 ; call return
4534 4464 ; w0: priority destroyed
4535 4464 ; w1: - destroyed
4536 4464 ; w2: - destroyed
4537 4464 ; w3: link current coroutine
4538 4464
4538 4464 b.j5 w.
4539 4464 c102: am (b28) ; begin
4540 4464 rs w3 (0) ; current_coroutine.ic:= link;
4541 4464 am (b28) ;
4542 4464 rl w3 +a544 ;
4543 4464 sn w3 0 ; if testoutput active
4544 4464 jl. j0. ; then generate testoutput(testkind);
4545 4464 jl. w3 h4. ;
4546 4464 3<22+1<2 ;
4547 4464 j0: rl w2 (b28) ;
4548 4464 rl w1 x2+a710 ; result:= current_coroutine.result;
4549 4464 jl. w3 c100. ; start(current_coroutine,priority,result);
4550 4464 jl. h2. ; central wait;
4551 4464 e. ; end;
4552 4464 \f
4552 4464
4552 4464 ; procedure entry inspect(priority,result);
4553 4464 ;
4554 4464 ; schedules pending events and checks if the active queue contains
4555 4464 ; coroutines with priority higher than the call parameter 'priority'. in
4556 4464 ; this case 'result' returns true (1).
4557 4464 ;
4558 4464 ; call return
4559 4464 ; w0: priority result
4560 4464 ; w1: - destroyed
4561 4464 ; w2: - destroyed
4562 4464 ; w3: link current coroutine
4563 4464
4563 4464 b.j5 w.
4564 4464 c103: am (b28) ; begin
4565 4464 rs w3 (0) ; current_coroutine.ic:= link;
4566 4464 am (b28) ;
4567 4464 rl w3 +a544 ;
4568 4464 sn w3 0 ; if testoutput is active then
4569 4464 jl. j0. ; generate testoutput(1<3);
4570 4464 jl. w3 h4. ;
4571 4464 3<22+1<3 ;
4572 4464 j0: rs w0 (b27) ; ext1(0):= priority;
4573 4464 jl. w3 h6. ; check_event_queue;
4574 4464 rl w0 (b27) ; priority:= ext1(0);
4575 4464 rl w3 b28 ;
4576 4464 rl w3 x3+a546 ; corout:= first in active queue;
4577 4464 sl w0 (x3-4) ;
4578 4464 am -1 ; result:= corout.prio > priority;
4579 4464 al w0 1 ;
4580 4464 rl w3 (b28) ;
4581 4464 jl (x3) ; end;
4582 4464 e.
4583 4464
4583 4464 \f
4583 4464 ; procedure entry start(corout,priority,result);
4584 4464 ;
4585 4464 ; removes the coroutine from its queue (normally the timer queue) and
4586 4464 ; inserts it in active queue according to the call parameter 'priority'.
4587 4464 ; the call parameter 'result' is returned in w0 of
4588 4464 ; the coroutine which is activated.
4589 4464 ;
4590 4464 ; call return
4591 4464 ; w0: priority destroyed
4592 4464 ; w1: result destroyed
4593 4464 ; w2: corout corout
4594 4464 ; w3: link current coroutine
4595 4464
4595 4464 b.j5
4596 4464 w.
4597 4464 c100: rs w3 (b27) ; begin
4598 4464 am (b28) ;
4599 4464 rl w3 +a544 ;
4600 4464 sn w3 0 ; if testoutput is active then
4601 4464 jl. j0. ; generate testoutput(1<0);
4602 4464 jl. w3 h4. ;
4603 4464 3<22+1<0 ;
4604 4464 j0: rs w1 x2+a710 ; corout.result:= result;
4605 4464 rs w0 x2+a698 ; corout.priority:= priority;
4606 4464 al w2 x2+2 ;
4607 4464 jl. w3 h0. ; remove(corout);
4608 4464 rl w1 0 ;
4609 4464 al w0 x2 ;
4610 4464 rl w2 b28 ; worse:= rear of active queue;
4611 4464 al w3 x2+a546 ; while worse.prio > prio and
4612 4464 al w1 x1+1 ; worse <> active queue head do
4613 4464 j1: rl w3 x3+2 ; worse:= prev(worse);
4614 4464 sn w3 x2+a546 ;
4615 4464 jl. j2. ; 'insert corout in the rear of
4616 4464 sh w1 (x3-4) ; other coroutines of the same
4617 4464 jl. j1. ; priority'
4618 4464 j2: rl w1 x3 ;
4619 4464 rl w2 0 ;
4620 4464 jl. w3 h1. ; link(worse,corout);
4621 4464 al w2 x2-2 ;
4622 4464
4622 4464 rl w3 (b28) ;
4623 4464 am (b27) ;
4624 4464 jl (0) ; end;
4625 4464 e.
4626 4464
4626 4464 \f
4626 4464 ; procedure entry wait(timer,result);
4627 4464 ;
4628 4464 ; calling coroutine is suspended for max 'timer' seconds.
4629 4464 ; 'timer' = 0 indicates no timeout. the return parameter 'result'
4630 4464 ; indicates whether the coroutine was started by timeout or by
4631 4464 ; the arrival of an internal or external event.
4632 4464 ;
4633 4464 ; call return
4634 4464 ; w0: timer result
4635 4464 ; w1: - destroyed
4636 4464 ; w2: - -
4637 4464 ; w3 link current coroutine
4638 4464
4638 4464 b.j5
4639 4464 w.
4640 4464 c101: am (b28) ; begin
4641 4464 rs w3 (0 ) ; current coroutine.return:= link;
4642 4464 am (b28) ;
4643 4464 rl w3 +a544 ;
4644 4464 sn w3 0 ; if testoutput active then
4645 4464 jl. j0. ; generate testoutput(1<1);
4646 4464 jl. w3 h4. ;
4647 4464 3<22+1<1 ;
4648 4464 j0: rl w2 (b28) ; current coroutine.timer:= timer;
4649 4464 rs w0 x2+a706 ;
4650 4464 al w2 x2+2 ;
4651 4464 jl. w3 h0. ; remove(current coroutine);
4652 4464 rl w3 b28 ;
4653 4464 al w1 x3+a552 ;
4654 4464 jl. w3 h1. ; link(timer queue head,current coroutine);
4655 4464 jl. h2. ; central wait;
4656 4464 ; end;
4657 4464 e.
4658 4464
4658 4464 \f
4658 4464 ; procedure entry csendmessage(mess,name,buf);
4659 4464 ;
4660 4464 ; allocates a message buffer extension and prepares it for cwaitanswer.
4661 4464 ; then calls sendmessage.
4662 4464 ;
4663 4464 ; return parameter 'buf': 0 buffer claims exceeded
4664 4464 ; 1 no free extensions
4665 4464 ; >1 message buffer address
4666 4464 ;
4667 4464 ; call return
4668 4464 ; w0: - destroyed
4669 4464 ; w1: mess destroyed
4670 4464 ; w2: name buffer address (or 0 or 1)
4671 4464 ; w3: link current coroutine
4672 4464
4672 4464 b.j5,i5 w.
4673 4464 c104: am (b28) ; begin
4674 4464 rs w3 (0) ; current_coroutine.ic:= link;
4675 4464 am (b28) ;
4676 4464 rl w3 +a544 ;
4677 4464 sn w3 0 ;
4678 4464 jl. j0. ; if testoutput active
4679 4464 jl. w3 h4. ; then generate_testoutput(1<4);
4680 4464 3<22+1<4 ;
4681 4464 j0: ds w2 (b27) ;
4682 4464 jl. w3 h7. ; get_mess_ext(ref);
4683 4464 sn w2 0 ; if ref <> 0 <* extension available *> then
4684 4464 jl. j1. ; begin
4685 4464 rl. w0 i0. ; <* initialize answer descriptor *>
4686 4464 rs w0 x2 ; ref.open:= false; ref.proc:= 12;
4687 4464 rl w3 b27 ;
4688 4464 rs w2 x3+2 ; ext1(2):= ref;
4689 4464 rl w1 x3-2 ;
4690 4464 rl w3 x3 ; send message(mess,name,buf,ref);
4691 4464 jd 1<11+16 ;
4692 4464 se w2 0 ; if buffer claims exceeded
4693 4464 jl. j2. ; then release message buffer extension;
4694 4464 am (b27) ;
4695 4464 rl w1 (+2) ;
4696 4464 rl w3 b28 ;
4697 4464 al w0 x1-2 ;
4698 4464 rx w0 x3+a588 ;
4699 4464 rs w0 x1-2 ;
4700 4464 jl. j2. ;
4701 4464 j1: al w2 1 ; end
4702 4464 j2: rl w3 (b28) ; else buf:= 1; <* no free extensions *>
4703 4464 jl (x3) ; end;
4704 4464
4704 4464 i0: 0<12+12 ; answer descriptor init (open=false,proc='answer_arrived')
4705 4464 e.
4706 4464
4706 4464 \f
4706 4464 ; procedure entry cwaitanswer(buf,timer,result);
4707 4464 ;
4708 4464 ; prepares the message buffer extension for receiving the answer. if
4709 4464 ; the buffer has been answered, 'last_event' is reset as the buffer
4710 4464 ; may have been skipped during an earlier inspection of the event queue.
4711 4464 ; the coroutine waits for max. 'timer' seconds for the answer. when the
4712 4464 ; coroutine is restarted the action depends on 'result':
4713 4464 ;
4714 4464 ; result = timeout : the answer descriptor is closed
4715 4464 ;
4716 4464 ; result = answer arrived : the answer is received in the answer
4717 4464 ; area in process extension 2 and the message
4718 4464 ; buffer extension is released.
4719 4464 ;
4720 4464 ; call return
4721 4464 ; w0: timer result (timeout:0,wait_answer result:1,2,3,4,5)
4722 4464 ; w1: - answer area in ext2 if result <> timeout
4723 4464 ; w2: buf buf
4724 4464 ; w3: link current coroutine
4725 4464
4725 4464 b.j10 w.
4726 4464 c105: rs w3 (b27) ; begin
4727 4464 am (b28) ;
4728 4464 rl w3 +a544 ;
4729 4464 sn w3 0 ;
4730 4464 jl. j0. ; if testoutput active
4731 4464 jl. w3 h4. ; then generate_testoutput(1<5);
4732 4464 3<22+1<5 ;
4733 4464 j0: rl w3 (b28) ;
4734 4464 rl w1 (b27) ; current_coroutine.return:= link;
4735 4464 ds w2 x3+a724 ; current_coroutine.buf:= buf;
4736 4464 rs w0 (b27) ; ext1(0):= timer;
4737 4464 rl w1 x2-2 ; with buf.ref do
4738 4464 al w0 1 ; begin
4739 4464 hs w0 x1 ; open:= true;
4740 4464 rs w3 x1+2 ; corout:= current_coroutine;
4741 4464 ; end;
4742 4464 rl w0 x2+4 ;
4743 4464 sz w0 -8 ; if buf.state = answer pending
4744 4464 jl. j1. ; then last_event:= 0; <* inspect from start *>
4745 4464 al w0 0 ;
4746 4464 am (b28) ;
4747 4464 rs w0 +a582 ;
4748 4464 j1: rl w0 (b27) ; timer:= ext1(0);
4749 4464 jl. w3 c101. ; wait(timer,result);
4750 4464 rl w2 x3+a724 ; buf:= current_coroutine.buf;
4751 4464 rl w1 x2-2 ; ref:= buf.ref;
4752 4464 se w0 0 ; if result = timeout
4753 4464 jl. j2. ; then ref.open:= false
4754 4464 hs w0 x1 ;
4755 4464 jl. j4. ; else
4756 4464 j2: ; begin <* result = answer arrived *>
4757 4464 rl w3 b28 ; release message buffer extension;
4758 4464 al w0 x1-2 ;
4759 4464 rx w0 x3+a588 ;
4760 4464 rs w0 x1-2 ;
4761 4464 se w2 (x3+a582) ;
4762 4464 jl. j3. ;
4763 4464 al w0 0 ; if buf = last_event then last_event:= 0;
4764 4464 rs w0 x3+a582 ;
4765 4464 j3: al w1 x3+a590 ;
4766 4464 jd 1<11+18 ; wait answer(buf,cur.ext2.answer_area);
4767 4464 j4: rl w3 (b28) ; end;
4768 4464 jl (x3+a722) ; end;
4769 4464 e. ; end;
4770 4464
4770 4464 \f
4770 4464 ; procedure entry signal binary(sem);
4771 4464 ; procedure entry signal(sem);
4772 4464 ;
4773 4464 ; call return
4774 4464 ; w0: - destroyed
4775 4464 ; w1: - destroyed
4776 4464 ; w2: sem destroyed
4777 4464 ; w3: link current coroutine
4778 4464
4778 4464 b.j5 w.
4779 4464 c107: am 1 ; signal_binary:
4780 4464 c108: al w0 0 ; signal:
4781 4464 am (b28) ; begin
4782 4464 rs w3 (0) ;
4783 4464 am (b28) ;
4784 4464 rl w3 +a544 ;
4785 4464 sn w3 0 ; if testoutput active
4786 4464 jl. j0. ; then generate_testoutput(1<7);
4787 4464 jl. w3 h4. ;
4788 4464 3<22+1<7 ;
4789 4464 j0: rl w1 x2+4 ; with sem do
4790 4464 al w3 x1+1 ; begin
4791 4464 se w0 0 ; count:= count+1;
4792 4464 la w3 0 ; if binary
4793 4464 rs w3 x2+4 ; then count:= count and 1;
4794 4464 sl w1 0 ; if count <= 0 then
4795 4464 jl. j1. ; begin
4796 4464 rl w2 x2 ; corout:= next(sem);
4797 4464 jl. w3 h0. ; remove(corout);
4798 4464 al w2 x2+6 ;
4799 4464 rl w0 x2+a698 ; priority:= corout.prio;
4800 4464 al w1 1 ; result:= ok;
4801 4464 jl. w3 c100. ; start(corout,priority,result);
4802 4464 j1: rl w3 (b28) ; end;
4803 4464 jl (x3) ; end;
4804 4464 e. ; end;
4805 4464
4805 4464 \f
4805 4464 ; procedure entry wait_semaphore(sem);
4806 4464 ;
4807 4464 ; call return
4808 4464 ; w0: - destroyed
4809 4464 ; w1: - destroyed
4810 4464 ; w2: sem destroyed
4811 4464 ; w3: link current coroutine
4812 4464
4812 4464 b.j5 w.
4813 4464 c109: am (b28) ; begin
4814 4464 rs w3 (0) ;
4815 4464 am (b28) ;
4816 4464 rl w3 +a544 ;
4817 4464 sn w3 0 ; if testoutput active
4818 4464 jl. j0. ; then generate_testoutput(1<8);
4819 4464 jl. w3 h4. ;
4820 4464 3<22+1<8 ;
4821 4464 j0: rl w1 x2+4 ; with sem do
4822 4464 al w1 x1-1 ; begin
4823 4464 rs w1 x2+4 ; count:= count-1;
4824 4464 rl w3 (b28) ;
4825 4464 sl w1 0 ; if count < 0 then
4826 4464 jl (x3) ; begin
4827 4464 rl w1 x3 ;
4828 4464 rs w1 x3+a722 ; current_coroutine.return:= link;
4829 4464 al w1 x2 ; head:= sem.coroutine_queue_head;
4830 4464 al w2 x3-6 ; elem:= current_coroutine.sem_queue_elem;
4831 4464 jl. w3 h1. ; link(head,elem);
4832 4464 al w0 0 ; timer:= 0 <* no timeout *>
4833 4464 jl. w3 c101. ; wait(timer);
4834 4464 rl w3 (b28) ; end;
4835 4464 jl (x3+a722) ; end with;
4836 4464 e. ; end;
4837 4464
4837 4464 \f
4837 4464 ; procedure entry signal_chained(sem,oper);
4838 4464 ;
4839 4464 ; signals an operation to a chained semaphore. if the coroutine queue of
4840 4464 ; the semaphore contains a coroutine which is waiting for an operation
4841 4464 ; of this type,the coroutine is started. otherwise the operation is
4842 4464 ; queued to the semaphore.
4843 4464 ;
4844 4464 ; two reserved types exist:
4845 4464 ; 1<0: message
4846 4464 ; 1<1: answer
4847 4464 ;
4848 4464 ; call return
4849 4464 ; w0: - destroyed
4850 4464 ; w1: operation destroyed
4851 4464 ; w2: semaphore destroyed
4852 4464 ; w3: link current coroutine
4853 4464
4853 4464 b.j10 w.
4854 4464 c110: am (b27) ; begin
4855 4464 rs w3 -2 ;
4856 4464 am (b28) ;
4857 4464 rl w3 +a544 ;
4858 4464 sn w3 0 ;
4859 4464 jl. j0. ; if testoutput active
4860 4464 jl. w3 h4. ; then generate_testoutput(1<9);
4861 4464 3<22+1<9 ;
4862 4464 j0: rl w3 x2 ; head:= sem.coroutine_queue_head;
4863 4464 j1: sn w3 x2 ; corout:= next(head); found:= false;
4864 4464 jl. j4. ; while corout <> head and -, found do
4865 4464 rl w0 x3-a694+a708; if logand(corout.mask,oper.type) <> 0 then
4866 4464 la w0 x1+4 ; begin
4867 4464 se w0 0 ;
4868 4464 jl. j3. ; found:= true;
4869 4464 rl w3 x3 ;
4870 4464 jl. j1. ;
4871 4464 j3: rs w1 x3-a694+a724; corout.latop:= operation;
4872 4464 rl w0 x1+4 ; type:= oper.type;
4873 4464 al w2 x3 ;
4874 4464 jl. w3 h0. ; remove(corout);
4875 4464 al w2 x2-a694 ;
4876 4464 rl w1 0 ; result:= type;
4877 4464 rl w0 x2+a698 ; priority:= corout.prio;
4878 4464 jl. w3 c100. ; start(corout,priority,result);
4879 4464 jl. j5. ; end
4880 4464 ; else corout:= next(corout);
4881 4464 j4: rx w2 2 ; if -,found
4882 4464 al w1 x1+4 ; then link(sem.operation_queue,oper);
4883 4464 jl. w3 h1. ;
4884 4464 j5: rl w3 (b28) ;
4885 4464 am (b27) ;
4886 4464 jl (-2) ; end;
4887 4464 e.
4888 4464
4888 4464 \f
4888 4464 ; procedure entry inspect_chained(sem,mask,oper,result);
4889 4464 ;
4890 4464 ; checks if 'sem_operation_queue' contains an operation which matches 'mask'.
4891 4464 ; if no matching operation is found, 'oper' returns = 0,
4892 4464 ; otherwise 'oper' refers to the first matching operation.
4893 4464 ; 'result' returns 'true' (1) if the active queue contains coroutines of
4894 4464 ; priorities higher than the priority of calling coroutine.
4895 4464 ;
4896 4464 ; call return
4897 4464 ; w0: - (result= 0,1)
4898 4464 ; w1: mask oper or 0
4899 4464 ; w2: sem sem
4900 4464 ; w3: link current coroutine
4901 4464
4901 4464 b.j10 w.
4902 4464 c111: am (b28) ; begin
4903 4464 rs w3 (0) ;
4904 4464 am (b28) ;
4905 4464 rl w3 +a544 ;
4906 4464 sn w3 0 ; if testoutput active
4907 4464 jl. j0. ; then generate_testoutput(1<10);
4908 4464 jl. w3 h4. ;
4909 4464 3<22+1<10 ;
4910 4464 j0: am (b27) ;
4911 4464 rs w2 +12 ; save(sem);
4912 4464 al w0 x1 ;
4913 4464 rl w1 x2+4 ; head:= sem.operation_queue_head;
4914 4464 j1: ; oper:= next(head); found:= false;
4915 4464 sn w1 x2+4 ; while oper <> head and -,found do
4916 4464 jl. j3. ; if logand(oper.type,mask) <> 0
4917 4464 rl w3 x1+4 ; then found:= true
4918 4464 la w3 0 ; else oper:= next(oper);
4919 4464 se w3 0 ;
4920 4464 jl. j4. ;
4921 4464 rl w1 x1 ;
4922 4464 jl. j1. ;
4923 4464 j3: al w1 0 ; if -,found then oper:= 0;
4924 4464 j4: rl w3 (b28) ;
4925 4464 rl w0 x3+a698 ; priority:= current_coroutine.prio;
4926 4464 rl w2 b28 ;
4927 4464 rl w2 x2+a546 ; corout:= first in active queue;
4928 4464 sh w0 (x2-4) ;
4929 4464 am -1 ;
4930 4464 al w0 1 ; result:= corout.prio > priority;
4931 4464 am (b27) ;
4932 4464 rl w2 +12 ;
4933 4464 jl (x3) ; end;
4934 4464 e.
4935 4464
4935 4464 \f
4935 4464 ; procedure entry wait_chained(sem,mask,timer,oper);
4936 4464 ;
4937 4464 ; if 'sem.operation_queue' contains an operation
4938 4464 ; which matches 'mask', the operation is removed from the queue . a 'pass'
4939 4464 ; is executed if the active queue contains coroutines of priorities higher
4940 4464 ; than the priority of calling coroutine. if no matching operation is found
4941 4464 ; pending events are scheduled and the calling coroutine waits for max. 'timer'
4942 4464 ; seconds for an operation to arrive.
4943 4464 ;
4944 4464 ; if the operation contains a message or an answer ('oper.type' = 1<0 or 1<1 ,
4945 4464 ; resp ) , the buffer contents is copied to the common message-answer area in
4946 4464 ; process extension 2. a buffer containing an answer is removed from the event
4947 4464 ; queue by 'waitanswer'.
4948 4464 ;
4949 4464 ;
4950 4464 ; call return
4951 4464 ; w0: timer result ( 0(timeout) or oper.type)
4952 4464 ; w1: mask oper (undefined if result = timeout)
4953 4464 ; w2: sem destr.
4954 4464 ; w3: link current_coroutine
4955 4464
4955 4464 b.j10 w.
4956 4464 c112: rs w3 (b27) ; begin
4957 4464 am (b28) ;
4958 4464 rl w3 +a544 ;
4959 4464 sn w3 0 ; if testoutput active
4960 4464 jl. j0. ; then generate_testoutput(1<11);
4961 4464 jl. w3 h4. ;
4962 4464 3<22+1<11 ;
4963 4464 j0: rx w1 (b27) ;
4964 4464 rl w3 (b28) ;
4965 4464 rs w1 x3+a722 ; current_coroutine.return:= link;
4966 4464 rx w1 (b27) ; current_coroutine.waitch_mask:= mask;
4967 4464 ds w1 x3+a708 ; current_coroutine.timer:= timer;
4968 4464 jl. w3 c111. ; inspect_chained(sem,mask,oper,result);
4969 4464 se w1 0 ; if oper = 0 then
4970 4464 jl. j1. ; begin <* wait in semaphore queue *>
4971 4464 al w1 x2 ; head:= sem.coroutine_queue_head;
4972 4464 al w2 x3+a694 ; elem:= current_coroutine.sem_queue_elem;
4973 4464 jl. w3 h1. ; link(head,elem);
4974 4464 rl w0 x2-a694+a706 ; timer:= current_coroutine.timer;
4975 4464 jl. w3 c101. ; wait(timer,result);
4976 4464 se w0 0 ; if result = timeout then
4977 4464 jl. j3. ; begin
4978 4464 rs w0 x3+a710 ; current_coroutine.result:= timeout;
4979 4464 al w2 x3+a694 ; elem:= current_coroutine.sem_queue_elem;
4980 4464 jl. w3 h0. ; remove(elem);
4981 4464 jl. j6. ; goto exit;
4982 4464 ; end;
4983 4464 ; end;
4984 4464 j1: rs w1 x3+a724 ; current_coroutine.latop:= oper;
4985 4464 rl w2 x1+4 ;
4986 4464 rs w2 x3+a710 ; current_coroutine.result:= oper.type;
4987 4464 al w2 x1 ;
4988 4464 jl. w3 h0. ; remove(oper);
4989 4464 rl w3 (b28) ; if waiting <* coroutines of higher
4990 4464 sn w0 0 ; priority in active queue *> then
4991 4464 jl. j2. ; begin
4992 4464 rl w0 x3+a698 ; priority:= current_coroutine.prio;
4993 4464 jl. w3 c102. ; pass(priority);
4994 4464 ; end;
4995 4464 j2: rl w0 x3+a710 ;
4996 4464 j3: sz w0 -4 ; if oper.type = message or answer then
4997 4464 jl. j6. ; begin
4998 4464 rl w2 x3+a724 ; oper:= current_coroutine.latop;
4999 4464 rl w3 b28 ;
5000 4464 rl w2 x2+8 ; buf:= oper.buf;
5001 4464 se w0 1<1 ; if oper.type = answer then
5002 4464 jl. j5. ; begin
5003 4464 se w2 (x3+a582) ;
5004 4464 jl. j4. ; if buf = last_event
5005 4464 al w0 0 ; then last_event:= 0;
5006 4464 rs w0 x3+a582 ;
5007 4464 j4: al w1 x3+a590 ; area:= common message-answer area;
5008 4464 jd 1<11+18 ; waitanswer(buf,area);
5009 4464 jl. j6. ; end
5010 4464 j5: al w1 x3+a590 ; else
5011 4464 dl w0 x2+10 ; begin <* message *>
5012 4464 ds w0 x1+2 ;
5013 4464 dl w0 x2+14 ;
5014 4464 ds w0 x1+6 ;
5015 4464 dl w0 x2+18 ; <* copy to common massage-answer area *>
5016 4464 ds w0 x1+10 ;
5017 4464 dl w0 x2+22 ;
5018 4464 ds w0 x1+14 ; end;
5019 4464 ; end;
5020 4464 j6: rl w3 (b28) ; exit:
5021 4464 rl w0 x3+a710 ; result:= current_coroutine.result;
5022 4464 rl w1 x3+a724 ; oper:= current_coroutine.latop; <* undef if timeout *>
5023 4464 jl (x3+a722) ;
5024 4464 e. ; end;
5025 4464
5025 4464 \f
5025 4464 ; procedure entry sem_sendmessage(name,message,oper,sem.result);
5026 4464 ;
5027 4464 ; sends a massage to the process given by 'name'. when the answer arrives
5028 4464 ; it is signalled to the chained semaphore 'sem'. the calling coroutine must
5029 4464 ; provide the operation 'oper' which is used as:
5030 4464 ;
5031 4464 ; 1) message_buffer_extension and 2) answer_operation(sem_answer_proc)
5032 4464 ; -6 (next operation) oper +0 next operation
5033 4464 ; -4 (prev operation) +2 prev operation
5034 4464 ; -2 (type) +4 type=answer(1<1)
5035 4464 ; ext. +0 open,'sem_answer_proc' +6 -
5036 4464 ; +2 answer_sem +8 buffer address
5037 4464 ;
5038 4464 ;
5039 4464 ; call return
5040 4464 ; w0: sem destr.
5041 4464 ; w1: params destr.
5042 4464 ; w2: oper buffer addres ( or 0 = claims exceeded )
5043 4464 ; w3: link current coroutine
5044 4464 ;
5045 4464 ; 'params' points at a parameter area containing:
5046 4464 ;
5047 4464 ; params +0: name(1)
5048 4464 ; +2: name(2)
5049 4464 ; +4: name(3)
5050 4464 ; +6: name(4)
5051 4464 ; +8: name table address
5052 4464 ; +10: mess(1)
5053 4464 ; +12: mess(2)
5054 4464 ; etc.
5055 4464
5055 4464 b.j5,i5 w.
5056 4464 c113: am (b28) ; begin
5057 4464 rs w3 (0) ;
5058 4464 am (b28) ;
5059 4464 rl w3 +a544 ;
5060 4464 sn w3 0 ; if testoutput active
5061 4464 jl. j0. ; then generate_testoutput(1<12);
5062 4464 jl. w3 h4. ;
5063 4464 3<22+1<12 ;
5064 4464 j0: rs w0 (b27) ; with oper.answer_descriptor do
5065 4464 rl. w0 i0. ; begin
5066 4464 rs w0 x2+6 ; proc:= sem_answerproc;
5067 4464 rl w0 (b27) ; open:= true;
5068 4464 rs w0 x2+8 ; answer_sem:= sem;
5069 4464 al w3 x1 ; end;
5070 4464 al w1 x1+10 ; name_address:= params;
5071 4464 ; message_address:= params+10;
5072 4464 al w2 x2+6 ; ref:= oper.answer_descriptor;
5073 4464 jd 1<11+16 ; sendmessage(name_addres,message_address,ref,result);
5074 4464 rl w3 (b28) ;
5075 4464 jl (x3) ; end;
5076 4464
5076 4464 i0: 1<12+28 ; answer_descriptor init;
5077 4464
5077 4464 e.
5078 4464
5078 4464 \f
5078 4464 ; procedure sem_answer_proc(ref,buf);
5079 4464 ;
5080 4464 ; this procedure is called from procedure 'check_event_queue' when an
5081 4464 ; answer to a message, sent by 'sem_sendmessage, has arrived. 'ref'
5082 4464 ; contains the address of the answer_descriptor and 'buf' contains the
5083 4464 ; message buffer address. the answer is signalled to the chained semaphore
5084 4464 ; given in answer_descriptor.
5085 4464 ;
5086 4464 ; call return
5087 4464 ; w0: - destr.
5088 4464 ; w1: ref destr.
5089 4464 ; w2: buf buf
5090 4464 ; w3: link link
5091 4464
5091 4464 b.j5 w.
5092 4464 c114: am (b27) ; begin
5093 4464 ds w3 +6 ;
5094 4464 am (b28) ;
5095 4464 rl w3 +a544 ;
5096 4464 sn w3 0 ; if testoutput active
5097 4464 jl. j0. ; then generate_testoutput(1<13);
5098 4464 jl. w3 h4. ;
5099 4464 3<22+1<13 ;
5100 4464 j0: al w0 0 ; with ref do
5101 4464 hs w0 x1 ; begin
5102 4464 al w0 1<1 ; open:= false;
5103 4464 rs w0 x1-2 ; type:= answer;
5104 4464 rx w2 x1+2 ; sem:= answer_sem;
5105 4464 al w1 x1-6 ; buffer:= buf;
5106 4464 jl. w3 c110. ; signal_chained(sem,operation);
5107 4464 am (b27) ; end;
5108 4464 dl w3 +6 ;
5109 4464 jl x3 ; end;
5110 4464 e.
5111 4464
5111 4464 \f
5111 4464 ; procedure message_received(buf,ref);
5112 4464 ;
5113 4464 ; this procedure is called from 'check_event_queue' when a message is
5114 4464 ; received and mess_descr.proc = 'message_received'. the message descriptor
5115 4464 ; must contain an operation and the address of a chained semaphore.
5116 4464 ;
5117 4464 ; message_descriptor message_operation
5118 4464 ; -6: next operation -
5119 4464 ; -4: prev operation -
5120 4464 ; -2: type type = message (1<0)
5121 4464 ; mess_descr +0: open,'message_received' -
5122 4464 ; +2: semaphore address buffer address
5123 4464 ;
5124 4464 ;
5125 4464 ; call return
5126 4464 ; w0: - destr.
5127 4464 ; w1: ref destr.
5128 4464 ; w2: buf 0 (the message buffer is removed)
5129 4464 ; w3: link link
5130 4464
5130 4464 b.j5 w.
5131 4464 c115: am (b27) ; begin
5132 4464 rs w3 +6 ;
5133 4464 am (b28) ;
5134 4464 rl w3 +a544 ;
5135 4464 sn w3 0 ; if testoutput active
5136 4464 jl. j0. ; then generate_testoutput(1<14);
5137 4464 jl. w3 h4. ;
5138 4464 3<22+1<14 ;
5139 4464 j0: jd 1<11+26 ; getevent(buf);
5140 4464 al w0 0 ; with ref do
5141 4464 hs w0 x1 ; begin
5142 4464 al w0 1<0 ; open:= false; <* the message class must be
5143 4464 ; explicitly opened by a
5144 4464 ; receiving coroutine *>
5145 4464 rs w0 x1-2 ; oper.type:= message;
5146 4464 rx w2 x1+2 ; oper.buffer:= buf;
5147 4464 al w1 x1-6 ; sem:= message_sem;
5148 4464 jl. w3 c110. ; signal_chained(sem,oper);
5149 4464 am (b27) ; end;
5150 4464 rl w3 +6 ;
5151 4464 al w2 0 ; buf:= 0; <* has been removed *>
5152 4464 jl x3 ; end;
5153 4464 e.
5154 4464
5154 4464 \f
5154 4464 ; procedure entry timer_message;
5155 4464 ;
5156 4464 ; sends a delay-message to 'clock'.
5157 4464 ;
5158 4464 ; call return
5159 4464 ; w0: - unchanged
5160 4464 ; w1: - destr.
5161 4464 ; w2: - buf or 0
5162 4464 ; w3: link current_coroutine
5163 4464
5163 4464 b.j5 w.
5164 4464 c116: am (b27) ; begin
5165 4464 rs w3 +14 ;
5166 4464 am (b28) ;
5167 4464 rl w3 +a544 ;
5168 4464 sn w3 0 ; if testoutput active
5169 4464 jl. j0. ; then generate_testoutput(1<15);
5170 4464 jl. w3 h4. ;
5171 4464 3<22+1<15 ;
5172 4464 j0: rl w3 b28 ;
5173 4464 al w1 x3+a626 ; mess:= cur.ext2.delaymess;
5174 4464 al w2 x3+a630 ; ref:= cur.ext2.answer_descr;
5175 4464 al w3 x3+a616 ; name:= <:clock:>;
5176 4464 jd 1<11+16 ; sendmessage(name,mess,ref,result);
5177 4464 rl w3 (b28) ;
5178 4464 am (b27) ;
5179 4464 rl w1 +14 ;
5180 4464 jl x1 ; end;
5181 4464 e.
5182 4464
5182 4464 \f
5182 4464 ; procedure timerscan(ref,buf);
5183 4464 ;
5184 4464 ; this procedure is called from 'check_event_queue' when an answer arrives
5185 4464 ; from 'clock'. the timer queue is inspected and coroutines which time out
5186 4464 ; are started with result = timeout. after the inspection a delay-message is
5187 4464 ; sent to 'clock'.
5188 4464 ;
5189 4464 ; call return
5190 4464 ; w0: - destr.
5191 4464 ; w1: ref destr.
5192 4464 ; w2: buf 0 (the message buffer is removed)
5193 4464 ; w3: link link
5194 4464
5194 4464 b.j5,i5 w.
5195 4464 c117: am (b27) ; begin
5196 4464 rs w3 +16 ; ext1(16):= link;
5197 4464 am (b28) ;
5198 4464 rl w3 +a544 ;
5199 4464 sn w3 0 ; if testoutput active
5200 4464 jl. j0. ; then generate_test_output(1<16);
5201 4464 jl. w3 h4. ;
5202 4464 3<22+1<16 ;
5203 4464 j0: rl w3 b28 ;
5204 4464 al w1 x3+a566 ; <* release messagebuffer *>
5205 4464 jd 1<11+18 ; wait_answer(cur.ext2.test_mess_area,buf);
5206 4464 j4: ;
5207 4464 al w2 x3+a552 ; corout:= first in timer queue;
5208 4464 j1: rl w2 x2 ; while corout <> timer queue head do
5209 4464 j3: sn w2 x3+a552 ; begin
5210 4464 jl. j2. ; corout:= next(corout);
5211 4464 rl w1 x2+4 ; with corout do
5212 4464 sh w1 0 ; begin
5213 4464 jl. j1. ; if timer > 0 then
5214 4464 al w1 x1-1 ; begin
5215 4464 rs w1 x2+4 ;
5216 4464 se w1 0 ; timer:= timer-1;
5217 4464 jl. j1. ; if timer = 0
5218 4464 rl w0 x2 ; then start(corout,prio,timeout);
5219 4464 am (b27) ;
5220 4464 rs w0 +18 ;
5221 4464 al w2 x2-2 ;
5222 4464 rl w0 x2+a698 ; end;
5223 4464 al w1 0 ; end;
5224 4464 jl. w3 c100. ;
5225 4464 am (b27) ;
5226 4464 rl w2 +18 ;
5227 4464 rl w3 b28 ;
5228 4464 jl. j3. ; end while;
5229 4464 j2: jl. w3 c116. ; timer_message;
5230 4464 am (b27) ;
5231 4464 rl w3 +16 ; link:= ext1(16);
5232 4464 al w2 0 ; buf:= 0; <* has been removed *>
5233 4464 jl x3 ; end;
5234 4464 e.
5235 4464
5235 4464 \f
5235 4464 ; procedure entry cregretmessage(buf);
5236 4464 ;
5237 4464 ; this procedure is used to regret a message sent by csendmessage, i. e. the
5238 4464 ; monitor procedure 'regretmessage' is called and the corresponding message
5239 4464 ; buffer extension is released.
5240 4464 ;
5241 4464 ; call return
5242 4464 ; w0: - destr.
5243 4464 ; w1: - destr.
5244 4464 ; w2: buf buf
5245 4464 ; w3: link current_coroutine
5246 4464
5246 4464 b.j5 w.
5247 4464 c118: am (b28) ; begin
5248 4464 rs w3 (0) ;
5249 4464 am (b28) ;
5250 4464 rl w3 +a544 ;
5251 4464 sn w3 0 ; if testoutput active
5252 4464 jl. j0. ; then generate test_output(1<17);
5253 4464 jl. w3 h4. ;
5254 4464 3<22+1<17 ;
5255 4464 j0: jd 1<11+82 ; regretmessage(buf);
5256 4464 rl w1 x2-2 ; ref:= buf.ref;
5257 4464 rl w3 b28 ; ext:= next(message_buffer_ext_head);
5258 4464 al w0 x1-2 ; next(message_buffer_ext_head):= ref;
5259 4464 rx w0 x3+a588 ; next(ref):= ext;
5260 4464 rs w0 x1-2 ;
5261 4464 rl w3 (b28) ;
5262 4464 jl (x3) ; end;
5263 4464 e.
5264 4464 \f
5264 4464
5264 4464
5264 4464 ; procedure entry testout
5265 4464 ;
5266 4464 ;
5267 4464 ; this procedure creates a user test record defined by the registers
5268 4464 ; as follows:
5269 4464 ;
5270 4464 ; call return
5271 4464 ; w0: testrecord ident unch.
5272 4464 ; w1: start address unch.
5273 4464 ; w2: no_of_halfwords unch.
5274 4464 ; w3: link current coroutine
5275 4464
5275 4464 b.j5 w.
5276 4464 c119: am (b28) ; begin
5277 4464 rs w3 (0) ;
5278 4464 am (b28) ; if test output active then
5279 4464 rl w3 +a544 ;
5280 4464 sn w3 0 ;
5281 4464 jl. j0. ;
5282 4464 jl. w3 h4. ; generate testoutput(1<18)
5283 4464 3<22+1<18;
5284 4464 j0: rl w3 (b28) ;
5285 4464 jl (x3) ; end;
5286 4464
5286 4464 e.
5287 4464 \f
5287 4464
5287 4464
5287 4464 ; procedure generate testoutput(testkind);
5288 4464 ;
5289 4464 ; this procedure creates a testrecord or initiates the creation of a test
5290 4464 ; record as follows:
5291 4464 ;
5292 4464 ; 1) if word 128 in monitor table is set ( <> 0 ) a message defining the
5293 4464 ; test record is sent to the coroutine test output process.
5294 4464 ;
5295 4464 ; 2) otherwise a test record is written in the cyclical test output buffer.
5296 4464 ; formats in the cyclical buffer:
5297 4464 ;
5298 4464 ; user test record coroutine function (signal etc.)
5299 4464 ; +0 testkind testkind
5300 4464 ; +2 time1 time1
5301 4464 ; +4 time2 time2
5302 4464 ; +6 user_ident,length w0
5303 4464 ; +8 test information w1
5304 4464 ; +10 - " - w2
5305 4464 ; +12 - " - coroutine ident
5306 4464 ; +14 etc. address of current coroutine
5307 4464
5307 4464 ;
5308 4464 ; testkind values:
5309 4464 ; 1<0 : start
5310 4464 ; 1<1 : wait
5311 4464 ; 1<2 : pass
5312 4464 ; 1<3 ; inspect
5313 4464 ; 1<4 : csendmessage
5314 4464 ; 1<5 : cwaitanswer
5315 4464 ; 1<6 : answer_arrived
5316 4464 ; 1<7 : signal_sem-signal_binary
5317 4464 ; 1<8 : wait_semaphore
5318 4464 ; 1<9 : signal_chained
5319 4464 ; 1<10 : inspect_chained
5320 4464 ; 1<11 : wait_chained
5321 4464 ; 1<12 : sem_sendmessage
5322 4464 ; 1<13 : sem_answer_proc
5323 4464 ; 1<14 : message_received
5324 4464 ; 1<15 : timer_message
5325 4464 ; 1<16 : timer_scan
5326 4464 ; 1<17 : cregretmessage
5327 4464 ; 1<18 : user defined testrecord
5328 4464 ;
5329 4464 ; call return
5330 4464 ; w0: - unchanged
5331 4464 ; w1: - unchanged
5332 4464 ; w2: - unchanged
5333 4464 ; w3: link current coroutine
5334 4464
5334 4464
5334 4464 b.j10,i5
5335 4464 w.
5336 4464 h4: am (b27) ; begin
5337 4464 rs w3 +8 ; ext1(8):= link;
5338 4464 rl w3 b27 ;
5339 4464 ds w1 x3+22 ; save working registers
5340 4464 rs w2 x3+24 ;
5341 4464 rl w1 x3+8 ;
5342 4464 rl w3 (b28) ;
5343 4464 rl w0 x3+a716 ; if testkind is included in curr.corout.testm then
5344 4464 la w0 x1 ; begin
5345 4464 sn w0 0 ;
5346 4464 jl. j6. ;
5347 4464 rl w3 b141 ; if core(128) <> 0 then
5348 4464 sn w3 0 ; begin
5349 4464 jl. j1. ;
5350 4464 rl w3 b28 ;
5351 4464 al w1 x3+a566 ;
5352 4464 rs w0 x1 ; cur.ext2.testmess(1):= testkind;
5353 4464 al w3 x3+a556 ;
5354 4464 jd 1<11+16 ; send message(testmes,cmontest);
5355 4464 jd 1<11+18 ; wait answer;
5356 4464 jl. j6. ; else
5357 4464 j1: rl w3 b28 ; begin ! create record in cyclical buffer !
5358 4464 am (b27) ; if testkind = user record
5359 4464 rl w1 +24 ;
5360 4464 se. w0 (i0.) ; then length:= length(user record)
5361 4464 al w1 8 ; else length:= 8;
5362 4464 rl w2 x3+a540 ; if (start(next record)+length+8) >
5363 4464 wa w1 x3+a540 ; top(test buffer) then
5364 4464 al w1 x1+8 ; begin
5365 4464 sh w1 (x3+a542) ;
5366 4464 jl. j2. ;
5367 4464 al w1 0 ; insert dummy end record
5368 4464 rs w1 x2 ;
5369 4464 rl w2 x3+a538 ; start(next record):= start(test buffer);
5370 4464 ; end;
5371 4464 j2: rs w0 x2 ; insert testkind in record
5372 4464 rl w3 0 ;
5373 4464 jd 1<11+36 ; get clock
5374 4464 ds w1 x2+4 ; insert time in test record
5375 4464 sn. w3 (i0.) ; if testkind = coroutine function then
5376 4464 jl. j3. ; begin
5377 4464 rl w3 (b28) ;
5378 4464 am (b27) ;
5379 4464 dl w1 +22 ;
5380 4464 ds w1 x2+8 ; insert w0,w1
5381 4464 am (b27) ;
5382 4464 rl w0 +24 ;
5383 4464 rs w0 x2+10 ; insert w2
5384 4464 rl w0 x3+a718 ;
5385 4464 ds w0 x2+14 ; insert coroutine_ident, addr. of curr,corout.
5386 4464 al w2 x2+14 ;
5387 4464 jl. j5. ; end
5388 4464 j3: rl w3 b27 ; else
5389 4464 dl w1 x3+22 ; begin <* user defined test record *>
5390 4464 rl w3 x3+24 ;
5391 4464 hs w0 x2+6 ; insert user identification
5392 4464 hs w3 x2+7 ; insert length
5393 4464 al w2 x2+8 ;
5394 4464 j4: rl w0 x1 ; transfer test information
5395 4464 rs w0 x2 ;
5396 4464 al w3 x3-2 ;
5397 4464 sh w3 0 ;
5398 4464 jl. j5. ;
5399 4464 al w2 x2+2 ;
5400 4464 al w1 x1+2 ;
5401 4464 jl. j4. ; end;
5402 4464 ; end;
5403 4464 j5: rl w3 b28 ;
5404 4464 al w2 x2+2 ; update start(next record) in procees ext2
5405 4464 rs w2 x3+a540 ;
5406 4464 j6: rl w3 b27 ;
5407 4464 dl w1 x3+22 ; load working registers
5408 4464 rl w2 x3+24 ;
5409 4464 rl w3 x3+8 ; return:=ext1(8);
5410 4464 jl x3+2 ; end;
5411 4464
5411 4464 i0: +1<18 ; testkind f. user test record
5412 4464
5412 4464 e.
5413 4464 e.
5414 4464 z.
5415 4464
5415 4464
5415 4464
5415 4464
5415 4464 ; procedure errorlog.
5416 4464 ; called from driver when a abnormal result is received,
5417 4464 ; or when a internal interupt is received.
5418 4464 ; if the external process errorlog has received a buffer this procedure
5419 4464 ; will produce a record. the format of the record depends on
5420 4464 ; the kind of error.
5421 4464 ; the procedure is called with w1 holding the process description of the failed
5422 4464 ; process e.g. the current internal process in case of a internal
5423 4464 ; interupt or the physical disc in case of a discerror.
5424 4464 ;
5425 4464 ;
5426 4464 ;
5427 4464 ; call return
5428 4464 ; w0 unchanged
5429 4464 ; w1 failed process unchanged
5430 4464 ; w2 link unchanged
5431 4464 ; w3 unchanged
5432 4464
5432 4464
5432 4464 b. i15 , j20 w.
5433 4464 g66 :ds. w1 i0. ; save all registers
5434 4466 ds. w3 i1. ;
5435 4468 dl w1 b19 ; save current buffer , current receiver
5436 4470 ds. w1 i3. ;
5437 4472 rl w1 b30 ; set current receiver := errorlog
5438 4474 rs w1 b19 ;
5439 4476 jl w3 g64 ; examine queue
5440 4478 jl. j15. ; +0 : queue empty ; return
5441 4480 rl w2 b30 ; +2 : mess in queue
5442 4482 al w2 x2+a70 ; c. w2= errorbuffer start
5443 4484 al w3 0 ;
5444 4486 rs w3 x2 ;
5445 4488 dl w1 b13+2 ; insert time in errorbuf
5446 4490 ds w1 x2+32 ;
5447 4492 rl. w1 i0. ; record type : goto case kind of
5448 4494 rl w0 x1+a10 ;
5449 4496 hs w0 x2+0 ;
5450 4498 sn w0 0 ;
5451 4500 jl. j0. ; internal interupts, monitor call break
5452 4502 sn w0 62 ;
5453 4504 jl. j1. ; discerror
5454 4506 se w0 86 ;
5455 4508 sn w0 88 ;
5456 4510 jl. j3. ; fpa transmission error
5457 4512 se w0 84 ;
5458 4514 sn w0 85 ;
5459 4516 jl. j5. ; subprocesserror
5460 4518 jl. j15. ; otherwise ... return
5461 4520 ;
5462 4520 ; before exit the registers contain
5463 4520 ; w0 : kind.failed process
5464 4520 ; w1 : process description of failed process
5465 4520 ; w2 : errorbuffer start
5466 4520 ;
5467 4520 ;
5468 4520 j0: dl w0 x1+a11+2 ; internal interupt .
5469 4522 ds w0 x2+4 ; move name.failed process
5470 4524 dl w0 x1+a11+6 ;
5471 4526 ds w0 x2+8 ;
5472 4528 al w2 x2+10 ;
5473 4530 al w0 8 ; copy from process descr. w0,w1 w2 w3
5474 4532 al w1 x1+a28 ; status ic(logical) cause sb
5475 4534 jl. w3 j9. ;
5476 4536 rl w3 x1-a28+a182; copy last two instructions
5477 4538 wa w3 x1-a28+a33 ;
5478 4540 dl w1 x3-2 ;
5479 4542 ds w1 x2-10+28 ;
5480 4544 al w3 32 ; save size-2 of record and
5481 4546 jl. j13. ; goto copy errorbuf
5482 4548 ;
5483 4548 ;
5484 4548 j1: rs w1 x2+28 ; discerror
5485 4550 rl w3 x1+a244 ; copy i-o result, rem char.std status
5486 4552 rl w0 x1+a231 ;
5487 4554 ds w0 x2+20 ;
5488 4556 dl w0 x1+100 ; status: sum of all statusbits
5489 4558 ds w0 x2+24 ; e.g. std. status "or" statusarea1
5490 4560 rl w3 x1+102 ; ( "or" statusarea2)
5491 4562 rs w3 x2+26 ;
5492 4564 rl. w1 i2. ; copy from "current" buffer
5493 4566 dl w0 x1+a151 ; mess(1) - mess(2)
5494 4568 ds w0 x2+12 ; mess(4) - mess(5)
5495 4570 dl w0 x1+a153+2
5496 4572 ds w0 x2+16 ;
5497 4574 rl w1 x1+a141 ; get process descr. rec
5498 4576 sh w1 (b3) ; if receiver defined then
5499 4578 jl. j2. ;
5500 4580 dl w0 x1+a11+2 ;
5501 4582 ds w0 x2+4 ;
5502 4584 dl w0 x1+a11+6 ;
5503 4586 ds w0 x2+8 ;
5504 4588 j2: al w3 32 ; save size-2 of record
5505 4590 jl. j13. ; goto copy errorbuf
5506 4592 ;
5507 4592 ;
5508 4592 j3: zl w0 x1+42 ; fpa transmission error
5509 4594 ls w0 12 ;
5510 4596 hl w0 x1+44 ; save
5511 4598 ds w1 x2+28 ; startbyte, statusbyte
5512 4600 dl w0 x1+a11+2 ; name
5513 4602 ds w0 x2+4
5514 4604 dl w0 x1+a11+6 ;
5515 4606 ds w0 x2+8 ;
5516 4608 dl w0 x1+a231 ; std status
5517 4610 ds w0 x2+12 ;
5518 4612 dl w0 x1+a233 ;
5519 4614 ds w0 x2+16
5520 4616 dl w0 x1+28 ; status from first sense
5521 4618 ds w0 x2+20 ;
5522 4620 dl w0 x1+32 ;
5523 4622 ds w0 x2+24 ;
5524 4624 dl w0 x1+36 ; copy status from second sense
5525 4626 ds w0 x2+36 ;
5526 4628 dl w0 x1+40 ;
5527 4630 ds w0 x2+40 ;
5528 4632 al w0 18 ; copy channelprogram
5529 4634 wa w1 x1+a226 ;
5530 4636 al w2 x2+42 ;
5531 4638 jl. w3 j9. ;
5532 4640 al w3 74 ; save size-2 of record
5533 4642 jl. j13. ; goto copy errorbuf
5534 4644 ;
5535 4644 ;
5536 4644 j5: rs w1 x2+28 ; subprocess error
5537 4646 hl w0 x1+36 ; copy from subprocess
5538 4648 hs w0 x2+1 ; subkind
5539 4650 dl w0 x1+a11+2 ;
5540 4652 ds w0 x2+4 ; name
5541 4654 dl w0 x1+a11+6 ;
5542 4656 ds w0 x2+8
5543 4658 dl w0 g29 ; copy first four words of mess from save area
5544 4660 ds w0 x2+12 ;
5545 4662 dl w0 g30 ;
5546 4664 ds w0 x2+16 ;
5547 4666 dl w0 g21 ; copy the answer from std answer area
5548 4668 ds w0 x2+20 ;
5549 4670 dl w0 g23
5550 4672 ds w0 x2+24 ;
5551 4674 rl w3 g24 ;
5552 4676 rs w3 x2+26 ;
5553 4678 al w3 32 ; save size-2
5554 4680 jl. j13. ; goto copy buf
5555 4682 ;
5556 4682 ;
5557 4682 ;
5558 4682 ; help procedure move doublewords.
5559 4682 ; move the specified number if words as doublewords.
5560 4682 ; odd number of words will cause one extra word to be moved.
5561 4682 ; call return
5562 4682 ; w0: no of words destroyed (zero)
5563 4682 ; w1: from adr unchanged
5564 4682 ; w2: to adr unchanged
5565 4682 ; w3: link unchanged
5566 4682 ;
5567 4682 ;
5568 4682 j9: ds.w2 i13. ;
5569 4684 ds. w0 i15. ;
5570 4686 j10: dl w0 x1+2 ;
5571 4688 ds w0 x2+2 ;
5572 4690 al w1 x1+4 ;
5573 4692 al w2 x2+4 ;
5574 4694 rl. w3 i15. ; decrease word count
5575 4696 al w3 x3-2 ;
5576 4698 rs. w3 i15. ;
5577 4700
5577 4700 sl w3 1 ;
5578 4702 jl. j10. ;
5579 4704 dl. w2 i13. ; restore registers
5580 4706 dl. w0 i15. ;
5581 4708 jl x3 ;
5582 4710 ;
5583 4710 ;
5584 4710 0 ; from adr
5585 4712 i13: 0 ; to adr
5586 4714 0 ; link
5587 4716 i15: 0 ; word count
5588 4718 ;
5589 4718 ;
5590 4718 j12: rl w1 4 ; copy direct: setup parameters to procedure move doublewors
5591 4720 rl. w2 i10. ;
5592 4722 rl w2 x2+a151 ; first adr in messbuf
5593 4724 wa. w2 i9. ; + no of hw already moved
5594 4726 al w0 34 ; record size: 34 hw
5595 4728 jl. w3 j9. ;
5596 4730 al w1 34 ; goto update no of hw moved
5597 4732 rl. w2 i10. ;
5598 4734 jl. j14. ;
5599 4736 ;
5600 4736 ;
5601 4736 j13: rl w2 b30 ; copy errorbuffer (general copy)
5602 4738 rl w1 x2+a54 ; check buffer.
5603 4740 al w0 0 ; if buffer<> last used buffer then
5604 4742 se. w1 (i10.) ; set bufferadr and clear relative adr.
5605 4744 ds. w1 i10. ;
5606 4746 rl w0 x1+a150 ; change operation to odd
5607 4748 wa. w0 i11. ; to use gen. copy
5608 4750 rs w0 x1+a150 ;
5609 4752 al w2 x2+a70 ;
5610 4754 zl w1 x2+0 ; if kind of record = internal then
5611 4756 sn w1 0 ; goto move direct.
5612 4758 jl. j12. ; (we are in monitor mode and cant use general copy)
5613 4760 wa w3 4 ; else store first and last adr
5614 4762 ds. w3 i8. ;
5615 4764 al. w1 i6. ;
5616 4766 rl. w2 i10. ; setup parameters and call
5617 4768 jd 1<11+84 ; general copy
5618 4770 se w0 0 ; if not ok then !!!!!
5619 4772 jl. j11. ;
5620 4774 j14: wa. w1 i9. ; (copy direct continues here. w1=no of hw moved
5621 4776 rs. w1 i9. ; w2= mess buf adr)
5622 4778 rl w0 x2+a150 ; change operation to even
5623 4780 ws. w0 i11. ; makes it possible to regret the mess.
5624 4782 rs w0 x2+a150 ;
5625 4784 wa w1 x2+a151 ; update relative adr and check restsize in buf
5626 4786 al w1 x1+74 ;
5627 4788 sh w1 (x2+a152) ; if restsize < max record size then
5628 4790 jl. j15. ; deliver answer else goto return
5629 4792 j11: al w0 1 ; deliver result 1
5630 4794 rl. w1 i9. ;
5631 4796 rl w3 b30 ; check kind.record
5632 4798 rl w3 x3+a70 ; if kind.record =internal then
5633 4800 se w3 0 ; deliver answer else
5634 4802 jl. j16. ; deliver result
5635 4804 rs w0 x2+a141 ; set result in buffer
5636 4806 ds w1 x2+a151 ; no of bytes =sum of bytes moved
5637 4808 jl w3 d15 ; deliver answer (continue with restore parameters )
5638 4810
5638 4810
5638 4810 j17: al w0 0 ; reset special watched receiver
5639 4812 rs w0 b32 ;
5640 4814 jl w3 g64 ; if more messages in queue
5641 4816 jl. j15. ; then set next special watched receiver adr
5642 4818 rl w0 x2+a153 ;
5643 4820 rs w0 b32 ; (placed in connection to "deliver result" )
5644 4822
5644 4822 j15: dl. w1 i3. ; return : restore all parameters
5645 4824 ds w1 b19 ; restore current receiver and buffer
5646 4826 dl. w1 i0. ; restore all registers
5647 4828 dl. w3 i1. ;
5648 4830 jl x2 ;
5649 4832 j16: ds w1 g21 ; deliver result
5650 4834 jl w3 g19 ;
5651 4836 jl. j17. ; restore parameters
5652 4838 ;
5653 4838 ;
5654 4838 ; parameter list :
5655 4838 ;
5656 4838 0 ; save w0:
5657 4840 i0: 0 ; save w1: pd.failed process
5658 4842 0 ; save w2: link
5659 4844 i1: 0 ; save w3:
5660 4846 i2: 0 ; save current buffer
5661 4848 i3: 0 ; save current receiver
5662 4850
5662 4850
5662 4850 i6: 2<1+1 ; parameters for general copy: funtion
5663 4852 i7: 0 ; first adr in errorbuf
5664 4854 i8: 0 ; last adr in errorbuf
5665 4856 i9: 0 ; relative start to mess buf adr (no of hw moved)
5666 4858 i10: 0 ; buffer adr
5667 4860 i11: 1<12 ; change op even-odd
5668 4862 e. ; end of errorlog entry
5669 4862
5669 4862
5669 4862 b.i0 ; begin
5670 4862 w.i0: al. w2 i0. ; make room:
5671 4864 jl x3+0 ; autoloader(end monitor procedures);
5672 4866 jl. i0. ; after loading:
5673 4868 j0=k - b127 + 2
5674 4868 k = i0 ; goto make room;
5675 4862 e. ; end
5676 4862
5676 4862
5676 4862 e. ; end of monitor segment
5677 4862
5677 4862
5677 4862 \f
▶EOF◀