COMPILATION LISTING OF SEGMENT cobol_rts_handler_ Compiled by: Multics PL/I Compiler, Release 31b, of April 24, 1989 Compiled at: Bull HN, Phoenix AZ, System-M Compiled on: 05/24/89 1025.4 mst Wed Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) BULL HN Information Systems Inc., 1989 * 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 14 15 /****^ HISTORY COMMENTS: 16* 1) change(89-04-23,Zimmerman), approve(89-04-23,MCR8060), 17* audit(89-05-05,RWaters), install(89-05-24,MR12.3-1048): 18* MCR8060 cobol_rts_handler_.pl1 Reformatted code to new Cobol standard. 19* END HISTORY COMMENTS */ 20 21 22 /* Modified on 8/18/76 by Bob Chang to change ext data name cobol_sort_ into cobol_SM_. */ 23 /* Modified on 6/30/76 by Bob Chang to implement cleanup condition for sort. */ 24 /*{*/ 25 /* format: style3 */ 26 cobol_rts_handler_: 27 proc (mcp, cond_name, wc_cobol_ptr, info_ptr, continue_sw); 28 29 30 dcl sort_$terminate entry (fixed bin (35)), 31 mcode fixed bin (35); /* 32*This procedure is the fixedoverflow handler for object 33*programs compiled by the Multics Cobol compiler. 34*This procedure looks at a flag in the static data portion of 35*the linkage section of the Cobol program in which the 36*fixedoverflow was detected, to determine how to respond to the 37*fixedoverflow. 38* 39* 1. If the flag is zero, then this handler sets its 40* parameter "continue_sw" ON, and returns. Setting 41* this parameter ON results in the signalling of 42* the next most recently established handler for fixedoverflow, 43* after this procedure exits. ( The effect of this 44* type of return is that the execution of this procedure 45* has no effect.) 46* 2. If the flag is non-zero, then the machine state 47* saved at the time the fixedoverflow was detected are 48* modified slightly, (see details below) and this 49* procedure returns with parameter "continue_sw" set 50* to "0"b. The effect of this type of return is that 51* control returns to the Cobol program in which the 52* fixedoverflow condition was detected. 53**/ 54 55 /* DECLARATION OF THE PARAMETERS */ 56 57 /* dcl mcp ptr; */ 58 /* THIS PARAMETER IS DECLARED BELOW 59* IN AN INCLUDE FILE */ 60 dcl cond_name char (32); 61 dcl cobol_SM_$ec fixed bin (35) ext, 62 cobol_SM_$stat_ptr ptr ext, 63 cobol_SM_$error_ptr ptr ext, 64 cobol_SM_$RETbl fixed bin (35) ext; 65 dcl wc_cobol_ptr ptr; 66 dcl info_ptr ptr; 67 dcl continue_sw bit (1); 68 69 dcl cobol_error_ entry (fixed bin, fixed bin (35), fixed bin, fixed bin, char (65) varying, ptr) ext; 70 71 /* DESCRIPTION OF THE PARAMETERS */ 72 73 /* NOTE: The following information was obtained from the 74*MPM, section 6.2. */ 75 76 /* 77*PARAMETER DESCRIPTION 78* 79*mcp Pointer to information describing the 80* state of the processor at the time the 81* fixedoverflow was detected. (input) 82*cond_name Not used by this procedure. 83*wc_cobol_ptr Not used by this procedure. 84*info_ptr Not used by this procedure. 85*continue_sw A binary switch indicating the action to 86* be taken when the handler returns to the 87* condition mechanism. Normally, when a 88* handler returns, control returns to the 89* point at whcih the condiion was raised, and 90* that operation is re-tried. This is the case 91* when "continue_sw" is set to "0"b. 92* However, if we do want to return 93* to the Cobol program in which fixedoverflow 94* was detected, we want to return to some 95* point OTHER THAN THE POINT WHERE THE 96* FIXED OVERFLOW WAS DETECTED. This is done 97* by modifying two entries in the saved 98* machine conditions, setting "continue_sw" 99* to "0"b, and then returning. The two entries 100* in the saved machine conditions that must 101* be modified are: 102* 103* 1. The value of the IC at which the 104* fixedoverflow was detected. This value is 105* incremented (or decremented) so that when 106* this procedure returns, return is to the 107* desired point, rather than the point at 108* which the fixedoverflow was detected. 109* 110* 2. The multi-instruction format 111* INDICATOR bit in the saved machine 112* conditions is set to "0"b. 113* 114* If control is not to return to the Cobol 115* program, then the continue_sw" is set to 116* "1"b, and this procedure returns. Under 117* these conditions, the condition mechanism 118* behaves as though this handler, 119* cobol_rts_handler_, had not been established 120* and invokes the next most recently established 121* handler for the fixedoverflow conditon. 122* 123**/ 124 125 /*}*/ 126 127 dcl vprog_id char (65) varying; 128 129 /**************************************************/ 130 /* START OF EXECUTION */ 131 /* EXTERNAL PROCEDURE */ 132 /* cobol_rts_handler_ */ 133 /**************************************************/ 134 135 136 137 /* THE CODE FOR HANDLING fixedoverflow IS NOW OBSOLETE */ 138 139 /* if cond_name = "fixedoverflow" then do; 140*/* /* Base the stack frame template on the stack frame of the procedure in which the fixedoverflow was 141*/* detected. */ 142 /* stack_frame_ptr = mc.prs(6); 143*/* /* Get the pointer to the linkage section of the procedure in which the fixedoverflow was detected. */ 144 /* stat_ptr = addrel(stack_frame.link_ptr,8); 145*/* if stat.fo_flag = 0 146*/* then continue_sw = "1"b; /* Return to the most recently previously established 147*/* fixedoverflow handler */ 148 /* else do; /* Increment the IC value saved in the machine conditions, and return 149*/* to the Cobol object program in which the overflow was detected. */ 150 /* continue_sw = "0"b; 151*/* /* Increment the IC by the value contained in the Cobol program's static data area. */ 152 /* scup = addr(mc.scu(0)); 153*/* scu.ilc = fixed (unspec(scu.ilc) + stat.fo_disp,18); 154*/* /* Turn off the multi-instruction format INDICATOR register bit in the 155*/* saved machine conditions for the objcet program in which fixedoverflow was detected. */ 156 /* scu.ir.mif = "0"b; 157*/* end; /* Increment the IC value saved in the machine conditions, and return 158*/* to the Cobol object program in whcih the overflow was detected. */ 159 /* end; 160*/* else 161**/ 162 if substr (cond_name, 1, 10) ^= "SORTM_STOP" 163 then do; 164 call sort_$terminate (mcode); 165 return; 166 end; 167 else do; /* temporary. */ 168 cobol_SM_$RETbl = 0; /* tell the SORT package rap up sorting*/ 169 if cobol_SM_$ec = 8 | cobol_SM_$ec = 9 | cobol_SM_$ec = 11 170 then return; 171 else do; 172 stat_ptr = cobol_SM_$stat_ptr;/* set by appropriate cobol SORT statement. */ 173 vprog_id = prog_id; 174 call cobol_error_ (50, 0, line_no (1), 0, vprog_id, cobol_SM_$error_ptr); 175 return; 176 end; 177 end; 178 return; /* shouldn't have gotten here anyhow */ 179 180 181 182 /**************************************************/ 183 /* INCLUDE FILES USED IN THIS PROCEDURE */ 184 /**************************************************/ 185 186 187 /***** Declaration for builtin function *****/ 188 189 dcl (substr, mod, binary, fixed, addr, addrel, rel, length, string, unspec, null, index) 190 builtin; 191 192 /***** End of declaration for builtin function *****/ 193 194 /* %include mc; OBSOLETE */ 195 dcl mcp ptr; 1 1 1 2 /* BEGIN INCLUDE FILE ... cobol_fixed_static.incl.pl1 */ 1 3 /* Last Modified May 5, 1977 by BC */ 1 4 1 5 /* This structure exists in the static data portion of the 1 6*linkage section of each cobol object segment. This 1 7*include file provides a "based" template for it. */ 1 8 1 9 /* This include file also contains internal static initialized 1 10*variables that define the offset of each field in this static 1 11*data portion of the linkage section from the 1 12*pointer upon which it is based. */ 1 13 1 14 1 15 /* WARNING: The fields in this structure,data_ptr 1 16*up to, but not including reserved, 1 17*must retain their positions in this structure forever. 1 18*No new fields not having space already allocated may be 1 19*defined as the position of the first link which follows 1 20*this fixed static area (to cobol_rts_) is in a fixed location 1 21*known to cobol_operators_. */ 1 22 dcl stat_ptr ptr; 1 23 dcl 1 stat based(stat_ptr) aligned, 1 24 2 data_ptr ptr aligned, 1 25 2 control_ptr ptr aligned, 1 26 2 file_info_ptr ptr aligned, 1 27 2 call_cnt fixed bin aligned, 1 28 2 data_len fixed bin aligned, 1 29 2 entry_pt_ptr ptr aligned, 1 30 2 prog_id_len fixed bin aligned, 1 31 2 prog_id char(65) aligned, 1 32 2 line_no (2) fixed bin aligned, 1 33 2 fo_flag fixed bin aligned, 1 34 2 fo_disp fixed bin aligned, 1 35 2 main_prog_sw fixed bin aligned, 1 36 2 sort_merge_sw fixed bin aligned, 1 37 2 ind_mask bit(36), /* overflow masking indicator bits. */ 1 38 2 pr3_save ptr, 1 39 2 pr5_save ptr, 1 40 2 user_output_ptr ptr, 1 41 2 error_output_ptr ptr, 1 42 2 user_input_ptr ptr, 1 43 2 error_con char(30) varying, 1 44 2 trace_control_word fixed bin aligned; 1 45 1 46 1 47 /* INTERNAL STATIC INITIALIZED VARIABLES THAT DEFINE THE 1 48*OFFSET OF EACH FIELD IN THE STATIC PORTION OF THE LINKAGE 1 49*SEGMENT. */ 1 50 1 51 dcl fixed_static_length fixed bin static options(constant) init(56); 1 52 dcl first_link_offset fixed bin static options(constant) init(64); 1 53 /*dcl stat_data_ptr_off fixed bin static options(constant) init(0); 1 54*/*dcl stat_control_ptr_off fixed bin static options(constant) init(2); 1 55*/*dcl stat_file_info_ptr_off fixed bin static options(constant) init(4); 1 56*/*dcl stat_call_cnt_off fixed bin static options(constant) init(6); 1 57*/*dcl stat_data_len_off fixed bin static options(constant) init(7); 1 58*/*dcl stat_entry_pt_ptr_off fixed bin static options(constant) init(8); 1 59*/*dcl stat_prog_id_len_off fixed bin static options(constant) init(10); 1 60*/*dcl stat_prog_id_off fixed bin static options(constant) init(11); 1 61*/*dcl stat_line_no_off fixed bin static options(constant) init(28); 1 62*/*dcl stat_fo_flag_off fixed bin static options(constant) init(30); 1 63*/*dcl stat_fo_disp_off fixed bin static options(constant) init(31); 1 64*/*dcl stat_main_prog_sw_off fixed bin static options(constant) init(32); 1 65*/*dcl stat_pr3_ptr_off fixed bin static options(constant) init(34); 1 66*/*dcl stat_pr5_ptr_off fixed bin static options(constant) init(36); 1 67*/*dcl stat_user_output_ptr_off fixed bin static options(constant) init(38); 1 68*/*dcl stat_error_output_ptr_off fixed bin static options(constant) init(40); 1 69*/*dcl stat_user_input_ptr_off fixed bin static options(constant) init(42); 1 70*/*dcl stat_error_con_off fixed bin static options(constant) init(44); 1 71*/*dcl stat_trace_control_word_off fixed bin static options(constant) init(53); 1 72*/**/ 1 73 1 74 /* END INCLUDE FILE ... cobol_fixed_static.incl.pl1 */ 1 75 196 197 /* %include cobol_stack_frame; OBSOLETE */ 198 /**************************************************/ 199 /* END OF EXTERNAL PROCEDURE */ 200 /* cobol_rts_handler_ */ 201 /**************************************************/ 202 203 end cobol_rts_handler_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/24/89 0836.8 cobol_rts_handler_.pl1 >spec>install>MR12.3-1048>cobol_rts_handler_.pl1 196 1 10/10/83 1730.8 cobol_fixed_static.incl.pl1 >ldd>include>cobol_fixed_static.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. cobol_SM_$RETbl 000020 external static fixed bin(35,0) dcl 61 set ref 168* cobol_SM_$ec 000012 external static fixed bin(35,0) dcl 61 ref 169 169 169 cobol_SM_$error_ptr 000016 external static pointer dcl 61 set ref 174* cobol_SM_$stat_ptr 000014 external static pointer dcl 61 ref 172 cobol_error_ 000022 constant entry external dcl 69 ref 174 cond_name parameter char(32) packed unaligned dcl 60 ref 26 162 continue_sw parameter bit(1) packed unaligned dcl 67 ref 26 info_ptr parameter pointer dcl 66 ref 26 line_no 34 based fixed bin(17,0) array level 2 dcl 1-23 set ref 174* mcode 000100 automatic fixed bin(35,0) dcl 30 set ref 164* mcp parameter pointer dcl 195 ref 26 prog_id 13 based char(65) level 2 dcl 1-23 ref 173 sort_$terminate 000010 constant entry external dcl 30 ref 164 stat based structure level 1 dcl 1-23 stat_ptr 000124 automatic pointer dcl 1-22 set ref 172* 173 174 substr builtin function dcl 189 ref 162 vprog_id 000101 automatic varying char(65) dcl 127 set ref 173* 174* wc_cobol_ptr parameter pointer dcl 65 ref 26 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. addr builtin function dcl 189 addrel builtin function dcl 189 binary builtin function dcl 189 first_link_offset internal static fixed bin(17,0) initial dcl 1-52 fixed builtin function dcl 189 fixed_static_length internal static fixed bin(17,0) initial dcl 1-51 index builtin function dcl 189 length builtin function dcl 189 mod builtin function dcl 189 null builtin function dcl 189 rel builtin function dcl 189 string builtin function dcl 189 unspec builtin function dcl 189 NAME DECLARED BY EXPLICIT CONTEXT. cobol_rts_handler_ 000013 constant entry external dcl 26 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 200 224 103 210 Length 420 103 24 157 75 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cobol_rts_handler_ 108 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cobol_rts_handler_ 000100 mcode cobol_rts_handler_ 000101 vprog_id cobol_rts_handler_ 000124 stat_ptr cobol_rts_handler_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out return_mac ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cobol_error_ sort_$terminate THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. cobol_SM_$RETbl cobol_SM_$ec cobol_SM_$error_ptr cobol_SM_$stat_ptr LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 26 000006 162 000020 164 000026 165 000034 168 000035 169 000036 172 000045 173 000050 174 000056 175 000102 ----------------------------------------------------------- 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