COMPILATION LISTING OF SEGMENT format_pl1_record_style_ Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell Multics Op. - System M Compiled on: 08/10/84 0947.8 mst Fri Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 /* Write a prevailing style control comment into the output segment. 12* 13* Written 5-Nov-79 by M. N. Davidoff. 14**/ 15 /* format: style5 */ 16 format_pl1_record_style_: 17 procedure (P_temp_segs, P_copy_position, P_line_position); 18 19 declare P_temp_segs (*) pointer; /* (Input) array of temporary segment pointers */ 20 declare P_copy_position fixed binary (21); 21 /* (Input/Output) output segment index of next character */ 22 declare P_line_position fixed binary; /* (Input/Output) column next character will be in */ 23 24 /* builtin */ 25 26 declare (convert, divide, hbound, lbound, length, ltrim, rtrim, size, 27 substr) builtin; 28 29 /* internal static */ 30 31 declare NL char (1) internal static 32 options (constant) initial (" 33 "); 34 declare SP char (1) internal static 35 options (constant) initial (""); 36 1 1 /* BEGIN INCLUDE FILE . . . format_pl1_dcls.incl.pl1 */ 1 2 1 3 /* DESCRIPTION: 1 4* This include file contains common definitions used by the format_pl1 1 5* programs. It defines tokens, statement types, mode types, etc. 1 6**/ 1 7 1 8 /* HISTORY: 1 9*Written by somebody, sometime. 1 10*Modified: 1 11*07/15/84 by R. Michael Tague: Added the statement types: 1 12* percent_abort_statement through percent_warn_statement. Added 1 13* the condition is_macro_whitespace. Added the modes: mode_indbegin, 1 14* mode_indbeginend, mode_indthenbegin, mode_indthenbeginend, 1 15* mode_indprocbody, mode_elsestmt, mode_equalind, and mode_linconind. 1 16* Added style5. 1 17**/ 1 18 1 19 /* format: style5 */ 1 20 1 21 /* automatic */ 1 22 1 23 declare temp_segs (4) pointer; 1 24 1 25 /* based */ 1 26 1 27 /* format_pl1_ places the unit_stack and the declare_stack after the token array */ 1 28 1 29 declare 1 token (divide (sys_info$max_seg_size, 3, 19)) 1 30 aligned based (temp_segs (1)), 1 31 2 string_size fixed binary (21) unaligned, 1 32 2 pad bit (5) unaligned, 1 33 2 type fixed binary (8) unaligned, 1 34 2 string_ptr pointer unaligned, 1 35 2 trailer_index fixed binary (17); 1 36 1 37 declare 1 trailer (divide (sys_info$max_seg_size, 2, 19)) 1 38 aligned based (temp_segs (2)), 1 39 2 string_size fixed binary (21) unaligned, 1 40 2 continued bit (1) unaligned, 1 41 2 pad bit (4) unaligned, 1 42 2 type fixed binary (8) unaligned, 1 43 2 string_ptr pointer unaligned; 1 44 1 45 /* format_pl1_ places the item array and the levels array after the stmt array */ 1 46 1 47 declare 1 global_header aligned based, 1 48 2 source_ptr pointer, 1 49 2 source_length fixed binary (21), 1 50 2 n_tokens fixed binary (17), 1 51 2 n_trailers fixed binary (17), 1 52 2 n_stmts fixed binary (17), 1 53 2 output_length fixed binary (21), 1 54 2 max_severity fixed binary (35), 1 55 2 modes_ptr pointer, 1 56 2 modes_length fixed binary (21), 1 57 2 ca unaligned, 1 58 3 check_comments bit (1), 1 59 3 check_strings bit (1), 1 60 3 force bit (1), 1 61 3 long bit (1), 1 62 3 record_style bit (1), 1 63 3 require_style_comment 1 64 bit (1), 1 65 2 flags unaligned, 1 66 3 include_file bit (1), 1 67 3 rdc_source bit (1), 1 68 3 pad bit (28), 1 69 2 command_line_style aligned like style, 1 70 2 prevailing_style aligned like style, 1 71 2 current_style aligned like style; 1 72 1 73 declare 1 global aligned based (temp_segs (3)), 1 74 2 header aligned like global_header, 1 75 2 stmt ( 1 76 divide (sys_info$max_seg_size 1 77 - size (global_header), 2, 19)), 1 78 3 type fixed binary (8) unaligned, 1 79 3 subtype fixed binary (8) unaligned, 1 80 3 start fixed binary (17) unaligned, 1 81 3 end fixed binary (17) unaligned, 1 82 3 pad bit (18) unaligned; 1 83 1 84 declare output_string char (4 * sys_info$max_seg_size) 1 85 based (temp_segs (4)); 1 86 1 87 /* internal static */ 1 88 1 89 declare command char (10) internal static 1 90 options (constant) initial ("format_pl1"); 1 91 1 92 /* token types */ 1 93 1 94 declare ( 1 95 no_token initial (0), 1 96 invalid_char initial (1), 1 97 identifier initial (2), 1 98 keyword_token initial (3), 1 99 isub initial (4), 1 100 plus initial (5), 1 101 minus initial (6), 1 102 asterisk initial (7), 1 103 slash initial (8), 1 104 expon initial (9), 1 105 not initial (10), 1 106 and initial (11), 1 107 or initial (12), 1 108 cat initial (13), 1 109 eq initial (14), 1 110 ne initial (15), 1 111 lt initial (16), 1 112 gt initial (17), 1 113 le initial (18), 1 114 ge initial (19), 1 115 ngt initial (20), 1 116 nlt initial (21), 1 117 prefix_plus initial (22), 1 118 prefix_minus initial (23), 1 119 assignment initial (24), 1 120 colon initial (25), 1 121 semi_colon initial (26), 1 122 comma initial (27), 1 123 period initial (28), 1 124 arrow initial (29), 1 125 left_parn initial (30), 1 126 right_parn initial (31), 1 127 percent initial (32), 1 128 target_comma initial (33), 1 129 comment_token initial (34), 1 130 nl_vt_np_token initial (35), 1 131 bit_string initial (36), 1 132 char_string initial (37), 1 133 fixed_bin initial (38), 1 134 bin_integer initial (39), 1 135 fixed_dec initial (40), 1 136 dec_integer initial (41), 1 137 float_bin initial (42), 1 138 token_hole_1 initial (43), 1 139 float_dec initial (44), 1 140 token_hole_2 initial (45), 1 141 i_fixed_bin initial (46), 1 142 i_bin_integer initial (47), 1 143 i_fixed_dec initial (48), 1 144 i_dec_integer initial (49), 1 145 i_float_bin initial (50), 1 146 token_hole_3 initial (51), 1 147 i_float_dec initial (52), 1 148 token_hole_4 initial (53) 1 149 ) fixed binary (8) internal static 1 150 options (constant); 1 151 1 152 /* token class limits */ 1 153 1 154 declare ( 1 155 min_delimiter_token initial (5), 1 156 max_delimiter_token initial (35), 1 157 min_constant_token initial (36), 1 158 max_constant_token initial (53), 1 159 min_arithmetic_token initial (38), 1 160 max_arithmetic_token initial (53) 1 161 ) fixed binary (8) internal static 1 162 options (constant); 1 163 1 164 /* arithmetic token type masks */ 1 165 1 166 declare ( 1 167 is_imaginary_constant initial ("1000"b), 1 168 is_float_constant initial ("0100"b), 1 169 is_decimal_constant initial ("0010"b), 1 170 is_integral_constant initial ("0001"b) 1 171 ) bit (4) aligned internal static 1 172 options (constant); 1 173 1 174 /* lexical limits */ 1 175 1 176 declare ( 1 177 max_bit_string_constant initial (253), 1 178 max_char_string_constant 1 179 initial (254), 1 180 max_identifier_length initial (256) 1 181 ) fixed binary internal static options (constant); 1 182 1 183 /* statement types */ 1 184 1 185 declare ( 1 186 unknown_statement initial (0), 1 187 allocate_statement initial (1), 1 188 assignment_statement initial (2), 1 189 begin_statement initial (3), 1 190 call_statement initial (4), 1 191 close_statement initial (5), 1 192 declare_statement initial (6), 1 193 lock_statement initial (7), 1 194 delete_statement initial (8), 1 195 display_statement initial (9), 1 196 do_statement initial (10), 1 197 else_clause initial (11), 1 198 end_statement initial (12), 1 199 entry_statement initial (13), 1 200 exit_statement initial (14), 1 201 format_statement initial (15), 1 202 free_statement initial (16), 1 203 get_statement initial (17), 1 204 goto_statement initial (18), 1 205 if_statement initial (19), 1 206 locate_statement initial (20), 1 207 null_statement initial (21), 1 208 on_statement initial (22), 1 209 open_statement initial (23), 1 210 procedure_statement initial (24), 1 211 put_statement initial (25), 1 212 read_statement initial (26), 1 213 return_statement initial (27), 1 214 revert_statement initial (28), 1 215 rewrite_statement initial (29), 1 216 signal_statement initial (30), 1 217 stop_statement initial (31), 1 218 system_on_unit initial (32), 1 219 unlock_statement initial (33), 1 220 wait_statement initial (34), 1 221 write_statement initial (35), 1 222 default_statement initial (36), 1 223 condition_prefix_list initial (37), 1 224 label_prefix_list initial (38), 1 225 percent_statement initial (39), 1 226 percent_abort_statement initial (40), 1 227 percent_default_statement 1 228 initial (41), 1 229 percent_else_statement initial (42), 1 230 percent_elseif_statement 1 231 initial (43), 1 232 percent_endif_statement initial (44), 1 233 percent_error_statement initial (45), 1 234 percent_if_statement initial (46), 1 235 percent_include_statement 1 236 initial (47), 1 237 percent_page_statement initial (48), 1 238 percent_print_statement initial (49), 1 239 percent_replace_statement 1 240 initial (50), 1 241 percent_set_statement initial (51), 1 242 percent_skip_statement initial (52), 1 243 percent_warn_statement initial (53) 1 244 ) fixed binary (8) internal static 1 245 options (constant); 1 246 1 247 declare is_independent_statement 1 248 (0:53) bit (1) aligned internal static 1 249 options (constant) 1 250 initial ("0"b, (2) (1)"1"b, "0"b, (2) (1)"1"b, 1 251 "0"b, (3) (1)"1"b, (4) (1)"0"b, "1"b, "0"b, 1 252 (8) (1)"1"b, "0"b, (11) (1)"1"b, (18) (1)"0"b); 1 253 1 254 declare is_macro_statement (0:53) bit (1) aligned internal static 1 255 options (constant) 1 256 initial ((39) (1)"0"b, (15) (1)"1"b); 1 257 1 258 declare is_macro_whitespace (0:53) bit (1) aligned internal static 1 259 options (constant) 1 260 initial ((39) (1)"0"b, (3) (1)"1"b, (3) (1)"0"b, 1 261 "1"b, "0"b, (7) (1)"1"b); 1 262 1 263 /* statement subtypes */ 1 264 1 265 declare ( 1 266 subtype_none initial (0), 1 267 subtype_noniterative_do initial (1) 1 268 ) fixed binary (8) internal static 1 269 options (constant); 1 270 1 271 /* style structures and constants */ 1 272 1 273 declare 1 style aligned based, 1 274 2 switches (26) bit (1) unaligned, 1 275 2 pad bit (10) unaligned, 1 276 2 values (10) fixed binary; 1 277 1 278 /* named modes for format_pl1_ */ 1 279 1 280 declare ( 1 281 mode_on defined (global.current_style.switches (1)), 1 282 mode_inddcls defined (global.current_style.switches (2)), 1 283 mode_delnl defined (global.current_style.switches (3)), 1 284 mode_insnl defined (global.current_style.switches (4)), 1 285 mode_indattr defined (global.current_style.switches (5)), 1 286 mode_linecom defined (global.current_style.switches (6)), 1 287 mode_case defined (global.current_style.switches (7)), 1 288 mode_ifthenstmt defined (global.current_style.switches (8)), 1 289 mode_ifthendo defined (global.current_style.switches (9)), 1 290 mode_ifthen defined (global.current_style.switches (10)), 1 291 mode_indthenelse defined (global.current_style.switches (11)), 1 292 mode_indnoniterdo defined (global.current_style.switches (12)), 1 293 mode_indnoniterend defined (global.current_style.switches (13)), 1 294 mode_indcomtxt defined (global.current_style.switches (14)), 1 295 mode_thendo defined (global.current_style.switches (15)), 1 296 mode_inditerdo defined (global.current_style.switches (16)), 1 297 mode_indend defined (global.current_style.switches (17)), 1 298 mode_indproc defined (global.current_style.switches (18)), 1 299 mode_indcom defined (global.current_style.switches (19)), 1 300 mode_indblkcom defined (global.current_style.switches (20)), 1 301 mode_indbegin defined (global.current_style.switches (21)), 1 302 mode_indbeginend defined (global.current_style.switches (22)), 1 303 mode_indthenbegin defined (global.current_style.switches (23)), 1 304 mode_indthenbeginend defined (global.current_style.switches (24)), 1 305 mode_indprocbody defined (global.current_style.switches (25)), 1 306 mode_elsestmt defined (global.current_style.switches (26)) 1 307 ) bit (1); 1 308 1 309 declare ( 1 310 mode_ind defined (global.current_style.values (1)), 1 311 mode_ll defined (global.current_style.values (2)), 1 312 mode_initcol defined (global.current_style.values (3)), 1 313 mode_declareind defined (global.current_style.values (4)), 1 314 mode_dclind defined (global.current_style.values (5)), 1 315 mode_idind defined (global.current_style.values (6)), 1 316 mode_struclvlind defined (global.current_style.values (7)), 1 317 mode_comcol defined (global.current_style.values (8)), 1 318 mode_equalind defined (global.current_style.values (9)), 1 319 mode_lineconind defined (global.current_style.values (10)) 1 320 ) fixed binary; 1 321 1 322 /* mode names */ 1 323 1 324 declare switch_mode_names (26) char (15) internal static 1 325 options (constant) 1 326 initial ("on", "inddcls", "delnl", "insnl", 1 327 "indattr", "linecom", "case", "ifthenstmt", 1 328 "ifthendo", "ifthen", "indthenelse", 1 329 "indnoniterdo", "indnoniterend", "indcomtxt", 1 330 "thendo", "inditerdo", "indend", "indproc", 1 331 "indcom", "indblkcom", "indbegin", 1 332 "indbeginend", "indthenbegin", 1 333 "indthenbeginend", "indprocbody", "elsestmt"); 1 334 1 335 declare switch_antonym_names (26) char (4) internal static 1 336 options (constant) 1 337 initial ("off", (5) (1)"", "tree", (19) (1)""); 1 338 1 339 declare value_mode_names (10) char (12) internal static 1 340 options (constant) 1 341 initial ("ind", "ll", "initcol", "declareind", 1 342 "dclind", "idind", "struclvlind", "comcol", 1 343 "equalind", "lineconind"); 1 344 1 345 /* predefined styles */ 1 346 1 347 /* style1: on,inddcls,^delnl,^insnl,indattr,^linecom,case,^ifthenstmt,^ifthendo,^ifthen,^indthenelse,indnoniterdo, 1 348* ^indnoniterend,^indcomtxt,^thendo,inditerdo,^indend,^indproc,^indcom,indblkcom,indbegin,^indbeginend,indthenbegin,^indthenbeginend,indprocbody,elsestmt,ind5,ll122,initcol6,declareind8, 1 349* dclind8,idind23,struclvlind2,comcol61,equalind0,lineconind5 1 350* style2: style1,delnl,insnl 1 351* style3: style2,^inddcls,declareind10,dclind10,idind20 1 352* style4: style1,^inddcls,^indattr,linecom,ifthendo,^indnoniterdo,indcomtxt,^inditerdo,indproc,^indthenbegin,declareind9,dclind5 1 353* style5: style2,linecom,ifthen,^indnoniterdo,indnoniterend,indcomtxt,^indthenbegin,indthenbeginend,^indprocbody,^elsestmt,ind8,ll80,initcol0,idind24,comcol57,lineconind4 1 354* 1 355* 1 356**/ 1 357 1 358 declare 1 styles (5) aligned internal static options (constant), 1 359 2 switches (26) bit (1) unaligned 1 360 initial ("1"b, "1"b, "0"b, "0"b, "1"b, "0"b, 1 361 "1"b, "0"b, "0"b, "0"b, "0"b, "1"b, "0"b, "0"b, 1 362 "0"b, "1"b, "0"b, "0"b, "0"b, "1"b, "1"b, "0"b, 1 363 "1"b, "0"b, "1"b, "1"b, /* style1 */ 1 364 "1"b, "1"b, "1"b, "1"b, "1"b, "0"b, "1"b, "0"b, 1 365 "0"b, "0"b, "0"b, "1"b, "0"b, "0"b, "0"b, "1"b, 1 366 "0"b, "0"b, "0"b, "1"b, "1"b, "0"b, "1"b, "0"b, 1 367 "1"b, "1"b, /* style2 */ 1 368 "1"b, "0"b, "1"b, "1"b, "1"b, "0"b, "1"b, "0"b, 1 369 "0"b, "0"b, "0"b, "1"b, "0"b, "0"b, "0"b, "1"b, 1 370 "0"b, "0"b, "0"b, "1"b, "1"b, "0"b, "1"b, "0"b, 1 371 "1"b, "1"b, /* style3 */ 1 372 "1"b, "0"b, "0"b, "0"b, "0"b, "1"b, "1"b, "0"b, 1 373 "1"b, "0"b, "0"b, "0"b, "0"b, "1"b, "0"b, "0"b, 1 374 "0"b, "1"b, "0"b, "1"b, "1"b, "0"b, "0"b, "0"b, 1 375 "1"b, "1"b, /* style4 */ 1 376 "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "1"b, "0"b, 1 377 "0"b, "1"b, "0"b, "0"b, "1"b, "1"b, "0"b, "1"b, 1 378 "0"b, "0"b, "0"b, "1"b, "1"b, "0"b, "0"b, "1"b, 1 379 "0"b, "0"b), /* style5 */ 1 380 2 pad bit (10) unaligned initial ((5) (1)""b), 1 381 2 values (10) fixed binary 1 382 initial (5, 122, 6, 8, 8, 23, 2, 61, 0, 5, 1 383 /* style1 */ 1 384 5, 122, 6, 8, 8, 23, 2, 61, 0, 5, 1 385 /* style2 */ 1 386 5, 122, 6, 10, 10, 20, 2, 61, 0, 5, 1 387 /* style3 */ 1 388 5, 122, 6, 9, 5, 23, 2, 61, 0, 5, 1 389 /* style4 */ 1 390 8, 80, 1, 8, 8, 24, 2, 57, 0, 4); 1 391 /* style5 */ 1 392 1 393 /* control comment constants */ 1 394 1 395 declare control_comment_indicator 1 396 char (7) internal static 1 397 options (constant) initial ("format:"); 1 398 declare mode_separator char (1) internal static 1 399 options (constant) initial (","); 1 400 declare revert_mode char (6) internal static 1 401 options (constant) initial ("revert"); 1 402 declare style_mode char (5) internal static 1 403 options (constant) initial ("style"); 1 404 declare switch_mode_not_indicator 1 405 char (1) internal static 1 406 options (constant) initial ("^"); 1 407 1 408 /* if statement control comments */ 1 409 1 410 declare case_control_comment char (10) internal static 1 411 options (constant) initial ("/* case */"); 1 412 declare tree_control_comment char (10) internal static 1 413 options (constant) initial ("/* tree */"); 1 414 1 415 /* comment indicator constants */ 1 416 1 417 declare comment_indicator_extra_chars 1 418 char (3) internal static 1 419 options (constant) initial ((3)"*"); 1 420 declare comment_indicator_no_indcomtxt 1 421 char (1) internal static 1 422 options (constant) initial ("^"); 1 423 1 424 /* external static */ 1 425 1 426 declare sys_info$max_seg_size fixed binary (19) external static; 1 427 1 428 /* entry */ 1 429 1 430 declare format_pl1_lex_ entry ((*) pointer); 1 431 declare format_pl1_stmt_type_ entry ((*) pointer); 1 432 declare format_pl1_ entry ((*) pointer); 1 433 declare format_pl1_modes_ entry ((*) pointer, char (*), pointer, bit (1), 1 434 bit (1)); 1 435 declare format_pl1_record_style_ 1 436 entry ((*) pointer, fixed binary (21), 1 437 fixed binary); 1 438 declare format_pl1_long_ entry ((*) pointer, pointer); 1 439 declare format_pl1_error_ entry ((*) pointer, fixed binary (35), char (*), 1 440 pointer); 1 441 1 442 /* END INCLUDE FILE . . . format_pl1_dcls.incl.pl1 */ 37 38 39 /* program */ 40 41 temp_segs (*) = P_temp_segs (*); 42 43 call record_style (get_nearest_style ()); 44 45 return; 46 47 /* Find the predefined style closest to the prevailing style. */ 48 49 get_nearest_style: 50 procedure returns (fixed binary); 51 52 declare differences fixed binary; 53 declare fewest_differences fixed binary; 54 declare nearest_style fixed binary; 55 declare style_index fixed binary; 56 57 nearest_style = lbound (styles, 1); 58 fewest_differences = count_differences (nearest_style); 59 do style_index = lbound (styles, 1) + 1 to hbound (styles, 1); 60 differences = count_differences (style_index); 61 if differences < fewest_differences then 62 do; 63 fewest_differences = differences; 64 nearest_style = style_index; 65 end; 66 end; 67 68 return (nearest_style); 69 70 /* Count how many modes are different between a predefined style and the prevailing style. */ 71 72 count_differences: 73 procedure (style_index) returns (fixed binary); 74 75 declare style_index fixed binary; /* (Input) predefined style number */ 76 77 declare differences fixed binary; 78 declare mode_index fixed binary; 79 80 differences = 0; 81 82 do mode_index = lbound (global.prevailing_style.switches, 1) 83 to hbound (global.prevailing_style.switches, 1); 84 if global.prevailing_style.switches (mode_index) 85 ^= styles (style_index).switches (mode_index) then 86 differences = differences + 1; 87 end; 88 89 do mode_index = lbound (global.prevailing_style.values, 1) 90 to hbound (global.prevailing_style.values, 1); 91 if global.prevailing_style.values (mode_index) 92 ^= styles (style_index).values (mode_index) then 93 differences = differences + 1; 94 end; 95 96 return (differences); 97 end count_differences; 98 99 end get_nearest_style; 100 101 /* Write the prevailing style control comment. */ 102 103 record_style: 104 procedure (nearest_style); 105 106 declare nearest_style fixed binary; /* (Input) predefined style closest to the prevailing style */ 107 108 declare mode_index fixed binary; 109 110 declare value_picture picture "(5)z9" based; 111 112 if P_line_position > 1 then 113 do; 114 call copy_string (NL); 115 P_line_position = 1; 116 end; 117 118 call copy_string ("/*" || SP || control_comment_indicator || SP 119 || style_mode || ltrim (convert (value_picture, nearest_style))); 120 121 do mode_index = lbound (global.prevailing_style.switches, 1) 122 to hbound (global.prevailing_style.switches, 1); 123 if global.prevailing_style.switches (mode_index) 124 ^= styles (nearest_style).switches (mode_index) then 125 do; 126 call copy_string (mode_separator); 127 128 if ^global.prevailing_style.switches (mode_index) then 129 if switch_antonym_names (mode_index) = "" then 130 call copy_string ( 131 switch_mode_not_indicator 132 || 133 rtrim ( 134 switch_mode_names (mode_index))); 135 136 else 137 call copy_string ( 138 rtrim ( 139 switch_antonym_names (mode_index))); 140 141 else 142 call copy_string ( 143 rtrim (switch_mode_names (mode_index))); 144 end; 145 end; 146 147 do mode_index = lbound (global.prevailing_style.values, 1) 148 to hbound (global.prevailing_style.values, 1); 149 if global.prevailing_style.values (mode_index) 150 ^= styles (nearest_style).values (mode_index) then 151 call copy_string (mode_separator 152 || rtrim (value_mode_names (mode_index)) 153 || 154 ltrim ( 155 convert (value_picture, 156 global.prevailing_style.values (mode_index)))); 157 end; 158 159 call copy_string (SP || "*/" || NL); 160 161 return; 162 163 /* Copy a string into the output segment. */ 164 165 copy_string: 166 procedure (string); 167 168 declare string char (*); /* (Input) string to copy into the output segment */ 169 170 substr (output_string, P_copy_position, length (string)) = string; 171 P_copy_position = P_copy_position + length (string); 172 end copy_string; 173 174 end record_style; 175 176 end format_pl1_record_style_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 08/10/84 0947.2 format_pl1_record_style_.pl1 >special_ldd>on>6896>format_pl1_record_style_.pl1 37 1 08/09/84 1141.5 format_pl1_dcls.incl.pl1 >special_ldd>on>6896>format_pl1_dcls.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. NL 000330 constant char(1) initial unaligned dcl 31 set ref 114* 159 P_copy_position parameter fixed bin(21,0) dcl 20 set ref 16 170 171* 171 P_line_position parameter fixed bin(17,0) dcl 22 set ref 16 112 115* P_temp_segs parameter pointer array dcl 19 ref 16 41 SP 001277 constant char(1) initial unaligned dcl 34 ref 118 118 159 control_comment_indicator 000074 constant char(7) initial unaligned dcl 1-395 ref 118 convert builtin function dcl 26 ref 118 149 differences 000132 automatic fixed bin(17,0) dcl 77 in procedure "count_differences" set ref 80* 84* 84 91* 91 96 differences 000120 automatic fixed bin(17,0) dcl 52 in procedure "get_nearest_style" set ref 60* 61 63 fewest_differences 000121 automatic fixed bin(17,0) dcl 53 set ref 58* 61 63* global based structure level 1 dcl 1-73 global_header based structure level 1 dcl 1-47 hbound builtin function dcl 26 ref 59 82 89 121 147 header based structure level 2 dcl 1-73 lbound builtin function dcl 26 ref 57 59 82 89 121 147 length builtin function dcl 26 ref 170 171 ltrim builtin function dcl 26 ref 118 149 mode_index 000142 automatic fixed bin(17,0) dcl 108 in procedure "record_style" set ref 121* 123 123 128 128 128 136 136 141 141* 147* 149 149 149 149* mode_index 000133 automatic fixed bin(17,0) dcl 78 in procedure "count_differences" set ref 82* 84 84* 89* 91 91* mode_separator 000072 constant char(1) initial unaligned dcl 1-398 set ref 126* 149 nearest_style parameter fixed bin(17,0) dcl 106 in procedure "record_style" ref 103 118 123 149 nearest_style 000122 automatic fixed bin(17,0) dcl 54 in procedure "get_nearest_style" set ref 57* 58* 64* 68 output_string based char unaligned dcl 1-84 set ref 170* prevailing_style 27 based structure level 3 dcl 1-73 rtrim builtin function dcl 26 ref 128 136 136 141 141 149 string parameter char unaligned dcl 168 ref 165 170 170 171 style based structure level 1 dcl 1-273 style_index parameter fixed bin(17,0) dcl 75 in procedure "count_differences" ref 72 84 91 style_index 000123 automatic fixed bin(17,0) dcl 55 in procedure "get_nearest_style" set ref 59* 60* 64* style_mode 000070 constant char(5) initial unaligned dcl 1-402 ref 118 styles 000000 constant structure array level 1 dcl 1-358 ref 57 59 59 substr builtin function dcl 26 set ref 170* switch_antonym_names 000134 constant char(4) initial array unaligned dcl 1-335 ref 128 136 136 switch_mode_names 000166 constant char(15) initial array unaligned dcl 1-324 ref 128 141 141 switch_mode_not_indicator 001276 constant char(1) initial unaligned dcl 1-404 ref 128 switches 27 based bit(1) array level 4 in structure "global" packed unaligned dcl 1-73 in procedure "format_pl1_record_style_" ref 82 82 84 121 121 123 128 switches 000000 constant bit(1) initial array level 2 in structure "styles" packed unaligned dcl 1-358 in procedure "format_pl1_record_style_" ref 84 123 sys_info$max_seg_size 000010 external static fixed bin(19,0) dcl 1-426 ref 170 temp_segs 000100 automatic pointer array dcl 1-23 set ref 41* 82 82 84 89 89 91 121 121 123 128 147 147 149 149 170 value_mode_names 000076 constant char(12) initial array unaligned dcl 1-339 ref 149 value_picture based picture(6) unaligned dcl 110 ref 118 149 values 30 based fixed bin(17,0) array level 4 in structure "global" dcl 1-73 in procedure "format_pl1_record_style_" ref 89 89 91 147 147 149 149 values 1 000000 constant fixed bin(17,0) initial array level 2 in structure "styles" dcl 1-358 in procedure "format_pl1_record_style_" ref 91 149 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. allocate_statement internal static fixed bin(8,0) initial dcl 1-185 and internal static fixed bin(8,0) initial dcl 1-94 arrow internal static fixed bin(8,0) initial dcl 1-94 assignment internal static fixed bin(8,0) initial dcl 1-94 assignment_statement internal static fixed bin(8,0) initial dcl 1-185 asterisk internal static fixed bin(8,0) initial dcl 1-94 begin_statement internal static fixed bin(8,0) initial dcl 1-185 bin_integer internal static fixed bin(8,0) initial dcl 1-94 bit_string internal static fixed bin(8,0) initial dcl 1-94 call_statement internal static fixed bin(8,0) initial dcl 1-185 case_control_comment internal static char(10) initial unaligned dcl 1-410 cat internal static fixed bin(8,0) initial dcl 1-94 char_string internal static fixed bin(8,0) initial dcl 1-94 close_statement internal static fixed bin(8,0) initial dcl 1-185 colon internal static fixed bin(8,0) initial dcl 1-94 comma internal static fixed bin(8,0) initial dcl 1-94 command internal static char(10) initial unaligned dcl 1-89 comment_indicator_extra_chars internal static char(3) initial unaligned dcl 1-417 comment_indicator_no_indcomtxt internal static char(1) initial unaligned dcl 1-420 comment_token internal static fixed bin(8,0) initial dcl 1-94 condition_prefix_list internal static fixed bin(8,0) initial dcl 1-185 dec_integer internal static fixed bin(8,0) initial dcl 1-94 declare_statement internal static fixed bin(8,0) initial dcl 1-185 default_statement internal static fixed bin(8,0) initial dcl 1-185 delete_statement internal static fixed bin(8,0) initial dcl 1-185 display_statement internal static fixed bin(8,0) initial dcl 1-185 divide builtin function dcl 26 do_statement internal static fixed bin(8,0) initial dcl 1-185 else_clause internal static fixed bin(8,0) initial dcl 1-185 end_statement internal static fixed bin(8,0) initial dcl 1-185 entry_statement internal static fixed bin(8,0) initial dcl 1-185 eq internal static fixed bin(8,0) initial dcl 1-94 exit_statement internal static fixed bin(8,0) initial dcl 1-185 expon internal static fixed bin(8,0) initial dcl 1-94 fixed_bin internal static fixed bin(8,0) initial dcl 1-94 fixed_dec internal static fixed bin(8,0) initial dcl 1-94 float_bin internal static fixed bin(8,0) initial dcl 1-94 float_dec internal static fixed bin(8,0) initial dcl 1-94 format_pl1_ 000000 constant entry external dcl 1-432 format_pl1_error_ 000000 constant entry external dcl 1-439 format_pl1_lex_ 000000 constant entry external dcl 1-430 format_pl1_long_ 000000 constant entry external dcl 1-438 format_pl1_modes_ 000000 constant entry external dcl 1-433 format_pl1_record_style_ 000000 constant entry external dcl 1-435 format_pl1_stmt_type_ 000000 constant entry external dcl 1-431 format_statement internal static fixed bin(8,0) initial dcl 1-185 free_statement internal static fixed bin(8,0) initial dcl 1-185 ge internal static fixed bin(8,0) initial dcl 1-94 get_statement internal static fixed bin(8,0) initial dcl 1-185 goto_statement internal static fixed bin(8,0) initial dcl 1-185 gt internal static fixed bin(8,0) initial dcl 1-94 i_bin_integer internal static fixed bin(8,0) initial dcl 1-94 i_dec_integer internal static fixed bin(8,0) initial dcl 1-94 i_fixed_bin internal static fixed bin(8,0) initial dcl 1-94 i_fixed_dec internal static fixed bin(8,0) initial dcl 1-94 i_float_bin internal static fixed bin(8,0) initial dcl 1-94 i_float_dec internal static fixed bin(8,0) initial dcl 1-94 identifier internal static fixed bin(8,0) initial dcl 1-94 if_statement internal static fixed bin(8,0) initial dcl 1-185 invalid_char internal static fixed bin(8,0) initial dcl 1-94 is_decimal_constant internal static bit(4) initial dcl 1-166 is_float_constant internal static bit(4) initial dcl 1-166 is_imaginary_constant internal static bit(4) initial dcl 1-166 is_independent_statement internal static bit(1) initial array dcl 1-247 is_integral_constant internal static bit(4) initial dcl 1-166 is_macro_statement internal static bit(1) initial array dcl 1-254 is_macro_whitespace internal static bit(1) initial array dcl 1-258 isub internal static fixed bin(8,0) initial dcl 1-94 keyword_token internal static fixed bin(8,0) initial dcl 1-94 label_prefix_list internal static fixed bin(8,0) initial dcl 1-185 le internal static fixed bin(8,0) initial dcl 1-94 left_parn internal static fixed bin(8,0) initial dcl 1-94 locate_statement internal static fixed bin(8,0) initial dcl 1-185 lock_statement internal static fixed bin(8,0) initial dcl 1-185 lt internal static fixed bin(8,0) initial dcl 1-94 max_arithmetic_token internal static fixed bin(8,0) initial dcl 1-154 max_bit_string_constant internal static fixed bin(17,0) initial dcl 1-176 max_char_string_constant internal static fixed bin(17,0) initial dcl 1-176 max_constant_token internal static fixed bin(8,0) initial dcl 1-154 max_delimiter_token internal static fixed bin(8,0) initial dcl 1-154 max_identifier_length internal static fixed bin(17,0) initial dcl 1-176 min_arithmetic_token internal static fixed bin(8,0) initial dcl 1-154 min_constant_token internal static fixed bin(8,0) initial dcl 1-154 min_delimiter_token internal static fixed bin(8,0) initial dcl 1-154 minus internal static fixed bin(8,0) initial dcl 1-94 mode_case defined bit(1) unaligned dcl 1-280 mode_comcol defined fixed bin(17,0) dcl 1-309 mode_dclind defined fixed bin(17,0) dcl 1-309 mode_declareind defined fixed bin(17,0) dcl 1-309 mode_delnl defined bit(1) unaligned dcl 1-280 mode_elsestmt defined bit(1) unaligned dcl 1-280 mode_equalind defined fixed bin(17,0) dcl 1-309 mode_idind defined fixed bin(17,0) dcl 1-309 mode_ifthen defined bit(1) unaligned dcl 1-280 mode_ifthendo defined bit(1) unaligned dcl 1-280 mode_ifthenstmt defined bit(1) unaligned dcl 1-280 mode_ind defined fixed bin(17,0) dcl 1-309 mode_indattr defined bit(1) unaligned dcl 1-280 mode_indbegin defined bit(1) unaligned dcl 1-280 mode_indbeginend defined bit(1) unaligned dcl 1-280 mode_indblkcom defined bit(1) unaligned dcl 1-280 mode_indcom defined bit(1) unaligned dcl 1-280 mode_indcomtxt defined bit(1) unaligned dcl 1-280 mode_inddcls defined bit(1) unaligned dcl 1-280 mode_indend defined bit(1) unaligned dcl 1-280 mode_inditerdo defined bit(1) unaligned dcl 1-280 mode_indnoniterdo defined bit(1) unaligned dcl 1-280 mode_indnoniterend defined bit(1) unaligned dcl 1-280 mode_indproc defined bit(1) unaligned dcl 1-280 mode_indprocbody defined bit(1) unaligned dcl 1-280 mode_indthenbegin defined bit(1) unaligned dcl 1-280 mode_indthenbeginend defined bit(1) unaligned dcl 1-280 mode_indthenelse defined bit(1) unaligned dcl 1-280 mode_initcol defined fixed bin(17,0) dcl 1-309 mode_insnl defined bit(1) unaligned dcl 1-280 mode_linecom defined bit(1) unaligned dcl 1-280 mode_lineconind defined fixed bin(17,0) dcl 1-309 mode_ll defined fixed bin(17,0) dcl 1-309 mode_on defined bit(1) unaligned dcl 1-280 mode_struclvlind defined fixed bin(17,0) dcl 1-309 mode_thendo defined bit(1) unaligned dcl 1-280 ne internal static fixed bin(8,0) initial dcl 1-94 ngt internal static fixed bin(8,0) initial dcl 1-94 nl_vt_np_token internal static fixed bin(8,0) initial dcl 1-94 nlt internal static fixed bin(8,0) initial dcl 1-94 no_token internal static fixed bin(8,0) initial dcl 1-94 not internal static fixed bin(8,0) initial dcl 1-94 null_statement internal static fixed bin(8,0) initial dcl 1-185 on_statement internal static fixed bin(8,0) initial dcl 1-185 open_statement internal static fixed bin(8,0) initial dcl 1-185 or internal static fixed bin(8,0) initial dcl 1-94 percent internal static fixed bin(8,0) initial dcl 1-94 percent_abort_statement internal static fixed bin(8,0) initial dcl 1-185 percent_default_statement internal static fixed bin(8,0) initial dcl 1-185 percent_else_statement internal static fixed bin(8,0) initial dcl 1-185 percent_elseif_statement internal static fixed bin(8,0) initial dcl 1-185 percent_endif_statement internal static fixed bin(8,0) initial dcl 1-185 percent_error_statement internal static fixed bin(8,0) initial dcl 1-185 percent_if_statement internal static fixed bin(8,0) initial dcl 1-185 percent_include_statement internal static fixed bin(8,0) initial dcl 1-185 percent_page_statement internal static fixed bin(8,0) initial dcl 1-185 percent_print_statement internal static fixed bin(8,0) initial dcl 1-185 percent_replace_statement internal static fixed bin(8,0) initial dcl 1-185 percent_set_statement internal static fixed bin(8,0) initial dcl 1-185 percent_skip_statement internal static fixed bin(8,0) initial dcl 1-185 percent_statement internal static fixed bin(8,0) initial dcl 1-185 percent_warn_statement internal static fixed bin(8,0) initial dcl 1-185 period internal static fixed bin(8,0) initial dcl 1-94 plus internal static fixed bin(8,0) initial dcl 1-94 prefix_minus internal static fixed bin(8,0) initial dcl 1-94 prefix_plus internal static fixed bin(8,0) initial dcl 1-94 procedure_statement internal static fixed bin(8,0) initial dcl 1-185 put_statement internal static fixed bin(8,0) initial dcl 1-185 read_statement internal static fixed bin(8,0) initial dcl 1-185 return_statement internal static fixed bin(8,0) initial dcl 1-185 revert_mode internal static char(6) initial unaligned dcl 1-400 revert_statement internal static fixed bin(8,0) initial dcl 1-185 rewrite_statement internal static fixed bin(8,0) initial dcl 1-185 right_parn internal static fixed bin(8,0) initial dcl 1-94 semi_colon internal static fixed bin(8,0) initial dcl 1-94 signal_statement internal static fixed bin(8,0) initial dcl 1-185 size builtin function dcl 26 slash internal static fixed bin(8,0) initial dcl 1-94 stop_statement internal static fixed bin(8,0) initial dcl 1-185 subtype_none internal static fixed bin(8,0) initial dcl 1-265 subtype_noniterative_do internal static fixed bin(8,0) initial dcl 1-265 system_on_unit internal static fixed bin(8,0) initial dcl 1-185 target_comma internal static fixed bin(8,0) initial dcl 1-94 token based structure array level 1 dcl 1-29 token_hole_1 internal static fixed bin(8,0) initial dcl 1-94 token_hole_2 internal static fixed bin(8,0) initial dcl 1-94 token_hole_3 internal static fixed bin(8,0) initial dcl 1-94 token_hole_4 internal static fixed bin(8,0) initial dcl 1-94 trailer based structure array level 1 dcl 1-37 tree_control_comment internal static char(10) initial unaligned dcl 1-412 unknown_statement internal static fixed bin(8,0) initial dcl 1-185 unlock_statement internal static fixed bin(8,0) initial dcl 1-185 wait_statement internal static fixed bin(8,0) initial dcl 1-185 write_statement internal static fixed bin(8,0) initial dcl 1-185 NAMES DECLARED BY EXPLICIT CONTEXT. copy_string 001225 constant entry internal dcl 165 ref 114 118 126 128 136 141 149 159 count_differences 000463 constant entry internal dcl 72 ref 58 60 format_pl1_record_style_ 000347 constant entry external dcl 16 get_nearest_style 000432 constant entry internal dcl 49 ref 43 43 record_style 000536 constant entry internal dcl 103 ref 43 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1350 1362 1300 1360 Length 1562 1300 12 164 50 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME format_pl1_record_style_ 128 external procedure is an external procedure. get_nearest_style internal procedure shares stack frame of external procedure format_pl1_record_style_. count_differences internal procedure shares stack frame of external procedure format_pl1_record_style_. record_style internal procedure shares stack frame of external procedure format_pl1_record_style_. copy_string 65 internal procedure is called during a stack extension. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME format_pl1_record_style_ 000100 temp_segs format_pl1_record_style_ 000120 differences get_nearest_style 000121 fewest_differences get_nearest_style 000122 nearest_style get_nearest_style 000123 style_index get_nearest_style 000132 differences count_differences 000133 mode_index count_differences 000142 mode_index record_style THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs cat_realloc_cs call_int_this_desc return bound_check_signal shorten_stack ext_entry_desc int_entry_desc NO EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 16 000343 41 000354 43 000421 45 000431 49 000432 57 000434 58 000436 59 000440 60 000445 61 000447 63 000452 64 000453 66 000455 68 000457 72 000463 80 000465 82 000466 84 000473 87 000506 89 000510 91 000515 94 000530 96 000532 103 000536 112 000540 114 000544 115 000554 118 000557 121 000652 123 000661 126 000673 128 000703 136 000760 141 001016 144 001052 145 001053 147 001055 149 001063 157 001201 159 001204 161 001223 165 001224 170 001240 171 001251 172 001253 ----------------------------------------------------------- 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