COMPILATION LISTING OF SEGMENT format_pl1_lex_ Compiled by: Multics PL/I Compiler, Release 33e, of October 6, 1992 Compiled at: CGI Compiled on: 2000-04-17_1935.40_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* 12* This is the lexical analysis program for the format_pl1 command. The 13* primary responsibilities of this program are: 14* 15* 1) Break the source program into tokens. 16* 2) Thread comments off the preceding token. 17* 3) Thread interstatement white space off the preceding token. 18* 4) Diagnose errors in the lexical syntax of programs. 19* 20* This program also performs several miscellaneous chores that assist 21* subsequent phases. They are: 22* 23* 1) Determine the type of arithmetic constants. 24* 25* Maintenance Instructions: 26* 27* To add another token type: 28* 29* 1) Add a token type declaration to format_pl1_dcls.incl.pl1. 30* 2) Adjust the token class limits in format_pl1_dcls.incl.pl1. 31* 3) If necessary, adjust tentative_token_type and action_table. 32* 33* To add another macro: 34* 35* 1) To add another macro statement, see in format_pl1_stmt_type_. 36* 2) To add another macro reference, i.e. a macro construct that gets 37* formatted like a PL/I reference such as %isarg, %isdef, and 38* %target, add an entry to the ignore_percent_token array. 39**/ 40 41 /* HISTORY: 42* Written by Paul Green, 11/05/77. 43* from "lex" in the PL/I compiler. 44* Modified: 45* 12/26/77 by Paul Green: Save comments and vertical white space as 46* token trailers. 47* 11/01/78 by Monte Davidoff: 48* 06/05/84 by R. Michael Tague: Make format_pl1 handle all % macro statements. 49* Changed %arg to %isarg, and added %isdef to ignore_percent_token. 50**/ 51 /* format: style5 */ 52 format_pl1_lex_: 53 procedure (P_temp_segs); 54 55 declare P_temp_segs (*) pointer; /* (Input) array of temporary segment pointers */ 56 57 /* automatic */ 58 59 declare action_index fixed binary; /* index of action to execute */ 60 declare current_char char (1) aligned; 61 /* character that stopped the scan, char we are checking */ 62 declare loop bit (1) aligned;/* loop control variable */ 63 declare scan_index fixed binary (21); 64 /* index (relative to source_index) of forward scan */ 65 declare source_index fixed binary (21); 66 /* index into current source segment */ 67 declare source_length fixed binary (21); 68 /* length (in characters) of current source segment */ 69 declare source_ptr pointer; /* pointer to base of source segment */ 70 declare string_length fixed binary (21); 71 /* number of characters in dequoted string */ 72 declare token_length fixed binary (21); 73 /* length of token in characters */ 74 declare token_start fixed binary (21); 75 /* index of first character of current token */ 76 declare token_type fixed binary (8); 77 /* type of current token */ 78 declare tokenx fixed binary; /* index into token */ 79 declare trailerx fixed binary; /* index into trailer */ 80 81 declare tentative_token_type (0:128) fixed binary (8) 82 initial ((9) invalid_char, 83 /* 000-010 ctl chars */ 84 no_token, /* 011 HT */ 85 (3) nl_vt_np_token, 86 /* 012-014 NL VT NP */ 87 (19) invalid_char, 88 /* 015-037 ctl chars */ 89 no_token, /* 040 SP */ 90 invalid_char, /* 041 ! */ 91 char_string, /* 042 " */ 92 (2) invalid_char, 93 /* 043-044 # $ */ 94 percent, /* 045 % */ 95 and, /* 046 & */ 96 invalid_char, /* 047 ' */ 97 left_parn, /* 050 ( */ 98 right_parn, /* 051 ) */ 99 asterisk, /* 052 * */ 100 plus, /* 053 + */ 101 comma, /* 054 , */ 102 minus, /* 055 - */ 103 period, /* 056 . */ 104 slash, /* 057 / */ 105 (10) dec_integer, 106 /* 060-071 0 - 9 */ 107 colon, /* 072 : */ 108 semi_colon, /* 073 ; */ 109 lt, /* 074 < */ 110 assignment, /* 075 = */ 111 gt, /* 076 > */ 112 (2) invalid_char, 113 /* 077-100 ? @ */ 114 (26) identifier,/* 101-132 A - Z */ 115 (3) invalid_char, 116 /* 133-135 [ \ ] */ 117 not, /* 136 ^ */ 118 (2) invalid_char, 119 /* 137-140 _ ` */ 120 (26) identifier,/* 141-172 a - z */ 121 invalid_char, /* 173 { */ 122 or, /* 174 | */ 123 (3) invalid_char, 124 /* 175-177 } ~ PAD */ 125 invalid_char); /* >177 non-ASCII */ 126 127 /* based */ 128 129 declare source_string char (source_length) based (source_ptr); 130 declare source_string_array (source_length) char (1) 131 based (source_ptr); 132 declare token_string char (token (tokenx).string_size) 133 based (token (tokenx).string_ptr); 134 135 /* builtin */ 136 137 declare (addr, binary, bit, char, divide, hbound, index, lbound, length, 138 min, null, rank, search, size, substr, unspec, verify) 139 builtin; 140 141 /* internal static */ 142 143 declare action_table (0:128) fixed binary internal 144 static options (constant) 145 initial ((9) 10,/* 000-010 ctl chars */ 146 1, /* 011 HT */ 147 (3) 9, /* 012-014 NL VT NP */ 148 (19) 10, /* 015-037 ctl chars */ 149 1, /* 040 SP */ 150 10, /* 041 ! */ 151 2, /* 042 " */ 152 10, /* 043 # */ 153 10, /* 044 $ */ 154 4, /* 045 % */ 155 5, /* 046 & */ 156 10, /* 047 ' */ 157 (2) 5, /* 050-051 ( ) */ 158 11, /* 052 * */ 159 (2) 5, /* 053-054 + , */ 160 12, /* 055 - */ 161 7, /* 056 . */ 162 6, /* 057 / */ 163 (10) 8, /* 060-071 0 - 9 */ 164 (2) 5, /* 072-073 : ; */ 165 13, /* 074 < */ 166 5, /* 075 = */ 167 14, /* 076 > */ 168 (2) 10, /* 077-100 ? @ */ 169 (26) 3, /* 101-132 A - Z */ 170 (3) 10, /* 133-135 [ \ ] */ 171 15, /* 136 ^ */ 172 (2) 10, /* 137-140 _ ` */ 173 (26) 3, /* 141-172 a - z */ 174 10, /* 173 { */ 175 16, /* 174 | */ 176 (3) 10, /* 175-177 } ~ PAD */ 177 10); /* >177 non-ASCII */ 178 179 declare bit_string_characters char (23) internal static 180 options (constant) 181 initial ("""0123456789ABCDEFabcdef"); 182 declare digits char (10) internal static 183 options (constant) 184 initial ("0123456789"); 185 declare identifier_characters char (64) internal static 186 options (constant) 187 initial ( 188 "$0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ_abcdefghijklmnopqrstuvwxyz" 189 ); 190 declare ignore_percent_token (3) char (8) internal static 191 options (constant) 192 initial ("%isarg", "%isdef", "%target"); 193 declare HT_SP char (2) internal static 194 options (constant) initial (" "); 195 declare NL_VT_NP char (3) internal static 196 options (constant) initial (" 197 "); 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 */ 198 199 200 /* program */ 201 202 temp_segs (*) = P_temp_segs (*); 203 global.n_tokens = 0; 204 global.n_trailers = 0; 205 206 source_ptr = global.source_ptr; 207 source_length = global.source_length; 208 source_index = 1; 209 210 unspec (token (1)) = ""b; /* build dummy first token */ 211 token (1).type = no_token; 212 token (1).string_ptr = null; 213 tokenx = 1; 214 trailerx = 0; 215 216 action (1): /* Scan horizontal white space */ 217 scan_index = verify (substr (source_string, source_index), HT_SP); 218 if scan_index = 0 then 219 goto end_of_source_reached_but_no_pending_token; 220 221 source_index = source_index + scan_index; 222 current_char = substr (source_string, source_index - 1, 1); 223 224 token_start = source_index - 1; 225 token_type = 226 tentative_token_type ( 227 min (rank (current_char), hbound (tentative_token_type, 1))); 228 229 action_index = 230 action_table (min (rank (current_char), hbound (action_table, 1))); 231 goto action (action_index); 232 233 action (2): /* Scan string: current_char = '"' */ 234 string_length = 0; /* count of number of characters in reduced string */ 235 236 loop = "1"b; 237 do while (loop); 238 scan_index = 239 index (substr (source_string, source_index), """") - 1; 240 if scan_index < 0 then 241 do; 242 call error (3, 243 "Missing double quote after string constant.", 244 token_start); 245 246 source_index = source_length + 1; 247 string_length = 248 string_length + (source_length - token_start + 1); 249 goto end_of_source_reached; 250 end; 251 252 source_index = source_index + scan_index + 1; 253 string_length = string_length + scan_index; 254 255 if source_index > source_length /* not an error */ 256 then 257 goto end_of_source_reached; 258 259 loop = substr (source_string, source_index, 1) = """"; 260 if loop then 261 do; 262 source_index = source_index + 1; 263 string_length = string_length + 1; 264 end; 265 end; 266 267 if substr (source_string, source_index, 1) = "b" then 268 do; 269 token_type = bit_string; 270 source_index = source_index + 1; 271 272 if source_index <= source_length then 273 if index ("1234", 274 substr (source_string, source_index, 1)) > 0 then 275 source_index = source_index + 1; 276 277 if string_length > max_bit_string_constant then 278 call error (2, "Bit-string constant too long.", 279 token_start); 280 281 if verify ( 282 substr (source_string, token_start, 283 source_index - token_start), bit_string_characters) ^= 0 284 then 285 call error (2, 286 "Invalid characters in bit-string constant.", 287 token_start); 288 end; 289 290 else 291 do; 292 if string_length > max_char_string_constant then 293 call error (2, "Character-string constant too long.", 294 token_start); 295 296 if global.ca.check_strings 297 & ( 298 search ( 299 substr (source_string, token_start, 300 source_index - token_start), NL_VT_NP) > 0 301 | 302 index ( 303 substr (source_string, token_start, 304 source_index - token_start), "/*") > 0 305 | 306 index ( 307 substr (source_string, token_start, 308 source_index - token_start), "*/") > 0) then 309 call error (1, 310 "Character-string constant contains ""/*"", ""*/"", or vertical white space." 311 , token_start); 312 end; 313 314 call make_token; 315 goto check_syntax_after_constant; 316 317 action (3): /* Scan identifiers */ 318 call scan_past_identifier_characters; 319 call make_token; 320 321 /* Now make sure the syntax after the identifier is correct. */ 322 323 if substr (source_string, source_index, 1) = """" 324 & token_string ^= "p" & token_string ^= "pic" 325 & token_string ^= "picture" then 326 call error (2, "Double quote after identifier.", source_index); 327 328 goto action (1); 329 330 action (4): /* % */ 331 if source_index > source_length then 332 goto end_of_source_reached; 333 334 current_char = substr (source_string, source_index, 1); 335 action_index = 336 action_table (min (rank (current_char), hbound (action_table, 1))); 337 338 if action_index ^= 3 /* identifier */ 339 then 340 do; 341 call make_token; 342 goto action (1); 343 end; 344 345 source_index = source_index + 1; 346 call scan_past_identifier_characters; 347 348 do action_index = lbound (ignore_percent_token, 1) 349 to hbound (ignore_percent_token, 1) 350 while (ignore_percent_token (action_index) 351 ^= substr (source_string, token_start, source_index - token_start)); 352 end; 353 354 if action_index <= hbound (ignore_percent_token, 1) then 355 token_type = identifier; 356 357 call make_token; 358 359 /* Now make sure the syntax after the % is correct. */ 360 361 if substr (source_string, source_index, 1) = """" then 362 call error (2, "Double quote after %identifier.", source_index); 363 364 goto action (1); 365 366 action (5): /* Single character tokens */ 367 call make_token; 368 goto action (1); 369 370 action (6): /* Separate / and /* */ 371 if source_index > source_length then 372 goto end_of_source_reached; 373 374 if substr (source_string, source_index, 1) ^= "*" then 375 do; 376 call make_token; 377 goto action (1); 378 end; 379 380 token_type = comment_token; 381 source_index = source_index + 1; 382 383 scan_index = index (substr (source_string, source_index), "*/") - 1; 384 if scan_index < 0 then 385 do; 386 call error (3, "Missing ""*/"" at end of comment.", token_start) 387 ; 388 389 source_index = source_length + 1; 390 call make_trailer; 391 goto end_of_source_reached_but_no_pending_token; 392 end; 393 394 source_index = source_index + scan_index + length ("*/"); 395 396 if index ( 397 substr (source_string, token_start + length ("/*"), 398 source_index - token_start - length ("/*") - length ("*/")), "/*") 399 > 0 & global.ca.check_comments then 400 call error (1, "Comment contains ""/*"".", token_start); 401 402 call make_trailer; 403 goto action (1); 404 405 action (7): /* Separate . and numbers: current_char = "." */ 406 if source_index > source_length then 407 goto end_of_source_reached; 408 409 if index (digits, substr (source_string, source_index, 1)) = 0 then 410 do; 411 call make_token; 412 goto action (1); 413 end; 414 415 token_type = fixed_dec; 416 call scan_past_digits; 417 goto scan_exponent; 418 419 action (8): /* Scan numbers and isubs: current char = */ 420 if source_index > source_length then 421 goto end_of_source_reached; 422 423 call scan_past_digits; 424 425 if substr (source_string, source_index, 1) = "." then 426 do; 427 token_type = fixed_dec; 428 source_index = source_index + 1; 429 call scan_past_digits; 430 end; 431 432 else if source_index + 2 <= source_length then 433 if substr (source_string, source_index, 3) = "sub" then 434 do; 435 source_index = source_index + 3; 436 token_type = isub; 437 call make_token; 438 goto check_syntax_after_constant; 439 end; 440 441 scan_exponent: 442 token_length = source_index - token_start; /* remember length of mantissa for later error check */ 443 444 if substr (source_string, source_index, 1) = "e" 445 | substr (source_string, source_index, 1) = "f" then 446 do; 447 if substr (source_string, source_index, 1) = "e" then 448 token_type = 449 bit_to_arithmetic (arithmetic_to_bit (token_type) 450 | is_float_constant); 451 452 token_type = 453 bit_to_arithmetic (arithmetic_to_bit (token_type) 454 & ^is_integral_constant); 455 source_index = source_index + 1; 456 457 if source_index > source_length then 458 do; 459 call error (3, 460 "Missing exponent in arithmetic constant.", 461 token_start); 462 goto end_of_source_reached; 463 end; 464 465 if substr (source_string, source_index, 1) = "+" 466 | substr (source_string, source_index, 1) = "-" then 467 do; 468 source_index = source_index + 1; 469 470 if source_index > source_length then 471 do; 472 call error (3, 473 "Missing exponent in arithmetic constant.", 474 token_start); 475 goto end_of_source_reached; 476 end; 477 end; 478 479 call scan_past_digits; 480 end; 481 482 if substr (source_string, source_index, 1) = "b"/* binary constant */ 483 then 484 do; 485 token_type = 486 bit_to_arithmetic (arithmetic_to_bit (token_type) 487 & ^is_decimal_constant); 488 source_index = source_index + 1; 489 490 if verify (substr (source_string, token_start, token_length), 491 ".01") > 0 then 492 call error (2, "Non-binary digit in binary constant.", 493 token_start); 494 end; 495 496 if source_index <= source_length then 497 if substr (source_string, source_index, 1) = "p" then 498 do; /* default suppression indicator */ 499 token_type = 500 bit_to_arithmetic (arithmetic_to_bit (token_type) 501 & ^is_integral_constant); 502 source_index = source_index + 1; 503 end; 504 505 if source_index <= source_length then 506 if substr (source_string, source_index, 1) = "i" then 507 do; /* imaginary constant */ 508 token_type = 509 bit_to_arithmetic (arithmetic_to_bit (token_type) 510 | is_imaginary_constant); 511 source_index = source_index + 1; 512 end; 513 514 call make_token; 515 516 /* Now make sure the syntax after the constant is correct. */ 517 518 check_syntax_after_constant: 519 if source_index > source_length then 520 goto end_of_source_reached; 521 522 current_char = substr (source_string, source_index, 1); 523 action_index = 524 action_table (min (rank (current_char), hbound (action_table, 1))); 525 526 if action_index = 2 | action_index = 3 | action_index = 8 527 /* double quote, identifier, or arithmetic constant */ 528 then 529 call error (2, "Invalid syntax after constant or isub.", 530 source_index); 531 532 goto action (1); 533 534 action (9): /* Scan NL VT NP */ 535 scan_index = 536 verify (substr (source_string, source_index), NL_VT_NP) - 1; 537 if scan_index < 0 then 538 source_index = source_length + 1; 539 else 540 source_index = source_index + scan_index; 541 542 call make_trailer; 543 goto action (1); 544 545 action (10): /* Invalid characters */ 546 if rank (current_char) < 32 | 128 <= rank (current_char) then 547 call error (2, 548 "Invalid character. """ 549 || char (bit (rank (current_char))) || """b", 550 source_index - 1); 551 552 else if current_char = "_" | current_char = "$" then 553 call error (2, 554 """" || current_char || """ may not start an identifier.", 555 source_index - 1); 556 557 else 558 call error (2, "Invalid character. """ || current_char || """", 559 source_index - 1); 560 561 call make_token; 562 goto action (1); 563 564 action (11): /* Separate * and ** */ 565 if source_index > source_length then 566 goto end_of_source_reached; 567 568 if substr (source_string, source_index, 1) = "*" then 569 do; 570 source_index = source_index + 1; 571 token_type = expon; 572 end; 573 574 call make_token; 575 goto action (1); 576 577 action (12): /* Separate - and -> */ 578 if source_index > source_length then 579 goto end_of_source_reached; 580 581 if substr (source_string, source_index, 1) = ">" then 582 do; 583 source_index = source_index + 1; 584 token_type = arrow; 585 end; 586 587 call make_token; 588 goto action (1); 589 590 action (13): /* Separate < and <= */ 591 if source_index > source_length then 592 goto end_of_source_reached; 593 594 if substr (source_string, source_index, 1) = "=" then 595 do; 596 source_index = source_index + 1; 597 token_type = le; 598 end; 599 600 call make_token; 601 goto action (1); 602 603 action (14): /* Separate > and >= */ 604 if source_index > source_length then 605 goto end_of_source_reached; 606 607 if substr (source_string, source_index, 1) = "=" then 608 do; 609 source_index = source_index + 1; 610 token_type = ge; 611 end; 612 613 call make_token; 614 goto action (1); 615 616 action (15): /* Separate ^ and ^= and ^< and ^> */ 617 if source_index > source_length then 618 goto end_of_source_reached; 619 620 if substr (source_string, source_index, 1) = "=" then 621 do; 622 source_index = source_index + 1; 623 token_type = ne; 624 end; 625 626 else if substr (source_string, source_index, 1) = "<" then 627 do; 628 source_index = source_index + 1; 629 token_type = nlt; 630 end; 631 632 else if substr (source_string, source_index, 1) = ">" then 633 do; 634 source_index = source_index + 1; 635 token_type = ngt; 636 end; 637 638 call make_token; 639 goto action (1); 640 641 action (16): /* Separate | and || */ 642 if source_index > source_length then 643 goto end_of_source_reached; 644 645 if substr (source_string, source_index, 1) = "|" then 646 do; 647 source_index = source_index + 1; 648 token_type = cat; 649 end; 650 651 call make_token; 652 goto action (1); 653 654 /* Control transfers here whenever the lex reaches the end of the current source segment. */ 655 656 end_of_source_reached: 657 call make_token; 658 659 end_of_source_reached_but_no_pending_token: 660 if tokenx >= hbound (token, 1) then 661 call error (4, "Too many tokens.", source_length); 662 663 unspec (token (tokenx + 1)) = ""b; /* build dummy last token */ 664 token (tokenx + 1).type = no_token; 665 666 /* Set string_ptr so error messages will indicate the end of the program. */ 667 668 if source_length = 0 then 669 token (tokenx + 1).string_ptr = null; 670 else 671 token (tokenx + 1).string_ptr = 672 addr (source_string_array (source_length)); 673 674 unrecoverable_error: 675 global.n_tokens = tokenx; 676 global.n_trailers = trailerx; 677 678 return; 679 680 /* Make a Token. 681* 682* Convention: 683* token_type set to the correct type 684* token_start set to index of first character of token 685* source_index set to index of first character after token 686**/ 687 make_token: 688 procedure; 689 690 token_length = source_index - token_start; 691 692 if token_type = identifier & token_length > max_identifier_length then 693 call error (2, "Identifier too long.", token_start); 694 695 if tokenx >= hbound (token, 1) then 696 call error (4, "Too many tokens.", token_start); 697 698 tokenx = tokenx + 1; 699 unspec (token (tokenx)) = ""b; 700 token (tokenx).type = token_type; 701 token (tokenx).string_size = token_length; 702 token (tokenx).string_ptr = addr (source_string_array (token_start)); 703 end make_token; 704 705 /* Make a token trailer and thread it off of the previous token. 706* 707* Convention: 708* token_start set to index of first char of trailer 709* token_type set to trailer type 710* source_index set to first char past trailer 711**/ 712 make_trailer: 713 procedure; 714 715 if trailerx >= hbound (trailer, 1) then 716 call error (4, "Too many trailers.", token_start); 717 718 trailerx = trailerx + 1; 719 unspec (trailer (trailerx)) = ""b; 720 trailer (trailerx).type = token_type; 721 trailer (trailerx).string_size = source_index - token_start; 722 trailer (trailerx).string_ptr = 723 addr (source_string_array (token_start)); 724 725 if token (tokenx).trailer_index = 0 then 726 token (tokenx).trailer_index = trailerx; 727 else 728 trailer (trailerx - 1).continued = "1"b; 729 end make_trailer; 730 731 /* Convert an arithmetic token type to it's bit string encoding. */ 732 733 arithmetic_to_bit: 734 procedure (type) returns (bit (4) aligned); 735 736 declare type fixed binary (8); 737 /* (Input) arithmetic token type */ 738 739 return (bit (binary (type - min_arithmetic_token, 4), 4)); 740 end arithmetic_to_bit; 741 742 /* Convert the bit string encoding of an arithmetic token type to it's token type. */ 743 744 bit_to_arithmetic: 745 procedure (bit_encoding) returns (fixed binary (8)); 746 747 declare bit_encoding bit (4) aligned;/* (Input) arithmetic token type bit string encoding */ 748 749 return (binary (bit_encoding, 4) + min_arithmetic_token); 750 end bit_to_arithmetic; 751 752 /* Scan sequences of identifier characters. 753* 754* Convention: 755* source_index Entry: on character after identifier character 756* Exit: on stopping break 757**/ 758 scan_past_identifier_characters: 759 procedure; 760 761 scan_index = 762 verify (substr (source_string, source_index), identifier_characters) 763 - 1; 764 if scan_index < 0 then 765 do; 766 source_index = source_length + 1; 767 goto end_of_source_reached; 768 end; 769 770 source_index = source_index + scan_index; 771 end scan_past_identifier_characters; 772 773 /* Scan sequences of . 774* 775* Convention: 776* source_index Entry: on character after digit 777* Exit: on stopping break 778**/ 779 scan_past_digits: 780 procedure; 781 782 scan_index = verify (substr (source_string, source_index), digits) - 1; 783 if scan_index < 0 then 784 do; 785 source_index = source_length + 1; 786 goto end_of_source_reached; 787 end; 788 789 source_index = source_index + scan_index; 790 end scan_past_digits; 791 792 /* Print an error message. */ 793 794 error: 795 procedure (severity, error_string, error_index); 796 797 declare severity fixed binary (35); 798 /* (Input) severity of error */ 799 declare error_string char (*); /* (Input) error message */ 800 declare error_index fixed binary (21); 801 /* (Input) index into source where error occured */ 802 803 call format_pl1_error_ (temp_segs (*), severity, error_string, 804 addr (source_string_array (error_index))); 805 806 if severity >= 4 then 807 goto unrecoverable_error; 808 end error; 809 810 end format_pl1_lex_; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 04/17/00 1935.4 format_pl1_lex_.pl1 >udd>sm>ds>w>ml>format_pl1_lex_.pl1 198 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. HT_SP constant char(2) initial packed unaligned dcl 193 ref 216 NL_VT_NP 000020 constant char(3) initial packed unaligned dcl 195 ref 296 534 P_temp_segs parameter pointer array dcl 55 ref 52 202 action_index 000100 automatic fixed bin(17,0) dcl 59 set ref 229* 231 335* 338 348* 348* 354 523* 526 526 526 action_table 000060 constant fixed bin(17,0) initial array dcl 143 ref 229 229 335 335 523 523 addr builtin function dcl 137 ref 670 702 722 803 803 and constant fixed bin(8,0) initial dcl 1-94 ref 81 arrow constant fixed bin(8,0) initial dcl 1-94 ref 584 assignment constant fixed bin(8,0) initial dcl 1-94 ref 81 asterisk constant fixed bin(8,0) initial dcl 1-94 ref 81 binary builtin function dcl 137 ref 739 749 bit builtin function dcl 137 ref 545 739 bit_encoding parameter bit(4) dcl 747 ref 744 749 bit_string constant fixed bin(8,0) initial dcl 1-94 ref 269 bit_string_characters 000052 constant char(23) initial packed unaligned dcl 179 ref 281 ca 13 based structure level 3 packed packed unaligned dcl 1-73 cat constant fixed bin(8,0) initial dcl 1-94 ref 648 char builtin function dcl 137 ref 545 char_string constant fixed bin(8,0) initial dcl 1-94 ref 81 check_comments 13 based bit(1) level 4 packed packed unaligned dcl 1-73 ref 396 check_strings 13(01) based bit(1) level 4 packed packed unaligned dcl 1-73 ref 296 colon constant fixed bin(8,0) initial dcl 1-94 ref 81 comma constant fixed bin(8,0) initial dcl 1-94 ref 81 comment_token constant fixed bin(8,0) initial dcl 1-94 ref 380 continued 0(22) based bit(1) array level 2 packed packed unaligned dcl 1-37 set ref 727* current_char 000101 automatic char(1) dcl 60 set ref 222* 225 229 334* 335 522* 523 545 545 545 552 552 552 557 dec_integer constant fixed bin(8,0) initial dcl 1-94 ref 81 digits 000047 constant char(10) initial packed unaligned dcl 182 ref 409 782 divide builtin function dcl 137 ref 659 695 715 error_index parameter fixed bin(21,0) dcl 800 ref 794 803 803 error_string parameter char packed unaligned dcl 799 set ref 794 803* expon constant fixed bin(8,0) initial dcl 1-94 ref 571 fixed_dec constant fixed bin(8,0) initial dcl 1-94 ref 415 427 format_pl1_error_ 000012 constant entry external dcl 1-439 ref 803 ge constant fixed bin(8,0) initial dcl 1-94 ref 610 global based structure level 1 dcl 1-73 global_header based structure level 1 dcl 1-47 gt constant fixed bin(8,0) initial dcl 1-94 ref 81 hbound builtin function dcl 137 ref 225 229 335 348 354 523 659 695 715 header based structure level 2 dcl 1-73 identifier constant fixed bin(8,0) initial dcl 1-94 ref 81 81 354 692 identifier_characters 000027 constant char(64) initial packed unaligned dcl 185 ref 761 ignore_percent_token 000021 constant char(8) initial array packed unaligned dcl 190 ref 348 348 348 354 index builtin function dcl 137 ref 238 272 296 296 383 396 409 invalid_char constant fixed bin(8,0) initial dcl 1-94 ref 81 81 81 81 81 81 81 81 81 81 81 81 81 81 81 81 81 81 is_decimal_constant constant bit(4) initial dcl 1-166 ref 485 is_float_constant constant bit(4) initial dcl 1-166 ref 447 is_imaginary_constant constant bit(4) initial dcl 1-166 ref 508 is_integral_constant constant bit(4) initial dcl 1-166 ref 452 499 isub constant fixed bin(8,0) initial dcl 1-94 ref 436 lbound builtin function dcl 137 ref 348 le constant fixed bin(8,0) initial dcl 1-94 ref 597 left_parn constant fixed bin(8,0) initial dcl 1-94 ref 81 length builtin function dcl 137 ref 394 396 396 396 loop 000102 automatic bit(1) dcl 62 set ref 236* 237 259* 260 lt constant fixed bin(8,0) initial dcl 1-94 ref 81 max_bit_string_constant constant fixed bin(17,0) initial dcl 1-176 ref 277 max_char_string_constant constant fixed bin(17,0) initial dcl 1-176 ref 292 max_identifier_length constant fixed bin(17,0) initial dcl 1-176 ref 692 min builtin function dcl 137 ref 225 229 335 523 min_arithmetic_token constant fixed bin(8,0) initial dcl 1-154 ref 739 749 minus constant fixed bin(8,0) initial dcl 1-94 ref 81 n_tokens 3 based fixed bin(17,0) level 3 dcl 1-73 set ref 203* 674* n_trailers 4 based fixed bin(17,0) level 3 dcl 1-73 set ref 204* 676* ne constant fixed bin(8,0) initial dcl 1-94 ref 623 ngt constant fixed bin(8,0) initial dcl 1-94 ref 635 nl_vt_np_token constant fixed bin(8,0) initial dcl 1-94 ref 81 81 81 nlt constant fixed bin(8,0) initial dcl 1-94 ref 629 no_token constant fixed bin(8,0) initial dcl 1-94 ref 81 81 211 664 not constant fixed bin(8,0) initial dcl 1-94 ref 81 null builtin function dcl 137 ref 212 668 or constant fixed bin(8,0) initial dcl 1-94 ref 81 percent constant fixed bin(8,0) initial dcl 1-94 ref 81 period constant fixed bin(8,0) initial dcl 1-94 ref 81 plus constant fixed bin(8,0) initial dcl 1-94 ref 81 rank builtin function dcl 137 ref 225 229 335 523 545 545 545 right_parn constant fixed bin(8,0) initial dcl 1-94 ref 81 scan_index 000103 automatic fixed bin(21,0) dcl 63 set ref 216* 218 221 238* 240 252 253 383* 384 394 534* 537 539 761* 764 770 782* 783 789 search builtin function dcl 137 ref 296 semi_colon constant fixed bin(8,0) initial dcl 1-94 ref 81 severity parameter fixed bin(35,0) dcl 797 set ref 794 803* 806 slash constant fixed bin(8,0) initial dcl 1-94 ref 81 source_index 000104 automatic fixed bin(21,0) dcl 65 set ref 208* 216 221* 221 222 224 238 246* 252* 252 255 259 262* 262 267 270* 270 272 272 272* 272 281 296 296 296 323 323* 330 334 345* 345 348 361 361* 370 374 381* 381 383 389* 394* 394 396 405 409 419 425 428* 428 432 432 435* 435 441 444 444 447 455* 455 457 465 465 468* 468 470 482 488* 488 496 496 502* 502 505 505 511* 511 518 522 526* 534 537* 539* 539 545 552 557 564 568 570* 570 577 581 583* 583 590 594 596* 596 603 607 609* 609 616 620 622* 622 626 628* 628 632 634* 634 641 645 647* 647 690 721 761 766* 770* 770 782 785* 789* 789 source_length 2 based fixed bin(21,0) level 3 in structure "global" dcl 1-73 in procedure "format_pl1_lex_" ref 207 source_length 000105 automatic fixed bin(21,0) dcl 67 in procedure "format_pl1_lex_" set ref 207* 216 222 238 246 247 255 259 267 272 272 281 296 296 296 323 330 334 348 361 370 374 383 389 396 405 409 419 425 432 432 444 444 447 457 465 465 470 482 490 496 496 505 505 518 522 534 537 564 568 577 581 590 594 603 607 616 620 626 632 641 645 659* 668 670 761 766 782 785 source_ptr 000106 automatic pointer dcl 69 in procedure "format_pl1_lex_" set ref 206* 216 222 238 259 267 272 281 296 296 296 323 334 348 361 374 383 396 409 425 432 444 444 447 465 465 482 490 496 505 522 534 568 581 594 607 620 626 632 645 670 702 722 761 782 803 803 source_ptr based pointer level 3 in structure "global" dcl 1-73 in procedure "format_pl1_lex_" ref 206 source_string based char packed unaligned dcl 129 ref 216 222 238 259 267 272 281 296 296 296 323 334 348 361 374 383 396 409 425 432 444 444 447 465 465 482 490 496 505 522 534 568 581 594 607 620 626 632 645 761 782 source_string_array based char(1) array packed unaligned dcl 130 set ref 670 702 722 803 803 string_length 000110 automatic fixed bin(21,0) dcl 70 set ref 233* 247* 247 253* 253 263* 263 277 292 string_ptr 1 based pointer array level 2 in structure "trailer" packed packed unaligned dcl 1-37 in procedure "format_pl1_lex_" set ref 722* string_ptr 1 based pointer array level 2 in structure "token" packed packed unaligned dcl 1-29 in procedure "format_pl1_lex_" set ref 212* 323 323 323 668* 670* 702* string_size based fixed bin(21,0) array level 2 in structure "trailer" packed packed unaligned dcl 1-37 in procedure "format_pl1_lex_" set ref 721* string_size based fixed bin(21,0) array level 2 in structure "token" packed packed unaligned dcl 1-29 in procedure "format_pl1_lex_" set ref 323 323 323 701* style based structure level 1 dcl 1-273 substr builtin function dcl 137 ref 216 222 238 259 267 272 281 296 296 296 323 334 348 361 374 383 396 409 425 432 444 444 447 465 465 482 490 496 505 522 534 568 581 594 607 620 626 632 645 761 782 sys_info$max_seg_size 000010 external static fixed bin(19,0) dcl 1-426 ref 659 695 715 temp_segs 000320 automatic pointer array dcl 1-23 set ref 202* 203 204 206 207 210 211 212 296 323 323 323 323 323 323 396 659 663 664 668 670 674 676 695 699 700 701 702 715 719 720 721 722 725 725 727 803* tentative_token_type 000116 automatic fixed bin(8,0) initial array dcl 81 set ref 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 81* 225 225 token based structure array level 1 dcl 1-29 set ref 210* 659 663* 695 699* token_length 000111 automatic fixed bin(21,0) dcl 72 set ref 441* 490 690* 692 701 token_start 000112 automatic fixed bin(21,0) dcl 74 set ref 224* 242* 247 277* 281 281 281* 292* 296 296 296 296 296 296 296* 348 348 386* 396 396 396* 441 459* 472* 490 490* 690 692* 695* 702 715* 721 722 token_string based char packed unaligned dcl 132 ref 323 323 323 token_type 000113 automatic fixed bin(8,0) dcl 76 set ref 225* 269* 354* 380* 415* 427* 436* 447* 447* 452* 452* 485* 485* 499* 499* 508* 508* 571* 584* 597* 610* 623* 629* 635* 648* 692 700 720 tokenx 000114 automatic fixed bin(17,0) dcl 78 set ref 213* 323 323 323 323 323 323 659 663 664 668 670 674 695 698* 698 699 700 701 702 725 725 trailer based structure array level 1 dcl 1-37 set ref 715 719* trailer_index 2 based fixed bin(17,0) array level 2 dcl 1-29 set ref 725 725* trailerx 000115 automatic fixed bin(17,0) dcl 79 set ref 214* 676 715 718* 718 719 720 721 722 725 727 type 0(27) based fixed bin(8,0) array level 2 in structure "trailer" packed packed unaligned dcl 1-37 in procedure "format_pl1_lex_" set ref 720* type 0(27) based fixed bin(8,0) array level 2 in structure "token" packed packed unaligned dcl 1-29 in procedure "format_pl1_lex_" set ref 211* 664* 700* type parameter fixed bin(8,0) dcl 736 in procedure "arithmetic_to_bit" ref 733 739 unspec builtin function dcl 137 set ref 210* 663* 699* 719* verify builtin function dcl 137 ref 216 281 490 534 761 782 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. allocate_statement internal static fixed bin(8,0) initial dcl 1-185 assignment_statement internal static fixed bin(8,0) initial dcl 1-185 begin_statement internal static fixed bin(8,0) initial dcl 1-185 bin_integer internal static fixed bin(8,0) initial dcl 1-94 call_statement internal static fixed bin(8,0) initial dcl 1-185 case_control_comment internal static char(10) initial packed unaligned dcl 1-410 close_statement internal static fixed bin(8,0) initial dcl 1-185 command internal static char(10) initial packed unaligned dcl 1-89 comment_indicator_extra_chars internal static char(3) initial packed unaligned dcl 1-417 comment_indicator_no_indcomtxt internal static char(1) initial packed unaligned dcl 1-420 condition_prefix_list internal static fixed bin(8,0) initial dcl 1-185 control_comment_indicator internal static char(7) initial packed unaligned dcl 1-395 declare_statement internal static fixed bin(8,0) initial dcl 1-185 default_statement internal static fixed bin(8,0) initial dcl 1-185 delete_statement internal static fixed bin(8,0) initial dcl 1-185 display_statement internal static fixed bin(8,0) initial dcl 1-185 do_statement internal static fixed bin(8,0) initial dcl 1-185 else_clause internal static fixed bin(8,0) initial dcl 1-185 end_statement internal static fixed bin(8,0) initial dcl 1-185 entry_statement internal static fixed bin(8,0) initial dcl 1-185 eq internal static fixed bin(8,0) initial dcl 1-94 exit_statement internal static fixed bin(8,0) initial dcl 1-185 fixed_bin 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_long_ 000000 constant entry external dcl 1-438 format_pl1_modes_ 000000 constant entry external dcl 1-433 format_pl1_record_style_ 000000 constant entry external dcl 1-435 format_pl1_stmt_type_ 000000 constant entry external dcl 1-431 format_statement internal static fixed bin(8,0) initial dcl 1-185 free_statement internal static fixed bin(8,0) initial dcl 1-185 get_statement internal static fixed bin(8,0) initial dcl 1-185 goto_statement internal static fixed bin(8,0) initial dcl 1-185 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 if_statement internal static fixed bin(8,0) initial dcl 1-185 is_independent_statement internal static bit(1) initial array dcl 1-247 is_macro_statement internal static bit(1) initial array dcl 1-254 is_macro_whitespace internal static bit(1) initial array dcl 1-258 keyword_token internal static fixed bin(8,0) initial dcl 1-94 label_prefix_list internal static fixed bin(8,0) initial dcl 1-185 locate_statement internal static fixed bin(8,0) initial dcl 1-185 lock_statement internal static fixed bin(8,0) initial dcl 1-185 max_arithmetic_token internal static fixed bin(8,0) initial dcl 1-154 max_constant_token internal static fixed bin(8,0) initial dcl 1-154 max_delimiter_token internal static fixed bin(8,0) initial dcl 1-154 min_constant_token internal static fixed bin(8,0) initial dcl 1-154 min_delimiter_token internal static fixed bin(8,0) initial dcl 1-154 mode_case defined bit(1) packed unaligned dcl 1-280 mode_comcol defined fixed bin(17,0) dcl 1-309 mode_dclind defined fixed bin(17,0) dcl 1-309 mode_declareind defined fixed bin(17,0) dcl 1-309 mode_delnl defined bit(1) packed unaligned dcl 1-280 mode_elsestmt defined bit(1) packed unaligned dcl 1-280 mode_equalind defined fixed bin(17,0) dcl 1-309 mode_idind defined fixed bin(17,0) dcl 1-309 mode_ifthen defined bit(1) packed unaligned dcl 1-280 mode_ifthendo defined bit(1) packed unaligned dcl 1-280 mode_ifthenstmt defined bit(1) packed unaligned dcl 1-280 mode_ind defined fixed bin(17,0) dcl 1-309 mode_indattr defined bit(1) packed unaligned dcl 1-280 mode_indbegin defined bit(1) packed unaligned dcl 1-280 mode_indbeginend defined bit(1) packed unaligned dcl 1-280 mode_indblkcom defined bit(1) packed unaligned dcl 1-280 mode_indcom defined bit(1) packed unaligned dcl 1-280 mode_indcomtxt defined bit(1) packed unaligned dcl 1-280 mode_inddcls defined bit(1) packed unaligned dcl 1-280 mode_indend defined bit(1) packed unaligned dcl 1-280 mode_inditerdo defined bit(1) packed unaligned dcl 1-280 mode_indnoniterdo defined bit(1) packed unaligned dcl 1-280 mode_indnoniterend defined bit(1) packed unaligned dcl 1-280 mode_indproc defined bit(1) packed unaligned dcl 1-280 mode_indprocbody defined bit(1) packed unaligned dcl 1-280 mode_indthenbegin defined bit(1) packed unaligned dcl 1-280 mode_indthenbeginend defined bit(1) packed unaligned dcl 1-280 mode_indthenelse defined bit(1) packed unaligned dcl 1-280 mode_initcol defined fixed bin(17,0) dcl 1-309 mode_insnl defined bit(1) packed unaligned dcl 1-280 mode_linecom defined bit(1) packed unaligned dcl 1-280 mode_lineconind defined fixed bin(17,0) dcl 1-309 mode_ll defined fixed bin(17,0) dcl 1-309 mode_on defined bit(1) packed unaligned dcl 1-280 mode_separator internal static char(1) initial packed unaligned dcl 1-398 mode_struclvlind defined fixed bin(17,0) dcl 1-309 mode_thendo defined bit(1) packed unaligned dcl 1-280 null_statement internal static fixed bin(8,0) initial dcl 1-185 on_statement internal static fixed bin(8,0) initial dcl 1-185 open_statement internal static fixed bin(8,0) initial dcl 1-185 output_string based char packed unaligned dcl 1-84 percent_abort_statement internal static fixed bin(8,0) initial dcl 1-185 percent_default_statement internal static fixed bin(8,0) initial dcl 1-185 percent_else_statement internal static fixed bin(8,0) initial dcl 1-185 percent_elseif_statement internal static fixed bin(8,0) initial dcl 1-185 percent_endif_statement internal static fixed bin(8,0) initial dcl 1-185 percent_error_statement internal static fixed bin(8,0) initial dcl 1-185 percent_if_statement internal static fixed bin(8,0) initial dcl 1-185 percent_include_statement internal static fixed bin(8,0) initial dcl 1-185 percent_page_statement internal static fixed bin(8,0) initial dcl 1-185 percent_print_statement internal static fixed bin(8,0) initial dcl 1-185 percent_replace_statement internal static fixed bin(8,0) initial dcl 1-185 percent_set_statement internal static fixed bin(8,0) initial dcl 1-185 percent_skip_statement internal static fixed bin(8,0) initial dcl 1-185 percent_statement internal static fixed bin(8,0) initial dcl 1-185 percent_warn_statement internal static fixed bin(8,0) initial dcl 1-185 prefix_minus internal static fixed bin(8,0) initial dcl 1-94 prefix_plus internal static fixed bin(8,0) initial dcl 1-94 procedure_statement internal static fixed bin(8,0) initial dcl 1-185 put_statement internal static fixed bin(8,0) initial dcl 1-185 read_statement internal static fixed bin(8,0) initial dcl 1-185 return_statement internal static fixed bin(8,0) initial dcl 1-185 revert_mode internal static char(6) initial packed unaligned dcl 1-400 revert_statement internal static fixed bin(8,0) initial dcl 1-185 rewrite_statement internal static fixed bin(8,0) initial dcl 1-185 signal_statement internal static fixed bin(8,0) initial dcl 1-185 size builtin function dcl 137 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 subtype_noniterative_do 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 target_comma internal static fixed bin(8,0) initial dcl 1-94 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 tree_control_comment internal static char(10) initial packed unaligned dcl 1-412 unknown_statement internal static fixed bin(8,0) initial dcl 1-185 unlock_statement internal static fixed bin(8,0) initial dcl 1-185 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. action 000000 constant label array(16) dcl 216 ref 231 328 342 364 368 377 403 412 532 543 562 575 588 601 614 639 652 arithmetic_to_bit 003062 constant entry internal dcl 733 ref 447 452 485 499 508 bit_to_arithmetic 003074 constant entry internal dcl 744 ref 447 452 485 499 508 check_syntax_after_constant 002254 constant label dcl 518 ref 315 438 end_of_source_reached 002621 constant label dcl 656 ref 249 255 330 370 405 419 462 475 518 564 577 590 603 616 641 767 786 end_of_source_reached_but_no_pending_token 002622 constant label dcl 659 ref 218 391 error 003163 constant entry internal dcl 794 ref 242 277 281 292 296 323 361 386 396 459 472 490 526 545 552 557 659 692 695 715 format_pl1_lex_ 000552 constant entry external dcl 52 make_token 002701 constant entry internal dcl 687 ref 314 319 341 357 366 376 411 437 514 561 574 587 600 613 638 651 656 make_trailer 002771 constant entry internal dcl 712 ref 390 402 542 scan_exponent 002031 constant label dcl 441 set ref 417 scan_past_digits 003133 constant entry internal dcl 779 ref 416 423 429 479 scan_past_identifier_characters 003103 constant entry internal dcl 758 ref 317 346 unrecoverable_error 002673 constant label dcl 674 ref 806 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 5562 5576 5513 5572 Length 6006 5513 14 173 47 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME format_pl1_lex_ 500 external procedure is an external procedure. make_token internal procedure shares stack frame of external procedure format_pl1_lex_. make_trailer internal procedure shares stack frame of external procedure format_pl1_lex_. arithmetic_to_bit internal procedure shares stack frame of external procedure format_pl1_lex_. bit_to_arithmetic internal procedure shares stack frame of external procedure format_pl1_lex_. scan_past_identifier_characters internal procedure shares stack frame of external procedure format_pl1_lex_. scan_past_digits internal procedure shares stack frame of external procedure format_pl1_lex_. error internal procedure shares stack frame of external procedure format_pl1_lex_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME format_pl1_lex_ 000100 action_index format_pl1_lex_ 000101 current_char format_pl1_lex_ 000102 loop format_pl1_lex_ 000103 scan_index format_pl1_lex_ 000104 source_index format_pl1_lex_ 000105 source_length format_pl1_lex_ 000106 source_ptr format_pl1_lex_ 000110 string_length format_pl1_lex_ 000111 token_length format_pl1_lex_ 000112 token_start format_pl1_lex_ 000113 token_type format_pl1_lex_ 000114 tokenx format_pl1_lex_ 000115 trailerx format_pl1_lex_ 000116 tentative_token_type format_pl1_lex_ 000320 temp_segs format_pl1_lex_ THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_e_as alloc_char_temp call_ext_out_desc return_mac bound_ck_signal shorten_stack ext_entry_desc any_to_any_truncate_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. format_pl1_error_ 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 52 000547 81 000557 202 001071 203 001137 204 001141 206 001142 207 001144 208 001146 210 001150 211 001154 212 001156 213 001160 214 001162 216 001163 218 001204 221 001205 222 001206 224 001213 225 001216 229 001227 231 001232 233 001233 236 001234 237 001236 238 001240 240 001257 242 001260 246 001270 247 001273 249 001277 252 001300 253 001303 255 001305 259 001310 260 001315 262 001316 263 001317 265 001320 267 001321 269 001327 270 001331 272 001332 277 001347 281 001362 288 001410 292 001411 296 001424 314 001503 315 001504 317 001505 319 001506 323 001507 328 001547 330 001550 334 001553 335 001557 338 001566 341 001570 342 001571 345 001572 346 001573 348 001574 352 001614 354 001616 357 001623 361 001624 364 001642 366 001643 368 001644 370 001645 374 001650 376 001654 377 001655 380 001656 381 001660 383 001661 384 001677 386 001700 389 001710 390 001713 391 001714 394 001715 396 001720 402 001750 403 001751 405 001752 409 001755 411 001766 412 001767 415 001770 416 001772 417 001773 419 001774 423 001777 425 002000 427 002006 428 002010 429 002011 430 002012 432 002013 435 002023 436 002025 437 002027 438 002030 441 002031 444 002034 447 002046 452 002060 455 002073 457 002074 459 002077 462 002107 465 002110 468 002121 470 002122 472 002125 475 002135 479 002136 482 002137 485 002145 488 002160 490 002161 496 002206 499 002216 502 002231 505 002232 508 002242 511 002252 514 002253 518 002254 522 002257 523 002264 526 002273 532 002311 534 002312 537 002331 539 002336 542 002337 543 002340 545 002341 552 002412 557 002442 561 002470 562 002472 564 002473 568 002476 570 002502 571 002503 574 002505 575 002506 577 002507 581 002512 583 002516 584 002517 587 002521 588 002522 590 002523 594 002526 596 002532 597 002533 600 002535 601 002536 603 002537 607 002542 609 002546 610 002547 613 002551 614 002552 616 002553 620 002556 622 002564 623 002565 624 002567 626 002570 628 002572 629 002573 630 002575 632 002576 634 002600 635 002601 638 002603 639 002604 641 002605 645 002610 647 002614 648 002615 651 002617 652 002620 656 002621 659 002622 663 002640 664 002646 668 002656 670 002664 674 002673 676 002676 678 002700 687 002701 690 002702 692 002705 695 002723 698 002741 699 002742 700 002751 701 002755 702 002762 703 002770 712 002771 715 002772 718 003012 719 003013 720 003022 721 003025 722 003033 725 003041 727 003054 729 003061 733 003062 739 003064 744 003074 749 003076 758 003103 761 003104 764 003124 766 003125 767 003130 770 003131 771 003132 779 003133 782 003134 783 003154 785 003155 786 003160 789 003161 790 003162 794 003163 803 003174 806 003231 808 003235 ----------------------------------------------------------- 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