THIS FILE IS DAMAGED COMPILATION LISTING OF SEGMENT format_pl1 Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985 Compiled at: Honeywell Multics Op. - System M Compiled on: 04/08/85 1155.2 mst Mon 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 /* DESCRIPTION: 11* 12* Program to format a PL/I program according to my own set of conventions. 13* Basically, if-then-else and do-end groups get lined up so that it is easy 14* to find the matching else statement, or the end of a do-end group. 15* 16* This program has its origins in the Multics indent command, but unlike 17* indent, we understand the syntax of PL/I fully, and don't get confused by 18* strange constructs. We also attempt to do more processing, since we have 19* the knowledge. 20* 21* I have wanted to write this program for a long time. I published my first 22* ideas in my S.B. thesis in 1973. I wrote a draft of the parser in 1974. 23* The notes I took for the lexical analyzer for format_pl1 turned into the 24* EIS lex for PL/I itself in 1977. So at long last... (Paul Green) 25* 26* This command is being modified to be the Multics standard PL/I formatting 27* command for MCR 3503. Consequently, it must have options to make it act 28* similar to indent as well as other formatting styles. (Monte Davidoff) 29* 30* Maintenance Instructions: 31* 32* To add another: 33* 34* 1) PL/I statement, see format_pl1_stmt_type_, format_pl1_. 35* 2) Formatting mode, see format_pl1_. 36* 3) Macro, see format_pl1_lex_, format_pl1_stmt_type_, format_pl1_. 37* 4) Declare statement attribute, see format_pl1_. 38* 5) Token type, see format_pl1_lex_, format_pl1_stmt_type_, 39* format_pl1_. 40* 6) Numbered style, see format_pl1_. 41**/ 42 43 /* HISTORY: 44* Written by Paul Green, 11/06/77. 45* 46* Modified: 47* 11/01/78 by Monte Davidoff: 48* 09/01/82 by Benson I. Margulies: for .X.pmac files. 49* 06/05/84 by R. Michael Tague: to recognize all legal pmac % statements. 50**/ 51 52 /* format: style5 */ 53 format_pl1: 54 fp: 55 procedure options (variable); 56 57 /* automatic */ 58 59 declare arg_count fixed binary; 60 declare arg_length fixed binary (21); 61 declare arg_ptr pointer; 62 declare argument_no fixed binary; 63 declare argx fixed binary; 64 declare bit_count fixed binary (24); 65 declare 1 ca, 66 2 check_comments bit (1), 67 2 no_check_comments bit (1), 68 2 check_strings bit (1), 69 2 no_check_strings bit (1), 70 2 force bit (1), 71 2 no_force bit (1), 72 2 long bit (1), 73 2 brief bit (1), 74 2 modes bit (1), 75 2 output_file bit (1), 76 2 record_style bit (1), 77 2 no_record_style bit (1), 78 2 require_style_comment 79 bit (1), 80 2 no_require_style_comment 81 bit (1), 82 2 version bit (1), 83 2 no_version bit (1); 84 declare code fixed binary (35); 85 declare in_dname char (168); 86 declare in_ename char (32); 87 declare modes_length fixed binary (21); 88 declare modes_ptr pointer; 89 declare output_ptr pointer; 90 declare source_ptr pointer; 91 declare suffix char (3); 92 declare out_dname char (168); 93 declare out_ename char (32); 94 95 /* based */ 96 97 declare arg_string char (arg_length) based (arg_ptr); 98 declare modes_string char (modes_length) based (modes_ptr); 99 100 /* builtin */ 101 102 declare (baseno, divide, index, null, reverse, rtrim, size, string, 103 substr) builtin; 104 105 /* condition */ 106 107 declare cleanup condition; 108 109 /* internal static */ 110 111 declare DEFAULT_STYLE fixed binary internal static 112 options (constant) initial (1); 113 declare VERSION char (3) internal static 114 options (constant) initial ("6.6"); 115 116 /* external static */ 117 118 declare error_table_$badopt fixed binary (35) external static; 119 declare error_table_$noentry fixed binary (35) external static; 120 declare format_pl1_severity_ fixed binary (35) external static; 121 122 /* entry */ 123 124 declare com_err_ entry options (variable); 125 declare com_err_$suppress_name entry options (variable); 126 declare cu_$arg_count entry (fixed binary, fixed binary (35)); 127 declare cu_$arg_ptr entry (fixed binary, pointer, 128 fixed binary (21), fixed binary (35)); 129 declare expand_pathname_ entry (char (*), char (*), char (*), 130 fixed binary (35)); 131 declare get_equal_name_ entry (char (*), char (*), char (32), 132 fixed binary (35)); 133 declare get_temp_segments_ entry (char (*), (*) pointer, 134 fixed binary (35)); 135 declare hcs_$initiate_count entry (char (*), char (*), char (*), 136 fixed binary (24), fixed binary (2), 137 pointer, fixed binary (35)); 138 declare hcs_$make_seg entry (char (*), char (*), char (*), 139 fixed binary (5), pointer, 140 fixed binary (35)); 141 declare ioa_ entry options (variable); 142 declare release_temp_segments_ entry (char (*), (*) pointer, 143 fixed binary (35)); 144 declare suffixed_name_$make entry (char (*), char (*), char (32), 145 fixed binary (35)); 146 declare suffixed_name_$new_suffix 147 entry (char (*), char (*), char (*), 148 char (32), fixed binary (35)); 149 declare terminate_file_ entry (pointer, fixed binary (24), 150 bit (*), fixed binary (35)); 151 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 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 */ 152 2 1 /* BEGIN INCLUDE FILE ... terminate_file.incl.pl1 */ 2 2 /* format: style2,^inddcls,idind32 */ 2 3 2 4 declare 1 terminate_file_switches based, 2 5 2 truncate bit (1) unaligned, 2 6 2 set_bc bit (1) unaligned, 2 7 2 terminate bit (1) unaligned, 2 8 2 force_write bit (1) unaligned, 2 9 2 delete bit (1) unaligned; 2 10 2 11 declare TERM_FILE_TRUNC bit (1) internal static options (constant) initial ("1"b); 2 12 declare TERM_FILE_BC bit (2) internal static options (constant) initial ("01"b); 2 13 declare TERM_FILE_TRUNC_BC bit (2) internal static options (constant) initial ("11"b); 2 14 declare TERM_FILE_TERM bit (3) internal static options (constant) initial ("001"b); 2 15 declare TERM_FILE_TRUNC_BC_TERM bit (3) internal static options (constant) initial ("111"b); 2 16 declare TERM_FILE_FORCE_WRITE bit (4) internal static options (constant) initial ("0001"b); 2 17 declare TERM_FILE_DELETE bit (5) internal static options (constant) initial ("00001"b); 2 18 2 19 /* END INCLUDE FILE ... terminate_file.incl.pl1 */ 153 3 1 /* BEGIN INCLUDE FILE ... access_mode_values.incl.pl1 3 2* 3 3* Values for the "access mode" argument so often used in hardcore 3 4* James R. Davis 26 Jan 81 MCR 4844 3 5* Added constants for SM access 4/28/82 Jay Pattin 3 6* Added text strings 03/19/85 Chris Jones 3 7**/ 3 8 3 9 3 10 /* format: style4,delnl,insnl,indattr,ifthen,dclind10 */ 3 11 dcl ( 3 12 N_ACCESS init ("000"b), 3 13 R_ACCESS init ("100"b), 3 14 E_ACCESS init ("010"b), 3 15 W_ACCESS init ("001"b), 3 16 RE_ACCESS init ("110"b), 3 17 REW_ACCESS init ("111"b), 3 18 RW_ACCESS init ("101"b), 3 19 S_ACCESS init ("100"b), 3 20 M_ACCESS init ("010"b), 3 21 A_ACCESS init ("001"b), 3 22 SA_ACCESS init ("101"b), 3 23 SM_ACCESS init ("110"b), 3 24 SMA_ACCESS init ("111"b) 3 25 ) bit (3) internal static options (constant); 3 26 3 27 /* The following arrays are meant to be accessed by doing either 1) bin (bit_value) or 3 28* 2) divide (bin_value, 2) to come up with an index into the array. */ 3 29 3 30 dcl SEG_ACCESS_MODE_NAMES (0:7) init ("null", "W", "E", "EW", "R", "RW", "RE", "REW") char (4) internal 3 31 static options (constant); 3 32 3 33 dcl DIR_ACCESS_MODE_NAMES (0:7) init ("null", "A", "M", "MA", "S", "SA", "SM", "SMA") char (4) internal 3 34 static options (constant); 3 35 3 36 dcl ( 3 37 N_ACCESS_BIN init (00000b), 3 38 R_ACCESS_BIN init (01000b), 3 39 E_ACCESS_BIN init (00100b), 3 40 W_ACCESS_BIN init (00010b), 3 41 RW_ACCESS_BIN init (01010b), 3 42 RE_ACCESS_BIN init (01100b), 3 43 REW_ACCESS_BIN init (01110b), 3 44 S_ACCESS_BIN init (01000b), 3 45 M_ACCESS_BIN init (00010b), 3 46 A_ACCESS_BIN init (00001b), 3 47 SA_ACCESS_BIN init (01001b), 3 48 SM_ACCESS_BIN init (01010b), 3 49 SMA_ACCESS_BIN init (01011b) 3 50 ) fixed bin (5) internal static options (constant); 3 51 3 52 /* END INCLUDE FILE ... access_mode_values.incl.pl1 */ 154 155 156 /* program */ 157 158 source_ptr = null; 159 output_ptr = null; 160 temp_segs (*) = null; 161 modes_ptr = null; 162 modes_length = 0; 163 format_pl1_severity_ = 5; 164 165 string (ca) = ""b; 166 ca.long = "1"b; 167 168 call cu_$arg_count (arg_count, code); 169 if code ^= 0 then 170 do; 171 call com_err_ (code, command); 172 return; 173 end; 174 175 argument_no = 0; 176 do argx = 1 to arg_count; 177 call cu_$arg_ptr (argx, arg_ptr, arg_length, code); 178 if code ^= 0 then 179 do; 180 call com_err_ (code, command, "Argument ^d.", argx); 181 return; 182 end; 183 184 if arg_string = "-version" | arg_string = "-ver" then 185 do; 186 ca.version = "1"b; 187 ca.no_version = "0"b; 188 end; 189 190 else if arg_string = "-no_version" | arg_string = "-nver" 191 then 192 do; 193 ca.version = "0"b; 194 ca.no_version = "1"b; 195 end; 196 197 el 316 317 call expand_pathname_ (arg_string, out_dname, out_ename, 318 code); 319 if code ^= 0 then 320 do; 321 call com_err_ (code, command, "^a", arg_string); 322 return; 323 end; 324 325 ca.output_file = "1"b; 326 end; 327 328 else if index (arg_string, "-") = 1 then 329 do; 330 call com_err_ (error_table_$badopt, command, "^a", 331 arg_string); 332 return; 333 end; 334 335 else 336 do; 337 argument_no = argument_no + 1; 338 339 if argument_no = 1 then 340 do; 341 call expand_pathname_ (arg_string, in_dname, 342 in_ename, code); 343 if code ^= 0 then 344 do; 345 call com_err_ (code, command, "^a", 346 arg_string); 347 return; 348 end; 349 end; 350 end; 351 end; 352 353 if argument_no ^= 1 then 354 do; 355 call com_err_$suppress_name (0, command, 356 "Usage: ^a in_path {-control_args}", command); 357 return; 358 end; 359 360 on cleanup call cleanup_procedure; 361 362 call get_input_segment (code); 363 if code ^= 0 then 364 do; 365 call cleanup_procedure; 366 return; 367 end; 368 369 if ca.output_file then 370 begin; 371 declare old_ename char (32); 372 373 old_ename = out_ename; 374 call get_equal_name_ (in_ename, old_ename, out_ename, code); 375 if code ^= 0 then 376 do; 377 call com_err_ (code, command, "Equal name ^a with ^a.", 378 old_ename, in_ename); 379 call cleanup_procedure; 380 return; 381 end; 382 383 old_ename = out_ename; 384 call suffixed_name_$make (old_ename, suffix, out_ename, code); 385 if code ^= 0 then 386 do; 387 call com_err_ (code, command, "^a with ^a suffix.", 388 old_ename, suffix); 389 call cleanup_procedure; 390 return; 391 end; 392 end; 393 394 call get_temp_segments_ (command, temp_segs (*), code); 395 if code ^= 0 then 396 do; 397 call com_err_ (code, command, 398 "Getting temporary segments in process directory."); 399 call cleanup_procedure; 400 return; 401 end; 402 403 global.source_ptr = source_ptr; 404 global.source_length = divide (bit_count + 8, 9, 21); 405 global.max_severity = 0; 406 global.modes_ptr = modes_ptr; 407 global.modes_length = modes_length; 408 global.ca = ca, by name; 409 global.include_file = ends_with (in_ename, ".incl.pl1"); 410 global.rdc_source = ends_with (in_ename, ".rd"); 411 412 /* Initialize the current style. */ 413 414 global.current_style = styles (DEFAULT_STYLE); 415 416 if ca.modes then 417 do; 418 call format_pl1_modes_ (temp_segs (*), modes_string, null, "0"b, 419 "0"b); 420 if global.max_severity > 0 then 421 do; 422 format_pl1_severity_ = global.max_severity; 423 call cleanup_procedure; 424 return; 425 end; 426 end; 427 428 else 429 global.ca.long = "0"b; 430 431 global.command_line_style = global.current_style; 432 433 if ca.force then 434 global.current_style = styles (DEFAULT_STYLE); 435 436 /* Initialization is complete. Print version if requested. */ 437 438 if ca.version then 439 call ioa_ ("Format PL/I ^a", VERSION); 440 441 /* Lex the program. */ 442 443 call format_pl1_lex_ (temp_segs (*)); 444 if global.max_severity > 2 then 445 do; 446 format_pl1_severity_ = global.max_severity; 447 call com_err_ (0, command, "No formatting will be done."); 448 call cleanup_procedure; 449 return; 450 end; 451 452 /* Produce a list of statements. */ 453 454 call format_pl1_stmt_type_ (temp_segs (*)); 455 if global.max_severity > 3 then 456 do; 457 format_pl1_severity_ = global.max_severity; 458 call com_err_ (0, command, "No formatting will be done."); 459 call cleanup_procedure; 460 return; 461 end; 462 463 /* Do the formatting. */ 464 465 call format_pl1_ (temp_segs (*)); 466 if global.max_severity > 3 then 467 do; 468 format_pl1_severity_ = global.max_severity; 469 call com_err_ (0, command, "No formatting will be done."); 470 call cleanup_procedure; 471 return; 472 end; 473 474 /* Copy the formatted program over to the output segment. */ 475 476 if ^ca.output_file then 477 if global.max_severity <= 1 then 478 do; 479 out_dname = in_dname; 480 out_ename = in_ename; 481 output_ptr = source_ptr; 482 source_ptr = null; 483 end; 484 485 else 486 do; 487 out_dname = "[pd]"; 488 out_ename = in_ename; 489 490 call hcs_$make_seg ("", out_ename, "", RW_ACCESS_BIN, 491 output_ptr, code); 492 if output_ptr = null then 493 do; 494 call com_err_ (code, command, "^a^[>^]^a", 495 out_dname, out_dname ^= ">", out_ename); 496 call cleanup_procedure; 497 return; 498 end; 499 500 if baseno (source_ptr) = baseno (output_ptr) then 501 do; 502 format_pl1_severity_ = global.max_severity; 503 call com_err_ (0, command, 504 "Input segment not replaced."); 505 call cleanup_procedure; 506 return; 507 end; 508 509 call com_err_ (0, command, 510 "Input segment not replaced. Formatted copy is in ^a^[>^]^a." 511 , out_dname, out_dname ^= ">", out_ename); 512 end; 513 514 else 515 do; 516 call hcs_$make_seg (out_dname, out_ename, "", RW_ACCESS_BIN, 517 output_ptr, code); 518 if output_ptr = null then 519 do; 520 call com_err_ (code, command, "^a^[>^]^a", out_dname, 521 out_dname ^= ">", out_ename); 522 call cleanup_procedure; 523 return; 524 end; 525 end; 526 527 substr (output_ptr -> output_string, 1, global.output_length) = 528 substr (output_string, 1, global.output_length); 529 530 call terminate_file_ (output_ptr, 9 * global.output_length, 531 TERM_FILE_TRUNC_BC_TERM, code); 532 if code ^= 0 then 533 do; 534 global.max_severity = 5; 535 call com_err_ (code, command, "Terminating the file ^a^[>^]^a.", 536 out_dname, out_dname ^= ">", out_ename); 537 end; 538 539 format_pl1_severity_ = global.max_severity; 540 541 call cleanup_procedure; 542 543 return; 544 545 get_input_segment: 546 procedure (code); 547 548 declare code fixed binary (35); 549 /* (Output) standard status code */ 550 551 declare explicit_suffix bit (1) aligned; 552 declare tentative_ename char (32); 553 declare test_ename char (32); 554 555 556 /* NOTE: pmac suffices, like rd, must be explicit. */ 557 /* no attempt is made to remember pmac-ness so as to */ 558 /* reject %set etc. in non-pmac segments, since this will */ 559 /* be in the compiler some day. */ 560 561 code = 0; 562 explicit_suffix = "1"b; 563 564 if ends_with (in_ename, ".pmac") then 565 test_ename = before (in_ename, ".pmac"); 566 else 567 test_ename = in_ename; 568 569 if ends_with (test_ename, ".pl1") then 570 suffix = "pl1"; 571 572 else if ends_with (test_ename, ".cds") then 573 suffix = "cds"; 574 575 else if ends_with (test_ename, ".rd") then 576 suffix = "rd"; 577 578 else 579 do; 580 explicit_suffix = "0"b; 581 suffix = "pl1"; 582 583 tentative_ename = in_ename; 584 call suffixed_name_$make (tentative_ename, suffix, in_ename, 585 code); 586 if code ^= 0 then 587 do; 588 call com_err_ (code, command, "^a with ^a suffix.", 589 tentative_ename, suffix); 590 return; 591 end; 592 end; 593 594 call hcs_$initiate_count (in_dname, in_ename, "", bit_count, 0, 595 source_ptr, code); 596 if source_ptr ^= null then 597 do; 598 code = 0; 599 return; 600 end; 601 602 if explicit_suffix | code ^= error_table_$noentry then 603 do; 604 call com_err_ (code, command, "^a^[>^]^a", in_dname, 605 in_dname ^= ">", in_ename); 606 return; 607 end; 608 609 call suffixed_name_$new_suffix (in_ename, "pl1", "cds", tentative_ename, 610 code); 611 if code ^= 0 then 612 do; 613 call com_err_ (code, command, "^a with ^a suffix.", in_ename, 614 "cds"); 615 return; 616 end; 617 618 call hcs_$initiate_count (in_dname, tentative_ename, "", bit_count, 0, 619 source_ptr, code); 620 if source_ptr ^= null then 621 do; 622 code = 0; 623 in_ename = tentative_ename; 624 suffix = "cds"; 625 return; 626 end; 627 628 if code = error_table_$noentry then 629 call com_err_ (code, command, "^a^[>^]^a", in_dname, 630 in_dname ^= ">", in_ename); 631 else 632 call com_err_ (code, command, "^a^[>^]^a", in_dname, 633 in_dname ^= ">", tentative_ename); 634 end get_input_segment; 635 636 /* Check if one string ends another with trailing blanks ignored. */ 637 638 ends_with: 639 procedure (string, ending) returns (bit (1) aligned); 640 641 declare string char (*); /* (Input) string with unknown ending */ 642 declare ending char (*); /* (Input) possible ending */ 643 644 return (index (reverse (rtrim (string)), reverse (rtrim (ending))) = 1); 645 end ends_with; 646 647 /* Release temporary storage and terminate segments. */ 648 649 cleanup_procedure: 650 procedure; 651 652 call terminate_file_ (source_ptr, 0, TERM_FILE_TERM, code); 653 call terminate_file_ (output_ptr, 0, TERM_FILE_TERM, code); 654 call release_temp_segments_ (command, temp_segs (*), code); 655 end cleanup_procedure; 656 657 end format_pl1; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/08/85 1128.7 format_pl1.pl1 >spec>on>41-15>format_pl1.pl1 152 1 08/10/84 0958.4 format_pl1_dcls.incl.pl1 >ldd>include>format_pl1_dcls.incl.pl1 153 2 04/06/83 1239.4 terminate_file.incl.pl1 >ldd>include>terminate_file.incl.pl1 154 3 04/08/85 1113.3 access_mode_values.incl.pl1 >spec>on>41-15>access_mode_values.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. DEFAULT_STYLE constant fixed bin(17,0) initial dcl 111 ref 414 433 RW_ACCESS_BIN 000067 constant fixed bin(5,0) initial dcl 3-36 set ref 490* 516* TERM_FILE_TERM 000071 constant bit(3) initial unaligned dcl 2-14 set ref 652* 653* TERM_FILE_TRUNC_BC_TERM 000070 constant bit(3) initial unaligned dcl 2-15 set ref 530* VERSION 000075 constant char(3) initial unaligned dcl 113 set ref 438* arg_count 000100 automatic fixed bin(17,0) dcl 59 set ref 168* 176 281 302 arg_length 000101 automatic fixed bin(21,0) dcl 60 set ref 177* 184 184 190 190 197 197 204 204 211 211 218 218 225 225 232 232 239 239 246 246 253 253 259 259 265 265 271 271 277 277 277 299 299 309* 317 317 321 321 328 330 330 341 341 345 345 arg_ptr 000102 automatic pointer dcl 61 set ref 177* 184 184 190 190 197 197 204 204 211 211 218 218 225 225 232 232 239 239 246 246 253 253 259 259 265 265 271 271 277 277 277 299 299 309* 317 321 328 330 341 345 arg_string based char unaligned dcl 97 set ref 184 184 190 190 197 197 204 204 211 211 218 218 225 225 232 232 239 239 246 246 253 253 259 259 265 265 271 271 277 277 277 299 299 317* 321* 328 330* 341* 345* argument_no 000104 automatic fixed bin(17,0) dcl 62 set ref 175* 337* 337 339 353 argx 000105 automatic fixed bin(17,0) dcl 63 set ref 176* 177* 180* 280* 280 281 288* 291* 301* 301 302 309* 312* baseno builtin function dcl 102 ref 500 500 bit_count 000106 automatic fixed bin(24,0) dcl 64 set ref 404 594* 618* brief 0(07) 000107 automatic bit(1) level 2 packed unaligned dcl 65 set ref 268* 274* ca 000107 automatic structure level 1 packed unaligned dcl 65 in procedure "fp" set ref 165* 408 ca 13 based structure level 3 in structure "global" packed unaligned dcl 1-73 in procedure "fp" set ref 408* check_comments 000107 automatic bit(1) level 2 packed unaligned dcl 65 set ref 214* 221* check_strings 0(02) 000107 automatic bit(1) level 2 packed unaligned dcl 65 set ref 228* 235* cleanup 000266 stack reference condition dcl 107 ref 360 code 000110 automatic fixed bin(35,0) dcl 84 in procedure "fp" set ref 168* 169 171* 177* 178 180* 288* 289 291* 309* 310 312* 317* 319 321* 341* 343 345* 362* 363 374* 375 377* 384* 385 387* 394* 395 397* 490* 494* 516* 520* 530* 532 535* 652* 653* 654* code parameter fixed bin(35,0) dcl 548 in procedure "get_input_segment" set ref 545 561* 584* 586 588* 594* 598* 602 604* 609* 611 613* 618* 622* 628 628* 631* com_err_ 000016 constant entry external dcl 124 ref 171 180 283 291 304 312 321 330 345 377 387 397 447 458 469 494 503 509 520 535 588 604 613 628 631 com_err_$suppress_name 000020 constant entry external dcl 125 ref 355 command 000072 constant char(10) initial unaligned dcl 1-89 set ref 171* 180* 283* 291* 304* 312* 321* 330* 345* 355* 355* 377* 387* 394* 397* 447* 458* 469* 494* 503* 509* 520* 535* 588* 604* 613* 628* 631* 654* command_line_style 14 based structure level 3 dcl 1-73 set ref 431* cu_$arg_count 000022 constant entry external dcl 126 ref 168 cu_$arg_ptr 000024 constant entry external dcl 127 ref 177 288 309 current_style 42 based structure level 3 dcl 1-73 set ref 414* 431 433* divide builtin function dcl 102 ref 404 ending parameter char unaligned dcl 642 ref 638 644 error_table_$badopt 000010 external static fixed bin(35,0) dcl 118 set ref 330* error_table_$noentry 000012 external static fixed bin(35,0) dcl 119 ref 602 628 expand_pathname_ 000026 constant entry external dcl 129 ref 317 341 explicit_suffix 000324 automatic bit(1) dcl 551 set ref 562* 580* 602 flags 13(06) based structure level 3 packed unaligned dcl 1-73 force 0(04) 000107 automatic bit(1) level 2 packed unaligned dcl 65 set ref 255* 261* 433 format_pl1_ 000060 constant entry external dcl 1-432 ref 465 format_pl1_lex_ 000054 constant entry external dcl 1-430 ref 443 format_pl1_modes_ 000062 constant entry external dcl 1-433 ref 418 format_pl1_severity_ 000014 external static fixed bin(35,0) dcl 120 set ref 163* 422* 446* 457* 468* 502* 539* format_pl1_stmt_type_ 000056 constant entry external dcl 1-431 ref 454 get_equal_name_ 000030 constant entry external dcl 131 ref 374 get_temp_segments_ 000032 constant entry external dcl 133 ref 394 global based structure level 1 dcl 1-73 global_header based structure level 1 dcl 1-47 hcs_$initiate_count 000034 constant entry external dcl 135 ref 594 618 hcs_$make_seg 000036 constant entry external dcl 138 ref 490 516 header based structure level 2 dcl 1-73 in_dname 000111 automatic char(168) unaligned dcl 85 set ref 341* 479 594* 604* 604 618* 628* 628 631* 631 in_ename 000163 automatic char(32) unaligned dcl 86 set ref 341* 374* 377* 409* 410* 480 488 564* 564 566 583 584* 594* 604* 609* 613* 623* 628* include_file 13(06) based bit(1) level 4 packed unaligned dcl 1-73 set ref 409* index builtin function dcl 102 ref 328 644 ioa_ 000040 constant entry external dcl 141 ref 438 long 13(03) based bit(1) level 4 in structure "global" packed unaligned dcl 1-73 in procedure "fp" set ref 428* long 0(06) 000107 automatic bit(1) level 2 in structure "ca" packed unaligned dcl 65 in procedure "fp" set ref 166* 267* 273* max_severity 7 based fixed bin(35,0) level 3 dcl 1-73 set ref 405* 420 422 444 446 455 457 466 468 476 502 534* 539 modes 0(08) 000107 automatic bit(1) level 2 packed unaligned dcl 65 set ref 296* 416 modes_length 000173 automatic fixed bin(21,0) dcl 87 in procedure "fp" set ref 162* 288* 407 418 418 modes_length 12 based fixed bin(21,0) level 3 in structure "global" dcl 1-73 in procedure "fp" set ref 407* modes_ptr 000174 automatic pointer dcl 88 in procedure "fp" set ref 161* 288* 406 418 modes_ptr 10 based pointer level 3 in structure "global" dcl 1-73 in procedure "fp" set ref 406* modes_string based char unaligned dcl 98 set ref 418* no_check_comments 0(01) 000107 automatic bit(1) level 2 packed unaligned dcl 65 set ref 215* 222* no_check_strings 0(03) 000107 automatic bit(1) level 2 packed unaligned dcl 65 set ref 229* 236* no_force 0(05) 000107 automatic bit(1) level 2 packed unaligned dcl 65 set ref 256* 262* no_record_style 0(11) 000107 automatic bit(1) level 2 packed unaligned dcl 65 set ref 201* 208* no_require_style_comment 0(13) 000107 automatic bit(1) level 2 packed unaligned dcl 65 set ref 243* 250* no_version 0(15) 000107 automatic bit(1) level 2 packed unaligned dcl 65 set ref 187* 194* null builtin function dcl 102 ref 158 159 160 161 418 418 482 492 518 596 620 old_ename 000306 automatic char(32) unaligned dcl 371 set ref 373* 374* 377* 383* 384* 387* out_dname 000203 automatic char(168) unaligned dcl 92 set ref 317* 479* 487* 494* 494 509* 509 516* 520* 520 535* 535 out_ename 000255 automatic char(32) unaligned dcl 93 set ref 317* 373 374* 383 384* 480* 488* 490* 494* 509* 516* 520* 535* output_file 0(09) 000107 automatic bit(1) level 2 packed unaligned dcl 65 set ref 325* 369 476 output_length 6 based fixed bin(21,0) level 3 dcl 1-73 ref 527 527 530 output_ptr 000176 automatic pointer dcl 89 set ref 159* 481* 490* 492 500 516* 518 527 530* 653* output_string based char unaligned dcl 1-84 set ref 527* 527 rdc_source 13(07) based bit(1) level 4 packed unaligned dcl 1-73 set ref 410* record_style 0(10) 000107 automatic bit(1) level 2 packed unaligned dcl 65 set ref 200* 207* release_temp_segments_ 000042 constant entry external dcl 142 ref 654 require_style_comment 0(12) 000107 automatic bit(1) level 2 packed unaligned dcl 65 set ref 242* 249* reverse builtin function dcl 102 ref 644 644 rtrim builtin function dcl 102 ref 644 644 source_length 2 based fixed bin(21,0) level 3 dcl 1-73 set ref 404* source_ptr based pointer level 3 in structure "global" dcl 1-73 in procedure "fp" set ref 403* source_ptr 000200 automatic pointer dcl 90 in procedure "fp" set ref 158* 403 481 482* 500 594* 596 618* 620 652* string parameter char unaligned dcl 641 in procedure "ends_with" ref 638 644 string builtin function dcl 102 in procedure "fp" set ref 165* style based structure level 1 dcl 1-273 styles 000000 constant structure array level 1 dcl 1-358 ref 414 433 substr builtin function dcl 102 set ref 527* 527 suffix 000202 automatic char(3) unaligned dcl 91 set ref 384* 387* 569* 572* 575* 581* 584* 588* 624* suffixed_name_$make 000044 constant entry external dcl 144 ref 384 584 suffixed_name_$new_suffix 000046 constant entry external dcl 146 ref 609 sys_info$max_seg_size 000052 external static fixed bin(19,0) dcl 1-426 ref 527 527 temp_segs 000274 automatic pointer array dcl 1-23 set ref 160* 394* 403 404 405 406 407 408 409 410 414 418* 420 422 428 431 431 433 443* 444 446 454* 455 457 465* 466 468 476 502 527 527 527 530 534 539 654* tentative_ename 000325 automatic char(32) unaligned dcl 552 set ref 583* 584* 588* 609* 618* 623 631* terminate_file_ 000050 constant entry external dcl 149 ref 530 652 653 test_ename 000335 automatic char(32) unaligned dcl 553 set ref 564* 566* 569* 572* 575* version 0(14) 000107 automatic bit(1) level 2 packed unaligned dcl 65 set ref 186* 193* 438 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. A_ACCESS internal static bit(3) initial unaligned dcl 3-11 A_ACCESS_BIN internal static fixed bin(5,0) initial dcl 3-36 DIR_ACCESS_MODE_NAMES internal static char(4) initial array unaligned dcl 3-33 E_ACCESS internal static bit(3) initial unaligned dcl 3-11 E_ACCESS_BIN internal static fixed bin(5,0) initial dcl 3-36 M_ACCESS internal static bit(3) initial unaligned dcl 3-11 M_ACCESS_BIN internal static fixed bin(5,0) initial dcl 3-36 N_ACCESS internal static bit(3) initial unaligned dcl 3-11 N_ACCESS_BIN internal static fixed bin(5,0) initial dcl 3-36 REW_ACCESS internal static bit(3) initial unaligned dcl 3-11 REW_ACCESS_BIN internal static fixed bin(5,0) initial dcl 3-36 RE_ACCESS internal static bit(3) initial unaligned dcl 3-11 RE_ACCESS_BIN internal static fixed bin(5,0) initial dcl 3-36 RW_ACCESS internal static bit(3) initial unaligned dcl 3-11 R_ACCESS internal static bit(3) initial unaligned dcl 3-11 R_ACCESS_BIN internal static fixed bin(5,0) initial dcl 3-36 SA_ACCESS internal static bit(3) initial unaligned dcl 3-11 SA_ACCESS_BIN internal static fixed bin(5,0) initial dcl 3-36 SEG_ACCESS_MODE_NAMES internal static char(4) initial array unaligned dcl 3-30 SMA_ACCESS internal static bit(3) initial unaligned dcl 3-11 SMA_ACCESS_BIN internal static fixed bin(5,0) initial dcl 3-36 SM_ACCESS internal static bit(3) initial unaligned dcl 3-11 SM_ACCESS_BIN internal statical 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_error_ 000000 constant entry external dcl 1-439 format_pl1_long_ 000000 constant entry external dcl 1-438 format_pl1_record_style_ 000000 constant entry external dcl 1-435 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 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 al nonquick procedures. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME fp 000100 arg_count fp 000101 arg_length fp 000102 arg_ptr fp 000104 argument_no fp 000105 argx fp 000106 bit_count fp 000107 ca fp 000110 code fp 000111 in_dname fp 000163 in_ename fp 000173 modes_length fp 000174 modes_ptr fp 000176 output_ptr fp 000200 source_ptr fp 000202 suffix fp 000203 out_dname fp 000255 out_ename fp 000274 temp_segs fp 000306 old_ename begin block on line 369 000324 explicit_suffix get_input_segment 000325 tentative_ename get_input_segment 000335 test_ename get_input_segment THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as r_ne_as call_ext_out_desc call_ext_out call_int_this call_int_other begin_return return enable ext_entry int_entry set_cs_eis index_before_cs index_reverse_cs THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. com_err_ com_err_$suppress_name cu_$arg_count cu_$arg_ptr expand_pathname_ format_pl1_ format_pl1_lex_ format_pl1_modes_ format_pl1_stmt_type_ get_equal_name_ get_temp_segments_ hcs_$initiate_count hcs_$make_seg ioa_ release_temp_segments_ suffixed_name_$make suffixed_name_$new_suffix terminate_file_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$badopt error_table_$noentry format_pl1_severity_ sys_info$max_seg_size LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 53 000446 158 000463 159 000465 160 000466 161 000501 162 000503 163 000504 165 000507 166 000511 168 000513 169 000523 171 000525 172 000542 175 000543 176 000544 177 000553 178 000570 180 000572 181 000624 184 000625 186 000637 187 000641 188 000643 190 000644 193 000654 194 000656 195 000660 197 000661 200 000671 201 000673 202 000675 204 000676 207 000706 208 000710 209 000712 211 000713 214 000723 215 000725 216 000727 218 000730 221 000740 222 000742 223 000744 225 000745 228 000755 229 000757 230 000761 232 000762 235 000772 236 000774 237 000776 239 000777 242 001007 243 001011 244 001013 246 001014 249 001024 250 001026 251 001030 253 001031 255 001041 256 001043 257 001045 259 001046 261 001056 262 001060 263 001062 265 001063 267 001073 268 001075 269 001077 271 001100 273 001110 274 001112 275 001114 277 001115 280 001131 281 001132 283 001135 285 001162 288 001163 ----------------------------------------------------------- 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