COMPILATION LISTING OF SEGMENT unwind_stack_ Compiled by: Multics PL/I Compiler, Release 32f, of October 9, 1989 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 11/11/89 0959.8 mst Sat Options: optimize map 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: style2 */ 14 15 unwind_stack_: 16 proc (a_start_sp, a_target_sp, code); 17 18 /* This procedure actually does the unwinding for the unwinder. 19* It examines all the stack frames from the frame before start_sp to target_sp 20* looking for cleanup handlers. When one is found, cleanup is signalled 21* (signal_ is sure to find the handler). 22* If target_sp is null, the whole stack is unwound. */ 23 24 /* coded 1 November 1973 by M. Weaver (much of code copied from signal_) */ 25 /* modified to protect against terminated cleanup handlers, Benson I. 26* Margulies, December 1981 */ 27 28 dcl a_start_sp ptr, 29 a_target_sp ptr, 30 code fixed bin (35); 31 32 dcl (start_sp, target_sp, entryp, onlistp, oldp) 33 ptr; 34 dcl based_p ptr based; 35 36 dcl loops fixed bin init (0); 37 dcl ou_count fixed bin; 38 dcl error_table_$not_done ext fixed bin (35); 39 40 dcl onlistrel bit (18) aligned; 41 dcl allsw bit (1) aligned; 42 43 dcl char_string char (onlistp -> on_unit.size) aligned based (onlistp -> on_unit.name); 44 45 dcl (addrel, baseno, baseptr, bin, length, null, rel) 46 builtin; 47 48 dcl entry_variable variable entry (ptr, char (*), ptr, ptr, bit (1) aligned); 49 50 dcl 1 label based aligned, /* template for label or entry variable */ 51 2 target ptr, 52 2 stack ptr; 53 1 1 /* BEGIN INCLUDE FILE ... on_unit.incl.pl1 */ 1 2 /* coded 31 October 1973 by M. Weaver to facilitate adding flags */ 1 3 1 4 dcl 1 on_unit based aligned, 1 5 2 name ptr, /* pointer to the condition name */ 1 6 2 body ptr, /* pointer to procedure to handle condition */ 1 7 2 size fixed bin, /* length of the condition name */ 1 8 2 next bit (18) unaligned, /* rel pointer to next on unit */ 1 9 2 flags unaligned, 1 10 3 pl1_snap bit (1) unaligned, /* "1"b indicates to call snap procedure */ 1 11 3 pl1_system bit (1) unaligned, /* "1"b indicates to use system condition handler */ 1 12 3 pad bit (16) unaligned, 1 13 2 file ptr; /* ptr to file descriptor for pl1 I/O condition */ 1 14 1 15 /* END INCLUDE FILE ... on_unit.incl.pl1 */ 54 55 2 1 /* BEGIN INCLUDE FILE ... stack_frame.incl.pl1 ... */ 2 2 2 3 /* format: off */ 2 4 2 5 /* Modified: 16 Dec 1977, D. Levin - to add fio_ps_ptr and pl1_ps_ptr */ 2 6 /* Modified: 3 Feb 1978, P. Krupp - to add run_unit_manager bit & main_proc bit */ 2 7 /* Modified: 21 March 1978, D. Levin - change fio_ps_ptr to support_ptr */ 2 8 /* Modified: 03/01/84, S. Herbst - Added RETURN_PTR_MASK */ 2 9 2 10 2 11 /****^ HISTORY COMMENTS: 2 12* 1) change(86-09-15,Kissel), approve(86-09-15,MCR7473), 2 13* audit(86-10-01,Fawcett), install(86-11-03,MR12.0-1206): 2 14* Modified to add constants for the translator_id field in the stack_frame 2 15* structure. 2 16* END HISTORY COMMENTS */ 2 17 2 18 2 19 dcl RETURN_PTR_MASK bit (72) int static options (constant) /* mask to be AND'd with stack_frame.return_ptr */ 2 20 init ("777777777777777777000000"b3); /* when copying, to ignore bits that a call fills */ 2 21 /* with indicators (nonzero for Fortran hexfp caller) */ 2 22 /* say: unspec(ptr) = unspec(stack_frame.return_ptr) & RETURN_PTR_MASK; */ 2 23 2 24 dcl TRANSLATOR_ID_PL1V2 bit (18) internal static options (constant) init ("000000"b3); 2 25 dcl TRANSLATOR_ID_ALM bit (18) internal static options (constant) init ("000001"b3); 2 26 dcl TRANSLATOR_ID_PL1V1 bit (18) internal static options (constant) init ("000002"b3); 2 27 dcl TRANSLATOR_ID_SIGNAL_CALLER bit (18) internal static options (constant) init ("000003"b3); 2 28 dcl TRANSLATOR_ID_SIGNALLER bit (18) internal static options (constant) init ("000004"b3); 2 29 2 30 2 31 dcl sp pointer; /* pointer to beginning of stack frame */ 2 32 2 33 dcl stack_frame_min_length fixed bin static init(48); 2 34 2 35 2 36 dcl 1 stack_frame based(sp) aligned, 2 37 2 pointer_registers(0 : 7) ptr, 2 38 2 prev_sp pointer, 2 39 2 next_sp pointer, 2 40 2 return_ptr pointer, 2 41 2 entry_ptr pointer, 2 42 2 operator_and_lp_ptr ptr, /* serves as both */ 2 43 2 arg_ptr pointer, 2 44 2 static_ptr ptr unaligned, 2 45 2 support_ptr ptr unal, /* only used by fortran I/O */ 2 46 2 on_unit_relp1 bit(18) unaligned, 2 47 2 on_unit_relp2 bit(18) unaligned, 2 48 2 translator_id bit(18) unaligned, /* Translator ID (see constants above) 2 49* 0 => PL/I version II 2 50* 1 => ALM 2 51* 2 => PL/I version I 2 52* 3 => signal caller frame 2 53* 4 => signaller frame */ 2 54 2 operator_return_offset bit(18) unaligned, 2 55 2 x(0: 7) bit(18) unaligned, /* index registers */ 2 56 2 a bit(36), /* accumulator */ 2 57 2 q bit(36), /* q-register */ 2 58 2 e bit(36), /* exponent */ 2 59 2 timer bit(27) unaligned, /* timer */ 2 60 2 pad bit(6) unaligned, 2 61 2 ring_alarm_reg bit(3) unaligned; 2 62 2 63 2 64 dcl 1 stack_frame_flags based(sp) aligned, 2 65 2 pad(0 : 7) bit(72), /* skip over prs */ 2 66 2 xx0 bit(22) unal, 2 67 2 main_proc bit(1) unal, /* on if frame belongs to a main procedure */ 2 68 2 run_unit_manager bit(1) unal, /* on if frame belongs to run unit manager */ 2 69 2 signal bit(1) unal, /* on if frame belongs to logical signal_ */ 2 70 2 crawl_out bit(1) unal, /* on if this is a signal caller frame */ 2 71 2 signaller bit(1) unal, /* on if next frame is signaller's */ 2 72 2 link_trap bit(1) unal, /* on if this frame was made by the linker */ 2 73 2 support bit(1) unal, /* on if frame belongs to a support proc */ 2 74 2 condition bit(1) unal, /* on if condition established in this frame */ 2 75 2 xx0a bit(6) unal, 2 76 2 xx1 fixed bin, 2 77 2 xx2 fixed bin, 2 78 2 xx3 bit(25) unal, 2 79 2 old_crawl_out bit (1) unal, /* on if this is a signal caller frame */ 2 80 2 old_signaller bit(1) unal, /* on if next frame is signaller's */ 2 81 2 xx3a bit(9) unaligned, 2 82 2 xx4(9) bit(72) aligned, 2 83 2 v2_pl1_op_ret_base ptr, /* When a V2 PL/I program calls an operator the 2 84* * operator puts a pointer to the base of 2 85* * the calling procedure here. (text base ptr) */ 2 86 2 xx5 bit(72) aligned, 2 87 2 pl1_ps_ptr ptr; /* ptr to ps for this frame; also used by fio. */ 2 88 2 89 /* format: on */ 2 90 2 91 /* END INCLUDE FILE ... stack_frame.incl.pl1 */ 56 57 58 /* */ 59 start_sp = a_start_sp; /* copy aRGS */ 60 target_sp = a_target_sp; 61 code = 0; 62 63 if target_sp = null 64 then allsw = "1"b; /* unwind whole stack */ 65 else allsw = "0"b; 66 67 entryp = addr (entry_variable); /* set pointer to entry */ 68 sp = start_sp -> stack_frame.prev_sp; /* start from previous frame */ 69 70 stack_loop: /* check to determine if target stack level has been reached */ 71 if target_sp = sp 72 then return; /* all done; don't unwind target */ 73 74 /* see if we have already passed the target frame; 75* this could happen if target_sp does not point to the beginning of a stack frame */ 76 if bin (rel (target_sp), 18) > bin (rel (sp), 18) 77 then if ^allsw 78 then do; 79 code = error_table_$not_done; /* caller can better signal unwinder_error */ 80 return; 81 end; 82 83 /* Search the condition stack for a cleanup on unit. If found, signal cleanup. */ 84 if sp -> stack_frame_flags.condition 85 then do; /* have on units in this frame */ 86 onlistrel = sp -> stack_frame.on_unit_relp1; 87 /* pick up ptr to on unit thread */ 88 ou_count = 0; /* keep track of on units to check for loops */ 89 oldp = null; /* works as back thread */ 90 91 do while (onlistrel); /* search the on unit thread */ 92 onlistp = addrel (sp, onlistrel); /* get pr to next on unit */ 93 if onlistp -> on_unit.size = length ("cleanup") 94 then if char_string = "cleanup" 95 then do; /* unthread on unit and call handler */ 96 if oldp = null 97 then /* test for beginning of condition thread */ 98 sp -> stack_frame.on_unit_relp1 = onlistp -> on_unit.next; 99 else /* unthread cleanup on unit */ 100 oldp -> on_unit.next = onlistp -> on_unit.next; 101 entryp -> label.target = onlistp -> on_unit.body; 102 /* fill in entry variable */ 103 entryp -> label.stack = sp; 104 105 /**** The following block contains all the error trapping stuff to avoid 106* bad pointers as cleanup handlers. The code just above does not 107* actually reference through any pointers to the program handler. */ 108 109 begin; 110 111 declare (seg_fault_error, no_read_permission, no_execute_permission, 112 not_in_read_bracket, null_pointer, undefined_pointer, illegal_opcode, 113 illegal_modifier, not_in_call_bracket, illegal_procedure, 114 linkage_error) condition; 115 116 on seg_fault_error, no_read_permission, no_execute_permission, 117 not_in_read_bracket, null_pointer, undefined_pointer, illegal_opcode, 118 illegal_modifier, not_in_call_bracket, illegal_procedure, linkage_error 119 goto THIS_HANDLER_DONT; 120 121 call entry_variable (null (), "cleanup", null (), null, ("0"b)); 122 /* call this cleanup handler procedure */ 123 THIS_HANDLER_DONT: 124 end; 125 go to end_loop; /* done with this frame */ 126 end; 127 128 oldp = onlistp; /* save pointer to previous on unit */ 129 onlistrel = onlistp -> on_unit.next; 130 /* step to the next on unit and continue */ 131 ou_count = ou_count + 1; /* increment count of on units found */ 132 if ou_count > 200 133 then ptr (baseptr (-2), -2) -> based_p = sp; 134 /* term process if too many */ 135 end; 136 end; 137 138 end_loop: 139 sp -> stack_frame_flags.condition = "0"b; /* frame has disappeared as far as 140* condition mechanism is concerned */ 141 sp = sp -> stack_frame.prev_sp; /* step stack ptr back to previous frame */ 142 loops = loops + 1; /* increment count of stack frames found */ 143 if loops > 5000 144 then ptr (baseptr (-2), -2) -> based_p = sp; /* term process if too many */ 145 if baseno (start_sp) = baseno (sp) 146 then go to stack_loop; /* continue search if on same stack */ 147 148 return; /* caller will continue on another stack */ 149 150 end unwind_stack_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/11/89 0804.2 unwind_stack_.pl1 >spec>install>1110>unwind_stack_.pl1 54 1 05/06/74 1742.5 on_unit.incl.pl1 >ldd>include>on_unit.incl.pl1 56 2 11/07/86 1550.3 stack_frame.incl.pl1 >ldd>include>stack_frame.incl.pl1 NAMES DECLARED IN THIS COMPILATION. IDENTIFIER OFFSET LOC STORAGE CLASS DATA TYPE ATTRIBUTES AND REFERENCES (* indicates a set context) NAMES DECLARED BY DECLARE STATEMENT. a_start_sp parameter pointer dcl 28 ref 15 59 a_target_sp parameter pointer dcl 28 ref 15 60 addrel builtin function dcl 45 ref 92 allsw 000115 automatic bit(1) dcl 41 set ref 63* 65* 76 based_p based pointer dcl 34 set ref 132* 143* baseno builtin function dcl 45 ref 145 145 baseptr builtin function dcl 45 ref 132 143 bin builtin function dcl 45 ref 76 76 body 2 based pointer level 2 dcl 1-4 ref 101 char_string based char dcl 43 ref 93 code parameter fixed bin(35,0) dcl 28 set ref 15 61* 79* condition 20(29) based bit(1) level 2 packed packed unaligned dcl 2-64 set ref 84 138* entry_variable 000116 automatic entry variable dcl 48 set ref 67 121 entryp 000104 automatic pointer dcl 32 set ref 67* 101 103 error_table_$not_done 000010 external static fixed bin(35,0) dcl 38 ref 79 illegal_modifier 000152 stack reference condition dcl 111 ref 116 illegal_opcode 000144 stack reference condition dcl 111 ref 116 illegal_procedure 000166 stack reference condition dcl 111 ref 116 label based structure level 1 dcl 50 length builtin function dcl 45 ref 93 linkage_error 000174 stack reference condition dcl 111 ref 116 loops 000112 automatic fixed bin(17,0) initial dcl 36 set ref 36* 142* 142 143 name based pointer level 2 dcl 1-4 ref 93 next 5 based bit(18) level 2 packed packed unaligned dcl 1-4 set ref 96 99* 99 129 no_execute_permission 000114 stack reference condition dcl 111 ref 116 no_read_permission 000106 stack reference condition dcl 111 ref 116 not_in_call_bracket 000160 stack reference condition dcl 111 ref 116 not_in_read_bracket 000122 stack reference condition dcl 111 ref 116 null builtin function dcl 45 ref 63 89 96 121 121 121 121 121 121 null_pointer 000130 stack reference condition dcl 111 ref 116 oldp 000110 automatic pointer dcl 32 set ref 89* 96 99 128* on_unit based structure level 1 dcl 1-4 on_unit_relp1 36 based bit(18) level 2 packed packed unaligned dcl 2-36 set ref 86 96* onlistp 000106 automatic pointer dcl 32 set ref 92* 93 93 93 96 99 101 128 129 onlistrel 000114 automatic bit(18) dcl 40 set ref 86* 91 92 129* ou_count 000113 automatic fixed bin(17,0) dcl 37 set ref 88* 131* 131 132 prev_sp 20 based pointer level 2 dcl 2-36 ref 68 141 rel builtin function dcl 45 ref 76 76 seg_fault_error 000100 stack reference condition dcl 111 ref 116 size 4 based fixed bin(17,0) level 2 dcl 1-4 ref 93 93 sp 000122 automatic pointer dcl 2-31 set ref 68* 70 76 84 86 92 96 103 132 138 141* 141 143 145 stack 2 based pointer level 2 dcl 50 set ref 103* stack_frame based structure level 1 dcl 2-36 stack_frame_flags based structure level 1 dcl 2-64 start_sp 000100 automatic pointer dcl 32 set ref 59* 68 145 target based pointer level 2 dcl 50 set ref 101* target_sp 000102 automatic pointer dcl 32 set ref 60* 63 70 76 undefined_pointer 000136 stack reference condition dcl 111 ref 116 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. RETURN_PTR_MASK internal static bit(72) initial packed unaligned dcl 2-19 TRANSLATOR_ID_ALM internal static bit(18) initial packed unaligned dcl 2-25 TRANSLATOR_ID_PL1V1 internal static bit(18) initial packed unaligned dcl 2-26 TRANSLATOR_ID_PL1V2 internal static bit(18) initial packed unaligned dcl 2-24 TRANSLATOR_ID_SIGNALLER internal static bit(18) initial packed unaligned dcl 2-28 TRANSLATOR_ID_SIGNAL_CALLER internal static bit(18) initial packed unaligned dcl 2-27 stack_frame_min_length internal static fixed bin(17,0) initial dcl 2-33 NAMES DECLARED BY EXPLICIT CONTEXT. THIS_HANDLER_DONT 000364 constant label dcl 123 set ref 116 end_loop 000406 constant label dcl 138 ref 125 stack_loop 000130 constant label dcl 70 ref 145 unwind_stack_ 000076 constant entry external dcl 15 NAMES DECLARED BY CONTEXT OR IMPLICATION. addr builtin function ref 67 ptr builtin function ref 132 143 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 506 520 437 516 Length 714 437 12 160 47 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME unwind_stack_ 88 external procedure is an external procedure. begin block on line 109 164 begin block enables or reverts conditions. on unit on line 116 64 on unit STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME unwind_stack_ 000100 start_sp unwind_stack_ 000102 target_sp unwind_stack_ 000104 entryp unwind_stack_ 000106 onlistp unwind_stack_ 000110 oldp unwind_stack_ 000112 loops unwind_stack_ 000113 ou_count unwind_stack_ 000114 onlistrel unwind_stack_ 000115 allsw unwind_stack_ 000116 entry_variable unwind_stack_ 000122 sp unwind_stack_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. enter_begin_block leave_begin_block call_ent_var_desc return_mac tra_ext_1 enable_op ext_entry int_entry NO EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$not_done LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 15 000072 36 000103 59 000104 60 000110 61 000113 63 000114 65 000123 67 000124 68 000126 70 000130 76 000134 79 000145 80 000151 84 000152 86 000156 88 000161 89 000162 91 000164 92 000166 93 000171 96 000201 99 000211 101 000214 103 000216 109 000221 116 000224 121 000325 123 000364 125 000365 128 000366 129 000367 131 000372 132 000373 135 000405 138 000406 141 000411 142 000413 143 000414 145 000426 148 000435 ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group BULL including BULL HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell BULL Inc., Groupe BULL and BULL HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, BULL or BULL HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by BULL HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved