COMPILATION LISTING OF SEGMENT linus_modify_gt Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985 Compiled at: Honeywell Multics Op. - System M Compiled on: 07/29/86 1005.9 mst Tue Options: optimize map 1 /* *********************************************************** 2* * * 3* * * 4* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 5* * * 6* * * 7* *********************************************************** */ 8 9 /* ****************************************************** 10* * * 11* * * 12* * Copyright (c) 1972 by Massachusetts Institute of * 13* * Technology and Honeywell Information Systems, Inc. * 14* * * 15* * * 16* ****************************************************** */ 17 18 linus_modify_gt: 19 proc (lcb_ptr, start_ptr, string_len, start_pos, td_ptr, si_ptr, code); 20 21 /* DESCRIPTION: 22* 23* This procedure is the lexical analizer for the MODIFY request expr parser. 24* A key, pointer and length are returned for a CONSTANT. 25* A key and index into the linus variable structure are returned for a linus 26* variable. 27* A key and index into the select info structure are returned for a database 28* item. 29* 30* 31* 32* HISTORY: 33* 34* 77-08-01 J. C. C. Jagernauth: Initially written. 35* 36* 80-03-14 Rickie E. Brinegar: Modified to use a work area defined on 37* lcb.linus_area_ptr instead of getting system free area. 38* 39**/ 40 1 1 /* BEGIN INCLUDE FILE linus_lcb.incl.pl1 -- jaw 8/30/77 */ 1 2 1 3 1 4 1 5 /****^ HISTORY COMMENTS: 1 6* 1) change(86-04-23,Dupuis), approve(86-05-23,MCR7188), audit(86-07-23,GWMay), 1 7* install(86-07-29,MR12.0-1106): 1 8* Added general_work_area_ptr and renamed sfr_ptr to 1 9* force_retrieve_scope_ptr. 1 10* END HISTORY COMMENTS */ 1 11 1 12 1 13 /* HISTORY: 1 14* 1 15* 78-09-29 J. C. C. Jagernauth: Modified for MR7.0. 1 16* 1 17* 81-05-11 Rickie E. Brinegar: added security bit and andministrator bit as 1 18* a part of the attribute level control work. 1 19* 1 20* 81-06-17 Rickie E. Brinegar: deleted the sd_ptr as a part of removing the 1 21* scope_data structure from LINUS. LINUS now depends totally on MRDS for 1 22* scope information. 1 23* 1 24* 81-11-11 Rickie E. Brinegar: added the timing bit and three fields for 1 25* retaining various vcpu times to be collected when in timing mode. The 1 26* times to be collected are: LINUS parsing time, LINUS processing time, and 1 27* MRDS processing time. 1 28* 1 29* 82-01-15 DJ Schimke: Added the build_increment and build_start fields as 1 30* part of the line numbering implementation. This allows for possible later 1 31* LINUS control of the build defaults. 1 32* 1 33* 82-03-01 Paul W. Benjamin: Removed linus_prompt_chars_ptr, as that 1 34* information is now retained by ssu_. Removed parse_timer as no longer 1 35* meaningful. Added linus_version. Added iteration bit. Added 6 entry 1 36* variables for ssu_ replaceable procedures. Added actual_input_iocbp. 1 37* 1 38* 82-06-23 Al Dupuis: Added subsystem_control_info_ptr, 1 39* subsystem_invocation_level, and selection_expression_identifier. 1 40* 1 41* 82-08-26 DJ Schimke: Added report_control_info_ptr, and 1 42* table_control_info_ptr. 1 43* 1 44* 82-10-19 DJ Schimke: Added ssu_abort_line. 1 45* 1 46* 83-06-06 Bert Moberg: Added print_search_order (pso) and no_optimize (no_ot) 1 47* 1 48* 83-04-07 DJ Schimke: Added temp_seg_info_ptr. 1 49* 1 50* 83-08-26 Al Dupuis: Added query_temp_segment_ptr. 1 51**/ 1 52 1 53 dcl 1 lcb aligned based (lcb_ptr), /* LINUS control block */ 1 54 2 db_index fixed bin (35), /* index of open data base, or 0 */ 1 55 2 rb_len fixed bin (21), /* length of request buffer */ 1 56 2 lila_count fixed bin (35), /* number of LILA text lines */ 1 57 2 lila_chars fixed bin (35), /* number of LILA source test chars */ 1 58 2 trans_id fixed bin (35), /* used by checkpoint and rollback facilities (MR7.0) */ 1 59 2 lila_fn char (32) unal, /* entry name of lila data file */ 1 60 2 prompt_flag bit (1) unal, /* on if in prompt mode */ 1 61 2 test_flag bit (1) unal, /* on if in test mode */ 1 62 2 new_version bit (1) unal init (1), /* on for new version data base (MR7.0) */ 1 63 2 secured_db bit (1) unal, /* on if the db is in a secure state */ 1 64 2 administrator bit (1) unal, /* on if the user is a db administrator */ 1 65 2 timing_mode bit (1) unal, /* on if timing is to be done */ 1 66 2 iteration bit (1) unal, /* interpret parens as iteration sets */ 1 67 2 pso_flag bit (1) unal, /* add print_search_order to select */ 1 68 2 no_ot_flag bit (1) unal, /* add no_optimize to select */ 1 69 2 reserved bit (27) unal, 1 70 2 liocb_ptr ptr, /* iocb ptr for lila file */ 1 71 2 rb_ptr ptr, /* ptr to request buffer */ 1 72 2 is_ptr ptr, /* iocb ptr for currentinput stream switch */ 1 73 2 cal_ptr ptr, /* ptr to current arg list for invoke (or null) */ 1 74 2 ttn_ptr ptr, /* pointer to table info structure */ 1 75 2 force_retrieve_scope_info_ptr ptr, /* structure pointer to force retrieve scope operation */ 1 76 2 lv_ptr ptr, /* pointer linus variables */ 1 77 2 si_ptr ptr, /* pointer to select_info structure */ 1 78 2 setfi_ptr ptr, /* pointer to set function information */ 1 79 2 sclfi_ptr ptr, /* pointer to user declared scalar fun. names */ 1 80 2 ivs_ptr ptr, /* pointer to stack of invoke iocb pointers */ 1 81 2 lit_ptr ptr, /* pointer to literal pool */ 1 82 2 lvv_ptr ptr, /* pointer to linus variable alloc. pool */ 1 83 2 rd_ptr ptr, /* point to readied files mode information (MR7.0) */ 1 84 2 rt_ptr ptr, /* point to table of relation names and their readied modes 1 85* (MR7.0) */ 1 86 2 actual_input_iocbp ptr, /* ptr to input while in macros */ 1 87 2 lila_promp_chars_ptr ptr, /* pointer to the prompt characters for lila */ 1 88 2 linus_area_ptr ptr, /* LINUS temporary segment pointer */ 1 89 2 lila_area_ptr ptr, /* LILA temporary segment pointer */ 1 90 2 i_o_area_ptr ptr, /* temporary segment pointer used by write, print, create_list */ 1 91 2 rel_array_ptr ptr, /* ptr to array of names rslt info structure 1 92* for current lila expression */ 1 93 2 unused_timer float bin (63), /* future expansion */ 1 94 2 request_time float bin (63), /* How much request time was spent 1 95* in LINUS. (-1 = user has just enabled 1 96* timing, do not report) */ 1 97 2 mrds_time float bin (63), /* How much time was spent in MRDS */ 1 98 2 build_increment fixed bin, /* default increment for build mode */ 1 99 2 build_start fixed bin, /* default start count for build mode */ 1 100 2 linus_version char (4), /* current version of LINUS */ 1 101 2 subsystem_control_info_ptr ptr, /* the same ptr passed by ssu_ to each request procedure */ 1 102 2 subsystem_invocation_level fixed bin, /* identifies this invocation of LINUS */ 1 103 2 selection_expression_identifier fixed bin, /* identifies the current processed selection expression */ 1 104 2 report_control_info_ptr ptr, /* pointer to linus_report_control_info structure */ 1 105 2 table_control_info_ptr ptr, /* pointer to linus_table control structure */ 1 106 2 temp_seg_info_ptr ptr, /* pointer to linus_temp_seg_mgr control structure */ 1 107 2 query_temp_segment_ptr ptr, /* points to temp seg used for manipulating query */ 1 108 2 general_work_area_ptr ptr, /* a freeing area for general use */ 1 109 2 word_pad (6) bit (36) unal, 1 110 /* procedures that will be optionally */ 1 111 /* replaced by the user. Saved so they */ 1 112 /* can be reinstated if desired. */ 1 113 2 ssu_abort_line entry options (variable), 1 114 2 ssu_post_request_line variable entry (ptr), 1 115 2 ssu_pre_request_line variable entry (ptr), 1 116 1 117 2 curr_lit_offset fixed bin (35), /* index of first free bit in lit. pool */ 1 118 2 curr_lv_val_offset fixed bin (35), /* index of first free bit lv. val. pool */ 1 119 2 static_area area (sys_info$max_seg_size - fixed (rel (addr (lcb.static_area))) + 1); 1 120 1 121 dcl lcb_ptr ptr; 1 122 1 123 /* END INCLUDE FILE linus_lcb.incl.pl1 */ 41 42 2 1 /* BEGIN INCLUDE FILE linus_select_info.incl.pl1 */ 2 2 /* History: 77-07-29 J. A. Weeldreyer: Originally written. 2 3* Modified: 82-18-82 Dave Schimke: Added user_item.table_name 2 4**/ 2 5 dcl 1 select_info aligned based (si_ptr), /* info from LILA select clause */ 2 6 2 set_fn bit (1) unal, /* on if set fn to be applied */ 2 7 2 se_flags unal, /* flags pertaining to selection expr. */ 2 8 3 val_ret bit (1) unal, /* valid for retrieval */ 2 9 3 val_dtt bit (1) unal, /* valid for define_temp_table */ 2 10 3 val_del bit (1) unal, /* valid for delete */ 2 11 3 val_mod bit (1) unal, /* valid for modify */ 2 12 2 dup_flag bit (1) unal, /* on if dup explic. spec. somewhere */ 2 13 2 unique_flag bit (1) unal, /* on if unique explic. spec. somewhere */ 2 14 2 pad bit (29) unal, /* reserved */ 2 15 2 prior_sf_ptr ptr, /* pointer to set fns for prior eval. */ 2 16 2 se_ptr ptr, /* pointer to mrds selection expression */ 2 17 2 sel_items_ptr ptr, /* pointer to list of selected items */ 2 18 2 sel_items_len fixed bin, /* length in characters of list of selected items */ 2 19 2 se_len fixed bin (35), /* length of mrds sel. expr. */ 2 20 2 nsv_alloc fixed bin, /* no. of se. vals aloc. */ 2 21 2 nmi_alloc fixed bin, /* no. of mrds items alloc. */ 2 22 2 nui_alloc fixed bin, /* no. of user items alloc. */ 2 23 2 nsevals fixed bin, /* number of selection expr. vaules */ 2 24 2 n_mrds_items fixed bin, /* no. of items in mrds select list */ 2 25 2 n_user_items fixed bin, /* no. of items user will see */ 2 26 2 se_vals (nsv_init refer (select_info.nsv_alloc)), 2 27 3 arg_ptr ptr, 2 28 3 desc_ptr ptr, 2 29 2 mrds_item (nmi_init refer (select_info.nmi_alloc)), /* mrds select items */ 2 30 3 arg_ptr ptr, /* pointer to receiving field */ 2 31 3 bit_len fixed bin (35), /* bit length of receiving field */ 2 32 3 desc bit (36), /* descriptor for receiving field */ 2 33 3 assn_type fixed bin, /* type code for assign_ */ 2 34 3 assn_len fixed bin (35), /* length for assign_ */ 2 35 2 user_item (nui_init refer (select_info.nui_alloc)), /* user select item */ 2 36 3 name char (32) var, /* name for col. header */ 2 37 3 table_name char (32) var, /* name of containing linus table */ 2 38 3 item_type fixed bin, /* indicates type of item: 2 39* 1 => raw mrds, 2 40* 2 => expr. */ 2 41 3 rslt_desc bit (36), /* descriptor for expr. result */ 2 42 3 rslt_bit_len fixed bin (35), /* bit length of expr. result */ 2 43 3 rslt_assn_ptr ptr, /* pointer to expr. result storage loc. */ 2 44 3 rslt_assn_type fixed bin, /* assign_ type code of expr. result */ 2 45 3 rslt_assn_len fixed bin (35), /* assign_ length for expr. result */ 2 46 3 item_ptr ptr; /* pointer to item or expr. or applied set_func. structure */ 2 47 2 48 dcl (nsv_init, nmi_init, nui_init) fixed bin; 2 49 dcl si_ptr ptr; 2 50 2 51 /* END INCLUDE FILE linus_select_info.incl.pl1 */ 43 44 3 1 /* BEGIN INCLUDE FILE linus_token_data.incl.pl1 -- jaw 8/7/78 */ 3 2 3 3 dcl 1 token_data aligned based (td_ptr), /* data for lila tokens */ 3 4 2 key fixed bin (17) unal, /* key of token */ 3 5 2 must_free bit (1) unal, /* on if value must be freed */ 3 6 2 temp_tab bit (1) unal, /* on if temporary table */ 3 7 2 reserved bit (16) unal, 3 8 2 mvar char (32) var, /* mrds variable if identifier */ 3 9 2 lvar char (32) var, /* linus variable if identifier */ 3 10 2 length fixed bin (35), /* char length of token value */ 3 11 2 t_ptr ptr; /* points to token value */ 3 12 3 13 dcl ((NULL init (0)), 3 14 (RP init (1)), 3 15 (COL_SPEC init (2)), 3 16 (LINUS_VAR init (3)), 3 17 (CONST init (4)), 3 18 (SET_FN init (5)), 3 19 (SCAL_FN init (6)), 3 20 (LP init (7)), 3 21 (STAR init (8)), 3 22 (DIV init (9)), 3 23 (PLUS init (10)), 3 24 (MINUS init (11)), 3 25 (TAB_NAME init (12)), 3 26 (ROW_TAB_PAIR init (13)), 3 27 (UNION init (14)), 3 28 (INTER init (15)), 3 29 (DIFFER init (16)), 3 30 (ROW_DES init (17)), 3 31 (LB init (18)), 3 32 (RB init (19)), 3 33 (SELECT init (20)), 3 34 (NOT init (21)), 3 35 (AND init (22)), 3 36 (OR init (23)), 3 37 (EQ init (24)), 3 38 (NE init (25)), 3 39 (GT init (26)), 3 40 (GE init (27)), 3 41 (LT init (28)), 3 42 (LE init (29)), 3 43 (FROM init (30)), 3 44 (WHERE init (31)), 3 45 (DUP init (32)), 3 46 (UNIQUE init (33)), 3 47 (COMMA init (34))) fixed bin int static options (constant); 3 48 3 49 dcl td_ptr ptr; 3 50 3 51 /* END INCLUDE FILE linus_token_data.incl.pl1 */ 45 46 4 1 /* BEGIN INCLUDE FILE linus_variables.incl.pl1 -- jaw 7/19/77 */ 4 2 4 3 dcl 1 variables aligned based (lv_ptr), /* info for all variables */ 4 4 2 nvars_alloc fixed bin, /* no. var. slots alloc. */ 4 5 2 nvars fixed bin, /* no. of variables currently defined */ 4 6 2 var_info (nvars_init refer (variables.nvars_alloc)), 4 7 3 name char (32), /* name of variable */ 4 8 3 var_ptr ptr, /* ptr to curr. value */ 4 9 3 bit_len fixed bin (35), /* bit length of current value */ 4 10 3 assn_type fixed bin, /* assign_ type code of current value */ 4 11 3 assn_len fixed bin (35), /* assign_ length of current value */ 4 12 3 desc bit (36); /* descrptor of current value */ 4 13 4 14 dcl lv_ptr ptr; 4 15 dcl nvars_init fixed bin; 4 16 4 17 /* END INCLUDE FILE linus_variables.incl.pl1 */ 47 48 49 dcl start_ptr ptr; 50 51 dcl ( 52 code, /* Output: status code */ 53 start_pos, /* Input/Output: position at which to start scan */ 54 i, /* internal indexes */ 55 j, 56 cur_pos 57 ) fixed bin (35); /* current position in string */ 58 59 dcl string_len fixed bin; 60 61 dcl found bit (1); 62 63 dcl ARITH_CHARS char (14) int static options (constant) 64 init (".eib0123456789"); 65 dcl DELIMS char (3) int static options (constant) init (" 66 "); 67 dcl CONS_PREC char (5) int static options (constant) init ("(+-*/"); 68 dcl ARITH_START char (11) int static options (constant) init (".0123456789"); 69 dcl ID_CHARS char (64) int static options (constant) 70 init ( 71 "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_-"); 72 dcl tmp_char char (string_len) based (start_ptr); 73 dcl tmp_char_arr (string_len) char (1) based (start_ptr); 74 75 dcl ( 76 linus_error_$invalid_token, 77 linus_error_$long_id, 78 linus_error_$linus_var_not_defined, 79 linus_error_$long_lv_name, 80 linus_error_$inv_string_const, 81 mrds_data_$max_id_len, 82 sys_info$max_seg_size 83 ) fixed bin (35) ext; 84 85 dcl (rel, fixed, addr, verify, index, substr, null, collate) 86 builtin; 87 88 token_data.must_free = "0"b; 89 if start_pos > string_len then 90 token_data.key = NULL; 91 else do; /* if have something left */ 92 i = verify (substr (tmp_char, start_pos), DELIMS); /* skip white spaces */ 93 if i > 0 then do; 94 cur_pos = start_pos + i - 1; 95 96 go to char_proc (index (collate (), tmp_char_arr (cur_pos))); 97 /* see what we have */ 98 99 char_proc (1): /* special characters */ 100 char_proc (2): 101 char_proc (3): 102 char_proc (4): 103 char_proc (5): 104 char_proc (6): 105 char_proc (7): 106 char_proc (8): 107 char_proc (9): 108 char_proc (10): 109 char_proc (11): 110 char_proc (12): 111 char_proc (13): 112 char_proc (14): 113 char_proc (15): 114 char_proc (16): 115 char_proc (17): 116 char_proc (18): 117 char_proc (19): 118 char_proc (20): 119 char_proc (21): 120 char_proc (22): 121 char_proc (23): 122 char_proc (24): 123 char_proc (25): 124 char_proc (26): 125 char_proc (27): 126 char_proc (28): 127 char_proc (29): 128 char_proc (30): 129 char_proc (31): 130 char_proc (32): 131 char_proc (33): /* space */ 132 char_proc (36): /* # */ 133 char_proc (37): /* $ */ 134 char_proc (38): /* % */ 135 char_proc (39): /* & */ 136 char_proc (40): /* ' */ 137 char_proc (45): /* , */ 138 char_proc (59): /* : */ 139 char_proc (60): /* ; */ 140 char_proc (61): /* < */ 141 char_proc (62): /* = */ 142 char_proc (63): /* > */ 143 char_proc (64): /* ? */ 144 char_proc (65): /* @ */ 145 char_proc (92): /* [ */ 146 char_proc (93): /* \ */ 147 char_proc (94): /* ] */ 148 char_proc (95): /* ^ */ 149 char_proc (96): /* _ */ 150 char_proc (97): /* ` */ 151 char_proc (124): /* { */ 152 char_proc (125): /* | */ 153 char_proc (126): /* } */ 154 char_proc (127): /* ~ */ 155 char_proc (128): /* PAD */ 156 call error (linus_error_$invalid_token); /* none of these chars. can start a token */ 157 158 char_proc (34): /* ! */ 159 token_data.key = LINUS_VAR; /* this is a linus variable */ 160 cur_pos = cur_pos + 1; /* first char past ! */ 161 i = verify (substr (tmp_char, cur_pos), ID_CHARS); 162 /* find end of token */ 163 token_data.length = i - 1; 164 if lcb.lv_ptr = null then /* if no variables defined */ 165 call error (linus_error_$linus_var_not_defined); 166 lv_ptr = lcb.lv_ptr; 167 if variables.nvars <= 0 then /* if no variables */ 168 call error (linus_error_$linus_var_not_defined); 169 do j = 1 to variables.nvars 170 while (variables.var_info.name (j) 171 ^= substr (tmp_char, cur_pos, token_data.length)); 172 /* look for var. */ 173 end; 174 if j > variables.nvars then do; /* if didn't find it */ 175 i = index (substr (tmp_char, cur_pos, token_data.length), "-"); 176 /* look for imbedded hyphen */ 177 if i <= 0 then 178 call error (linus_error_$linus_var_not_defined); 179 /* not there */ 180 token_data.length = i - 1; /* found one, check first part */ 181 do j = 1 to variables.nvars 182 while (variables.var_info.name (j) 183 ^= substr (tmp_char, cur_pos, token_data.length)); 184 end; 185 if j > variables.nvars then 186 call error (linus_error_$linus_var_not_defined); 187 end; /* if didn't find it first time */ 188 if token_data.length > mrds_data_$max_id_len then 189 /* if too long */ 190 call error (linus_error_$long_lv_name); 191 start_pos = cur_pos + token_data.length; /* adjust scan start pos. */ 192 token_data.length = j; /* pass index to linus variable structure */ 193 go to exit; /* end ! */ 194 195 char_proc (35): /* " */ 196 token_data.key = CONST; /* this is a string constant */ 197 token_data.t_ptr = addr (tmp_char_arr (cur_pos)); 198 found = "0"b; /* init for end search */ 199 cur_pos = cur_pos + 1; 200 token_data.length = 1; 201 i = index (substr (tmp_char, cur_pos), """"); /* look for next " */ 202 do while (i > 0 & ^found); /* search for single quote */ 203 token_data.length = token_data.length + i; /* increment length */ 204 cur_pos = cur_pos + i; /* first char beyond */ 205 if cur_pos > string_len then 206 found = "1"b; /* single quote at end of string */ 207 else if tmp_char_arr (cur_pos) = """" then do; 208 cur_pos = cur_pos + 1; 209 token_data.length = token_data.length + 1; 210 if cur_pos <= string_len then 211 i = index (substr (tmp_char, cur_pos), """"); 212 else i = 0; 213 end; /* if double " */ 214 else found = "1"b; /* if single " */ 215 end; /* single " search loop */ 216 if ^found then 217 call error (linus_error_$inv_string_const); 218 if tmp_char_arr (cur_pos) = "b" then do; /* if bit string */ 219 cur_pos = cur_pos + 1; 220 token_data.length = token_data.length + 1; 221 end; 222 start_pos = cur_pos; 223 go to exit; /* end " */ 224 225 226 char_proc (41): /* ( */ 227 token_data.key = LP; /* assume LP unless proven other */ 228 i = verify (substr (tmp_char, cur_pos + 1), "0123456789"); 229 /* is possible string const */ 230 if tmp_char_arr (cur_pos + i) = ")" & i > 1 then do; 231 /* good chance of string const */ 232 j = verify (substr (tmp_char, cur_pos + i + 1), DELIMS); 233 /* skip white space */ 234 if tmp_char_arr (cur_pos + i + j) = """" then do; 235 /* have string const */ 236 token_data.key = CONST; 237 token_data.length = i + j + 1; /* init for quote search loop */ 238 token_data.t_ptr = addr (tmp_char_arr (cur_pos)); 239 cur_pos = cur_pos + i + j + 1; 240 found = "0"b; 241 i = index (substr (tmp_char, cur_pos), """"); 242 /* find next quote */ 243 do while (i > 0 & ^found); /* until we find a single quote */ 244 token_data.length = token_data.length + i; 245 /* incr. length */ 246 cur_pos = cur_pos + i; /* first char beyond */ 247 if cur_pos > string_len then 248 call error (linus_error_$inv_string_const); 249 if tmp_char_arr (cur_pos) = """" then do; 250 /* if double quote */ 251 cur_pos = cur_pos + 1; 252 token_data.length = token_data.length + 1; 253 if cur_pos <= string_len then 254 i = index (substr (tmp_char, cur_pos), """"); 255 else i = 0; /* terminate if passed end of string */ 256 end; /* if double quote */ 257 else do; /* if single quote */ 258 found = "1"b; 259 cur_pos = cur_pos + i; 260 token_data.length = token_data.length + i; 261 end; /* if single quote */ 262 end; /* single quote search loop */ 263 if ^found then 264 call error (linus_error_$inv_string_const); 265 if tmp_char_arr (cur_pos) = "b" then do; /* if bit string */ 266 cur_pos = cur_pos + 1; 267 token_data.length = token_data.length + 1; 268 end; 269 start_pos = cur_pos; 270 end; /* if string const */ 271 end; /* if good chance */ 272 if token_data.key = LP then 273 call set_token (LP, 1); /* if wasn't const */ 274 go to exit; /* end ( */ 275 276 char_proc (42): /* ) */ 277 call set_token (RP, 1); 278 go to exit; 279 280 char_proc (43): /* * */ 281 call set_token (STAR, 1); 282 go to exit; 283 284 char_proc (44): /* + */ 285 if is_const () = "1"b then 286 call arith_const; /* is arith const = "1"b */ 287 else call set_token (PLUS, 1);/* is operator */ 288 go to exit; 289 290 char_proc (46): /* - */ 291 if is_const () = "1"b then 292 call arith_const; 293 else call set_token (MINUS, 1); 294 go to exit; 295 296 char_proc (47): /* . */ 297 char_proc (49): /* 0 */ 298 char_proc (50): /* 1 */ 299 char_proc (51): /* 2 */ 300 char_proc (52): /* 3 */ 301 char_proc (53): /* 4 */ 302 char_proc (54): /* 5 */ 303 char_proc (55): /* 6 */ 304 char_proc (56): /* 7 */ 305 char_proc (57): /* 8 */ 306 char_proc (58): /* 9 */ 307 /* these characters begin an arith. const. */ 308 call arith_const; 309 go to exit; 310 311 char_proc (48): /* / */ 312 call set_token (DIV, 1); 313 go to exit; 314 315 316 char_proc (66): /* A */ 317 char_proc (67): /* B */ 318 char_proc (68): /* C */ 319 char_proc (69): /* D */ 320 char_proc (70): /* E */ 321 char_proc (71): /* F */ 322 char_proc (72): /* G */ 323 char_proc (73): /* H */ 324 char_proc (74): /* I */ 325 char_proc (75): /* J */ 326 char_proc (76): /* K */ 327 char_proc (77): /* L */ 328 char_proc (78): /* M */ 329 char_proc (79): /* N */ 330 char_proc (80): /* O */ 331 char_proc (81): /* P */ 332 char_proc (82): /* Q */ 333 char_proc (83): /* R */ 334 char_proc (84): /* S */ 335 char_proc (85): /* T */ 336 char_proc (86): /* U */ 337 char_proc (87): /* V */ 338 char_proc (88): /* W */ 339 char_proc (89): /* X */ 340 char_proc (90): /* Y */ 341 char_proc (91): /* Z */ 342 char_proc (98): /* a */ 343 char_proc (99): /* b */ 344 char_proc (100): /* c */ 345 char_proc (101): /* d */ 346 char_proc (102): /* e */ 347 char_proc (103): /* f */ 348 char_proc (104): /* g */ 349 char_proc (105): /* h */ 350 char_proc (106): /* i */ 351 char_proc (107): /* j */ 352 char_proc (108): /* k */ 353 char_proc (109): /* l */ 354 char_proc (110): /* m */ 355 char_proc (111): /* n */ 356 char_proc (112): /* o */ 357 char_proc (113): /* p */ 358 char_proc (114): /* q */ 359 char_proc (115): /* r */ 360 char_proc (116): /* s */ 361 char_proc (117): /* t */ 362 char_proc (118): /* u */ 363 char_proc (119): /* v */ 364 char_proc (120): /* w */ 365 char_proc (121): /* x */ 366 char_proc (122): /* y */ 367 char_proc (123): /* z */ 368 call ident_proc; /* determine identifier type, and set up token data */ 369 go to exit; 370 371 372 exit: 373 end; /* token section */ 374 375 else do; /* ran out of tokens */ 376 token_data.key = NULL; 377 start_pos = string_len + 1; 378 end; 379 end; /* if something to do */ 380 381 code = 0; 382 real_exit: 383 return; 384 385 set_token: 386 proc (key, length); 387 388 /* Procedure to set up token_data given a key value and token length */ 389 390 dcl (key, length) fixed bin; 391 392 token_data.key = key; 393 token_data.length = length; 394 token_data.t_ptr = addr (tmp_char_arr (cur_pos)); 395 start_pos = cur_pos + length; 396 397 end set_token; 398 399 is_const: 400 proc returns (bit (1)); 401 402 /* Procedure to determine if token at cur_pos is an arithmetic constant or 403* is n operator. */ 404 405 dcl i fixed bin; 406 dcl flag bit (1); 407 408 if index (ARITH_START, tmp_char_arr (cur_pos + 1)) ^= 0 then do; 409 /* possible const. */ 410 do i = cur_pos - 1 to 1 by -1 411 while (index (DELIMS, tmp_char_arr (i)) ^= 0); 412 end; /* search for end of prev token */ 413 if i < 1 then 414 flag = "1"b; /* first token, must be const */ 415 else if index (CONS_PREC, tmp_char_arr (i)) ^= 0 then 416 flag = "1"b; /* if predecessor forces constant */ 417 else flag = "0"b; /* is operator */ 418 end; /* possible constant */ 419 else flag = "0"b; /* if no chance of constant */ 420 421 return (flag); 422 423 end is_const; 424 425 arith_const: 426 proc; 427 428 /* Procedure to isolate an arithmetic constant, and set up the resultind token 429* data */ 430 431 dcl (i, j) fixed bin; 432 433 token_data.key = CONST; 434 token_data.t_ptr = addr (tmp_char_arr (cur_pos)); 435 j = 0; /* init */ 436 i = verify (substr (tmp_char, cur_pos + 1), ARITH_CHARS); 437 if i <= 0 then 438 i = string_len - cur_pos + 1; 439 else do; /* see if found real end */ 440 if tmp_char_arr (cur_pos + i) = "+" | tmp_char_arr (cur_pos + i) = "-" 441 then /* check for exponent */ 442 if tmp_char_arr (cur_pos + i - 1) ^= "e" then 443 ; /* not exp */ 444 else do; /* is exp, scan further */ 445 j = verify (substr (tmp_char, cur_pos + i + 1), ARITH_CHARS); 446 if j <= 0 then 447 i = string_len - cur_pos + 1; 448 else i = i + j; 449 end; /* if exponent */ 450 end; /* checking for real end */ 451 token_data.length = i; 452 start_pos = cur_pos + i; 453 454 end arith_const; 455 456 ident_proc: 457 proc; 458 459 /* Procedure to determine identifier type. */ 460 461 dcl (i, j, k, tmp_len) fixed bin; 462 dcl f_choice char (i) based (addr (tmp_char_arr (cur_pos))); 463 dcl s_choice char (j) based (addr (tmp_char_arr (cur_pos))); 464 465 j = 0; /* init */ 466 i = verify (substr (tmp_char, cur_pos), ID_CHARS);/* find end of id. */ 467 if i <= 0 then 468 i = string_len - cur_pos + 1; 469 else i = i - 1; /* i is length */ 470 if i > mrds_data_$max_id_len then do; /* too long, may have hidden - */ 471 j = index (substr (tmp_char, cur_pos, i), "-"); 472 if j <= 0 then 473 call error (linus_error_$long_id); /* is bad */ 474 if j > mrds_data_$max_id_len then 475 call error (linus_error_$long_id); /* if first part too long */ 476 else do; /* first part ok */ 477 i = j - 1; 478 j = 0; 479 end; 480 end; /* if orig. id. too long */ 481 else j = index (substr (tmp_char, cur_pos, i), "-"); /* see if there is second choice */ 482 if j > 0 then do; /* yes, set true length */ 483 j = j - 1; 484 tmp_len = j + 1; /* remember -- you may have to back up start_pos */ 485 call set_token (COL_SPEC, j); 486 end; 487 else do; 488 call set_token (COL_SPEC, i); 489 tmp_len = i + 1; /* remember -- you may have to back up start_pos */ 490 end; 491 492 do k = 1 to select_info.n_user_items 493 while (select_info.user_item.name (k) ^= f_choice); 494 end; 495 if k > select_info.n_user_items then do; 496 do k = 1 to select_info.n_user_items 497 while (select_info.user_item.name (k) ^= s_choice); 498 end; 499 end; 500 501 if k > select_info.n_user_items then do; 502 start_pos = start_pos - tmp_len; 503 if tmp_len = i + 1 /* length of first choice */ 504 then do; 505 token_data.key = NULL; 506 start_pos = string_len + 1; 507 end; 508 end; 509 510 token_data.length = k; /* return index to mrds item */ 511 512 end ident_proc; 513 514 error: 515 proc (cd); 516 517 /* Error procedure */ 518 519 dcl cd fixed bin (35); 520 521 code = cd; 522 go to real_exit; 523 524 end error; 525 526 527 end linus_modify_gt; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 07/29/86 0940.0 linus_modify_gt.pl1 >special_ldd>install>MR12.0-1106>linus_modify_gt.pl1 41 1 07/29/86 0937.8 linus_lcb.incl.pl1 >special_ldd>install>MR12.0-1106>linus_lcb.incl.pl1 43 2 09/16/83 1338.0 linus_select_info.incl.pl1 >ldd>include>linus_select_info.incl.pl1 45 3 03/27/82 0434.5 linus_token_data.incl.pl1 >ldd>include>linus_token_data.incl.pl1 47 4 03/27/82 0434.5 linus_variables.incl.pl1 >ldd>include>linus_variables.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. ARITH_CHARS 000227 constant char(14) initial unaligned dcl 63 ref 436 445 ARITH_START 000220 constant char(11) initial unaligned dcl 68 ref 408 COL_SPEC constant fixed bin(17,0) initial dcl 3-13 set ref 485* 488* CONST constant fixed bin(17,0) initial dcl 3-13 ref 195 236 433 CONS_PREC 000224 constant char(5) initial unaligned dcl 67 ref 415 DELIMS 000226 constant char(3) initial unaligned dcl 65 ref 92 232 410 DIV constant fixed bin(17,0) initial dcl 3-13 set ref 311* ID_CHARS 000200 constant char(64) initial unaligned dcl 69 ref 161 466 LINUS_VAR constant fixed bin(17,0) initial dcl 3-13 ref 158 LP constant fixed bin(17,0) initial dcl 3-13 set ref 226 272 272* MINUS 000233 constant fixed bin(17,0) initial dcl 3-13 set ref 293* NULL constant fixed bin(17,0) initial dcl 3-13 ref 89 376 505 PLUS 000234 constant fixed bin(17,0) initial dcl 3-13 set ref 287* RP constant fixed bin(17,0) initial dcl 3-13 set ref 276* STAR 000235 constant fixed bin(17,0) initial dcl 3-13 set ref 280* addr builtin function dcl 85 ref 197 238 394 434 492 496 cd parameter fixed bin(35,0) dcl 519 ref 514 521 code parameter fixed bin(35,0) dcl 51 set ref 18 381* 521* collate builtin function dcl 85 ref 96 cur_pos 000104 automatic fixed bin(35,0) dcl 51 set ref 94* 96 160* 160 161 169 175 181 191 197 199* 199 201 204* 204 205 207 208* 208 210 210 218 219* 219 222 228 230 232 234 238 239* 239 241 246* 246 247 249 251* 251 253 253 259* 259 265 266* 266 269 394 395 408 410 434 436 437 440 440 440 445 446 452 466 467 471 481 492 496 f_choice based char unaligned dcl 462 ref 492 flag 000125 automatic bit(1) unaligned dcl 406 set ref 413* 415* 417* 419* 421 found 000105 automatic bit(1) unaligned dcl 61 set ref 198* 202 205* 214* 216 240* 243 258* 263 i 000144 automatic fixed bin(17,0) dcl 461 in procedure "ident_proc" set ref 466* 467 467* 469* 469 470 471 477* 481 488* 489 492 503 i 000134 automatic fixed bin(17,0) dcl 431 in procedure "arith_const" set ref 436* 437 437* 440 440 440 445 446* 448* 448 451 452 i 000124 automatic fixed bin(17,0) dcl 405 in procedure "is_const" set ref 410* 410* 413 415 i 000102 automatic fixed bin(35,0) dcl 51 in procedure "linus_modify_gt" set ref 92* 93 94 161* 163 175* 177 180 201* 202 203 204 210* 212* 228* 230 230 232 234 237 239 241* 243 244 246 253* 255* 259 260 index builtin function dcl 85 ref 96 175 201 210 241 253 408 410 415 471 481 j 000145 automatic fixed bin(17,0) dcl 461 in procedure "ident_proc" set ref 465* 471* 472 474 477 478* 481* 482 483* 483 484 485* 496 j 000103 automatic fixed bin(35,0) dcl 51 in procedure "linus_modify_gt" set ref 169* 169* 174 181* 181* 185 192 232* 234 237 239 j 000135 automatic fixed bin(17,0) dcl 431 in procedure "arith_const" set ref 435* 445* 446 448 k 000146 automatic fixed bin(17,0) dcl 461 set ref 492* 492* 495 496* 496* 501 510 key based fixed bin(17,0) level 2 in structure "token_data" packed unaligned dcl 3-3 in procedure "linus_modify_gt" set ref 89* 158* 195* 226* 236* 272 376* 392* 433* 505* key parameter fixed bin(17,0) dcl 390 in procedure "set_token" ref 385 392 lcb based structure level 1 dcl 1-53 lcb_ptr parameter pointer dcl 1-121 ref 18 164 166 length 23 based fixed bin(35,0) level 2 in structure "token_data" dcl 3-3 in procedure "linus_modify_gt" set ref 163* 169 175 180* 181 188 191 192* 200* 203* 203 209* 209 220* 220 237* 244* 244 252* 252 260* 260 267* 267 393* 451* 510* length parameter fixed bin(17,0) dcl 390 in procedure "set_token" ref 385 393 395 linus_error_$inv_string_const 000020 external static fixed bin(35,0) dcl 75 set ref 216* 247* 263* linus_error_$invalid_token 000010 external static fixed bin(35,0) dcl 75 set ref 99* linus_error_$linus_var_not_defined 000014 external static fixed bin(35,0) dcl 75 set ref 164* 167* 177* 185* linus_error_$long_id 000012 external static fixed bin(35,0) dcl 75 set ref 472* 474* linus_error_$long_lv_name 000016 external static fixed bin(35,0) dcl 75 set ref 188* lv_ptr 32 based pointer level 2 in structure "lcb" dcl 1-53 in procedure "linus_modify_gt" ref 164 166 lv_ptr 000100 automatic pointer dcl 4-14 in procedure "linus_modify_gt" set ref 166* 167 169 169 174 181 181 185 mrds_data_$max_id_len 000022 external static fixed bin(35,0) dcl 75 ref 188 470 474 must_free 0(18) based bit(1) level 2 packed unaligned dcl 3-3 set ref 88* n_user_items 17 based fixed bin(17,0) level 2 dcl 2-5 ref 492 495 496 501 name based varying char(32) array level 3 in structure "select_info" dcl 2-5 in procedure "linus_modify_gt" ref 492 496 name 2 based char(32) array level 3 in structure "variables" dcl 4-3 in procedure "linus_modify_gt" ref 169 181 nmi_alloc 13 based fixed bin(17,0) level 2 dcl 2-5 ref 492 496 nsv_alloc 12 based fixed bin(17,0) level 2 dcl 2-5 ref 492 496 null builtin function dcl 85 ref 164 nvars 1 based fixed bin(17,0) level 2 dcl 4-3 ref 167 169 174 181 185 s_choice based char unaligned dcl 463 ref 496 select_info based structure level 1 dcl 2-5 si_ptr parameter pointer dcl 2-49 ref 18 492 492 495 496 496 501 start_pos parameter fixed bin(35,0) dcl 51 set ref 18 89 92 94 191* 222* 269* 377* 395* 452* 502* 502 506* start_ptr parameter pointer dcl 49 ref 18 92 96 161 169 175 181 197 201 207 210 218 228 230 232 234 238 241 249 253 265 394 408 410 415 434 436 440 440 440 445 466 471 481 492 496 string_len parameter fixed bin(17,0) dcl 59 ref 18 89 92 161 169 175 181 201 205 210 210 228 232 241 247 253 253 377 436 437 445 446 466 467 471 481 506 substr builtin function dcl 85 ref 92 161 169 175 181 201 210 228 232 241 253 436 445 466 471 481 t_ptr 24 based pointer level 2 dcl 3-3 set ref 197* 238* 394* 434* td_ptr parameter pointer dcl 3-49 ref 18 88 89 158 163 169 175 180 181 188 191 192 195 197 200 203 203 209 209 220 220 226 236 237 238 244 244 252 252 260 260 267 267 272 376 392 393 394 433 434 451 505 510 tmp_char based char unaligned dcl 72 ref 92 161 169 175 181 201 210 228 232 241 253 436 445 466 471 481 tmp_char_arr based char(1) array unaligned dcl 73 set ref 96 197 207 218 230 234 238 249 265 394 408 410 415 434 440 440 440 492 496 tmp_len 000147 automatic fixed bin(17,0) dcl 461 set ref 484* 489* 502 503 token_data based structure level 1 dcl 3-3 user_item based structure array level 2 dcl 2-5 var_info 2 based structure array level 2 dcl 4-3 variables based structure level 1 dcl 4-3 verify builtin function dcl 85 ref 92 161 228 232 436 445 466 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. AND internal static fixed bin(17,0) initial dcl 3-13 COMMA internal static fixed bin(17,0) initial dcl 3-13 DIFFER internal static fixed bin(17,0) initial dcl 3-13 DUP internal static fixed bin(17,0) initial dcl 3-13 EQ internal static fixed bin(17,0) initial dcl 3-13 FROM internal static fixed bin(17,0) initial dcl 3-13 GE internal static fixed bin(17,0) initial dcl 3-13 GT internal static fixed bin(17,0) initial dcl 3-13 INTER internal static fixed bin(17,0) initial dcl 3-13 LB internal static fixed bin(17,0) initial dcl 3-13 LE internal static fixed bin(17,0) initial dcl 3-13 LT internal static fixed bin(17,0) initial dcl 3-13 NE internal static fixed bin(17,0) initial dcl 3-13 NOT internal static fixed bin(17,0) initial dcl 3-13 OR internal static fixed bin(17,0) initial dcl 3-13 RB internal static fixed bin(17,0) initial dcl 3-13 ROW_DES internal static fixed bin(17,0) initial dcl 3-13 ROW_TAB_PAIR internal static fixed bin(17,0) initial dcl 3-13 SCAL_FN internal static fixed bin(17,0) initial dcl 3-13 SELECT internal static fixed bin(17,0) initial dcl 3-13 SET_FN internal static fixed bin(17,0) initial dcl 3-13 TAB_NAME internal static fixed bin(17,0) initial dcl 3-13 UNION internal static fixed bin(17,0) initial dcl 3-13 UNIQUE internal static fixed bin(17,0) initial dcl 3-13 WHERE internal static fixed bin(17,0) initial dcl 3-13 fixed builtin function dcl 85 nmi_init automatic fixed bin(17,0) dcl 2-48 nsv_init automatic fixed bin(17,0) dcl 2-48 nui_init automatic fixed bin(17,0) dcl 2-48 nvars_init automatic fixed bin(17,0) dcl 4-15 rel builtin function dcl 85 sys_info$max_seg_size external static fixed bin(35,0) dcl 75 NAMES DECLARED BY EXPLICIT CONTEXT. arith_const 001674 constant entry internal dcl 425 ref 284 290 296 char_proc 000000 constant label array(128) dcl 99 ref 96 error 002346 constant entry internal dcl 514 ref 99 164 167 177 185 188 216 247 263 472 474 exit 001526 constant label dcl 372 ref 193 223 274 278 282 288 294 309 313 369 ident_proc 002034 constant entry internal dcl 456 ref 316 is_const 001566 constant entry internal dcl 399 ref 284 290 linus_modify_gt 000321 constant entry external dcl 18 real_exit 001536 constant label dcl 382 ref 522 set_token 001537 constant entry internal dcl 385 ref 272 276 280 287 293 311 485 488 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 3554 3600 3445 3564 Length 4062 3445 24 246 106 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME linus_modify_gt 140 external procedure is an external procedure. set_token internal procedure shares stack frame of external procedure linus_modify_gt. is_const internal procedure shares stack frame of external procedure linus_modify_gt. arith_const internal procedure shares stack frame of external procedure linus_modify_gt. ident_proc internal procedure shares stack frame of external procedure linus_modify_gt. error internal procedure shares stack frame of external procedure linus_modify_gt. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME linus_modify_gt 000100 lv_ptr linus_modify_gt 000102 i linus_modify_gt 000103 j linus_modify_gt 000104 cur_pos linus_modify_gt 000105 found linus_modify_gt 000124 i is_const 000125 flag is_const 000134 i arith_const 000135 j arith_const 000144 i ident_proc 000145 j ident_proc 000146 k ident_proc 000147 tmp_len ident_proc THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. return ext_entry NO EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. linus_error_$inv_string_const linus_error_$invalid_token linus_error_$linus_var_not_defined linus_error_$long_id linus_error_$long_lv_name mrds_data_$max_id_len LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 18 000313 88 000326 89 000332 92 000341 93 000367 94 000370 96 000377 99 000410 158 000416 160 000423 161 000427 163 000455 164 000464 166 000501 167 000506 169 000517 173 000545 174 000552 175 000556 177 000576 180 000606 181 000617 184 000645 185 000652 188 000665 191 000702 192 000711 193 000713 195 000714 197 000717 198 000725 199 000726 200 000732 201 000736 202 000764 203 000772 204 001001 205 001005 207 001012 208 001020 209 001024 210 001030 212 001057 213 001060 214 001061 215 001063 216 001064 218 001075 219 001105 220 001111 222 001117 223 001121 226 001122 228 001125 230 001142 232 001153 234 001202 236 001207 237 001212 238 001220 239 001225 240 001231 241 001232 243 001257 244 001266 246 001275 247 001301 249 001312 251 001322 252 001326 253 001334 255 001363 256 001364 258 001365 259 001367 260 001373 262 001401 263 001402 265 001413 266 001423 267 001427 269 001435 272 001437 274 001450 276 001451 278 001455 280 001456 282 001462 284 001463 287 001473 288 001477 290 001500 293 001510 294 001514 296 001515 309 001516 311 001517 313 001523 316 001524 369 001525 376 001526 377 001531 381 001534 382 001536 385 001537 392 001541 393 001547 394 001552 395 001561 397 001565 399 001566 408 001570 410 001605 412 001633 413 001636 415 001644 417 001663 418 001664 419 001665 421 001666 425 001674 433 001675 434 001702 435 001712 436 001713 437 001732 440 001743 445 001762 446 002011 448 002022 451 002023 452 002027 454 002033 456 002034 465 002035 466 002036 467 002065 469 002076 470 002100 471 002104 472 002116 474 002125 477 002140 478 002142 480 002143 481 002144 482 002156 483 002160 484 002162 485 002165 486 002167 488 002170 489 002172 492 002175 494 002240 495 002242 496 002250 498 002310 501 002312 502 002320 503 002326 505 002332 506 002336 510 002341 512 002345 514 002346 521 002350 522 002353 ----------------------------------------------------------- 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