COMPILATION LISTING OF SEGMENT format_line Compiled by: Multics PL/I Compiler, Release 27d, of October 11, 1982 Compiled at: Honeywell LISD Phoenix, System M Compiled on: 11/04/82 1832.3 mst Thu Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* *********************************************************** */ 6 fl: 7 format_line: 8 procedure options (variable); /* command/active function interface to ioa_ */ 9 /* updated 03/08/82: change usage message to use */ 10 /* the long name of the command by LAB. */ 11 12 who_am_i = "format_line"; 13 newline_sw = "1"b; 14 go to COMMON; 15 16 flnnl: 17 format_line_nnl: 18 entry options (variable); /* interface to ioa_$nnl */ 19 20 who_am_i = "format_line_nnl"; 21 newline_sw = "0"b; 22 go to COMMON; 23 24 declare (addr, hbound, index, null, substr) 25 builtin; 26 27 declare cleanup condition; 28 29 declare active_function bit (1), /* mode of operation (how were we called?) */ 30 arg_count fixed bin, /* number of arguments we were passed. */ 31 arg_list_ptr ptr, /* ptr to argument list */ 32 idx fixed bin, /* an index temporary. */ 33 newline_sw bit (1), /* are we fl or flnnl? */ 34 overflow bit (1), /* for AF case: is return arg too short? */ 35 return_max_len fixed bin, /* maximum length of our return value. */ 36 return_ptr ptr, /* ptr to our return value. */ 37 rs_idx fixed bin (21), /* index of first quote in return string */ 38 seg_ptr ptr, /* ptr to temp for requoting if too big for stack */ 39 status fixed bin (35), /* an error code variable. */ 40 who_am_i char (32); /* name for error messages */ 41 42 declare seg char (rs.len - rs_idx + 1) based (seg_ptr); 43 44 declare 1 rs based (return_ptr) aligned, /* our return value. */ 45 2 len fixed bin (21), /* its current length. */ 46 2 first_quote char (1) unaligned, /* quote we put around it */ 47 2 value char (return_max_len refer (rs.len)) unal, 48 /* its character-string value. */ 49 2 last_quote char (1) unaligned; /* other quote we put around it */ 50 51 declare 1 arg_list aligned based (arg_list_ptr), 52 2 n_args fixed bin (17) unal, 53 2 code fixed bin (17) unal, 54 2 n_desc fixed bin (17) unal, 55 2 mbz fixed bin (17) unal, 56 2 arg_ptrs (arg_count) ptr, 57 2 desc_ptrs (arg_count) ptr; 58 59 declare ( 60 active_fnc_err_, 61 active_fnc_err_$af_suppress_name, 62 com_err_, 63 com_err_$suppress_name 64 ) entry options (variable), 65 cu_$af_return_arg entry (fixed bin, ptr, fixed bin, fixed bin (35)), 66 cu_$arg_list_ptr entry () returns (ptr), 67 cu_$generate_call entry (entry, ptr), 68 get_temp_segment_ entry (char (*), ptr, fixed bin (35)), 69 ioa_ entry options (variable), 70 ioa_$general_rs entry (ptr, fixed bin, fixed bin, char (*), fixed bin (21), bit (1) aligned, bit (1) aligned), 71 ioa_$nnl entry options (variable), 72 release_temp_segment_ 73 entry (char (*), ptr, fixed bin (35)); 74 75 declare ( 76 error_table_$command_line_overflow, 77 error_table_$not_act_fnc 78 ) fixed bin (35) external; 79 80 /* find out how many args we were passed, and get ptr to and max length of return arg. */ 81 82 COMMON: 83 call cu_$af_return_arg (arg_count, return_ptr, return_max_len, status); 84 85 if status = 0 then active_function = "1"b; 86 else if status = error_table_$not_act_fnc then active_function = "0"b; 87 else do; 88 call com_err_ (status, who_am_i); /* error if called without arg descriptors. */ 89 return; 90 end; 91 92 if arg_count = 0 then do; 93 if active_function 94 then call active_fnc_err_$af_suppress_name (0, who_am_i, "Usage: [format_line^[_nnl^] control_string {args}]", 95 ^newline_sw); 96 else call com_err_$suppress_name (0, who_am_i, "Usage: format_line^[_nnl^] control_string {args}", ^newline_sw); 97 return; 98 end; 99 100 arg_list_ptr = cu_$arg_list_ptr (); 101 102 if ^active_function then do; 103 if newline_sw 104 then call cu_$generate_call (ioa_, arg_list_ptr); 105 else call cu_$generate_call (ioa_$nnl, arg_list_ptr); 106 return; 107 end; 108 109 return_max_len = return_max_len - 2; /* leave room for our quotes */ 110 rs.len = return_max_len + 1; /* be able to detect overlength line. */ 111 112 113 /* Now, a new param list for the call to ioa_$general_rs must be constructed. 114* This is necessary because the argument list we were passed contains an extra argument for 115* the active function returns string. This argument may confuse ioa_ */ 116 117 begin; /* this is to allocate the list */ 118 119 declare 1 auto_arg_list like arg_list aligned automatic; 120 121 auto_arg_list.n_args = 2 * arg_count; 122 auto_arg_list.n_desc = 2 * arg_count; 123 auto_arg_list.code = 4; 124 auto_arg_list.mbz = 0; 125 126 if arg_list.code = 8 127 then arg_count = arg_count + 2; /* if extra pointer supplied */ 128 else arg_count = arg_count + 1; /* else just skip return argument */ 129 do idx = 1 to hbound (auto_arg_list.arg_ptrs, 1); 130 auto_arg_list.arg_ptrs (idx) = arg_list.arg_ptrs (idx); 131 auto_arg_list.desc_ptrs (idx) = arg_list.desc_ptrs (idx); 132 end; 133 134 call ioa_$general_rs (addr (auto_arg_list), 1, 2, rs.value, rs.len, "0"b, "0"b); 135 end; 136 137 overflow = "0"b; 138 rs_idx = index (rs.value, """"); /* embedded quotes? */ 139 if rs_idx > 0 140 then if rs.len - rs_idx > 4095 then do; /* If we take up more than a page don't use stack */ 141 seg_ptr = null (); 142 on cleanup call release_temp_segment_ (who_am_i, seg_ptr, (0)); 143 call get_temp_segment_ (who_am_i, seg_ptr, status); 144 if status ^= 0 then do; 145 call active_fnc_err_ (status, who_am_i, "Getting temp segment."); 146 return; 147 end; 148 seg = substr (rs.value, rs_idx); 149 call double_quotes (seg); 150 call release_temp_segment_ (who_am_i, seg_ptr, (0)); 151 end; 152 else call double_quotes (substr (rs.value, rs_idx)); 153 else if rs.len > return_max_len then do; 154 rs.len = return_max_len; 155 overflow = "1"b; 156 end; 157 158 rs.first_quote, rs.last_quote = """"; /* put quotes around result */ 159 rs.len = rs.len + 2; /* include room for the two quotes we're adding. */ 160 161 if overflow 162 then call active_fnc_err_ (error_table_$command_line_overflow, who_am_i, 163 "Type ""start"" to continue with truncated string."); 164 165 return; 166 167 double_quotes: 168 procedure (copy); /* procedure to double any quotes appearing in */ 169 /* the variable, arg. */ 170 171 declare copy char (*); 172 173 declare arg_len fixed bin, /* length of arg */ 174 arg_ptr ptr, /* ptr to arg */ 175 arg char (arg_len) based (arg_ptr), 176 clen fixed bin (21), /* current string length. */ 177 quote_idx fixed bin (21), /* another index temporary. */ 178 slen fixed bin (21); /* a string length temporary. */ 179 180 arg_ptr = addr (substr (rs.value, rs_idx)); /* set ptr to copy back into at first quote */ 181 arg_len = rs.len - rs_idx + 1; /* adjust length accordingly */ 182 return_max_len = return_max_len - rs_idx + 1; /* set max length down accordingly */ 183 rs.len = rs_idx - 1; /* set current length down to point so far valid */ 184 clen = 0; /* set index to start scanning copy for quotes */ 185 186 do while ("1"b); 187 return_max_len = return_max_len - 1; /* we're going to add a second quote after one */ 188 /* we've found in copy. Exclude this quote from */ 189 /* the length of arg. Instead shift ptr to */ 190 /* arg 1 char to the right. Then, index values */ 191 /* have the same meaning in arg and copy. */ 192 if clen >= return_max_len then do; /* punt if there's no room left for two quotes */ 193 overflow = "1"b; 194 return; 195 end; 196 substr (arg, clen + 1, 2) = """"""; /* add double quote to end of arg. */ 197 rs.len = rs.len + 2; /* update length of return value to reflect the */ 198 /* double quote. */ 199 arg_ptr = addr (substr (arg, 2)); /* move ptr to arg 1 char to the right */ 200 clen = clen + 1; /* look at chars after the quote we've doubled. */ 201 quote_idx = index (substr (copy, clen + 1), """") - 1; 202 /* find next quote in these chars. */ 203 if quote_idx < 0 204 then slen = arg_len - clen; /* No quotes, so get length of rest of string */ 205 else slen = quote_idx; /* length of stuff before quote */ 206 if clen + slen > return_max_len then do; /* if too long to fit, truncate it here */ 207 slen = return_max_len - clen; 208 quote_idx = -1; /* stop search and exit (fake "no more quotes") */ 209 overflow = "1"b; /* report error */ 210 end; 211 if slen > 0 then substr (arg, clen + 1, slen) = substr (copy, clen + 1, slen); 212 /* append this substr to end of arg. */ 213 rs.len = rs.len + slen; /* add length of substr to length of ret value. */ 214 if quote_idx < 0 then return; /* if we didn't find a quote, then all done. */ 215 clen = clen + quote_idx; /* set index of quote we found, and loop. */ 216 end; 217 218 end double_quotes; 219 220 end format_line; 221 SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/04/82 1610.0 format_line.pl1 >dumps>old>recomp>format_line.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. active_fnc_err_ 000010 constant entry external dcl 59 ref 145 161 active_fnc_err_$af_suppress_name 000012 constant entry external dcl 59 ref 93 active_function 000106 automatic bit(1) unaligned dcl 29 set ref 85* 86* 93 102 addr builtin function dcl 24 ref 134 134 180 199 arg based char unaligned dcl 173 set ref 196* 199 211* arg_count 000107 automatic fixed bin(17,0) dcl 29 set ref 82* 92 119 119 121 122 126* 126 128* 128 131 arg_len 000100 automatic fixed bin(17,0) dcl 173 set ref 181* 196 199 203 211 arg_list based structure level 1 dcl 51 arg_list_ptr 000110 automatic pointer dcl 29 set ref 100* 103* 105* 126 130 131 arg_ptr 000102 automatic pointer dcl 173 set ref 180* 196 199* 199 211 arg_ptrs 2 based pointer array level 2 in structure "arg_list" dcl 51 in procedure "format_line" ref 130 arg_ptrs 2 000100 automatic pointer array level 2 in structure "auto_arg_list" dcl 119 in begin block on line 117 set ref 129 130* auto_arg_list 000100 automatic structure level 1 dcl 119 set ref 134 134 cleanup 000100 stack reference condition dcl 27 ref 142 clen 000104 automatic fixed bin(21,0) dcl 173 set ref 184* 192 196 200* 200 201 203 206 207 211 211 215* 215 code 0(18) 000100 automatic fixed bin(17,0) level 2 in structure "auto_arg_list" packed unaligned dcl 119 in begin block on line 117 set ref 123* code 0(18) based fixed bin(17,0) level 2 in structure "arg_list" packed unaligned dcl 51 in procedure "format_line" ref 126 com_err_ 000014 constant entry external dcl 59 ref 88 com_err_$suppress_name 000016 constant entry external dcl 59 ref 96 copy parameter char unaligned dcl 171 ref 167 201 211 cu_$af_return_arg 000020 constant entry external dcl 59 ref 82 cu_$arg_list_ptr 000022 constant entry external dcl 59 ref 100 cu_$generate_call 000024 constant entry external dcl 59 ref 103 105 desc_ptrs based pointer array level 2 in structure "arg_list" dcl 51 in procedure "format_line" ref 131 desc_ptrs 000100 automatic pointer array level 2 in structure "auto_arg_list" dcl 119 in begin block on line 117 set ref 131* error_table_$command_line_overflow 000040 external static fixed bin(35,0) dcl 75 set ref 161* error_table_$not_act_fnc 000042 external static fixed bin(35,0) dcl 75 ref 86 first_quote 1 based char(1) level 2 packed unaligned dcl 44 set ref 158* get_temp_segment_ 000026 constant entry external dcl 59 ref 143 hbound builtin function dcl 24 ref 129 idx 000112 automatic fixed bin(17,0) dcl 29 set ref 129* 130 130 131 131* index builtin function dcl 24 ref 138 201 ioa_ 000030 constant entry external dcl 59 ref 103 103 ioa_$general_rs 000032 constant entry external dcl 59 ref 134 ioa_$nnl 000034 constant entry external dcl 59 ref 105 105 last_quote based char(1) level 2 packed unaligned dcl 44 set ref 158* len based fixed bin(21,0) level 2 dcl 44 set ref 110* 134 134 134* 138 139 148 148 149 149 152 152 153 154* 158 159* 159 180 181 183* 197* 197 213* 213 mbz 1(18) 000100 automatic fixed bin(17,0) level 2 packed unaligned dcl 119 set ref 124* n_args 000100 automatic fixed bin(17,0) level 2 packed unaligned dcl 119 set ref 121* n_desc 1 000100 automatic fixed bin(17,0) level 2 packed unaligned dcl 119 set ref 122* newline_sw 000113 automatic bit(1) unaligned dcl 29 set ref 13* 21* 93 96 103 null builtin function dcl 24 ref 141 overflow 000114 automatic bit(1) unaligned dcl 29 set ref 137* 155* 161 193* 209* quote_idx 000105 automatic fixed bin(21,0) dcl 173 set ref 201* 203 205 208* 214 215 release_temp_segment_ 000036 constant entry external dcl 59 ref 142 150 return_max_len 000115 automatic fixed bin(17,0) dcl 29 set ref 82* 109* 109 110 153 154 182* 182 187* 187 192 206 207 return_ptr 000116 automatic pointer dcl 29 set ref 82* 110 134 134 138 139 148 148 149 149 152 152 153 154 158 158 159 159 180 181 183 197 197 213 213 rs based structure level 1 dcl 44 rs_idx 000120 automatic fixed bin(21,0) dcl 29 set ref 138* 139 139 148 148 149 149 152 152 180 181 182 183 seg based char unaligned dcl 42 set ref 148* 149* seg_ptr 000122 automatic pointer dcl 29 set ref 141* 142* 143* 148 149 150* slen 000106 automatic fixed bin(21,0) dcl 173 set ref 203* 205* 206 207* 211 211 211 213 status 000124 automatic fixed bin(35,0) dcl 29 set ref 82* 85 86 88* 143* 144 145* substr builtin function dcl 24 set ref 148 152 152 180 196* 199 201 211* 211 value 1(09) based char level 2 packed unaligned dcl 44 set ref 134* 138 148 152 152 180 who_am_i 000125 automatic char(32) unaligned dcl 29 set ref 12* 20* 88* 93* 96* 142* 143* 145* 150* 161* NAMES DECLARED BY EXPLICIT CONTEXT. COMMON 000152 constant label dcl 82 ref 14 22 double_quotes 001061 constant entry internal dcl 167 ref 149 152 fl 000115 constant entry external dcl 6 flnnl 000140 constant entry external dcl 16 format_line 000106 constant entry external dcl 6 format_line_nnl 000131 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 1444 1510 1216 1454 Length 1706 1216 44 162 226 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME format_line 138 external procedure is an external procedure. begin block on line 117 106 begin block uses auto adjustable storage. on unit on line 142 80 on unit double_quotes 72 internal procedure is called during a stack extension. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME begin block on line 117 000100 auto_arg_list begin block on line 117 double_quotes 000100 arg_len double_quotes 000102 arg_ptr double_quotes 000104 clen double_quotes 000105 quote_idx double_quotes 000106 slen double_quotes format_line 000106 active_function format_line 000107 arg_count format_line 000110 arg_list_ptr format_line 000112 idx format_line 000113 newline_sw format_line 000114 overflow format_line 000115 return_max_len format_line 000116 return_ptr format_line 000120 rs_idx format_line 000122 seg_ptr format_line 000124 status format_line 000125 who_am_i format_line THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs enter_begin leave_begin call_ext_out_desc call_ext_out call_int_this_desc return alloc_auto_adj enable shorten_stack ext_entry int_entry int_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. active_fnc_err_ active_fnc_err_$af_suppress_name com_err_ com_err_$suppress_name cu_$af_return_arg cu_$arg_list_ptr cu_$generate_call get_temp_segment_ ioa_ ioa_$general_rs ioa_$nnl release_temp_segment_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$command_line_overflow error_table_$not_act_fnc LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 6 000105 12 000122 13 000125 14 000127 16 000130 20 000145 21 000150 22 000151 82 000152 85 000167 86 000174 88 000201 89 000215 92 000216 93 000220 96 000257 97 000313 100 000314 102 000323 103 000325 105 000345 106 000362 109 000363 110 000365 117 000370 119 000373 121 000407 122 000414 123 000417 124 000421 126 000423 128 000433 129 000434 130 000444 131 000450 132 000466 134 000470 135 000546 137 000547 138 000550 139 000563 141 000570 142 000572 143 000631 144 000652 145 000654 146 000700 148 000701 149 000725 150 000737 151 000761 152 000762 153 001010 154 001014 155 001016 158 001020 159 001027 161 001031 165 001057 167 001060 180 001074 181 001102 182 001106 183 001112 184 001115 187 001116 192 001121 193 001124 194 001126 196 001127 197 001133 199 001135 200 001141 201 001142 203 001157 205 001164 206 001165 207 001170 208 001173 209 001175 211 001177 213 001205 214 001206 215 001211 216 001212 218 001213 ----------------------------------------------------------- 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