COMPILATION LISTING OF SEGMENT mrpg Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell Multics Op. - System M Compiled on: 02/14/84 0844.5 mst Tue Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1983 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 /**** format: ind3,ll80,initcol6,indattr,^inddcls,dclind4,idind16 */ 12 /**** format: struclvlind2,^ifthenstmt,^ifthendo,^ifthen,^indnoniterdo */ 13 /**** format: ^inditerdo,^indnoniterend,^indthenelse,case,^indproc,^indend */ 14 /**** format: ^delnl,^insnl,comcol41,^indcom,^indblkcom,linecom,^indcomtxt */ 15 16 mrpg: proc; 17 18 dcl MRPG_version char (8) int static init ("1.1b"); 19 20 /* report generator language */ 21 22 code = 0; 23 ifp = null (); 24 call cu_$arg_ptr (1, argp, argl, code); 25 if (code = 0) 26 then do; 27 if (substr (arg, 1, 1) ^= "-") 28 then do; 29 if (ifp ^= null ()) 30 then do; 31 call com_err_ (0, command_name, "Multiple input segments not allowed."); 32 return; 33 end; 34 call expand_pathname_$add_suffix (arg, "mrpg", dname, ename, code); 35 if (code ^= 0) 36 then do; 37 call com_err_ (code, command_name, "^a", arg); 38 return; 39 end; 40 if (verify (before (ename, ".mrpg"), chars) ^= 0) 41 | (index ("_0123456789", substr (ename, 1, 1)) ^= 0) 42 then do; 43 call com_err_ (0, "mrpg", "Syntax error in report name."); 44 return; 45 end; 46 call hcs_$initiate_count (dname, ename, "", bc, 0, ifp, code); 47 if (ifp = null ()) 48 49 then do; 50 call com_err_ (code, command_name, "^a>^a", dname, ename); 51 return; 52 end; 53 if (bc = 0) 54 then do; 55 call com_err_ (error_table_$zero_length_seg, command_name, "^a>^a", dname, ename); 56 return; 57 end; 58 ife = divide (bc, 9, 24, 0); 59 arg = before (ename, ".mrpg"); 60 end; 61 else do; 62 call com_err_ (error_table_$badopt, command_name, "^a", arg); 63 return; 64 end; 65 end; 66 else do; 67 call com_err_ (code, command_name || MRPG_version, " 68 Usage: mrpg pathname {PL/I options}"); 69 return; 70 end; 71 if (ifp = null ()) 72 then do; 73 call com_err_ (error_table_$noarg, command_name, "Input segment."); 74 return; 75 end; 76 call ioa_ ("MRPG ^a", MRPG_version); 77 ai.version = area_info_version_1; 78 ai.zero_on_alloc = "1"b; 79 ai.zero_on_free = "0"b; 80 ai.dont_free = "0"b; 81 ai.no_freeing = "1"b; 82 ai.owner = command_name; 83 ai.size = sys_info$max_seg_size; 84 if hold_sw 85 then do; 86 ai.extend = "0"b; 87 call hcs_$make_seg (get_wdir_ (), "mrpg.area", "mrpg.area", 01010b, ai.areap, code); 88 if (ai.areap = null ()) 89 then do; 90 call com_err_ (code, "mrpg", "Getting work area"); 91 return; 92 end; 93 end; 94 else do; 95 ai.areap = null (); 96 ai.extend = "1"b; 97 end; 98 call define_area_ (addr (ai), code); 99 if (code ^= 0) 100 then do; 101 call com_err_ (code, command_name, "define_area_"); 102 return; 103 end; 104 on condition (cleanup) begin; 105 if ^hold_sw 106 then call release_area_ (ai.areap); 107 end; 108 on condition (mrpg_fatal) goto done; 109 call mrpg_error_$init; 110 call mrpg_parse_ (ifp, ife, ai.areap, code); 111 if mrpg_error_$stat () 112 then goto done; 113 call mrpg_generate_ (ai.areap, ename, ifp, code); 114 if (code ^= 0) 115 then goto done; 116 if ^hold_sw then 117 call release_area_ (ai.areap); 118 ai.areap = null (); 119 call hcs_$make_ptr (null (), "pl1", "pl1", pl1p, code); 120 call cu_$arg_list_ptr (arglp); 121 call cu_$gen_call (pl1p, arglp); 122 done: 123 if ^hold_sw & (ai.areap ^= null ()) then 124 call release_area_ (ai.areap); 125 return; 126 127 dcl 1 ai like area_info; 1 1 /* BEGIN INCLUDE FILE area_info.incl.pl1 12/75 */ 1 2 1 3 dcl area_info_version_1 fixed bin static init (1) options (constant); 1 4 1 5 dcl area_infop ptr; 1 6 1 7 dcl 1 area_info aligned based (area_infop), 1 8 2 version fixed bin, /* version number for this structure is 1 */ 1 9 2 control aligned like area_control, /* control bits for the area */ 1 10 2 owner char (32) unal, /* creator of the area */ 1 11 2 n_components fixed bin, /* number of components in the area (returned only) */ 1 12 2 size fixed bin (18), /* size of the area in words */ 1 13 2 version_of_area fixed bin, /* version of area (returned only) */ 1 14 2 areap ptr, /* pointer to the area (first component on multisegment area) */ 1 15 2 allocated_blocks fixed bin, /* number of blocks allocated */ 1 16 2 free_blocks fixed bin, /* number of free blocks not in virgin */ 1 17 2 allocated_words fixed bin (30), /* number of words allocated in the area */ 1 18 2 free_words fixed bin (30); /* number of words free in area not in virgin */ 1 19 1 20 dcl 1 area_control aligned based, 1 21 2 extend bit (1) unal, /* says area is extensible */ 1 22 2 zero_on_alloc bit (1) unal, /* says block gets zerod at allocation time */ 1 23 2 zero_on_free bit (1) unal, /* says block gets zerod at free time */ 1 24 2 dont_free bit (1) unal, /* debugging aid, turns off free requests */ 1 25 2 no_freeing bit (1) unal, /* for allocation method without freeing */ 1 26 2 system bit (1) unal, /* says area is managed by system */ 1 27 2 pad bit (30) unal; 1 28 1 29 /* END INCLUDE FILE area_info.incl.pl1 */ 128 129 dcl arg char (argl) based (argp); /* current argument */ 130 dcl argl fixed bin (24); /* length of current argument */ 131 dcl arglp ptr; 132 dcl argp ptr; /* pointer to current argument */ 133 dcl bc fixed bin (24); 134 dcl chars char (63) int static 135 init ("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789"); 136 dcl cleanup condition; 137 dcl code fixed bin (35); 138 dcl com_err_ entry options (variable); 139 dcl command_name char (4) int static init ("mrpg"); 140 dcl cu_$arg_list_ptr entry (ptr); 141 dcl cu_$arg_ptr entry (fixed bin (24), ptr, fixed bin (24), fixed bin (35)); 142 dcl cu_$gen_call entry (ptr, ptr); 143 dcl define_area_ entry (ptr, fixed bin (35)); 144 dcl dname char (168); /* directory portion of input name */ 145 dcl ename char (32); /* entry portion of input name */ 146 dcl error_table_$zero_length_seg fixed bin (35) ext static; 147 dcl error_table_$badopt fixed bin (35) ext static; 148 dcl error_table_$noarg fixed bin (35) ext static; 149 dcl expand_pathname_$add_suffix entry (char (*), char (*), char (*), char (*), fixed bin (35)); 150 dcl get_wdir_ entry returns (char (168)); 151 dcl hcs_$initiate_count entry options (variable); 152 dcl hcs_$make_ptr entry (ptr, char (*), char (*), ptr, fixed bin (35)); 153 dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)); 154 dcl i fixed bin (24); 155 dcl ife fixed bin (24); /* length of input segment */ 156 dcl ifp ptr; /* pointer to input sgment */ 157 dcl ioa_ entry options (variable); 158 dcl mrpg_error_$init entry; 159 dcl mrpg_error_$stat entry returns (bit (1)); 160 dcl mrpg_fatal condition; 161 dcl mrpg_generate_ entry (ptr, char (32), ptr, fixed bin (35)); 162 dcl mrpg_parse_ entry (ptr, fixed bin (24), ptr, fixed bin (35)); 163 dcl pl1p ptr; 164 dcl release_area_ entry (ptr); 165 dcl sys_info$max_seg_size fixed bin (24) ext static; 166 167 dcl (addr, before, codeptr, divide, index, null, substr, verify) builtin; 168 169 dcl hold_sw bit (1) int static init ("0"b); 170 holdn: entry; hold_sw = "1"b; return; 171 holdf: entry; hold_sw = "0"b; return; 172 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 02/14/84 0844.1 mrpg.pl1 >special_ldd>on>6591>mrpg.pl1 128 1 06/11/76 1043.4 area_info.incl.pl1 >ldd>include>area_info.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. MRPG_version 000010 internal static char(8) initial unaligned dcl 18 set ref 67 76* addr builtin function dcl 167 ref 98 98 ai 000100 automatic structure level 1 unaligned dcl 127 set ref 98 98 area_control based structure level 1 dcl 1-20 area_info based structure level 1 dcl 1-7 area_info_version_1 constant fixed bin(17,0) initial dcl 1-3 ref 77 areap 16 000100 automatic pointer level 2 dcl 127 set ref 87* 88 95* 105* 110* 113* 116* 118* 122 122* arg based char unaligned dcl 129 set ref 27 34* 37* 59* 62* argl 000124 automatic fixed bin(24,0) dcl 130 set ref 24* 27 34 34 37 37 59 62 62 arglp 000126 automatic pointer dcl 131 set ref 120* 121* argp 000130 automatic pointer dcl 132 set ref 24* 27 34 37 59 62 bc 000132 automatic fixed bin(24,0) dcl 133 set ref 46* 53 58 before builtin function dcl 167 ref 40 59 chars 000000 constant char(63) initial unaligned dcl 134 ref 40 cleanup 000134 stack reference condition dcl 136 ref 104 code 000142 automatic fixed bin(35,0) dcl 137 set ref 22* 24* 25 34* 35 37* 46* 50* 67* 87* 90* 98* 99 101* 110* 113* 114 119* com_err_ 000014 constant entry external dcl 138 ref 31 37 43 50 55 62 67 73 90 101 command_name 000012 internal static char(4) initial unaligned dcl 139 set ref 31* 37* 50* 55* 62* 67 73* 82 101* control 1 000100 automatic structure level 2 dcl 127 cu_$arg_list_ptr 000016 constant entry external dcl 140 ref 120 cu_$arg_ptr 000020 constant entry external dcl 141 ref 24 cu_$gen_call 000022 constant entry external dcl 142 ref 121 define_area_ 000024 constant entry external dcl 143 ref 98 divide builtin function dcl 167 ref 58 dname 000143 automatic char(168) unaligned dcl 144 set ref 34* 46* 50* 55* dont_free 1(03) 000100 automatic bit(1) level 3 packed unaligned dcl 127 set ref 80* ename 000215 automatic char(32) unaligned dcl 145 set ref 34* 40 40 46* 50* 55* 59 113* error_table_$badopt 000030 external static fixed bin(35,0) dcl 147 set ref 62* error_table_$noarg 000032 external static fixed bin(35,0) dcl 148 set ref 73* error_table_$zero_length_seg 000026 external static fixed bin(35,0) dcl 146 set ref 55* expand_pathname_$add_suffix 000034 constant entry external dcl 149 ref 34 extend 1 000100 automatic bit(1) level 3 packed unaligned dcl 127 set ref 86* 96* get_wdir_ 000036 constant entry external dcl 150 ref 87 87 hcs_$initiate_count 000040 constant entry external dcl 151 ref 46 hcs_$make_ptr 000042 constant entry external dcl 152 ref 119 hcs_$make_seg 000044 constant entry external dcl 153 ref 87 hold_sw 000013 internal static bit(1) initial unaligned dcl 169 set ref 84 105 116 122 170* 171* ife 000225 automatic fixed bin(24,0) dcl 155 set ref 58* 110* ifp 000226 automatic pointer dcl 156 set ref 23* 29 46* 47 71 110* 113* index builtin function dcl 167 ref 40 ioa_ 000046 constant entry external dcl 157 ref 76 mrpg_error_$init 000050 constant entry external dcl 158 ref 109 mrpg_error_$stat 000052 constant entry external dcl 159 ref 111 mrpg_fatal 000230 stack reference condition dcl 160 ref 108 mrpg_generate_ 000054 constant entry external dcl 161 ref 113 mrpg_parse_ 000056 constant entry external dcl 162 ref 110 no_freeing 1(04) 000100 automatic bit(1) level 3 packed unaligned dcl 127 set ref 81* null builtin function dcl 167 ref 23 29 47 71 88 95 118 119 119 122 owner 2 000100 automatic char(32) level 2 packed unaligned dcl 127 set ref 82* pl1p 000236 automatic pointer dcl 163 set ref 119* 121* release_area_ 000060 constant entry external dcl 164 ref 105 116 122 size 13 000100 automatic fixed bin(18,0) level 2 dcl 127 set ref 83* substr builtin function dcl 167 ref 27 40 sys_info$max_seg_size 000062 external static fixed bin(24,0) dcl 165 ref 83 verify builtin function dcl 167 ref 40 version 000100 automatic fixed bin(17,0) level 2 dcl 127 set ref 77* zero_on_alloc 1(01) 000100 automatic bit(1) level 3 packed unaligned dcl 127 set ref 78* zero_on_free 1(02) 000100 automatic bit(1) level 3 packed unaligned dcl 127 set ref 79* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. area_infop automatic pointer dcl 1-5 codeptr builtin function dcl 167 i automatic fixed bin(24,0) dcl 154 NAMES DECLARED BY EXPLICIT CONTEXT. done 001341 constant label dcl 122 ref 108 111 114 holdf 001372 constant entry external dcl 171 holdn 001360 constant entry external dcl 170 mrpg 000141 constant entry external dcl 16 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2074 2160 1606 2104 Length 2412 1606 64 216 265 4 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME mrpg 282 external procedure is an external procedure. on unit on line 104 68 on unit on unit on line 108 64 on unit STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 MRPG_version mrpg 000012 command_name mrpg 000013 hold_sw mrpg STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME mrpg 000100 ai mrpg 000124 argl mrpg 000126 arglp mrpg 000130 argp mrpg 000132 bc mrpg 000142 code mrpg 000143 dname mrpg 000215 ename mrpg 000225 ife mrpg 000226 ifp mrpg 000236 pl1p mrpg THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return tra_ext enable ext_entry int_entry set_cs_eis index_before_cs THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ cu_$arg_list_ptr cu_$arg_ptr cu_$gen_call define_area_ expand_pathname_$add_suffix get_wdir_ hcs_$initiate_count hcs_$make_ptr hcs_$make_seg ioa_ mrpg_error_$init mrpg_error_$stat mrpg_generate_ mrpg_parse_ release_area_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badopt error_table_$noarg error_table_$zero_length_seg sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 16 000140 22 000146 23 000147 24 000151 25 000167 27 000171 29 000176 31 000202 32 000227 34 000230 35 000266 37 000270 38 000322 40 000323 43 000354 44 000403 46 000404 47 000446 50 000452 51 000505 53 000506 55 000510 56 000543 58 000544 59 000546 60 000561 62 000562 63 000614 65 000615 67 000616 69 000650 71 000651 73 000655 74 000702 76 000703 77 000722 78 000724 79 000726 80 000730 81 000732 82 000734 83 000740 84 000742 86 000744 87 000746 88 001024 90 001030 91 001061 93 001062 95 001063 96 001065 98 001067 99 001102 101 001104 102 001131 104 001132 105 001146 107 001157 108 001160 109 001177 110 001204 111 001221 113 001233 114 001250 116 001252 118 001263 119 001265 120 001321 121 001330 122 001341 125 001356 170 001357 170 001365 170 001370 171 001371 171 001377 171 001401 ----------------------------------------------------------- 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