COMPILATION LISTING OF SEGMENT pl1_print Compiled by: Multics PL/I Compiler, Release 33d, of April 24, 1992 Compiled at: ACTC Technologies Inc. Compiled on: 92-10-06_0040.64_Tue_mdt Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) BULL HN Information Systems Inc., 1992 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 14 15 /****^ HISTORY COMMENTS: 16* 1) change(92-09-10,Zimmerman), approve(92-09-10,MCR8257), audit(92-09-18,Vu), 17* install(92-10-06,MR12.5-1023): 18* Fix segment overflow in source section of listing. 19* END HISTORY COMMENTS */ 20 21 22 /* print routines for use by the PL/1 compiler in writing into the listing */ 23 /* segment. There are four entries for the combinations of varying and non-*/ 24 /* varying character string parameters and for with and without new-line */ 25 /* characters appended to the string before transmission. */ 26 27 /* Written by: J.D. Mills */ 28 /* On 22 January 1969 */ 29 /* Modified by: B. L. Wolman on 16 May 1969 to use cv_string */ 30 /* Modified by: B. L. Wolman on 21 May 1969 to accept ptr to string */ 31 /* Rewritten in pl1 replacing cv_string with substr on 28 JULY 1969 by the author. */ 32 /* Modified on: 20 August 1970 by P. Green for Version II */ 33 /* Modified on: 17 January 1974 by R. A. Barnes for 256K segments */ 34 /* Modified 770502 by PG to rewrite $for_lex entry to work with EIS lex */ 35 36 pl1_print$varying: proc(var_string); 37 38 /* parameters */ 39 40 dcl var_string char(*) varying aligned; 41 42 /* automatic */ 43 44 dcl l_suff fixed bin, 45 arg_length fixed bin(21); 46 47 /* based */ 48 49 declare string char (261120) aligned based (pl1_stat_$list_ptr); 50 51 /* builtins */ 52 53 declare ( length, substr) builtin; 54 55 /* conditions */ 56 57 declare listing_overflow condition; 58 59 /* external static */ 60 61 dcl ( pl1_stat_$list_ptr ptr, 62 pl1_stat_$max_list_size fixed bin(21), 63 pl1_stat_$char_pos fixed bin(21)) static external; 64 65 /* internal static */ 66 67 declare NL character(1) aligned static internal initial(" 68 "); 69 70 /* program */ 71 72 /* Entry to write a varying character string sans new-line character into the listing segment. */ 73 74 l_suff=0; 75 go to l1; 76 77 /* Entry to write a varying character string avec new-line character into the listing segment. */ 78 79 pl1_print$varying_nl: entry(var_string); 80 81 l_suff=1; 82 83 l1: arg_length=length(var_string); 84 85 if arg_length + pl1_stat_$char_pos + l_suff > pl1_stat_$max_list_size 86 then signal condition(listing_overflow); 87 88 substr(string,pl1_stat_$char_pos,arg_length)=var_string; 89 goto done; 90 91 /* Entry to write a non-varying character string sans new-line character into the listing segment. */ 92 93 pl1_print$non_varying: entry(nv_string,size); 94 95 dcl nv_string char(*) aligned, 96 size fixed bin(35); 97 98 l_suff=0; 99 go to l2; 100 101 /* Entry to write non-varying character string avec new-line character into the listing segment. */ 102 103 pl1_print$non_varying_nl: entry(nv_string,size); 104 105 l_suff=1; 106 107 l2: if size > 0 108 then arg_length=size; 109 else arg_length=length(nv_string); 110 111 if arg_length + pl1_stat_$char_pos + l_suff > pl1_stat_$max_list_size 112 then signal condition(listing_overflow); 113 substr(string,pl1_stat_$char_pos,arg_length)=nv_string; 114 115 done: pl1_stat_$char_pos=pl1_stat_$char_pos + arg_length; 116 117 if l_suff ^= 0 118 then do; 119 substr(string,pl1_stat_$char_pos,1) = NL; 120 pl1_stat_$char_pos = pl1_stat_$char_pos+1; 121 end; 122 123 return; 124 125 /* Entry to write string given by ptr into listing without nl */ 126 127 pl1_print$string_ptr: entry(pt,size); 128 129 dcl pt ptr; /* points at string */ 130 dcl based_string char(size) aligned based(pt); 131 132 l_suff = 0; 133 goto l3; 134 135 /* Entry to write string given by ptr into listing with nl */ 136 137 pl1_print$string_ptr_nl: entry(pt,size); 138 139 l_suff = 1; 140 141 l3: arg_length = size; 142 143 if arg_length + pl1_stat_$char_pos + l_suff > pl1_stat_$max_list_size 144 then signal condition(listing_overflow); 145 146 substr(string,pl1_stat_$char_pos,arg_length)=based_string; 147 148 goto done; 149 150 pl1_print$for_lex: 151 entry (bv_source_ptr, bv_line_number, bv_line_start, bv_line_length, bv_suppress_line_numbers, 152 bv_line_begins_in_comment); 153 154 /* parameters */ 155 156 declare ( bv_source_ptr ptr, 157 bv_line_number fixed bin (14), 158 bv_line_start fixed bin (21), 159 bv_line_length fixed bin (21), 160 bv_suppress_line_numbers bit (1) aligned, 161 bv_line_begins_in_comment bit (1) aligned 162 ) parameter; 163 164 /* automatic */ 165 166 declare line_number_string picture "zzzzzzzz9"; 167 168 /* external static */ 169 170 declare pl1_stat_$source_seg fixed bin (8) external static; 171 172 /* internal static */ 173 174 declare SPACE_FOR_LINE_NUMBERS_PLUS_ONE_BLANK fixed bin internal static options (constant) init (10); 175 176 /* program */ 177 178 /* A source program cannot be more than a single segment in length, but the 179* LISTING (including headers, incl. files, etc.) of the source can exceed 180* a single segment. Thus this check. We could do it in two parts (one for 181* the line number field, if we're not supressing them) and the other for 182* the actual line... but it's more efficient to only do the check once. 183* If we're going msf on the listing (which is guaranteed if we approach 184* msf in this phase) doing it a few characters early won't hurt. phx21284 */ 185 186 if pl1_stat_$char_pos + SPACE_FOR_LINE_NUMBERS_PLUS_ONE_BLANK 187 + bv_line_length >= pl1_stat_$max_list_size 188 then signal condition(listing_overflow); 189 190 191 if ^bv_suppress_line_numbers 192 then do; 193 line_number_string = bv_line_number; 194 substr (string, pl1_stat_$char_pos, 195 SPACE_FOR_LINE_NUMBERS_PLUS_ONE_BLANK) = line_number_string; /* move in digits + 1 blank */ 196 197 if pl1_stat_$source_seg > 0 198 then do; 199 line_number_string = pl1_stat_$source_seg; 200 substr (string, pl1_stat_$char_pos, 3) = substr (line_number_string, 7, 3); 201 end; 202 203 pl1_stat_$char_pos = pl1_stat_$char_pos + SPACE_FOR_LINE_NUMBERS_PLUS_ONE_BLANK; 204 205 if bv_line_begins_in_comment 206 then substr (string, pl1_stat_$char_pos - 1, 1) = "*"; 207 end; 208 209 substr (string, pl1_stat_$char_pos, bv_line_length) = substr (bv_source_ptr -> based_string, 210 bv_line_start, bv_line_length); 211 pl1_stat_$char_pos = pl1_stat_$char_pos + bv_line_length; 212 return; 213 214 /* Entry to write unaligned string avec new-line character into the listing segment */ 215 216 pl1_print$unaligned_nl: entry(unal_string,size); 217 218 dcl unal_string char(*) unaligned; 219 220 if size > 0 221 then arg_length = size; 222 else arg_length = length(unal_string); 223 224 if arg_length + pl1_stat_$char_pos >= pl1_stat_$max_list_size 225 then signal condition(listing_overflow); 226 227 substr(string,pl1_stat_$char_pos,arg_length) = unal_string; 228 229 l_suff = 1; 230 goto done; 231 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 10/06/92 0040.6 pl1_print.pl1 >spec>inst>1023>pl1_print.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 constant char(1) initial dcl 67 ref 119 SPACE_FOR_LINE_NUMBERS_PLUS_ONE_BLANK constant fixed bin(17,0) initial dcl 174 ref 186 194 203 arg_length 000101 automatic fixed bin(21,0) dcl 44 set ref 83* 85 88 107* 109* 111 113 115 141* 143 146 220* 222* 224 227 based_string based char dcl 130 ref 146 209 bv_line_begins_in_comment parameter bit(1) dcl 156 ref 150 205 bv_line_length parameter fixed bin(21,0) dcl 156 ref 150 186 209 209 211 bv_line_number parameter fixed bin(14,0) dcl 156 ref 150 193 bv_line_start parameter fixed bin(21,0) dcl 156 ref 150 209 bv_source_ptr parameter pointer dcl 156 ref 150 209 bv_suppress_line_numbers parameter bit(1) dcl 156 ref 150 191 l_suff 000100 automatic fixed bin(17,0) dcl 44 set ref 74* 81* 85 98* 105* 111 117 132* 139* 143 229* length builtin function dcl 53 ref 83 109 222 line_number_string 000110 automatic picture(9) packed unaligned dcl 166 set ref 193* 194 199* 200 listing_overflow 000102 stack reference condition dcl 57 ref 85 111 143 186 224 nv_string parameter char dcl 95 ref 93 103 109 113 pl1_stat_$char_pos 000014 external static fixed bin(21,0) dcl 61 set ref 85 88 111 113 115* 115 119 120* 120 143 146 186 194 200 203* 203 205 209 211* 211 224 227 pl1_stat_$list_ptr 000010 external static pointer dcl 61 ref 88 113 119 146 194 200 205 209 227 pl1_stat_$max_list_size 000012 external static fixed bin(21,0) dcl 61 ref 85 111 143 186 224 pl1_stat_$source_seg 000016 external static fixed bin(8,0) dcl 170 ref 197 199 pt parameter pointer dcl 129 ref 127 137 146 size parameter fixed bin(35,0) dcl 95 ref 93 103 107 107 127 137 141 146 209 216 220 220 string based char(261120) dcl 49 set ref 88* 113* 119* 146* 194* 200* 205* 209* 227* substr builtin function dcl 53 set ref 88* 113* 119* 146* 194* 200* 200 205* 209* 209 227* unal_string parameter char packed unaligned dcl 218 ref 216 222 227 var_string parameter varying char dcl 40 ref 36 79 83 88 NAMES DECLARED BY EXPLICIT CONTEXT. done 000203 constant label dcl 115 ref 89 148 230 l1 000053 constant label dcl 83 set ref 75 l2 000146 constant label dcl 107 ref 99 l3 000244 constant label dcl 141 ref 133 pl1_print$for_lex 000305 constant entry external dcl 150 pl1_print$non_varying 000112 constant entry external dcl 93 pl1_print$non_varying_nl 000131 constant entry external dcl 103 pl1_print$string_ptr 000224 constant entry external dcl 127 pl1_print$string_ptr_nl 000235 constant entry external dcl 137 pl1_print$unaligned_nl 000423 constant entry external dcl 216 pl1_print$varying 000017 constant entry external dcl 36 pl1_print$varying_nl 000036 constant entry external dcl 79 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 744 764 476 754 Length 1166 476 20 166 245 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME pl1_print$varying 79 external procedure is an external procedure. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME pl1_print$varying 000100 l_suff pl1_print$varying 000101 arg_length pl1_print$varying 000110 line_number_string pl1_print$varying THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. return_mac signal_op ext_entry ext_entry_desc NO EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. pl1_stat_$char_pos pl1_stat_$list_ptr pl1_stat_$max_list_size pl1_stat_$source_seg LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 36 000014 74 000032 75 000033 79 000034 81 000051 83 000053 85 000057 88 000067 89 000105 93 000106 98 000125 99 000126 103 000127 105 000144 107 000146 109 000153 111 000155 113 000165 115 000203 117 000206 119 000210 120 000216 123 000217 127 000220 132 000231 133 000232 137 000233 139 000242 141 000244 143 000247 146 000257 148 000276 150 000277 186 000312 191 000324 193 000330 194 000340 197 000347 199 000351 200 000361 203 000365 205 000367 209 000376 211 000414 212 000416 216 000417 220 000436 222 000443 224 000445 227 000454 229 000472 230 000474 ----------------------------------------------------------- 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