1 /* *********************************************************** 2 * * 3 * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4 * * 5 * Copyright (c) 1972 by Massachusetts Institute of * 6 * Technology and Honeywell Information Systems, Inc. * 7 * * 8 *********************************************************** */ 9 10 11 db_break: proc; 12 13 /* This procedure is part of the debug package. All of the mechanism required to 14 * handle break points is contained in this procedure. This procedure alone, 15 * maintains the user's break segment found in his home directory. This 16 * procedure, along with db_break_map, maintains the break map needed in each 17 * segment which has breaks. Note, what this procedure does NOT know about 18 * is the semantics of the debug language. 19 * Rewritten Dec 72 for the 6180 by Bill Silver. 20 * 21 * db_break has the following entry points: 22 * 23 * check_break: Returns info about a break, especially whether or not a 24 * condition has been met. 25 * 26 * global: Performs a specified action on all the breaks known to the 27 * user in all segments. 28 * 29 * print_bseg: Prints the number of breaks in all the segments which the user 30 * has breaks. Cleans up this break segment. 31 * 32 * print_default: Prints the path name of the current default segment. 33 * 34 * restart: Restarts a break - executes the instruction replaced by 35 * the mme2. 36 * 37 * set_break: Sets up a break. 38 * 39 * set_default: Establishes a segment as the default segment. 40 * 41 * set_skips: Sets a number of skips in a specified break. 42 * 43 * single: Performs a specified action on ONE specified break. 44 * 45 * sub_global: Performs a specified action on all the breaks in the 46 * default segment. 47 */ 48 49 50 /* PARAMETER DATA */ 51 52 dcl arg_action_code fixed bin, /* (INPUT) Implies action to perform on break. 53 * A^H_C^H_T^H_I^H_O^H_N^H_ C^H_O^H_D^H_E^H_ 54 * list 1 55 * reset 2 56 * disable 3 57 * enable 4 58 * set command 5 59 * set condition 6 */ 60 arg_break_num fixed bin, /* (INPUT) The number of a break in the 61 * default segment. */ 62 arg_break_ptr ptr, /* (INPUT) A pointer to the word where 63 * the break will be set. */ 64 arg_cond_flag fixed bin, /* (OUTPUT) A flag indicating whether or not the 65 * condition of a conditional break has been met. 66 * 0 => No condition or condition not met. 67 * 1 => Condition not met - skip break. */ 68 69 arg_comd_len fixed bin, /* (OUTPUT) The length of the command line 70 * found in a break. 0 => no command. */ 71 arg_comd_ptr ptr, /* (OUTPUT) A pointer to the command line 72 * found in a break. */ 73 arg_line char (236), /* (INPUT) A string that can be either a 74 * command line or condition data. */ 75 arg_line_len fixed bin, /* (INPUT) The length of the above string. */ 76 arg_line_no fixed bin, /* (OUTPUT) Source line number. */ 77 arg_num_skips fixed bin, /* (INPUT/OUTPUT) The number of skips 78 * ( to set/that are set ) in a break. */ 79 arg_print_mode fixed bin, /* (INPUT) 0 => SHORT, 1 => LONG. */ 80 arg_scu_ptr ptr, /* (INPUT) Points to the SCU data 81 * generated by a mme2 fault. */ 82 arg_seg_ptr ptr, /* (INPUT) Pointer to a segment that is 83 * to become the default segment. */ 84 arg_snt_ptr ptr, /* (INPUT) Pointer to debug's arg_snt data. */ 85 arg_type fixed bin; /* (INPUT) The type of break. 86 * 0 => regular, 87 * 1 => temporary, 88 * 2 => disabled. */ 89 90 91 /* INTERNAL STATIC DATA */ 92 93 /* Note, since the following variables must be preserved from one call to another 94 * they are static. Any procedures which need this information therefore must be 95 * part of db_break or called by db_break. */ 96 97 98 /* Pointer to the user's break segment. */ 99 100 dcl break_seg_ptr ptr internal static init (null); 101 102 103 104 /* The following variables are used to define the default segment. 105 * def_seg is the number of the break segment array entry which corresponds 106 * to the default segment. def_break_map_ptr points to the break map in 107 * the default segment. 108 */ 109 dcl def_segx fixed bin internal static init (0), 110 def_break_map_ptr ptr internal static; 111 112 /* Below is the mme2 instruction that is put into a break word. */ 113 114 dcl 1 mme2 aligned internal static, 115 2 break_num fixed bin (17) unaligned, 116 2 op_code bit (36) unaligned init ("000000100000000000"b); 117 118 /* An array used to print the type of a break. */ 119 120 dcl break_type_name (0:3) char (24) internal static aligned 121 init ("Break ", "Temporary break", "Disabled break", 122 "Temporary disabled break"); 123 124 125 %include db_ext_stat_; 126 127 /* AUTOMATIC DATA */ 128 129 dcl action_code fixed bin, /* These variables are used to copy arguments. */ 130 break_num fixed bin, 131 break_ptr ptr, 132 line_len fixed bin, 133 print_mode fixed bin, 134 snt_ptr ptr, 135 type fixed bin; 136 137 dcl break_word_ptr ptr, /* Pointer to the word where the break is. */ 138 break_offset fixed bin (18); /* Word offset of the break word. */ 139 140 dcl dir_name char (168), /* Directory name of a segment. */ 141 ent_name char (32); /* Entry name of a segment. */ 142 143 /* This is the array of data returned by the calls to hcs_$status_long. */ 144 145 dcl 1 branch aligned, 146 (2 type bit (2), 147 2 nnames bit (16), 148 2 nrp bit (18), 149 2 dtm bit (36), 150 2 dtu bit (36), 151 2 mode bit (5), 152 2 padding bit (13), 153 2 records bit (18), 154 2 dtd bit (36), 155 2 dtem bit (36), 156 2 acct bit (36), 157 2 curlen bit (12), 158 2 bitcnt bit (24), 159 2 did bit (4), 160 2 mdid bit (4), 161 2 copysw bit (1), 162 2 pad2 bit (9), 163 2 rbs (0:2) bit (6), 164 2 uid bit (36)) unaligned; 165 166 dcl action_flag bit (1), /* Used to denote if an action has been 167 * performed for any breaks. */ 168 cond_flag fixed bin, /* Used to determine condition state. */ 169 delete_seg_entry_flag bit (1), /* Denotes whether a segment entry in the break 170 * segment array has been deleted. */ 171 inst_ptr ptr, /* Pointer to instruction after break. */ 172 new_bnum fixed bin, /* Temporary break number. */ 173 seg_ptr ptr, /* Temporary segment pointer. */ 174 segx fixed bin; /* Index into break segment array. */ 175 176 dcl print_num_breaks char (6), /* A word string for printing, */ 177 source_string char (72) var; /* Used to get info back from other procs. */ 178 179 dcl bit_count fixed bin (24), /* Returned from hcs_$initiate count. */ 180 code fixed bin (35), /* Error return code. */ 181 (i, j) fixed bin; /* Work variables. */ 182 183 184 /* BASED DATA */ 185 186 /* This is a map of the user's break segment. */ 187 188 dcl 1 bseg based (break_seg_ptr) aligned, 189 2 num_segs fixed bin, /* Number of segments in seg array. */ 190 2 seg (1), /* Array of segment entries. Each entry 191 * corresponds to one segment which should 192 * have a break map. */ 193 3 uid bit (36), /* UID of segment. This field remains 194 * constant for the life of the entry. */ 195 3 dir_name char (168) unal, /* Directory name of segment. */ 196 3 ent_name char (32) unal; /* Entry name of the segment. Note, these 197 * two fields may change since the segment 198 * may be moved, renamed, or referenced 199 * via a link. */ 200 201 /* This is an overlay of the break segment used to move whole entries around. */ 202 203 dcl 1 bseg_map based (break_seg_ptr) aligned, 204 2 num_segs fixed bin, 205 2 array (1), 206 3 entry char (204); 207 208 209 /* This is a map of the mme2 word that is moved into the break word. */ 210 211 dcl 1 mme2_map based aligned, 212 2 break_num fixed bin (17) unaligned, 213 2 op_code bit (18) unaligned; 214 215 /* This is used to reference one word. */ 216 217 dcl based_word bit (36) based aligned; 218 219 220 /* EXTERNAL ENTRIES */ 221 222 dcl (addr, addrel, divide, fixed, index, max, null, ptr, rel, size, substr) builtin; 223 224 dcl com_err_ external entry options (variable), 225 db_break_map$check external entry (ptr, fixed bin (24), ptr), 226 db_break_map$delete external entry (ptr), 227 db_break_map$get_slots external entry (ptr), 228 db_break_map$init external entry (ptr, fixed bin (24), ptr), 229 db_line_no external entry (ptr, fixed bin (18), 230 fixed bin, fixed bin, fixed bin), 231 db_parse_condition$check external entry (ptr, ptr, ptr, fixed bin), 232 db_parse_condition$print_line external entry (ptr, char (72) var), 233 hcs_$fs_get_path_name external entry (ptr, char (*), fixed bin, char (*), fixed bin (35)), 234 hcs_$initiate_count external entry (char (*), char (*), char (*), fixed bin (24), 235 fixed bin (2), ptr, fixed bin (35)), 236 hcs_$make_seg external entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)), 237 hcs_$set_bc_seg external entry (ptr, fixed bin (24), fixed bin (35)), 238 hcs_$status_long external entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35)), 239 hcs_$truncate_seg external entry (ptr, fixed bin (18), fixed bin (35)), 240 ioa_$ioa_stream external entry options (variable), 241 ioa_$rsnnl external entry options (variable), 242 user_info_ external entry (char (*)), 243 print_text_$real_offset external entry (ptr, char (*) var, fixed bin (18)), 244 user_info_$homedir external entry (char (*)); 245 /* ^L */ 246 %include db_break_map_map; 247 /* ^L */ 248 dcl 1 op_mnemonic_$op_mnemonic (0:1023) ext static aligned, 249 250 2 opcode char (6) unal, 251 2 dtype fixed bin (2) unal, 252 2 num_desc fixed bin (5) unal, 253 2 num_words fixed bin (8) unal; 254 255 /* ^L */ 256 %include db_inst; 257 /* ^L */ 258 %include mc; 259 /* ^L */ 260 print_bseg: entry (arg_print_mode); 261 262 263 /* This entry is called to print the contents of the users break segment. It will 264 * print the number of breaks that are set for each segment referenced in the break 265 * segment. It will also clean up the break segment. This involves deleting any 266 * entries which are no longer valid or whose segments have no breaks set. 267 */ 268 269 print_mode = arg_print_mode; /* Copy argument. */ 270 271 if break_seg_ptr = null () /* Make sure we have a break segment. */ 272 then call INIT_BREAK_SEG; 273 274 do segx = 1 to bseg.num_segs; /* Process each entry in break segment. */ 275 call CHECK_SEGMENT; /* This will return the segment's break 276 * map pointer if the segment entry was OK 277 * and wasn't deleted. */ 278 279 /* Was the segment entry deleted. If so, segx now refers to the last segment entry. 280 * It just replaced the one we were working on. Thus segx must be decremented 281 * so it can reference this same entry again on the next iteration. However, 282 * if this is the last entry in the array, we must not decrement segx because we want 283 * to get out of the loop since bseg.num_segs was also decremented when the 284 * segment entry was deleted. 285 */ 286 if delete_seg_entry_flag /* Was segment entry deleted? */ 287 then do; /* YES, thus there were no breaks. */ 288 if segx <= bseg.num_segs /* But is it last entry. */ 289 then segx = segx -1; /* NO, decrement segment index. */ 290 else; /* YES, lets get out of the loop. */ 291 end; 292 else do; /* No, there are breaks. */ 293 if bmap.num_set = 1 294 then print_num_breaks = "break "; 295 else print_num_breaks = "breaks"; 296 call ioa_$ioa_stream (debug_output, "^d ^a set in ^a>^a", bmap.num_set, print_num_breaks, 297 bseg.seg (segx).dir_name, bseg.seg (segx).ent_name); 298 end; 299 end; /* We have just processed one segment entry. */ 300 301 /* The only segment entries left in the break segment array will be those of segments 302 * which have breaks set. If there are no entries left, then there were no breaks set. 303 */ 304 if bseg.num_segs = 0 305 then call ioa_$ioa_stream (debug_output, "No breaks set."); 306 307 return; 308 /* ^L */ 309 set_default: entry (arg_seg_ptr); 310 311 312 /* This entry will establish the specified segment as the default segment. */ 313 314 break_ptr = arg_seg_ptr; /* Not really a break pointer. */ 315 call SET_DEFAULTS; 316 317 return; 318 319 320 321 322 323 324 print_default: entry; 325 326 327 /* This entry is called to print the name of the default segment. 328 */ 329 330 break_num = 1; /* Set dummy break number. */ 331 call CHECK_DEFAULT; 332 333 call ioa_$ioa_stream (debug_output, "Default segment is ^a>^a", 334 bseg.seg (segx).dir_name, bseg.seg (segx).ent_name); 335 336 return; 337 /* ^L */ 338 check_break: entry (arg_break_ptr, arg_break_num, arg_snt_ptr, arg_cond_flag, arg_num_skips, 339 arg_comd_len, arg_comd_ptr, arg_line_no); 340 341 342 /* This entry returns data about the specified break. Especially important is the 343 * condition flag which tells whether or not a conditional break has been satisfied 344 * 0 => either this is not a conditional break or condition has been satisfied, 345 * 1 => conditional break and condition has not been satisfied. 346 */ 347 348 break_ptr = arg_break_ptr; /* Copy arguments. */ 349 break_num = arg_break_num; 350 snt_ptr = arg_snt_ptr; 351 352 call SET_DEFAULTS; /* Establish this segment as the default segment. */ 353 354 call CHECK_BREAK_NUM; /* Validate the break number. */ 355 356 /* Now set the condition flag. If the length of the condition data is zero, then we 357 * know that this is not a conditional break and we can set the condition flag to 358 * zero. If this is a conditional break, then we must call out to a procedure that 359 * understands the condition data semantics so it can determaine if the condition 360 * has been met. 361 */ 362 arg_num_skips = break_slot.skip_count; /* no. of times to skip this break */ 363 364 if arg_num_skips > 0 365 then do; 366 cond_flag = 0; /* Ignore condition because break will be skiped */ 367 break_slot.skip_count = break_slot.skip_count - 1; 368 end; 369 370 else if break_slot.cond_len = 0 /* Is this a conditional break? */ 371 then cond_flag = 0; /* NO. */ 372 else call db_parse_condition$check (break_map_ptr, addr (break_slot.cond_data), 373 snt_ptr, cond_flag); 374 375 arg_cond_flag = cond_flag; /* Return info about break. */ 376 arg_comd_len = break_slot.comd_len; 377 arg_comd_ptr = addr (break_slot.comd_line); 378 arg_line_no = break_slot.line_no; 379 380 return; /* The end of the check_break entry. */ 381 /* ^L */ 382 set_break: entry (arg_break_ptr, arg_type, arg_snt_ptr, arg_print_mode); 383 384 385 /* This entry is called to set a break. Unless it is a disabled break, the word 386 * referenced by break_ptr will be set up to take a fault when executed. 387 */ 388 389 break_ptr = arg_break_ptr; /* Copy arguments. */ 390 type = arg_type; 391 snt_ptr = arg_snt_ptr; 392 print_mode = arg_print_mode; 393 394 call SET_DEFAULTS; /* Set up this segment as the default segment. */ 395 396 /* Now we know that we have pointers to the break map of the default segment and 397 * to the user's break segment. Next, we will look for a free slot in the break map 398 * where we can put this new break. If no slots are available, we will try to allocate 399 * some. 400 */ 401 break_offset = fixed (rel (break_ptr)); /* Get word offset of where the break is to go. 402 * This is used to identify the break. */ 403 404 new_bnum = -1; /* Initialize the new break number to indicate that 405 * we don't have a slot for the break yet. */ 406 407 do break_num = 1 to bmap.num_slots; /* Search through all the break slots in 408 * this break map. */ 409 call GET_BREAK_SLOT_PTR; /* Get pointer to this slot. */ 410 if break_slot.type = -1 /* Is this break slot free? */ 411 then if new_bnum = -1 /* YES, but is it the first free slot? */ 412 then new_bnum = break_num; /* YES, this is the slot we will use. */ 413 else; 414 415 /* NO, this slot is not free. There is a break set in it. See if it is the break 416 * we are trying to set now. If it is a temporary break, we still want to set it. 417 */ 418 else if break_slot.offset = break_offset 419 then do; /* This is the break we are trying to set. */ 420 if (break_slot.type ^= 1) & 421 (break_slot.type ^= 3) 422 then do; /* This is not a temporary break. */ 423 call ioa_$ioa_stream (debug_output, "Break ^d already set at ^p", break_num, break_ptr); 424 return; 425 end; 426 new_bnum = break_num; /* Temp break. Use this slot. Restore inst. */ 427 break_ptr -> based_word = break_slot.old_word; 428 end; 429 end; /* We have just checked one break slot in the map. */ 430 431 if new_bnum = -1 /* Did we find a free break slot? */ 432 then do; /* No, try to allocate more slots. */ 433 call db_break_map$get_slots (break_map_ptr); 434 if break_map_ptr = null () /* Did we get more slots? */ 435 then do; /* NO. */ 436 call ioa_$ioa_stream (debug_output, "Unable to allocate more break slots in ^a>^a", 437 bseg.seg (segx).dir_name, bseg.seg (segx).ent_name); 438 return; 439 end; 440 new_bnum = bmap.num_set + 1; /* Get number of first new slot. */ 441 end; 442 443 /* Now we have an index to the break slot we will use for this new break. We 444 * must increment the count of breaks that are set and we must initialize the 445 * break itself. 446 */ 447 break_num = new_bnum; /* Use new break number. */ 448 bmap.num_set = bmap.num_set + 1; /* One more break is being set. */ 449 call GET_BREAK_SLOT_PTR; /* Get pointer to new break slot. */ 450 451 break_slot.type = type; /* Now fill in the break slot. */ 452 break_slot.offset = break_offset; 453 break_slot.old_word = break_ptr -> based_word; 454 455 /* Get the line number associated with the location (if possible). */ 456 457 call db_line_no (snt_ptr, fixed (rel (break_ptr), 18), i, j, break_slot.line_no); 458 459 /* Get the number of words used by this instruction. If there are more 460 * than one, this is an EIS instruction. 461 */ 462 break_slot.num_words = op_mnemonic_$op_mnemonic (fixed (break_ptr -> instr.opcode, 17)).num_words; 463 464 /* Initially there are no skips set, there is no command to execute, and there is 465 * no condition set. 466 */ 467 break_slot.reserved (*), 468 break_slot.skip_count, 469 break_slot.comd_len, 470 break_slot.cond_len = 0; 471 472 call LIST; /* Tell user that break is set. */ 473 474 if type < 2 /* Is break a disabled type? */ 475 then do; /* No, set break. */ 476 mme2.break_num = break_num; /* Connect mme2 to break slot via break index. */ 477 break_ptr -> mme2_map = mme2; /* Move mme2 into break location. */ 478 end; 479 480 return; /* This is the end of the set_break entry. */ 481 /* ^L */ 482 set_skips: entry (arg_break_num, arg_num_skips); 483 484 485 /* This entry is called to set the skip count in the specified break of the 486 * default segment. 487 */ 488 489 break_num = arg_break_num; /* Copy argument. */ 490 491 call CHECK_DEFAULT; /* Make sure default segment set up 492 * and break number valid. */ 493 break_slot.skip_count = arg_num_skips; 494 495 return; 496 /* ^L */ 497 restart: entry (arg_break_ptr, arg_break_num, arg_num_skips, arg_scu_ptr, arg_print_mode); 498 499 /* This entry is called to restart a break. To do this we must modify the SCU 500 * data in the stack frame of the debug break handler. When the break handler 501 * returns, the instruction that was replaced by the mme2 will be executed. 502 */ 503 504 break_ptr = arg_break_ptr; /* Copy some arguments. */ 505 break_num = arg_break_num; 506 scup = arg_scu_ptr; 507 print_mode = arg_print_mode; 508 509 if break_ptr -> mme2_map.op_code ^= mme2.op_code /* Break has alredy been reset */ 510 then scup -> scu.even_inst = break_ptr -> based_word; 511 512 else do; /* Break is still set. */ 513 call SET_DEFAULTS; 514 call CHECK_BREAK_NUM; /* Make sure it is still valid. */ 515 scup -> scu.even_inst = break_slot.old_word; 516 517 if break_slot.type = 1 /* Is this a temporary break? */ 518 519 then call RESET; /* Temporary break */ 520 else do; /* Regular break */ 521 522 if arg_num_skips >= 0 then break_slot.skip_count = arg_num_skips - 1; 523 if break_slot.num_words > 1 /* EIS instruction */ 524 & bmap.version = "ver3" 525 526 then do; 527 inst_ptr = addrel (break_ptr, break_slot.num_words); 528 bmap.eis.mme2_indw = rel (break_ptr); 529 bmap.eis.inst_indw = rel (inst_ptr); 530 bmap.eis.mme2 = break_ptr -> based_word; 531 bmap.eis.inst = inst_ptr -> based_word; 532 break_ptr -> based_word = break_slot.old_word; 533 inst_ptr -> based_word = bmap.eis.tra; 534 end; 535 end; 536 end; 537 538 scup -> scu.apu.xsf = "0"b; /* These fields must be zero. */ 539 addr (scup -> scu.word3) -> based_word = "0"b; 540 scup -> scu.cu.its = "0"b; 541 542 /* If a break has just been set in the following word (.ct request or by the < request), the 543 odd instruction will have to be set since it has already been fetched. 544 */ 545 546 break_ptr = addrel (break_ptr, 1); 547 if break_ptr -> mme2_map.op_code = mme2.op_code 548 then scup -> scu.odd_inst = break_ptr -> based_word; 549 550 return; /* This is the end of the restart entry. */ 551 /* ^L */ 552 single: entry (arg_break_num, arg_action_code, arg_line_len, arg_line, arg_print_mode); 553 554 555 /* This entry is called to perform an action on ONE break that is assumed to 556 * be in the default segment. 557 */ 558 559 break_num = arg_break_num; /* Copy arguments. */ 560 action_code = arg_action_code; 561 line_len = arg_line_len; 562 print_mode = arg_print_mode; 563 564 call CHECK_DEFAULT; /* Make sure everything is OK. */ 565 566 if break_slot.type ^= -1 /* Is break really set? */ 567 then call DO_ACTION; /* YES, go perform action on this break. */ 568 else call ioa_$ioa_stream (debug_output, "Break ^d not set.", break_num); 569 570 return; 571 /* ^L */ 572 sub_global: entry (arg_action_code, arg_line_len, arg_line, arg_print_mode); 573 574 575 /* This entry is called to perform an action on all of the breaks set in the 576 * DEFAULT SEGMENT. 577 */ 578 action_flag = "0"b; /* Initialize flag. */ 579 action_code = arg_action_code; /* Copy arguments. */ 580 line_len = arg_line_len; 581 print_mode = arg_print_mode; 582 break_num = 1; /* Set up dummy break number. */ 583 call CHECK_DEFAULT; 584 585 /* If there are no breaks set in this segment, we will delete its break map. 586 * This will also delete this segment's entry in the break segment array. 587 */ 588 if bmap.num_set = 0 /* Any breaks set? */ 589 then do; /* NO. */ 590 call DELETE_BMAP; 591 call ioa_$ioa_stream (debug_output, "No breaks set."); 592 return; 593 end; 594 595 /* There are breaks set in the default segment. We have to look at all of the slots 596 * in this segments break map. We will perform the specified action on all of the 597 * breaks that are found. 598 */ 599 do break_num = 1 to bmap.num_slots while (break_map_ptr ^= null ()); 600 call GET_BREAK_SLOT_PTR; 601 if break_slot.type ^= -1 /* Is there a break in this slot? */ 602 then call DO_ACTION; /* YES. */ 603 end; 604 605 if ^action_flag 606 then call ioa_$ioa_stream (debug_output, "No breaks set."); 607 608 return; /* End of sub_global entry. */ 609 /* ^L */ 610 global: entry (arg_action_code, arg_line_len, arg_line, arg_print_mode); 611 612 613 /* This entry is called to perform a specified action an all of the breaks the user 614 * has in ALL of the segments referenced by his break segment. 615 */ 616 617 action_flag = "0"b; /* Initialize flag. */ 618 action_code = arg_action_code; /* Copy arguments. */ 619 line_len = arg_line_len; 620 print_mode = arg_print_mode; 621 622 if break_seg_ptr = null () /* Make sure we have a break segment. */ 623 then call INIT_BREAK_SEG; /* We don't care about any default segment. */ 624 625 if bseg.num_segs > 0 then do; /* Breaks are set */ 626 segx = 1; 627 do while (segx <= bseg.num_segs); /* Process all segments in user's break segment. 628 * If not, the segment entry will be deleted 629 * and delete_seg_entry_flag will be ON. */ 630 call CHECK_SEGMENT; 631 632 if ^ delete_seg_entry_flag then do; /* Segment not deleted; at least one break */ 633 634 do break_num = 1 to bmap.num_slots while (break_map_ptr ^= null ()); 635 call GET_BREAK_SLOT_PTR; 636 if break_slot.type ^= -1 then call DO_ACTION; 637 end; 638 if ^delete_seg_entry_flag then segx = segx + 1; 639 end; 640 end; 641 end; 642 643 if ^action_flag then call ioa_$ioa_stream (debug_output, "No breaks set."); 644 645 return; /* The end of the global entry. */ 646 /* ^L */ 647 SET_DEFAULTS: procedure; 648 649 650 /* This procedure establishes the segment with the break as the default segment. 651 * It also makes sure that we have a break segment to work with - it sets up the 652 * pointer to the break segment. The default segment index references this segment's 653 * entry in the user's break segment and the default break map pointer references the 654 * break map in this segment. The entry for this segment in the user's break segment 655 * is initialized. If none exists, one will be created. 656 */ 657 658 if break_seg_ptr = null () /* Has the break segment been set up? */ 659 then call INIT_BREAK_SEG; /* No, do it now. */ 660 661 /* Get the name of the new default segment. */ 662 663 call hcs_$fs_get_path_name (break_ptr, dir_name, (0), ent_name, code); 664 if code ^= 0 665 then goto SET_DEF_ERR; 666 667 668 /* Get the bit count and the uid of this segment. Note, if the path name is for 669 * a link, then we will chase the link, and get the status of the branch itself. 670 */ 671 call hcs_$status_long (dir_name, ent_name, 1b, addr (branch), null (), code); 672 if code ^= 0 673 then goto SET_DEF_ERR; 674 675 676 /* Now get the pointer to the break map for this segment. If no break map exists, it 677 * will be created. 678 */ 679 call db_break_map$init (break_ptr, fixed (branch.bitcnt, 24), break_map_ptr); 680 if break_map_ptr = null () | break_ptr = null then do; 681 arg_break_ptr = null; 682 goto RETURN_FROM_DB_BREAK; 683 end; 684 685 /* Now we must find the entry in the break segment which corresponds to the new 686 * default segment. If there is no entry for this segment, then one will be created. 687 * Note, the search through the break segment entries is done for uid's and not 688 * for path names since they may have been changed. 689 */ 690 do segx = 1 to bseg.num_segs; 691 if bseg.seg (segx).uid = branch.uid 692 then goto SET_DEF_SEG_FOUND; 693 end; 694 695 696 /* This break segment doesn't contain an entry for the dafault segment. Thus we 697 * will create one. 698 */ 699 call set_break_seg_bc (segx, "0"b); 700 701 bseg.num_segs = segx; /* Up count of segments. */ 702 bseg.seg (segx).uid = branch.uid; /* This relates the entry to the segment. */ 703 704 705 /* Now that we know the index of the break segment entry for the default segment we 706 * can fill in the names of the segment. These must be reset each time the segment 707 * is established as the default segment. 708 */ 709 710 SET_DEF_SEG_FOUND: 711 712 bseg.seg (segx).dir_name = dir_name; 713 bseg.seg (segx).ent_name = ent_name; 714 715 def_break_map_ptr = break_map_ptr; /* Set up default break map pointer. */ 716 def_segx = segx; /* Set up default segment index. */ 717 718 return; 719 720 721 SET_DEF_ERR: 722 723 call com_err_ (code, "debug", "Cannot make ^p the default break segment.", break_ptr); 724 goto RETURN_FROM_DB_BREAK; /* Transfer out of this internal procedure and 725 * return directly to the caller of db_break. */ 726 727 end SET_DEFAULTS; 728 /* ^L */ 729 CHECK_DEFAULT: procedure; 730 731 732 /* This internal procedure checks to see if there is a default segment established. 733 * If not, there is an error. It will also check to see if the break number passed 734 * as an argument is valid for this segment. If everything is OK, it will copy the 735 * default variables, which are in internal static, and the break number, which is an 736 * argument, into automatic variables. 737 */ 738 739 if def_segx = 0 /* Has default segment been established? */ 740 then do; /* NO, error. */ 741 call ioa_$ioa_stream (debug_output, "No default break segment."); 742 goto RETURN_FROM_DB_BREAK; 743 end; 744 745 break_map_ptr = def_break_map_ptr; /* Copy default variables. */ 746 segx = def_segx; 747 748 call VALIDATE_BREAK_NUM; /* Check boonds of break number. */ 749 call GET_BREAK_SLOT_PTR; /* Get pointer to its break slot. */ 750 751 752 end CHECK_DEFAULT; 753 /* ^L */ 754 CHECK_BREAK_NUM: procedure; 755 756 757 /* This internal procedure is called to perform special validation on the break number. 758 * It checks to see if the break number is within valid bounds and it also checks to 759 * see that the specified breakis enabled. If the break number is valid, 760 * it sets up the break slot pointer to point to the break slot associated 761 * with this break number. 762 */ 763 764 call VALIDATE_BREAK_NUM; /* Check bounds of break number. */ 765 766 call GET_BREAK_SLOT_PTR; /* Get pointer to this break's slot. */ 767 if (break_slot.type = -1) | /* Is break not set? */ 768 (break_slot.type > 1) /* Or is break disabled? */ 769 then do; /* Yes, break not enabled. */ 770 call ioa_$ioa_stream (debug_output, "Break ^d should be enabled but isn't. Segment must be recompiled.", break_num); 771 arg_break_ptr = null; 772 goto RETURN_FROM_DB_BREAK; 773 end; 774 775 776 end CHECK_BREAK_NUM; 777 /* ^L */ 778 VALIDATE_BREAK_NUM: procedure; 779 780 781 /* This procedure is called to check that the current break number is 782 * within valid bounds for the current default segment. 783 */ 784 785 if (break_num <= 0) | /* Is break number within bounds. */ 786 (break_num > bmap.num_slots) 787 then do; /* No, outside bounds of break map. */ 788 call ioa_$ioa_stream (debug_output, "Illegal break number ^d for segment ^a>^a", 789 break_num, bseg.seg (segx).dir_name, bseg.seg (segx).ent_name); 790 goto RETURN_FROM_DB_BREAK; 791 end; 792 793 end VALIDATE_BREAK_NUM; 794 /* ^L */ 795 CHECK_SEGMENT: procedure; 796 797 798 /* This procedure is called to get the break map of a segment and to validate the 799 * fact that the segment has breaks set. The first thing that we must do is to 800 * initiate this segment so we can get a pointer to it and get its bit count. 801 * If any of the following four conditions occur, we will delete this entry in 802 * the break segment: 803 * 1. The segment does not exist. 804 * 2. The uid of the segment doesn't match the uid in the break segment entry. 805 * This implies that the name of the segment was changed and a new 806 * segment was created with its old name. 807 * 3. There is no break map for this segment; => it has no breaks. 808 * 4. There is a break map, but there are no breaks set. 809 * If the segment entry is deleted and there is a break map, the break map will 810 * also be deleted. If for any of the above reasons the segment entry is deleted 811 * the delete_seg_entry_flag will be turned ON. 812 */ 813 delete_seg_entry_flag = "0"b; /* Assume seg entry OK. */ 814 815 call hcs_$initiate_count (bseg.seg (segx).dir_name, bseg.seg (segx).ent_name, 816 "", bit_count, 0, seg_ptr, code); 817 if seg_ptr = null () /* Does segment exist? */ 818 then do; /* NO. */ 819 call DELETE_SEG_ENTRY; 820 return; 821 end; 822 823 call hcs_$status_long (bseg.seg (segx).dir_name, bseg.seg (segx).ent_name, 1b, 824 addr (branch), null (), code); 825 if bseg.seg (segx).uid ^= branch.uid /* Is it realy the same segment? */ 826 then do; /* NO. */ 827 call ioa_$ioa_stream (debug_output, "Path name ^a>^a now references new segment.", 828 bseg.seg (segx).dir_name, bseg.seg (segx).ent_name); 829 call DELETE_SEG_ENTRY; 830 return; 831 end; 832 833 call db_break_map$check (seg_ptr, bit_count, break_map_ptr); 834 if seg_ptr = null then return; /* error return for illegal break format */ 835 836 if break_map_ptr = null () /* Does it have a break map? */ 837 then do; /* NO. */ 838 if print_mode = 1 /* Only print this message in LONG mode. */ 839 then call ioa_$ioa_stream (debug_output, "^a>^a has no break map.", bseg.seg (segx).dir_name, 840 bseg.seg (segx).ent_name); 841 call DELETE_SEG_ENTRY; 842 return; 843 end; 844 845 /* This segment has a break map. Does it have any breaks set? If not, we will 846 * delete its break map. This will also result in deleteing its segment entry. 847 */ 848 if bmap.num_set = 0 /* Does it have any breaks set? */ 849 then do; /* NO. */ 850 call DELETE_BMAP; 851 return; 852 end; 853 854 end CHECK_SEGMENT; 855 /* ^L */ 856 GET_BREAK_SLOT_PTR: procedure; 857 858 859 /* This internal procedure is called to get a pointer to the break slot 860 * referenced by "break_num". Temporarily, there are two versionb of 861 * the break_map_header. This procedure must decide which version is being used. 862 */ 863 864 break_slot_ptr = addr (bmap.breaks (break_num)); 865 866 867 end GET_BREAK_SLOT_PTR; 868 /* ^L */ 869 INIT_BREAK_SEG: procedure; 870 871 872 /* This procedure is called to get a pointer to the user's break segment in his 873 * home directory. The pointer is set in "break_seg_ptr" which is in internal 874 * static. If no break segment exists for this user, then one will be created. 875 */ 876 877 call user_info_$homedir (dir_name); /* Get the name of the user's 878 * home directory. */ 879 880 call user_info_ (ent_name); /* Get the user's login name. 881 * Note, it is a max of 24 chars. */ 882 883 i = index (ent_name, " "); /* Get index of first blank. */ 884 substr (ent_name, i, 7) = ".breaks"; /* Add debug suffix. */ 885 886 887 /* The following call will get a pointer to the segment. If none exists, it will 888 * create the segment. In any case, there is an error only if we don't get a 889 * valid pointer back. We don't use a reference name and we want RWA access to 890 * the segment. 891 */ 892 call hcs_$make_seg (dir_name, ent_name, "", 01011b, break_seg_ptr, code); 893 if break_seg_ptr = null () 894 then do; 895 call com_err_ (code, "debug", "^a>^a", dir_name, ent_name); 896 goto RETURN_FROM_DB_BREAK; 897 end; 898 899 900 end INIT_BREAK_SEG; 901 /* ^L */ 902 DO_ACTION: procedure; 903 904 905 /* This internal procedure acts as a transfer vector. It calls the db_break 906 * procedure which will perform the specified action. The action code 907 * indicates the type of action. The action flag is turned on in order to 908 * indicate that the action has been performed for at least one break. 909 */ 910 911 action_flag = "1"b; 912 913 goto ACTION_LABEL (action_code); /* Go to specified call. */ 914 915 916 ACTION_LABEL (1): /* LIST a break. */ 917 call LIST; 918 return; 919 920 921 922 ACTION_LABEL (2): /* RESET a break. */ 923 call RESET; 924 return; 925 926 927 ACTION_LABEL (3): /* DISABLE a break. */ 928 call DISABLE; 929 return; 930 931 932 ACTION_LABEL (4): /* ENABLE a break. */ 933 call ENABLE; 934 return; 935 936 937 ACTION_LABEL (5): /* Set a COMMAND in a break. */ 938 call SET_COMMAND; 939 return; 940 941 942 ACTION_LABEL (6): /* Set a CONDITION in a break. */ 943 call SET_CONDITION; 944 945 946 end DO_ACTION; 947 /* ^L */ 948 LIST: procedure; 949 950 951 /* This procedure is called to print the contents of one break. The print_mode flag 952 * determines the mode of printing. There are two modes: 953 * SHORT (print_mode = 0) Print as little as possible. 954 * LONG (print_mode = 1) Print as much as possible. 955 */ 956 957 dcl line_info char (14) aligned; /* Char representation of line num. (if available) */ 958 959 960 if break_slot.line_no > 0 961 then call ioa_$rsnnl (" (line ^d)", line_info, j, break_slot.line_no); 962 else line_info = ""; 963 964 /* Print short mode information first. */ 965 966 call ioa_$ioa_stream (debug_output, "^a ^d set at ^a|^o^a", 967 break_type_name (break_slot.type), break_num, 968 bseg.seg (segx).ent_name, break_slot.offset, line_info); 969 970 if print_mode = 0 /* If short mode, that's all. */ 971 then return; 972 973 /* Now we must print the long mode data. First print the instruction where the 974 * break is. 975 */ 976 call print_text_$real_offset (addr (break_slot.old_word), source_string, break_slot.offset); 977 call ioa_$ioa_stream (debug_output, "^-At instruction: ^a", source_string); 978 979 /* Now print the command line and the condition line if they exist. */ 980 981 if break_slot.comd_len ^= 0 982 then call ioa_$ioa_stream (debug_output, "Command = ^a", substr (break_slot.comd_line, 1, break_slot.comd_len)); 983 984 if break_slot.cond_len ^= 0 /* Is there a condition line? */ 985 then do; /* Yes, call routine that knows condition format. */ 986 call db_parse_condition$print_line (addr (break_slot.cond_data), source_string); 987 call ioa_$ioa_stream (debug_output, "Condition = ^a", source_string); 988 end; 989 990 991 end LIST; 992 /* ^L */ 993 RESET: procedure; 994 995 996 /* This procedure is called to reset a break. Resetting a break involves 997 * removing the mme2 instruction from the break word and freeing the break slot 998 * used by the break. When the last break in a segment is reset, its 999 * break map will be deleted. Also, its entry in the break segment array will 1000 * be deleted. 1001 */ 1002 1003 call DISABLE; /* First disable the mme2. */ 1004 1005 break_slot.type = -1; /* Now free the break slot. */ 1006 bmap.num_set = bmap.num_set -1; /* Segment has one less break set. */ 1007 1008 if print_mode ^= 0 1009 then call ioa_$ioa_stream (debug_output, "Break ^d at ^a|^o reset.", 1010 break_num, bseg.seg (segx).ent_name, break_slot.offset); 1011 1012 /* Now that the break has been reset, we must check to see if there are any breaks left 1013 * in the segment. If not, we will delete its break map. 1014 */ 1015 if bmap.num_set = 0 /* Any breaks left in segment? */ 1016 then call DELETE_BMAP; /* NO. */ 1017 1018 1019 end RESET; 1020 /* ^L */ 1021 DISABLE: procedure; 1022 1023 /* This procedure is called to disable a break. Disabling a break involves 1024 * putting the word that was originally in the break word back into the break word. 1025 * This overlays the mme2 that is there while the break is enabled. 1026 */ 1027 1028 if break_slot.type > 1 /* Is break already disabled? */ 1029 then return; /* YES. */ 1030 1031 /* Get a pointer to the break and set up our own mme2 word to look like what should 1032 * be in the break word now. 1033 */ 1034 break_word_ptr = ptr (break_map_ptr, break_slot.offset); 1035 mme2.break_num = break_num; 1036 1037 1038 /* Now check to see that this is a valid break. The break word should contain a 1039 * mme2 instruction with an address equal to this break number. 1040 */ 1041 if break_word_ptr -> based_word ^= addr (mme2) -> based_word 1042 then do; 1043 call ioa_$ioa_stream (debug_output, "Break ^d at ^a|^o is invalid.", 1044 break_num, bseg.seg (segx).ent_name, break_slot.offset); 1045 return; 1046 end; 1047 1048 /* It is a valid break so we disable it now. */ 1049 1050 break_word_ptr -> based_word = break_slot.old_word; 1051 1052 1053 /* Now set the type to indicate that this is a disabled break. Regular breaks 1054 * are now type 2 and temporary breaks are now type 3. 1055 */ 1056 break_slot.type = break_slot.type + 2; 1057 1058 1059 end DISABLE; 1060 /* ^L */ 1061 ENABLE: procedure; 1062 1063 1064 /* This procedure is called to enable a break. Enabling a break involves simply 1065 * putting a mme2 instruction the the break word. 1066 */ 1067 1068 if break_slot.type < 2 /* Is break already enabled */ 1069 then return; /* YES, don't bother. */ 1070 1071 mme2.break_num = break_num; /* Addr field of mme2 = break num. */ 1072 ptr (break_map_ptr, break_slot.offset) -> mme2_map = mme2; 1073 1074 1075 /* Now set the type to indicate that the break is enabled. If it is a regular 1076 * break it will go from 2 -> 0 and if it is a temporary break if will go from 1077 * 3 -> 1. 1078 */ 1079 break_slot.type = break_slot.type - 2; 1080 1081 1082 end ENABLE; 1083 /* ^L */ 1084 SET_COMMAND: procedure; 1085 1086 1087 /* This procedure sets up a command in the specified break. 1088 */ 1089 1090 break_slot.comd_len = line_len; 1091 1092 if line_len ^= 0 /* Is there really a command line? */ 1093 then substr (break_slot.comd_line, 1, line_len) = substr (arg_line, 1, line_len); 1094 1095 1096 end SET_COMMAND; 1097 1098 1099 1100 1101 1102 1103 SET_CONDITION: procedure; 1104 1105 1106 /* This procedure is called to set or to reset a condition in a break. The type of 1107 * break is not considered and is not changed. Only the condition information 1108 * in the break slot is changed. We must determine if we are to set the condition 1109 * or reset the condition. If the condition length is zero, we must reset. 1110 */ 1111 1112 if line_len = 0 /* Are we to SET or RESET? */ 1113 then break_slot.cond_len = 0; /* RESET - this implies no condition. */ 1114 else do; /* SET condition, there is data. */ 1115 break_slot.cond_len = line_len; 1116 substr (break_slot.cond_data, 1, line_len) = substr (arg_line, 1, line_len); 1117 end; 1118 1119 1120 end SET_CONDITION; 1121 /* ^L */ 1122 DELETE_BMAP: procedure; 1123 1124 1125 /* This procedure is called to delete a beak map from a segment. This is done 1126 * whenever a segment is referenced which has a break map but does not have any 1127 * breaks set. This will also result in deleting the segment's entry in 1128 * the break segment array. 1129 */ 1130 1131 call db_break_map$delete (break_map_ptr); 1132 break_map_ptr = null; /* Make sure no attempt is made 1133 * look at this break map again */ 1134 1135 call DELETE_SEG_ENTRY; 1136 1137 /* If this segment is the default segment, we must reset the default segment 1138 * variables to indicate that there is no default segment. 1139 */ 1140 if def_segx = segx /* Is this the default segment? */ 1141 then def_segx = 0; /* YES, but no longer. */ 1142 1143 1144 end DELETE_BMAP; 1145 /* ^L */ 1146 DELETE_SEG_ENTRY: procedure; 1147 1148 1149 /* This procedure is called to delete an entry in the user's break segment. 1150 * We will move the last entry in the break segment array into the entry 1151 * that is being deleted. Then we will clear the last entry and decrement 1152 * the count of entries. 1153 */ 1154 1155 /* Move last entry into the one being deleted. */ 1156 1157 break_seg_ptr -> bseg_map.array (segx).entry = 1158 break_seg_ptr -> bseg_map.array (bseg.num_segs).entry; 1159 1160 bseg.num_segs = bseg.num_segs - 1; /* Decrement the count of entries. */ 1161 delete_seg_entry_flag = "1"b; 1162 call set_break_seg_bc (bseg.num_segs, "1"b); 1163 1164 end DELETE_SEG_ENTRY; 1165 1166 /* ^L */ 1167 /* This procedure sets the bit count on the user's break segment. It is called when a new segment 1168 slot is added or deleted. 1169 */ 1170 set_break_seg_bc: proc (num_slots, truncate); 1171 1172 dcl num_slots fixed bin; /* size the break map will become */ 1173 dcl truncate bit (1) unal; /* truncate the break segment */ 1174 1175 dcl 1 break_slot aligned like bseg.seg based; 1176 dcl word_count fixed bin (18); 1177 dcl size builtin; 1178 1179 word_count = size (break_slot) * num_slots + 1; 1180 call hcs_$truncate_seg (break_seg_ptr, word_count, code); 1181 if code = 0 then call hcs_$set_bc_seg (break_seg_ptr, 36 * word_count, code); 1182 if code ^= 0 then call com_err_ (code, "break segment"); 1183 1184 return; 1185 1186 end set_break_seg_bc; 1187 1188 /* ^L */ 1189 /* This statement is part of the main db_break block. It is provided so that 1190 * internal procedures may return directly to the caller of db_break. Thus the 1191 * db_break entry which called the internal procedure doesn't have to check for 1192 * error conditions. 1193 */ 1194 1195 RETURN_FROM_DB_BREAK: 1196 1197 return; 1198 1199 1200 end db_break;