1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  6         *                                                         *
  7         * Copyright (c) 1972 by Massachusetts Institute of        *
  8         * Technology and Honeywell Information Systems, Inc.      *
  9         *                                                         *
 10         *********************************************************** */
 11 
 12 
 13 /* format: style4,delnl,insnl,^ifthendo */
 14 tty_lock:
 15      proc;
 16 
 17 /* This procedure locks and unlocks channel locks.  Locking
 18    performed at interrupt time differs from ordinary locking
 19    in two ways:
 20 
 21    1.  At interrupt time, one cannot wait for a channel that
 22    is locked to be unlocked.  Therefore, failure to lock immediately
 23    at interrupt time results in the interrupt operation being
 24    queued (i.e., postponed) for later execution.  Queued
 25    interrupts for a channel are processed the next time the
 26    channel is unlocked.
 27 
 28    2.  Ordinarily, it is considered an error when a process
 29    attempts to lock a channel that it has already locked.
 30    However, if the channel was previously locked for an
 31    interrupt operation, then subsequent attempts by the same
 32    process to lock and unlock for non-interrupt operations are
 33    simply ignored.  This permits an interrupt handler executing
 34    on behalf of some subchannel to perform an operation on its
 35    major channel even though the major channel was previously
 36    locked for the same interrupt.
 37 */
 38 
 39 /* Recoded by J. Stern 8/8/78 */
 40 /* lock_lcte entry added 12/12/79 by Robert Coren */
 41 /* Modified 6 Apr 82, W. Olin Sibert: check_for_interrupt, dequeue_interrupt entries added for mcs_timer */
 42 /* Modified 83-12-19 BIM to add pm_code to lock_lcte, which can set it! */
 43 /* Modified September 1984 by Robert Coren to make dequeue_*_interrupt entries
 44    avoid calling tty_space_man$free_space while holding the queue lock  */
 45 /* Modified March 1985 by EJ Sharpe to return bit from $verify */
 46 
 47 /* Parameters */
 48 
 49 dcl  pm_lctep ptr;
 50 dcl  pm_devx fixed bin;
 51 dcl  pm_subchan_devx fixed bin;
 52 dcl  pm_int_type fixed bin;
 53 dcl  pm_int_data bit (72) aligned;
 54 dcl  pm_locked bit (1) aligned;
 55 dcl  pm_code fixed bin (35);
 56 
 57 
 58 /* Automatic */
 59 
 60 dcl  devx fixed bin;
 61 dcl  subchan_devx fixed bin;
 62 dcl  tried bit (1) aligned;
 63 dcl  locked bit (1) aligned;
 64 dcl  i fixed bin;
 65 dcl  wire_arg fixed bin (71);
 66 dcl  wire_ptr ptr;
 67 dcl  qep ptr;
 68 dcl  qtp ptr;
 69 dcl  (prev_qep, next_qep) ptr;
 70 dcl  (first_free_qep, last_free_qep) ptr;
 71 dcl  dequeue_all bit (1) aligned;
 72 dcl  int_type fixed bin;
 73 dcl  int_data bit (72) aligned;
 74 dcl  start_wait_time fixed bin (71);
 75 dcl  wait_time fixed bin (35);
 76 dcl  unlocked_something bit (1) aligned;
 77 
 78 /* Based */
 79 
 80 dcl  1 queue_entry aligned based (qep),
 81        2 next_entry bit (18) unal,
 82        2 subchan_devx fixed bin (18) unsigned unal,
 83        2 int_type fixed bin,
 84        2 int_data bit (72);
 85 
 86 
 87 /* External static */
 88 
 89 dcl  pds$process_id bit (36) ext;
 90 dcl  pds$process_group_id char (32) aligned ext;
 91 dcl  error_table_$io_no_permission fixed bin (35) ext;
 92 
 93 
 94 /* Builtins */
 95 
 96 dcl  (addr, clock, max, null, stac, stacq, size, rel, pointer, ptr) builtin;
 97 
 98 
 99 /* Entries */
100 
101 dcl  pxss$addevent entry (fixed bin);
102 dcl  pxss$delevent entry (fixed bin);
103 dcl  pxss$notify entry (fixed bin);
104 dcl  pxss$wait entry;
105 dcl  syserr entry options (variable);
106 dcl  pmut$wire_and_mask entry (fixed bin (71), ptr);
107 dcl  pmut$unwire_unmask entry (fixed bin (71), ptr);
108 dcl  mcs_timer$verify_lock entry ();
109 %page;
110 lock_lcte:
111      entry (pm_lctep, pm_code);                             /* locks a channel before a non-interrupt operation given an LCTE pointer */
112 
113           ttybp = addr (tty_buf$);
114           lctp = tty_buf.lct_ptr;
115           lctep = pm_lctep;
116           go to lock_it;
117 
118 
119 lock_channel:
120      entry (pm_devx, pm_code);                              /* locks a channel before a non-interrupt operation */
121 
122           pm_code = 0;
123           call setup ();
124           if ^lcte.entry_in_use | lcte.special_lock
125           then go to no_permission;
126 lock_it:
127           tty_buf.tty_lock_calls = tty_buf.tty_lock_calls + 1;
128           if lcte.lock = pds$process_id                     /* we've already locked this channel */
129           then if lcte.locked_for_interrupt                 /* ok, don't lock it again */
130                then return;
131                else call syserr (SYSERR_CRASH_SYSTEM, "tty_lock: attempt to lock channel already locked by same process.")
132                          ;
133 
134           locked = "0"b;
135           tried = "0"b;
136           do while (^locked);
137                if stac (addr (lcte.lock), pds$process_id)
138                then locked = "1"b;                          /* we locked it */
139                else do;                                     /* must wait for lock to be unlocked */
140                     if ^tried
141                     then do;
142                          tty_buf.found_channel_locked = tty_buf.found_channel_locked + 1;
143                          start_wait_time = clock ();
144                          tried = "1"b;
145                     end;
146 
147                     call pxss$addevent (tty_ev);            /* get ready to wait for this event */
148                     lcte.notify_reqd = "1"b;                /* ask to be notified when lock is unlocked */
149                     if stac (addr (lcte.lock), pds$process_id)
150                                                             /* try once more to lock) it */
151                     then do;                                /* got it, no need to wait */
152                          call pxss$delevent (tty_ev);
153                          locked = "1"b;
154                     end;
155                     else call pxss$wait ();
156                end;
157           end;
158 
159           if tried
160           then do;                                          /* if we had to wait, meter */
161                wait_time = clock () - start_wait_time;
162                tty_buf.total_wait_time = tty_buf.total_wait_time + wait_time;
163                tty_buf.max_wait_time = max (tty_buf.max_wait_time, wait_time);
164           end;
165 
166           if lcte.initialized
167           then return;
168 
169           call unlock ();                                   /* don't keep uninitialized channel locked */
170 
171 no_permission:
172           pm_code = error_table_$io_no_permission;
173 
174           return;
175 %page;
176 lock_channel_int:
177      entry (pm_devx, pm_int_type, pm_int_data, pm_locked);  /* locks a channel before an interrupt operation */
178 
179 
180           int_type = pm_int_type;
181           int_data = pm_int_data;
182           subchan_devx = 0;
183           pm_locked = "0"b;
184           call setup ();
185           tty_buf.tty_lock_calls = tty_buf.tty_lock_calls + 1;
186           if ^lcte.entry_in_use
187           then call syserr (SYSERR_CRASH_SYSTEM, "tty_lock: attempt to lock unused channel for interrupt.");
188 
189           call lock_queue;
190           if ^stac (addr (lcte.lock), pds$process_id)
191           then do;                                          /* cannot set lock, must queue the interrupt */
192                call enqueue;
193                call unlock_queue;
194                return;
195           end;
196           call unlock_queue;
197 
198           if ^lcte.initialized
199           then do;                                          /* ignore interrupts for uninitialized channels */
200                call unlock ();
201                return;
202           end;
203 
204           lcte.locked_for_interrupt = "1"b;
205           pm_locked = "1"b;
206           return;
207 %page;
208 queue_interrupt:
209      entry (pm_devx, pm_int_type, pm_int_data, pm_subchan_devx);
210 
211 /* This entry adds an entry to the queue for a major channel on behalf of one of
212    its subchannels. it is used by channel_manager$interrupt_later
213 */
214 
215           int_type = pm_int_type;
216           int_data = pm_int_data;
217           subchan_devx = pm_subchan_devx;
218           call setup ();
219 
220           call lock_queue;
221           call enqueue;
222           call unlock_queue;
223           return;
224 %page;
225 unlock_channel:
226      entry (pm_devx);                                       /* unlocks a channel after a non-interrupt operation */
227 
228           call setup ();
229 
230           if lcte.lock = pds$process_id                     /* we have channel locked as expected */
231           then if lcte.locked_for_interrupt                 /* but we don't really want to unlock it now */
232                then return;
233 
234           call unlock ();
235 
236           return;
237 
238 
239 
240 unlock_channel_int:
241      entry (pm_devx);                                       /* unlocks a channel after an interrupt operation */
242 
243           call setup ();
244 
245           lcte.locked_for_interrupt = "0"b;
246           call unlock ();
247           return;
248 %page;
249 flush_queue:
250      entry (pm_devx);                                       /* deletes all queue entries for a given channel */
251 
252           call setup ();
253 
254           do while (dequeue ());
255           end;
256           return;
257 
258 
259 
260 cleanup_locks:
261      entry;                                                 /* called only by terminate_proc */
262 
263           call CLEANUP_LOCKS;
264           return;
265 
266 
267 verify:
268      entry () returns (bit (1) aligned);
269 
270           call CLEANUP_LOCKS;
271           return (unlocked_something);
272 
273 
274 CLEANUP_LOCKS:                          /* internal procedure for $cleanup_locks and $verify entrypoints */
275      procedure ();
276 
277           unlocked_something = "0"b;
278           ttybp = addr (tty_buf$);
279           if tty_buf.slock = pds$process_id
280           then call syserr (SYSERR_CRASH_SYSTEM, "tty_lock$verify: attempted crawlout with tty_buf lock set.");
281 
282           lctp = tty_buf.lct_ptr;
283           if lctp = null ()
284           then return;                                      /* MCS not started yet, never mind */
285           if lct.queue_lock = pds$process_id
286           then call syserr (SYSERR_CRASH_SYSTEM, "tty_lock$verify: attempted crawlout with queue lock set.");
287 
288           call mcs_timer$verify_lock ();                    /* will crash system if timer lock locked */
289 
290           do i = 1 to lct.max_no_lctes;
291                lctep = addr (lcte_array (i));
292                if lcte.entry_in_use
293                then if lcte.lock = pds$process_id
294                     then if lcte.special_lock
295                          then call syserr (SYSERR_CRASH_SYSTEM,
296                                    "tty_lock$verify: attempted crawlout with special channel lock set.");
297                          else do;
298                               devx = i;
299                               call force_unlock;            /* clear the lock so next caller won't hang */
300                               unlocked_something = "1"b;
301                          end;
302           end;
303 
304           return;
305 
306      end CLEANUP_LOCKS;
307 %page;
308 check_for_interrupt:
309      entry (pm_devx, pm_int_type, pm_int_data) returns (bit (1) aligned);
310 
311           int_type = pm_int_type;
312           int_data = pm_int_data;
313           call setup ();
314 
315           call lock_queue ();
316 
317           do qep = pointer (ttybp, lcte.queue_head) repeat (pointer (ttybp, queue_entry.next_entry))
318                while (rel (qep) ^= ""b);
319 
320                if (queue_entry.int_type = int_type) & (queue_entry.int_data = int_data)
321                then do;
322                     call unlock_queue ();
323                     return ("1"b);                          /* You're our boy */
324                end;
325           end;
326 
327           call unlock_queue ();
328 
329           return ("0"b);                                    /* None found */
330 %page;
331 dequeue_one_interrupt:
332      entry (pm_devx, pm_int_type, pm_int_data);
333 
334           dequeue_all = "0"b;
335           int_data = pm_int_data;
336           goto dequeue_common;
337 
338 
339 dequeue_all_interrupts:
340      entry (pm_devx, pm_int_type);
341 
342           dequeue_all = "1"b;
343 
344 
345 dequeue_common:
346           int_type = pm_int_type;
347           call setup ();
348 
349           call lock_queue ();
350 
351 /* it's not safe to call tty_space_man with the queue lock locked, because it can
352    generate "space_available" interrupts; so we'll keep a list of entries to free
353    and free them all after we've unthreaded them and released the lock.
354 */
355 
356           prev_qep, first_free_qep = pointer (ttybp, 0);
357           do qep = pointer (ttybp, lcte.queue_head) repeat (next_qep) while (rel (qep) ^= ""b);
358                next_qep = pointer (ttybp, queue_entry.next_entry);
359 
360                if (queue_entry.int_type = int_type) & (dequeue_all | (queue_entry.int_data = int_data))
361                then do;
362                     if (lcte.queue_head = rel (qep))
363                     then lcte.queue_head = queue_entry.next_entry;
364 
365                     if (lcte.queue_tail = rel (qep))
366                     then lcte.queue_tail = rel (prev_qep);
367 
368                     if (rel (prev_qep) ^= ""b)
369                     then prev_qep -> queue_entry.next_entry = queue_entry.next_entry;
370 
371 /* put this one on the "to be freed" list */
372 
373                     queue_entry.next_entry = ""b;
374                     if rel (first_free_qep) = ""b
375                     then first_free_qep, last_free_qep = qep;
376                     else do;
377                          last_free_qep -> queue_entry.next_entry = rel (qep);
378                          last_free_qep = qep;
379                     end;
380                end;
381                else prev_qep = qep;
382           end;                                              /* Of loop through queue entries */
383 
384           call unlock_queue ();
385 
386 /* now go through the free list (if any) and free the entries on it */
387 
388           do qep = first_free_qep repeat (next_qep) while (rel (qep) ^= ""b);
389                next_qep = pointer (ttybp, queue_entry.next_entry);
390                call tty_space_man$free_space (size (queue_entry), qep);
391           end;
392 
393           return;
394 %page;
395 setup:
396      proc;
397 
398           ttybp = addr (tty_buf$);
399           lctp = tty_buf.lct_ptr;
400           devx = pm_devx;
401           lctep = addr (lct.lcte_array (devx));
402           return;
403      end setup;
404 
405 
406 
407 unlock:
408      proc;
409 
410 /* process all entries in the channel queue before unlocking */
411 /* last call to dequeue will unlock the channel lock */
412 
413           do while (dequeue ());
414                lcte.locked_for_interrupt = "1"b;            /* make queued interrupt look real */
415                if subchan_devx ^= 0                         /* this is really for a subchannel */
416                then call channel_manager$interrupt (subchan_devx, int_type, int_data);
417                else call channel_manager$queued_interrupt (devx, int_type, int_data);
418                lcte.locked_for_interrupt = "0"b;
419           end;
420 
421           if lcte.notify_reqd                               /* someone is waiting for this lock */
422           then do;                                          /* let everyone know it's available */
423                lcte.notify_reqd = "0"b;
424                call pxss$notify (tty_ev);
425           end;
426 
427      end;                                                   /* unlock */
428 
429 
430 
431 force_unlock:
432      procedure;
433 
434 /* lock is to be forced because process is crawling out. Send notify if necessary,
435    but flush queued interrupts rather than attempting to process them.
436 */
437 
438           call syserr (SYSERR_LOG_OR_PRINT, "tty_lock: forcing unlock of channel ^a from ^a",
439                lct.lcnt_ptr -> lcnt.names (devx), pds$process_group_id);
440 
441           lcte.locked_for_interrupt = "0"b;
442           do while (dequeue ());                            /* this flushes the queue and unlocks the channel when it's done */
443           end;
444 
445           if lcte.notify_reqd
446           then do;
447                lcte.notify_reqd = "0"b;
448                call pxss$notify (tty_ev);
449           end;
450 
451           return;
452      end force_unlock;
453 %page;
454 lock_queue:
455      proc;
456 
457           call pmut$wire_and_mask (wire_arg, wire_ptr);
458 
459           do while (^stac (addr (lct.queue_lock), pds$process_id));
460           end;
461 
462      end;                                                   /* lock_queue */
463 
464 
465 
466 unlock_queue:
467      proc;
468 
469           if ^stacq (lct.queue_lock, "0"b, pds$process_id)
470           then call syserr (SYSERR_CRASH_SYSTEM, "tty_lock: attempt to unlock queue not locked by same process.");
471 
472           call pmut$unwire_unmask (wire_arg, wire_ptr);
473 
474      end;                                                   /* unlock_queue */
475 %page;
476 enqueue:
477      proc;                                                  /* adds queue entry to head of channel queue */
478 
479 
480           if ^lcte.initialized                              /* don't queue anything for an uninitialized channel */
481           then return;
482 
483           call tty_space_man$get_space (size (queue_entry), qep);
484           if qep = null
485           then do;
486                call syserr (SYSERR_PRINT_WITH_ALARM, "tty_lock: Cannot get space for queue entry. (devx = ^d)", devx);
487                return;
488           end;
489 
490           queue_entry.int_type = int_type;
491           queue_entry.int_data = int_data;
492           queue_entry.subchan_devx = subchan_devx;
493           if lcte.queue_tail = "0"b                         /* queue is empty */
494           then lcte.queue_tail, lcte.queue_head = rel (qep);/* new entry is both first and last */
495           else do;
496                qtp = ptr (ttybp, lcte.queue_tail);          /* get ptr to last entry */
497                qtp -> queue_entry.next_entry = rel (qep);   /* put new entry after it */
498                lcte.queue_tail = rel (qep);                 /* new entry is now the last */
499           end;
500           queue_entry.next_entry = "0"b;                    /* nothing follows last entry */
501           tty_buf.n_queued_interrupts = tty_buf.n_queued_interrupts + 1;
502 
503      end;
504 
505 
506 
507 dequeue:
508      proc returns (bit (1));                                /* removes entry from head of channel queue */
509 
510           call lock_queue ();
511           if lcte.queue_head = "0"b                         /* queue is empty */
512           then do;
513                qep = null;
514                if ^stacq (lcte.lock, "0"b, pds$process_id)
515                then call syserr (SYSERR_CRASH_SYSTEM, "tty_lock: attempt to unlock channel not locked by same process.");
516           end;
517 
518           else do;
519                qep = ptr (ttybp, lcte.queue_head);          /* get ptr to first queue entry */
520                lcte.queue_head = queue_entry.next_entry;    /* next entry is now first */
521                if lcte.queue_head = "0"b                    /* there was no next entry */
522                then lcte.queue_tail = "0"b;
523           end;
524           call unlock_queue ();
525 
526           if qep = null
527           then return ("0"b);                               /* indicate empty queue */
528           else do;
529                int_type = queue_entry.int_type;
530                int_data = queue_entry.int_data;
531                subchan_devx = queue_entry.subchan_devx;
532                call tty_space_man$free_space (size (queue_entry), qep);
533                return ("1"b);
534           end;
535 
536      end;
537 %page;
538 %include lct;
539 %include tty_buf;
540 %include tty_space_man_dcls;
541 %include channel_manager_dcls;
542 %include syserr_constants;
543 %page;
544 /* BEGIN MESSAGE DOCUMENTATION
545 
546    Message:
547    tty_lock: attempt to lock channel already locked by same process.
548 
549    S:     $crash
550 
551    T:     $run
552 
553    M:     A locking error was detected when a process tried to lock a
554    channel that it had already locked.
555 
556    A:     $inform
557 
558 
559    Message:
560    tty_lock: attempt to lock unused channel for interrupt.
561 
562    S:     $crash
563 
564    T:     $run
565 
566    M:     A locking error was detected when an interrupt handler
567    tried to lock an ununsed channel.
568 
569    A:     $inform
570 
571 
572    Message:
573    tty_lock: attempt to unlock channel not locked by same process.
574 
575    S:     $crash
576 
577    T:     $run
578 
579    M:     A locking error was detected when a process tried to unlock
580    a channel that was either not locked or locked by another process.
581 
582    A:     $inform
583 
584 
585    Message:
586    tty_lock$verify: attempted crawlout with tty_buf lock set.
587 
588    S:     $crash
589 
590    T:     $run
591 
592    M:     There was an attempt to crawl out while the tty_buf lock used
593    by tty_space_man was locked.
594 
595    A:     $inform
596 
597 
598    Message:
599    tty_lock$verify: attempted crawlout with special channel lock set.
600 
601    S:     $crash
602 
603    T:     $run
604 
605    M:     There was an attempt to crawl out while a channel lock that
606    is also a processor lock was locked.
607 
608    A:     $inform
609 
610    Message:
611    tty_lock$verify: attempted crawlout with queue lock set.
612 
613    S:     $crash
614 
615    T:     $run
616 
617    M:     There was an attempt to crawl out while the tty queue
618    lock was locked.
619 
620    A:     $inform
621 
622    Message:
623    tty_lock: Cannot get space for queue entry. (devx = N)
624 
625    S:     $beep
626 
627    T:     $run
628 
629    M:     An attempt to queue an interrupt for the channel with devx N
630    failed due to lack of space.  The interrupt was lost which may cause
631    loss of data or improper channel operation.
632 
633    A:     $inform
634 
635 
636    Message:
637    tty_lock: attempt to unlock queue not locked by same process.
638 
639    S:     $crash
640 
641    T:     $run
642 
643    M:     A locking error was detected when a process tried to unlock
644    the global queue lock which was either not locked or was locked by another
645    process.
646 
647    END MESSAGE DOCUMENTATION */
648 
649      end tty_lock;