1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  6         *                                                         *
  7         *********************************************************** */
  8 
  9 
 10 
 11 /****^  HISTORY COMMENTS:
 12   1) change(2021-11-06,Swenson), approve(2021-11-06,MCR10100),
 13      audit(2021-11-07,GDixon), install(2021-11-07,MR12.8-1007):
 14      Updated MTB reference in comments to refer to correct MTB.
 15                                                    END HISTORY COMMENTS */
 16 
 17 
 18 
 19 /* format: style4,delnl,insnl,ifthenstmt,indnoniterend */
 20 mcs_timer:
 21      procedure ();
 22 
 23 MAIN_RETURN:                                                /* This is the only way out of this program. Everything */
 24           return;                                           /* does a non-local goto to here */
 25 
 26 /* *      MCS_TIMER -- Ring zero MCS timer manager
 27    *
 28    *      This procedure implements timers for ring zero MCS. When a timer comes due,
 29    *      a TIMER interrupt is delivered to the lucky channel. For all the frankly
 30    *      fascinating details, see MTB-580 ("Timers in Ring Zero MCS").
 31    *
 32    *      Written 24 March 1982, W. Olin Sibert, for the ASEA Hyperchannel project.
 33    *      Modification history:
 34    *      24 Mar 82, WOS: Initial coding, for the ASEA Hyperchannel project.
 35    *      30 May 82, WOS: Added subchan_idx parameters, changed timer_id to bit (36).
 36    *      October 1982, CAH: Redesigned to use an hproc.
 37 */
 38 
 39 declare  P_devx fixed bin parameter;                        /* Channel number */
 40 declare  P_subchan_idx fixed bin parameter;                 /* Index of subchannel timer belongs to */
 41 declare  P_time fixed bin (71) parameter;                   /* Time for timer to come due */
 42 declare  P_timer_id bit (36) aligned parameter;             /* Timer ID caller uses to tell timers apart */
 43 
 44 declare  devx fixed bin;                                    /* Local copies of parameters */
 45 declare  subchan_idx fixed bin;
 46 declare  time fixed bin (71);
 47 declare  timer_id bit (36) aligned;
 48 
 49 declare  wire_mask fixed bin (71);                          /* pmut$wire_and_mask info */
 50 declare  wire_ptr pointer;
 51 declare  start_time fixed bin (71);                         /* Time mcs_timer was entered, for metering */
 52 
 53 declare  timer_found bit (1) aligned;                       /* Whether locate_timer found this sort of timer anywhere */
 54 declare  timer_was_queued bit (1) aligned;                  /* Whether the located timer was in the interrupt queue */
 55 declare  channel_locked bit (1) aligned;                    /* we managed to lock channel */
 56 
 57 declare  pds$processid bit (36) aligned external static;
 58 
 59 declare  channel_manager$queued_interrupt entry (fixed bin, fixed bin, bit (72) aligned);
 60 declare  privileged_mode_ut$wire_and_mask entry (fixed bin (71), pointer);
 61 declare  privileged_mode_ut$unwire_unmask entry (fixed bin (71), pointer);
 62 declare  pxss$unique_ring_0_wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35));
 63 declare  syserr entry options (variable);
 64 declare  tty_lock$check_for_interrupt entry (fixed bin, fixed bin, bit (72) aligned) returns (bit (1) aligned);
 65 declare  tty_lock$dequeue_one_interrupt entry (fixed bin, fixed bin, bit (72) aligned);
 66 declare  tty_lock$dequeue_all_interrupts entry (fixed bin, fixed bin);
 67 declare  tty_lock$lock_channel_int entry (fixed bin, fixed bin, bit (72) aligned, bit (1) aligned);
 68 declare  tty_lock$unlock_channel_int entry (fixed bin);
 69 
 70 declare  (addr, clock, null, pointer, rel, size, stacq, unspec) builtin;
 71 
 72 /* format: on */
 73 %page;
 74 mcs_timer$set:
 75      entry (P_devx, P_subchan_idx, P_time, P_timer_id);
 76 
 77           devx = P_devx;
 78           time = P_time;
 79           call get_id_and_subchan ();
 80 
 81           call setup_channel ();
 82 
 83           call locate_timer ();
 84 
 85           if timer_found then call timer_error ("Duplicate timer ID. Cannot set");
 86 
 87           call allocate_timer_block ();                     /* Get space for the new timer */
 88 
 89           call fill_timer_block ();                         /* and fill it in */
 90 
 91           call thread_timer_block ();                       /* Add it to the lists */
 92 
 93           call finished (tty_buf.timer_call_time, tty_buf.timer_set_calls);
 94                                                             /* All done */
 95           call unlock_timer_lock ();
 96           goto MAIN_RETURN;                                 /* Depart */
 97 %page;
 98 mcs_timer$change:
 99      entry (P_devx, P_subchan_idx, P_time, P_timer_id);
100 
101           devx = P_devx;
102           time = P_time;
103           call get_id_and_subchan ();
104 
105           call setup_channel ();
106 
107           call locate_timer ();
108 
109           if ^timer_found then call timer_error ("Timer not found. Cannot change");
110 
111           if timer_was_queued then do;
112                call tty_lock$dequeue_one_interrupt (devx, TIMER, unspec (timer_info));
113                                                             /* If it came from the interrupt queue, must get a new */
114                call allocate_timer_block ();                /* timer block. Otherwise, we can just re-use the old one */
115                end;
116           else call unthread_timer_block ();
117 
118           call fill_timer_block ();
119 
120           call thread_timer_block ();
121 
122           call finished (tty_buf.timer_call_time, tty_buf.timer_change_calls);
123 
124           call unlock_timer_lock ();
125 
126           goto MAIN_RETURN;                                 /* Depart */
127 %page;
128 mcs_timer$reset:
129      entry (P_devx, P_subchan_idx, P_timer_id);
130 
131           devx = P_devx;
132           call get_id_and_subchan ();
133 
134           call setup_channel ();
135 
136           call locate_timer ();
137 
138           if ^timer_found then call timer_error ("Timer not found. Cannot reset");
139 
140           if timer_was_queued
141           then call tty_lock$dequeue_one_interrupt (devx, TIMER, unspec (timer_info));
142           else do;                                          /* Remove from the lists and free */
143                call unthread_timer_block ();
144                call free_timer_block ();
145                end;
146 
147           call finished (tty_buf.timer_call_time, tty_buf.timer_reset_calls);
148 
149           call unlock_timer_lock ();
150 
151           goto MAIN_RETURN;                                 /* Depart */
152 %page;
153 mcs_timer$reset_all:
154      entry (P_devx);
155 
156           devx = P_devx;
157           call setup_channel ();
158 
159           call tty_lock$dequeue_all_interrupts (devx, TIMER);
160                                                             /* Get the urgent ones first */
161 
162           do while (lcte.timer_offset ^= ""b);              /* Keep flushing from the front of the queue */
163                timer_ptr = pointer (ttybp, lcte.timer_offset);
164                call unthread_timer_block ();
165                call free_timer_block ();
166           end;
167 
168           call finished (tty_buf.timer_call_time, tty_buf.timer_reset_calls);
169                                                             /* There. That was easy, wasn't it? */
170 
171           call unlock_timer_lock ();
172 
173           goto MAIN_RETURN;                                 /* Depart */
174 %page;
175 mcs_timer$verify_lock:
176      entry ();
177 
178           ttybp = addr (tty_buf$);                          /* We can't call setup_global, since this entry doesn't */
179                                                             /* follow the usual conventions about locking */
180           if (tty_buf.timer_lock = pds$processid)
181           then call syserr (CRASH, "mcs_timer: Crawlout with MCS timer lock locked.");
182 
183           return;                                           /* not likely, but better than falling through */
184 %page;
185 /* This is called by mcs_timer_daemon to do the work */
186 
187 mcs_timer$poll:
188      entry () returns (fixed bin (71));
189 
190           call setup_global ();
191 
192 POLLING_LOOP:
193           if tty_buf.next_timer_offset = ""b then do;       /* No more left */
194                call finished (tty_buf.timer_polling_time, tty_buf.timer_poll_calls);
195                call unlock_timer_lock ();
196                return (0);
197                end;
198 
199           timer_ptr = pointer (ttybp, tty_buf.next_timer_offset);
200                                                             /* Find the first one to deliver */
201           time = timer.time;                                /* Copy data from the timer */
202           timer_id = timer.data;                            /* since we are about to free it */
203           devx = timer.devx;
204           subchan_idx = timer.subchan_idx;
205 
206           if (time > clock ()) then do;                     /* No more left */
207                call finished (tty_buf.timer_polling_time, tty_buf.timer_poll_calls);
208                call unlock_timer_lock ();
209                return (time);
210                end;
211 
212           call unthread_timer_block ();
213 
214           call free_timer_block ();
215 
216           timer_info.id = timer_id;
217           timer_info.subchan_idx = subchan_idx;
218 
219           call tty_lock$lock_channel_int (devx, TIMER, unspec (timer_info), channel_locked);
220           if channel_locked then do;
221                call unlock_timer_lock ();
222                call channel_manager$queued_interrupt (devx, TIMER, unspec (timer_info));
223                call tty_lock$unlock_channel_int (devx);
224                call lock_timer_lock ();
225                end;
226 
227           goto POLLING_LOOP;
228 %page;
229 locate_timer:
230      procedure ();
231 
232 /* This procedure finds the requested timer for a channel, given the timer ID,
233    and sets the global variables to indicate its whereabouts. */
234 
235           timer_found = tty_lock$check_for_interrupt (devx, TIMER, unspec (timer_info));
236           if timer_found then do;                           /* There's one waiting for you when you get home */
237                timer_ptr = null ();                         /* for good measure */
238                timer_was_queued = "1"b;                     /* indicate where found */
239                return;
240                end;
241 
242           timer_was_queued = "0"b;
243           timer_found = "1"b;
244 
245           do timer_ptr = pointer (ttybp, lcte.timer_offset) repeat (pointer (ttybp, timer.next_for_lcte))
246                while (rel (timer_ptr) ^= ""b);
247 
248                if (timer.data = timer_id)
249                then if (timer.subchan_idx = subchan_idx) then return;
250                                                             /* Jackpot */
251 
252           end;
253 
254           timer_found = "0"b;
255           timer_ptr = null ();                              /* Again, for good measure */
256 
257           return;
258      end locate_timer;
259 %page;
260 allocate_timer_block:
261      procedure ();
262 
263 /* Procedure to get space for a timer block, and abort if it can't */
264 
265           call tty_space_man$get_space (size (timer), timer_ptr);
266           if (timer_ptr = null ()) then call timer_error ("Cannot get space to set");
267 
268           return;
269      end allocate_timer_block;
270 
271 
272 
273 free_timer_block:
274      procedure ();
275 
276 /* Procedure to return space used by a timer block */
277 
278           call tty_space_man$free_space (size (timer), timer_ptr);
279 
280           return;
281      end free_timer_block;
282 
283 
284 
285 fill_timer_block:
286      procedure ();
287 
288 /* Procedure to fill in a timer block from the global variables */
289 
290           unspec (timer) = ""b;
291           timer.devx = devx;
292           timer.subchan_idx = subchan_idx;
293           timer.data = timer_id;
294           timer.time = time;
295 
296           return;
297      end fill_timer_block;
298 %page;
299 thread_timer_block:
300      procedure ();
301 
302 /* Procedure to thread in the current timer block onto the global timer queue and the queue for the lcte */
303 /* Also updates the global variables in tty_buf */
304 
305 declare  soonest_timer_ptr pointer;
306 declare  next_timer_ptr pointer;
307 declare  prev_timer_ptr pointer;
308 declare  found_it bit (1) aligned;
309 
310 
311           lctep = addr (lct.lcte_array (timer.devx));       /* Who this one belongs to */
312 
313           if (tty_buf.next_timer_offset ^= ""b) then do;    /* Set soonest_timer_ptr to mean we need to update */
314                soonest_timer_ptr = pointer (ttybp, tty_buf.next_timer_offset);
315 
316                if (soonest_timer_ptr -> timer.time >= timer.time)
317                then soonest_timer_ptr = timer_ptr;          /* New one is soonest in the list */
318                else soonest_timer_ptr = null ();            /* Otherwise, leave it alone */
319                end;
320           else soonest_timer_ptr = timer_ptr;               /* There were none before, so this must be it */
321 
322           prev_timer_ptr = pointer (ttybp, 0);              /* Prepare to rethread */
323           next_timer_ptr = pointer (ttybp, tty_buf.next_timer_offset);
324 
325           found_it = "0"b;
326           do while ((rel (next_timer_ptr) ^= ""b) & (^found_it));
327                                                             /* Look for a place to thread it in */
328                if (next_timer_ptr -> timer.time > timer.time)
329                then found_it = "1"b;
330                else do;
331                     prev_timer_ptr = next_timer_ptr;
332                     next_timer_ptr = pointer (ttybp, next_timer_ptr -> timer.next_timer);
333                     end;
334           end;
335 
336           if rel (prev_timer_ptr) ^= ""b then prev_timer_ptr -> timer.next_timer = rel (timer_ptr);
337                                                             /* Splice it in, if we can */
338           if rel (next_timer_ptr) ^= ""b then next_timer_ptr -> timer.prev_timer = rel (timer_ptr);
339 
340           timer.next_timer = rel (next_timer_ptr);
341           timer.prev_timer = rel (prev_timer_ptr);
342 
343           next_timer_ptr = pointer (ttybp, lcte.timer_offset);
344 
345           timer.prev_for_lcte = ""b;                        /* Thread in at the beginning of the LCTE list */
346           timer.next_for_lcte = rel (next_timer_ptr);
347 
348           if (rel (next_timer_ptr) ^= ""b) then next_timer_ptr -> timer.prev_for_lcte = rel (timer_ptr);
349 
350           lcte.timer_offset = rel (timer_ptr);
351 
352           if (soonest_timer_ptr ^= null ()) then do;        /* Must update "next time" */
353                tty_buf.next_timer_offset = rel (soonest_timer_ptr);
354                call pxss$unique_ring_0_wakeup (tty_buf.timer_process, tty_buf.timer_ev_chn, 0, (0));
355                end;
356 
357           tty_buf.timer_count = tty_buf.timer_count + 1;
358 
359           return;
360      end thread_timer_block;
361 %page;
362 unthread_timer_block:
363      procedure ();
364 
365 /* Procedure to unthread the current timer block from the global timer queue and the lcte queue */
366 /* Also updates the global variables in tty_buf, changing the next timer info if necessary */
367 
368 declare  soonest_timer_ptr pointer;                         /* For updating tty_buf */
369 declare  next_timer_ptr pointer;
370 declare  prev_timer_ptr pointer;
371 
372 
373           prev_timer_ptr = pointer (ttybp, timer.prev_timer);
374                                                             /* First, unthread it from the global list */
375           next_timer_ptr = pointer (ttybp, timer.next_timer);
376 
377           if (rel (timer_ptr) = tty_buf.next_timer_offset)
378           then soonest_timer_ptr = next_timer_ptr;          /* If we're removing the first one, update */
379           else soonest_timer_ptr = null ();                 /* If not skip this step */
380 
381           if (timer.next_timer ^= ""b) then next_timer_ptr -> timer.prev_timer = timer.prev_timer;
382 
383           if (timer.prev_timer ^= ""b) then prev_timer_ptr -> timer.next_timer = timer.next_timer;
384 
385           tty_buf.timer_count = tty_buf.timer_count - 1;
386 
387           if soonest_timer_ptr ^= null () then do;          /* This means the one we unthreaded was the first */
388                tty_buf.next_timer_offset = rel (soonest_timer_ptr);
389                end;                                         /* "That's longer than anybody's ever been gone before!" */
390 
391           lctep = addr (lct.lcte_array (timer.devx));       /* Who this one belongs to */
392 
393           prev_timer_ptr = pointer (ttybp, timer.prev_for_lcte);
394                                                             /* Next, unthread it from the list for the LCTE */
395           next_timer_ptr = pointer (ttybp, timer.next_for_lcte);
396 
397           if (timer.next_for_lcte ^= ""b) then next_timer_ptr -> timer.prev_for_lcte = timer.prev_for_lcte;
398 
399           if (timer.prev_for_lcte ^= ""b) then prev_timer_ptr -> timer.next_for_lcte = timer.next_for_lcte;
400 
401           if (rel (timer_ptr) = lcte.timer_offset) then lcte.timer_offset = rel (next_timer_ptr);
402 
403           return;
404      end unthread_timer_block;
405 %page;
406 setup_global:
407      procedure ();
408 
409 /* Set up for any kind of mcs_timer operation. Sets global variables, wires and masks,
410    and locks the timer lock */
411 
412           ttybp = addr (tty_buf$);
413           lctp = tty_buf.lct_ptr;
414           lctep = null ();
415 
416           start_time = clock ();
417 
418           call lock_timer_lock ();
419 
420           return;
421      end setup_global;
422 
423 
424 
425 setup_channel:
426      procedure ();
427 
428 /* This procedure performs additional setup up for an operation on a particular
429    channel, and checks that it is locked by the correct process. */
430 
431           call setup_global ();
432 
433           lctep = addr (lct.lcte_array (devx));
434 
435           if (lcte.lock ^= pds$processid)
436           then call syserr (CRASH, "mcs_timer: Channel not locked by this process. Devx = ^d.", devx);
437 
438           return;
439      end setup_channel;
440 
441 
442 
443 
444 get_id_and_subchan:
445      procedure ();
446 
447           timer_id = P_timer_id;
448           subchan_idx = P_subchan_idx;
449 
450           timer_info.id = timer_id;
451           timer_info.subchan_idx = subchan_idx;
452 
453           return;
454      end get_id_and_subchan;
455 %page;
456 timer_error:
457      procedure (P_message);
458 
459 declare  P_message char (*) parameter;
460 
461 
462           call syserr (tty_buf.recoverable_error_severity, "mcs_timer: ^a timer ^w for devx(subchan) ^d(^d)", P_message,
463                timer_id, devx, subchan_idx);
464 
465           call finished ((0), tty_buf.timer_error_calls);   /* Don't meter calls that don't complete */
466 
467           call unlock_timer_lock ();
468 
469           goto MAIN_RETURN;                                 /* Depart */
470 
471      end timer_error;
472 
473 
474 
475 finished:
476      procedure (P_time_meter, P_count);
477 
478 declare  P_time_meter fixed bin (71) parameter;
479 declare  P_count fixed bin (35) parameter;
480 
481 
482           P_time_meter = P_time_meter + (clock () - start_time);
483           if (P_count < 34359738367)
484           then                                              /* Avoid overflows. That number is 2**35-1 */
485                P_count = P_count + 1;
486           return;
487      end finished;
488 %page;
489 lock_timer_lock:
490      procedure ();
491 
492 declare  spin_start_time fixed bin (71);
493 
494 
495           if (tty_buf.timer_lock = pds$processid)
496           then call syserr (CRASH, "mcs_timer: Timer lock already locked to this process.");
497 
498           call privileged_mode_ut$wire_and_mask (wire_mask, wire_ptr);
499 
500           if ^(stacq (tty_buf.timer_lock, pds$processid, ""b)) then do;
501 
502                spin_start_time = clock ();                  /* Didn't lock at first attempt */
503                tty_buf.timer_lock_wait_count = tty_buf.timer_lock_wait_count + 1;
504 
505                do while (^stacq (tty_buf.timer_lock, pds$processid, ""b));
506                end;
507 
508                tty_buf.timer_lock_wait_time = tty_buf.timer_lock_wait_time + (clock () - spin_start_time);
509                end;
510 
511           tty_buf.timer_lock_count = tty_buf.timer_lock_count + 1;
512 
513           return;
514      end lock_timer_lock;
515 
516 
517 
518 unlock_timer_lock:
519      procedure ();
520 
521           if ^(stacq (tty_buf.timer_lock, "0"b, pds$processid))
522           then call syserr (CRASH, "mcs_timer: Timer lock not locked by this process.");
523 
524           call privileged_mode_ut$unwire_unmask (wire_mask, wire_ptr);
525 
526           return;
527      end unlock_timer_lock;
528 %page;
529 %include mcs_timer_data;
530 %include tty_buf;
531 %include lct;
532 %include mcs_interrupt_info;
533 %include tty_space_man_dcls;
534 %page;
535 /* BEGIN MESSAGE DOCUMENTATION
536 
537    Message:
538    mcs_timer: Timer lock already locked to this process.
539 
540    S:     $crash
541 
542    T:     $run
543 
544    M:     A process that had the MCS timer lock locked tried to lock it again.
545 
546    A:     $inform
547 
548 
549    Message:
550    mcs_timer: Timer lock not locked by this process.
551 
552    S:     $crash
553 
554    T:     $run
555 
556    M:     A process called to unlock the MCS timer lock, but did not have it locked.
557 
558    A:     $inform
559 
560 
561    Message:
562    mcs_timer: Channel not locked by this process. Devx = DDDD.
563 
564    S:     $crash
565 
566    T:     $run
567 
568    M:     A process called to perform an MCS timer operation, but the channel it
569    specified (devx DDDD) was not locked by the calling process.
570    by the calling process.
571 
572    A:     $inform
573 
574 
575    Message:
576    mcs_timer: Timer not found. Cannot OOOOO timer NNN for devx(subchan) DDD(SSS).
577 
578    S:     $log
579 
580    T:     $run
581 
582    M:     An attempt was made to perform operation OOOOO (reset or change) on
583    an MCS timer when no timer or queued timer interrupt with the specified ID
584    could be found for the requesting channel. The call is ignored.
585 
586    A:     $inform
587 
588 
589    Message:
590    mcs_timer: Duplicate timer ID. Cannot set timer NNN for devx(subchan) DDD(SSS).
591 
592    S:     $log
593 
594    T:     $run
595 
596    M:     An attempt was made to set an MCS timer with the specified timer ID,
597    but the channel already had an outstanding timer or queued timer interrupt
598    with that ID. The call is ignored.
599 
600    A:     $inform
601 
602 
603    Message:
604    mcs_timer: Cannot get space to set timer NNN for devx(subchan) DDD(SSS).
605 
606    S:     $log
607 
608    T:     $run
609 
610    M:     An attempt was made to set an MCS timer with the specified timer ID,
611    but it was not possible to allocate the necessary space in tty_buf to hold
612    timer data block. The call is ignored.
613 
614    A:     $inform
615 
616 
617    END MESSAGE DOCUMENTATION */
618 
619      end mcs_timer;