COMPILATION LISTING OF SEGMENT retain_symbols Compiled by: Multics PL/I Compiler, Release 26a, of September 3, 1980 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 01/06/81 1248.2 mst Tue Options: optimize map 1 /* ****************************************************** 2* * * 3* * * 4* * Copyright, (C) Honeywell Information Systems * 5* * Inc., 1980. * 6* * * 7* * * 8* ****************************************************** */ 9 10 retain_symbols: rsb: procedure; 11 12 /* This procedure implements the retain_symbols command. 13* * Created on 02/04/76 by Bill Silver as escape_notescript. 14* * Changed on 06/10/77 by Bill Silver as retain_symbols. 15* * 16* * The retain_symbols (rsb) command takes an input segment and inserts escapes 17* * wherever text would be expanded by the expand_symbols command. 18* * Its calling sequence is: 19* * 20* * retain_symbols, rsn input_path (output_path) (-perm | -temp) 21**/ 22 23 /* AUTOMATIC DATA */ 24 dcl dir_name char (168); /* Used to expand pathnames. */ 25 dcl ent_name char (32); /* Used to expand pathnames. */ 26 27 dcl arg_len fixed bin; /* Length of control argument. */ 28 dcl arg_ptr ptr; /* Pointer to control argument. */ 29 dcl argx fixed bin; /* Index of control argument. */ 30 dcl ecode fixed bin (35); /* Error table code. */ 31 dcl in_len fixed bin (21); /* Length of unused part of input segment. */ 32 dcl in_ptr ptr; /* Pointer to input segment. */ 33 dcl num_args fixed bin; /* Number of command arguments. */ 34 dcl out_ptr ptr; /* Pointer to output segment. */ 35 dcl out_len fixed bin (21); /* Max length of output segment. */ 36 dcl out_used fixed bin (21); /* Length of used part of output segment. */ 37 dcl perm_flag bit (1) aligned; /* ON => permanent escape, OFF => temporary escape. */ 38 dcl temp_flag bit (1) aligned; /* ON -> using temporary output segment. */ 39 40 /* BASED DATA */ 41 42 dcl argument char (arg_len) based (arg_ptr); /* Control argument string. */ 43 44 /* EXTERNAL ENTRIES */ 45 46 dcl (addr, substr) builtin; 47 48 dcl error_table_$badopt fixed bin (35) external; 49 dcl error_table_$wrong_no_of_args fixed bin (35) external; 50 51 dcl com_err_ entry options (variable); 52 dcl cu_$arg_count entry (fixed bin); 53 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); 54 dcl expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin (35)); 55 dcl speedtype_retain_ entry (bit (1) aligned, ptr, fixed bin (21), ptr, fixed bin (21), fixed bin (21), fixed bin (35)); 56 dcl speedtype_util_$fix_output_seg entry (bit (1) aligned, ptr, ptr, fixed bin (21), fixed bin (35)); 57 dcl speedtype_util_$init_input_seg entry (char (*), char (*), ptr, fixed bin (21), fixed bin (35)); 58 dcl speedtype_util_$init_output_seg entry (char (*), char (*), ptr, fixed bin (21), fixed bin (35)); 59 /* */ 60 call cu_$arg_count (num_args); /* Test for correct number of arguments. */ 61 if (num_args < 1) | /* Must have either 1 or 2 or 3 arguments. */ 62 (num_args > 3) 63 then do; 64 ecode = error_table_$wrong_no_of_args; 65 call com_err_ (ecode, "Speedtype", "Usage is: rsb input_path (output_path) (-perm | -temp"); 66 return; 67 end; 68 69 perm_flag, /* Default is to use permanent escape. */ 70 temp_flag = "1"b; /* Assume that we need a temporary output segment. */ 71 72 do argx = 1 to num_args; /* Process each argument. */ 73 call cu_$arg_ptr (argx, arg_ptr, arg_len, ecode); 74 if ecode ^= 0 75 then do; 76 call com_err_ (ecode, "Speedtype", "Error getting argument ^d", argx); 77 return; 78 end; 79 call PROCESS_ARG; /* Process this argument. */ 80 if ecode ^= 0 then return; /* Give up if argument error. */ 81 end; 82 83 if temp_flag /* Do we need a temporary output segment? */ 84 then do; /* Yes, use temporary segment in process directory. */ 85 call speedtype_util_$init_output_seg ("", "speedtype_temp", out_ptr, out_len, ecode); 86 if ecode ^= 0 87 then do; 88 call com_err_ (ecode, "Speedtype", "Error creating temporary output segment"); 89 return; 90 end; 91 end; 92 93 /* Now expand input segment. */ 94 call speedtype_retain_ (perm_flag, in_ptr, in_len, out_ptr, out_len, out_used, ecode); 95 if ecode ^= 0 96 then do; 97 call com_err_ (ecode, "Speedtype", "Error processing input"); 98 return; 99 end; 100 101 /* Fix up output segment. */ 102 call speedtype_util_$fix_output_seg (temp_flag, in_ptr, out_ptr, out_used, ecode); 103 if ecode ^= 0 104 then call com_err_ (ecode, "Speedtype", "Error fixing output segment"); 105 106 return; 107 /* */ 108 PROCESS_ARG: procedure; 109 110 /* This procedure is called to process one input argument. 111* * The first argument must be the pathname of the input segment. 112* * The second, optional argument, may be the pathanme of the output segment. 113* * An optional control argument may specify which escape character to use. 114**/ 115 goto ARGUMENT (argx); /* Go process argument. */ 116 117 ARGUMENT (1): /* Pathname of input segment. */ 118 call expand_path_ (arg_ptr, arg_len, addr (dir_name), addr (ent_name), ecode); 119 if ecode ^= 0 120 then do; 121 call com_err_ (ecode, "Speedtype", "Error expanding input pathanme: ^a", argument); 122 return; 123 end; 124 call speedtype_util_$init_input_seg (dir_name, ent_name, in_ptr, in_len, ecode); 125 if ecode ^= 0 126 then call com_err_ (ecode, "Speedtype", "Error initializing input segment"); 127 return; 128 129 ARGUMENT (2): /* Pathname of output segment. */ 130 if substr (argument, 1, 1) = "-" /* Is this a control argument? */ 131 then goto ARGUMENT (3); /* Yes, process as such. */ 132 call expand_path_ (arg_ptr, arg_len, addr (dir_name), addr (ent_name), ecode); 133 if ecode ^= 0 134 then do; 135 call com_err_ (ecode, "Speedtype", "Error expanding output pathname: ^a", argument); 136 return; 137 end; 138 call speedtype_util_$init_output_seg (dir_name, ent_name, out_ptr, out_len, ecode); 139 if ecode ^= 0 140 then do; 141 call com_err_ (ecode, "Speedtype", "Error initializing output segment"); 142 return; 143 end; 144 if out_ptr ^= in_ptr /* If output segment different from input segment. */ 145 then temp_flag = "0"b; /* Then no need for temporary output segment. */ 146 return; 147 148 ARGUMENT (3): /* (-temp | -perm) */ 149 if argument = "-perm" /* This is the default. */ 150 then return; /* Everything already set up. */ 151 if argument = "-temp" /* Temporary escape? */ 152 then perm_flag = "0"b; /* Yes. */ 153 else do; /* No, illegal control argument. */ 154 ecode = error_table_$badopt; 155 call com_err_ (ecode, "Speedtype", "Unknown control argument: ^a", argument); 156 end; 157 return; 158 159 end PROCESS_ARG; 160 end retain_symbols; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 01/06/81 1247.6 retain_symbols.pl1 >spec>on>speed>retain_symbols.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. addr builtin function dcl 46 ref 117 117 117 117 132 132 132 132 arg_len 000162 automatic fixed bin(17,0) dcl 27 set ref 73* 117* 121 121 129 132* 135 135 148 151 155 155 arg_ptr 000164 automatic pointer dcl 28 set ref 73* 117* 121 129 132* 135 148 151 155 argument based char unaligned dcl 42 set ref 121* 129 135* 148 151 155* argx 000166 automatic fixed bin(17,0) dcl 29 set ref 72* 73* 76* 115 com_err_ 000014 constant entry external dcl 51 ref 65 76 88 97 103 121 125 135 141 155 cu_$arg_count 000016 constant entry external dcl 52 ref 60 cu_$arg_ptr 000020 constant entry external dcl 53 ref 73 dir_name 000100 automatic char(168) unaligned dcl 24 set ref 117 117 124* 132 132 138* ecode 000167 automatic fixed bin(35,0) dcl 30 set ref 64* 65* 73* 74 76* 80 85* 86 88* 94* 95 97* 102* 103 103* 117* 119 121* 124* 125 125* 132* 133 135* 138* 139 141* 154* 155* ent_name 000152 automatic char(32) unaligned dcl 25 set ref 117 117 124* 132 132 138* error_table_$badopt 000010 external static fixed bin(35,0) dcl 48 ref 154 error_table_$wrong_no_of_args 000012 external static fixed bin(35,0) dcl 49 ref 64 expand_path_ 000022 constant entry external dcl 54 ref 117 132 in_len 000170 automatic fixed bin(21,0) dcl 31 set ref 94* 124* in_ptr 000172 automatic pointer dcl 32 set ref 94* 102* 124* 144 num_args 000174 automatic fixed bin(17,0) dcl 33 set ref 60* 61 61 72 out_len 000200 automatic fixed bin(21,0) dcl 35 set ref 85* 94* 138* out_ptr 000176 automatic pointer dcl 34 set ref 85* 94* 102* 138* 144 out_used 000201 automatic fixed bin(21,0) dcl 36 set ref 94* 102* perm_flag 000202 automatic bit(1) dcl 37 set ref 69* 94* 151* speedtype_retain_ 000024 constant entry external dcl 55 ref 94 speedtype_util_$fix_output_seg 000026 constant entry external dcl 56 ref 102 speedtype_util_$init_input_seg 000030 constant entry external dcl 57 ref 124 speedtype_util_$init_output_seg 000032 constant entry external dcl 58 ref 85 138 substr builtin function dcl 46 ref 129 temp_flag 000203 automatic bit(1) dcl 38 set ref 69* 83 102* 144* NAMES DECLARED BY EXPLICIT CONTEXT. ARGUMENT 000000 constant label array(3) dcl 117 ref 115 129 PROCESS_ARG 000573 constant entry internal dcl 108 ref 79 retain_symbols 000201 constant entry external dcl 10 rsb 000172 constant entry external dcl 10 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1360 1414 1213 1370 Length 1604 1213 34 154 144 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME rsb 282 external procedure is an external procedure. PROCESS_ARG internal procedure shares stack frame of external procedure rsb. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME rsb 000100 dir_name rsb 000152 ent_name rsb 000162 arg_len rsb 000164 arg_ptr rsb 000166 argx rsb 000167 ecode rsb 000170 in_len rsb 000172 in_ptr rsb 000174 num_args rsb 000176 out_ptr rsb 000200 out_len rsb 000201 out_used rsb 000202 perm_flag rsb 000203 temp_flag rsb THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. call_ext_out_desc call_ext_out return ext_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ cu_$arg_count cu_$arg_ptr expand_path_ speedtype_retain_ speedtype_util_$fix_output_seg speedtype_util_$init_input_seg speedtype_util_$init_output_seg THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badopt error_table_$wrong_no_of_args LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 10 000171 60 000206 61 000214 64 000221 65 000224 66 000253 69 000254 72 000257 73 000265 74 000302 76 000304 77 000340 79 000341 80 000342 81 000344 83 000346 85 000351 86 000410 88 000412 89 000442 94 000443 95 000466 97 000470 98 000520 102 000521 103 000540 106 000572 108 000573 115 000574 117 000576 119 000621 121 000623 122 000662 124 000663 125 000714 127 000746 129 000747 132 000754 133 000777 135 001001 136 001040 138 001041 139 001072 141 001074 142 001124 144 001125 146 001132 148 001133 151 001142 154 001150 155 001153 157 001211 ----------------------------------------------------------- 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