COMPILATION LISTING OF SEGMENT format_pl1_ Compiled by: Multics PL/I Compiler, Release 33e, of October 6, 1992 Compiled at: CGI Compiled on: 2000-04-17_1934.41_Mon_mdt 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* Format a PL/I program given a list of tokens and statements. For most 12* statements, as much of the statement is put on a line as possible. If a 13* statement will not fit on one line, parenthesis nesting and the precedence 14* of each token is used to determine where to break the statement across 15* lines. This default formatting is done by format_other. Most of this 16* program handles special cases that format_other would not format correctly. 17* Some token types are changed by format_pl1_stmt_type_ because some tokens 18* require different precedences in different contexts. This procedure 19* assumes the token type needs no further refinement. The steps are: 20* 21* 1) Convert a statement into items. Items are tokens and comments. The 22* item structure has many fields that facilitate formatting. 23* 2) Figure out how to format the statement by modifying the item structure. 24* 3) Copy the items for a statement into the output string using the item 25* structure control information. 26* 4) This procedure keeps track of the syntactic nesting of the program in 27* the unit_stack. The unit_stack is kept current after each statement by 28* adjust_unit_stack. 29* 30* Maintenance Instructions: 31* 32* To add another token type: 33* 34* 1) Add an entry to the precedence array. 35* 2) Add entries to the last_space_class and this_space_class arrays 36* in make_items. If necessary, add entries to the space_table 37* array in make_items. 38* 39* To add another PL/I statement: 40* 41* 1) If the statement needs special formatting, change 42* format_one_statement. 43* 44* To add another macro: 45* 46* 1) If the macro needs special formatting, change 47* format_one_statement. 48* 49* To add another declare statement attribute: 50* 51* 1) If the attribute consists of an identifier or an identifier 52* followed by something in parentheses, and no special formatting 53* is needed, no change is necessary. Otherwise, change 54* attribute_set. 55* 56* To add another formatting mode: 57* 58* 1) Change the style stucture in format_pl1_dcls.incl.pl1 to include 59* space for the new mode. 60* 2) Add a declaration that starts with "mode_" to 61* format_pl1_dcls.incl.pl1 to reference the mode in the current 62* style. This declaration is used only by this procedure. 63* 3) For a switch mode, add entries to the switch_mode_names and 64* switch_antonym_names arrays. For a value mode, add an entry to 65* the value_mode_names array. These arrays are in 66* format_pl1_dcls.incl.pl1. 67* 4) Add a default value for the new mode in each style in the styles 68* array of structures in format_pl1_dcls.incl.pl1. 69* 5) Change this procedure to use the new "mode_" declaration. 70* 71* To add another numbered style: 72* 73* 1) Add new entries to the styles array of structures in 74* format_pl1_dcls.incl.pl1 that defines a default value for each 75* mode in the new style. 76**/ 77 78 /* HISTORY: 79*Written by Paul Green, 11/01/77. 80*Rewritten by Monte Davidoff, 07/17/78. 81*Modified: 82*09/03/83 by Jim Lippard: to not go into an infinite loop on 83* "dcl a defined (b;". 84*06/05/84 by R. Michael Tague: Handle the % macro statments of pmac. Changed 85* pop_unit so that a multiple closure error message will be printed 86* when a labeled end statement is used to close a %if or %else 87* statement instead of the proper closure with a %endif. 88* Added the elsedo formatting option. 89*11/15/84 by R. Michael Tague: Changed the formatting of "else if" to always 90* place the if statement exactly one space after the else. 91*02/12/85 by R. Michael Tague: Changed comparisons with percent_statement to 92* use the is_macro_statement. This was a bug, I should have changed 93* it 06/05/84. Fixed so that the trailing comma that comes after 94* a literal will stay on the line with the literal when the literal 95* is the only thing on the line but still the line is too long. 96**/ 97 98 /* format: style5,^indcomtxt */ 99 100 format_pl1_: 101 procedure (P_temp_segs); 102 103 declare P_temp_segs (*) pointer; /* (Input) array of temporary segment pointers */ 104 105 /* automatic */ 106 107 declare copy_position fixed binary (21); 108 /* index in output segment of next character to write */ 109 declare item_ptr pointer; /* pointer to base of item array */ 110 declare left_margin fixed binary; /* current indentation level column */ 111 declare line_position fixed binary; /* column next character will be written into */ 112 declare looked_ahead bit (1) aligned;/* on if next statement will fit on the current line */ 113 declare off_region_ptr pointer; /* pointer to first character not to format */ 114 declare text_after_end_msg bit (1) aligned;/* on if printed text after end of program message */ 115 declare unit_stack_index fixed binary; /* number of entries in unit stack */ 116 declare unit_stack_ptr pointer; /* pointer to base of unit_stack */ 117 118 /* based */ 119 120 declare 1 item ( 121 divide (sys_info$max_seg_size 122 - binary (rel (item_ptr), 18), 5, 17)) 123 aligned based (item_ptr), 124 2 string_size fixed binary (21) unaligned, 125 2 comment_ind_len fixed binary (3) unsigned unaligned, 126 2 pad1 bit (2) unaligned, 127 2 type fixed binary (8) unaligned, 128 2 string_ptr pointer unaligned, 129 2 paren_depth fixed binary (8) unaligned, 130 2 precedence fixed binary (9) unsigned unaligned, 131 2 last_col fixed binary (17) unaligned, 132 2 next_token fixed binary (17) unaligned, 133 2 header unaligned, 134 3 tab bit (1), 135 3 need_space fixed binary (1) unsigned, 136 3 tab_blkcom bit (1), 137 3 insnl bit (1), 138 3 pad2 bit (5), 139 3 amount fixed binary (9) unsigned, 140 2 trailer unaligned, 141 3 NP bit (1), 142 3 pad3 bit (8), 143 3 VTs fixed binary (9) unsigned, 144 3 NLs fixed binary (9) unsigned, 145 2 flags unaligned, 146 3 control_comment bit (1), 147 3 gave_error_msg bit (1), 148 3 indcomtxt bit (1), 149 3 pad4 bit (6); 150 151 declare 1 unit_stack ( 152 divide (sys_info$max_seg_size 153 - binary (rel (unit_stack_ptr), 18), 4, 154 17)) aligned based (unit_stack_ptr), 155 2 type fixed binary (17) unaligned, 156 2 label_start fixed binary (17) unaligned, 157 2 label_end fixed binary (17) unaligned, 158 2 close_left_margin fixed binary (17) unaligned, 159 2 previous_left_margin 160 fixed binary (17) unaligned, 161 2 flags unaligned, 162 3 case bit (1), 163 3 in_else_clause bit (1), 164 3 pad bit (16), 165 2 construct_ptr pointer unaligned; 166 167 /* builtin */ 168 169 declare (addr, after, before, binary, copy, divide, hbound, index, 170 length, ltrim, max, min, null, rel, reverse, rtrim, search, 171 size, substr, unspec, verify) 172 builtin; 173 174 /* internal static */ 175 176 declare close_comment char (2) internal static 177 options (constant) initial ("*/"); 178 declare open_comment char (2) internal static 179 options (constant) initial ("/*"); 180 declare tab_interval fixed binary (4) internal static 181 options (constant) initial (10); 182 183 declare ( 184 NO_UNIT initial (0), 185 BEGIN_UNIT initial (1), 186 DO_UNIT initial (2), 187 PROCEDURE_UNIT initial (3), 188 IF_UNIT initial (4), 189 ELSE_UNIT initial (5), 190 ON_UNIT initial (6), 191 PERCENT_IF_UNIT initial (7) 192 ) fixed binary internal static 193 options (constant); 194 195 declare BS char (1) internal static 196 options (constant) initial (""); 197 declare HT char (1) internal static 198 options (constant) initial (" "); 199 declare HT_BS_NL_VT_NP char (5) internal static 200 options (constant) initial ("  201 "); 202 declare HT_SP char (2) internal static 203 options (constant) initial (" "); 204 205 declare precedence (0:53) fixed binary (9) 206 unsigned internal static 207 options (constant) initial (15, 208 /* no_token */ 209 15, /* invalid_char */ 210 15, /* identifier */ 211 3, /* keyword_token */ 212 15, /* isub */ 213 10, /* infix + */ 214 10, /* infix - */ 215 11, /* * */ 216 11, /* / */ 217 12, /* ** */ 218 12, /* ^ */ 219 7, /* & */ 220 6, /* | */ 221 9, /* || */ 222 8, /* = */ 223 8, /* ^= */ 224 8, /* < */ 225 8, /* > */ 226 8, /* <= */ 227 8, /* >= */ 228 8, /* ^> */ 229 8, /* ^< */ 230 12, /* prefix + */ 231 12, /* prefix - */ 232 4, /* assignment */ 233 15, /* : */ 234 15, /* ; */ 235 2, /* , */ 236 14, /* . */ 237 13, /* -> */ 238 17, /* ( */ 239 1, /* ) */ 240 15, /* % */ 241 5, /* target , */ 242 16, /* comment */ 243 0, /* nl_vt_np_token */ 244 (18) 15); /* constants */ 245 246 declare HT_SP_NL_VT_NP char (5) internal static 247 options (constant) initial (" 248 "); 249 declare NL char (1) internal static 250 options (constant) initial (" 251 "); 252 declare NP char (1) internal static 253 options (constant) initial (" "); 254 declare SP char (1) internal static 255 options (constant) initial (""); 256 declare VT char (1) internal static 257 options (constant) initial (" "); 258 259 /* entry */ 260 261 declare ioa_ entry options (variable); 262 263 declare char_offset_ entry (pointer) 264 returns (fixed binary (21)) reducible; 265 266 /* more internal static */ 267 268 declare NL_VT_NP char (3) internal static 269 options (constant) initial (" 270 "); 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 */ 271 272 273 /* program */ 274 275 temp_segs (*) = P_temp_segs (*); 276 global.output_length = 0; 277 278 copy_position = 1; 279 line_position = 1; 280 looked_ahead = "0"b; 281 text_after_end_msg = "0"b; 282 283 unit_stack_ptr = addr (token (global.n_tokens + 2)); 284 unspec (unit_stack (1)) = ""b; 285 unit_stack (1).type = NO_UNIT; 286 unit_stack_index = 1; 287 288 item_ptr = addr (stmt (global.n_stmts + 2)); 289 unspec (item (1)) = ""b; 290 item (1).type = no_token; 291 item (1).string_ptr = null; 292 item (1).trailer.NLs = 1; 293 294 begin; 295 declare n_items fixed binary; 296 declare prevailing_style_item fixed binary; 297 298 left_margin = 1; 299 n_items = 1; 300 call make_items (1, 1, "1"b, "0"b, n_items); 301 call set_prevailing_style (n_items, prevailing_style_item); 302 303 if global.ca.long 304 & unspec (global.prevailing_style) 305 ^= unspec (global.command_line_style) then 306 call format_pl1_long_ (temp_segs (*), 307 (item (prevailing_style_item).string_ptr)); 308 309 n_items = 1; 310 call make_items (1, 1, "1"b, "1"b, n_items); 311 312 if prevailing_style_item <= n_items then 313 if global.ca.force then 314 call delete_and_record_new_prevailing_style_comment 315 (prevailing_style_item, n_items); 316 else 317 call copy_items (2, n_items); 318 319 else 320 do; 321 call copy_items (2, n_items); 322 call record_style; 323 end; 324 end; 325 326 begin; 327 declare last_stmt_type fixed binary (8); 328 declare stmtx fixed binary; 329 330 last_stmt_type = unknown_statement; 331 stmtx = 2; 332 do while (stmtx <= global.n_stmts); 333 call format_one_statement (stmtx, last_stmt_type); 334 end; 335 end; 336 337 if off_region_ptr ^= null then 338 call copy_off_region (global.source_length); 339 340 do unit_stack_index = unit_stack_index to 2 by -1; 341 if (unit_stack (unit_stack_index).type = BEGIN_UNIT 342 | unit_stack (unit_stack_index).type = DO_UNIT 343 | unit_stack (unit_stack_index).type = PROCEDURE_UNIT) 344 & (^global.rdc_source | unit_stack_index > 2) then 345 call error (3, "Missing end statement.", 346 unit_stack (unit_stack_index).construct_ptr); 347 348 else if unit_stack (unit_stack_index).type = PERCENT_IF_UNIT 349 then 350 call error (3, "Missing %endif macro.", 351 unit_stack (unit_stack_index).construct_ptr); 352 end; 353 354 unrecoverable_error: 355 global.output_length = copy_position - 1; 356 357 return; 358 359 /* Find the prevailing style comment and set the prevailing style. */ 360 361 set_prevailing_style: 362 procedure (n_items, prevailing_style_item); 363 364 declare n_items fixed binary; /* (Input) index of last item before the first token */ 365 declare prevailing_style_item fixed binary; /* (Output) index of prevailing style comment, 366* or n_items + 1 if none */ 367 368 declare item_string char (item (prevailing_style_item) 369 .string_size) 370 based (item (prevailing_style_item) 371 .string_ptr); 372 373 do prevailing_style_item = 2 to n_items 374 while (^item (prevailing_style_item).control_comment); 375 end; 376 377 if prevailing_style_item <= n_items then 378 call format_pl1_modes_ (temp_segs (*), 379 before (after (item_string, control_comment_indicator), 380 close_comment), addr (item_string), "0"b, 381 item (prevailing_style_item).gave_error_msg); 382 383 else if global.ca.require_style_comment then 384 call error (2, 385 "Program does not already contain a prevailing style control comment.", 386 null); 387 388 if global.ca.force then 389 begin; 390 declare 1 control_com_style aligned like style; 391 392 declare command_line_modes char (global.modes_length) 393 based (global.modes_ptr); 394 395 control_com_style = global.current_style; 396 call format_pl1_modes_ (temp_segs (*), command_line_modes, null, 397 "0"b, "1"b); 398 399 if unspec (control_com_style) = unspec (global.current_style) 400 then 401 global.ca.force = "0"b; 402 end; 403 404 global.prevailing_style = global.current_style; 405 left_margin = mode_initcol; 406 407 if mode_on then 408 off_region_ptr = null; 409 else 410 off_region_ptr = global.source_ptr; 411 end set_prevailing_style; 412 413 /* Delete an existing prevailing style control comment and optionally record a new one. */ 414 415 delete_and_record_new_prevailing_style_comment: 416 procedure (prevailing_style_item, n_items); 417 418 declare prevailing_style_item fixed binary; /* (Input) index of prevailing style comment */ 419 declare n_items fixed binary; /* (Input) index of last item before the first token */ 420 421 call copy_items (2, prevailing_style_item - 1); 422 423 if off_region_ptr = null then 424 call record_style; 425 426 else 427 do; 428 call copy_off_region ( 429 char_offset_ ((item (prevailing_style_item).string_ptr))); 430 call record_style; 431 432 if prevailing_style_item < n_items then 433 off_region_ptr = 434 item (prevailing_style_item + 1).string_ptr; 435 436 else if global.n_tokens > 1 then 437 off_region_ptr = token (2).string_ptr; 438 end; 439 440 call copy_items (prevailing_style_item + 1, n_items); 441 end delete_and_record_new_prevailing_style_comment; 442 443 /* Record the prevailing style in the output segment. */ 444 445 record_style: 446 procedure; 447 448 if ^global.ca.record_style then 449 return; 450 451 if off_region_ptr = null then 452 call format_pl1_record_style_ (temp_segs (*), copy_position, 453 line_position); 454 455 else if global.n_tokens <= 1 then 456 do; 457 call copy_off_region (global.source_length); 458 call format_pl1_record_style_ (temp_segs (*), copy_position, 459 line_position); 460 end; 461 462 else 463 do; 464 call copy_off_region (char_offset_ ((token (2).string_ptr))); 465 call format_pl1_record_style_ (temp_segs (*), copy_position, 466 line_position); 467 off_region_ptr = token (2).string_ptr; 468 end; 469 end record_style; 470 471 /* Format a statement. */ 472 473 format_one_statement: 474 procedure (stmtx, last_stmt_type); 475 476 declare stmtx fixed binary; /* (Updated) statement to format */ 477 declare last_stmt_type fixed binary (8); 478 /* (Updated) type of the last statement */ 479 480 declare n_items fixed binary; 481 declare label_start fixed binary; 482 declare label_end fixed binary; 483 declare last_stmt_item fixed binary; 484 declare stmt_type fixed binary (8); 485 486 if stmt (stmtx).type = condition_prefix_list then 487 do; 488 call format_prefix_list (stmtx); 489 if stmtx > global.n_stmts then 490 return; 491 end; 492 493 if stmt (stmtx).type = label_prefix_list then 494 do; 495 label_start = stmt (stmtx).start; 496 label_end = stmt (stmtx).end; 497 498 call format_prefix_list (stmtx); 499 if stmtx > global.n_stmts then 500 return; 501 end; 502 503 else 504 do; 505 label_start = 0; 506 label_end = 0; 507 end; 508 509 stmt_type = stmt (stmtx).type; 510 call convert_stmt_to_items (stmtx, 1, "0"b, n_items); 511 512 if stmt_type = assignment_statement then 513 call format_assignment (n_items); 514 515 else if stmt_type = begin_statement then 516 call format_begin (n_items, last_stmt_type, label_start, 517 label_end); 518 519 else if stmt_type = declare_statement then 520 call format_declare (n_items); 521 522 else if stmt_type = do_statement then 523 call format_do (n_items, last_stmt_type, label_start, label_end) 524 ; 525 526 else if stmt_type = end_statement then 527 call format_end (n_items); 528 529 else if stmt_type = if_statement then 530 call format_if (last_stmt_type, n_items); 531 532 else if stmt_type = else_clause then 533 call format_else (n_items); 534 535 else if stmt_type = on_statement then 536 call format_on (n_items); 537 538 else if stmt_type = procedure_statement then 539 call format_procedure (n_items, label_start, label_end); 540 541 else if stmt_type = entry_statement then 542 call format_entry (n_items); 543 544 else if stmt_type = percent_if_statement then 545 call format_percent_if_macros (n_items, "1"b, "1"b, "1"b); 546 547 else if stmt_type = percent_elseif_statement then 548 call format_percent_if_macros (n_items, "0"b, "1"b, "1"b); 549 550 else if stmt_type = percent_else_statement then 551 call format_percent_if_macros (n_items, "0"b, "1"b, "0"b); 552 553 else if stmt_type = percent_endif_statement then 554 call format_percent_if_macros (n_items, "0"b, "0"b, "0"b); 555 556 else if is_macro_statement (stmt_type) then 557 call format_other (2, n_items, 1, mode_lineconind, "1"b); 558 559 else 560 call format_other (2, n_items, left_margin, mode_lineconind, 561 "1"b); 562 563 do last_stmt_item = n_items by -1 564 while (item (last_stmt_item).type = comment_token); 565 end; 566 567 call copy_items (2, last_stmt_item); 568 569 if ^is_macro_whitespace (stmt_type) then 570 do; 571 call adjust_unit_stack (stmt_type, next_statement (stmtx)); 572 last_stmt_type = stmt_type; 573 end; 574 575 call copy_items (last_stmt_item + 1, n_items); 576 577 stmtx = stmtx + 1; 578 579 return; 580 581 format_prefix_list: 582 procedure (stmtx); 583 584 declare stmtx fixed binary; /* (Updated) prefix list to format */ 585 586 declare first_prefix_item fixed binary; 587 declare itemx fixed binary; 588 declare n_items fixed binary; 589 590 call convert_stmt_to_items (stmtx, 1, "0"b, n_items); 591 592 do first_prefix_item = 2 repeat itemx + 1 593 while (first_prefix_item <= n_items); 594 item (first_prefix_item).header.need_space = 1; 595 596 do itemx = first_prefix_item to n_items 597 while (item (itemx).type ^= colon); 598 end; 599 600 do itemx = itemx to n_items 601 while (item (itemx + 1).type = comment_token); 602 call insert_tab (itemx + 1, mode_comcol); 603 end; 604 605 if stmt (stmtx).type = condition_prefix_list then 606 call format_other (first_prefix_item, itemx, 1, 0, "1"b) 607 ; 608 else 609 call format_other (first_prefix_item, itemx, 1, 610 mode_lineconind, "1"b); 611 end; 612 613 call copy_items (2, n_items); 614 stmtx = stmtx + 1; 615 end format_prefix_list; 616 617 /* Convert the tokens in a statement to items. */ 618 619 convert_stmt_to_items: 620 procedure (P_stmtx, initial_itemx, P_reconverting, P_itemx); 621 622 declare P_stmtx fixed binary; /* (Input) statement to convert */ 623 declare initial_itemx fixed binary; /* (Input) last used item */ 624 declare P_reconverting bit (1) aligned;/* (Input) on if stmt has already been converted in place */ 625 declare P_itemx fixed binary; /* (Output) last item that was converted */ 626 627 declare first_in_item_array bit (1) aligned; 628 declare itemx fixed binary; 629 declare reconverting bit (1) aligned; 630 declare stmtx fixed binary; 631 declare tokenx fixed binary; 632 633 stmtx = P_stmtx; 634 itemx = initial_itemx; 635 first_in_item_array = initial_itemx = 1; 636 reconverting = P_reconverting; 637 638 do tokenx = stmt (stmtx).start to stmt (stmtx).end; 639 call make_items (stmtx, tokenx, first_in_item_array, 640 reconverting, itemx); 641 end; 642 643 P_itemx = itemx; 644 645 item (initial_itemx + 1).header.need_space = 1; 646 item (initial_itemx + 1).header.amount = 1; 647 648 if itemx >= hbound (item, 1) then 649 call error (4, "Too many tokens and comments in a statement.", 650 item (itemx).string_ptr); 651 652 unspec (item (itemx + 1)) = ""b; 653 item (itemx + 1).type = no_token; 654 item (itemx + 1).string_ptr = token (stmt (stmtx).end + 1).string_ptr; 655 656 if first_in_item_array & ^reconverting 657 & stmt (stmtx).type ^= unknown_statement 658 & (token (stmt (stmtx).end).type = semi_colon 659 | ^is_macro_statement (stmt (stmtx + 1).type) 660 | is_macro_whitespace (stmt (stmtx + 1).type)) then 661 if item (itemx).paren_depth > 1 662 | item (itemx).paren_depth = 1 663 & item (itemx).type ^= right_parn then 664 call error (2, "Missing right parenthesis.", 665 item (2).string_ptr); 666 667 else if item (itemx).paren_depth < 0 668 | item (itemx).paren_depth = 0 669 & item (itemx).type = right_parn then 670 call error (2, "Missing left parenthesis.", 671 item (2).string_ptr); 672 end convert_stmt_to_items; 673 674 /* Adjust the unit stack for the next statement. */ 675 676 adjust_unit_stack: 677 procedure (last_stmt_type, stmtx); 678 679 declare last_stmt_type fixed binary (8); 680 /* (Input) type of the last statement */ 681 declare stmtx fixed binary; /* (Input) index of the next statement */ 682 683 if unit_stack (unit_stack_index).type = ON_UNIT 684 & (last_stmt_type ^= on_statement 685 | stmt (stmtx).type = on_statement 686 | stmt (stmtx).type = if_statement) then 687 call pop_unit (0, left_margin, left_margin); 688 689 if last_stmt_type ^= if_statement & last_stmt_type ^= else_clause then 690 if stmt (stmtx).type = else_clause then 691 begin; /* pop unit stack through matching then */ 692 declare loop bit (1) aligned; 693 694 loop = "1"b; 695 do while (loop); 696 if unit_stack (unit_stack_index).type = IF_UNIT 697 then 698 do; 699 loop = "0"b; 700 unit_stack (unit_stack_index).type = 701 ELSE_UNIT; 702 left_margin = 703 unit_stack (unit_stack_index) 704 .close_left_margin; 705 706 if (^unit_stack (unit_stack_index).case 707 | 708 ^unit_stack (unit_stack_index) 709 .in_else_clause 710 & stmt (next_statement (stmtx)).type 711 ^= if_statement) & mode_indthenelse 712 then 713 left_margin = 714 left_margin + mode_ind; 715 end; 716 717 else if unit_stack (unit_stack_index).type 718 = ELSE_UNIT then 719 call pop_unit (0, 0, left_margin); 720 721 else 722 do; 723 loop = "0"b; 724 call error (3, 725 "No if statement preceding else clause.", 726 token (stmt (stmtx).start) 727 .string_ptr); 728 end; 729 end; 730 end; 731 732 else 733 do while (unit_stack (unit_stack_index).type = IF_UNIT 734 | unit_stack (unit_stack_index).type = ELSE_UNIT); 735 call pop_unit (0, 0, left_margin); 736 end; 737 end adjust_unit_stack; 738 739 format_procedure: 740 procedure (n_items, label_start, label_end); 741 742 declare n_items fixed binary; /* (Input) number of items in the statement */ 743 declare label_start fixed binary; /* (Input) first label token */ 744 declare label_end fixed binary; /* (Input) last label token */ 745 746 declare previous_left_margin fixed binary; 747 declare procedure_nest_depth fixed binary; 748 declare unitx fixed binary; 749 750 previous_left_margin = left_margin; 751 752 procedure_nest_depth = 0; 753 do unitx = unit_stack_index to 2 by -1; 754 if unit_stack (unit_stack_index).type = PROCEDURE_UNIT then 755 procedure_nest_depth = procedure_nest_depth + 1; 756 end; 757 758 if procedure_nest_depth < 2 | ^mode_indproc then 759 left_margin = mode_ind + 1; 760 761 call format_other (2, n_items, left_margin, mode_lineconind, "1"b); 762 763 call push_unit (PROCEDURE_UNIT, label_start, label_end, left_margin, 764 previous_left_margin); 765 if mode_indprocbody then 766 left_margin = left_margin + mode_ind; 767 end format_procedure; 768 769 format_assignment: 770 procedure (n_items); 771 772 declare n_items fixed binary; /* (Input) number of items in the statement */ 773 774 if mode_equalind = 0 then 775 call format_other (2, n_items, left_margin, mode_lineconind, 776 "1"b); 777 else 778 begin; 779 declare assignment_item fixed binary; 780 do assignment_item = 2 to n_items 781 while (item (assignment_item).type ^= assignment); 782 end; 783 784 call format_other (2, assignment_item - 1, left_margin, 785 mode_lineconind, "0"b); 786 call format_other (assignment_item, n_items, 787 left_margin + mode_equalind, mode_lineconind, "1"b); 788 end; 789 end format_assignment; 790 791 format_begin: 792 procedure (n_items, last_stmt_type, label_start, label_end); 793 794 declare n_items fixed binary; /* (Input) number of items in the statement */ 795 declare last_stmt_type fixed binary (8); 796 /* (Input) type of the last nonwhitespace stmt */ 797 declare label_start fixed binary; /* (Input) first label token */ 798 declare label_end fixed binary; /* (Input) last label token */ 799 800 declare previous_left_margin fixed binary; 801 802 call format_other (2, n_items, left_margin, mode_lineconind, "1"b); 803 804 previous_left_margin = left_margin; 805 806 if last_stmt_type ^= if_statement & last_stmt_type ^= else_clause 807 & last_stmt_type ^= on_statement then 808 do; 809 if mode_indbegin then 810 do; 811 left_margin = left_margin + mode_ind; 812 call push_unit (BEGIN_UNIT, label_start, label_end, 813 indent_margin (mode_indbeginend, left_margin), 814 previous_left_margin); 815 end; 816 else 817 call push_unit (BEGIN_UNIT, label_start, label_end, 818 left_margin, previous_left_margin); 819 end; 820 else 821 do; 822 if mode_indthenbegin then 823 left_margin = left_margin + mode_ind; 824 call push_unit (BEGIN_UNIT, label_start, label_end, 825 indent_margin (mode_indthenbeginend, left_margin), 826 previous_left_margin); 827 end; 828 829 end format_begin; 830 831 format_do: 832 procedure (n_items, last_stmt_type, label_start, label_end); 833 834 declare n_items fixed binary; /* (Input) number of items in the statement */ 835 declare last_stmt_type fixed binary (8); 836 /* (Input) type of the last non whitespace stmt */ 837 declare label_start fixed binary; /* (Input) first label token */ 838 declare label_end fixed binary; /* (Input) last label token */ 839 840 declare indent_end bit (1); 841 declare previous_left_margin fixed binary; 842 843 call format_other (2, n_items, left_margin, mode_lineconind, "1"b); 844 845 previous_left_margin = left_margin; 846 847 if last_stmt_type = if_statement | last_stmt_type = else_clause 848 | last_stmt_type = on_statement then 849 if stmt (stmtx).subtype = subtype_noniterative_do then 850 do; 851 if mode_indnoniterdo then 852 left_margin = left_margin + mode_ind; 853 854 indent_end = mode_indnoniterend; 855 end; 856 857 else 858 do; 859 if mode_inditerdo then 860 left_margin = left_margin + mode_ind; 861 862 indent_end = mode_indend; 863 end; 864 865 else 866 do; 867 left_margin = left_margin + mode_ind; 868 indent_end = mode_indend; 869 end; 870 871 call push_unit (DO_UNIT, label_start, label_end, 872 indent_margin (indent_end, left_margin), previous_left_margin); 873 end format_do; 874 875 format_entry: 876 procedure (n_items); 877 878 declare n_items fixed binary; /* (Input) number of items in the statement */ 879 880 declare unitx fixed binary; 881 882 do unitx = unit_stack_index to 2 by -1 883 while (unit_stack (unitx).type ^= PROCEDURE_UNIT); 884 end; 885 886 if unit_stack (unitx).type = PROCEDURE_UNIT then 887 call format_other (2, n_items, 888 (unit_stack (unitx).close_left_margin), mode_lineconind, 889 "1"b); 890 else 891 call format_other (2, n_items, mode_ind + 1, mode_lineconind, 892 "1"b); 893 end format_entry; 894 895 format_end: 896 procedure (n_items); 897 898 declare n_items fixed binary; /* (Input) number of items in the statement */ 899 900 declare previous_left_margin fixed binary; 901 902 if unit_stack_index = 2 & stmtx < global.n_stmts & ^text_after_end_msg 903 then 904 do; 905 call error (3, "Text follows logical end of program.", 906 token (stmt (stmtx + 1).start).string_ptr); 907 text_after_end_msg = "1"b; 908 end; 909 910 if unit_stack_index > 1 then 911 if token (stmt (stmtx).start + 1).type = identifier then 912 call pop_unit (stmt (stmtx).start + 1, left_margin, 913 previous_left_margin); 914 else 915 call pop_unit (0, left_margin, previous_left_margin); 916 917 else 918 do; 919 left_margin = 1; 920 previous_left_margin = mode_ind + 1; 921 call error (3, "End statement follows logical end of program.", 922 item (2).string_ptr); 923 end; 924 925 call format_other (2, n_items, left_margin, mode_lineconind, "1"b); 926 927 left_margin = previous_left_margin; 928 end format_end; 929 930 /* ************************************************************************ 931* * format_if - procedure to format an if statement. * 932* * previous_left_margin - left margin when this proc is entered. * 933* * if_statement_left_margin - the column this if statement will begin * 934* * in. This is used to get "else if" statements so that the if * 935* * begins one space after the else regardless of mode_ind. * 936* * if_statement_lineconind - this is an adjustment to the line * 937* * continuation value so that line continuations are placed * 938* * mode_lineconind from the begining of the "else if" instead * 939* * mode_lineconind from the "if". We are treating "else if" as * 940* * if it were one statement. * 941* ************************************************************************ */ 942 943 format_if: 944 procedure (last_stmt_type, n_items); 945 946 declare last_stmt_type fixed binary (8); 947 /* (Input) type of the last statement */ 948 declare n_items fixed binary; /* (Input) number of items in the statement */ 949 950 declare current_mode_case bit (1) aligned; 951 declare then_item fixed binary; 952 declare previous_left_margin fixed binary; 953 declare if_statement_left_margin 954 fixed binary; 955 declare if_statement_lineconind fixed binary; 956 957 declare third_item_string char (item (3).string_size) 958 based (item (3).string_ptr); 959 960 current_mode_case = mode_case; 961 962 if last_stmt_type = if_statement | last_stmt_type = else_clause then 963 current_mode_case = unit_stack (unit_stack_index).case; 964 965 if item (3).type = comment_token then 966 if third_item_string = case_control_comment then 967 current_mode_case = "1"b; 968 969 else if third_item_string = tree_control_comment then 970 current_mode_case = "0"b; 971 972 previous_left_margin = left_margin; 973 974 if last_stmt_type = else_clause & current_mode_case then 975 do; 976 left_margin = unit_stack (unit_stack_index).close_left_margin; 977 if_statement_left_margin = left_margin + length ("else") + 1; 978 if_statement_lineconind = 979 mode_lineconind - (length ("else") + 1); 980 end; 981 else 982 do; 983 if_statement_left_margin = previous_left_margin; 984 if_statement_lineconind = mode_lineconind; 985 end; 986 987 call push_unit (IF_UNIT, 0, 0, left_margin, previous_left_margin); 988 unit_stack (unit_stack_index).case = current_mode_case; 989 unit_stack (unit_stack_index).in_else_clause = 990 last_stmt_type = else_clause; 991 992 if mode_indthenelse then 993 left_margin = left_margin + mode_ind; 994 995 do then_item = n_items by -1 996 while (item (then_item).type = comment_token); 997 end; 998 999 if is_ifthenstmt (stmtx, last_stmt_type, current_mode_case) 1000 & mode_ifthenstmt then 1001 begin; 1002 declare last_item fixed binary; 1003 declare may_be_ifthenstmt bit (1) aligned; 1004 1005 call convert_stmt_to_items (stmtx + 1, n_items, "0"b, last_item) 1006 ; 1007 1008 may_be_ifthenstmt = "1"b; 1009 1010 if stmt (stmtx + 1).type = on_statement then 1011 if may_be_one_line_on_unit (stmtx + 1) then 1012 call convert_stmt_to_items (stmtx + 2, 1013 (last_item), "0"b, last_item); 1014 else 1015 may_be_ifthenstmt = "0"b; 1016 1017 if may_be_ifthenstmt then 1018 do; 1019 call format_other (2, last_item, 1020 if_statement_left_margin, if_statement_lineconind, 1021 "1"b); 1022 call look_ahead_if_is_on_one_line (stmtx, 2, last_item, 1023 looked_ahead); 1024 end; 1025 end; 1026 1027 else if stmt (stmtx + 1).subtype = subtype_noniterative_do 1028 & mode_ifthendo then 1029 begin; 1030 declare itemx fixed binary; 1031 declare last_item fixed binary; 1032 declare then_item_NLs fixed binary; 1033 1034 call convert_stmt_to_items (stmtx + 1, n_items, "0"b, last_item) 1035 ; 1036 then_item_NLs = item (then_item).trailer.NLs; 1037 call format_other (2, last_item, if_statement_left_margin, 1038 if_statement_lineconind, "1"b); 1039 1040 do itemx = last_item by -1 1041 while (item (itemx).type = comment_token); 1042 end; 1043 1044 do itemx = itemx to then_item by -1 1045 while (^item (itemx).header.tab); 1046 end; 1047 1048 if itemx < then_item & ^mode_thendo then 1049 looked_ahead = "1"b; 1050 else 1051 do; 1052 item (then_item).trailer.NLs = then_item_NLs; 1053 call convert_stmt_to_items (stmtx + 1, n_items, "0"b, 1054 last_item); 1055 call format_other (then_item, last_item, left_margin, 1056 mode_lineconind, "1"b); 1057 call look_ahead_if_is_on_one_line (stmtx, then_item, 1058 last_item, looked_ahead); 1059 end; 1060 end; 1061 1062 if ^looked_ahead then 1063 if mode_ifthen then 1064 begin; 1065 declare itemx fixed binary; 1066 1067 do itemx = then_item + 1 by 1 1068 while (item (itemx).type = comment_token); 1069 call insert_tab (itemx, mode_comcol); 1070 end; 1071 1072 call format_other (2, n_items, if_statement_left_margin, 1073 if_statement_lineconind, "0"b); 1074 1075 end; 1076 1077 else 1078 begin; 1079 declare itemx fixed binary; 1080 1081 do itemx = then_item - 1 by -1 1082 while (item (itemx).type = comment_token); 1083 call insert_tab (itemx, mode_comcol); 1084 end; 1085 1086 call format_other (2, then_item - 1, 1087 if_statement_left_margin, if_statement_lineconind, 1088 "1"b); 1089 call format_other (then_item, n_items, left_margin, 1090 mode_lineconind, "0"b); 1091 end; 1092 1093 if mode_ifthen then 1094 left_margin = left_margin + mode_ind; 1095 else 1096 left_margin = 1097 left_margin + clause_indentation (stmt (stmtx + 1).type); 1098 1099 return; 1100 1101 is_ifthenstmt: 1102 procedure (stmtx, last_stmt_type, case) returns (bit (1) aligned); 1103 1104 declare stmtx fixed binary; /* (Input) current if statement */ 1105 declare last_stmt_type fixed binary (8); 1106 /* (Input) type of last statement */ 1107 declare case bit (1) aligned;/* (Input) current mode case */ 1108 1109 if ^is_independent_statement (stmt (stmtx + 1).type) 1110 | stmt (stmtx + 1).type = if_statement then 1111 return ("0"b); 1112 1113 if stmt (stmtx + 2).type ^= else_clause then 1114 return ("1"b); 1115 1116 return (case 1117 & (last_stmt_type = else_clause 1118 | stmt (next_statement (stmtx + 2)).type = if_statement)); 1119 end is_ifthenstmt; 1120 1121 end format_if; 1122 1123 format_else: 1124 procedure (n_items); 1125 1126 declare n_items fixed binary; /* (Input) number of items in the statement */ 1127 1128 if stmt (stmtx + 1).subtype = subtype_noniterative_do & mode_ifthendo 1129 then 1130 begin; 1131 declare last_item fixed binary; 1132 1133 call convert_stmt_to_items (stmtx + 1, n_items, "0"b, last_item) 1134 ; 1135 call format_other (2, last_item, left_margin, mode_lineconind, 1136 "1"b); 1137 call look_ahead_if_is_on_one_line (stmtx, 2, last_item, 1138 looked_ahead); 1139 end; 1140 1141 if ^looked_ahead then 1142 if mode_elsestmt then 1143 call format_other (2, n_items, left_margin, 1144 mode_lineconind, "0"b); 1145 else 1146 do; 1147 if stmt (stmtx + 1).type = if_statement 1148 & unit_stack (unit_stack_index).case then 1149 call format_other (2, n_items, left_margin, 1150 mode_lineconind, "0"b); 1151 else 1152 call format_other (2, n_items, left_margin, 1153 mode_lineconind, "1"b); 1154 end; 1155 1156 if mode_elsestmt then 1157 left_margin = 1158 left_margin + clause_indentation (stmt (stmtx + 1).type); 1159 else 1160 left_margin = left_margin + mode_ind; 1161 end format_else; 1162 1163 clause_indentation: 1164 procedure (clause_type) returns (fixed binary); 1165 1166 declare clause_type fixed binary (8) unaligned; 1167 /* (Input) type of then clause or else clause */ 1168 1169 /* length ("then") = length ("else") */ 1170 1171 if is_independent_statement (clause_type) then 1172 return (max (length ("then") + 1, mode_ind)); 1173 else 1174 return (mode_ind); 1175 end clause_indentation; 1176 1177 next_statement: 1178 procedure (this_stmtx) returns (fixed binary); 1179 1180 declare this_stmtx fixed binary; /* (Input) current statement */ 1181 1182 declare stmtx fixed binary; 1183 1184 do stmtx = this_stmtx + 1 by 1 1185 while (stmt (stmtx).type = condition_prefix_list 1186 | stmt (stmtx).type = label_prefix_list 1187 | is_macro_whitespace (stmt (stmtx).type)); 1188 end; 1189 1190 return (stmtx); 1191 end next_statement; 1192 1193 format_on: 1194 procedure (n_items); 1195 1196 declare n_items fixed binary; /* (Input) number of items in the statement */ 1197 1198 if may_be_one_line_on_unit (stmtx) then 1199 if ^looked_ahead then 1200 begin; 1201 declare last_item fixed binary; 1202 1203 call convert_stmt_to_items (stmtx + 1, n_items, "0"b, 1204 last_item); 1205 call format_other (2, last_item, left_margin, 1206 mode_lineconind, "1"b); 1207 call look_ahead_if_is_on_one_line (stmtx, 2, last_item, 1208 looked_ahead); 1209 end; 1210 1211 if ^looked_ahead then 1212 call format_other (2, n_items, left_margin, mode_lineconind, 1213 "1"b); 1214 1215 call push_unit (ON_UNIT, 0, 0, left_margin, left_margin); 1216 left_margin = left_margin + mode_ind; 1217 end format_on; 1218 1219 may_be_one_line_on_unit: 1220 procedure (stmtx) returns (bit (1) aligned); 1221 1222 declare stmtx fixed binary; /* (Input) on statement index */ 1223 1224 return (is_independent_statement (stmt (stmtx + 1).type) 1225 & stmt (stmtx + 1).type ^= if_statement 1226 & stmt (stmtx + 1).type ^= on_statement 1227 & stmt (stmtx + 1).type ^= return_statement 1228 & stmt (stmtx + 1).type ^= revert_statement); 1229 end may_be_one_line_on_unit; 1230 1231 look_ahead_if_is_on_one_line: 1232 procedure (stmtx, first_item, last_item, looked_ahead); 1233 1234 declare stmtx fixed binary; /* (Input) current statement */ 1235 declare first_item fixed binary; /* (Input) first item to check */ 1236 declare last_item fixed binary; /* (Input) last item to check */ 1237 declare looked_ahead bit (1) aligned;/* (Output) on if next statement fits on the current line */ 1238 1239 declare itemx fixed binary; 1240 declare last_stmt_item fixed binary; 1241 1242 do last_stmt_item = last_item by -1 1243 while (item (last_stmt_item).type = comment_token); 1244 end; 1245 1246 if item (last_stmt_item).type ^= semi_colon then 1247 last_stmt_item = last_item + 1; 1248 1249 do itemx = first_item to last_stmt_item - 1 1250 while (item (itemx).trailer.NLs = 0); 1251 end; 1252 1253 looked_ahead = itemx >= last_stmt_item; 1254 1255 if ^looked_ahead then 1256 call convert_stmt_to_items (stmtx, 1, "1"b, itemx); 1257 end look_ahead_if_is_on_one_line; 1258 1259 format_percent_if_macros: 1260 procedure (n_items, first_clause, start_clause, has_percent_then); 1261 1262 declare n_items fixed binary; /* (Input) number of items in the macro */ 1263 declare first_clause bit (1) aligned;/* (Input) on to start new macro: %if */ 1264 declare start_clause bit (1) aligned;/* (Input) on to start new clause: %if, %elseif, %else */ 1265 declare has_percent_then bit (1) aligned;/* (Input) on if macro has %then: %if, %elseif */ 1266 1267 declare itemx fixed binary; 1268 1269 if ^first_clause then 1270 if start_clause then 1271 do; 1272 do while (unit_stack (unit_stack_index).type 1273 ^= PERCENT_IF_UNIT & unit_stack_index >= 2); 1274 call pop_unit (0, 0, left_margin); 1275 end; 1276 1277 if unit_stack (unit_stack_index).type = PERCENT_IF_UNIT 1278 then 1279 call pop_unit (0, left_margin, left_margin); 1280 else 1281 call error (3, "No preceding %if macro.", 1282 item (2).string_ptr); 1283 end; 1284 1285 else 1286 begin; 1287 declare unitx fixed binary; 1288 1289 do unitx = unit_stack_index to 2 by -1 1290 while (unit_stack (unitx).type ^= PERCENT_IF_UNIT); 1291 end; 1292 1293 if unit_stack (unitx).type = PERCENT_IF_UNIT then 1294 do; 1295 do unitx = unitx + 1 to unit_stack_index; 1296 unit_stack (unitx - 1) = 1297 unit_stack (unitx); 1298 end; 1299 1300 unit_stack_index = unit_stack_index - 1; 1301 end; 1302 1303 else 1304 call error (3, 1305 "No %if macro preceding %endif macro.", 1306 item (2).string_ptr); 1307 end; 1308 1309 if start_clause then 1310 call push_unit (PERCENT_IF_UNIT, 0, 0, left_margin, left_margin) 1311 ; 1312 1313 do itemx = n_items by -1 while (item (itemx).type = comment_token); 1314 call insert_tab (itemx, mode_comcol); 1315 end; 1316 1317 call format_other (2, n_items, 1, mode_lineconind, "1"b); 1318 1319 if has_percent_then & item (itemx).header.tab then 1320 call insert_tab (itemx, 1); 1321 end format_percent_if_macros; 1322 1323 format_declare: 1324 procedure (n_items); 1325 1326 declare n_items fixed binary; /* (Input) number of items in the statement */ 1327 1328 declare declare_margin fixed binary; 1329 declare factored_level_number bit (1) aligned; 1330 declare id_start_col fixed binary; 1331 declare itemx fixed binary; 1332 declare levels_ptr pointer; 1333 declare levelx fixed binary; 1334 declare tokenx fixed binary; 1335 1336 declare levels (0:sys_info$max_seg_size 1337 - binary (rel (levels_ptr), 18) - 1) 1338 fixed binary based (levels_ptr); 1339 1340 tokenx = n_items + 1; 1341 do itemx = tokenx to 2 by -1; 1342 item (itemx).next_token = tokenx; 1343 1344 if item (itemx).type ^= comment_token then 1345 tokenx = itemx; 1346 end; 1347 1348 levels_ptr = addr (item (n_items + 2)); 1349 levels (0) = -1; 1350 levelx = 0; 1351 1352 factored_level_number = "0"b; 1353 itemx = 2; 1354 1355 if mode_inddcls then 1356 declare_margin = left_margin; 1357 else 1358 declare_margin = 1; 1359 1360 if item (itemx).string_size = length ("dcl") then 1361 id_start_col = declare_margin + mode_dclind; 1362 else 1363 id_start_col = declare_margin + mode_declareind; 1364 1365 call insert_tab (itemx, declare_margin); 1366 1367 itemx = item (itemx).next_token; 1368 call declaration_list; 1369 1370 itemx = item (itemx).next_token; 1371 call insert_NL (itemx - 1, 0); 1372 1373 return; 1374 1375 declaration_list: 1376 procedure; 1377 1378 declare declare_stack_index fixed binary; 1379 declare declare_stack_ptr pointer; 1380 1381 declare 1 declare_stack ( 1382 divide (sys_info$max_seg_size 1383 - binary (rel (declare_stack_ptr), 18), 1384 2, 17)) aligned 1385 based (declare_stack_ptr), 1386 2 state fixed binary (17) unaligned, 1387 2 flags unaligned, 1388 3 has_level_number bit (1), 1389 3 pad bit (17), 1390 2 component_start fixed binary (17); 1391 1392 declare item_string char (item (itemx).string_size) 1393 based (item (itemx).string_ptr); 1394 1395 declare ( 1396 START_COMPONENT initial (0), 1397 WANT_RIGHT_PAREN initial (1), 1398 WANT_ATTRIBUTE_SET initial (2) 1399 ) fixed binary internal static 1400 options (constant); 1401 1402 declare_stack_ptr = addr (unit_stack (unit_stack_index + 1)); 1403 declare_stack_index = 0; 1404 1405 call push_declare_stack_entry (declare_stack_index); 1406 do while (declare_stack_index > 0); 1407 if declare_stack (declare_stack_index).state = START_COMPONENT 1408 then 1409 do; 1410 declare_stack (declare_stack_index).state = 1411 WANT_ATTRIBUTE_SET; 1412 declare_stack (declare_stack_index).has_level_number = 1413 "0"b; 1414 declare_stack (declare_stack_index).component_start = 1415 itemx; 1416 1417 if item (itemx).type = dec_integer then 1418 begin; 1419 declare level fixed binary; 1420 1421 level = binary (item_string, 17); 1422 1423 do levelx = levelx to 1 by -1 1424 while (levels (levelx) >= level); 1425 end; 1426 1427 if levelx >= hbound (levels, 1) then 1428 call error (4, "Too many levels.", 1429 item (itemx).string_ptr); 1430 1431 levelx = levelx + 1; 1432 levels (levelx) = level; 1433 declare_stack (declare_stack_index) 1434 .has_level_number = "1"b; 1435 1436 if factored_level_number then 1437 call error (3, 1438 "Level number within the scope of a factored level number.", 1439 item (itemx).string_ptr); 1440 1441 itemx = item (itemx).next_token; 1442 end; 1443 1444 else if ^factored_level_number 1445 & item (itemx).type ^= left_parn then 1446 levelx = 0; 1447 1448 call insert_tab (declare_stack (declare_stack_index) 1449 .component_start, structure_id_start_col (levelx)); 1450 1451 if item (itemx).type = identifier then 1452 itemx = item (itemx).next_token; 1453 1454 else if item (itemx).type = left_parn then 1455 begin; 1456 declare ix fixed binary; 1457 1458 factored_level_number = 1459 declare_stack (declare_stack_index) 1460 .has_level_number; 1461 1462 call completely_factored_declaration_list ( 1463 itemx, ix); 1464 if ix > 0 then 1465 itemx = ix; 1466 else 1467 do; 1468 itemx = item (itemx).next_token; 1469 declare_stack (declare_stack_index) 1470 .state = WANT_RIGHT_PAREN; 1471 call push_declare_stack_entry ( 1472 declare_stack_index); 1473 end; 1474 end; 1475 1476 else if ^is_macro_statement (stmt (stmtx + 1).type) then 1477 call error (3, 1478 "Syntax error in declaration component.", 1479 item (itemx).string_ptr); 1480 end; 1481 1482 else if declare_stack (declare_stack_index).state 1483 = WANT_RIGHT_PAREN then 1484 do; 1485 declare_stack (declare_stack_index).state = 1486 WANT_ATTRIBUTE_SET; 1487 1488 if item (itemx).type = right_parn then 1489 begin; 1490 declare ix fixed binary; 1491 1492 do ix = itemx - 1 by -1 1493 while (item (ix).type = comment_token); 1494 call insert_tab (ix, mode_comcol); 1495 end; 1496 1497 call insert_NL (itemx - 1, 1498 structure_id_start_col (levelx)); 1499 itemx = item (itemx).next_token; 1500 end; 1501 1502 else if ^is_macro_statement (stmt (stmtx + 1).type) then 1503 call error (3, 1504 "Missing right parenthesis after declaration list.", 1505 item (itemx).string_ptr); 1506 1507 if declare_stack (declare_stack_index).has_level_number 1508 then 1509 factored_level_number = "0"b; 1510 end; 1511 1512 else 1513 do; /* WANT_ATTRIBUTE_SET */ 1514 call attribute_set (id_start_col + mode_idind, itemx); 1515 1516 if mode_indattr then 1517 if declare_stack (declare_stack_index) 1518 .has_level_number then 1519 call tab_continuation_lines ( 1520 declare_stack (declare_stack_index) 1521 .component_start + 1, itemx, 1522 structure_id_start_col (levelx) 1523 + mode_ind); 1524 else 1525 call tab_continuation_lines ( 1526 declare_stack (declare_stack_index) 1527 .component_start + 1, itemx, 1528 structure_id_start_col (levelx)); 1529 1530 else if item (itemx).type = comma 1531 | item (itemx).type = semi_colon then 1532 call format_other ( 1533 declare_stack (declare_stack_index) 1534 .component_start, itemx, 1535 structure_id_start_col (levelx), 1536 mode_lineconind, "0"b); 1537 else 1538 call format_other ( 1539 declare_stack (declare_stack_index) 1540 .component_start, itemx - 1, 1541 structure_id_start_col (levelx), 1542 mode_lineconind, "0"b); 1543 1544 if item (itemx).type = comma then 1545 do; 1546 itemx = item (itemx).next_token; 1547 call insert_NL (itemx - 1, 0); 1548 declare_stack (declare_stack_index).state = 1549 START_COMPONENT; 1550 end; 1551 1552 else 1553 declare_stack_index = declare_stack_index - 1; 1554 end; 1555 end; 1556 1557 return; 1558 1559 push_declare_stack_entry: 1560 procedure (declare_stack_index); 1561 1562 declare declare_stack_index fixed binary; /* (Updated) top of the declare_stack */ 1563 1564 if declare_stack_index >= hbound (declare_stack, 1) then 1565 call error (4, "Declaration lists nested too deep.", 1566 item (itemx).string_ptr); 1567 1568 declare_stack_index = declare_stack_index + 1; 1569 unspec (declare_stack (declare_stack_index)) = ""b; 1570 declare_stack (declare_stack_index).state = START_COMPONENT; 1571 end push_declare_stack_entry; 1572 1573 /* Format a declaration list if it has all the attributes factored, doesn't 1574* contain any comments, and the identifiers don't contain dollar signs. */ 1575 1576 completely_factored_declaration_list: 1577 procedure (first_item, last_item); 1578 1579 declare first_item fixed binary; /* (Input) left paren preceding declaration list */ 1580 declare last_item fixed binary; /* (Output) item after right paren of declaration component, 1581* or 0 if not a completely factored declaration list */ 1582 1583 declare itemx fixed binary; 1584 1585 declare item_string char (item (itemx).string_size) 1586 based (item (itemx).string_ptr); 1587 1588 last_item = 0; 1589 itemx = first_item + 1; 1590 1591 if item (itemx).type ^= identifier then 1592 return; 1593 1594 do itemx = itemx + 1 repeat itemx + 1 while (item (itemx).type = comma); 1595 itemx = itemx + 1; 1596 1597 if item (itemx).type ^= identifier then 1598 return; 1599 1600 if index (item_string, "$") > 0 then 1601 return; 1602 end; 1603 1604 if item (itemx).type ^= right_parn then 1605 return; 1606 1607 if ^factored_level_number then 1608 levelx = 0; 1609 1610 if declare_stack (declare_stack_index).has_level_number then 1611 call format_other (declare_stack (declare_stack_index) 1612 .component_start, itemx, structure_id_start_col (levelx), 1613 mode_lineconind, "0"b); 1614 else 1615 call format_other (declare_stack (declare_stack_index) 1616 .component_start, itemx, structure_id_start_col (levelx), 0, 1617 "0"b); 1618 1619 if declare_stack (declare_stack_index).has_level_number then 1620 factored_level_number = "0"b; 1621 1622 last_item = itemx + 1; 1623 end completely_factored_declaration_list; 1624 1625 attribute_set: 1626 procedure (start_col, itemx); 1627 1628 declare start_col fixed binary; /* (Input) column the attributes start in */ 1629 declare itemx fixed binary; /* (Updated) current item */ 1630 1631 declare first_item fixed binary; 1632 declare initial_paren_depth fixed binary; 1633 1634 declare item_string char (item (itemx).string_size) 1635 based (item (itemx).string_ptr); 1636 1637 first_item = itemx; 1638 do while (item (itemx).type ^= comma & item (itemx).type ^= semi_colon 1639 & item (itemx).type ^= right_parn & item (itemx).type ^= no_token); 1640 if item (itemx).type = identifier then 1641 do; 1642 item (itemx).type = keyword_token; 1643 item (itemx).precedence = precedence (keyword_token); 1644 1645 /* if item_string = "entry" 1646* then call entry_attribute; 1647* else if item_string = "returns" 1648* then call returns_attribute; 1649* else if item_string = "generic" 1650* then call generic_attribute; 1651* else */ 1652 1653 if item_string = "like" then 1654 do; 1655 itemx = item (itemx).next_token; 1656 1657 if item (itemx).type = identifier then 1658 do; 1659 itemx = item (itemx).next_token; 1660 do while (item (itemx).type = period); 1661 itemx = item (itemx).next_token; 1662 1663 if item (itemx).type 1664 = identifier then 1665 itemx = 1666 item (itemx) 1667 .next_token; 1668 end; 1669 end; 1670 end; 1671 1672 else if item_string = "defined" | item_string = "def" 1673 then 1674 do; 1675 initial_paren_depth = item (itemx).paren_depth; 1676 do itemx = item (itemx).next_token 1677 repeat item (itemx).next_token 1678 while (item (itemx).paren_depth 1679 > initial_paren_depth & itemx < n_items 1680 | item (itemx).type ^= comma 1681 & item (itemx).type ^= semi_colon 1682 & item (itemx).type ^= right_parn 1683 & (item (itemx).type ^= identifier 1684 | 1685 ^ 1686 could_end_a_reference (item (itemx - 1) 1687 .type))); 1688 end; 1689 end; 1690 1691 else 1692 itemx = item (itemx).next_token; 1693 end; 1694 1695 else if item (itemx).type = left_parn then 1696 do; 1697 initial_paren_depth = item (itemx).paren_depth; 1698 do itemx = item (itemx).next_token 1699 repeat item (itemx).next_token 1700 while (item (itemx).paren_depth 1701 >= initial_paren_depth); 1702 end; 1703 end; 1704 1705 else 1706 itemx = item (itemx).next_token; 1707 end; 1708 1709 if first_item < itemx & mode_indattr then 1710 if item (itemx).type = comma | item (itemx).type = semi_colon 1711 then 1712 call format_other (first_item, itemx, start_col, 0, 1713 "0"b); 1714 else 1715 call format_other (first_item, itemx - 1, start_col, 0, 1716 "0"b); 1717 1718 return; 1719 1720 could_end_a_reference: 1721 procedure (type) returns (bit (1) aligned); 1722 1723 declare type fixed binary (8) unaligned; 1724 /* (Input) token type which might end a reference */ 1725 1726 return (type = identifier | type = isub | type = right_parn 1727 | min_constant_token <= type & type <= max_constant_token); 1728 end could_end_a_reference; 1729 1730 end attribute_set; 1731 1732 structure_id_start_col: 1733 procedure (level) returns (fixed binary); 1734 1735 declare level fixed binary; /* (Input) current normalized structure level */ 1736 1737 return (id_start_col + mode_struclvlind * max (0, level - 1)); 1738 end structure_id_start_col; 1739 1740 end declaration_list; 1741 1742 end format_declare; 1743 1744 /* Format items using the precedence rules. */ 1745 1746 format_other: 1747 procedure (first_item, last_item, start_col, continuation_indent, 1748 insert_final_NL_sw); 1749 1750 declare first_item fixed binary; /* (Input) first item to format */ 1751 declare last_item fixed binary; /* (Input) last item to format */ 1752 declare start_col fixed binary; /* (Input) left margin for this statement fragment */ 1753 declare continuation_indent fixed binary; /* (Input) number of columns to indent continuation lines */ 1754 declare insert_final_NL_sw bit (1) aligned;/* (Input) on to insert a NL after last_item */ 1755 1756 declare first_on_line fixed binary; 1757 declare ix fixed binary; 1758 declare last_line_pos fixed binary; 1759 1760 declare ix_item_string char (item (ix).string_size) 1761 based (item (ix).string_ptr); 1762 declare last_ix_item_string char (item (ix - 1).string_size) 1763 based (item (ix - 1).string_ptr); 1764 1765 if looked_ahead then 1766 do; 1767 looked_ahead = "0"b; 1768 return; 1769 end; 1770 1771 call insert_tab (first_item, start_col); 1772 call tab_continuation_lines (first_item + 1, last_item, 1773 start_col + continuation_indent); 1774 1775 if ^mode_insnl then 1776 return; 1777 1778 first_on_line = first_item; 1779 do while (first_on_line <= last_item); 1780 do ix = first_on_line to last_item 1781 while (item (ix - 1).last_col <= mode_ll 1782 | ix = first_on_line); 1783 if item (ix).header.tab then 1784 do; 1785 first_on_line = ix; 1786 last_line_pos = -1; 1787 end; 1788 1789 else if item (ix - 1).type = char_string 1790 | item (ix - 1).type = comment_token then 1791 if search (last_ix_item_string, NL_VT_NP) = 0 1792 then 1793 last_line_pos = item (ix - 1).last_col; 1794 else 1795 last_line_pos = 1796 last_line_position (1, 1797 last_ix_item_string); 1798 1799 else 1800 last_line_pos = item (ix - 1).last_col; 1801 1802 if item (ix).type = char_string 1803 | item (ix).type = comment_token then 1804 item (ix).last_col = 1805 next_line_position (last_line_pos 1806 + item (ix).header.amount + 1, 1807 ix_item_string) - 1; 1808 else 1809 item (ix).last_col = 1810 last_line_pos + item (ix).header.amount 1811 + item (ix).string_size; 1812 end; 1813 1814 if item (ix - 1).last_col <= mode_ll then 1815 first_on_line = ix; 1816 else 1817 begin; 1818 declare last_on_line fixed binary; 1819 declare low_paren_depth fixed binary; 1820 declare low_precedence fixed binary; 1821 1822 last_on_line = ix - 1; 1823 do first_on_line = first_on_line to last_on_line 1824 while (item (first_on_line).last_col 1825 < start_col + continuation_indent); 1826 end; 1827 1828 if item_should_end_line (item (last_on_line).type) then 1829 do; 1830 low_paren_depth = 1f5; 1831 low_precedence = 1f5; 1832 end; 1833 1834 else 1835 do; 1836 low_paren_depth = 1837 item (last_on_line).paren_depth; 1838 low_precedence = item (last_on_line).precedence; 1839 end; 1840 1841 do ix = first_on_line + 1 to last_on_line - 1; 1842 if item (ix).paren_depth < low_paren_depth 1843 | item (ix).paren_depth = low_paren_depth 1844 & item (ix).precedence <= low_precedence 1845 then 1846 do; 1847 last_on_line = ix; 1848 low_paren_depth = item (ix).paren_depth; 1849 low_precedence = item (ix).precedence; 1850 end; 1851 end; 1852 1853 if ^item_should_end_line (item (last_on_line).type) then 1854 if first_on_line < last_on_line then 1855 last_on_line = last_on_line - 1; 1856 else if item (last_on_line + 1).type = comma 1857 then 1858 last_on_line = last_on_line + 1; 1859 1860 call insert_NL (last_on_line, 1861 start_col + continuation_indent); 1862 first_on_line = last_on_line + 1; 1863 end; 1864 end; 1865 1866 if insert_final_NL_sw then 1867 call insert_NL (last_item, 0); 1868 1869 return; 1870 1871 item_should_end_line: 1872 procedure (type) returns (bit (1) aligned); 1873 1874 declare type fixed binary (8) unaligned; 1875 /* (Input) token type */ 1876 1877 return (type = comma | type = target_comma | type = right_parn 1878 | type = assignment); 1879 end item_should_end_line; 1880 1881 end format_other; 1882 1883 push_unit: 1884 procedure (unit_type, label_start, label_end, close_left_margin, 1885 previous_left_margin); 1886 1887 declare unit_type fixed binary; /* (Input) type of unit to push */ 1888 declare label_start fixed binary; /* (Input) first token in the statement's label prefixes */ 1889 declare label_end fixed binary; /* (Input) last token in the statement's label prefixes */ 1890 declare close_left_margin fixed binary; /* (Input) left margin for corresponding 'end' statement */ 1891 declare previous_left_margin fixed binary; /* (Input) left margin for next statement */ 1892 1893 if unit_stack_index >= hbound (unit_stack, 1) then 1894 call error (4, "Blocks nested too deep.", 1895 token (stmt (stmtx).start).string_ptr); 1896 1897 unit_stack_index = unit_stack_index + 1; 1898 unspec (unit_stack (unit_stack_index)) = ""b; 1899 unit_stack (unit_stack_index).type = unit_type; 1900 unit_stack (unit_stack_index).label_start = label_start; 1901 unit_stack (unit_stack_index).label_end = label_end; 1902 unit_stack (unit_stack_index).close_left_margin = close_left_margin; 1903 unit_stack (unit_stack_index).previous_left_margin = 1904 previous_left_margin; 1905 unit_stack (unit_stack_index).construct_ptr = 1906 token (stmt (stmtx).start).string_ptr; 1907 end push_unit; 1908 1909 pop_unit: 1910 procedure (label_token, close_left_margin, previous_left_margin); 1911 1912 declare label_token fixed binary; /* (Input) end statement label token, 0 if none */ 1913 declare close_left_margin fixed binary; /* (Output) left margin for end statement */ 1914 declare previous_left_margin fixed binary; /* (Output) left margin for the next statement */ 1915 1916 declare matched bit (1) aligned; 1917 declare multiple_closure_msg bit (1) aligned; 1918 declare tx fixed binary; 1919 1920 declare label_string char (token (label_token).string_size) 1921 based (token (label_token).string_ptr); 1922 declare tx_token_string char (token (tx).string_size) 1923 based (token (tx).string_ptr); 1924 1925 multiple_closure_msg = "0"b; 1926 matched = label_token = 0; 1927 do while (^matched & unit_stack_index >= 2); 1928 if unit_stack (unit_stack_index).label_start > 0 then 1929 do tx = unit_stack (unit_stack_index).label_start 1930 to unit_stack (unit_stack_index).label_end 1931 while (^matched); 1932 if token (tx).type = identifier 1933 & token (tx + 1).type = colon then 1934 matched = 1935 label_string = tx_token_string; 1936 end; 1937 1938 if ^matched then 1939 do; 1940 if unit_stack (unit_stack_index).type = BEGIN_UNIT 1941 | unit_stack (unit_stack_index).type = DO_UNIT 1942 | unit_stack (unit_stack_index).type 1943 = PROCEDURE_UNIT 1944 | unit_stack (unit_stack_index).type 1945 = PERCENT_IF_UNIT then 1946 do; 1947 if ^multiple_closure_msg then 1948 do; 1949 call error (1, 1950 "Labeled end statement terminates more than one block or group.", 1951 token (label_token).string_ptr); 1952 multiple_closure_msg = "1"b; 1953 end; 1954 1955 call error (1, 1956 "Block or group terminated by labeled end statement.", 1957 unit_stack (unit_stack_index).construct_ptr) 1958 ; 1959 end; 1960 1961 unit_stack_index = unit_stack_index - 1; 1962 end; 1963 end; 1964 1965 if matched then 1966 do; 1967 close_left_margin = 1968 unit_stack (unit_stack_index).close_left_margin; 1969 previous_left_margin = 1970 unit_stack (unit_stack_index).previous_left_margin; 1971 unit_stack_index = unit_stack_index - 1; 1972 end; 1973 1974 else 1975 do; 1976 close_left_margin = 1; 1977 previous_left_margin = 1; 1978 call error (3, "No match for labeled end statement.", 1979 token (label_token).string_ptr); 1980 end; 1981 end pop_unit; 1982 1983 /* Ensure starting columns for continuation lines are specified. */ 1984 1985 tab_continuation_lines: 1986 procedure (first_item, last_item, continuation_col); 1987 1988 declare first_item fixed binary; /* (Input) first item to check */ 1989 declare last_item fixed binary; /* (Input) last item to check */ 1990 declare continuation_col fixed binary; /* (Input) default continuation line starting column */ 1991 1992 declare itemx fixed binary; 1993 1994 do itemx = first_item to last_item; 1995 if item (itemx - 1).trailer.NLs > 0 & ^item (itemx).header.tab 1996 then 1997 call insert_tab (itemx, continuation_col); 1998 end; 1999 end tab_continuation_lines; 2000 2001 /* Insert a NL in the statement. */ 2002 2003 insert_NL: 2004 procedure (itemx, start_col); 2005 2006 declare itemx fixed binary; /* (Input) index of last item on the line */ 2007 declare start_col fixed binary; /* (Input) starting column of first item on the next line, 2008* 0 if none */ 2009 2010 if item (itemx).trailer.NLs = 0 & mode_insnl then 2011 item (itemx).trailer.NLs = 1; 2012 2013 if start_col > 0 then 2014 call insert_tab (itemx + 1, start_col); 2015 end insert_NL; 2016 2017 /* Insert a tab to a particular column in the statement. */ 2018 2019 insert_tab: 2020 procedure (itemx, start_col); 2021 2022 declare itemx fixed binary; /* (Input) index of item to be moved over */ 2023 declare start_col fixed binary; /* (Input) new starting column */ 2024 2025 if item (itemx).type = comment_token & item (itemx).header.tab then 2026 return; 2027 2028 item (itemx).header.tab = "1"b; 2029 item (itemx).header.amount = start_col; 2030 end insert_tab; 2031 2032 end format_one_statement; 2033 2034 /* Convert a token and its trailers to items. 2035* 2036* Puts white space between two items if necessary. 2037**/ 2038 make_items: 2039 procedure (stmtx, tokenx, scan_control_comments, keep_gave_error_msg, 2040 itemx); 2041 2042 declare stmtx fixed binary; /* (Input) statement that the token is in */ 2043 declare tokenx fixed binary; /* (Input) token to convert */ 2044 declare scan_control_comments bit (1) aligned;/* (Input) on to look for control comments */ 2045 declare keep_gave_error_msg bit (1) aligned;/* (Input) on to keep old value of item.gave_error_msg 2046* in trailer items */ 2047 declare itemx fixed binary; /* (Updated) last item */ 2048 2049 declare is_after_statement bit (1) aligned; 2050 declare last_trailer_type fixed binary (8); 2051 declare last_type fixed binary (8); 2052 declare loop bit (1) aligned; 2053 declare next_comment_in_col_1 bit (1) aligned; 2054 declare 1 style_before_trailers aligned like style; 2055 declare this_type fixed binary (8); 2056 declare trailerx fixed binary; 2057 2058 declare trailer_string char (trailer (trailerx).string_size) 2059 based (trailer (trailerx).string_ptr); 2060 2061 declare last_space_class (0:53) fixed binary (3) internal 2062 static options (constant) 2063 initial ((10) 1, 2, 2064 /* ^ */ 2065 (11) 1, 2, /* prefix + */ 2066 2, /* prefix - */ 2067 1, /* assignment */ 2068 2, /* : */ 2069 1, /* ; */ 2070 1, /* , */ 2071 2, /* . */ 2072 1, /* -> */ 2073 3, /* ( */ 2074 4, /* ) */ 2075 2, /* % */ 2076 1, /* target , */ 2077 5, /* comment */ 2078 (19) (1)); 2079 2080 declare this_space_class (0:53) fixed binary (3) internal 2081 static options (constant) 2082 initial ((25) 1, 4, 2083 /* : */ 2084 2, /* ; */ 2085 2, /* , */ 2086 4, /* . */ 2087 1, /* -> */ 2088 1, /* ( */ 2089 2, /* ) */ 2090 4, /* % */ 2091 2, /* target , */ 2092 5, /* comment */ 2093 1, /* nl_vt_np_token */ 2094 3, /* bit_string */ 2095 3, /* char_string */ 2096 (16) (1)); 2097 2098 declare space_table (5, 5) fixed binary (1) 2099 unsigned internal static 2100 options (constant) 2101 initial (1, 0, 1, 0, 1, 2102 /* last space class 1 */ 2103 0, 0, 0, 0, 1, /* last space class 2 */ 2104 0, 0, 0, 0, 0, /* last space class 3 */ 2105 1, 0, 0, 0, 1, /* last space class 4 */ 2106 1, 0, 1, 1, 1); /* last space class 5 */ 2107 2108 this_type = token (tokenx).type; 2109 last_type = item (itemx).type; 2110 2111 if itemx >= hbound (item, 1) then 2112 call error (4, "Too many tokens and comments in a statement.", 2113 token (tokenx).string_ptr); 2114 2115 itemx = itemx + 1; 2116 unspec (item (itemx)) = ""b; 2117 item (itemx).type = this_type; 2118 item (itemx).string_ptr = token (tokenx).string_ptr; 2119 item (itemx).string_size = token (tokenx).string_size; 2120 2121 if last_type = right_parn then 2122 item (itemx).paren_depth = item (itemx - 1).paren_depth - 1; 2123 else 2124 item (itemx).paren_depth = item (itemx - 1).paren_depth; 2125 2126 if this_type = left_parn then 2127 item (itemx).paren_depth = item (itemx).paren_depth + 1; 2128 2129 item (itemx).precedence = precedence (this_type); 2130 2131 if item (itemx - 1).trailer.NLs = 0 then 2132 item (itemx).header.amount, item (itemx).header.need_space = 2133 space_table (last_space_class (last_type), 2134 this_space_class (this_type)); 2135 2136 if token (tokenx).trailer_index = 0 then 2137 return; 2138 2139 style_before_trailers = global.current_style; 2140 2141 is_after_statement = 2142 this_type = no_token | this_type = semi_colon 2143 | is_macro_statement (stmt (stmtx).type) 2144 & tokenx = stmt (stmtx).end; 2145 next_comment_in_col_1 = 2146 this_type = no_token 2147 | this_type = semi_colon & is_macro_statement (stmt (stmtx).type); 2148 last_trailer_type = no_token; 2149 2150 loop = "1"b; 2151 do trailerx = token (tokenx).trailer_index by 1 while (loop); 2152 if trailer (trailerx).type = nl_vt_np_token then 2153 if is_after_statement | ^mode_delnl then 2154 begin; 2155 declare i fixed 2156 binary (21); 2157 2158 next_comment_in_col_1 = 2159 trailer_string ^= NL 2160 | last_trailer_type = nl_vt_np_token 2161 | next_comment_in_col_1; 2162 do i = 1 to length (trailer_string); 2163 if substr (trailer_string, i, 1) = NL 2164 then 2165 item (itemx).trailer.NLs = 2166 item (itemx).trailer.NLs 2167 + 1; 2168 2169 else if substr (trailer_string, i, 1) 2170 = VT then 2171 do; 2172 item (itemx).trailer.VTs = 2173 item (itemx).trailer.VTs 2174 + 1; 2175 item (itemx).trailer.NLs = 0; 2176 end; 2177 2178 else 2179 do; /* NP */ 2180 item (itemx).trailer.NP = "1"b; 2181 item (itemx).trailer.VTs = 0; 2182 item (itemx).trailer.NLs = 0; 2183 end; 2184 end; 2185 end; 2186 else 2187 ; /* ignore vertical white space within stmt in delnl mode */ 2188 2189 else 2190 begin; /* comment trailer */ 2191 declare category fixed binary (2); 2192 declare old_gave_error_msg bit (1) aligned; 2193 2194 call adjust_vertical_white_space_after_item (itemx); 2195 2196 if this_type = semi_colon 2197 & trailerx = token (tokenx).trailer_index + 1 2198 & ^item (itemx).trailer.NP 2199 & item (itemx).trailer.VTs = 0 2200 & item (itemx).trailer.NLs = 1 & mode_delnl then 2201 item (itemx).trailer.NLs = 0; 2202 2203 if itemx >= hbound (item, 1) then 2204 call error (4, 2205 "Too many tokens and comments in a statement.", 2206 trailer (trailerx).string_ptr); 2207 2208 itemx = itemx + 1; 2209 old_gave_error_msg = item (itemx).gave_error_msg; 2210 unspec (item (itemx)) = ""b; 2211 item (itemx).type = comment_token; 2212 item (itemx).string_ptr = trailer (trailerx).string_ptr; 2213 item (itemx).string_size = 2214 trailer (trailerx).string_size; 2215 2216 if item (itemx - 1).type = right_parn then 2217 item (itemx).paren_depth = 2218 item (itemx - 1).paren_depth - 1; 2219 else 2220 item (itemx).paren_depth = 2221 item (itemx - 1).paren_depth; 2222 2223 item (itemx).precedence = precedence (comment_token); 2224 item (itemx).header.need_space = 2225 space_table ( 2226 last_space_class (item (itemx - 1).type), 2227 this_space_class (comment_token)); 2228 item (itemx).gave_error_msg = 2229 old_gave_error_msg & keep_gave_error_msg; 2230 2231 do category = length (comment_indicator_extra_chars) 2232 to 1 by -1 2233 while ( 2234 substr (trailer_string, length (open_comment) + 1, 2235 min (length (trailer_string) 2236 - length (open_comment) - length (close_comment), 2237 category)) 2238 ^= 2239 substr (comment_indicator_extra_chars, 1, category)) 2240 ; 2241 end; 2242 2243 item (itemx).comment_ind_len = 2244 length (open_comment) + category; 2245 item (itemx).header.insnl = category > 0; 2246 2247 if substr (trailer_string, 2248 item (itemx).comment_ind_len + 1, 2249 length (comment_indicator_no_indcomtxt)) 2250 = comment_indicator_no_indcomtxt then 2251 item (itemx).comment_ind_len = 2252 item (itemx).comment_ind_len 2253 + length (comment_indicator_no_indcomtxt); 2254 else 2255 item (itemx).indcomtxt = "1"b; 2256 2257 if category = 0 then 2258 if next_comment_in_col_1 then 2259 if mode_indcom & tokenx > 1 then 2260 category = 2; 2261 else 2262 category = 3; 2263 2264 else if is_after_statement | this_type = comma 2265 | this_type = target_comma then 2266 category = 1; 2267 2268 if category = 3 then 2269 do; 2270 item (itemx).header.tab = "1"b; 2271 item (itemx).header.amount = 1; 2272 end; 2273 2274 else if category = 2 then 2275 do; 2276 item (itemx).header.tab = "1"b; 2277 item (itemx).header.amount = 2278 indent_margin (mode_indblkcom, left_margin); 2279 item (itemx).header.tab_blkcom = 2280 tokenx = stmt (stmtx).end; 2281 end; 2282 2283 else if category = 1 then 2284 do; 2285 item (itemx).header.tab = "1"b; 2286 item (itemx).header.amount = mode_comcol; 2287 end; 2288 2289 else 2290 do; 2291 item (itemx).header.amount = 2292 item (itemx).header.need_space; 2293 2294 if trailer (trailerx).continued & mode_linecom 2295 then 2296 if trailer (trailerx + 1).type 2297 = nl_vt_np_token then 2298 do; 2299 item (itemx).header.tab = "1"b; 2300 item (itemx).header.amount = 2301 mode_comcol; 2302 2303 if mode_delnl then 2304 item (itemx).trailer 2305 .NLs = 1; 2306 end; 2307 end; 2308 2309 if scan_control_comments then 2310 if is_control_comment (trailer_string, 2311 (item (itemx).comment_ind_len), 2312 item (itemx).gave_error_msg) then 2313 if is_after_statement then 2314 do; 2315 item (itemx).control_comment = 2316 "1"b; 2317 call format_pl1_modes_ ( 2318 temp_segs (*), 2319 before ( 2320 after (trailer_string, 2321 control_comment_indicator), 2322 close_comment), 2323 addr (trailer_string), "1"b, 2324 item (itemx).gave_error_msg) 2325 ; 2326 end; 2327 2328 else 2329 call error (2, 2330 "Control comment within statement.", 2331 item (itemx).string_ptr); 2332 end; 2333 2334 last_trailer_type = trailer (trailerx).type; 2335 loop = trailer (trailerx).continued; 2336 end; 2337 call adjust_vertical_white_space_after_item (itemx); 2338 2339 global.current_style = style_before_trailers; 2340 2341 return; 2342 2343 adjust_vertical_white_space_after_item: 2344 procedure (itemx); 2345 2346 declare itemx fixed binary; /* (Input) item to adjust */ 2347 2348 if (item (itemx).trailer.NP | item (itemx).trailer.VTs > 0) 2349 & item (itemx).trailer.NLs = 0 then 2350 item (itemx).trailer.NLs = 1; 2351 2352 if item (itemx).type = comment_token & item (itemx).header.tab 2353 & item (itemx).trailer.NLs = 0 & mode_insnl then 2354 item (itemx).trailer.NLs = 1; 2355 end adjust_vertical_white_space_after_item; 2356 2357 is_control_comment: 2358 procedure (comment, comment_ind_len, gave_error_msg) 2359 returns (bit (1) aligned); 2360 2361 declare comment char (*); /* (Input) comment which may be a control comment */ 2362 declare comment_ind_len fixed binary (3); 2363 /* (Input) comment indicator length */ 2364 declare gave_error_msg bit (1); /* (Updated) on if printed it's a bad control comment */ 2365 2366 declare control_comment bit (1) aligned; 2367 2368 if index (comment, control_comment_indicator) = 0 then 2369 return ("0"b); 2370 2371 if verify ( 2372 before (substr (comment, comment_ind_len + 1), 2373 control_comment_indicator), HT_SP) ^= 0 then 2374 return ("0"b); 2375 2376 control_comment = 2377 search ( 2378 ltrim ( 2379 rtrim ( 2380 before (after (comment, control_comment_indicator), close_comment), 2381 HT_SP), HT_SP), HT_SP) = 0; 2382 2383 if ^control_comment & ^gave_error_msg then 2384 do; 2385 call error (2, "Invalid syntax in control comment.", 2386 addr (comment)); 2387 gave_error_msg = "1"b; 2388 end; 2389 2390 return (control_comment); 2391 end is_control_comment; 2392 2393 end make_items; 2394 2395 /* Copy all items in a statement into the output segment. */ 2396 2397 copy_items: 2398 procedure (first_item, last_item); 2399 2400 declare first_item fixed binary; /* (Input) index of first item to copy */ 2401 declare last_item fixed binary; /* (Input) index of last item to copy */ 2402 2403 declare itemx fixed binary; 2404 2405 declare item_string char (item (itemx).string_size) 2406 based (item (itemx).string_ptr); 2407 2408 do itemx = first_item to last_item; 2409 if item (itemx).header.tab_blkcom then 2410 item (itemx).header.amount = 2411 indent_margin (mode_indblkcom, left_margin); 2412 2413 if item (itemx).control_comment then 2414 do; 2415 call format_pl1_modes_ (temp_segs (*), 2416 before ( 2417 after (item_string, control_comment_indicator), 2418 close_comment), addr (item_string), "1"b, 2419 item (itemx).gave_error_msg); 2420 2421 if off_region_ptr = null then 2422 if mode_on then 2423 call copy_item (itemx, "111"b); 2424 else 2425 do; 2426 call copy_item (itemx, "100"b); 2427 off_region_ptr = 2428 item (itemx).string_ptr; 2429 end; 2430 2431 else if mode_on then 2432 do; 2433 call copy_off_region ( 2434 char_offset_ ((item (itemx).string_ptr))); 2435 call copy_item (itemx, "011"b); 2436 end; 2437 end; 2438 2439 else if mode_on then 2440 call copy_item (itemx, "111"b); 2441 end; 2442 2443 return; 2444 2445 /* Copy one item into the output segment. */ 2446 2447 copy_item: 2448 procedure (itemx, copy_sws); 2449 2450 declare itemx fixed binary; /* (Input) item to copy */ 2451 declare copy_sws bit (3) aligned;/* (Input) on to copy header, item, trailer, respectively */ 2452 2453 declare item_string char (item (itemx).string_size) 2454 based (item (itemx).string_ptr); 2455 2456 if substr (copy_sws, 1, 1) & item (itemx).header.amount > 0 then 2457 begin; 2458 declare col_to_go fixed binary; 2459 declare tabs fixed binary; 2460 2461 if item (itemx).header.tab then 2462 col_to_go = item (itemx).header.amount; 2463 else 2464 col_to_go = line_position + item (itemx).header.amount; 2465 2466 if col_to_go < line_position 2467 | col_to_go = line_position & line_position > 1 2468 & item (itemx).type ^= comment_token then 2469 if mode_insnl | item (itemx).header.insnl then 2470 do; 2471 call copy_string (NL); 2472 line_position = 1; 2473 end; 2474 2475 else 2476 col_to_go = 2477 line_position 2478 + item (itemx).header.need_space; 2479 2480 tabs = divide (col_to_go - 1, tab_interval, 17) 2481 - divide (line_position - 1, tab_interval, 17); 2482 if tabs > 0 & col_to_go - line_position > 1 then 2483 do; 2484 call copy_char (HT, tabs); 2485 line_position = 2486 tab_interval 2487 * divide (col_to_go - 1, tab_interval, 17) + 1; 2488 end; 2489 2490 if line_position < col_to_go then 2491 do; 2492 call copy_char (SP, col_to_go - line_position); 2493 line_position = col_to_go; 2494 end; 2495 end; 2496 2497 if substr (copy_sws, 2, 1) then 2498 if item (itemx).type = comment_token 2499 & (^global.rdc_source | index (item_string, "/*++") ^= 1) 2500 & item (itemx).indcomtxt & mode_indcomtxt then 2501 begin; 2502 declare comment_close_ind_len fixed binary (21); 2503 declare comment_text_len fixed binary (21); 2504 declare scan_index fixed binary (21); 2505 2506 comment_text_len = 2507 length (item_string) 2508 - item (itemx).comment_ind_len 2509 - length (close_comment); 2510 comment_close_ind_len = length (close_comment); 2511 2512 scan_index = 2513 verify ( 2514 reverse ( 2515 substr (item_string, 2516 item (itemx).comment_ind_len + 1, comment_text_len)) 2517 , comment_indicator_extra_chars) - 1; 2518 if scan_index < 0 then 2519 scan_index = comment_text_len; 2520 2521 scan_index = 2522 min (scan_index, 2523 length (comment_indicator_extra_chars)); 2524 comment_text_len = comment_text_len - scan_index; 2525 comment_close_ind_len = 2526 comment_close_ind_len + scan_index; 2527 2528 if comment_text_len 2529 >= length (comment_indicator_no_indcomtxt) then 2530 if substr (item_string, 2531 item (itemx).comment_ind_len 2532 + comment_text_len 2533 - length (comment_indicator_no_indcomtxt) 2534 + 1, 2535 length (comment_indicator_no_indcomtxt)) 2536 = comment_indicator_no_indcomtxt then 2537 do; 2538 comment_text_len = 2539 comment_text_len 2540 - 2541 length ( 2542 comment_indicator_no_indcomtxt); 2543 comment_close_ind_len = 2544 comment_close_ind_len 2545 + 2546 length ( 2547 comment_indicator_no_indcomtxt); 2548 end; 2549 2550 begin; 2551 declare comment_close_ind char ( 2552 comment_close_ind_len 2553 ) 2554 defined ( 2555 item_string) 2556 position ( 2557 item (itemx) 2558 .comment_ind_len 2559 + 2560 comment_text_len 2561 + 1); 2562 declare comment_indicator char ( 2563 item (itemx) 2564 . 2565 comment_ind_len) 2566 defined ( 2567 item_string); 2568 declare comment_text char ( 2569 comment_text_len) 2570 defined ( 2571 item_string) 2572 position ( 2573 item (itemx) 2574 .comment_ind_len 2575 + 1); 2576 2577 call indent_comment (comment_indicator, 2578 comment_text, comment_close_ind, 2579 (item (itemx).header.tab), 2580 item (itemx).header.amount - 1, 2581 line_position); 2582 end; 2583 end; 2584 2585 else 2586 do; 2587 call copy_string (item_string); 2588 2589 if item (itemx).type = char_string 2590 | item (itemx).type = comment_token then 2591 line_position = 2592 last_line_position (line_position, 2593 item_string); 2594 else 2595 line_position = 2596 line_position + length (item_string); 2597 end; 2598 2599 if substr (copy_sws, 3, 1) & item (itemx).trailer.NLs > 0 then 2600 do; 2601 if (item (itemx).trailer.NP | item (itemx).trailer.VTs > 0) 2602 & line_position > 1 then 2603 call copy_string (NL); 2604 2605 if item (itemx).trailer.NP then 2606 call copy_string (NP); 2607 2608 call copy_char (VT, (item (itemx).trailer.VTs)); 2609 call copy_char (NL, (item (itemx).trailer.NLs)); 2610 2611 line_position = 1; 2612 end; 2613 2614 return; 2615 2616 indent_comment: 2617 procedure (comment_indicator, comment_text, comment_close_ind, tab, 2618 comment_indentation, line_position); 2619 2620 declare comment_indicator char (*); /* (Input) what the comment starts with */ 2621 declare comment_text char (*); /* (Input) text of comment to indent */ 2622 declare comment_close_ind char (*); /* (Input) what the comment ends with */ 2623 declare tab bit (1) aligned;/* (Input) on for block comments */ 2624 declare comment_indentation fixed binary; /* (Input) number of columns to indent comment */ 2625 declare line_position fixed binary; /* (Output) output segment line position */ 2626 2627 declare line_length fixed binary (21); 2628 declare n_HT fixed binary; 2629 declare n_SP fixed binary; 2630 declare scan_index fixed binary (21); 2631 declare scan_position fixed binary (21); 2632 2633 if tab then 2634 begin; 2635 declare text_indentation fixed binary; 2636 2637 text_indentation = 2638 comment_indentation + length (comment_indicator || SP); 2639 n_HT = divide (text_indentation, tab_interval, 17); 2640 n_SP = text_indentation - tab_interval * n_HT; 2641 end; 2642 2643 call copy_string (comment_indicator); 2644 2645 scan_position = 1; 2646 do while (scan_position <= length (comment_text)); 2647 scan_index = 2648 search (substr (comment_text, scan_position), NL_VT_NP) - 1; 2649 if scan_index < 0 then 2650 do; 2651 scan_index = 2652 length (substr (comment_text, scan_position)); 2653 line_length = scan_index; 2654 end; 2655 2656 else 2657 line_length = 2658 length ( 2659 rtrim ( 2660 substr (comment_text, scan_position, scan_index), 2661 HT_SP)); 2662 2663 if scan_position = 1 then 2664 begin; 2665 declare line char (line_length) 2666 defined (comment_text); 2667 2668 if verify (line, HT_SP) = 1 then 2669 call copy_string (SP); 2670 2671 call copy_string (line); 2672 end; 2673 2674 else if tab then 2675 begin; 2676 declare trim_length fixed binary (21); 2677 2678 trim_length = 2679 length ( 2680 ltrim ( 2681 substr (comment_text, scan_position, line_length), 2682 HT_SP)); 2683 if trim_length > 0 then 2684 begin; 2685 declare trimmed_line char ( 2686 trim_length) 2687 defined ( 2688 comment_text) 2689 position ( 2690 scan_position 2691 + line_length 2692 - trim_length); 2693 2694 call copy_char (HT, n_HT); 2695 call copy_char (SP, n_SP); 2696 call copy_string (trimmed_line); 2697 end; 2698 end; 2699 2700 else 2701 begin; 2702 declare line char (line_length) 2703 defined (comment_text) 2704 position (scan_position) 2705 ; 2706 2707 call copy_string (line); 2708 end; 2709 2710 scan_position = scan_position + scan_index; 2711 2712 scan_index = 2713 verify (substr (comment_text, scan_position), NL_VT_NP) - 1; 2714 if scan_index < 0 then 2715 scan_index = 2716 length (substr (comment_text, scan_position)); 2717 2718 begin; 2719 declare vertical_white_space char (scan_index) 2720 defined (comment_text) 2721 position (scan_position) 2722 ; 2723 2724 call copy_string (vertical_white_space); 2725 end; 2726 2727 scan_position = scan_position + scan_index; 2728 end; 2729 2730 if tab 2731 & index (NL_VT_NP, substr (output_string, copy_position - 1, 1)) > 0 2732 then 2733 do; 2734 n_HT = divide (comment_indentation, tab_interval, 17); 2735 call copy_char (HT, n_HT); 2736 call copy_char (SP, comment_indentation - tab_interval * n_HT); 2737 end; 2738 2739 else if 2740 index (HT_SP_NL_VT_NP, substr (output_string, copy_position - 1, 1)) 2741 = 0 then 2742 call copy_string (SP); 2743 2744 call copy_string (comment_close_ind); 2745 2746 begin; 2747 declare output char (copy_position - 1) 2748 defined (output_string); 2749 2750 line_position = last_line_position (1, output); 2751 end; 2752 end indent_comment; 2753 2754 /* Copy one character several times into the output segment. 2755* 2756* The complicated case statement is just to get better code out of the compiler. 2757**/ 2758 copy_char: 2759 procedure (char, number); 2760 2761 declare char char (1); /* (Input) character to place in the output segment */ 2762 declare number fixed binary; /* (Input) how many times to copy the character */ 2763 2764 if char = SP then 2765 substr (output_string, copy_position, number) = ""; 2766 2767 else if char = HT then 2768 substr (output_string, copy_position, number) = 2769 copy (HT, number); 2770 2771 else if char = NL then 2772 substr (output_string, copy_position, number) = 2773 copy (NL, number); 2774 2775 else if char = VT then 2776 substr (output_string, copy_position, number) = 2777 copy (VT, number); 2778 2779 else 2780 substr (output_string, copy_position, number) = 2781 copy (char, number); 2782 2783 copy_position = copy_position + number; 2784 end copy_char; 2785 2786 end copy_item; 2787 2788 end copy_items; 2789 2790 /* Copy an off region into the output segment. */ 2791 2792 copy_off_region: 2793 procedure (stop_position); 2794 2795 declare stop_position fixed binary (21); 2796 /* (Input) last character to copy */ 2797 2798 declare off_region_length fixed binary (21); 2799 2800 declare off_region_string char (off_region_length) 2801 based (off_region_ptr); 2802 2803 off_region_length = stop_position - char_offset_ (off_region_ptr); 2804 2805 call copy_string (off_region_string); 2806 line_position = last_line_position (line_position, off_region_string); 2807 2808 off_region_ptr = null; 2809 end copy_off_region; 2810 2811 /* Copy a string into the output segment. */ 2812 2813 copy_string: 2814 procedure (string); 2815 2816 declare string char (*); /* (Input) string to place in the output segment */ 2817 2818 substr (output_string, copy_position, length (string)) = string; 2819 copy_position = copy_position + length (string); 2820 end copy_string; 2821 2822 /* Calculate an indented margin. */ 2823 2824 indent_margin: 2825 procedure (indent, margin) returns (fixed binary); 2826 2827 declare indent bit (1); /* (Input) on to indent to margin */ 2828 declare margin fixed binary; /* (Input) margin to indent to */ 2829 2830 if indent then 2831 return (margin); 2832 else 2833 return (max (margin - mode_ind, 1)); 2834 end indent_margin; 2835 2836 /* Calculate the line position after a string. */ 2837 2838 last_line_position: 2839 procedure (line_position, string) returns (fixed binary); 2840 2841 declare line_position fixed binary; /* (Input) line position string starts on */ 2842 declare string char (*); /* (Input) string to place at line_position */ 2843 2844 declare last_line_length fixed binary (21); 2845 2846 last_line_length = search (reverse (string), NL_VT_NP) - 1; 2847 if last_line_length < 0 then 2848 return (next_line_position (line_position, string)); 2849 2850 begin; 2851 declare last_line char (last_line_length) 2852 defined (string) 2853 position (length (string) 2854 - last_line_length + 1); 2855 2856 return (next_line_position (1, last_line)); 2857 end; 2858 end last_line_position; 2859 2860 /* Calculate the line position after a string on its first line, i.e. before any vertical white space. */ 2861 2862 next_line_position: 2863 procedure (start_line_position, string) returns (fixed binary); 2864 2865 declare start_line_position fixed binary; /* (Input) line position string start on */ 2866 declare string char (*); /* (Input) string to place at start_line_position */ 2867 2868 declare line_position fixed binary (21); 2869 declare scan_index fixed binary (21); 2870 declare scan_position fixed binary (21); 2871 2872 line_position = start_line_position; 2873 scan_position = 1; 2874 do while (scan_position <= length (string)); 2875 scan_index = 2876 search (substr (string, scan_position), HT_BS_NL_VT_NP) - 1; 2877 if scan_index < 0 then 2878 scan_index = length (substr (string, scan_position)); 2879 2880 line_position = line_position + scan_index; 2881 scan_position = scan_position + scan_index + 1; 2882 2883 if scan_position - 1 <= length (string) then 2884 if substr (string, scan_position - 1, 1) = HT then 2885 line_position = 2886 tab_interval 2887 * 2888 divide (line_position + tab_interval - 1, 2889 tab_interval, 17) + 1; 2890 2891 else if substr (string, scan_position - 1, 1) = BS then 2892 line_position = line_position - 1; 2893 2894 else 2895 scan_position = length (string) + 1; 2896 end; 2897 2898 return (line_position); 2899 end next_line_position; 2900 2901 /* Print an error message. */ 2902 2903 error: 2904 procedure (severity, error_string, source_ptr); 2905 2906 declare severity fixed binary (35); 2907 /* (Input) severity of the error */ 2908 declare error_string char (*); /* (Input) error message */ 2909 declare source_ptr pointer unaligned; 2910 /* (Input) pointer to error in source */ 2911 2912 call format_pl1_error_ (temp_segs (*), severity, error_string, 2913 (source_ptr)); 2914 2915 if severity >= 4 then 2916 goto unrecoverable_error; 2917 end error; 2918 2919 end format_pl1_; 2920 SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/17/00 1934.4 format_pl1_.pl1 >udd>sm>ds>w>ml>format_pl1_.pl1 271 1 08/10/84 1058.4 format_pl1_dcls.incl.pl1 >ldd>incl>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. BEGIN_UNIT 000634 constant fixed bin(17,0) initial dcl 183 set ref 341 812* 816* 824* 1940 BS constant char(1) initial packed unaligned dcl 195 ref 2891 DO_UNIT 000635 constant fixed bin(17,0) initial dcl 183 set ref 341 871* 1940 ELSE_UNIT constant fixed bin(17,0) initial dcl 183 ref 700 717 732 HT 000560 constant char(1) initial packed unaligned dcl 197 set ref 2484* 2694* 2735* 2767 2767 2883 HT_BS_NL_VT_NP 000556 constant char(5) initial packed unaligned dcl 199 ref 2875 HT_SP constant char(2) initial packed unaligned dcl 202 ref 2371 2376 2376 2376 2656 2668 2678 HT_SP_NL_VT_NP 000466 constant char(5) initial packed unaligned dcl 246 ref 2739 IF_UNIT constant fixed bin(17,0) initial dcl 183 set ref 696 732 987* NL 000464 constant char(1) initial packed unaligned dcl 249 set ref 2158 2163 2471* 2601* 2609* 2771 2771 NL_VT_NP 000460 constant char(3) initial packed unaligned dcl 268 ref 1789 2647 2712 2730 2846 NLs 4(18) based fixed bin(9,0) array level 3 packed packed unsigned unaligned dcl 120 set ref 292* 1036 1052* 1249 1995 2010 2010* 2131 2163* 2163 2175* 2182* 2196 2196* 2303* 2348 2348* 2352 2352* 2599 2609 NO_UNIT constant fixed bin(17,0) initial dcl 183 ref 285 NP 4 based bit(1) array level 3 in structure "item" packed packed unaligned dcl 120 in procedure "format_pl1_" set ref 2180* 2196 2348 2601 2605 NP 000463 constant char(1) initial packed unaligned dcl 252 in procedure "format_pl1_" set ref 2605* ON_UNIT constant fixed bin(17,0) initial dcl 183 set ref 683 1215* PERCENT_IF_UNIT 000561 constant fixed bin(17,0) initial dcl 183 set ref 348 1272 1277 1289 1293 1309* 1940 PROCEDURE_UNIT 000631 constant fixed bin(17,0) initial dcl 183 set ref 341 754 763* 882 886 1940 P_itemx parameter fixed bin(17,0) dcl 625 set ref 619 643* P_reconverting parameter bit(1) dcl 624 ref 619 636 P_stmtx parameter fixed bin(17,0) dcl 622 ref 619 633 P_temp_segs parameter pointer array dcl 103 ref 100 275 SP 000462 constant char(1) initial packed unaligned dcl 254 set ref 2492* 2637 2668* 2695* 2736* 2739* 2764 START_COMPONENT constant fixed bin(17,0) initial dcl 1395 ref 1407 1548 1570 VT 000461 constant char(1) initial packed unaligned dcl 256 set ref 2169 2608* 2775 2775 VTs 4(09) based fixed bin(9,0) array level 3 packed packed unsigned unaligned dcl 120 set ref 2172* 2172 2181* 2196 2348 2601 2608 WANT_ATTRIBUTE_SET constant fixed bin(17,0) initial dcl 1395 ref 1410 1485 WANT_RIGHT_PAREN constant fixed bin(17,0) initial dcl 1395 ref 1469 1482 addr builtin function dcl 169 ref 283 288 377 377 1348 1402 2317 2317 2385 2385 2415 2415 after builtin function dcl 169 ref 377 377 2317 2317 2376 2415 2415 amount 3(27) based fixed bin(9,0) array level 3 packed packed unsigned unaligned dcl 120 set ref 646* 1802 1808 2029* 2131* 2271* 2277* 2286* 2291* 2300* 2409* 2456 2461 2463 2577 assignment constant fixed bin(8,0) initial dcl 1-94 ref 780 1877 assignment_item 000310 automatic fixed bin(17,0) dcl 779 set ref 780* 780* 784 786* assignment_statement constant fixed bin(8,0) initial dcl 1-185 ref 512 before builtin function dcl 169 ref 377 377 2317 2317 2371 2376 2415 2415 begin_statement constant fixed bin(8,0) initial dcl 1-185 ref 515 binary builtin function dcl 169 ref 648 1421 1427 1564 1893 2111 2203 ca 13 based structure level 3 packed packed unaligned dcl 1-73 case 2(18) based bit(1) array level 3 in structure "unit_stack" packed packed unaligned dcl 151 in procedure "format_pl1_" set ref 706 962 988* 1147 case parameter bit(1) dcl 1107 in procedure "is_ifthenstmt" ref 1101 1116 case_control_comment 000211 constant char(10) initial packed unaligned dcl 1-410 ref 965 category 000740 automatic fixed bin(2,0) dcl 2191 set ref 2231* 2231 2231* 2243 2245 2257 2257* 2261* 2264* 2268 2274 2283 char parameter char(1) packed unaligned dcl 2761 ref 2758 2764 2767 2771 2775 2779 char_offset_ 000010 constant entry external dcl 263 ref 428 428 464 464 2433 2433 2803 char_string constant fixed bin(8,0) initial dcl 1-94 ref 1789 1802 2589 clause_type parameter fixed bin(8,0) packed unaligned dcl 1166 ref 1163 1171 close_comment constant char(2) initial packed unaligned dcl 176 ref 377 377 2231 2317 2317 2376 2415 2415 2506 2510 close_left_margin parameter fixed bin(17,0) dcl 1890 in procedure "push_unit" ref 1883 1902 close_left_margin parameter fixed bin(17,0) dcl 1913 in procedure "pop_unit" set ref 1909 1967* 1976* close_left_margin 1(18) based fixed bin(17,0) array level 2 in structure "unit_stack" packed packed unaligned dcl 151 in procedure "format_pl1_" set ref 702 886 976 1902* 1967 col_to_go 000776 automatic fixed bin(17,0) dcl 2458 set ref 2461* 2463* 2466 2466 2475* 2480 2482 2485 2490 2492 2493 colon constant fixed bin(8,0) initial dcl 1-94 ref 596 1932 comma constant fixed bin(8,0) initial dcl 1-94 ref 1530 1544 1594 1638 1676 1709 1856 1877 2264 command_line_modes based char packed unaligned dcl 392 set ref 396* command_line_style 14 based structure level 3 dcl 1-73 ref 303 comment parameter char packed unaligned dcl 2361 set ref 2357 2368 2371 2376 2385 2385 comment_close_ind defined char packed unaligned dcl 2551 in begin block on line 2550 set ref 2577* comment_close_ind parameter char packed unaligned dcl 2622 in procedure "indent_comment" set ref 2616 2744* comment_close_ind_len 001000 automatic fixed bin(21,0) dcl 2502 set ref 2510* 2525* 2525 2543* 2543 2551 comment_ind_len 0(22) based fixed bin(3,0) array level 2 in structure "item" packed packed unsigned unaligned dcl 120 in procedure "format_pl1_" set ref 2243* 2247 2247* 2247 2309 2506 2512 2528 2562 2577 2577 comment_ind_len parameter fixed bin(3,0) dcl 2362 in procedure "is_control_comment" ref 2357 2371 comment_indentation parameter fixed bin(17,0) dcl 2624 ref 2616 2637 2734 2736 comment_indicator parameter char packed unaligned dcl 2620 in procedure "indent_comment" set ref 2616 2637 2643* comment_indicator defined char packed unaligned dcl 2562 in begin block on line 2550 set ref 2577* comment_indicator_extra_chars 000205 constant char(3) initial packed unaligned dcl 1-417 ref 2231 2231 2512 2521 comment_indicator_no_indcomtxt 021125 constant char(1) initial packed unaligned dcl 1-420 ref 2247 2247 2247 2528 2528 2528 2528 2538 2543 comment_text defined char packed unaligned dcl 2568 in begin block on line 2550 set ref 2577* comment_text parameter char packed unaligned dcl 2621 in procedure "indent_comment" ref 2616 2646 2647 2651 2656 2668 2668 2671 2671 2678 2696 2696 2707 2707 2712 2714 2724 2724 comment_text_len 001001 automatic fixed bin(21,0) dcl 2503 set ref 2506* 2512 2518 2524* 2524 2528 2528 2538* 2538 2568 2577 comment_token constant fixed bin(8,0) initial dcl 1-94 ref 563 600 965 995 1040 1067 1081 1242 1313 1344 1492 1789 1802 2025 2211 2223 2224 2352 2466 2497 2589 component_start 1 based fixed bin(17,0) array level 2 dcl 1381 set ref 1414* 1448* 1516 1524 1530* 1537* 1610* 1614* condition_prefix_list constant fixed bin(8,0) initial dcl 1-185 ref 486 605 1184 construct_ptr 3 based pointer array level 2 packed packed unaligned dcl 151 set ref 341* 348* 1905* 1955* continuation_col parameter fixed bin(17,0) dcl 1990 set ref 1985 1995* continuation_indent parameter fixed bin(17,0) dcl 1753 ref 1746 1772 1823 1860 continued 0(22) based bit(1) array level 2 packed packed unaligned dcl 1-37 ref 2294 2335 control_com_style 000143 automatic structure level 1 dcl 390 set ref 395* 399 control_comment 000756 automatic bit(1) dcl 2366 in procedure "is_control_comment" set ref 2376* 2383 2390 control_comment 4(27) based bit(1) array level 3 in structure "item" packed packed unaligned dcl 120 in procedure "format_pl1_" set ref 373 2315* 2413 control_comment_indicator 000214 constant char(7) initial packed unaligned dcl 1-395 ref 377 377 2317 2317 2368 2371 2376 2415 2415 copy builtin function dcl 169 ref 2767 2771 2775 2779 copy_position 000100 automatic fixed bin(21,0) dcl 107 set ref 278* 354 451* 458* 465* 2730 2739 2747 2764 2767 2771 2775 2779 2783* 2783 2818 2819* 2819 copy_sws parameter bit(3) dcl 2451 ref 2447 2456 2497 2599 current_mode_case 000360 automatic bit(1) dcl 950 set ref 960* 962* 965* 969* 974 988 999* current_style 42 based structure level 3 dcl 1-73 set ref 395 399 404 2139 2339* dec_integer constant fixed bin(8,0) initial dcl 1-94 ref 1417 declare_margin 000502 automatic fixed bin(17,0) dcl 1328 set ref 1355* 1357* 1360 1362 1365* declare_stack based structure array level 1 dcl 1381 set ref 1564 1569* declare_stack_index parameter fixed bin(17,0) dcl 1562 in procedure "push_declare_stack_entry" set ref 1559 1564 1568* 1568 1569 1570 declare_stack_index 000520 automatic fixed bin(17,0) dcl 1378 in procedure "declaration_list" set ref 1403* 1405* 1406 1407 1410 1412 1414 1433 1448 1458 1469 1471* 1482 1485 1507 1516 1516 1524 1530 1537 1548 1552* 1552 1610 1610 1614 1619 declare_stack_ptr 000522 automatic pointer dcl 1379 set ref 1402* 1407 1410 1412 1414 1433 1448 1458 1469 1482 1485 1507 1516 1516 1524 1530 1537 1548 1564 1564 1569 1570 1610 1610 1614 1619 declare_statement constant fixed bin(8,0) initial dcl 1-185 ref 519 divide builtin function dcl 169 ref 648 1564 1893 2111 2203 2480 2480 2485 2639 2734 2883 do_statement constant fixed bin(8,0) initial dcl 1-185 ref 522 else_clause constant fixed bin(8,0) initial dcl 1-185 ref 532 689 689 806 847 962 974 989 1113 1116 end 56 based fixed bin(17,0) array level 3 packed packed unaligned dcl 1-73 set ref 496 638 654 656 2141 2279 end_statement constant fixed bin(8,0) initial dcl 1-185 ref 526 entry_statement constant fixed bin(8,0) initial dcl 1-185 ref 541 error_string parameter char packed unaligned dcl 2908 set ref 2903 2912* factored_level_number 000503 automatic bit(1) dcl 1329 set ref 1352* 1436 1444 1458* 1507* 1607 1619* first_clause parameter bit(1) dcl 1263 ref 1259 1269 first_in_item_array 000230 automatic bit(1) dcl 627 set ref 635* 639* 656 first_item parameter fixed bin(17,0) dcl 1579 in procedure "completely_factored_declaration_list" ref 1576 1589 first_item 000554 automatic fixed bin(17,0) dcl 1631 in procedure "attribute_set" set ref 1637* 1709 1709* 1714* first_item parameter fixed bin(17,0) dcl 1988 in procedure "tab_continuation_lines" ref 1985 1994 first_item parameter fixed bin(17,0) dcl 1235 in procedure "look_ahead_if_is_on_one_line" ref 1231 1249 first_item parameter fixed bin(17,0) dcl 1750 in procedure "format_other" set ref 1746 1771* 1772 1778 first_item parameter fixed bin(17,0) dcl 2400 in procedure "copy_items" ref 2397 2408 first_on_line 000600 automatic fixed bin(17,0) dcl 1756 set ref 1778* 1779 1780 1780 1785* 1814* 1823* 1823 1823* 1841 1853 1862* first_prefix_item 000214 automatic fixed bin(17,0) dcl 586 set ref 592* 592* 594 596 605* 608* flags 0(18) based structure array level 2 in structure "declare_stack" packed packed unaligned dcl 1381 in procedure "declaration_list" flags 2(18) based structure array level 2 in structure "unit_stack" packed packed unaligned dcl 151 in procedure "format_pl1_" flags 13(06) based structure level 3 in structure "global" packed packed unaligned dcl 1-73 in procedure "format_pl1_" flags 4(27) based structure array level 2 in structure "item" packed packed unaligned dcl 120 in procedure "format_pl1_" force 13(02) based bit(1) level 4 packed packed unaligned dcl 1-73 set ref 312 388 399* format_pl1_error_ 000022 constant entry external dcl 1-439 ref 2912 format_pl1_long_ 000020 constant entry external dcl 1-438 ref 303 format_pl1_modes_ 000014 constant entry external dcl 1-433 ref 377 396 2317 2415 format_pl1_record_style_ 000016 constant entry external dcl 1-435 ref 451 458 465 gave_error_msg parameter bit(1) packed unaligned dcl 2364 in procedure "is_control_comment" set ref 2357 2383 2387* gave_error_msg 4(28) based bit(1) array level 3 in structure "item" packed packed unaligned dcl 120 in procedure "format_pl1_" set ref 377* 2209 2228* 2309* 2317* 2415* global based structure level 1 dcl 1-73 global_header based structure level 1 dcl 1-47 has_level_number 0(18) based bit(1) array level 3 packed packed unaligned dcl 1381 set ref 1412* 1433* 1458 1507 1516 1610 1619 has_percent_then parameter bit(1) dcl 1265 ref 1259 1319 hbound builtin function dcl 169 ref 648 1427 1564 1893 2111 2203 header 3(18) based structure array level 2 in structure "item" packed packed unaligned dcl 120 in procedure "format_pl1_" header based structure level 2 in structure "global" dcl 1-73 in procedure "format_pl1_" i 000736 automatic fixed bin(21,0) dcl 2155 set ref 2162* 2163 2169* id_start_col 000504 automatic fixed bin(17,0) dcl 1330 set ref 1360* 1362* 1514 1737 identifier constant fixed bin(8,0) initial dcl 1-94 ref 910 1451 1591 1597 1640 1657 1663 1676 1726 1932 if_statement constant fixed bin(8,0) initial dcl 1-185 ref 529 683 689 706 806 847 962 1109 1116 1147 1224 if_statement_left_margin 000363 automatic fixed bin(17,0) dcl 953 set ref 977* 983* 1019* 1037* 1072* 1086* if_statement_lineconind 000364 automatic fixed bin(17,0) dcl 955 set ref 978* 984* 1019* 1037* 1072* 1086* in_else_clause 2(19) based bit(1) array level 3 packed packed unaligned dcl 151 set ref 706 989* indcomtxt 4(29) based bit(1) array level 3 packed packed unaligned dcl 120 set ref 2254* 2497 indent parameter bit(1) packed unaligned dcl 2827 ref 2824 2830 indent_end 000330 automatic bit(1) packed unaligned dcl 840 set ref 854* 862* 868* 871* 871* index builtin function dcl 169 ref 1600 2368 2497 2730 2739 initial_itemx parameter fixed bin(17,0) dcl 623 ref 619 634 635 645 646 initial_paren_depth 000555 automatic fixed bin(17,0) dcl 1632 set ref 1675* 1676 1697* 1698 insert_final_NL_sw parameter bit(1) dcl 1754 ref 1746 1866 insnl 3(21) based bit(1) array level 3 packed packed unaligned dcl 120 set ref 2245* 2466 is_after_statement 000714 automatic bit(1) dcl 2049 set ref 2141* 2152 2264 2309 is_independent_statement 000372 constant bit(1) initial array dcl 1-247 ref 1109 1171 1224 is_macro_statement 000304 constant bit(1) initial array dcl 1-254 ref 556 656 1476 1502 2141 2145 is_macro_whitespace 000216 constant bit(1) initial array dcl 1-258 ref 569 656 1184 isub constant fixed bin(8,0) initial dcl 1-94 ref 1726 item based structure array level 1 dcl 120 set ref 289* 648 652* 1348 2111 2116* 2203 2210* item_ptr 000102 automatic pointer dcl 109 set ref 288* 289 290 291 292 303 373 377 377 377 377 377 377 377 377 377 428 428 432 563 594 596 600 645 646 648 648 648 652 653 654 656 656 656 656 667 667 667 667 780 921 965 965 965 969 969 995 1036 1040 1044 1052 1067 1081 1242 1246 1249 1280 1303 1313 1319 1342 1344 1348 1360 1367 1370 1417 1421 1421 1427 1436 1441 1444 1451 1451 1454 1468 1476 1488 1492 1499 1502 1530 1530 1544 1546 1564 1591 1594 1597 1600 1600 1604 1638 1638 1638 1638 1640 1642 1643 1653 1653 1655 1657 1659 1660 1661 1663 1663 1672 1672 1672 1672 1675 1676 1676 1676 1676 1676 1676 1676 1688 1691 1695 1697 1698 1698 1702 1705 1709 1709 1780 1783 1789 1789 1789 1789 1789 1794 1794 1794 1799 1802 1802 1802 1802 1802 1802 1802 1808 1808 1808 1814 1823 1828 1836 1838 1842 1842 1842 1848 1849 1853 1856 1995 1995 2010 2010 2025 2025 2028 2029 2109 2111 2111 2116 2117 2118 2119 2121 2121 2123 2123 2126 2126 2129 2131 2131 2131 2163 2163 2172 2172 2175 2180 2181 2182 2196 2196 2196 2196 2203 2203 2209 2210 2211 2212 2213 2216 2216 2216 2219 2219 2223 2224 2224 2228 2243 2245 2247 2247 2247 2254 2270 2271 2276 2277 2279 2285 2286 2291 2291 2299 2300 2303 2309 2309 2315 2317 2328 2348 2348 2348 2348 2352 2352 2352 2352 2409 2409 2413 2415 2415 2415 2415 2415 2415 2415 2415 2415 2427 2433 2433 2456 2461 2461 2463 2466 2466 2475 2497 2497 2497 2497 2506 2506 2506 2512 2512 2512 2528 2528 2528 2562 2577 2577 2577 2577 2577 2577 2577 2577 2577 2577 2587 2587 2587 2589 2589 2589 2589 2589 2594 2594 2599 2601 2601 2605 2608 2609 item_string based char packed unaligned dcl 1392 in procedure "declaration_list" ref 1421 item_string based char packed unaligned dcl 368 in procedure "set_prevailing_style" set ref 377 377 377 377 item_string based char packed unaligned dcl 1585 in procedure "completely_factored_declaration_list" ref 1600 item_string based char packed unaligned dcl 1634 in procedure "attribute_set" ref 1653 1672 1672 item_string based char packed unaligned dcl 2453 in procedure "copy_item" set ref 2497 2506 2512 2528 2577 2577 2577 2577 2577 2577 2587* 2589* 2594 item_string based char packed unaligned dcl 2405 in procedure "copy_items" set ref 2415 2415 2415 2415 itemx 000505 automatic fixed bin(17,0) dcl 1331 in procedure "format_declare" set ref 1341* 1342 1344 1344* 1353* 1360 1365* 1367* 1367 1370* 1370 1371 1414 1417 1421 1421 1427 1436 1441* 1441 1444 1451 1451* 1451 1454 1462* 1464* 1468* 1468 1476 1488 1492 1497 1499* 1499 1502 1514* 1516* 1524* 1530 1530 1530* 1537 1544 1546* 1546 1547 1564 itemx 000766 automatic fixed bin(17,0) dcl 2403 in procedure "copy_items" set ref 2408* 2409 2409 2413 2415 2415 2415 2415 2415 2415 2415 2415 2415 2421* 2426* 2427 2433 2433 2435* 2439* itemx parameter fixed bin(17,0) dcl 1629 in procedure "attribute_set" set ref 1625 1637 1638 1638 1638 1638 1640 1642 1643 1653 1653 1655* 1655 1657 1659* 1659 1660 1661* 1661 1663 1663* 1663 1672 1672 1672 1672 1675 1676* 1676 1676 1676 1676 1676 1676 1676 1676* 1688 1691* 1691 1695 1697 1698* 1698 1698* 1702 1705* 1705 1709 1709 1709 1709* 1714 itemx 000215 automatic fixed bin(17,0) dcl 587 in procedure "format_prefix_list" set ref 596* 596* 600* 600 600* 602* 605* 608* 611 itemx 000456 automatic fixed bin(17,0) dcl 1239 in procedure "look_ahead_if_is_on_one_line" set ref 1249* 1249* 1253 1255* itemx 000367 automatic fixed bin(17,0) dcl 1030 in begin block on line 1027 set ref 1040* 1040* 1044* 1044 1044* 1048 itemx 000374 automatic fixed bin(17,0) dcl 1079 in begin block on line 1077 set ref 1081* 1081* 1083* itemx parameter fixed bin(17,0) dcl 2346 in procedure "adjust_vertical_white_space_after_item" ref 2343 2348 2348 2348 2348 2352 2352 2352 2352 itemx parameter fixed bin(17,0) dcl 2047 in procedure "make_items" set ref 2038 2109 2111 2115* 2115 2116 2117 2118 2119 2121 2121 2123 2123 2126 2126 2129 2131 2131 2131 2163 2163 2172 2172 2175 2180 2181 2182 2194* 2196 2196 2196 2196 2203 2208* 2208 2209 2210 2211 2212 2213 2216 2216 2216 2219 2219 2223 2224 2224 2228 2243 2245 2247 2247 2247 2254 2270 2271 2276 2277 2279 2285 2286 2291 2291 2299 2300 2303 2309 2309 2315 2317 2328 2337* itemx 000373 automatic fixed bin(17,0) dcl 1065 in begin block on line 1062 set ref 1067* 1067* 1069* itemx 000544 automatic fixed bin(17,0) dcl 1583 in procedure "completely_factored_declaration_list" set ref 1589* 1591 1594* 1594 1594* 1595* 1595 1597 1600 1600* 1602 1604 1610* 1614* 1622 itemx parameter fixed bin(17,0) dcl 2006 in procedure "insert_NL" ref 2003 2010 2010 2013 itemx 000670 automatic fixed bin(17,0) dcl 1992 in procedure "tab_continuation_lines" set ref 1994* 1995 1995 1995* itemx parameter fixed bin(17,0) dcl 2022 in procedure "insert_tab" ref 2019 2025 2025 2028 2029 itemx 000231 automatic fixed bin(17,0) dcl 628 in procedure "convert_stmt_to_items" set ref 634* 639* 643 648 648 652 653 654 656 656 656 667 667 667 itemx parameter fixed bin(17,0) dcl 2450 in procedure "copy_item" ref 2447 2456 2461 2461 2463 2466 2466 2475 2497 2497 2497 2497 2506 2506 2506 2512 2512 2512 2528 2528 2528 2562 2577 2577 2577 2577 2577 2577 2577 2577 2577 2577 2587 2587 2587 2589 2589 2589 2589 2589 2594 2594 2599 2601 2601 2605 2608 2609 itemx 000470 automatic fixed bin(17,0) dcl 1267 in procedure "format_percent_if_macros" set ref 1313* 1313* 1314* 1319 1319* ix 000526 automatic fixed bin(17,0) dcl 1490 in begin block on line 1488 set ref 1492* 1492* 1494* ix 000601 automatic fixed bin(17,0) dcl 1757 in procedure "format_other" set ref 1780* 1780 1780* 1783 1785 1789 1789 1789 1789 1789 1794 1794 1794 1799 1802 1802 1802 1802 1802 1802 1802 1808 1808 1808* 1814 1814 1822 1841* 1842 1842 1842 1847 1848 1849* ix 000525 automatic fixed bin(17,0) dcl 1456 in begin block on line 1454 set ref 1462* 1464 1464 ix_item_string based char packed unaligned dcl 1760 set ref 1802* keep_gave_error_msg parameter bit(1) dcl 2045 ref 2038 2228 keyword_token constant fixed bin(8,0) initial dcl 1-94 ref 1642 1643 label_end parameter fixed bin(17,0) dcl 798 in procedure "format_begin" set ref 791 812* 816* 824* label_end parameter fixed bin(17,0) dcl 1889 in procedure "push_unit" ref 1883 1901 label_end parameter fixed bin(17,0) dcl 838 in procedure "format_do" set ref 831 871* label_end 000202 automatic fixed bin(17,0) dcl 482 in procedure "format_one_statement" set ref 496* 506* 515* 522* 538* label_end parameter fixed bin(17,0) dcl 744 in procedure "format_procedure" set ref 739 763* label_end 1 based fixed bin(17,0) array level 2 in structure "unit_stack" packed packed unaligned dcl 151 in procedure "format_pl1_" set ref 1901* 1928 label_prefix_list constant fixed bin(8,0) initial dcl 1-185 ref 493 1184 label_start 0(18) based fixed bin(17,0) array level 2 in structure "unit_stack" packed packed unaligned dcl 151 in procedure "format_pl1_" set ref 1900* 1928 1928 label_start 000201 automatic fixed bin(17,0) dcl 481 in procedure "format_one_statement" set ref 495* 505* 515* 522* 538* label_start parameter fixed bin(17,0) dcl 1888 in procedure "push_unit" ref 1883 1900 label_start parameter fixed bin(17,0) dcl 837 in procedure "format_do" set ref 831 871* label_start parameter fixed bin(17,0) dcl 743 in procedure "format_procedure" set ref 739 763* label_start parameter fixed bin(17,0) dcl 797 in procedure "format_begin" set ref 791 812* 816* 824* label_string based char packed unaligned dcl 1920 ref 1932 label_token parameter fixed bin(17,0) dcl 1912 ref 1909 1926 1932 1932 1949 1978 last_col 2(18) based fixed bin(17,0) array level 2 packed packed unaligned dcl 120 set ref 1780 1789 1799 1802* 1808* 1814 1823 last_item 000370 automatic fixed bin(17,0) dcl 1031 in begin block on line 1027 set ref 1034* 1037* 1040 1053* 1055* 1057* last_item 000412 automatic fixed bin(17,0) dcl 1131 in begin block on line 1128 set ref 1133* 1135* 1137* last_item parameter fixed bin(17,0) dcl 2401 in procedure "copy_items" ref 2397 2408 last_item parameter fixed bin(17,0) dcl 1236 in procedure "look_ahead_if_is_on_one_line" ref 1231 1242 1246 last_item parameter fixed bin(17,0) dcl 1751 in procedure "format_other" set ref 1746 1772* 1779 1780 1866* last_item 000440 automatic fixed bin(17,0) dcl 1201 in begin block on line 1198 set ref 1203* 1205* 1207* last_item parameter fixed bin(17,0) dcl 1989 in procedure "tab_continuation_lines" ref 1985 1994 last_item parameter fixed bin(17,0) dcl 1580 in procedure "completely_factored_declaration_list" set ref 1576 1588* 1622* last_item 000365 automatic fixed bin(17,0) dcl 1002 in begin block on line 999 set ref 1005* 1010 1010* 1019* 1022* last_ix_item_string based char packed unaligned dcl 1762 set ref 1789 1794* last_line defined char packed unaligned dcl 2851 set ref 2856* last_line_length 001102 automatic fixed bin(21,0) dcl 2844 set ref 2846* 2847 2851 2856 last_line_pos 000602 automatic fixed bin(17,0) dcl 1758 set ref 1786* 1789* 1794* 1799* 1802 1808 last_on_line 000604 automatic fixed bin(17,0) dcl 1818 set ref 1822* 1823 1828 1836 1838 1841 1847* 1853 1853 1853* 1853 1856 1856* 1856 1860* 1862 last_space_class 000117 constant fixed bin(3,0) initial array dcl 2061 ref 2131 2224 last_stmt_item 000457 automatic fixed bin(17,0) dcl 1240 in procedure "look_ahead_if_is_on_one_line" set ref 1242* 1242* 1246 1246* 1249 1253 last_stmt_item 000203 automatic fixed bin(17,0) dcl 483 in procedure "format_one_statement" set ref 563* 563* 567* 575 last_stmt_type 000131 automatic fixed bin(8,0) dcl 327 in begin block on line 326 set ref 330* 333* last_stmt_type parameter fixed bin(8,0) dcl 679 in procedure "adjust_unit_stack" ref 676 683 689 689 last_stmt_type parameter fixed bin(8,0) dcl 477 in procedure "format_one_statement" set ref 473 515* 522* 529* 572* last_stmt_type parameter fixed bin(8,0) dcl 946 in procedure "format_if" set ref 943 962 962 974 989 999* last_stmt_type parameter fixed bin(8,0) dcl 795 in procedure "format_begin" ref 791 806 806 806 last_stmt_type parameter fixed bin(8,0) dcl 835 in procedure "format_do" ref 831 847 847 847 last_stmt_type parameter fixed bin(8,0) dcl 1105 in procedure "is_ifthenstmt" ref 1101 1116 last_trailer_type 000715 automatic fixed bin(8,0) dcl 2050 set ref 2148* 2158 2334* last_type 000716 automatic fixed bin(8,0) dcl 2051 set ref 2109* 2121 2131 left_margin 000104 automatic fixed bin(17,0) dcl 110 set ref 298* 405* 559* 683* 683* 702* 706* 706 717* 735* 750 758* 761* 763* 765* 765 774* 784* 786 802* 804 811* 811 812* 812* 816* 822* 822 824* 824* 843* 845 851* 851 859* 859 867* 867 871* 871* 910* 914* 919* 925* 927* 972 976* 977 987* 992* 992 1055* 1089* 1093* 1093 1095* 1095 1135* 1141* 1147* 1151* 1156* 1156 1159* 1159 1205* 1211* 1215* 1215* 1216* 1216 1274* 1277* 1277* 1309* 1309* 1355 2277* 2409* left_parn constant fixed bin(8,0) initial dcl 1-94 ref 1444 1454 1695 2126 length builtin function dcl 169 ref 977 978 1171 1360 2162 2231 2231 2231 2231 2231 2243 2247 2247 2506 2506 2510 2521 2528 2528 2528 2538 2543 2594 2637 2646 2651 2656 2678 2714 2818 2819 2856 2874 2877 2883 2894 level parameter fixed bin(17,0) dcl 1735 in procedure "structure_id_start_col" ref 1732 1737 level 000524 automatic fixed bin(17,0) dcl 1419 in begin block on line 1417 set ref 1421* 1423 1432 levels based fixed bin(17,0) array dcl 1336 set ref 1349* 1423 1427 1432* levels_ptr 000506 automatic pointer dcl 1332 set ref 1348* 1349 1423 1427 1427 1432 levelx 000510 automatic fixed bin(17,0) dcl 1333 set ref 1350* 1423* 1423 1423* 1427 1431* 1431 1432 1444* 1448* 1448* 1497* 1497* 1516* 1524* 1524* 1530* 1530* 1537* 1537* 1607* 1610* 1610* 1614* 1614* line defined char packed unaligned dcl 2665 in begin block on line 2663 set ref 2668 2671* line defined char packed unaligned dcl 2702 in begin block on line 2700 set ref 2707* line_length 001020 automatic fixed bin(21,0) dcl 2627 set ref 2653* 2656* 2665 2678 2696 2702 line_position 001114 automatic fixed bin(21,0) dcl 2868 in procedure "next_line_position" set ref 2872* 2880* 2880 2883* 2883 2891* 2891 2898 line_position parameter fixed bin(17,0) dcl 2625 in procedure "indent_comment" set ref 2616 2750* line_position 000105 automatic fixed bin(17,0) dcl 111 in procedure "format_pl1_" set ref 279* 451* 458* 465* 2463 2466 2466 2466 2472* 2475 2480 2482 2485* 2490 2492 2493* 2577* 2589* 2589* 2594* 2594 2601 2611* 2806* 2806* line_position parameter fixed bin(17,0) dcl 2841 in procedure "last_line_position" set ref 2838 2847* long 13(03) based bit(1) level 4 packed packed unaligned dcl 1-73 ref 303 looked_ahead 000106 automatic bit(1) dcl 112 in procedure "format_pl1_" set ref 280* 1022* 1048* 1057* 1062 1137* 1141 1198 1207* 1211 1765 1767* looked_ahead parameter bit(1) dcl 1237 in procedure "look_ahead_if_is_on_one_line" set ref 1231 1253* 1255 loop 000717 automatic bit(1) dcl 2052 in procedure "make_items" set ref 2150* 2151 2335* loop 000266 automatic bit(1) dcl 692 in begin block on line 689 set ref 694* 695 699* 723* low_paren_depth 000605 automatic fixed bin(17,0) dcl 1819 set ref 1830* 1836* 1842 1842 1848* low_precedence 000606 automatic fixed bin(17,0) dcl 1820 set ref 1831* 1838* 1842 1849* ltrim builtin function dcl 169 ref 2376 2678 margin parameter fixed bin(17,0) dcl 2828 ref 2824 2830 2832 matched 000634 automatic bit(1) dcl 1916 set ref 1926* 1927 1928 1932* 1938 1965 max builtin function dcl 169 ref 1171 1737 2832 max_constant_token constant fixed bin(8,0) initial dcl 1-154 ref 1726 may_be_ifthenstmt 000366 automatic bit(1) dcl 1003 set ref 1008* 1014* 1017 min builtin function dcl 169 ref 2231 2521 min_constant_token constant fixed bin(8,0) initial dcl 1-154 ref 1726 mode_case defined bit(1) packed unaligned dcl 1-280 ref 960 mode_comcol defined fixed bin(17,0) dcl 1-309 set ref 602* 1069* 1083* 1314* 1494* 2286 2300 mode_dclind defined fixed bin(17,0) dcl 1-309 ref 1360 mode_declareind defined fixed bin(17,0) dcl 1-309 ref 1362 mode_delnl defined bit(1) packed unaligned dcl 1-280 ref 2152 2196 2303 mode_elsestmt defined bit(1) packed unaligned dcl 1-280 ref 1141 1156 mode_equalind defined fixed bin(17,0) dcl 1-309 ref 774 786 mode_idind defined fixed bin(17,0) dcl 1-309 ref 1514 mode_ifthen defined bit(1) packed unaligned dcl 1-280 ref 1062 1093 mode_ifthendo defined bit(1) packed unaligned dcl 1-280 ref 1027 1128 mode_ifthenstmt defined bit(1) packed unaligned dcl 1-280 ref 999 mode_ind defined fixed bin(17,0) dcl 1-309 ref 706 758 765 811 822 851 859 867 890 920 992 1093 1159 1171 1173 1216 1516 2832 mode_indattr defined bit(1) packed unaligned dcl 1-280 ref 1516 1709 mode_indbegin defined bit(1) packed unaligned dcl 1-280 ref 809 mode_indbeginend defined bit(1) packed unaligned dcl 1-280 set ref 812* 812* mode_indblkcom defined bit(1) packed unaligned dcl 1-280 set ref 2277* 2409* mode_indcom defined bit(1) packed unaligned dcl 1-280 ref 2257 mode_indcomtxt defined bit(1) packed unaligned dcl 1-280 ref 2497 mode_inddcls defined bit(1) packed unaligned dcl 1-280 ref 1355 mode_indend defined bit(1) packed unaligned dcl 1-280 ref 862 868 mode_inditerdo defined bit(1) packed unaligned dcl 1-280 ref 859 mode_indnoniterdo defined bit(1) packed unaligned dcl 1-280 ref 851 mode_indnoniterend defined bit(1) packed unaligned dcl 1-280 ref 854 mode_indproc defined bit(1) packed unaligned dcl 1-280 ref 758 mode_indprocbody defined bit(1) packed unaligned dcl 1-280 ref 765 mode_indthenbegin defined bit(1) packed unaligned dcl 1-280 ref 822 mode_indthenbeginend defined bit(1) packed unaligned dcl 1-280 set ref 824* 824* mode_indthenelse defined bit(1) packed unaligned dcl 1-280 ref 706 992 mode_initcol defined fixed bin(17,0) dcl 1-309 ref 405 mode_insnl defined bit(1) packed unaligned dcl 1-280 ref 1775 2010 2352 2466 mode_linecom defined bit(1) packed unaligned dcl 1-280 ref 2294 mode_lineconind defined fixed bin(17,0) dcl 1-309 set ref 556* 559* 608* 761* 774* 784* 786* 802* 843* 886* 890* 925* 978 984 1055* 1089* 1135* 1141* 1147* 1151* 1205* 1211* 1317* 1530* 1537* 1610* mode_ll defined fixed bin(17,0) dcl 1-309 ref 1780 1814 mode_on defined bit(1) packed unaligned dcl 1-280 ref 407 2421 2431 2439 mode_struclvlind defined fixed bin(17,0) dcl 1-309 ref 1737 mode_thendo defined bit(1) packed unaligned dcl 1-280 ref 1048 modes_length 12 based fixed bin(21,0) level 3 dcl 1-73 ref 396 396 modes_ptr 10 based pointer level 3 dcl 1-73 ref 396 multiple_closure_msg 000635 automatic bit(1) dcl 1917 set ref 1925* 1947 1952* n_HT 001021 automatic fixed bin(17,0) dcl 2628 set ref 2639* 2640 2694* 2734* 2735* 2736 n_SP 001022 automatic fixed bin(17,0) dcl 2629 set ref 2640* 2695* n_items 000127 automatic fixed bin(17,0) dcl 295 in begin block on line 294 set ref 299* 300* 301* 309* 310* 312 312* 316* 321* n_items 000200 automatic fixed bin(17,0) dcl 480 in procedure "format_one_statement" set ref 510* 512* 515* 519* 522* 526* 529* 532* 535* 538* 541* 544* 547* 550* 553* 556* 559* 563 575* n_items parameter fixed bin(17,0) dcl 1126 in procedure "format_else" set ref 1123 1133* 1141* 1147* 1151* n_items parameter fixed bin(17,0) dcl 794 in procedure "format_begin" set ref 791 802* n_items parameter fixed bin(17,0) dcl 1326 in procedure "format_declare" ref 1323 1340 1348 1676 n_items parameter fixed bin(17,0) dcl 419 in procedure "delete_and_record_new_prevailing_style_comment" set ref 415 432 440* n_items parameter fixed bin(17,0) dcl 364 in procedure "set_prevailing_style" ref 361 373 377 n_items parameter fixed bin(17,0) dcl 878 in procedure "format_entry" set ref 875 886* 890* n_items parameter fixed bin(17,0) dcl 1262 in procedure "format_percent_if_macros" set ref 1259 1313 1317* n_items 000216 automatic fixed bin(17,0) dcl 588 in procedure "format_prefix_list" set ref 590* 592 596 600 613* n_items parameter fixed bin(17,0) dcl 834 in procedure "format_do" set ref 831 843* n_items parameter fixed bin(17,0) dcl 772 in procedure "format_assignment" set ref 769 774* 780 786* n_items parameter fixed bin(17,0) dcl 742 in procedure "format_procedure" set ref 739 761* n_items parameter fixed bin(17,0) dcl 948 in procedure "format_if" set ref 943 995 1005* 1034* 1053* 1072* 1089* n_items parameter fixed bin(17,0) dcl 898 in procedure "format_end" set ref 895 925* n_items parameter fixed bin(17,0) dcl 1196 in procedure "format_on" set ref 1193 1203* 1211* n_stmts 5 based fixed bin(17,0) level 3 dcl 1-73 ref 288 332 489 499 902 n_tokens 3 based fixed bin(17,0) level 3 dcl 1-73 ref 283 436 455 need_space 3(19) based fixed bin(1,0) array level 3 packed packed unsigned unaligned dcl 120 set ref 594* 645* 2131* 2224* 2291 2475 next_comment_in_col_1 000720 automatic bit(1) dcl 2053 set ref 2145* 2158* 2158 2257 next_token 3 based fixed bin(17,0) array level 2 packed packed unaligned dcl 120 set ref 1342* 1367 1370 1441 1451 1468 1499 1546 1655 1659 1661 1663 1676 1688 1691 1698 1702 1705 nl_vt_np_token constant fixed bin(8,0) initial dcl 1-94 ref 2152 2158 2294 no_token constant fixed bin(8,0) initial dcl 1-94 ref 290 653 1638 2141 2145 2148 null builtin function dcl 169 ref 291 337 383 383 396 396 407 423 451 2421 2808 number parameter fixed bin(17,0) dcl 2762 ref 2758 2764 2767 2767 2771 2771 2775 2775 2779 2779 2783 off_region_length 001056 automatic fixed bin(21,0) dcl 2798 set ref 2803* 2805 2805 2806 2806 off_region_ptr 000110 automatic pointer dcl 113 set ref 337 407* 409* 423 432* 436* 451 467* 2421 2427* 2803* 2805 2806 2808* off_region_string based char packed unaligned dcl 2800 set ref 2805* 2806* old_gave_error_msg 000741 automatic bit(1) dcl 2192 set ref 2209* 2228 on_statement constant fixed bin(8,0) initial dcl 1-185 ref 535 683 683 806 847 1010 1224 open_comment constant char(2) initial packed unaligned dcl 178 ref 2231 2231 2243 output defined char packed unaligned dcl 2747 set ref 2750* output_length 6 based fixed bin(21,0) level 3 dcl 1-73 set ref 276* 354* output_string based char packed unaligned dcl 1-84 set ref 2730 2739 2750 2750 2764* 2767* 2771* 2775* 2779* 2818* paren_depth 2 based fixed bin(8,0) array level 2 packed packed unaligned dcl 120 set ref 656 656 667 667 1675 1676 1697 1698 1836 1842 1842 1848 2121* 2121 2123* 2123 2126* 2126 2216* 2216 2219* 2219 percent_else_statement constant fixed bin(8,0) initial dcl 1-185 ref 550 percent_elseif_statement constant fixed bin(8,0) initial dcl 1-185 ref 547 percent_endif_statement constant fixed bin(8,0) initial dcl 1-185 ref 553 percent_if_statement constant fixed bin(8,0) initial dcl 1-185 ref 544 period constant fixed bin(8,0) initial dcl 1-94 ref 1660 precedence 000470 constant fixed bin(9,0) initial array unsigned dcl 205 in procedure "format_pl1_" ref 1643 2129 2223 precedence 2(09) based fixed bin(9,0) array level 2 in structure "item" packed packed unsigned unaligned dcl 120 in procedure "format_pl1_" set ref 1643* 1838 1842 1849 2129* 2223* prevailing_style 27 based structure level 3 dcl 1-73 set ref 303 404* prevailing_style_item parameter fixed bin(17,0) dcl 365 in procedure "set_prevailing_style" set ref 361 373* 373* 377 377 377 377 377 377 377 377 377 377 prevailing_style_item parameter fixed bin(17,0) dcl 418 in procedure "delete_and_record_new_prevailing_style_comment" ref 415 421 428 428 432 432 440 prevailing_style_item 000130 automatic fixed bin(17,0) dcl 296 in begin block on line 294 set ref 301* 303 312 312* previous_left_margin parameter fixed bin(17,0) dcl 1914 in procedure "pop_unit" set ref 1909 1969* 1977* previous_left_margin 000320 automatic fixed bin(17,0) dcl 800 in procedure "format_begin" set ref 804* 812* 816* 824* previous_left_margin 000362 automatic fixed bin(17,0) dcl 952 in procedure "format_if" set ref 972* 983 987* previous_left_margin parameter fixed bin(17,0) dcl 1891 in procedure "push_unit" ref 1883 1903 previous_left_margin 000331 automatic fixed bin(17,0) dcl 841 in procedure "format_do" set ref 845* 871* previous_left_margin 2 based fixed bin(17,0) array level 2 in structure "unit_stack" packed packed unaligned dcl 151 in procedure "format_pl1_" set ref 1903* 1969 previous_left_margin 000350 automatic fixed bin(17,0) dcl 900 in procedure "format_end" set ref 910* 914* 920* 927 previous_left_margin 000276 automatic fixed bin(17,0) dcl 746 in procedure "format_procedure" set ref 750* 763* procedure_nest_depth 000277 automatic fixed bin(17,0) dcl 747 set ref 752* 754* 754 758 procedure_statement constant fixed bin(8,0) initial dcl 1-185 ref 538 rdc_source 13(07) based bit(1) level 4 packed packed unaligned dcl 1-73 ref 341 2497 reconverting 000232 automatic bit(1) dcl 629 set ref 636* 639* 656 record_style 13(04) based bit(1) level 4 packed packed unaligned dcl 1-73 ref 448 rel builtin function dcl 169 ref 648 1427 1564 1893 2111 2203 require_style_comment 13(05) based bit(1) level 4 packed packed unaligned dcl 1-73 ref 383 return_statement constant fixed bin(8,0) initial dcl 1-185 ref 1224 reverse builtin function dcl 169 ref 2512 2846 revert_statement constant fixed bin(8,0) initial dcl 1-185 ref 1224 right_parn constant fixed bin(8,0) initial dcl 1-94 ref 656 667 1488 1604 1638 1676 1726 1877 2121 2216 rtrim builtin function dcl 169 ref 2376 2656 scan_control_comments parameter bit(1) dcl 2044 ref 2038 2309 scan_index 001002 automatic fixed bin(21,0) dcl 2504 in begin block on line 2497 set ref 2512* 2518 2518* 2521* 2521 2524 2525 scan_index 001023 automatic fixed bin(21,0) dcl 2630 in procedure "indent_comment" set ref 2647* 2649 2651* 2653 2656 2710 2712* 2714 2714* 2719 2727 scan_index 001115 automatic fixed bin(21,0) dcl 2869 in procedure "next_line_position" set ref 2875* 2877 2877* 2880 2881 scan_position 001116 automatic fixed bin(21,0) dcl 2870 in procedure "next_line_position" set ref 2873* 2874 2875 2877 2881* 2881 2883 2883 2891 2894* scan_position 001024 automatic fixed bin(21,0) dcl 2631 in procedure "indent_comment" set ref 2645* 2646 2647 2651 2656 2663 2678 2696 2707 2710* 2710 2712 2714 2724 2727* 2727 search builtin function dcl 169 ref 1789 2376 2647 2846 2875 semi_colon constant fixed bin(8,0) initial dcl 1-94 ref 656 1246 1530 1638 1676 1709 2141 2145 2196 severity parameter fixed bin(35,0) dcl 2906 set ref 2903 2912* 2915 source_length 2 based fixed bin(21,0) level 3 dcl 1-73 set ref 337* 457* source_ptr parameter pointer packed unaligned dcl 2909 in procedure "error" ref 2903 2912 source_ptr based pointer level 3 in structure "global" dcl 1-73 in procedure "format_pl1_" ref 409 space_table 000000 constant fixed bin(1,0) initial array unsigned dcl 2098 ref 2131 2224 start 55(18) based fixed bin(17,0) array level 3 packed packed unaligned dcl 1-73 set ref 495 638 724 905 910 910 1893 1905 start_clause parameter bit(1) dcl 1264 ref 1259 1269 1309 start_col parameter fixed bin(17,0) dcl 1752 in procedure "format_other" set ref 1746 1771* 1772 1823 1860 start_col parameter fixed bin(17,0) dcl 2023 in procedure "insert_tab" ref 2019 2029 start_col parameter fixed bin(17,0) dcl 2007 in procedure "insert_NL" set ref 2003 2013 2013* start_col parameter fixed bin(17,0) dcl 1628 in procedure "attribute_set" set ref 1625 1709* 1714* start_line_position parameter fixed bin(17,0) dcl 2865 ref 2862 2872 state based fixed bin(17,0) array level 2 packed packed unaligned dcl 1381 set ref 1407 1410* 1469* 1482 1485* 1548* 1570* stmt 55 based structure array level 2 dcl 1-73 set ref 288 stmt_type 000204 automatic fixed bin(8,0) dcl 484 set ref 509* 512 515 519 522 526 529 532 535 538 541 544 547 550 553 556 569 571* 572 stmtx 000430 automatic fixed bin(17,0) dcl 1182 in procedure "next_statement" set ref 1184* 1184 1184 1184* 1190 stmtx parameter fixed bin(17,0) dcl 476 in procedure "format_one_statement" set ref 473 486 488* 489 493 495 496 498* 499 509 510* 571* 571* 577* 577 847 902 905 910 910 999* 1005 1010 1010 1010 1022* 1027 1034 1053 1057* 1095 1128 1133 1137* 1147 1156 1198* 1203 1207* 1476 1502 1893 1905 stmtx parameter fixed bin(17,0) dcl 1234 in procedure "look_ahead_if_is_on_one_line" set ref 1231 1255* stmtx parameter fixed bin(17,0) dcl 681 in procedure "adjust_unit_stack" set ref 676 683 683 689 706* 724 stmtx parameter fixed bin(17,0) dcl 2042 in procedure "make_items" ref 2038 2141 2141 2145 2279 stmtx parameter fixed bin(17,0) dcl 1222 in procedure "may_be_one_line_on_unit" ref 1219 1224 1224 1224 1224 1224 stmtx parameter fixed bin(17,0) dcl 1104 in procedure "is_ifthenstmt" ref 1101 1109 1109 1113 1116 stmtx parameter fixed bin(17,0) dcl 584 in procedure "format_prefix_list" set ref 581 590* 605 614* 614 stmtx 000132 automatic fixed bin(17,0) dcl 328 in begin block on line 326 set ref 331* 332 333* stmtx 000233 automatic fixed bin(17,0) dcl 630 in procedure "convert_stmt_to_items" set ref 633* 638 638 639* 654 656 656 656 656 stop_position parameter fixed bin(21,0) dcl 2795 ref 2792 2803 string parameter char packed unaligned dcl 2866 in procedure "next_line_position" ref 2862 2874 2875 2877 2883 2883 2891 2894 string parameter char packed unaligned dcl 2842 in procedure "last_line_position" set ref 2838 2846 2847* 2856 2856 2856 string parameter char packed unaligned dcl 2816 in procedure "copy_string" ref 2813 2818 2818 2819 string_ptr 1 based pointer array level 2 in structure "trailer" packed packed unaligned dcl 1-37 in procedure "format_pl1_" set ref 2158 2162 2163 2169 2203* 2212 2231 2231 2247 2309 2317 2317 2317 2317 string_ptr 1 based pointer array level 2 in structure "item" packed packed unaligned dcl 120 in procedure "format_pl1_" set ref 291* 303 377 377 377 377 428 428 432 648* 654* 656* 667* 921* 965 969 1280* 1303* 1421 1427* 1436* 1476* 1502* 1564* 1600 1653 1672 1672 1789 1794 1802 2118* 2212* 2328* 2415 2415 2415 2415 2427 2433 2433 2497 2506 2512 2528 2577 2577 2577 2587 2589 2594 string_ptr 1 based pointer array level 2 in structure "token" packed packed unaligned dcl 1-29 in procedure "format_pl1_" set ref 436 464 464 467 654 724* 905* 1893* 1905 1932 1932 1949* 1978* 2111* 2118 string_size based fixed bin(21,0) array level 2 in structure "token" packed packed unaligned dcl 1-29 in procedure "format_pl1_" set ref 1932 1932 2119 string_size based fixed bin(21,0) array level 2 in structure "trailer" packed packed unaligned dcl 1-37 in procedure "format_pl1_" ref 2158 2162 2163 2169 2213 2231 2231 2247 2309 2309 2317 2317 2317 2317 string_size based fixed bin(21,0) array level 2 in structure "item" packed packed unaligned dcl 120 in procedure "format_pl1_" set ref 377 377 377 377 965 969 1360 1421 1600 1653 1672 1672 1789 1794 1794 1802 1802 1808 2119* 2213* 2415 2415 2415 2415 2497 2506 2512 2528 2577 2577 2577 2587 2587 2589 2589 2594 style based structure level 1 dcl 1-273 style_before_trailers 000721 automatic structure level 1 dcl 2054 set ref 2139* 2339 substr builtin function dcl 169 set ref 2163 2169 2231 2231 2247 2371 2456 2497 2512 2528 2599 2647 2651 2656 2678 2712 2714 2730 2739 2764* 2767* 2771* 2775* 2779* 2818* 2875 2877 2883 2891 subtype 55(09) based fixed bin(8,0) array level 3 packed packed unaligned dcl 1-73 set ref 847 1027 1128 subtype_noniterative_do constant fixed bin(8,0) initial dcl 1-265 ref 847 1027 1128 switches 42 based bit(1) array level 4 packed packed unaligned dcl 1-73 set ref 407 407 706 706 758 758 765 765 809 809 812 812 812 812 822 822 824 824 824 824 851 851 854 854 859 859 862 862 868 868 960 960 992 992 999 999 1027 1027 1048 1048 1062 1062 1093 1093 1128 1128 1141 1141 1156 1156 1355 1355 1516 1516 1709 1709 1775 1775 2010 2010 2152 2152 2196 2196 2257 2257 2277 2277 2294 2294 2303 2303 2352 2352 2409 2409 2421 2421 2431 2431 2439 2439 2466 2466 2497 2497 sys_info$max_seg_size 000012 external static fixed bin(19,0) dcl 1-426 ref 648 1427 1564 1893 2111 2203 2730 2739 2750 2764 2767 2771 2775 2779 2818 tab 3(18) based bit(1) array level 3 in structure "item" packed packed unaligned dcl 120 in procedure "format_pl1_" set ref 1044 1319 1783 1995 2025 2028* 2270* 2276* 2285* 2299* 2352 2461 2577 tab parameter bit(1) dcl 2623 in procedure "indent_comment" ref 2616 2633 2674 2730 tab_blkcom 3(20) based bit(1) array level 3 packed packed unaligned dcl 120 set ref 2279* 2409 tab_interval constant fixed bin(4,0) initial dcl 180 ref 2480 2480 2485 2485 2639 2640 2734 2736 2883 2883 2883 tabs 000777 automatic fixed bin(17,0) dcl 2459 set ref 2480* 2482 2484* target_comma constant fixed bin(8,0) initial dcl 1-94 ref 1877 2264 temp_segs 000116 automatic pointer array dcl 1-23 set ref 275* 276 283 283 288 288 303 303 303 303* 312 332 337 341 354 377* 383 388 395 396* 396 396 396 399 399 404 404 405 407 409 436 436 448 451* 455 457 458* 464 464 465* 467 486 489 493 495 496 499 509 556 559 602 605 608 638 638 654 654 656 656 656 656 656 683 683 689 706 706 706 724 724 758 758 761 765 765 774 774 784 786 786 802 809 811 812 812 822 822 824 824 843 847 851 851 854 859 859 862 867 868 886 890 890 902 905 905 910 910 910 920 925 960 978 984 992 992 999 1010 1027 1027 1048 1055 1062 1069 1083 1089 1093 1093 1095 1109 1109 1113 1116 1128 1128 1135 1141 1141 1147 1147 1151 1156 1156 1159 1171 1173 1184 1184 1184 1205 1211 1216 1224 1224 1224 1224 1224 1314 1317 1355 1360 1362 1476 1494 1502 1514 1516 1516 1530 1537 1610 1709 1737 1775 1780 1814 1893 1893 1905 1905 1932 1932 1932 1932 1932 1932 1949 1978 2010 2108 2111 2118 2119 2136 2139 2141 2141 2145 2151 2152 2152 2158 2158 2162 2162 2163 2163 2169 2169 2196 2196 2203 2212 2213 2231 2231 2231 2231 2247 2247 2257 2277 2279 2286 2294 2294 2294 2300 2303 2309 2309 2309 2317* 2317 2317 2317 2317 2317 2317 2317 2317 2334 2335 2339 2352 2409 2415* 2421 2431 2439 2466 2497 2497 2730 2739 2750 2764 2767 2771 2775 2779 2818 2832 2912* text_after_end_msg 000112 automatic bit(1) dcl 114 set ref 281* 902 907* text_indentation 001025 automatic fixed bin(17,0) dcl 2635 set ref 2637* 2639 2640 then_item 000361 automatic fixed bin(17,0) dcl 951 set ref 995* 995* 1036 1044 1048 1052 1055* 1057* 1067 1081 1086 1089* then_item_NLs 000371 automatic fixed bin(17,0) dcl 1032 set ref 1036* 1052 third_item_string based char packed unaligned dcl 957 ref 965 969 this_space_class 000031 constant fixed bin(3,0) initial array dcl 2080 ref 2131 2224 this_stmtx parameter fixed bin(17,0) dcl 1180 ref 1177 1184 this_type 000734 automatic fixed bin(8,0) dcl 2055 set ref 2108* 2117 2126 2129 2131 2141 2141 2145 2145 2196 2264 2264 token based structure array level 1 dcl 1-29 set ref 283 tokenx 000511 automatic fixed bin(17,0) dcl 1334 in procedure "format_declare" set ref 1340* 1341 1342 1344* tokenx parameter fixed bin(17,0) dcl 2043 in procedure "make_items" ref 2038 2108 2111 2118 2119 2136 2141 2151 2196 2257 2279 tokenx 000234 automatic fixed bin(17,0) dcl 631 in procedure "convert_stmt_to_items" set ref 638* 639* trailer 4 based structure array level 2 in structure "item" packed packed unaligned dcl 120 in procedure "format_pl1_" trailer based structure array level 1 dcl 1-37 in procedure "format_pl1_" trailer_index 2 based fixed bin(17,0) array level 2 dcl 1-29 set ref 2136 2151 2196 trailer_string based char packed unaligned dcl 2058 set ref 2158 2162 2163 2169 2231 2231 2247 2309* 2317 2317 2317 2317 trailerx 000735 automatic fixed bin(17,0) dcl 2056 set ref 2151* 2152 2158 2158 2162 2162 2163 2163 2169 2169 2196 2203 2212 2213 2231 2231 2231 2231 2247 2247 2294 2294 2309 2309 2309 2317 2317 2317 2317 2317 2317 2317 2317 2334 2335* tree_control_comment 000206 constant char(10) initial packed unaligned dcl 1-412 ref 969 trim_length 001030 automatic fixed bin(21,0) dcl 2676 set ref 2678* 2683 2685 2696 trimmed_line defined char packed unaligned dcl 2685 set ref 2696* tx 000636 automatic fixed bin(17,0) dcl 1918 set ref 1928* 1932 1932 1932 1932* tx_token_string based char packed unaligned dcl 1922 ref 1932 type 0(27) based fixed bin(8,0) array level 2 in structure "token" packed packed unaligned dcl 1-29 in procedure "format_pl1_" set ref 656 910 1932 1932 2108 type 0(27) based fixed bin(8,0) array level 2 in structure "item" packed packed unaligned dcl 120 in procedure "format_pl1_" set ref 290* 563 596 600 653* 656 667 780 965 995 1040 1067 1081 1242 1246 1313 1344 1417 1444 1451 1454 1488 1492 1530 1530 1544 1591 1594 1597 1604 1638 1638 1638 1638 1640 1642* 1657 1660 1663 1676 1676 1676 1676 1676* 1695 1709 1709 1789 1789 1802 1802 1828* 1853* 1856 2025 2109 2117* 2211* 2216 2224 2352 2466 2497 2589 2589 type parameter fixed bin(8,0) packed unaligned dcl 1723 in procedure "could_end_a_reference" ref 1720 1726 1726 1726 1726 1726 type 0(27) based fixed bin(8,0) array level 2 in structure "trailer" packed packed unaligned dcl 1-37 in procedure "format_pl1_" ref 2152 2294 2334 type parameter fixed bin(8,0) packed unaligned dcl 1874 in procedure "item_should_end_line" ref 1871 1877 1877 1877 1877 type 55 based fixed bin(8,0) array level 3 in structure "global" packed packed unaligned dcl 1-73 in procedure "format_pl1_" set ref 486 493 509 605 656 656 656 683 683 689 706 1010 1095* 1109 1109 1113 1116 1147 1156* 1184 1184 1184 1224 1224 1224 1224 1224 1476 1502 2141 2145 type based fixed bin(17,0) array level 2 in structure "unit_stack" packed packed unaligned dcl 151 in procedure "format_pl1_" set ref 285* 341 341 341 348 683 696 700* 717 732 732 754 882 886 1272 1277 1289 1293 1899* 1940 1940 1940 1940 unit_stack based structure array level 1 dcl 151 set ref 284* 1296* 1296 1402 1893 1898* unit_stack_index 000113 automatic fixed bin(17,0) dcl 115 set ref 286* 340* 340* 341 341 341 341 341 348 348* 683 696 700 702 706 706 717 732 732 753 754 882 902 910 962 976 988 989 1147 1272 1272 1277 1289 1295 1300* 1300 1402 1893 1897* 1897 1898 1899 1900 1901 1902 1903 1905 1927 1928 1928 1928 1940 1940 1940 1940 1955 1961* 1961 1967 1969 1971* 1971 unit_stack_ptr 000114 automatic pointer dcl 116 set ref 283* 284 285 341 341 341 341 348 348 683 696 700 702 706 706 717 732 732 754 882 886 886 962 976 988 989 1147 1272 1277 1289 1293 1296 1296 1402 1893 1893 1898 1899 1900 1901 1902 1903 1905 1928 1928 1928 1940 1940 1940 1940 1955 1967 1969 unit_type parameter fixed bin(17,0) dcl 1887 ref 1883 1899 unitx 000340 automatic fixed bin(17,0) dcl 880 in procedure "format_entry" set ref 882* 882* 886 886 unitx 000471 automatic fixed bin(17,0) dcl 1287 in begin block on line 1285 set ref 1289* 1289* 1293 1295* 1295* 1296 1296* unitx 000300 automatic fixed bin(17,0) dcl 748 in procedure "format_procedure" set ref 753* unknown_statement constant fixed bin(8,0) initial dcl 1-185 ref 330 656 unspec builtin function dcl 169 set ref 284* 289* 303 303 399 399 652* 1569* 1898* 2116* 2210* values 43 based fixed bin(17,0) array level 4 dcl 1-73 set ref 405 405 556 556 559 559 602 602 608 608 706 706 758 758 761 761 765 765 774 774 774 774 784 784 786 786 786 786 802 802 811 811 822 822 843 843 851 851 859 859 867 867 886 886 890 890 890 890 920 920 925 925 978 978 984 984 992 992 1055 1055 1069 1069 1083 1083 1089 1089 1093 1093 1135 1135 1141 1141 1147 1147 1151 1151 1159 1159 1171 1171 1173 1173 1205 1205 1211 1211 1216 1216 1314 1314 1317 1317 1360 1360 1362 1362 1494 1494 1514 1514 1516 1516 1530 1530 1537 1537 1610 1610 1737 1737 1780 1780 1814 1814 2286 2286 2300 2300 2832 2832 verify builtin function dcl 169 ref 2371 2512 2668 2712 vertical_white_space defined char packed unaligned dcl 2719 set ref 2724* 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 asterisk internal static fixed bin(8,0) initial dcl 1-94 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 cat internal static fixed bin(8,0) initial dcl 1-94 close_statement internal static fixed bin(8,0) initial dcl 1-185 command internal static char(10) initial packed unaligned dcl 1-89 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 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_lex_ 000000 constant entry external dcl 1-430 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 invalid_char internal static fixed bin(8,0) initial dcl 1-94 ioa_ 000000 constant entry external dcl 261 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_integral_constant internal static bit(4) initial dcl 1-166 le 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_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_delimiter_token internal static fixed bin(8,0) initial dcl 1-154 minus internal static fixed bin(8,0) initial dcl 1-94 mode_separator internal static char(1) initial packed unaligned dcl 1-398 ne internal static fixed bin(8,0) initial dcl 1-94 ngt internal static fixed bin(8,0) initial dcl 1-94 nlt 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 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_error_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 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 put_statement internal static fixed bin(8,0) initial dcl 1-185 read_statement internal static fixed bin(8,0) initial dcl 1-185 revert_mode internal static char(6) initial packed unaligned dcl 1-400 rewrite_statement internal static fixed bin(8,0) initial dcl 1-185 signal_statement internal static fixed bin(8,0) initial dcl 1-185 size builtin function dcl 169 slash internal static fixed bin(8,0) initial dcl 1-94 stop_statement internal static fixed bin(8,0) initial dcl 1-185 style_mode internal static char(5) initial packed unaligned dcl 1-402 styles internal static structure array level 1 dcl 1-358 subtype_none internal static fixed bin(8,0) initial dcl 1-265 switch_antonym_names internal static char(4) initial array packed unaligned dcl 1-335 switch_mode_names internal static char(15) initial array packed unaligned dcl 1-324 switch_mode_not_indicator internal static char(1) initial packed unaligned dcl 1-404 system_on_unit internal static fixed bin(8,0) initial dcl 1-185 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 unlock_statement internal static fixed bin(8,0) initial dcl 1-185 value_mode_names internal static char(12) initial array packed unaligned dcl 1-339 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. adjust_unit_stack 003436 constant entry internal dcl 676 ref 571 adjust_vertical_white_space_after_item 014054 constant entry internal dcl 2343 ref 2194 2337 attribute_set 010461 constant entry internal dcl 1625 ref 1514 clause_indentation 006254 constant entry internal dcl 1163 ref 1095 1156 completely_factored_declaration_list 010267 constant entry internal dcl 1576 ref 1462 convert_stmt_to_items 003131 constant entry internal dcl 619 ref 510 590 1005 1010 1034 1053 1133 1203 1255 copy_char 016003 constant entry internal dcl 2758 ref 2484 2492 2608 2609 2694 2695 2735 2736 copy_item 014556 constant entry internal dcl 2447 ref 2421 2426 2435 2439 copy_items 014313 constant entry internal dcl 2397 ref 316 321 421 440 567 575 613 copy_off_region 016116 constant entry internal dcl 2792 ref 337 428 457 464 2433 copy_string 016174 constant entry internal dcl 2813 ref 2471 2587 2601 2605 2643 2668 2671 2696 2707 2724 2739 2744 2805 could_end_a_reference 011042 constant entry internal dcl 1720 ref 1676 declaration_list 007266 constant entry internal dcl 1375 ref 1368 delete_and_record_new_prevailing_style_comment 002056 constant entry internal dcl 415 ref 312 error 016461 constant entry internal dcl 2903 ref 341 348 383 648 656 667 724 905 921 1280 1303 1427 1436 1476 1502 1564 1893 1949 1955 1978 2111 2203 2328 2385 format_assignment 004015 constant entry internal dcl 769 ref 512 format_begin 004144 constant entry internal dcl 791 ref 515 format_declare 007142 constant entry internal dcl 1323 ref 519 format_do 004327 constant entry internal dcl 831 ref 522 format_else 006002 constant entry internal dcl 1123 ref 532 format_end 004572 constant entry internal dcl 895 ref 526 format_entry 004460 constant entry internal dcl 875 ref 541 format_if 004773 constant entry internal dcl 943 ref 529 format_on 006335 constant entry internal dcl 1193 ref 535 format_one_statement 002306 constant entry internal dcl 473 ref 333 format_other 011112 constant entry internal dcl 1746 ref 556 559 605 608 761 774 784 786 802 843 886 890 925 1019 1037 1055 1072 1086 1089 1135 1141 1147 1151 1205 1211 1317 1530 1537 1610 1614 1709 1714 format_percent_if_macros 006636 constant entry internal dcl 1259 ref 544 547 550 553 format_pl1_ 001212 constant entry external dcl 100 format_prefix_list 002737 constant entry internal dcl 581 ref 488 498 format_procedure 003703 constant entry internal dcl 739 ref 538 indent_comment 015325 constant entry internal dcl 2616 ref 2577 indent_margin 016216 constant entry internal dcl 2824 ref 812 812 824 824 871 871 2277 2409 insert_NL 012363 constant entry internal dcl 2003 ref 1371 1497 1547 1860 1866 insert_tab 012424 constant entry internal dcl 2019 ref 602 1069 1083 1314 1319 1365 1448 1494 1771 1995 2013 is_control_comment 014126 constant entry internal dcl 2357 ref 2309 is_ifthenstmt 005721 constant entry internal dcl 1101 ref 999 item_should_end_line 011643 constant entry internal dcl 1871 ref 1828 1853 last_line_position 016240 constant entry internal dcl 2838 ref 1794 2589 2750 2806 look_ahead_if_is_on_one_line 006535 constant entry internal dcl 1231 ref 1022 1057 1137 1207 make_items 012453 constant entry internal dcl 2038 ref 300 310 639 may_be_one_line_on_unit 006502 constant entry internal dcl 1219 ref 1010 1198 next_line_position 016352 constant entry internal dcl 2862 ref 1802 2847 2856 next_statement 006302 constant entry internal dcl 1177 ref 571 571 706 1116 pop_unit 012022 constant entry internal dcl 1909 ref 683 717 735 910 914 1274 1277 push_declare_stack_entry 010205 constant entry internal dcl 1559 ref 1405 1471 push_unit 011673 constant entry internal dcl 1883 ref 763 812 816 824 871 987 1215 1309 record_style 002154 constant entry internal dcl 445 ref 322 423 430 set_prevailing_style 001612 constant entry internal dcl 361 ref 301 structure_id_start_col 011076 constant entry internal dcl 1732 ref 1448 1448 1497 1497 1516 1524 1524 1530 1530 1537 1537 1610 1610 1614 1614 tab_continuation_lines 012322 constant entry internal dcl 1985 ref 1516 1524 1772 unrecoverable_error 001605 constant label dcl 354 ref 2915 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 21236 21262 21126 21246 Length 21504 21126 24 206 107 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME format_pl1_ 2050 external procedure is an external procedure. begin block on line 294 begin block shares stack frame of external procedure format_pl1_. begin block on line 326 begin block shares stack frame of external procedure format_pl1_. set_prevailing_style internal procedure shares stack frame of external procedure format_pl1_. begin block on line 388 begin block shares stack frame of external procedure format_pl1_. delete_and_record_new_prevailing_style_comment internal procedure shares stack frame of external procedure format_pl1_. record_style internal procedure shares stack frame of external procedure format_pl1_. format_one_statement internal procedure shares stack frame of external procedure format_pl1_. format_prefix_list internal procedure shares stack frame of external procedure format_pl1_. convert_stmt_to_items internal procedure shares stack frame of external procedure format_pl1_. adjust_unit_stack internal procedure shares stack frame of external procedure format_pl1_. begin block on line 689 begin block shares stack frame of external procedure format_pl1_. format_procedure internal procedure shares stack frame of external procedure format_pl1_. format_assignment internal procedure shares stack frame of external procedure format_pl1_. begin block on line 777 begin block shares stack frame of external procedure format_pl1_. format_begin internal procedure shares stack frame of external procedure format_pl1_. format_do internal procedure shares stack frame of external procedure format_pl1_. format_entry internal procedure shares stack frame of external procedure format_pl1_. format_end internal procedure shares stack frame of external procedure format_pl1_. format_if internal procedure shares stack frame of external procedure format_pl1_. begin block on line 999 begin block shares stack frame of external procedure format_pl1_. begin block on line 1027 begin block shares stack frame of external procedure format_pl1_. begin block on line 1062 begin block shares stack frame of external procedure format_pl1_. begin block on line 1077 begin block shares stack frame of external procedure format_pl1_. is_ifthenstmt internal procedure shares stack frame of external procedure format_pl1_. format_else internal procedure shares stack frame of external procedure format_pl1_. begin block on line 1128 begin block shares stack frame of external procedure format_pl1_. clause_indentation internal procedure shares stack frame of external procedure format_pl1_. next_statement internal procedure shares stack frame of external procedure format_pl1_. format_on internal procedure shares stack frame of external procedure format_pl1_. begin block on line 1198 begin block shares stack frame of external procedure format_pl1_. may_be_one_line_on_unit internal procedure shares stack frame of external procedure format_pl1_. look_ahead_if_is_on_one_line internal procedure shares stack frame of external procedure format_pl1_. format_percent_if_macros internal procedure shares stack frame of external procedure format_pl1_. begin block on line 1285 begin block shares stack frame of external procedure format_pl1_. format_declare internal procedure shares stack frame of external procedure format_pl1_. declaration_list internal procedure shares stack frame of external procedure format_pl1_. begin block on line 1417 begin block shares stack frame of external procedure format_pl1_. begin block on line 1454 begin block shares stack frame of external procedure format_pl1_. begin block on line 1488 begin block shares stack frame of external procedure format_pl1_. push_declare_stack_entry internal procedure shares stack frame of external procedure format_pl1_. completely_factored_declaration_list internal procedure shares stack frame of external procedure format_pl1_. attribute_set internal procedure shares stack frame of external procedure format_pl1_. could_end_a_reference internal procedure shares stack frame of external procedure format_pl1_. structure_id_start_col internal procedure shares stack frame of external procedure format_pl1_. format_other internal procedure shares stack frame of external procedure format_pl1_. begin block on line 1816 begin block shares stack frame of external procedure format_pl1_. item_should_end_line internal procedure shares stack frame of external procedure format_pl1_. push_unit internal procedure shares stack frame of external procedure format_pl1_. pop_unit internal procedure shares stack frame of external procedure format_pl1_. tab_continuation_lines internal procedure shares stack frame of external procedure format_pl1_. insert_NL internal procedure shares stack frame of external procedure format_pl1_. insert_tab internal procedure shares stack frame of external procedure format_pl1_. make_items internal procedure shares stack frame of external procedure format_pl1_. begin block on line 2152 begin block shares stack frame of external procedure format_pl1_. begin block on line 2189 begin block shares stack frame of external procedure format_pl1_. adjust_vertical_white_space_after_item internal procedure shares stack frame of external procedure format_pl1_. is_control_comment internal procedure shares stack frame of external procedure format_pl1_. copy_items internal procedure shares stack frame of external procedure format_pl1_. copy_item internal procedure shares stack frame of external procedure format_pl1_. begin block on line 2456 begin block shares stack frame of external procedure format_pl1_. begin block on line 2497 begin block shares stack frame of external procedure format_pl1_. begin block on line 2550 begin block shares stack frame of external procedure format_pl1_. indent_comment internal procedure shares stack frame of external procedure format_pl1_. begin block on line 2633 begin block shares stack frame of external procedure format_pl1_. begin block on line 2663 begin block shares stack frame of external procedure format_pl1_. begin block on line 2674 begin block shares stack frame of external procedure format_pl1_. begin block on line 2683 begin block shares stack frame of external procedure format_pl1_. begin block on line 2700 begin block shares stack frame of external procedure format_pl1_. begin block on line 2718 begin block shares stack frame of external procedure format_pl1_. begin block on line 2746 begin block shares stack frame of external procedure format_pl1_. copy_char internal procedure shares stack frame of external procedure format_pl1_. copy_off_region internal procedure shares stack frame of external procedure format_pl1_. copy_string internal procedure shares stack frame of external procedure format_pl1_. indent_margin internal procedure shares stack frame of external procedure format_pl1_. last_line_position internal procedure shares stack frame of external procedure format_pl1_. begin block on line 2850 begin block shares stack frame of external procedure format_pl1_. next_line_position internal procedure shares stack frame of external procedure format_pl1_. error internal procedure shares stack frame of external procedure format_pl1_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME format_pl1_ 000100 copy_position format_pl1_ 000102 item_ptr format_pl1_ 000104 left_margin format_pl1_ 000105 line_position format_pl1_ 000106 looked_ahead format_pl1_ 000110 off_region_ptr format_pl1_ 000112 text_after_end_msg format_pl1_ 000113 unit_stack_index format_pl1_ 000114 unit_stack_ptr format_pl1_ 000116 temp_segs format_pl1_ 000127 n_items begin block on line 294 000130 prevailing_style_item begin block on line 294 000131 last_stmt_type begin block on line 326 000132 stmtx begin block on line 326 000143 control_com_style begin block on line 388 000200 n_items format_one_statement 000201 label_start format_one_statement 000202 label_end format_one_statement 000203 last_stmt_item format_one_statement 000204 stmt_type format_one_statement 000214 first_prefix_item format_prefix_list 000215 itemx format_prefix_list 000216 n_items format_prefix_list 000230 first_in_item_array convert_stmt_to_items 000231 itemx convert_stmt_to_items 000232 reconverting convert_stmt_to_items 000233 stmtx convert_stmt_to_items 000234 tokenx convert_stmt_to_items 000266 loop begin block on line 689 000276 previous_left_margin format_procedure 000277 procedure_nest_depth format_procedure 000300 unitx format_procedure 000310 assignment_item begin block on line 777 000320 previous_left_margin format_begin 000330 indent_end format_do 000331 previous_left_margin format_do 000340 unitx format_entry 000350 previous_left_margin format_end 000360 current_mode_case format_if 000361 then_item format_if 000362 previous_left_margin format_if 000363 if_statement_left_margin format_if 000364 if_statement_lineconind format_if 000365 last_item begin block on line 999 000366 may_be_ifthenstmt begin block on line 999 000367 itemx begin block on line 1027 000370 last_item begin block on line 1027 000371 then_item_NLs begin block on line 1027 000373 itemx begin block on line 1062 000374 itemx begin block on line 1077 000412 last_item begin block on line 1128 000430 stmtx next_statement 000440 last_item begin block on line 1198 000456 itemx look_ahead_if_is_on_one_line 000457 last_stmt_item look_ahead_if_is_on_one_line 000470 itemx format_percent_if_macros 000471 unitx begin block on line 1285 000502 declare_margin format_declare 000503 factored_level_number format_declare 000504 id_start_col format_declare 000505 itemx format_declare 000506 levels_ptr format_declare 000510 levelx format_declare 000511 tokenx format_declare 000520 declare_stack_index declaration_list 000522 declare_stack_ptr declaration_list 000524 level begin block on line 1417 000525 ix begin block on line 1454 000526 ix begin block on line 1488 000544 itemx completely_factored_declaration_list 000554 first_item attribute_set 000555 initial_paren_depth attribute_set 000600 first_on_line format_other 000601 ix format_other 000602 last_line_pos format_other 000604 last_on_line begin block on line 1816 000605 low_paren_depth begin block on line 1816 000606 low_precedence begin block on line 1816 000634 matched pop_unit 000635 multiple_closure_msg pop_unit 000636 tx pop_unit 000670 itemx tab_continuation_lines 000714 is_after_statement make_items 000715 last_trailer_type make_items 000716 last_type make_items 000717 loop make_items 000720 next_comment_in_col_1 make_items 000721 style_before_trailers make_items 000734 this_type make_items 000735 trailerx make_items 000736 i begin block on line 2152 000740 category begin block on line 2189 000741 old_gave_error_msg begin block on line 2189 000756 control_comment is_control_comment 000766 itemx copy_items 000776 col_to_go begin block on line 2456 000777 tabs begin block on line 2456 001000 comment_close_ind_len begin block on line 2497 001001 comment_text_len begin block on line 2497 001002 scan_index begin block on line 2497 001020 line_length indent_comment 001021 n_HT indent_comment 001022 n_SP indent_comment 001023 scan_index indent_comment 001024 scan_position indent_comment 001025 text_indentation begin block on line 2633 001030 trim_length begin block on line 2674 001056 off_region_length copy_off_region 001102 last_line_length last_line_position 001114 line_position next_line_position 001115 scan_index next_line_position 001116 scan_position next_line_position THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_l_a r_g_a r_e_as r_ne_as r_le_a r_ge_a alloc_char_temp call_ext_out_desc call_ext_out return_mac bound_ck_signal signal_op shorten_stack ext_entry_desc repeat set_chars_eis index_chars_eis any_to_any_truncate_ index_before_cs index_after_cs THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. char_offset_ format_pl1_error_ format_pl1_long_ format_pl1_modes_ format_pl1_record_style_ 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 100 001207 275 001217 276 001265 278 001267 279 001271 280 001273 281 001274 283 001275 284 001302 285 001305 286 001307 288 001311 289 001315 290 001320 291 001322 292 001324 298 001326 299 001330 300 001331 301 001341 303 001343 309 001375 310 001377 312 001406 316 001420 321 001425 322 001431 330 001432 331 001434 332 001436 333 001442 334 001444 337 001445 340 001460 341 001465 348 001544 352 001602 354 001605 357 001611 361 001612 373 001614 375 001631 377 001633 383 001740 388 001757 395 001763 396 001767 399 002030 404 002037 405 002043 407 002045 409 002053 411 002055 415 002056 421 002060 423 002067 428 002075 430 002116 432 002117 436 002130 440 002137 441 002153 445 002154 448 002155 451 002162 455 002210 457 002213 458 002221 460 002242 464 002243 465 002261 467 002302 469 002305 473 002306 486 002310 488 002317 489 002325 493 002333 495 002344 496 002351 498 002354 499 002362 501 002370 505 002371 506 002372 509 002373 510 002402 512 002422 515 002430 519 002450 522 002455 526 002475 529 002502 532 002516 535 002523 538 002530 541 002535 544 002542 547 002553 550 002565 553 002600 556 002611 559 002641 563 002664 565 002677 567 002702 569 002706 571 002711 572 002724 575 002727 577 002734 579 002736 581 002737 590 002741 592 002761 594 002767 596 002775 598 003014 600 003016 602 003035 603 003051 605 003053 608 003074 611 003116 613 003122 614 003126 615 003130 619 003131 633 003133 634 003135 635 003137 636 003142 638 003145 639 003163 641 003165 643 003167 645 003172 646 003202 648 003205 652 003247 653 003255 654 003265 656 003300 667 003400 672 003435 676 003436 683 003440 689 003471 694 003507 695 003511 696 003514 699 003525 700 003526 702 003532 706 003536 715 003606 717 003607 723 003616 724 003617 729 003657 689 003660 732 003661 735 003675 736 003701 737 003702 739 003703 750 003705 752 003707 753 003710 754 003715 756 003726 758 003731 761 003744 763 003767 765 004006 767 004014 769 004015 774 004017 780 004046 782 004066 784 004070 786 004116 789 004143 791 004144 802 004146 804 004172 806 004174 809 004204 811 004210 812 004212 815 004245 816 004246 819 004264 822 004265 824 004273 829 004326 831 004327 843 004331 845 004355 847 004357 851 004401 854 004406 855 004412 859 004413 862 004420 863 004425 867 004426 868 004431 871 004436 873 004457 875 004460 882 004462 884 004475 886 004500 890 004542 893 004571 895 004572 902 004574 905 004606 907 004645 910 004647 914 004702 919 004706 920 004710 921 004714 925 004744 927 004770 928 004772 943 004773 960 004775 962 005002 965 005020 969 005042 972 005047 974 005051 976 005056 977 005065 978 005067 980 005074 983 005075 984 005076 987 005100 988 005104 989 005114 992 005125 995 005133 997 005147 999 005152 1005 005201 1008 005224 1010 005226 1014 005261 1017 005262 1019 005264 1022 005272 999 005311 1027 005312 1034 005326 1036 005351 1037 005360 1040 005366 1042 005401 1044 005404 1046 005420 1048 005423 1052 005435 1053 005445 1055 005470 1057 005511 1062 005526 1067 005535 1069 005551 1070 005562 1072 005564 1062 005607 1081 005610 1083 005625 1084 005636 1086 005641 1089 005652 1093 005674 1095 005703 1099 005720 1101 005721 1109 005723 1113 005742 1116 005752 1123 006002 1128 006004 1133 006021 1135 006044 1137 006067 1141 006106 1147 006141 1151 006204 1156 006227 1159 006251 1161 006253 1163 006254 1171 006256 1173 006276 1177 006302 1184 006304 1188 006327 1190 006331 1193 006335 1198 006337 1203 006356 1205 006401 1207 006424 1211 006443 1215 006472 1216 006476 1217 006501 1219 006502 1224 006504 1231 006535 1242 006537 1244 006554 1246 006557 1249 006565 1251 006605 1253 006607 1255 006614 1257 006635 1259 006636 1269 006640 1272 006646 1274 006662 1275 006666 1277 006667 1280 006676 1283 006731 1289 006732 1291 006745 1293 006750 1295 006760 1296 006767 1298 006777 1300 007001 1301 007003 1303 007004 1309 007034 1313 007044 1314 007061 1315 007072 1317 007075 1319 007123 1321 007141 1323 007142 1340 007144 1341 007147 1342 007153 1344 007162 1346 007172 1348 007175 1349 007203 1350 007205 1352 007206 1353 007207 1355 007211 1357 007220 1360 007222 1362 007236 1365 007241 1367 007243 1368 007251 1370 007252 1371 007260 1373 007265 1375 007266 1402 007267 1403 007273 1405 007274 1406 007276 1407 007300 1410 007307 1412 007313 1414 007315 1417 007317 1421 007331 1423 007347 1425 007360 1427 007363 1431 007427 1432 007430 1433 007433 1436 007440 1441 007474 1417 007502 1444 007503 1448 007510 1451 007527 1454 007546 1458 007550 1462 007557 1464 007561 1468 007565 1469 007573 1471 007601 1454 007603 1476 007604 1480 007644 1482 007645 1485 007647 1488 007653 1492 007664 1494 007701 1495 007712 1497 007715 1499 007724 1488 007732 1502 007733 1507 007773 1510 010002 1514 010003 1516 010011 1524 010040 1530 010050 1537 010115 1544 010150 1546 010161 1547 010165 1548 010172 1550 010200 1552 010201 1555 010203 1557 010204 1559 010205 1564 010207 1568 010252 1569 010254 1570 010263 1571 010266 1576 010267 1588 010271 1589 010272 1591 010275 1594 010306 1595 010322 1597 010323 1600 010334 1602 010352 1604 010354 1607 010357 1610 010362 1614 010417 1619 010444 1622 010454 1623 010460 1625 010461 1637 010463 1638 010465 1640 010507 1642 010511 1643 010515 1653 010522 1655 010533 1657 010536 1659 010545 1660 010550 1661 010562 1663 010565 1668 010577 1670 010600 1672 010601 1675 010611 1676 010614 1688 010707 1689 010715 1691 010716 1693 010721 1695 010722 1697 010724 1698 010730 1702 010745 1703 010751 1705 010752 1707 010756 1709 010757 1714 011015 1718 011041 1720 011042 1726 011044 1732 011076 1737 011100 1746 011112 1765 011114 1767 011117 1768 011120 1771 011121 1772 011132 1775 011153 1778 011160 1779 011163 1780 011170 1783 011215 1785 011223 1786 011225 1787 011227 1789 011230 1794 011264 1799 011311 1802 011313 1808 011373 1812 011405 1814 011407 1822 011424 1823 011427 1826 011451 1828 011453 1830 011473 1831 011475 1832 011476 1836 011477 1838 011506 1841 011512 1842 011523 1847 011544 1848 011546 1849 011550 1851 011552 1853 011554 1856 011602 1860 011614 1862 011622 1864 011625 1866 011626 1869 011642 1871 011643 1877 011645 1883 011673 1893 011675 1897 011751 1898 011752 1899 011761 1900 011770 1901 011773 1902 011777 1903 012002 1905 012006 1907 012021 1909 012022 1925 012024 1926 012025 1927 012030 1928 012035 1932 012061 1936 012123 1938 012125 1940 012127 1947 012146 1949 012150 1952 012203 1955 012205 1961 012237 1963 012241 1965 012242 1967 012244 1969 012255 1971 012260 1972 012262 1976 012263 1977 012266 1978 012267 1981 012321 1985 012322 1994 012324 1995 012333 1998 012360 1999 012362 2003 012363 2010 012365 2013 012405 2015 012423 2019 012424 2025 012426 2028 012444 2029 012447 2030 012452 2038 012453 2108 012455 2109 012465 2111 012474 2115 012535 2116 012537 2117 012546 2118 012553 2119 012561 2121 012565 2123 012601 2126 012604 2129 012615 2131 012622 2136 012645 2139 012650 2141 012654 2145 012702 2148 012706 2150 012710 2151 012712 2152 012716 2158 012735 2162 012756 2163 012765 2169 013015 2172 013017 2175 013033 2176 013036 2180 013037 2181 013045 2182 013050 2184 013054 2186 013056 2194 013057 2196 013066 2203 013131 2208 013174 2209 013176 2210 013206 2211 013212 2212 013215 2213 013223 2216 013227 2219 013250 2223 013253 2224 013260 2228 013275 2231 013304 2241 013330 2243 013333 2245 013346 2247 013354 2254 013405 2257 013407 2261 013425 2264 013430 2268 013441 2270 013444 2271 013446 2272 013451 2274 013452 2276 013454 2277 013456 2279 013503 2281 013517 2283 013520 2285 013522 2286 013524 2287 013530 2291 013531 2294 013537 2299 013560 2300 013562 2303 013565 2309 013573 2315 013656 2317 013664 2326 013765 2328 013767 2334 014022 2335 014032 2336 014036 2337 014040 2339 014047 2341 014053 2343 014054 2348 014056 2352 014101 2355 014125 2357 014126 2368 014137 2371 014150 2376 014176 2383 014262 2385 014270 2387 014303 2390 014310 2397 014313 2408 014315 2409 014325 2413 014357 2415 014365 2421 014463 2426 014501 2427 014505 2429 014512 2431 014513 2433 014517 2435 014536 2437 014542 2439 014543 2441 014553 2443 014555 2447 014556 2456 014560 2461 014571 2463 014605 2466 014611 2471 014635 2472 014640 2473 014642 2475 014643 2480 014650 2482 014661 2484 014666 2485 014670 2490 014676 2492 014701 2493 014706 2497 014710 2506 014755 2510 014773 2512 014775 2518 015011 2521 015015 2524 015021 2525 015023 2528 015025 2538 015035 2543 015037 2551 015040 2562 015042 2568 015053 2577 015056 2497 015146 2587 015147 2589 015162 2594 015226 2599 015232 2601 015246 2605 015264 2608 015276 2609 015310 2611 015322 2614 015324 2616 015325 2633 015350 2637 015354 2639 015361 2640 015363 2643 015370 2645 015401 2646 015403 2647 015407 2649 015427 2651 015430 2653 015433 2654 015434 2656 015435 2663 015447 2665 015452 2671 015454 2668 015456 2671 015477 2663 015510 2674 015511 2678 015514 2683 015532 2685 015533 2694 015535 2695 015537 2696 015541 2674 015564 2702 015565 2707 015567 2710 015606 2712 015610 2714 015631 2719 015635 2724 015637 2727 015656 2728 015660 2730 015661 2734 015703 2735 015706 2736 015710 2737 015721 2739 015722 2744 015736 2747 015750 2750 015753 2752 016002 2758 016003 2764 016005 2767 016023 2771 016040 2775 016056 2779 016074 2783 016111 2784 016115 2792 016116 2803 016120 2805 016135 2806 016147 2808 016171 2809 016173 2813 016174 2818 016205 2819 016214 2820 016215 2824 016216 2830 016220 2832 016230 2838 016240 2846 016251 2847 016264 2851 016311 2856 016313 2858 016346 2862 016352 2872 016363 2873 016366 2874 016370 2875 016373 2877 016413 2880 016417 2881 016420 2883 016423 2891 016444 2894 016451 2896 016454 2898 016455 2903 016461 2912 016472 2915 016527 2917 016533 ----------------------------------------------------------- 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