1 /****^  ***********************************************************
  2         *                                                         *
  3         * Copyright, (C) Honeywell Bull Inc., 1987                *
  4         *                                                         *
  5         * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  6         *                                                         *
  7         *********************************************************** */
  8 /* format: style3,linecom,ifthenstmt,ifthendo,ifthen,^indnoniterdo,indnoniterend,indcomtxt,^inditerdo,indend,idind30 */
  9 mcs_trace:
 10      procedure (Devx);
 11 
 12 /* Routine for tracing events in ring 0 MCS. */
 13 /* Written by C. Hornig, September 1979. */
 14 
 15 dcl       Devx                          fixed bin parameter;
 16 dcl       Chainp                        pointer parameter;
 17 
 18 %include mcs_trace_data;
 19 
 20 dcl       formline_                     entry (fixed bin, fixed bin, pointer, fixed bin (21), fixed bin);
 21 
 22 dcl       initialized                   bit aligned internal static init ("0"b);
 23 dcl       mapc                          character (512) aligned internal static init ("");
 24 
 25 dcl       (my_idx, next_idx)            fixed bin (35) aligned;
 26 dcl       (bsize, i)                    fixed bin;
 27 
 28 dcl       bwords                        (256) bit (36) aligned based (blockp);
 29 
 30 dcl       (addr, binary, bit, clock, length, pointer, stacq)
 31                                         builtin;
 32 
 33 /* * * * * * * * * * * * * * * * * * * */
 34 
 35           call setup;
 36           call get_entry;
 37           call formline_ (2, 3, addr (trace_entry.message), length (trace_entry.message), 1);
 38 return_to_caller:
 39           return;
 40 
 41 /* * * * * * * * * * BUFFER_CHAIN * * * * * * * * * */
 42 
 43 buffer_chain:
 44      entry (Devx, Chainp);
 45 
 46           call setup;
 47           do blockp = Chainp repeat (pointer (ttybp, buffer.next)) while (rel (blockp) ^= ""b);
 48                bsize = 16 * (1 + buffer.size_code);
 49                call fill_in (" ^d words at ^6.3b; ^d chars; flags: ^[eop,^]^[conv,^]^[break^]", bsize, rel (blockp),
 50                     buffer.tally, buffer.flags.end_of_page, buffer.flags.converted, buffer.flags.break);
 51                do i = 1 by 2 to bsize;
 52                     if (bwords (i) | bwords (i + 1)) ^= ""b then
 53                          call fill_in (" ^2d: ^w ^w ^8a", (i - 1) * 4, bwords (i), bwords (i + 1),
 54                               translate (substr (string (buffer.chars), i * 4 - 7, 8), mapc));
 55                     end;
 56                end;
 57           return;
 58 
 59 /* * * * * * * * * * INIT * * * * * * * * * */
 60 
 61 setup:
 62      procedure;
 63           ttybp = addr (tty_buf$);
 64           if ^initialized then do;
 65                mapc = copy (".", 32) || substr (collate9 (), 33, 95) || copy (".", 385);
 66                initialized = "1"b;
 67                end;
 68           if ^tty_buf.trace.enable then goto return_to_caller;
 69           if tty_buf.trace.data_offset = ""b then goto return_to_caller;
 70           trace_array_ptr = pointer (ttybp, tty_buf.trace.data_offset);
 71           if trace_array.num_entries = 0 then goto return_to_caller;
 72           lctep = addr (tty_buf.lct_ptr -> lct.lcte_array (Devx));
 73           if lcte.flags.trace = (tty_buf.trace.default_mode & ^lcte.flags.trace_force) then goto return_to_caller;
 74      end setup;
 75 
 76 /* * * * * * * * * * GET_ENTRY * * * * * * * * * */
 77 
 78 get_entry:
 79      procedure;
 80 snarf_trace_entry:
 81           my_idx = binary (trace_array.idx);                /* idx is where our message will go */
 82           next_idx = my_idx + 1;
 83           if next_idx > trace_array.num_entries then next_idx = 1;
 84                                                             /* where next entry will go */
 85           if ^stacq (trace_array.idx, unspec (next_idx), unspec (my_idx)) then goto snarf_trace_entry;
 86                                                             /* now grab the entry */
 87           trace_entry_ptr = addr (trace_array.entry (my_idx));
 88           trace_entry.time = clock ();
 89           trace_entry.devx = Devx;
 90      end get_entry;
 91 
 92 /* * * * * * * * * * FILL_IN * * * * * * * * * */
 93 
 94 fill_in:
 95      procedure options (variable, non_quick);
 96           call get_entry;
 97           call formline_ (1, 2, addr (trace_entry.message), length (trace_entry.message), 1);
 98      end fill_in;
 99 
100 %include tty_buf;
101 %include lct;
102 %include tty_buffer_block;
103 
104      end;