COMPILATION LISTING OF SEGMENT gfms_calling_sequence_ Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell Multics Op. - System M Compiled on: 12/10/84 1203.1 mst Mon Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* *********************************************************** */ 6 gfms_calling_sequence_: proc; 7 8 /* Print the input arguments (strings) on error_output 9* stream with the following considerations: 10* strings containing "|" are justified 11* and information after the "|" are folded under this 12* character, e.g., 13* abc | stuff xxx 14* d | more stuff 15* 16* Author: Dave Ward 02/02/81 17* Change: Dave Ward 02/03/81 fold lines not containing |. 18* Change: Scott C. Akers 02/08/82 Change name from print_calling_sequence_ to 19* gfms_calling_sequence_ for binding into bound_gfms. 20**/ 21 ll = get_line_length_$stream ("error_output", code); 22 call cu_$arg_count (na); 23 mm = 0; /* Set initial max m. */ 24 25 /* Obtain parameter information. */ 26 do i = 1 to na while (i <= hbound (a, 1)); 27 call cu_$arg_ptr (i, p (i), l (i), code); 28 if code ^= 0 then do; 29 call com_err_ ( 30 code 31 , "gfms_calling_sequence_" 32 , "Arg ^i" 33 , i 34 ); 35 return; 36 end; 37 38 /* Measure for | location. */ 39 m (i) = index (argi, "|"); 40 mm = max (mm, m (i)); 41 end; 42 43 /* Print the strings. */ 44 do i = 1 to (i-1); 45 if (m (i) = 0) | (mm > (ll-5)) then do; /* Either no |, or | too far to the right (a Reagen bar). */ 46 if length (argi) <= ll then /* Not more than ll characters to print. */ 47 call out (argi); 48 else /* More than ll characters to print. */ 49 call fold (argi); 50 end; 51 else do; /* String contains |. */ 52 call out (substr (argi, 1, m (i)-1)); 53 if m (i)m (i) then /* There are characters after the |. */ 57 call pr_rest (after_bar); 58 end; 59 call out (NL); 60 end; 61 fail: ; 62 return; 63 64 fold: proc (s); 65 66 /* Output ll characters, break on space, fold remainder. 67**/ 68 dcl s char(*)parm; 69 if length (s) <= ll then do; 70 call out (s); 71 return; 72 end; 73 k = index (reverse (substr (s, 1, ll)), " "); 74 if k>0 then do; 75 l = length (rtrim (substr (s, 1, ll-k))); 76 if l>0 then do; 77 call out (substr (s, 1, l)); 78 call out (NL); 79 end; 80 l = ll - (k-1) + 1; /* Location 1st character of remainder. */ 81 if (length (s)-l+1)>ll then 82 call fold (substr (s, l)); 83 else do; /* Right justify final piece. */ 84 call out (substr ((100)" ", 1, ll- (length (s)-l+1))); 85 call out (substr (s, l)); 86 end; 87 return; 88 end; 89 90 /* No blanks in string. */ 91 call out (substr (s, 1, ll)); 92 call out (NL); 93 call fold (substr (s, ll+1)); 94 return; 95 dcl k fixed bin; 96 dcl l fixed bin; 97 end fold; 98 99 out: proc (s); 100 101 /* Print string "s". */ 102 dcl s char(*)parm; 103 call iox_$put_chars ( 104 iox_$error_output 105 , addr (s) 106 , length (s) 107 , code 108 ); 109 if code ^= 0 then do; 110 call com_err_ ( 111 code 112 , "gfms_calling_sequence_" 113 , "String ""^a""" 114 , s 115 ); 116 goto fail; 117 end; 118 return; 119 end out; 120 121 pr_rest: proc (s); 122 123 /* Print the string "s" as the rest of the string 124* after |. 125**/ 126 dcl s char(*)parm; 127 call out (" "); 128 l = ll-mm-2; /* Print characters available. */ 129 pl = length (s); 130 if pl <= l then do; /* Not more than ll characters to print. */ 131 call out (s); 132 return; 133 end; 134 135 /* More than ll characters, 136* print up to ll characters on this line 137* and fold the remainder. 138**/ 139 k = index (reverse (substr (s, 1, l)), " "); 140 if k = 0 then do; /* No space found. */ 141 call out (substr (s, 1, l)); 142 fc = l+1; 143 ln = pl-l; 144 if ln<1 then return; 145 end; 146 else do; /* Print up to space. */ 147 call out (rtrim (substr (s, 1, l- (k-1)))); 148 fc = l-k+2; 149 ln = pl-fc+1; 150 if ln<1 then return; 151 end; 152 call out (NL); 153 call out (substr ((100)" ", 1, mm-1)); 154 call out (" |"); 155 call pr_rest (substr (s, fc, ln)); 156 return; 157 dcl fc fixed bin; 158 dcl k fixed bin; 159 dcl l fixed bin; 160 dcl ln fixed bin; 161 dcl pl fixed bin; 162 end pr_rest; 163 164 /* Variables for gfms_calling_sequence_: */ 165 /* IDENTIFIER ATTRIBUTES */ 166 dcl after_bar char(l(i)-m(i))unal based(addr(ari(m(i)+1))) /* i-th argument, characters after |. */; 167 dcl argi char(l(i))unal based(p(i)) /* i-th argument, character string. */; 168 dcl ari (l(i))char(1)unal based(p(i)) /* i-th argument, array of characters. */; 169 dcl code fixed bin(35); 170 dcl com_err_ entry() options(variable); 171 dcl cu_$arg_count entry (fixed bin); 172 dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin(21), fixed bin(35)); 173 dcl get_line_length_$stream entry (char(*), fixed bin(35)) returns(fixed bin); 174 dcl hbound builtin; 175 dcl i fixed bin; 176 dcl index builtin; 177 dcl iox_$error_output ptr ext static; 178 dcl iox_$put_chars entry (ptr, ptr, fixed bin(21), fixed bin(35)); 179 dcl ll fixed bin; 180 dcl max builtin; 181 dcl min builtin; 182 dcl mm fixed bin; 183 dcl na fixed bin; 184 dcl reverse builtin; 185 dcl substr builtin; 186 187 dcl NL char(1)static int options(constant)init(" 188 "); 189 190 dcl 1 a (1000)aligned 191 , 2 p ptr 192 , 2 l fixed bin(21) 193 , 2 m fixed bin 194 ; 195 end gfms_calling_sequence_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 12/10/84 1041.7 gfms_calling_sequence_.pl1 >spec>on>7105>gfms_calling_sequence_.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. NL 000000 constant char(1) initial unaligned dcl 187 set ref 59* 78* 92* 152* a 000106 automatic structure array level 1 dcl 190 set ref 26 after_bar based char unaligned dcl 166 set ref 56* argi based char unaligned dcl 167 set ref 39 46 46* 48* 52 52 ari based char(1) array unaligned dcl 168 set ref 56 code 000100 automatic fixed bin(35,0) dcl 169 set ref 21* 27* 28 29* 103* 109 110* com_err_ 000010 constant entry external dcl 170 ref 29 110 cu_$arg_count 000012 constant entry external dcl 171 ref 22 cu_$arg_ptr 000014 constant entry external dcl 172 ref 27 fc 000100 automatic fixed bin(17,0) dcl 157 set ref 142* 148* 149 155 155 get_line_length_$stream 000016 constant entry external dcl 173 ref 21 hbound builtin function dcl 174 ref 26 i 000101 automatic fixed bin(17,0) dcl 175 set ref 26* 26* 27* 27 27 29* 39 39 39 40* 44* 44* 45 46 46 46 46 46 48 48 48 52 52 52 52 52 52 53 53 53 56 56 56 56 56 56 56 56* index builtin function dcl 176 ref 39 73 139 iox_$error_output 000020 external static pointer dcl 177 set ref 103* iox_$put_chars 000022 constant entry external dcl 178 ref 103 k 000101 automatic fixed bin(17,0) dcl 158 in procedure "pr_rest" set ref 139* 140 147 147 148 k 000100 automatic fixed bin(17,0) dcl 95 in procedure "fold" set ref 73* 74 75 80 l 000101 automatic fixed bin(17,0) dcl 96 in procedure "fold" set ref 75* 76 77 77 80* 81 81 81 84 84 85 85 l 000102 automatic fixed bin(17,0) dcl 159 in procedure "pr_rest" set ref 128* 130 139 141 141 142 143 147 147 148 l 2 000106 automatic fixed bin(21,0) array level 2 in structure "a" dcl 190 in procedure "gfms_calling_sequence_" set ref 27* 39 46 46 46 48 48 52 52 56 56 56 ll 000102 automatic fixed bin(17,0) dcl 179 set ref 21* 45 46 69 73 75 80 81 84 84 91 91 93 93 128 ln 000103 automatic fixed bin(17,0) dcl 160 set ref 143* 144 149* 150 155 155 m 3 000106 automatic fixed bin(17,0) array level 2 dcl 190 set ref 39* 40 45 52 52 53 53 53 56 56 56 56 max builtin function dcl 180 ref 40 mm 000103 automatic fixed bin(17,0) dcl 182 set ref 23* 40* 40 45 53 53 53 128 153 153 na 000104 automatic fixed bin(17,0) dcl 183 set ref 22* 26 p 000106 automatic pointer array level 2 dcl 190 set ref 27* 39 46 46 48 52 52 56 pl 000104 automatic fixed bin(17,0) dcl 161 set ref 129* 130 143 149 reverse builtin function dcl 184 ref 73 139 s parameter char unaligned dcl 102 in procedure "out" set ref 99 103 103 103 103 110* s parameter char unaligned dcl 126 in procedure "pr_rest" set ref 121 129 131* 139 141 141 147 147 155 155 s parameter char unaligned dcl 68 in procedure "fold" set ref 64 69 70* 73 75 77 77 81 81 81 84 84 85 85 91 91 93 93 substr builtin function dcl 185 ref 52 52 53 53 73 75 77 77 81 81 84 84 85 85 91 91 93 93 139 141 141 147 147 153 153 155 155 NAME DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. min builtin function dcl 181 NAMES DECLARED BY EXPLICIT CONTEXT. fail 000414 constant label dcl 61 ref 116 fold 000417 constant entry internal dcl 64 ref 48 81 93 gfms_calling_sequence_ 000035 constant entry external dcl 6 out 000747 constant entry internal dcl 99 ref 46 52 53 55 59 70 77 78 84 85 91 92 127 131 141 147 152 153 154 pr_rest 001054 constant entry internal dcl 121 ref 56 155 NAMES DECLARED BY CONTEXT OR IMPLICATION. addr builtin function ref 56 103 103 length builtin function ref 46 69 75 81 84 84 103 103 129 rtrim builtin function ref 75 147 147 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1520 1544 1377 1530 Length 1726 1377 24 145 120 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME gfms_calling_sequence_ 4112 external procedure is an external procedure. fold 80 internal procedure is called during a stack extension. out 100 internal procedure is called during a stack extension. pr_rest 83 internal procedure is called during a stack extension. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME fold 000100 k fold 000101 l fold gfms_calling_sequence_ 000100 code gfms_calling_sequence_ 000101 i gfms_calling_sequence_ 000102 ll gfms_calling_sequence_ 000103 mm gfms_calling_sequence_ 000104 na gfms_calling_sequence_ 000106 a gfms_calling_sequence_ pr_rest 000100 fc pr_rest 000101 k pr_rest 000102 l pr_rest 000103 ln pr_rest 000104 pl pr_rest THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs call_ext_out_desc call_ext_out call_int_this_desc call_int_other_desc return tra_ext shorten_stack ext_entry int_entry_desc THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ cu_$arg_count cu_$arg_ptr get_line_length_$stream iox_$put_chars 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 6 000034 21 000042 22 000067 23 000076 26 000077 27 000111 28 000127 29 000131 35 000166 39 000167 40 000205 41 000211 44 000213 45 000223 46 000233 48 000252 50 000264 52 000265 53 000310 55 000341 56 000354 59 000402 60 000412 61 000414 62 000415 64 000416 69 000432 70 000435 71 000447 73 000450 74 000464 75 000465 76 000502 77 000503 78 000522 80 000534 81 000544 83 000602 84 000603 85 000631 86 000662 87 000663 91 000664 92 000704 93 000716 94 000744 99 000746 103 000762 109 001003 110 001006 116 001047 118 001052 121 001053 127 001067 128 001102 129 001107 130 001111 131 001113 132 001126 139 001127 140 001143 141 001144 142 001164 143 001170 144 001173 145 001176 147 001177 148 001235 149 001242 150 001246 152 001251 153 001262 154 001305 155 001321 156 001344 ----------------------------------------------------------- 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