COMPILATION LISTING OF SEGMENT mrds_rst_error Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985 Compiled at: Honeywell Multics Op. - System M Compiled on: 04/18/85 1057.0 mst Thu Options: optimize map 1 /* *********************************************************** 2* * * 3* * * 4* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 5* * * 6* * * 7* *********************************************************** */ 8 9 /* ****************************************************** 10* * * 11* * * 12* * Copyright (c) 1972 by Massachusetts Institute of * 13* * Technology and Honeywell Information Systems, Inc. * 14* * * 15* * * 16* ****************************************************** */ 17 18 /* HISTORY: 19* 20* Originally written by roger lackey 21* Modified by Jim Gray - - Feb. 1980, to add signaling of th condition 22* mrds_rst_error, when rsc.command_level is off, indicating that CMDB 23* was called from a subroutine level, and thus not to output 24* errors to error_output. 25* Modified by Jim Gray - - Mar. 1980, to fix formatting of specifics message, 26* so that no blanks in a 79 char length of text are handled better. 27* 28**/ 29 30 mrds_rst_error: proc (rsc_ptr, severity, err_code, specifics_text); 31 32 /* PARAMETERS */ 33 34 /* rsc_ptr ptr; / Pointer to rst (restructuring ) control segment */ 35 dcl severity fixed bin; /* (INPUT) 36* 1 = Warning level error detected 37* 2 = syntax error detected 38* 3 = 39* 4 = Fatal error during logical phase of restructuring 40* 5 = fatal error during physical restructuring */ 41 42 dcl err_code fixed bin (35); /* (INPUT) error code for com_err_ */ 43 dcl specifics_text char (*); /* (INPUT) associated specific message */ 44 45 /* 46* . BEGIN_DESCRIPTION 47* this routine is a common error reporting routine for create/restructure_mrds_db 48* it's primary purpose is to format error messages for output on the users console. 49* The error messages include a severity level, the error table message, 50* plus one or more lines of length <= 80, with specifics about this error. 51* It also can return simple a condition info with the status code, 52* instead of doing an user error output(except for the listing segment) 53* if the call was from a subroutine level. 54* . END_DESCRIPTION 55**/ 56 57 call convert_status_code_ (err_code, shortinfo, longinfo); 58 59 if severity < 2 then err_msg.type = "WARNING "; 60 else err_msg.type = "*ERROR*"; 61 62 err_msg.severity_level = severity; 63 64 err_msg.msg1 = longinfo; 65 specifics = specifics_text || NL; 66 67 call format_specifics_message (); 68 69 code = 0; /* init */ 70 71 if rsc.command_level then do; /* called as a command, not from subroutine level */ 72 call iox_$put_chars (iox_$error_output, addr (err_msg), length (string (err_msg)), code); 73 call iox_$put_chars (iox_$error_output, addrel (addr (specifics), 1), length (specifics), code); 74 end; 75 else do; 76 77 /* fill in the condition information for find_condition_info_, 78* then signal the condition mrds_rst_error for mrds_dm_create_db to handle, 79* since this was a call from a subroutine interface */ 80 81 mrds_error_cond_info.length = size (mrds_error_cond_info); 82 mrds_error_cond_info.version = 1; 83 mrds_error_cond_info.cant_restart = "0"b; 84 mrds_error_cond_info.default_restart = "1"b; 85 mrds_error_cond_info.pad = "0"b; 86 mrds_error_cond_info.info_string = substr (specifics, 1, min (256, length (specifics))); 87 mrds_error_cond_info.status_code = err_code; 88 mrds_error_cond_info.severity = severity; 89 mrds_error_cond_info.severity_high = rsc.severity_high; 90 91 call signal_ ("mrds_rst_error", null (), addr (mrds_error_cond_info)); 92 93 end; 94 95 if code = 0 then 96 if rsc.listing_seg_sw then do; 97 call iox_$put_chars (rsc.listing_iocb_ptr, addr (err_msg), length (string (err_msg)), code); 98 call iox_$put_chars (rsc.listing_iocb_ptr, addrel (addr (specifics), 1), length (specifics), code); 99 end; 100 101 if code ^= 0 then do; 102 if rsc.command_level then 103 call com_err_ (code, "mrds_rst_error"); 104 else call sub_err_ (code, "mrds_rst_error", "c", null (), 0, "Unable to output listing."); 105 end; 106 107 rsc.severity_high = max (rsc.severity_high, severity); 108 109 format_specifics_message: procedure (); 110 111 /* routine to break long lines down to shorter ones by inserting 112* new_lines where blanks appear, so that error messages will not be 113* folded by the printing device. */ 114 115 i, pos = 1; 116 117 do while (pos + 79 < length (specifics)); /* Break into 79 char lines or less at a blank char */ 118 i = index (reverse (substr (specifics, pos, 79)), BLANK); 119 if i ^= 0 then do; 120 substr (specifics, pos + 79 - i, 1) = NL; 121 pos = pos + 79 - i; 122 end; 123 else do; /* no blank in 79 chars, find first blank following */ 124 pos = pos + 79; 125 i = index (substr (specifics, pos), BLANK); 126 if i ^= 0 then do; 127 substr (specifics, pos + i - 1, 1) = NL; 128 pos = pos + i; 129 end; 130 else pos = length (specifics); /* no blanks left, get out */ 131 end; 132 133 end; 134 135 end; 136 137 138 dcl code fixed bin (35); 139 dcl com_err_ entry options (variable); 140 dcl convert_status_code_ entry (fixed bin (35), char (8) aligned, char (100) aligned); 141 dcl iox_$error_output ext ptr; 142 dcl iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35)); 143 dcl longinfo char (100) aligned;/* Long msg from convert status code */ 144 dcl shortinfo char (8) aligned; /* Short msg from convert status code */ 145 dcl sys_info$max_seg_size ext fixed bin (35); 146 declare signal_ entry options (variable); /* passes cond_info structure upon signaling condition */ 147 148 declare 1 mrds_error_cond_info aligned, 1 1 1 2 /* begin include file ... cond_info_structure.incl.pl1 */ 1 3 /* last modified 5/7/73 */ 1 4 1 5 2 length fixed bin, /* length in words of this structure */ 1 6 2 version fixed bin, /* version number of this structure */ 1 7 2 action_flags aligned, /* tell handler how to proceed */ 1 8 3 cant_restart bit(1) unal, /* caller doesn't ever want to be returned to */ 1 9 3 default_restart bit(1) unal, /* caller can be returned to with no further action */ 1 10 3 pad bit(34) unal, 1 11 2 info_string char(256) var, /* may contain printable message */ 1 12 2 status_code fixed bin(35), /* if^=0, code interpretable by com_err_ */ 1 13 /* end include file ... cond_info_structure.incl.pl1 */ 149 150 151 2 severity fixed bin, 152 2 severity_high fixed bin; 153 154 declare sub_err_ entry options (variable); 155 dcl (addr, fixed, length, max, rel, size, string) builtin; 156 dcl (addrel, index, min, null, reverse, substr) builtin; 157 158 dcl BLANK char (1) int static options (constant) init (" "); 159 dcl NL char (1) int static options (constant) init (" 160 "); 161 dcl (i, pos) fixed bin; 162 163 164 165 dcl 1 err_msg aligned, 166 2 lf0 char (1) unal init (" 167 "), /* Start with a line feed */ 168 2 type char (8) unal, /* Type = WARNING or *ERROR* */ 169 2 constant char (12) unal init ("OF SEVERITY "), 170 2 severity_level pic "9" unal, /* Severity numeric 1 to 5 see input parameter */ 171 2 lf1 char (1) unal init (" 172 "), 173 2 msg1 char (100) unal, /* Error message from error table */ 174 2 lf2 char (1) unal init (" 175 "); 176 177 dcl specifics char (256) varying unal; /* Additional err info */ 178 2 1 /* BEGIN INCLUDE FILE mrds_rst_rsc.incl.pl1 RDL 7/7/78 */ 2 2 2 3 /* Modified 8/21/78 by RDL */ 2 4 2 5 /* Modified 9/11/78 by RDL to add directive and stmt pointers */ 2 6 2 7 /* Modified 11/4/78 by RDL to add debug,trace,meter switches 2 8* 2 9* Modified 3/29/79 by RDL to change s_seg_info_ptr to source_seg_ptr 2 10* 2 11* Modified by Jim Gray - - Jan. 1980, to add flags to disallow blocked files, forieng keys, and restructuring. 2 12* 2 13* Modified by Jim Gray - - Feb. 1980, to add command level flag for cmdb subroutine interface. 2 14* 2 15* Modified by Jim Gray - - 80-11-06, to add bit for cmdb -secure option. 2 16* 2 17* 81-05-18 Jim Gray : added bit for max_attributes error message, so that 2 18* it would only be issued on first occurence. 2 19* 2 20* 82-08-19 Davids: added the db_type field. 2 21* 2 22* 83-02-18 Mike Kubicar : Removed the db_type field and added the 2 23* db_relation_mode_flags substructure to define the modes applicable 2 24* to the database's relations. Also removed assorted unsed fields 2 25* (names that included the word unused). 2 26* 2 27**/ 2 28 2 29 dcl 1 rsc based (rsc_ptr), /* Restructuring control info */ 2 30 2 rsc_dir char (200), /* pathname of directory containing rsc segment */ 2 31 2 dbp char (168), /* Database absolute path */ 2 32 2 temp_dir char (168), /* Path name of temp restrucuring directory */ 2 33 2 temp_dir_sw bit (1) unal, /* On => temp dir has been created */ 2 34 2 db_quiesced_sw bit (1) unal, /* On => database has been quiesced */ 2 35 2 o_db_open_sw bit (1) unal, /* On => old database has been opened */ 2 36 2 n_db_open_sw bit (1) unal, /* On => temp database is open */ 2 37 2 listing_seg_sw bit (1) unal, /* On => listing segment has been created */ 2 38 2 skip_scanner_conversion bit (1) unal, /* Skip conversion in scanner */ 2 39 2 cmdb_option bit (1) unal, /* ON => this is a cmdb source, not restructuring */ 2 40 2 trace_sw bit (1) unal, /* On -> trace mode in affect */ 2 41 2 debug_sw bit (1) unal, /* On = debug mode (NOT IMPLEMENTED) */ 2 42 2 meter_sw bit (1) unal, /* On = procedures call metering procedure */ 2 43 2 delete_db_sw bit (1) unal, /* On = delete data base in cleanup */ 2 44 2 model_consistent_sw bit (1) unal, /* On => Model is consistent */ 2 45 2 physical_started_sw bit (1) unal, /* On => Physical restructuring started */ 2 46 2 physical_complete_sw bit (1) unal, /* On => Physical restructuring completed */ 2 47 2 model_overflow bit (1) unal, /* ON => model segment area condition occurred */ 2 48 2 max_files bit (1) unal, /* ON => maximum number of files reached */ 2 49 2 allow_foreign_keys bit (1) unal, /* on => allow foreign key statment */ 2 50 2 foreign_key_seen bit (1) unal, /* on => foreign key definition in source */ 2 51 2 allow_blocked_files bit (1) unal, /* on => allow file statement with blocked option */ 2 52 2 blocked_file_seen bit (1) unal, /* on => blocked file definition in source */ 2 53 2 allow_restructuring bit (1) unal, /* on => allow RMDB entry point */ 2 54 2 command_level bit (1) unal, /* on => called from command unal, not subroutine level */ 2 55 2 secure bit (1) unal, /* on => -secure option given for cmdb */ 2 56 2 max_attrs bit (1) unal, /* on => max attrs/rel or max indexes/rel exceeded */ 2 57 2 db_relation_mode_flags, 2 58 3 dm_file_type bit (1) unal, /* on => relations are dm files */ 2 59 3 protection_on bit (1) unal, /* on => relations need transactions */ 2 60 3 concurrency_on bit (1) unal, /* on => concurrency control enabled */ 2 61 3 rollback_on bit (1) unal, /* on => before journalling is enabled */ 2 62 2 severity_high fixed bin, /* Highest severity level error encountered */ 2 63 2 phase fixed bin, /* 000 = init 2 64* 100 = global list init 2 65* 200 = parse 2 66* 300 = physical init 2 67* 400 = physical */ 2 68 2 h_o_seg_info_ls_ptr ptr, /* Pointer to head of old db seg_info list */ 2 69 2 h_n_seg_info_ls_ptr ptr, /* Pointer to head of new db seg_info list */ 2 70 2 h_gfile_ptr ptr, /* Pointer to head of global file list */ 2 71 2 h_gdom_ptr ptr, /* Pointer to head of global domain list */ 2 72 2 h_gattr_ptr ptr, /* Pointer to head of global attribute list */ 2 73 2 h_grel_ptr ptr, /* Pointer to head of global relation list */ 2 74 2 h_glink_ptr ptr, /* Pointer to head of global link list */ 2 75 2 o_dm_ptr ptr, /* Pointer to old data model seg (dm_model ) */ 2 76 2 n_dm_ptr ptr, /* Pointer to temp data model seg */ 2 77 2 o_fn_hdr_ptr ptr, /* Pointer to head of original file list (fn structure) */ 2 78 2 source_seg_ptr ptr, /* Pointer to source_seg */ 2 79 2 listing_iocb_ptr ptr, /* Pointer to listing segment iocb */ 2 80 2 directive_ptr ptr, /* Pointer to directive type str in mrds_rst_semactics.incl.pl1 */ 2 81 2 stmt_ptr ptr, /* Pointer to statement str in mrds_rst_sematics.incl.pl1 */ 2 82 2 trace_metering_iocb_ptr ptr, /* Pointer to seg used by trace and metering */ 2 83 2 tree_node_area_ptr ptr, /* pointer to working storage for tree nodes */ 2 84 2 tree_data, 2 85 3 seg_info_area_ptr ptr, /* seg info working storage area */ 2 86 3 gl_area_ptr ptr, /* global list data work storage area */ 2 87 3 sl_area_ptr ptr, /* sublist data work storage area */ 2 88 2 parse_info_area_ptr ptr, /* parse interface work area storage */ 2 89 2 static_info_area_ptr ptr, /* directive, stmt and other static work storage area */ 2 90 2 variable_length_area_ptr ptr, /* varibale allocates work storage area */ 2 91 2 other_area_ptr ptr, /* unspecified work area storage */ 2 92 2 wa area (sys_info$max_seg_size - fixed (rel (addr (rsc.wa))) + 1); /* Work area */ 2 93 2 94 dcl rsc_ptr ptr; /* Pointer to base of rsc segment */ 2 95 2 96 2 97 2 98 /* END INCLUDE FILE mrds_rst_rsc.incl.pl1 */ 2 99 179 180 181 end mrds_rst_error; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/18/85 0908.8 mrds_rst_error.pl1 >special_ldd>online>mrds.pbf-04/18/85>mrds_rst_error.pl1 149 1 05/06/74 1741.0 cond_info_structure.incl.pl1 >ldd>include>cond_info_structure.incl.pl1 179 2 10/14/83 1609.1 mrds_rst_rsc.incl.pl1 >ldd>include>mrds_rst_rsc.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. BLANK constant char(1) initial unaligned dcl 158 ref 118 125 NL 000611 constant char(1) initial unaligned dcl 159 ref 65 120 127 action_flags 2 000134 automatic structure level 2 dcl 148 addr builtin function dcl 155 ref 72 72 73 73 91 91 97 97 98 98 addrel builtin function dcl 156 ref 73 73 98 98 cant_restart 2 000134 automatic bit(1) level 3 packed unaligned dcl 148 set ref 83* code 000100 automatic fixed bin(35,0) dcl 138 set ref 69* 72* 73* 95 97* 98* 101 102* 104* com_err_ 000010 constant entry external dcl 139 ref 102 command_level 206(21) based bit(1) level 2 packed unaligned dcl 2-29 ref 71 102 constant 2(09) 000245 automatic char(12) initial level 2 packed unaligned dcl 165 set ref 165* convert_status_code_ 000012 constant entry external dcl 140 ref 57 default_restart 2(01) 000134 automatic bit(1) level 3 packed unaligned dcl 148 set ref 84* err_code parameter fixed bin(35,0) dcl 42 set ref 30 57* 87 err_msg 000245 automatic structure level 1 dcl 165 set ref 72 72 72 72 97 97 97 97 i 000243 automatic fixed bin(17,0) dcl 161 set ref 115* 118* 119 120 121 125* 126 127 128 index builtin function dcl 156 ref 118 125 info_string 3 000134 automatic varying char(256) level 2 dcl 148 set ref 86* iox_$error_output 000014 external static pointer dcl 141 set ref 72* 73* iox_$put_chars 000016 constant entry external dcl 142 ref 72 73 97 98 length builtin function dcl 155 in procedure "mrds_rst_error" ref 72 72 73 73 86 97 97 98 98 117 130 length 000134 automatic fixed bin(17,0) level 2 in structure "mrds_error_cond_info" dcl 148 in procedure "mrds_rst_error" set ref 81* lf0 000245 automatic char(1) initial level 2 packed unaligned dcl 165 set ref 165* lf1 5(18) 000245 automatic char(1) initial level 2 packed unaligned dcl 165 set ref 165* lf2 36(27) 000245 automatic char(1) initial level 2 packed unaligned dcl 165 set ref 165* listing_iocb_ptr 240 based pointer level 2 dcl 2-29 set ref 97* 98* listing_seg_sw 206(04) based bit(1) level 2 packed unaligned dcl 2-29 ref 95 longinfo 000101 automatic char(100) dcl 143 set ref 57* 64 max builtin function dcl 155 ref 107 min builtin function dcl 156 ref 86 mrds_error_cond_info 000134 automatic structure level 1 dcl 148 set ref 81 91 91 msg1 5(27) 000245 automatic char(100) level 2 packed unaligned dcl 165 set ref 64* null builtin function dcl 156 ref 91 91 104 104 pad 2(02) 000134 automatic bit(34) level 3 packed unaligned dcl 148 set ref 85* pos 000244 automatic fixed bin(17,0) dcl 161 set ref 115* 117 118 120 121* 121 124* 124 125 127 128* 128 130* reverse builtin function dcl 156 ref 118 rsc based structure level 1 unaligned dcl 2-29 rsc_ptr parameter pointer dcl 2-94 ref 30 71 89 95 97 98 102 107 107 severity parameter fixed bin(17,0) dcl 35 in procedure "mrds_rst_error" ref 30 59 62 88 107 severity 105 000134 automatic fixed bin(17,0) level 2 in structure "mrds_error_cond_info" dcl 148 in procedure "mrds_rst_error" set ref 88* severity_high 106 000134 automatic fixed bin(17,0) level 2 in structure "mrds_error_cond_info" dcl 148 in procedure "mrds_rst_error" set ref 89* severity_high 207 based fixed bin(17,0) level 2 in structure "rsc" dcl 2-29 in procedure "mrds_rst_error" set ref 89 107* 107 severity_level 5(09) 000245 automatic picture(1) level 2 packed unaligned dcl 165 set ref 62* shortinfo 000132 automatic char(8) dcl 144 set ref 57* signal_ 000020 constant entry external dcl 146 ref 91 size builtin function dcl 155 ref 81 specifics 000304 automatic varying char(256) dcl 177 set ref 65* 73 73 73 73 86 86 98 98 98 98 117 118 120* 125 127* 130 specifics_text parameter char unaligned dcl 43 ref 30 65 status_code 104 000134 automatic fixed bin(35,0) level 2 dcl 148 set ref 87* string builtin function dcl 155 ref 72 72 97 97 sub_err_ 000022 constant entry external dcl 154 ref 104 substr builtin function dcl 156 set ref 86 118 120* 125 127* type 0(09) 000245 automatic char(8) level 2 packed unaligned dcl 165 set ref 59* 60* version 1 000134 automatic fixed bin(17,0) level 2 dcl 148 set ref 82* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. fixed builtin function dcl 155 rel builtin function dcl 155 sys_info$max_seg_size external static fixed bin(35,0) dcl 145 NAMES DECLARED BY EXPLICIT CONTEXT. format_specifics_message 000514 constant entry internal dcl 109 ref 67 mrds_rst_error 000041 constant entry external dcl 30 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 710 734 612 720 Length 1152 612 24 202 76 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME mrds_rst_error 337 external procedure is an external procedure. format_specifics_message internal procedure shares stack frame of external procedure mrds_rst_error. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME mrds_rst_error 000100 code mrds_rst_error 000101 longinfo mrds_rst_error 000132 shortinfo mrds_rst_error 000134 mrds_error_cond_info mrds_rst_error 000243 i mrds_rst_error 000244 pos mrds_rst_error 000245 err_msg mrds_rst_error 000304 specifics mrds_rst_error THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs call_ext_out_desc call_ext_out return shorten_stack ext_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ convert_status_code_ iox_$put_chars signal_ sub_err_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. iox_$error_output LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 30 000034 165 000054 57 000065 59 000100 60 000110 62 000113 64 000123 65 000126 67 000150 69 000152 71 000153 72 000161 73 000202 74 000226 81 000227 82 000231 83 000233 84 000235 85 000237 86 000241 87 000254 88 000256 89 000260 91 000262 95 000314 97 000324 98 000345 101 000374 102 000376 104 000430 107 000503 181 000513 109 000514 115 000515 117 000520 118 000525 119 000537 120 000540 121 000546 122 000551 124 000552 125 000554 126 000573 127 000574 128 000600 129 000602 130 000603 133 000605 135 000606 ----------------------------------------------------------- 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