COMPILATION LISTING OF SEGMENT extract_msg_doc_ Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985 Compiled at: Honeywell Multics Op. - System M Compiled on: 05/22/86 1419.2 mst Thu Options: optimize map 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 12 13 /****^ HISTORY COMMENTS: 14* 1) change(86-05-22,Martinson), approve(86-05-22,MCR7412), 15* audit(86-05-22,GJohnson), install(86-05-22,MR12.0-1060): 16* Improve error message searching and fix bugs in search hueristics. 17* END HISTORY COMMENTS */ 18 19 20 extract_msg_doc_: proc (segname, segp, lth, iocbp, ec); 21 22 /* This procedure extracts message documentation coded in a conventional way 23* out of the source of a program. The extracted information is marked for 24* sorting and editing and appended to an output file. 25* 26* THVV 3/77 27* Improved by R. Holmstedt 9/82 to find more error messages. 28**/ 29 30 dcl segname char (*), /* Parameters. Name of segment being scanned */ 31 segp ptr, /* Ptr to input */ 32 lth fixed bin (21), /* Lth of input */ 33 iocbp ptr, /* Ptr to output */ 34 ec fixed bin (35); /* status code */ 35 36 /* ec = 1 means no documentation but has call to a logging subroutine 37* ec = 2 means has BEGIN but no end 38* ec = 3 means has BEGIN - END but no Message: 39* any other ec came from vfile_ 40* */ 41 42 dcl START char (28) static options (constant) init ("BEGIN MESSAGE DOCUMENTATION 43 "); 44 dcl END char (25) static options (constant) init ("END MESSAGE DOCUMENTATION"); 45 dcl NL char (1) static options (constant) init (" 46 "); 47 dcl NLNL char (2) static options (constant) init (" 48 49 "); 50 dcl NL_QUOTE_NL_QUOTE char (4) static options (constant) init (" 51 "" 52 """); 53 dcl MSG char (9) static options (constant) init ("Message: 54 "); 55 56 dcl (beginning_of_documentation, doc_block_size, cur_msg_index, errmess_lth) fixed bin (21); 57 dcl (pfx_lth, msg_block_start, msg_block_lth) fixed bin (21); 58 dcl pfx char (32) var; /* Chars to discard at begin of each line */ 59 60 dcl segment char (lth) based (segp); /* Input */ 61 62 dcl iox_$put_chars entry (ptr, ptr, fixed bin (21), fixed bin (35)); 63 64 dcl (addr, index, length, reverse, substr, verify) builtin; 65 66 ec = 1; 67 beginning_of_documentation = index (segment, START); /* Scan for BEGIN */ 68 if beginning_of_documentation = 0 then do; 69 call check_calls; /* Check if any logging */ 70 return; /* Error 1 no message documentation or Error 0 no */ 71 end; /* message documentation because no logging calls */ 72 ec = 2; /* Check Error 2 - Message block has not end */ 73 beginning_of_documentation = beginning_of_documentation + length (START); 74 doc_block_size = index (substr (segment, beginning_of_documentation), END); /* Find END. */ 75 if doc_block_size = 0 then return; 76 ec = 3; 77 78 cur_msg_index = index (substr (segment, beginning_of_documentation, doc_block_size), MSG); /* Find header */ 79 if cur_msg_index = 0 then do; 80 call check_calls; /* Check if any logging */ 81 return; /* Error 3, empty message block or Error 0, empty message */ 82 end; /* block because no logging calls */ 83 ec = 0; /* All is well */ 84 msg_block_start = beginning_of_documentation+cur_msg_index-1; 85 pfx_lth = index (reverse (substr (segment, 1, msg_block_start-1)), NL)-1; 86 pfx = substr (segment, msg_block_start-pfx_lth, pfx_lth); 87 88 do while (cur_msg_index < doc_block_size); 89 cur_msg_index = cur_msg_index + length (MSG); 90 msg_block_start = beginning_of_documentation+cur_msg_index-1; 91 msg_block_lth = index (substr (segment, msg_block_start, doc_block_size-cur_msg_index+1), MSG)-1; 92 if msg_block_lth <= 0 then msg_block_lth = doc_block_size-cur_msg_index; 93 errmess_lth = index (substr (segment, msg_block_start, msg_block_lth-1), NLNL); /* Standard end of message PL/I source */ 94 if errmess_lth = 0 then 95 errmess_lth = index (substr (segment, msg_block_start, msg_block_lth-1), NL_QUOTE_NL_QUOTE); /* Standard end of message ALM source */ 96 if errmess_lth > 0 then do; 97 call putc ("["); 98 call iox_$put_chars (iocbp, addr (segname), length (rtrim (segname)), 0); 99 call putc ("]"); 100 call putc (" "); 101 call move_lines (msg_block_start, errmess_lth); 102 call putc ("~"); 103 call putc (NL); 104 call move_lines (msg_block_start+errmess_lth+2-1, msg_block_lth+1-errmess_lth-2); 105 call putc ("!"); 106 call putc (NL); 107 end; 108 cur_msg_index = cur_msg_index + msg_block_lth; 109 end; 110 return; 111 112 check_calls: proc; 113 if index (segment, "call syserr") ^= 0 then return; 114 if index (segment, "call syserr") ^= 0 then return; /* callTAB... */ 115 if index (segment, "call sys_log_") ^= 0 then return; 116 if index (segment, "call sys_log_") ^= 0 then return; /* callTAB... */ 117 if index (segment, "call admin_gate_$syserr") ^= 0 then return; 118 if index (segment, "call admin_gate_$syserr") ^= 0 then return; /* callTAB... */ 119 if index (segment, "call salv_err_msg") ^= 0 then return; 120 if index (segment, "call salv_err_msg") ^= 0 then return; /* callTAB... */ 121 if index (segment, "call hphcs_$syserr") ^= 0 then return; 122 if index (segment, "call hphcs_$syserr") ^= 0 then return; /* callTAB... */ 123 ec = 0; /* Not an error, no logging calls */ 124 end check_calls; 125 126 move_lines: proc (a_beg, a_nleft); 127 128 dcl (a_beg, a_nleft) fixed bin (21); 129 dcl (beg, nleft, llth, trim_lth, tpx, nls) fixed bin (21); 130 131 beg = a_beg; 132 nleft = a_nleft; 133 nls = 0; 134 do while (nleft > 0); 135 llth = index (substr (segment, beg, nleft), NL); 136 if llth = 0 then llth = nleft+1; 137 tpx = min (llth-1, pfx_lth); /* Discard the "prefix" */ 138 if substr (segment, beg, tpx) ^= pfx /* .. which we noted before the first "Message:" */ 139 then tpx = 0; 140 if llth-tpx > 1 then 141 do while (nls > 0); 142 call putc (NL); 143 nls = nls - 1; 144 end; 145 call iox_$put_chars (iocbp, addr (substr (segment, beg+tpx, 1)), llth-tpx-1, 0); 146 nls = nls + 1; 147 beg = beg + llth; 148 nleft = nleft - llth; 149 end; 150 151 end move_lines; 152 153 154 putc: proc (c); 155 156 dcl c char (1); 157 158 call iox_$put_chars (iocbp, addr (c), 1, 0); 159 160 end putc; 161 162 end extract_msg_doc_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 05/22/86 1419.2 extract_msg_doc_.pl1 >spec>install>1060>extract_msg_doc_.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. END 000005 constant char(25) initial unaligned dcl 44 ref 74 MSG 000000 constant char(9) initial unaligned dcl 53 ref 78 89 91 NL 000004 constant char(1) initial unaligned dcl 45 set ref 85 103* 106* 135 142* NLNL constant char(2) initial unaligned dcl 47 ref 93 NL_QUOTE_NL_QUOTE 000003 constant char(4) initial unaligned dcl 50 ref 94 START 000014 constant char(28) initial unaligned dcl 42 ref 67 73 a_beg parameter fixed bin(21,0) dcl 128 ref 126 131 a_nleft parameter fixed bin(21,0) dcl 128 ref 126 132 addr builtin function dcl 64 ref 98 98 145 145 158 158 beg 000134 automatic fixed bin(21,0) dcl 129 set ref 131* 135 138 145 145 147* 147 beginning_of_documentation 000100 automatic fixed bin(21,0) dcl 56 set ref 67* 68 73* 73 74 78 84 90 c parameter char(1) unaligned dcl 156 set ref 154 158 158 cur_msg_index 000102 automatic fixed bin(21,0) dcl 56 set ref 78* 79 84 88 89* 89 90 91 92 108* 108 doc_block_size 000101 automatic fixed bin(21,0) dcl 56 set ref 74* 75 78 88 91 92 ec parameter fixed bin(35,0) dcl 30 set ref 20 66* 72* 76* 83* 123* errmess_lth 000103 automatic fixed bin(21,0) dcl 56 set ref 93* 94 94* 96 101* 104 104 index builtin function dcl 64 ref 67 74 78 85 91 93 94 113 114 115 116 117 118 119 120 121 122 135 iocbp parameter pointer dcl 30 set ref 20 98* 145* 158* iox_$put_chars 000010 constant entry external dcl 62 ref 98 145 158 length builtin function dcl 64 ref 73 89 98 98 llth 000136 automatic fixed bin(21,0) dcl 129 set ref 135* 136 136* 137 140 145 147 148 lth parameter fixed bin(21,0) dcl 30 ref 20 67 74 78 85 86 91 93 94 113 114 115 116 117 118 119 120 121 122 135 138 145 145 msg_block_lth 000106 automatic fixed bin(21,0) dcl 57 set ref 91* 92 92* 93 94 104 108 msg_block_start 000105 automatic fixed bin(21,0) dcl 57 set ref 84* 85 86 90* 91 93 94 101* 104 nleft 000135 automatic fixed bin(21,0) dcl 129 set ref 132* 134 135 136 148* 148 nls 000140 automatic fixed bin(21,0) dcl 129 set ref 133* 140 143* 143 146* 146 pfx 000107 automatic varying char(32) dcl 58 set ref 86* 138 pfx_lth 000104 automatic fixed bin(21,0) dcl 57 set ref 85* 86 86 137 reverse builtin function dcl 64 ref 85 segment based char unaligned dcl 60 set ref 67 74 78 85 86 91 93 94 113 114 115 116 117 118 119 120 121 122 135 138 145 145 segname parameter char unaligned dcl 30 set ref 20 98 98 98 98 segp parameter pointer dcl 30 ref 20 67 74 78 85 86 91 93 94 113 114 115 116 117 118 119 120 121 122 135 138 145 145 substr builtin function dcl 64 ref 74 78 85 86 91 93 94 135 138 145 145 tpx 000137 automatic fixed bin(21,0) dcl 129 set ref 137* 138 138* 140 145 145 145 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. trim_lth automatic fixed bin(21,0) dcl 129 verify builtin function dcl 64 NAMES DECLARED BY EXPLICIT CONTEXT. check_calls 000434 constant entry internal dcl 112 ref 69 80 extract_msg_doc_ 000113 constant entry external dcl 20 move_lines 000561 constant entry internal dcl 126 ref 101 104 putc 000704 constant entry internal dcl 154 ref 97 99 100 102 103 105 106 142 NAMES DECLARED BY CONTEXT OR IMPLICATION. min builtin function ref 137 rtrim builtin function ref 98 98 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1020 1032 762 1030 Length 1200 762 12 131 36 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME extract_msg_doc_ 148 external procedure is an external procedure. check_calls internal procedure shares stack frame of external procedure extract_msg_doc_. move_lines internal procedure shares stack frame of external procedure extract_msg_doc_. putc internal procedure shares stack frame of external procedure extract_msg_doc_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME extract_msg_doc_ 000100 beginning_of_documentation extract_msg_doc_ 000101 doc_block_size extract_msg_doc_ 000102 cur_msg_index extract_msg_doc_ 000103 errmess_lth extract_msg_doc_ 000104 pfx_lth extract_msg_doc_ 000105 msg_block_start extract_msg_doc_ 000106 msg_block_lth extract_msg_doc_ 000107 pfx extract_msg_doc_ 000134 beg move_lines 000135 nleft move_lines 000136 llth move_lines 000137 tpx move_lines 000140 nls move_lines THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out return ext_entry_desc set_cs_eis index_cs_eis THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. iox_$put_chars NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 20 000106 66 000126 67 000131 68 000141 69 000142 70 000143 72 000144 73 000146 74 000150 75 000167 76 000170 78 000172 79 000204 80 000205 81 000206 83 000207 84 000210 85 000213 86 000225 88 000241 89 000245 90 000247 91 000253 92 000273 93 000277 94 000313 96 000325 97 000326 98 000332 99 000367 100 000373 101 000377 102 000401 103 000405 104 000407 105 000422 106 000426 108 000430 109 000432 110 000433 112 000434 113 000435 114 000447 115 000457 116 000467 117 000477 118 000507 119 000517 120 000527 121 000537 122 000547 123 000557 124 000560 126 000561 131 000563 132 000565 133 000567 134 000570 135 000572 136 000607 137 000613 138 000620 140 000626 142 000634 143 000636 144 000640 145 000641 146 000675 147 000676 148 000700 149 000702 151 000703 154 000704 158 000706 160 000731 ----------------------------------------------------------- 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