1 /* ***********************************************************
  2    *                                                         *
  3    * Copyright, (C) Honeywell Information Systems Inc., 1982 *
  4    *                                                         *
  5    *********************************************************** */
  6 %;
  7 /* ******************************************************
  8    *                                                    *
  9    *                                                    *
 10    * Copyright (c) 1972 by Massachusetts Institute of   *
 11    * Technology and Honeywell Information Systems, Inc. *
 12    *                                                    *
 13    *                                                    *
 14    ****************************************************** */
 15 
 16 debug: db: procedure;
 17 /*        This is the main procedure of the  debug  package.  It has two entries:
 18    *
 19    *      1.  The  CALLED entry "debug" or "db" is entered when debug is called by
 20    *          a user.
 21    *
 22    *      2.  "mme2_fault"  is entered to handle a mme2 fault, i.e., a break.
 23 */
 24 
 25 /*                  PARAMETER  DATA               */
 26 dcl  arg_mcp ptr;                                           /* Pointer to the machine conditions that is
 27                                                                *  passed to the mme2 fault entry.  This pointer
 28                                                                *  is generated by the "signaller" and is
 29                                                                *  handed down to  "debug".  */
 30 
 31 /*                  AUTOMATIC  DATA               */
 32 /*        Below is the automatic area reserved for common data.   Also declared is the area
 33    *      where the  SNT  table is built.
 34 */
 35 
 36 dcl  common_auto_area (88) fixed bin aligned,
 37 
 38      snt_area (70) fixed bin aligned;
 39 
 40 dcl 1 save aligned like db_ext_stat_$db_ext_stat_;
 41 dcl  break_num fixed bin,                                   /* Number of the break that caused the
 42                                                                *  mme2 fault.  */
 43 
 44      break_ptr ptr,                                         /* Pointer to where the break occurred.  */
 45 
 46      temp_break_ptr ptr;                                    /* Pointer to where a temporary break will
 47                                                                *  be set.  */
 48 dcl  comd_len fixed bin,                                    /* The length of the command line in a break.
 49                                                                *  0 => no command line.  */
 50 
 51      comd_ptr ptr,                                          /* Pointer to the command line  IN THE BREAK.  */
 52 
 53      cond_flag fixed bin;                                   /* A flag indicating whether a given break
 54                                                                *  should be skipped due to an unsatisfied
 55                                                                *  condition.  Its values are:
 56                                                                *  0 => NO - No condition or condition met.
 57                                                                *  1 => YES - Skip break, condition not met.  */
 58 dcl  i fixed bin;                                           /* Work variable.  */
 59 
 60 dcl  input_buffer char (132) aligned,                       /* Area where the user commands are read.  */
 61 
 62      input_buffer_ptr ptr,                                  /* Pointer to the beginning of this area.  */
 63 
 64      input_line_len21 fixed bin (21),                       /* For use with iox_ */
 65      input_line_len fixed bin;                              /* Actual length of user's input command.  */
 66 
 67 dcl  printer_on char (1) init ("^F");                       /* Turn printer on "006" */
 68 
 69 dcl  line_num fixed bin,                                    /* Source line number associated with an
 70                                                                *  offset in an object segment.  */
 71 
 72      line_1st_inst_off fixed bin,                           /* The offset of the FIRST instruction of
 73                                                                *  a given source line.  */
 74 
 75      line_num_inst fixed bin;                               /* Number of instructions used to implement
 76                                                                *  a given source line.  */
 77 
 78 dcl  line_info char (14) aligned;                           /* Line number for printing. */
 79 
 80 dcl  last_sp ptr;                                           /* Pointer to the last stack frame in the
 81                                                                *  stack history which we will use as
 82                                                                *  part of our trace.  */
 83 
 84 dcl  cleanup condition;
 85 dcl  command_abort_ condition;
 86 dcl  code fixed bin (35);
 87 dcl  new_line char (1) init ("
 88 ");                                                         /* new line character */
 89 /*        The label used by the condition handling procedures.  */
 90 dcl  read_line_label label;
 91 
 92 
 93 /*                  INTERNAL  STATIC  DATA        */
 94 /*        Below is the static area reserved for common data.  */
 95 
 96 dcl  common_static_area (1063) fixed bin internal static aligned;
 97 dcl  static_init_count fixed bin internal static init (0);
 98 dcl  initial_flag bit (1) int static init ("0"b);
 99 
100 
101 
102 /*                  EXTERNAL  DATA                */
103 %include db_ext_stat_;
104 
105 dcl 1 d like db_ext_stat_$db_ext_stat_ based (addr (db_ext_stat_$db_ext_stat_));
106 dcl  condition_ ext entry (char (*), entry),
107      cu_$stack_frame_ptr ext entry returns (ptr),
108      db_break$check_break ext entry (ptr, fixed bin, ptr, fixed bin, fixed bin,
109      fixed bin, ptr, fixed bin),
110      db_break$restart ext entry (ptr, fixed bin, fixed bin, ptr, fixed bin),
111      db_break$set_break ext entry (ptr, fixed bin, ptr, fixed bin),
112      db_fill_snt ext entry (ptr, ptr),
113      db_find_mc ext entry (ptr, bit (1) aligned, ptr),
114      db_parse ext entry (ptr, fixed bin, ptr, ptr),
115      debug$mme2_fault ext entry (ptr),
116      hcs_$high_low_seg_count ext entry (fixed bin, fixed bin),
117      ioa_$ioa_stream ext entry options (variable),
118      ioa_$rsnnl ext entry options (variable),
119      legal_f_ ext entry (ptr) returns (fixed bin),
120      db_line_no ext entry (ptr, fixed bin (18), fixed bin, fixed bin, fixed bin);
121 dcl  iox_$control ext entry (ptr, char (*), ptr, fixed bin (35));
122 dcl  iox_$user_output ptr ext;
123 dcl  iox_$user_input ptr ext;
124 dcl  iox_$get_line ext entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35));
125 dcl  iox_$close ext entry (ptr, fixed bin (35));
126 dcl  iox_$detach_iocb ext entry (ptr, fixed bin (35));
127 dcl  com_err_ ext entry options (variable);
128 dcl  error_table_$long_record ext fixed bin (35);
129 dcl  error_table_$not_attached ext fixed bin (35);
130 dcl  error_table_$not_open ext fixed bin (35);
131 dcl (addr,
132      addrel,
133      baseptr,
134      fixed,
135      null,
136      ptr) builtin;
137                                                             /* ^L */
138 %include db_common_auto;
139 %include db_common_static;
140 /* ^L */
141 %include db_inst;
142 /* ^L */
143 %include db_snt;
144 /* ^L */
145 %include stack_header;
146 %include stack_frame;
147 %include mc;
148 /* ^L */
149 /* CALLED  ENTRY  -  This is where  "debug" is entered when the user calls "debug". */
150 
151           if static_init_count = 0 then call set_internal_stat;
152 
153           call set_ext_stat;
154           d.static_handler_call = "0"b;
155 
156           com_stat_ptr = addr (common_static_area);
157           com_auto_ptr = addr (common_auto_area);
158           sntp = addr (snt_area);
159 
160           call condition_ ("mme2", debug$mme2_fault);
161 
162           break_num = 0;                                    /* debug was called so there is no break number */
163           temp_break_mode = 0;                              /* Not in temporary break mode */
164           num_skips = 0;                                    /* No skip count since no break. */
165 
166 /* Now get a pointer to the last  sp  we will use in the stack history trace.  It
167    must be the frame before the  "debug"  frame. */
168 
169           last_sp = cu_$stack_frame_ptr () ->               /* Pointer to our frame. */
170                stack_frame.prev_sp;                         /* ptr to the frame of the procedure that called debug */
171 /* Now get a pointer to the machine conditions of the last fault that was taken
172    before  "debug" was called.  The stack frame of the procedure that took the
173    fault must still be in the stack history if we are to get a pointer to the
174    machine conditions.  If there is no fault frame in the stack history it is OK.
175    The user just won't have any registers to play with.  If he tries to reference
176    a machine register  "db_regs"  will tell him.
177 */
178 
179           call db_find_mc (last_sp, "0"b, db_mc_ptr);
180 
181 /* Now call an internal procedure that will perform the rest of the initialization.
182    Once this is done we can start reading in user commands. */
183 
184           call common_init;
185 
186           goto read_line;                                   /* Go get user commands. */
187 
188 /* ^L */
189 /* This entry is entered via a mme2 fault that occurred at a break point.  The input
190    argument points to the machine conditions associated with this fault.
191 
192    There are two cases in which the break will be skipped.  In both cases debug will not print any message
193    a)  The break has a non zero skip count.
194    b)  The break contains a condition but the condition has not been met.
195    */
196 mme2_fault: entry (arg_mcp);
197 
198           if static_init_count = 0 then do;                 /* in case debug is entered via static handler */
199                call set_internal_stat;
200                call set_ext_stat;
201                d.static_handler_call = "1"b;
202           end;
203 
204           com_stat_ptr = addr (common_static_area);
205           com_auto_ptr = addr (common_auto_area);
206           sntp = addr (snt_area);
207 
208           db_mc_ptr = arg_mcp;                              /* The machine conditions associated with
209                                                                *  this fault serve as our registers.  */
210 
211 /* From the SCU data we get the address of where the mme2 fault occurred - in effect the PPR.  The
212    The address field of the mme2 instruction contains the break number.
213 */
214           scup = addr (db_mc_ptr -> mc.scu);
215           break_ptr = ptr (baseptr (fixed (scup -> scu.ppr.psr)), scup -> scu.ilc);
216           break_num = fixed (break_ptr -> instr.offset);
217           last_sp = db_mc_ptr -> mc.prs (spx);              /* stack frame of the procedure that took the fault. */
218           call db_fill_snt (last_sp, sntp);
219           call db_break$check_break (break_ptr, break_num, sntp, cond_flag, num_skips, comd_len, comd_ptr, line_num);
220 
221 /* If the break could not be handled (it was not enabled, it was a version 1 break), the user will enter command
222    mode for debug. */
223 
224           if break_ptr = null then do;
225                call common_init;
226                goto  read_line_label;
227           end;
228 
229           if (cond_flag = 1) | (num_skips > 0) then goto restart_break;
230 
231           call common_init;
232 
233           if line_num > 0 then call ioa_$rsnnl ("at line ^d", line_info, i, line_num);
234           else line_info = "";
235 
236           if print_mode = 0 then call ioa_$ioa_stream (d.debug_output, "Break  ^d ^a  of  ^a", break_num, line_info, snt.ent_name);
237           else call ioa_$ioa_stream (d.debug_output, "^RBreak  ^d  ^a  of  ^a  -  at  ^p^B",
238                break_num, line_info, snt.ent_name, break_ptr);
239           if temp_comd_len ^= 0                             /* temporary global command */
240           then call db_parse (addr (temp_comd_line), temp_comd_len, com_auto_ptr, com_stat_ptr);
241 
242           if comd_len ^= 0                                  /* conditional break */
243           then call db_parse (comd_ptr, comd_len, com_auto_ptr, com_stat_ptr);
244 
245           goto db_action_label (db_action_code);
246                                                             /* ^L */
247 
248 /*        These condition handlers  return to "read_line".  The stack frame that
249    *      "debug" will be running on will be the last  "debug" stack frame regardless of
250    *      how  "debug" was entered.
251 */
252 
253 conversion_handler: procedure;
254 
255                call ioa_$ioa_stream (d.debug_output, "Conversion error");
256                goto read_line_label;
257 
258           end conversion_handler;
259 
260 prog_interrupt_handler: procedure;
261 
262                goto read_line_label;
263 
264           end prog_interrupt_handler;
265 /*  The any_other_handler prints the name of the condition and goes to read the next
266    request from the user.  The condition will be passed on if the user was not in
267    debug when the condition occurred or the condition is not in the conditions table.
268 
269    The user is not in debug in the following cases:
270 
271    *      db_parse            (..) when a procedure is executed
272    *                          (:=) when a subroutine call is made
273 
274    *      debug               (.c) when the user continues execution after a break
275 */
276 
277 any_other_handler: proc (mcptr, name, wcptr, info_ptr, cont);
278 
279 dcl  mcptr ptr,
280      name char (*),
281      wcptr ptr,
282      info_ptr ptr,
283      cont bit (1);
284 dcl  conditions char (106) init ("conversion,fixedoverflow,out_of_bounds,overflow,underflow,zerodivide,stringrange,stringsize,subscriptrange");
285 
286                if d.in_debug then do;                       /* only handle debug conditions */
287 
288                     if name = "db_conversion" then name = "conversion";
289                     if index (conditions, name) > 0 then do;
290                          call ioa_$ioa_stream (d.debug_output, "db: ^a", name);
291                          go to read_line_label;
292                     end;
293                end;
294 
295                cont = "1"b;
296                return;
297 
298           end any_other_handler;
299 
300 /* ^L */
301 
302 /*        This routine will read a user command and then call the parsing procedure to
303    *      process the command line.  What we do when the parsing procedure returns depends
304    *      upon the action code which the parsing procedure sets.  Thus the contents of the
305    *      command line determines what we do next.
306 */
307 
308 read_line:
309 db_action_label (0):
310           call iox_$get_line (d.debug_io_ptr (1), input_buffer_ptr, 132, input_line_len21, code);
311           input_line_len = input_line_len21;
312 
313           if code ^= 0 then do;
314                call com_err_ (code, "debug");
315                if code = error_table_$long_record then go to read_line;
316                else go to quit;
317           end;
318           if input_line_len = 1 then goto read_line;        /* Is it a blank line?  */
319           db_action_code = 0;                               /* in case different value was returned before */
320 
321           call db_parse (input_buffer_ptr, input_line_len, com_auto_ptr, com_stat_ptr);
322 
323           goto db_action_label (db_action_code);
324 
325 /* resetread:       Flush read ahead because last request was incorrect */
326 
327 db_action_label (1):
328 
329           call iox_$control (d.debug_io_ptr (1), "resetread", null, code);
330           if code ^= 0 then call com_err_ (code, "debug");
331           goto read_line;
332 
333 /*  Quit  debug  */
334 db_action_label (2):
335 quit:
336 
337           if break_num = 0 then do;                         /* debug was CALLED */
338                call restore;
339                return;
340           end;
341 
342 /* If this invocation was through a mme2 fault, return is made to the stack frame that had the call to debug.
343    If debug was originally invoked via a static handler and return is not possible. */
344 
345           if ^d.flags.static_handler_call then goto d.return_label;
346           signal command_abort_;
347           goto read_line;
348 
349 return_from_debug:                                          /* This is where the previous goto will transfer to.
350                                                                However, we will now be in a different stack frame. */
351 
352           call restore;                                     /* Restore i/o attachments & external data */
353           return;                                           /* Return to CALLER. */
354 
355 /*        This routine is called when the user wants to restart a break.  Note that all of
356    *      the data needed to restart the break has been set up by  "debug".  Only the num_skips
357    *      field could have been modified by a user if  the parse procedure was called to
358    *      process a command line.  If there is no break number then  "debug" was entered
359    *      via a  CALL.  Thus there is no break to restart.  We will just go and read in
360    *      another command line.
361    */
362 
363 restart_break:
364 db_action_label (3):
365           if break_num = 0 | break_ptr = null
366 
367           then do;
368                call ioa_$ioa_stream (d.debug_output, "No break fault, cannot restart break.");
369                goto read_line;
370           end;
371 /*        There was a break fault so we can restart this break.  First we will check to
372    *      see if we are in  temporary break mode.  If we are we will set a temporary break.
373    *      The location of the temporary break will be at the beginning of the next line if
374    *      there are line numbers available.  Otherwise it will be at the next instruction.
375 */
376 
377           if temp_break_mode ^= 0                           /* Are we in temporary break mode?  */
378 
379           then do;                                          /* YES */
380 
381                call db_fill_snt (last_sp, sntp);
382 
383                call get_line_num;                           /* Get temporary break pointer.  */
384 
385                call db_break$set_break (temp_break_ptr, 1, sntp, print_mode);
386 
387           end;
388 /*        Now we will call  db_break to restart the break.  It will fiddle with our  SCU
389    *      data so that when we say  "return"  the instruction that was replaced by the
390    *      mme2  will eventually be executed.  We return to the procedure that called  "debug"
391    *      at the  mme2 fault entry.  Eventually a return is made to the signaller who does
392    *      an  "RCU"  instruction from our  SCU  data.  This will restart the procedure which
393    *      will execute as if the break never happened.
394 */
395 
396           d.in_debug = "0"b;                                /* restart break means leaving debug */
397           call db_break$restart (break_ptr, break_num, num_skips, scup, print_mode);
398           return;                                           /* This will begin the process which will
399                                                                *  restart the procedure.  */
400                                                             /* ^L */
401 common_init: procedure;
402 /*        This procedure is called to perform initialization that is common the both the
403    *      CALLED and the  mme2_fault entries.  It will not be called at all if the  mme2 fault
404    *      entry immediately restarts the break.
405 */
406 
407 /*        First initialize the rest of the common automatic variables.  Also set up
408    *      the pointer to the input buffer.
409 */
410 
411                first_call_flag,
412                     db_action_code = 0;
413 
414                input_buffer_ptr = addr (input_buffer);
415 /*        Establish condition handlers for illegal  debug  conversions and for program
416    *      interrupts.  Both of these condition handlers will go to  "read_line"  to get
417    *      another input line.  At that time  "debug"  will be executing out of the last
418    *      "debug"  stack frame regardless of how it was entered.
419 */
420 
421                read_line_label = read_line;
422                call condition_ ("db_conversion", conversion_handler);
423                call condition_ ("program_interrupt", prog_interrupt_handler);
424 
425                call condition_ ("any_other", any_other_handler);
426                d.in_debug = "1"b;
427 
428 /*        Now trace the stack history.  We will start at the beginning of the stack and
429    *      trace until we reach the frame we have designated as the last frame.  The pointer
430    *      to this frame is in  "last_sp".  The index of the  stack_ptr_array  entry for
431    *      this last frame will be saved in the common variable  "max_sp_x".
432 */
433                sp = ptr (last_sp, 0) -> stack_header.stack_begin_ptr; /* Get a pointer to the first
434                                                                *  frame in the stack.  Note,
435                                                                *  it is a dummy and will
436                                                                *  be skipped.  */
437                do i = 0 to 511;
438 
439                     if legal_f_ (sp) ^= 0                   /* Is it a legal frame?  */
440 
441                     then do;                                /* NO. */
442 
443                          max_sp_x = i - 1;                  /* Previous frame is the last one
444                                                                *  we can use in the stack history.  */
445 
446                          call ioa_$ioa_stream (d.debug_output, "Cannot trace stack past depth  ^d", i-1);
447 
448                          goto get_snt_data;                 /* End stack trace. */
449 
450                     end;
451                     stack_ptr_array (i) = sp;               /* Stack is legal. Save its pointer
452                                                                *  in the stack array. */
453 
454                     if sp = last_sp                         /* Is this the last stack frame we
455                                                                *  want to trace?  */
456 
457                     then do;                                /* YES.  This is the end of the trace.  */
458 
459                          max_sp_x = i;                      /* Save number of valid stack frames
460                                                                *  in the trace.  */
461 
462                          goto get_snt_data;
463 
464                     end;
465 
466                     sp = sp -> stack_frame.next_sp;         /* Get a pointer to the next frame. */
467 
468                end;
469 /*        If we get here we have overflowed the stack array area.  Tell the user. */
470 
471                call ioa_$ioa_stream (d.debug_output, "Stack array overflow has occurred.");
472 
473                max_sp_x = i - 1;
474 /*        Now that the stack trace has finished we will fill in the SNT table from the data
475    *      in the last stack frame in the trace.
476 */
477 
478 get_snt_data:
479 
480                call db_fill_snt (stack_ptr_array (max_sp_x), sntp);
481 
482                snt_ptr = sntp;
483 
484           end common_init;
485                                                             /* ^L */
486 get_line_num: procedure;
487 /*        This internal procedure is called to get the line number of the instruction at
488    *      the current break point.  It will also return a pointer to where the next temporary
489    *      break point should be set.  If we can't get the line number then a line number
490    *      value of (-1) will be returned.  This procedure assumes that "break_ptr" points to
491    *      the break point and that "sntp" points to valid  SNT  data of the fault frame.
492 */
493 
494 /*        Get the line number. */
495 
496                call db_line_no (sntp, fixed (rel (break_ptr), 18), line_1st_inst_off,
497                     line_num_inst, line_num);
498                if line_num > -1                             /* Did we get a line number.  */
499                then do;                                     /* YES, temporary pointer is beginning of
500                                                                *  next line.  */
501 
502                     temp_break_ptr = ptr (break_ptr, line_1st_inst_off + line_num_inst);
503 
504                     return;
505                end;
506 
507 /*        Either we couldn't get a symbol pointer or we couldn't get a line number.  In
508    *      any case we will return a line number of (-1) and the temporary break pointer
509    *      will be equal to the instruction after the break point.
510 */
511 
512                line_num = -1;
513 
514                temp_break_ptr = addrel (break_ptr, 1);
515           end get_line_num;
516 restore:  proc;
517 
518 /*        This procedure is called when the user quits debug or when the cleanup condition
519    *      is signaled.
520    *        1.  Any i/o attachments that were made by debug are detached.
521    *        2.  The external data is restore to its initial value when debug was called.
522 */
523 
524                do i = 1 to 2;
525 
526                     if d.debug_io_open (i) then do;
527                          call iox_$close (d.debug_io_ptr (i), code);
528                          if code ^= 0 then if code ^= error_table_$not_open then call com_err_ (code, "debug");
529                     end;
530 
531                     if d.debug_io_attach (i) then do;
532                          call iox_$detach_iocb (d.debug_io_ptr (i), code);
533                          if code ^= 0 then if code ^= error_table_$not_attached then call com_err_ (code, "debug");
534                     end;
535                end;
536 
537                d = save;                                    /* restore external static data */
538                static_init_count = static_init_count - 1;
539 
540                return;
541           end restore;
542 
543 /* ^L */
544 /* The external static is setup to work like controlled storage.  When debug is called, the
545    external static is copied into automatic storage.  Before the user returns from debug, the external static is
546    restored using the values saved in automatic storage.  This is required for the return_label and is also
547    convienent for cleanup for users who change the io switches. */
548 
549 set_ext_stat: proc;
550 
551                save = d;                                    /* save ext static data */
552                d.debug_input = "user_input";
553                d.debug_output = "user_output";
554                d.debug_io_open (1), d.debug_io_open (2), d.debug_io_attach (1), d.debug_io_attach (2) = "0"b;
555                d.debug_io_ptr (1) = iox_$user_input;
556                d.debug_io_ptr (2) = iox_$user_output;
557                static_init_count = static_init_count + 1;
558 
559 /* When the user issues a debug quit command we want to return to the procedure which
560    called "debug".  Thus we must be using the stack frame of "debug" when it was entered
561    via a call.  In order to quit out of debug when it was entered via a fault we must
562    do a non local goto back to the stack frame of "debug" when it was entered via a call. */
563 
564                d.return_label = return_from_debug;
565 
566                on cleanup call restore;
567 
568           end set_ext_stat;
569 set_internal_stat: proc;
570 
571                com_stat_ptr = addr (common_static_area);    /* common static data */
572                if initial_flag then return;
573 
574                call hcs_$high_low_seg_count (i, hcs_count);
575 
576                sb = ptr (cu_$stack_frame_ptr (), 0);        /* ptr to base of stack */
577                lotp = sb -> stack_header.lot_ptr;           /* ptr to base of the linkage */
578 
579                print_mode = 1;                              /* long message mode */
580                temp_comd_len = 0;                           /* no temporary global break command line */
581                initial_flag = "1"b;
582 
583           end set_internal_stat;
584      end debug;