1 "BEGIN INCLUDE FILE simone_operators_.incl.alm
2 " HISTORY COMMENTS:
3 " 1) change86-09-11JPFauche, approve86-09-11MCR7521,
4 " audit86-09-15Martinson, install86-11-12MR12.0-1208:
5 " Release 8.03 for MR12.
6 " END HISTORY COMMENTS
7
8 "
9 " SIM-ONE OPERATORS - Designed and written : Alain Kermarrec, CICB - France
10 "
11 "
12 "
13 "
14 "
15 "
16 " * * * * * * * * * * * * * *
17 " * *
18 " * SIMONE ENTRY OPERATORS *
19 " * *
20 " * * * * * * * * * * * * * *
21 "
22 "
23 "
24 " entry operators for MAIN SIMONE
25 " --------------------------------------------------
26 "
27 " assumed that: Multics convention
28 " PR0 -> parameter list
29 " PR6 -> stack frame of the calling procedure
30 " PR7 -> stack header
31 "
32 " calling sequence:
33 " epp5 0,ic entry point addr
34 " epp2 7|stack_header.trans_op_tv_ptr MUST BE SECOND WORD for TRACE
35 " epp2 2|8,* to get ptr to pascal operators
36 " ldq PASCAL execution flags,dl
37 " eax7 stack_frame size in words n * 16
38 " eax4 max size than can be reached by the stak of this processus
39 " eax3 addr of return point when EXIT
40 " tsp3 2|op number
41 "
42 " Performs the standard push sequence.
43 "
44 " returns:
45 " PR0 -> pascal operators transfer vector
46 " PR4 -> link section of the procedure
47 " PR6 -> stack_frame of the procedure
48 " indicators are reset
49 SIMONE_MAIN_entry:
50 " PUSH stack
51 inhibit on
52 epp1 7|stack_header.stack_end_ptr,*
53 spri6 1|stack_frame.prev_sp
54 spri1 6|stack_frame.next_sp
55 epp6 1|0
56 epp1 6|0,x4 get full space for this process
57 spri1 6|stack_frame.next_sp
58 spri1 7|stack_header.stack_end_ptr
59 inhibit off
60 " FILL stack
61 spri0 6|stack_frame.arg_ptr "arg_ptr" in new stack frame
62 epp0 2|0 op ptr must be pr0
63 spri5 6|stack_frame.entry_ptr "entry_ptr" of new stack frame
64 spri0 6|stack_frame.operator_ptr "operator_ptr" in new stack frame
65 adq my_id,du
66 stq 6|stack_frame.translator_id
67 epp2 6|0,7 ptr to next stack_frame of this processus
68 spri2 6|next_simone_frame_ptr
69 epp1 2|-sim_locs_size
70 spri1 6|locals_ptr
71 " initialize now locals
72 " - - - - - - - - - - - - -
73 stx4 1|max_size
74 stx7 6|left_size
75 sbx4 6|left_size
76 stx4 6|left_size
77 spri6 1|main_base_ptr
78 spri6 6|base_process_ptr
79 epbp2 3|0 PR2 --> Executed segment
80 epp2 2|0,x3 PR2 --> EXIT point
81 spri2 1|exit_ptr Store PR2
82 epp2 null_ptr,*
83 spri2 6|next_free_block_ptr Free list
84 spri2 1|first_active_process_ptr
85 spri2 1|next_threaded_process_ptr
86 spri2 1|previous_threaded_process_ptr
87 spri2 1|bill_book_ptr
88 spri2 6|dlinkw
89 spri2 6|execution_mo_ptr
90 stz 1|hour
91 stz 1|father_type
92 stz 1|number_of_active_sons
93 stz 1|waiting_var_sons
94 aos 1|number_of_active_sons
95 epaq 3|0
96 lprp4 7|stack_header.lot_ptr,*au
97 spri4 6|linkage_ptr "linkage_ptr" in new stack frame
98 epbp1 3|0
99 spri1 6|stack_frame.return_ptr
100 ldi 0,dl reset indicators
101 tra 3|2 return to procedure
102 "
103 "
104 "
105 "
106 " entry operator for exportable pure SIMONE procedure
107 " -----------------------------------------------------
108 "
109 " assumed that: Multics convention
110 " PR0 -> parameter list
111 " PR6 -> stack frame of the calling procedure
112 " PR7 -> stack header
113 "
114 " calling sequence:
115 " epp5 0,ic entry point addr
116 " epp2 7|stack_header.trans_op_tv_ptr MUST BE SECOND WORD for TRACE
117 " epp2 2|8,* to get ptr to pascal operators
118 " ldq PASCAL execution flags,dl
119 " eax7 stack_frame size in words n * 16
120 " eax4 max size than can be reached by the stak of this processus
121 " tsp3 2|op number
122 "
123 " Performs the standard push sequence.
124 " Sets locals to blank if check mode
125 "
126 " returns:
127 " PR0 -> pascal operators transfer vector
128 " PR4 -> link section of the procedure
129 " PR6 -> stack_frame of the procedure
130 " indicators are reset
131 "
132 "
133 sim_ext_entry:
134 " PUSH stack
135 inhibit on
136 epp1 7|stack_header.stack_end_ptr,*
137 spri6 1|stack_frame.prev_sp
138 spri1 6|stack_frame.next_sp
139 epp6 1|0
140 epp1 6|0,x7 get space for this proc
141 spri1 6|stack_frame.next_sp
142 spri1 7|stack_header.stack_end_ptr
143 inhibit off
144 " FILL stack
145 spri0 6|stack_frame.arg_ptr "arg_ptr" in new stack frame
146 epp0 2|0
147 spri0 6|stack_frame.operator_ptr
148 spri5 6|stack_frame.entry_ptr "entry_ptr" of new stack frame
149 adq my_id,du
150 stq 6|stack_frame.translator_id
151 anq check_bit,dl
152 tze sim_ext_skip_init
153 eaa -sim_first_local_place,x7
154 als 2
155 mlr pr,prrl,fill040
156 desc9a 6|sim_first_local_place,0
157 desc9a 6|sim_first_local_place,au
158 sim_ext_skip_init:
159 epaq 3|0
160 lprp4 7|stack_header.lot_ptr,*au
161 spri4 6|linkage_ptr "linkage_ptr" in new stack frame
162 epp1 null_ptr,*
163 spri1 6|dlinkw
164 spri1 6|base_process_ptr
165 epbp1 3|0
166 spri1 6|stack_frame.return_ptr
167 ldi 0,dl reset indicators
168 tra 3|2 return to procedure
169 "
170 "
171 "
172 "
173 " entry operator for Simone pure internal procedures
174 " --------------------------------------------------
175 "
176 " assumed that: PASCAL internal convention
177 " PR0 -> pascal operators
178 " PR1 -> dynamic link
179 " PR2 -> argument list
180 " PR4 -> linkage section
181 " PR6 -> stack frame of the calling procedure
182 " PR7 -> stack header
183 "
184 " calling sequence:
185 " epp5 0,ic get ptr to the entry point
186 " eax7 stack_frame size in words n * 16
187 " tsp3 0|91
188 "
189 " returns:
190 " PR0 , PR6 not changed
191 " PR6 -> stack frame of the procedure
192 "
193 pure_int_entry:
194 " PUSH stack
195 inhibit on
196 eaa 7|stack_header.stack_end_ptr,* A <- stack_end
197 spri6 7|stack_frame.prev_sp,au
198 spri1 7|dlinkw,au
199 spri2 7|stack_frame.arg_ptr,au
200 epp1 6|0 PR1 -> caller stack
201 epp6 7|0,au PR6 -> current new stack
202 epp2 6|0,x7 PR2 -> next stack stack_end
203 spri6 1|stack_frame.next_sp
204 spri2 6|stack_frame.next_sp
205 spri2 7|stack_header.stack_end_ptr
206 inhibit off
207 " FILL stack
208 spri4 6|linkage_ptr
209 spri0 6|stack_frame.operator_ptr
210 spri5 6|stack_frame.entry_ptr
211 epp5 1|base_process_ptr,*
212 spri5 6|base_process_ptr
213 ldq 1|stack_frame.translator_id
214 anq non_MAIN_mask
215 stq 6|stack_frame.translator_id
216 anq check_bit,dl
217 tze skip_p_inter_init
218 eaa -sim_first_local_place,x7
219 als 2
220 mlr pr,prrl,fill040
221 desc9a pr6|sim_first_local_place,0
222 desc9a pr6|sim_first_local_place,au
223 skip_p_inter_init:
224 ldi 0,dl
225 epbp1 3|0
226 spri1 6|stack_frame.return_ptr
227 tra 3|2
228 "
229 "
230 "
231 "
232 " entry operator for Simone non pure internal procedures
233 " ------------------------------------------------------
234 "
235 " assumed that: PASCAL internal convention
236 " PR0 -> pascal operators
237 " PR1 -> dynamic link
238 " PR2 -> argument list
239 " PR4 -> linkage section
240 " PR6 -> stack frame of the calling procedure
241 " PR7 -> stack header
242 " x2 =
243 "
244 " calling sequence:
245 " epp5 0,ic get ptr to the entry point
246 " eax7 stack_frame size in words n * 16
247 " tsp3 0|91
248 "
249 " returns:
250 " PR0 , PR6 not changed
251 " PR6 -> stack frame of the procedure
252 "
253 sim_int_entry:
254 " Check if enough room in process stack
255 stx7 6|op_work
256 ldx4 6|left_size
257 sbx4 6|op_work
258 tmi check_overflow
259 " PUSH stack
260 inhibit on
261 eaa 6|next_simone_frame_ptr,*
262 spri6 7|stack_frame.prev_sp,au
263 spri1 7|dlinkw,au
264 spri2 7|stack_frame.arg_ptr,au
265 epp1 6|0 PR1 -> caller stack
266 epp6 7|0,au PR6 -> current new stack
267 epp2 1|stack_frame.next_sp,* PR2 -> next stack_frame
268 spri6 1|stack_frame.next_sp
269 spri2 6|stack_frame.next_sp
270 epp2 6|0,x7
271 spri2 6|next_simone_frame_ptr
272 inhibit off
273 " FILL stack
274 spri4 6|linkage_ptr
275 spri5 7|stack_frame.entry_ptr,au
276 " adx6 -1,du test x6
277 " tmi no_propagation
278 " epp4 6|stack_frame.prev_sp,*
279 " epp4 4|base_process_ptr,* PR4 -> PROCESS STACK
280 " epp4 4|execution_mo_ptr,* PR4 -> MONITOR WHERE CALL IS MADE
281 " spri4 6|monormod_ptr
282 " epp4 6|linkage_ptr,* Restore PR4
283 " no_propagation:
284 adx2 -1,du
285 tmi ordinary_proc
286 ldq 6|stack_frame.arg_ptr,*
287 qrl 1
288 mpy 2,dl
289 eaa 1|next_simone_frame_ptr,*
290 epp5 6|stack_frame.arg_ptr,*qu
291 epp5 5|0,*
292 spri5 6|monormod_ptr
293 epp2 1|base_process_ptr,*
294 spri5 2|execution_mo_ptr
295 ordinary_proc:
296 ldq 1|stack_frame.translator_id
297 anq non_MAIN_mask
298 stq 6|stack_frame.translator_id
299 anq check_bit,dl
300 tze skip_inter_init
301 eaa -sim_first_local_place,x7
302 als 2
303 mlr pr,prrl,fill040
304 desc9a 6|sim_first_local_place,0
305 desc9a 6|sim_first_local_place,au
306 skip_inter_init:
307 epp2 1|base_process_ptr,*
308 spri2 6|base_process_ptr
309 epbp1 3|0
310 spri1 6|stack_frame.return_ptr
311 stx4 6|left_size
312 ldi 0,dl
313 tra 3|2
314 check_overflow:
315 epp1 <pascal_errors_>|recursivity_error
316 tra common_op_call
317 "
318 "
319 "
320 " Entry operator for a process
321 " ----------------------------
322 "
323 "
324 " This Operator :
325 " -Installs the stack of the process to be started
326 " - Put the process including the calling procedure
327 " in the active_process_queue by calling the
328 " appropriate operator.
329 "
330 " assumed that: PASCAL internal convention
331 " PR0 -> pascal operators
332 " PR1 -> dynamic link
333 " PR2 -> argument list
334 " PR4 -> linkage section
335 " PR6 -> stack frame of the calling procedure
336 " PR7 -> stack header
337 "
338 " calling sequence:
339 " epp5 0,ic get ptr to the entry point
340 " eax7 stack_frame size in words n * 16
341 " eax4 max size the process can reach
342 " eax3 addr of EXIT point
343 " eax6 type of the father proc : 0 or monormod :1
344 " tsp3 0|<operator number>
345 "
346 "
347 "
348 process_entry:
349 "
350 " first save registers
351 "
352 eax1 save_ptr_regs
353 eax2 save_regs
354 spri 6|base_process_ptr,*x1
355 sreg 6|base_process_ptr,*x2
356 "
357 epp1 6|base_process_ptr,* PR1 <- STARTER
358 epp2 1|locals_ptr,* PR2 <- locals of STARTER
359 epp5 2|main_base_ptr,* PR5 <- Main
360 "
361 " Look for a free block to install process frame
362 "
363 continue_to_search:
364 epp2 5|0 PR2 <- PR5
365 ldaq null_ptr )
366 eraq 5|next_free_block_ptr ) Test if next free block exists
367 ana ring_number_mask )
368 tze set_on_stack_end
369 epp5 5|next_free_block_ptr,* PR5 <- next free block
370 cmpx4 5|free_block_size compare new process and free block sizes
371 tnz continue_to_search This block is not suitable
372 eaa 5|0 A <- addr of new process frame
373 epp5 5|next_free_block_ptr,* PR5 <- next free block becomming PR2's next free block
374 spri5 2|next_free_block_ptr Update free list
375 epp5 7|stack_header.stack_end_ptr,* stack end does not change
376 tra install_stack Not to modify A register
377 set_on_stack_end:
378 epp5 7|stack_header.stack_end_ptr,*x4 new stack end
379 eaa 7|stack_header.stack_end_ptr,* A <- addr of new process frame
380 install_stack:
381 stz 6|work_for_sim
382 sxl6 6|work_for_sim Store process father type
383 ldq 6|work_for_sim Q <- Store process father type
384 anq check_mo_father_type_bit Check father type
385 tze load_dlk_type
386 epp2 1|save_ptr_regs+2,* PR6 -> Dyn_link
387 new_link_again:
388 ldq 2|mo_father_type
389 anq check_mo_father_type_bit Check father type
390 epp2 2|mo_dynlk,* New dyn_link
391 tze install_stack_now
392 tra new_link_again
393 load_dlk_type:
394 epp2 1|save_ptr_regs+2,*
395 install_stack_now:
396 "
397 "
398 " At this point:
399 "
400 " PR5 -> new stack end
401 " PR2 -> Father dlink
402 " A = offset of new process stack frame
403 "
404 "
405 " PUSH stack
406 inhibit on
407 spri5 7|stack_header.stack_end_ptr
408 spri5 7|stack_frame.next_sp,au
409 spri2 7|stack_frame.prev_sp,au
410 " epp2 4|0
411 epp6 7|0,au
412 spri6 2|stack_frame.next_sp
413 inhibit off
414 " FILL stack
415 "
416 " At this point:
417 "
418 " PR0 -> pascal_operators
419 " PR1 -> starter process frame where registers are saved
420 " PR2 -> stack frame of father or dlink
421 " PR3 -> return point in code of current starting process
422 " PR4 -> linkage section
423 " PR6 -> current new stack frame
424 " PR7 -> stack base
425 "
426 epp5 1|save_ptr_regs+10,* restor PR5 entry point
427 spri5 6|stack_frame.entry_ptr
428 epbp5 3|0
429 spri5 6|stack_frame.return_ptr
430 spri0 6|stack_frame.operator_ptr
431 spri4 6|linkage_ptr
432 epp5 1|save_ptr_regs+4,* restor PR2 arg ptr
433 spri5 6|stack_frame.arg_ptr
434 epp2 1|save_ptr_regs+2,* dlink or father
435 spri2 6|dlinkw
436 "
437 epp2 1|0
438 epp1 6|-sim_locs_size,x7
439 "
440 " At this point:
441 "
442 " PR1 -> sim locals for this new proc
443 " PR2 -> starter process frame
444 "
445 "
446 "
447 spri1 6|locals_ptr
448 "
449 " Update set frame list
450 "
451 ldq 2|stack_frame.translator_id )
452 anq non_MAIN_mask ) Update sf translator_id
453 stq 6|stack_frame.translator_id )
454 anq check_bit,dl )
455 tze skip_internal_init )
456 eaa -sim_first_local_place-sim_locs_size,x7 )
457 als 2 ) Fill variable with blanck char
458 mlr pr,prrl,fill040 )
459 desc9a pr6|sim_first_local_place,0 )
460 desc9a pr6|sim_first_local_place,au )
461 skip_internal_init:
462 epp5 2|locals_ptr,*
463 epp5 5|main_base_ptr,*
464 spri5 1|main_base_ptr
465 epp5 6|0,x7 PR5 <- next simone frame
466 spri5 6|next_simone_frame_ptr
467 spri6 6|base_process_ptr PR6 -> base_process <- PR6
468 stz 1|waiting_var_sons
469 stz 1|father_type )
470 sxl6 1|father_type ) store type of the father
471 stx4 1|max_size
472 stx7 6|left_size
473 sbx4 6|left_size
474 stx4 6|left_size
475 stz 1|priority
476 stz 1|activation_time
477 stz 1|number_of_active_sons
478 aos 1|number_of_active_sons Process is its own son
479 epbp5 3|0 PR5 --> Executed module
480 epp5 5|0,x3 PR5 --> Exit point
481 spri5 1|exit_ptr Store PR5
482 epp5 null_ptr,*
483 spri5 1|next_threaded_process_ptr
484 spri5 1|previous_threaded_process_ptr
485 spri5 6|execution_mo_ptr
486 epp5 6|father_ptr,* PR5 --> father
487 ldq 1|father_type check father type --> Q
488 anq check_mo_father_type_bit compare with father of this process
489 tze proc_father transfer for proc father
490 monormod_father:
491 aos 5|mo_active_sons active_sons +:= 1
492 tra end_update_active_sons
493 proc_father:
494 epp5 5|locals_ptr,* PR5 __> locals
495 aos 5|number_of_active_sons active_sons +:= 1
496 end_update_active_sons:
497 "
498 " Put caller process in queue
499 "
500 epp5 2|0 PR5 --> process to queue
501 epp1 6|0 PR1 -> process to be started
502 tsp2 active_process_queuing active_process_queueing
503 "
504 ldi 0,dl
505 tra 3|2 ..finally, return to starting process
506 "
507 "
508 "
509 " ***************************
510 " * *
511 " * SAVE_ARG_LIST OPERATOR *
512 " * *
513 " ***************************
514 "
515 "
516 " This Operator updates pointers on the parameters
517 " which have just been copied in the new stack.
518 "
519 "
520 " Calling sequence :
521 "
522 " ldq number of parameters for this process
523 " tsp3 0|operator's number
524 "
525 "
526 save_arg_list:
527 tze save_arg_end If no parameters
528 epp2 6|stack_frame.arg_ptr,* PR2 --> arg list
529 eaa 2|2
530 sta 6|decal
531 eaa 6|sim_first_local_place
532 ssa 6|decal
533 lda 6|decal
534 epp2 6|sim_first_local_place
535 update_pointer:
536 asa 2|1
537 sbq 1,dl
538 tze save_arg_end
539 epp2 2|2
540 tra update_pointer
541 save_arg_end:
542 tra 3|0
543 "
544 "
545 "
546
547
548 " ***************************************************
549 " * *
550 " * OPERATORS DEALING WITH QUEUES *
551 " * *
552 " ***************************************************
553 "
554 "
555 "
556 "
557 " Operator setting a process in the active process queue
558 " ------------------------------------------------------
559 "
560 "
561 " The process to be put in this queue is inserted at the
562 " head of the queue.
563 "
564 "
565 " ASSUME THAT :
566 " PR1 --> FRAME of the process to be started
567 " PR5 --> FRAME of the process to be queued
568 " PR6 --> FRAME of the calling procedure
569 "
570 " MUST NOT MODIFIE PR1 PR2 PR3 PR6
571 "
572 " PR0 PR4, PR7 ARE USED BUT RESTORED
573 "
574 "
575 " Calling sequence :
576 " tsp2 0|-5
577 "
578 "
579 active_process_queuing:
580 epp7 5|locals_ptr,*
581 epp7 7|main_base_ptr,* PR7 --> main
582 ldaq null_ptr
583 epp4 7|locals_ptr,*
584 eraq 4|first_active_process_ptr Checking emptyness of the queue
585 ana ring_number_mask
586 tze first_in_queue
587 "
588 " There is already at least one process in the queue
589 " --------------------------------------------------
590 "
591 epp0 4|first_active_process_ptr,*
592 epp7 0|locals_ptr,*
593 spri5 7|previous_threaded_process_ptr
594 spri5 4|first_active_process_ptr
595 epp7 5|locals_ptr,*
596 spri0 7|next_threaded_process_ptr
597 epp0 null_ptr,*
598 spri0 7|previous_threaded_process_ptr
599 epp7 4|main_base_ptr,*
600 tra restor_ptr
601 "
602 " The queue was empty
603 " -------------------
604 "
605 first_in_queue:
606 epp4 7|locals_ptr,*
607 spri5 4|first_active_process_ptr
608 epp4 5|locals_ptr,*
609 ldaq null_ptr
610 staq 4|previous_threaded_process_ptr
611 staq 4|next_threaded_process_ptr
612 "
613 " restor now PR0, PR4, PR7
614 " ------------------------
615 "
616 restor_ptr:
617 epp0 7|stack_frame.operator_ptr,*
618 epbp7 7|0
619 epp4 6|linkage_ptr,*
620 tra 2|0
621 "
622 "
623 " Choose process operator
624 " -----------------------
625 "
626 " Asuume that PR6 --> Main_process
627 "
628 "
629 " May modifie active_process_queue or bill_book_queue
630 "
631 " Calling sequence :
632 " tra choose_process
633 "
634 "
635 choose_process:
636 epp5 6|locals_ptr,*
637 ldaq null_ptr
638 eraq 5|first_active_process_ptr
639 ana ring_number_mask
640 tnz take_in_active_queue
641 "
642 " Choose in bill_book_queue
643 " -------------------------
644
645 ldaq null_ptr
646 eraq 5|bill_book_ptr
647 ana ring_number_mask
648 tnz bill_book_ok
649 epp7 6|base_process_ptr,*
650 lpri 7|save_ptr_regs
651 epbp7 6|0
652 epp1 7|stack_header.stack_end_ptr,*
653 spri1 6|stack_frame.next_sp
654 epp1 <pascal_errors_>|dead_lock_error No process available
655 tra common_op_call
656 bill_book_ok:
657 epp4 5|bill_book_ptr,* PR4 --> Choosen process frame
658 epp2 4|locals_ptr,* PR2 --> Choosen process locals
659 lda 2|activation_time
660 sta 5|hour
661 ldaq null_ptr
662 eraq 2|next_threaded_process_ptr
663 ana ring_number_mask
664 tnz bill_book_not_empty
665 ldaq null_ptr
666 staq 5|bill_book_ptr
667 tra skip_bill_book_update
668 bill_book_not_empty:
669 epp1 2|next_threaded_process_ptr,*
670 epp7 1|locals_ptr,*
671 ldaq null_ptr
672 staq 7|previous_threaded_process_ptr
673 spri1 5|bill_book_ptr
674 skip_bill_book_update:
675 staq 2|next_threaded_process_ptr
676 epp6 4|0
677 tra activate_process
678 take_in_active_queue:
679 "
680 " Choose in active_queue
681 " ----------------------
682 "
683 epp4 5|first_active_process_ptr,* PR4 --> Choosen process frame
684 epp2 4|locals_ptr,* PR2 --> Choosen process locals
685 ldaq null_ptr
686 eraq 2|next_threaded_process_ptr
687 ana ring_number_mask
688 tnz active_queue_not_empty
689 ldaq null_ptr
690 staq 5|first_active_process_ptr
691 tra skip_active_queue_update
692 active_queue_not_empty:
693 epp1 2|next_threaded_process_ptr,*
694 epp7 1|locals_ptr,*
695 ldaq null_ptr
696 staq 7|previous_threaded_process_ptr
697 spri1 5|first_active_process_ptr
698 skip_active_queue_update:
699 staq 2|next_threaded_process_ptr
700 epp6 4|0
701 tra activate_process
702
703 "
704 " activate_process operator
705 " -------------------------
706 "
707 " Assume that : PR6 --> Base of the process to be activated
708 "
709 "
710 " Restor : PR0, PR1, PR4, PR6, PR7
711 "
712 " set PPR to the convenient address
713 "
714 "
715 " Calling sequence :
716 " tra activate_process
717 "
718 "
719 activate_process:
720 epp2 6|0
721 stack_links_loop:
722 epp3 2|locals_ptr,* PR3 -> PR2 locals
723 ldq 3|father_type
724 anq check_mo_father_type_bit
725 tze no_skip
726 epp2 2|dlinkw,* PR2 -> Dynamic link MONITOR
727 skip_monitor:
728 ldq 2|mo_father_type
729 anq check_mo_father_type_bit
730 epp2 2|mo_dynlk,* dynamic_link is a monitor
731 tnz skip_monitor
732 no_skip:
733 ldaq null_ptr
734 eraq 2|dlinkw
735 ana ring_number_mask
736 tze stack_links_ok
737 epp3 2|dlinkw,*
738 epp3 3|base_process_ptr,*
739 epp1 3|save_ptr_regs+12,*
740 spri2 1|stack_frame.next_sp
741 spri1 2|stack_frame.prev_sp
742 epp2 3|0
743 tra stack_links_loop
744 stack_links_ok:
745 epp2 6|locals_ptr,* PR2 <- PR6 locals
746 ldaq null_ptr
747 staq 2|next_threaded_process_ptr store NIL in PR6 NTP
748 staq 2|previous_threaded_process_ptr store NIL in PR6 PTP
749 lreg 6|save_regs restor regs
750 lpri 6|save_ptr_regs restor ptr_regs
751 epbp3 6|0
752 epp3 3|stack_header.stack_end_ptr,*
753 spri3 6|stack_frame.next_sp
754 epp3 6|stack_frame.return_ptr,* PR3 <- return point
755 tra 3|0
756 "
757 "
758 " ***********************************
759 " * *
760 " * WAITSONS *
761 " * *
762 " ***********************************
763 "
764 "
765 "
766 " These operators delay the end of process or monitor or
767 " module until they have no more active sons.
768 "
769 " MO_WAITSONS
770 " -----------
771 "
772 " This operator deals with monitors and modules
773 "
774 " Calling sequence:
775 "
776 " epp2 <address of the variable>
777 " tsp3 0|<operator number >
778 "
779 "
780 mo_waitsons:
781 ldq 2|mo_father_type
782 anq check_mo_father_type_bit
783 tze mo_return
784 spri1 6|work_for_sim save PR1
785 epp1 2|mo_dynlk,*
786 ldq 1|mo_active_sons
787 sbq 1,dl
788 stq 1|mo_active_sons
789 epp1 6|work_for_sim,*
790 mo_return:
791 ldq 2|mo_active_sons Load Q reg with number of active sons
792 tnz wait_later
793 tra 3|0
794 wait_later:
795 eax1 save_ptr_regs
796 eax2 save_regs
797 epp5 6|base_process_ptr,*
798 epp5 5|locals_ptr,* PR5 -> process locals
799 aos 5|waiting_var_sons Process waiting for its variables sons
800 spri 6|base_process_ptr,*x1 registers must be saved
801 sreg 6|base_process_ptr,*x2
802 tra wait
803 "
804 "
805 " WAITSONS
806 " --------
807 "
808 " This operator deals with processes
809 "
810 "
811 " Calling sequence ;
812 " tsp3 0|operator number
813 "
814 waitsons:
815 epp5 6|locals_ptr,*
816 lda 5|number_of_active_sons
817 sba 1,dl
818 sta 5|number_of_active_sons
819 tnz wait
820 tra 3|0
821 "
822 " must wait
823 " ---------
824 "
825 wait:
826 spri3 6|stack_frame.return_ptr
827 lda -1,dl
828 sta 5|priority
829 epp6 5|main_base_ptr,*
830 tra choose_process
831
832 " return from simone internal procedures
833 " --------------------------------------
834 "
835 " MUST NOT MODIFY E,A,Q AND ZERO AND NEGATIVE INDICATORS
836 "
837 " calling sequence:
838 " tra 0|92
839 "
840 " Returns to the calling procedure in the same segment
841 " PR0 , PR4 no to modify - PR6 to reset
842 "
843 sim_int_return:
844 epbp7 6|0 PR7 -> stack header
845 epp2 6|stack_frame.next_sp,*
846 epp6 6|stack_frame.prev_sp,* rPR6 -> stack frame of calling
847 spri2 6|stack_frame.next_sp
848 rtcd 6|stack_frame.return_ptr return to calling proc
849 "
850 "
851
852 " return from process after the active sons have been waited
853 " ------------------------------------------------------------
854 "
855 " Calling sequence :
856 " tra 0|operator_number
857 "
858 " Return to the next process to be reactived
859 "
860 "
861 process_return:
862 epp5 6|locals_ptr,* PR5 <- locals of the process to be terminated
863 epp1 6|father_ptr,* PR1 <- father process
864 ldq 5|father_type
865 anq check_mo_father_type_bit
866 tze proc_waiting tra if father in a process
867 ldq 1|mo_active_sons load Q with number of active sons
868 sbq 1,dl substract one
869 stq 1|mo_active_sons store new number of active sons
870 tnz return_end father must not be waken
871 link_to_find:
872 ldq 1|mo_father_type
873 anq check_mo_father_type_bit
874 tze link_found first process bound
875 epp1 1|mo_dynlk,* PR1 -> next monitor
876 tra link_to_find
877 link_found:
878 epp5 1|mo_dynlk,* to wake father if necessary
879 epp1 5|locals_ptr,* PR1 -> locals
880 ldq 1|waiting_var_sons
881 tze return_end Process is not waiting
882 tsp2 active_process_queuing tranfer to active_process_queueing
883 tra return_end
884 proc_waiting:
885 epp2 1|locals_ptr,* PR2 <- father's locals
886 lda 2|number_of_active_sons )
887 sba 1,dl ) Update father's number of active sons
888 sta 2|number_of_active_sons )
889 tnz return_end
890 "
891 " This was the last active son
892 " ----------------------------
893 "
894 epp5 6|father_ptr,* PR5 <- father that must be activated to finish
895 tsp2 0|-5 Active process queueing
896 "
897 return_end:
898 "
899 " block becomes free
900 " -------------------
901 "
902 epp5 6|locals_ptr,* PR5 -> locals of current terminating process
903 epp7 5|main_base_ptr,* PR7 <- Main
904 epp2 7|next_free_block_ptr,* PR2 <- first free block
905 spri2 6|next_free_block_ptr Insert liberated frame in free list
906 spri6 7|next_free_block_ptr
907 ldq 5|max_size
908 stq 6|free_block_size
909 epp6 7|0
910 epbp7 6|0
911 tra choose_process
912 "
913 "
914 " ***********************
915 " * *
916 " * HOLD OPERATOR *
917 " * *
918 " ***********************
919 "
920 "
921 " This operator sets in the bill_book queue the process to be hold.
922 "
923 "
924 " Calling sequence :
925 " ldx3 time to wait
926 " tsp3 0|operator_number
927 "
928 "
929 hold:
930 "
931 " first save registers
932 " --------------------
933 "
934 spri7 6|save_regs
935 epp7 6|base_process_ptr,*
936 spri3 6|stack_frame.return_ptr
937 spri 7|save_ptr_regs
938 epp5 6|base_process_ptr,* PR5 : Process to be queued
939 epp7 6|save_regs,*
940 spri7 5|save_ptr_regs+14
941 epp4 5|locals_ptr,*
942 sreg 5|save_regs
943 "
944 " Now begin queuing
945 " -----------------
946 "
947 epp0 4|main_base_ptr,* PR0 : main
948 epp0 0|locals_ptr,* PR0 : Main's locals
949 adq 0|hour
950 stq 4|activation_time
951 "
952 " cheking emptyness of the queue
953 " ------------------------------
954 "
955 ldaq null_ptr
956 eraq 0|bill_book_ptr
957 ana ring_number_mask
958 tze bill_book_was_empty
959 "
960 " the queue wasn't empty
961 " ----------------------
962 "
963 epp1 0|bill_book_ptr,* PR1 : first in the queue
964 epp2 1|locals_ptr,*
965 ldq 4|activation_time
966 cmpq 2|activation_time
967 tpnz chain_later
968 "
969 " Must be queued before C PR1
970 " -----------------------------
971 "
972 ldaq null_ptr
973 eraq 2|previous_threaded_process_ptr
974 ana ring_number_mask
975 tze insert_at_the_first_place
976 "
977 " Queuing now the process
978 " -----------------------
979 "
980 bill_book_queuing:
981 epp3 2|previous_threaded_process_ptr,* PR3 : previuos
982 spri3 4|previous_threaded_process_ptr
983 epp7 3|locals_ptr,*
984 spri5 7|next_threaded_process_ptr
985 spri1 4|next_threaded_process_ptr
986 spri5 2|previous_threaded_process_ptr
987 tra bill_book_end
988 "
989 chain_later:
990 "
991 " Was it the last in the queue ?
992 " ------------------------------
993 "
994 ldaq null_ptr
995 eraq 2|next_threaded_process_ptr
996 ana ring_number_mask
997 tze set_at_the_last_place
998 "
999 " No
1000 " --
1001 "
1002 epp1 2|next_threaded_process_ptr,*
1003 epp2 1|locals_ptr,*
1004 ldq 4|activation_time
1005 cmpq 2|activation_time
1006 tpnz chain_later
1007 tra bill_book_queuing
1008 "
1009 " bill_book was empty
1010 " -------------------
1011 "
1012 bill_book_was_empty:
1013 epp3 null_ptr,*
1014 spri3 4|next_threaded_process_ptr
1015 set_at_the_first_place:
1016 spri5 0|bill_book_ptr
1017 tra bill_book_end
1018 "
1019 " The process must be inserted at the beginning of the queue
1020 " -----------------------------------------------------------
1021 "
1022 insert_at_the_first_place:
1023 spri1 4|next_threaded_process_ptr
1024 spri5 2|previous_threaded_process_ptr
1025 tra set_at_the_first_place
1026 "
1027 " The process must be set at the end of the queue
1028 " -----------------------------------------------
1029 "
1030 set_at_the_last_place:
1031 spri5 2|next_threaded_process_ptr
1032 spri1 4|previous_threaded_process_ptr
1033 epp3 null_ptr,*
1034 spri3 4|next_threaded_process_ptr
1035 "
1036 " End
1037 " ---
1038 "
1039 bill_book_end:
1040 epp6 5|locals_ptr,*
1041 epp6 6|main_base_ptr,*
1042 tra choose_process
1043 "
1044 "
1045 "
1046 "
1047 " **************************************************
1048 " * *
1049 " * SIMONE 'S OPERATORS FOR MONITORS AND MODULES *
1050 " * *
1051 " **************************************************
1052 "
1053 "
1054 " monitor entry
1055 " -------------
1056 " This operator initializes the pseudo_stack of a monitor
1057 "
1058 " Calling sequence :
1059 " epp1 dynlk
1060 " epp2 addr of the monitor
1061 " eax1 addr of the arg_list
1062 " tsp3 0|operator number
1063 "
1064 "
1065 monitor_entry:
1066 stz 2|monitor_busy
1067 aos 2|monitor_busy
1068 epp5 7|0,x1 get pr on arg_list
1069 spri5 2|mo_arg_list_ptr and store it
1070 epp5 6|base_process_ptr,* PR5 -> PROCESS
1071 epp5 5|execution_mo_ptr,* PR5 -> previous execution_mo ptr if any
1072 spri5 2|prev_exec_mo_ptr
1073 epp5 6|base_process_ptr,* PR5 -> PROCESS
1074 spri2 5|execution_mo_ptr
1075 spri2 6|execution_mo_ptr
1076 epp5 2|mo_arg_list_ptr,* Restore PR5
1077 spri6 2|mo_father_ptr
1078 spri1 2|mo_dynlk
1079 stz 2|mo_active_sons
1080 stz 2|mo_father_type 0 if father is a process
1081 sxl6 2|mo_father_type 1 if it is a monitor
1082 ldq 2|mo_father_type Q = father_type
1083 anq check_mo_father_type_bit
1084 tze nothing_with_act_sons
1085 aos 1|mo_active_sons add one when father monormod
1086 nothing_with_act_sons:
1087 ldaq null_ptr
1088 staq 2|mon_fifo_queue_ptr
1089 staq 2|mon_fifo_queue_end_ptr
1090 staq 2|mon_signalers_queue_ptr
1091 stz 2|monitor_busy
1092 tra 3|0
1093 module_entry:
1094 epp5 7|0,x1 get pr on arg_list
1095 spri5 2|mo_arg_list_ptr and store it
1096 spri6 2|mo_father_ptr
1097 epp5 6|base_process_ptr,* PR5 -> PROCESS
1098 epp5 5|execution_mo_ptr,* PR5 -> previous execution_mo ptr if any
1099 spri5 2|prev_exec_mo_ptr
1100 epp5 6|base_process_ptr,* PR5 -> PROCESS
1101 spri2 5|execution_mo_ptr
1102 spri2 6|execution_mo_ptr
1103 spri1 2|mo_dynlk
1104 stz 2|mo_father_type 0 if father is a process
1105 sxl6 2|mo_father_type 1 if it is a monitor
1106 stz 2|mo_active_sons
1107 ldq 2|mo_father_type Q = father_type
1108 anq check_mo_father_type_bit
1109 tze end_init_mo
1110 aos 1|mo_active_sons add one when father monormod
1111 end_init_mo:
1112 tra 3|0
1113 "
1114 "
1115 "
1116 "
1117 " RESTOR_PREV_EXEC_MO
1118 " --------------------
1119 "
1120 "
1121 " This operator restors in execution_mo_ptr word in process stack
1122 " the address of the requested monitor or module that has possibly
1123 " be altered by another monitor or module initialisation.
1124 "
1125 " Calling sequence :
1126 " tsp3 0|operator_numbrer
1127 "
1128 " Assumes that PR2 -> just initialized monitor
1129 "
1130 "
1131 restor_prev_mo:
1132 spri1 6|work_for_sim save pr1
1133 epp1 6|base_process_ptr,* PR1 -> base of the process
1134 epp2 2|prev_exec_mo_ptr,* PR2 -> requested monitor or module
1135 spri2 1|execution_mo_ptr store it
1136 epp1 6|work_for_sim,* restor PR1
1137 tra 3|0
1138 "
1139 "
1140 "
1141 " INIT_COND OPERATOR
1142 " -------------------
1143 "
1144 " This operator initializes conditions
1145 "
1146 " assumed that pr2 -> condition to br init
1147 " calling sequence :
1148 " tsp3 pr0|operator_number
1149 "
1150 init_cond:
1151 epp1 null_ptr,*
1152 spri1 pr2|cond_queue_ptr
1153 spri1 pr2|cond_queue_end_ptr
1154 stz pr2|cond_counter
1155 tra pr3|0
1156 "
1157 "
1158 " OPERATOR ASK_FOR_EXCLUSION
1159 " --------------------------
1160 "
1161
1162 " This operator is called when a process need the exclusion of a
1163 " monitor i.e when it calls an entry_point of this monitor
1164 " If the monitor is busy the process can enter it, otherwise it
1165 " is set in the queue.
1166 "
1167 " assume that pr2 --> monitor required
1168 "
1169 " calling sequence:
1170 " tsp3 0|operator number
1171 "
1172 "
1173 ask_for_exclusion:
1174 ldq 2|monitor_busy is monitor busy ?
1175 tze take_exclusion
1176 "
1177 " process must be queued
1178 " first save registers
1179 "
1180 spri7 6|save_regs save PR7
1181 epp7 6|base_process_ptr,* PR7 <- Process body stack
1182 spri3 6|stack_frame.return_ptr save stack_frame return point
1183 spri 7|save_ptr_regs save ptr regs
1184 epp5 6|base_process_ptr,* PR5 <- Process to be queued
1185 epp7 6|save_regs,* restor PR7
1186 spri7 5|save_ptr_regs+14 save real PR7 value
1187 epp4 5|locals_ptr,* PR4 <- PR5 locals
1188 sreg 5|save_regs save regs
1189 "
1190 " now queue the process
1191 "
1192 ldaq null_ptr )
1193 eraq 2|mon_fifo_queue_ptr ) is the queue empty ?
1194 ana ring_number_mask )
1195 tze set_in_fifo_queue
1196 epp1 2|mon_fifo_queue_end_ptr,* PR1 <- last in the queue
1197 epp4 1|locals_ptr,* PR4 <- PR1 locals
1198 spri5 4|next_threaded_process_ptr store PR5 as PR1 NTP
1199 epp4 5|locals_ptr,* PR4 <- PR5 locals
1200 spri1 4|previous_threaded_process_ptr store PR1 as PR5 PTP
1201 tra add_in_fifo_queue
1202 set_in_fifo_queue:
1203 spri5 2|mon_fifo_queue_ptr store PR5 as the 1st FIFO queued Process
1204 add_in_fifo_queue:
1205 spri5 2|mon_fifo_queue_end_ptr store PR5 as the last FIFO queued process
1206 ldaq null_ptr
1207 staq 4|next_threaded_process_ptr store NIL as PR5 NTP
1208 "
1209 " now select process to activate
1210 " Monitor is busy so select only in active_process_queue
1211 " or in bill_book
1212 "
1213 "
1214 epp6 4|main_base_ptr,* PR6 <- Main process stack
1215 tra choose_process
1216 take_exclusion:
1217 aos 2|monitor_busy
1218 spri5 6|work_for_sim save PR5
1219 epp5 6|base_process_ptr,* PR5 <- process stack
1220 spri2 5|execution_mo_ptr store PR2 as PR5 exec monit
1221 spri5 2|mon_tenant_process_ptr store PR5 as PR2 holding process
1222 epp5 6|work_for_sim,* restor PR5
1223 tra 3|0
1224
1225
1226 "
1227 " OPERATOR FREE_EXCLUSION
1228 "
1229 "
1230 " This operator is called when a process leaves a monitor.
1231 " assume that pr2 --> monitor to be freed
1232 "
1233 " calling sequence:
1234 " tsp3 0|operator_number
1235 "
1236 free_exclusion:
1237 spri5 6|work_for_sim save PR5
1238 epp5 6|base_process_ptr,* PR5 --> proces' base
1239 ldaq null_ptr
1240 staq 5|execution_mo_ptr normal execution
1241 epp5 6|work_for_sim,* restor PR5
1242 eraq 2|mon_signalers_queue_ptr
1243 ana ring_number_mask
1244 tnz select_act_proc
1245 ldaq null_ptr
1246 eraq 2|mon_fifo_queue_ptr
1247 ana ring_number_mask
1248 tnz select_fifo_proc
1249 "
1250 " if no other process selected just free monitor
1251 "
1252 stz 2|monitor_busy
1253 tra 3|0
1254 select_act_proc:
1255 "
1256 " process must be queued
1257 " first save registers
1258 "
1259 spri7 6|save_regs save PR7
1260 epp7 2|mon_tenant_process_ptr,* PR7 <- holding process
1261 spri3 6|stack_frame.return_ptr save return point
1262 spri 7|save_ptr_regs save ptr_regs
1263 epp5 2|mon_tenant_process_ptr,* PR5 : Process to be queued
1264 epp7 6|save_regs,* restor PR7
1265 spri7 5|save_ptr_regs+14 save PR7 real value
1266 epp4 5|locals_ptr,* PR4 <- holding process locals
1267 sreg 5|save_regs save regs
1268 epp1 2|mon_signalers_queue_ptr,* PR1 <- first signaller
1269 epp4 1|locals_ptr,* PR4 <- locals
1270 epp4 4|next_threaded_process_ptr,* PR4 <- New first sgnaller
1271 spri4 2|mon_signalers_queue_ptr Store it
1272 tra select_end
1273
1274
1275 select_fifo_proc:
1276 "
1277 " process must be queued
1278 " first save registers
1279 "
1280 spri7 6|save_regs
1281 epp7 2|mon_tenant_process_ptr,*
1282 spri3 6|stack_frame.return_ptr
1283 spri 7|save_ptr_regs
1284 epp5 2|mon_tenant_process_ptr,* PR5 : Process to be queued
1285 epp7 6|save_regs,*
1286 spri7 5|save_ptr_regs+14
1287 epp4 5|locals_ptr,*
1288 sreg 5|save_regs
1289 epp1 2|mon_fifo_queue_ptr,*
1290 epp4 1|locals_ptr,*
1291 epp4 4|next_threaded_process_ptr,*
1292 spri4 2|mon_fifo_queue_ptr
1293 select_end:
1294 spri2 5|work_for_sim
1295 tsp2 0|-5
1296 epp2 5|work_for_sim,*
1297 "
1298 " PR1 MUST BE ACTVATED
1299 " ----------------------
1300 "
1301 spri2 1|execution_mo_ptr
1302 spri1 2|mon_tenant_process_ptr
1303 epp6 1|0
1304 tra activate_process
1305 "
1306 "
1307 "
1308 "
1309 " EXIT OPERATOR
1310 " --------------
1311 "
1312 "
1313 " This operator is called when a process executes an EXIT instruction
1314 " anywhwere but during its body execution.
1315 " In such a case the process is executing a non pure procedure and
1316 " therefor the execution occurs inside the process pseudo stack.
1317 " This procedure may be a monitor's one. Then the concerned one is
1318 " to be freed.
1319 " At least the stack is to be cleared as in the case of a ordinary
1320 " procedure termination. Then the process ends waiting its active
1321 " sons and closing its variables.
1322 "
1323 "
1324 "
1325 " Calling sequence :
1326 "
1327 " tra 0|operator_number
1328 "
1329 exit:
1330 epp5 6|base_process_ptr,* PR5 --> Process' base
1331 ldaq null_ptr
1332 eraq 5|execution_mo_ptr Monitor or module proc ?
1333 ana ring_number_mask
1334 tze just_update_ptrs
1335 epp2 5|execution_mo_ptr,* PR2 --> concerned object
1336 ldq 2|mo_type Monitor ?
1337 tze just_update_ptrs
1338 tsp3 free_exclusion Monitor to free
1339 just_update_ptrs:
1340 inhibit on
1341 epp1 6|stack_frame.next_sp,*
1342 spri1 5|stack_frame.next_sp Update stack_frame
1343 epp6 5|0
1344 inhibit off
1345 epp3 6|locals_ptr,* PR3 --> locals
1346 epp3 3|exit_ptr,* Process end
1347 tra 3|0
1348
1349 "
1350 "
1351 "
1352 " ***************************************
1353 " * *
1354 " * OPERATORS DEALING WITH CONDITIONS *
1355 " * *
1356 " ***************************************
1357 "
1358 "
1359 " SIGNAL_OPERATOR
1360 " ---------------
1361 "
1362 " assume that pr2 --> condition affected
1363 "
1364 " calling sequence:
1365 " tsp3 0|operator number
1366 "
1367 signal:
1368 ldq 2|cond_counter
1369 tze nothing
1370 "
1371 " save context
1372 "
1373 spri7 6|save_regs
1374 epp7 6|base_process_ptr,*
1375 spri 7|save_ptr_regs
1376 epp5 6|base_process_ptr,* PR5 : Process to be queued
1377 spri3 6|stack_frame.return_ptr
1378 epp4 5|locals_ptr,*
1379 epp7 6|save_regs,*
1380 spri7 5|save_ptr_regs+14
1381 sreg 5|save_regs
1382 "
1383 " now set proc in signaller's queue
1384 "
1385 epp5 6|base_process_ptr,*
1386 epp1 5|execution_mo_ptr,*
1387 ldaq null_ptr
1388 eraq 1|mon_signalers_queue_ptr
1389 ana ring_number_mask
1390 tze no_signaler
1391 epp7 1|mon_signalers_queue_ptr,* PR7 -> first waiting process in monitor
1392 epp4 7|locals_ptr,*
1393 spri5 4|previous_threaded_process_ptr store NTP
1394 epp4 5|locals_ptr,* PR4 -> PR5's locals
1395 spri7 4|next_threaded_process_ptr
1396 tra skip_no_signaler
1397 no_signaler:
1398 ldaq null_ptr
1399 staq 4|next_threaded_process_ptr
1400 skip_no_signaler:
1401 ldaq null_ptr
1402 staq 4|previous_threaded_process_ptr
1403 spri5 1|mon_signalers_queue_ptr
1404 "
1405 " UPDATE NOW COND_QUEUE
1406 "
1407 epp5 2|cond_queue_ptr,*
1408 ldq 2|cond_counter
1409 sbq 1,dl
1410 stq 2|cond_counter
1411 tze cond_queue_empty
1412 epp4 5|locals_ptr,*
1413 ldaq null_ptr
1414 staq 4|previous_threaded_process_ptr
1415 epp4 4|next_threaded_process_ptr,*
1416 spri4 2|cond_queue_ptr
1417 cond_queue_empty:
1418 "
1419 " AND ACTIVATE PROCESS
1420 "
1421 spri5 1|mon_tenant_process_ptr
1422 spri1 5|execution_mo_ptr
1423 epp6 5|0
1424 tra activate_process
1425 nothing:
1426 tra 3|0
1427 "
1428 "
1429 " WAIT OPERATOR
1430 " -------------
1431 "
1432 " This operator is called when a process needs to wait on
1433 " a condition. It queues the process in the condition queue and acti-
1434 " vate another one
1435 "
1436 " assumed that pr2 --> condition
1437 "
1438 " calling sequence:
1439 " tsp3 0|operator number
1440 "
1441 cwait:
1442 "
1443 " SAVE CONTEXT
1444 "
1445 spri7 6|save_regs
1446 epp7 6|base_process_ptr,*
1447 spri3 6|stack_frame.return_ptr
1448 spri 7|save_ptr_regs
1449 epp5 6|base_process_ptr,* PR5 : Process to be queued
1450 epp4 5|locals_ptr,* PR4 --> Locals
1451 epp7 6|save_regs,*
1452 spri7 5|save_ptr_regs+14
1453 sreg 5|save_regs
1454 sta 4|priority store priority
1455 "
1456 " NOW QUEUE PROCESS
1457 "
1458 ldq 2|cond_counter
1459 tze init_cond_queue
1460 epp1 2|cond_queue_end_ptr,* PR1 -> last process in the queue
1461 epp7 1|locals_ptr,* PR7 -> locals
1462 cmpa 7|priority compare with new_process' prioriry
1463 tmi not_at_end if new process priority < last
1464 "
1465 " AT THE END OF THE QUEUE
1466 "
1467 spri1 4|previous_threaded_process_ptr
1468 spri5 7|next_threaded_process_ptr
1469 tra end_init_cond
1470 "
1471 " THE QUEUE WAS EMPTY
1472 "
1473 init_cond_queue:
1474 ldaq null_ptr
1475 staq 4|previous_threaded_process_ptr
1476 spri5 2|cond_queue_ptr
1477 end_init_cond:
1478 spri5 2|cond_queue_end_ptr
1479 ldaq null_ptr
1480 staq 4|next_threaded_process_ptr
1481 tra select_process
1482 "
1483 "
1484 " PROCESS IS NOT TO BE END QUEUED
1485 "
1486 not_at_end:
1487 epp1 2|cond_queue_ptr,* PR1 --> 1st in queue
1488 epp7 1|locals_ptr,* PR7 --> locals
1489 cmpa 7|priority compare priorities
1490 tpl insert_inside
1491 "
1492 "
1493 " PROCESS QUEUED AT THE BEGINNING
1494 "
1495 "
1496 spri5 7|previous_threaded_process_ptr update queue
1497 spri1 4|next_threaded_process_ptr
1498 ldaq null_ptr
1499 staq 4|previous_threaded_process_ptr
1500 spri5 2|cond_queue_ptr update cond : Beginning of the queue
1501 tra select_process
1502 "
1503 "
1504 " PROCESS TO BE QUEUED INSIDE THE QUEUE
1505 "
1506 "
1507 insert_inside:
1508 ldq 4|priority proc tb queue's priority in Q
1509 insert_later:
1510 epp1 7|next_threaded_process_ptr,* PR1 --> Next in queue
1511 epp7 1|locals_ptr,* PR7 --> PR1's locals
1512 cmpq 7|priority
1513 tpl insert_later
1514 "
1515 "
1516 " PROCESS TO BE QUEUED BEFORE PR1
1517 "
1518 "
1519 spri1 4|next_threaded_process_ptr
1520 epp0 7|previous_threaded_process_ptr,*
1521 spri0 4|previous_threaded_process_ptr
1522 spri5 7|previous_threaded_process_ptr
1523 epp1 0|locals_ptr,*
1524 spri5 1|next_threaded_process_ptr
1525 "
1526 " NOW SELECT PROCESS TO BE RESTARTED
1527 "
1528 select_process:
1529 aos 2|cond_counter update cond : counter +:= 1
1530 epp1 5|execution_mo_ptr,*
1531 ldaq null_ptr
1532 eraq 1|mon_signalers_queue_ptr
1533 ana ring_number_mask
1534 tze fifoq
1535 "
1536 " SELECTED IN SIGNALERS' QUEUE
1537 "
1538 epp2 1|mon_signalers_queue_ptr,*
1539 epp7 2|locals_ptr,*
1540 epp4 7|next_threaded_process_ptr,*
1541 spri4 1|mon_signalers_queue_ptr
1542 tra activproc
1543 "
1544 fifoq:
1545 ldaq null_ptr
1546 eraq 1|mon_fifo_queue_ptr
1547 ana ring_number_mask
1548 tze algonorm
1549 "
1550 " SELECTED IN FIFO QUEUE
1551 "
1552 epp2 1|mon_fifo_queue_ptr,*
1553 epp7 2|locals_ptr,*
1554 epp4 7|next_threaded_process_ptr,*
1555 spri4 1|mon_fifo_queue_ptr
1556 tra activproc
1557 "
1558 " SELECT IN MAIN'S QUEUES
1559 "
1560 algonorm:
1561 epp2 5|execution_mo_ptr,*
1562 stz 2|monitor_busy
1563 epp1 5|locals_ptr,*
1564 epp6 1|main_base_ptr,*
1565 tra choose_process
1566 "
1567 " ACTIVPROC
1568 "
1569 activproc:
1570 spri2 1|mon_tenant_process_ptr
1571 spri1 2|execution_mo_ptr
1572 epp6 2|0
1573 tra activate_process
1574 "
1575 "
1576 "
1577 " PRIORITY
1578 " --------
1579 "
1580 " This operator returns the priority of the ieme process blocked on
1581 " a specified condition. If no process matches with this criteria
1582 " then returns -1 ;
1583 "
1584 "
1585 " Calling sequence :
1586 "
1587 " epp2 condition
1588 " ldq i
1589 " tsp3 operator_number
1590 "
1591 "
1592 priority_op:
1593 cmpq 2|cond_counter Is i too large?
1594 tmoz cont
1595 lda moinsun i is too large
1596 tra 3|0 return
1597 cont:
1598 stz 6|op_work +1 at each step
1599 aos 6|op_work
1600 epp5 2|cond_queue_ptr,* PR5 --> 1st waiting process
1601 epp1 5|locals_ptr,* PR1 --> locals
1602 cmpq 6|op_work right process ?
1603 tze priority_end
1604 priority_deb:
1605 aos 6|op_work
1606 epp5 1|next_threaded_process_ptr,* PR5 --> next
1607 epp1 5|locals_ptr,* PR1 --> locals
1608 cmpq 6|op_work right process ?
1609 tpnz priority_deb
1610 priority_end:
1611 lda 1|priority
1612 tra 3|0
1613 "
1614 "
1615 " EMPTY
1616 " -----
1617 "
1618 " This operator verifies wether a condition 's queue is empty or not
1619 "
1620 "
1621 " Calling sequence:
1622 "
1623 " epp2 <requested condition>
1624 " tsp3 0|operator number
1625 "
1626 "
1627 empty:
1628 lda 2|cond_counter
1629 tze empty_cond
1630 lda 1,dl
1631 tra empty_end
1632 empty_cond:
1633 lda 0,dl
1634 empty_end:
1635 tra 3|0
1636 "
1637 "
1638 "
1639 " LENGTH
1640 " ------
1641 "
1642 "
1643 length:
1644 lda 2|cond_counter
1645 tra 3|0
1646 "
1647 "
1648 "
1649 " *********
1650 " * *
1651 " * VTIME *
1652 " * *
1653 " *********
1654 "
1655 "
1656 " RETURN VIRTAL TIME
1657 "
1658 " Calling sequence :
1659 " tra 3|operator number
1660 "
1661 "
1662 vtime:
1663 spri1 6|save_regs
1664 epp1 6|base_process_ptr,*
1665 epp1 1|locals_ptr,*
1666 epp1 1|main_base_ptr,*
1667 epp1 1|locals_ptr,*
1668 lda 1|hour
1669 epp1 6|save_regs,*
1670 tra 3|0
1671 "
1672 "
1673 "
1674 " TERMINATE OPERATOR
1675 " ------------------
1676 "
1677 "
1678 " Set pr6 on main and then call return
1679 "
1680 "
1681 " Calling sequence :
1682 "
1683 " tsp3 0|operator number
1684 "
1685 "
1686 terminate:
1687 epp6 6|base_process_ptr,*
1688 epp6 6|locals_ptr,*
1689 epp6 6|main_base_ptr,*
1690 tra 3|0
1691 "
1692 "
1693 "
1694 "
1695 "
1696 " *******************
1697 " * RANDOM FUNCIONS *
1698 " * OPERATORS *
1699 " *******************
1700 "
1701 "
1702 " NORMAL
1703 " ------
1704 "
1705 " Generates a random number greater than -6.0 and less than
1706 " 6.0 with a normal distribution by call to the random_$normal
1707 " subroutine.
1708 " The seed is passed as the first argument in the argument
1709 " list and the results is stored as the second one. The result is on
1710 " one word and has to be extended as a double word.
1711 "
1712 "
1713 " Assumed that arg list is built as follow :
1714 "
1715 "
1716 "
1717 " --------------------- 0
1718 " | arg list header |
1719 " --------------------- 2
1720 " | ptr on seed |
1721 " --------------------- 4
1722 " | ptr on result |
1723 " --------------------- 6
1724 "
1725 " Calling sequence:
1726 "
1727 " epp2 <argument list>
1728 " tsp3 0|<operator_number>
1729 "
1730 "
1731 normal:
1732 ora 4,dl
1733 spri 6|op_work save pointers registers
1734 sreg 6|save_regs save other registers
1735 epaq 0,ic
1736 lprp4 7|stack_header.lot_ptr,*au
1737 ldaq 6|save_regs+4
1738 staq 2|0 update arg list
1739 epp0 2|0 PR0 --> arg list
1740 epp1 6|base_process_ptr,*
1741 epp1 1|locals_ptr,*
1742 epp1 1|main_base_ptr,*
1743 epp1 1|stack_frame.operator_ptr,*
1744 spri1 6|stack_frame.operator_ptr
1745 epp2 3,ic PR2 --> return
1746 spri2 6|stack_frame.return_ptr store return
1747 tsp3 <random_>|normal call normal
1748 tra norm_unif_end for result expansion
1749 "
1750 "
1751 "
1752 " UNIFORM
1753 " --------
1754 "
1755 "
1756 " Generates a random number with a value between 0.0 and
1757 " 1.0 with a unifrom distribution by call to the random_$uniform
1758 " subroutine.
1759 " The seed is passed as the first argument in the argument
1760 " list and the results is stored as the second one. The result is on
1761 " one word and has to be extended as a double word.
1762 "
1763 "
1764 "
1765 " Assumed that arg list is built as follow:
1766 "
1767 "
1768 " --------------------- 0
1769 " | arg list header |
1770 " --------------------- 2
1771 " | ptr on seed |
1772 " --------------------- 4
1773 " | ptr on result |
1774 " --------------------- 6
1775 "
1776 " Calling sequence:
1777 "
1778 " epp2 <argument list>
1779 " tsp3 0|<operator_number>
1780 "
1781 "
1782 uniform:
1783 ora 4,dl
1784 spri 6|op_work save pointers registers
1785 sreg 6|save_regs save other registers
1786 epaq 0,ic
1787 lprp4 7|stack_header.lot_ptr,*au
1788 ldaq 6|save_regs+4
1789 staq 2|0 update arg list
1790 epp0 2|0 PR0 --> arg list
1791 epp1 6|base_process_ptr,*
1792 epp1 1|locals_ptr,*
1793 epp1 1|main_base_ptr,*
1794 epp1 1|stack_frame.operator_ptr,*
1795 spri1 6|stack_frame.operator_ptr
1796 epp2 3,ic PR2 --> return
1797 spri2 6|stack_frame.return_ptr store return
1798 tsp3 <random_>|uniform call uniform
1799 norm_unif_end:
1800 epp2 6|op_work+4,* restor pr2
1801 epp2 2|4,* pr2 --> result
1802 stz 2|1 expand result
1803 tra common_random_return
1804 negexp:
1805 "
1806 "
1807 "
1808 "
1809 "
1810 " RANDINT
1811 " -------
1812 "
1813 "
1814 " Generates a random number with a value between two
1815 " bounds given by the programmer and an uniform distribution inside
1816 " this bounds.
1817 " First call random_$uniform and updates result just like
1818 " uniform operator does.
1819 " Then computes :
1820 " result * high_bound - low_bound + 1 * low_bound
1821 " At least call trunc operator to get an integer as the
1822 " result.
1823 "
1824 " Assumed that arg list is built as follw ;
1825 "
1826 " --------------------- 0
1827 " | arg list header |
1828 " --------------------- 2
1829 " | ptr on seed |
1830 " --------------------- 4
1831 " | ptr on result |
1832 " --------------------- 6
1833 " | ptr on low bound |
1834 " --------------------- 8
1835 " | ptr on high bound |
1836 " ---------------------
1837 "
1838 "
1839 " Calling sequence:
1840 " epp2 <argument list>
1841 " tsp3 0|<operator number>
1842 "
1843 "
1844 randint:
1845 ora 4,dl
1846 spri 6|op_work save pointers registers
1847 sreg 6|save_regs save other registers
1848 epaq 0,ic
1849 lprp4 7|stack_header.lot_ptr,*au
1850 ldaq 6|save_regs+4
1851 staq 2|0 update arg list
1852 epp0 2|0 PR0 --> arg list
1853 epp1 6|base_process_ptr,*
1854 epp1 1|locals_ptr,*
1855 epp1 1|main_base_ptr,*
1856 epp1 1|stack_frame.operator_ptr,*
1857 spri1 6|stack_frame.operator_ptr necessary to return from random
1858 epp2 3,ic PR2 --> return
1859 spri2 6|stack_frame.return_ptr store return
1860 tsp3 <random_>|uniform call uniform
1861 epp2 6|op_work+4,* restor pr2
1862 epp2 2|4,* pr2 --> result
1863 stz 2|1 expand result
1864 epp1 6|op_work+4,* PR1 --> arg list
1865 epp3 1|8,* PR3 --> high_bound
1866 lda 3|0 load A with high_bound
1867 epp5 1|6,* PR5 --> low_bound
1868 sba 5|0 A := high_bound - low_bound
1869 sta 3|0 store A
1870 aos 3|0 add one
1871 epp0 6|op_work,* PR0 --> pascal_operators
1872 ldq 3|0 load Q
1873 tsp3 0|32 Convert integer to real
1874 dfmp 2|0 multiply
1875 dfst 2|0 store intermediate result
1876 ldq 5|0 Load Q for convertion
1877 tsp3 0|32 Convert integer to real
1878 dfad 2|0 add low_bound
1879 spri0 2|2 for op_work is modified by TRUNC
1880 tsp3 0|63 call TRUNC operator
1881 sta 2|0 store reel result
1882 epp0 2|2,* restor pr0
1883 spri0 6|op_work store PR0 at the right place
1884 common_random_return:
1885 lpri 6|op_work restor pointer registers
1886 lreg 6|save_regs restor other registers
1887 tra 3|0 return
1888 "
1889 "
1890 "
1891 "
1892 "
1893 "END INCLUDE simone_operators_.incl.alm