COMPILATION LISTING OF SEGMENT db_sym Compiled by: Multics PL/I Compiler, Release 29, of July 28, 1986 Compiled at: Honeywell Multics Op. - System M Compiled on: 11/05/86 1030.1 mst Wed Options: optimize map 1 /* *********************************************************** 2* * * 3* * Copyright, (C) Honeywell Information Systems Inc., 1982 * 4* * * 5* * Copyright (c) 1972 by Massachusetts Institute of * 6* * Technology and Honeywell Information Systems, Inc. * 7* * * 8* *********************************************************** */ 9 10 11 db_sym: proc (line, a_sntp, data_ptr, offset, type, type_char, mode, a_size, m_size, code); 12 13 14 /* Modified Nov 72 to convert to PL/I V2 by R Coren. 15* * Modified Nov 72 for 6180 (remove check entry ) by Bill Silver. 16* * Modified 10/76 to add COBOL data types by S. Barr. */ 17 /* Changed to test for Version 1/pascal symbol table before testing data_ptr 10/14/83 S. Herbst */ 18 dcl line char (72) varying, 19 a_sntp ptr, 20 data_ptr ptr, 21 offset fixed bin, 22 type_char char (1) aligned, 23 mode char (*) aligned, 24 size fixed bin, 25 a_size fixed bin, 26 m_size fixed bin, 27 code fixed bin; 28 29 30 dcl (addr, addrel, baseno, divide, fixed, length, min, null, ptr, rel, substr, unspec) builtin; 31 32 dcl var_flag fixed bin; 33 34 dcl (type, n, i, j, steps) fixed bin, 35 f17 fixed bin based, 36 (p, stack_pt, found_block, symbol_pt, ref_pt) ptr, 37 current_block ptr, 38 packed_ptr based unaligned ptr, 39 based_ptr based ptr, 40 bn bit (18) aligned, 41 db_get_sym ext entry (ptr), 42 stu_$find_runtime_symbol entry (ptr, char (*) aligned, ptr, fixed bin) returns (ptr), 43 stu_$get_runtime_address entry (ptr, ptr, ptr, ptr, ptr, ptr, ptr) returns (ptr), 44 stu_$offset_to_pointer entry (ptr, ptr, ptr, ptr, ptr, ptr) returns (ptr), 45 stu_$decode_runtime_value entry (fixed bin, ptr, ptr, ptr, ptr, ptr, fixed bin) returns (fixed bin); 46 47 dcl decode_type char (32) int static aligned 48 init ("oddfooooooooopoppoobvavoiiip"); 49 /* */ 1 1 /* BEGIN INCLUDE FILE ... db_snt.incl.pl1 Last modified Nov 1972. WSS */ 1 2 /* Modified 8/75 to add internal static pointer by S.E. Barr */ 1 3 1 4 1 5 /* Overlay of segment name table. */ 1 6 1 7 dcl sntp ptr; /* Pointer to segment name table. */ 1 8 1 9 dcl 1 snt based (sntp) aligned, 1 10 2 ent_pt_name char(32), /* Entry point name. */ 1 11 2 ent_name char(32), /* Entry name of segment. */ 1 12 2 dir_name char(168), /* Directory name. */ 1 13 2 pp ptr, /* Pointer to current procedure. */ 1 14 2 sp ptr, /* Pointer to current stack frame. */ 1 15 2 lp ptr, /* Pointer to linkage section. */ 1 16 2 symp ptr, /* Pointer to current symbol table block. */ 1 17 2 symflag bit(1) unal, /* ON => no symbol table defined. */ 1 18 2 std bit(1) unal, /* ON => standard symbol header. */ 1 19 2 headp ptr, /* Pointer to current symbol header. */ 1 20 2 static_ptr ptr; /* Pointer to current static section. */ 1 21 1 22 /* END OF INCLUDE FILE... db_snt.incl.pl1 */ 50 51 /* */ 2 1 /* BEGIN INCLUDE FILE ... stack_frame.incl.pl1 ... */ 2 2 2 3 /* format: off */ 2 4 2 5 /* Modified: 16 Dec 1977, D. Levin - to add fio_ps_ptr and pl1_ps_ptr */ 2 6 /* Modified: 3 Feb 1978, P. Krupp - to add run_unit_manager bit & main_proc bit */ 2 7 /* Modified: 21 March 1978, D. Levin - change fio_ps_ptr to support_ptr */ 2 8 /* Modified: 03/01/84, S. Herbst - Added RETURN_PTR_MASK */ 2 9 2 10 2 11 /****^ HISTORY COMMENTS: 2 12* 1) change(86-09-15,Kissel), approve(86-09-15,MCR7473), 2 13* audit(86-10-01,Fawcett), install(86-11-03,MR12.0-1206): 2 14* Modified to add constants for the translator_id field in the stack_frame 2 15* structure. 2 16* END HISTORY COMMENTS */ 2 17 2 18 2 19 dcl RETURN_PTR_MASK bit (72) int static options (constant) /* mask to be AND'd with stack_frame.return_ptr */ 2 20 init ("777777777777777777000000"b3); /* when copying, to ignore bits that a call fills */ 2 21 /* with indicators (nonzero for Fortran hexfp caller) */ 2 22 /* say: unspec(ptr) = unspec(stack_frame.return_ptr) & RETURN_PTR_MASK; */ 2 23 2 24 dcl TRANSLATOR_ID_PL1V2 bit (18) internal static options (constant) init ("000000"b3); 2 25 dcl TRANSLATOR_ID_ALM bit (18) internal static options (constant) init ("000001"b3); 2 26 dcl TRANSLATOR_ID_PL1V1 bit (18) internal static options (constant) init ("000002"b3); 2 27 dcl TRANSLATOR_ID_SIGNAL_CALLER bit (18) internal static options (constant) init ("000003"b3); 2 28 dcl TRANSLATOR_ID_SIGNALLER bit (18) internal static options (constant) init ("000004"b3); 2 29 2 30 2 31 dcl sp pointer; /* pointer to beginning of stack frame */ 2 32 2 33 dcl stack_frame_min_length fixed bin static init(48); 2 34 2 35 2 36 dcl 1 stack_frame based(sp) aligned, 2 37 2 pointer_registers(0 : 7) ptr, 2 38 2 prev_sp pointer, 2 39 2 next_sp pointer, 2 40 2 return_ptr pointer, 2 41 2 entry_ptr pointer, 2 42 2 operator_and_lp_ptr ptr, /* serves as both */ 2 43 2 arg_ptr pointer, 2 44 2 static_ptr ptr unaligned, 2 45 2 support_ptr ptr unal, /* only used by fortran I/O */ 2 46 2 on_unit_relp1 bit(18) unaligned, 2 47 2 on_unit_relp2 bit(18) unaligned, 2 48 2 translator_id bit(18) unaligned, /* Translator ID (see constants above) 2 49* 0 => PL/I version II 2 50* 1 => ALM 2 51* 2 => PL/I version I 2 52* 3 => signal caller frame 2 53* 4 => signaller frame */ 2 54 2 operator_return_offset bit(18) unaligned, 2 55 2 x(0: 7) bit(18) unaligned, /* index registers */ 2 56 2 a bit(36), /* accumulator */ 2 57 2 q bit(36), /* q-register */ 2 58 2 e bit(36), /* exponent */ 2 59 2 timer bit(27) unaligned, /* timer */ 2 60 2 pad bit(6) unaligned, 2 61 2 ring_alarm_reg bit(3) unaligned; 2 62 2 63 2 64 dcl 1 stack_frame_flags based(sp) aligned, 2 65 2 pad(0 : 7) bit(72), /* skip over prs */ 2 66 2 xx0 bit(22) unal, 2 67 2 main_proc bit(1) unal, /* on if frame belongs to a main procedure */ 2 68 2 run_unit_manager bit(1) unal, /* on if frame belongs to run unit manager */ 2 69 2 signal bit(1) unal, /* on if frame belongs to logical signal_ */ 2 70 2 crawl_out bit(1) unal, /* on if this is a signal caller frame */ 2 71 2 signaller bit(1) unal, /* on if next frame is signaller's */ 2 72 2 link_trap bit(1) unal, /* on if this frame was made by the linker */ 2 73 2 support bit(1) unal, /* on if frame belongs to a support proc */ 2 74 2 condition bit(1) unal, /* on if condition established in this frame */ 2 75 2 xx0a bit(6) unal, 2 76 2 xx1 fixed bin, 2 77 2 xx2 fixed bin, 2 78 2 xx3 bit(25) unal, 2 79 2 old_crawl_out bit (1) unal, /* on if this is a signal caller frame */ 2 80 2 old_signaller bit(1) unal, /* on if next frame is signaller's */ 2 81 2 xx3a bit(9) unaligned, 2 82 2 xx4(9) bit(72) aligned, 2 83 2 v2_pl1_op_ret_base ptr, /* When a V2 PL/I program calls an operator the 2 84* * operator puts a pointer to the base of 2 85* * the calling procedure here. (text base ptr) */ 2 86 2 xx5 bit(72) aligned, 2 87 2 pl1_ps_ptr ptr; /* ptr to ps for this frame; also used by fio. */ 2 88 2 89 /* format: on */ 2 90 2 91 /* END INCLUDE FILE ... stack_frame.incl.pl1 */ 52 3 1 /* BEGIN INCLUDE FILE ... picture_image.incl.pl1 3 2* 3 3* James R. Davis 12 Mar 79 3 4**/ 3 5 3 6 dcl 1 picture_image aligned based, 3 7 2 type fixed bin (8) unal, 3 8 2 prec fixed bin (8) unal, /* precision or length of associated value */ 3 9 2 scale fixed bin (8) unal, /* for both fixed and float pictures, 3 10* =ndigits after "v" - scale_factor */ 3 11 2 piclength fixed bin (8) unal, /* length of picture_constant.chars, <64 3 12* =length of normalized-picture-string */ 3 13 2 varlength fixed bin (8) unal, /* length of pictured variable in chars, <64 3 14* =length of normalized_picture_string - "k" and "v" */ 3 15 2 scalefactor fixed bin (8) unal, /* value of pict-sc-f, -256<=x<256 */ 3 16 2 explength fixed bin (8) unal, /* length of exp field for float */ 3 17 2 drift_character char (1) unal, 3 18 2 chars char (0 refer (picture_image.piclength)) aligned; 3 19 3 20 dcl ( 3 21 picture_char_type init (24), 3 22 picture_realfix_type init (25), 3 23 picture_complexfix_type 3 24 init (26), 3 25 picture_realflo_type init (27), 3 26 picture_complexflo_type 3 27 init (28) 3 28 ) fixed bin (8) unal static internal options (constant); 3 29 3 30 /* END INCLUDE FILE ... picture_image.incl.pl1 */ 53 54 /* */ 4 1 dcl 1 symbol_node aligned based, 4 2 2 type unal bit(12), /* data type */ 4 3 2 level unal bit(6), /* structure level */ 4 4 2 ndims unal bit(6), /* number of dimensions */ 4 5 2 bits unal, 4 6 3 aligned bit(1), 4 7 3 packed bit(1), 4 8 3 simple bit(1), 4 9 3 decimal bit(1), 4 10 2 scale unal bit(8), /* arithmetic scale factor */ 4 11 2 name unal bit(18), /* rel ptr to acc name */ 4 12 2 brother unal bit(18), /* rel ptr to brother entry */ 4 13 2 father unal bit(18), /* rel ptr to father entry */ 4 14 2 son unal bit(18), /* rel ptr to son entry */ 4 15 2 address unal, 4 16 3 offset bit(18), /* offset in storage class */ 4 17 3 class bit(4), /* storage class */ 4 18 3 next bit(14), /* rel ptr to next of same class */ 4 19 2 size fixed bin(35), /* encoded string|arith size */ 4 20 2 word_offset fixed bin(35), /* encoded offset from address */ 4 21 2 bit_offset fixed bin(35), 4 22 2 virtual_org fixed bin(35), 4 23 2 bounds(1), 4 24 3 lower fixed bin(35), /* encoded lower bound */ 4 25 3 upper fixed bin(35), /* encoded upper bound */ 4 26 3 multiplier fixed bin(35); /* encoded multiplier */ 4 27 4 28 dcl 1 sym_bound based, 4 29 2 lower fixed bin(35), 4 30 2 upper fixed bin(35), 4 31 2 multiplier fixed bin(35); 4 32 4 33 dcl 1 symbol_block aligned based, 4 34 2 type unal bit(12), /* = 0 for a block node */ 4 35 2 number unal bit(6), /* begin block number */ 4 36 2 start unal bit(18), /* rel ptr to start of symbols */ 4 37 2 name unal bit(18), /* rel ptr to name of proc */ 4 38 2 brother unal bit(18), /* rel ptr to brother block */ 4 39 2 father unal bit(18), /* rel ptr to father block */ 4 40 2 son unal bit(18), /* rel ptr to son block */ 4 41 2 map unal, 4 42 3 first bit(18), /* rel ptr to first word of map */ 4 43 3 last bit(18), /* rel ptr to last word of map */ 4 44 2 bits unal bit(18), 4 45 2 header unal bit(18), /* rel ptr to symbol header */ 4 46 2 chain(4) unal bit(18), /* chain(i) is rel ptr to first symbol 4 47* on start list with length >= 2**i */ 4 48 2 class_list(0:15) unal bit(18); /* rel ptrs to first symbol of given 4 49* storage class */ 55 56 /* */ 5 1 /* BEGIN INCLUDE FILE ... runtime_symbol.incl.pl1 ... Modified 07/79 */ 5 2 5 3 dcl 1 runtime_symbol aligned based, 5 4 2 flag unal bit(1), /* always "1"b for Version II */ 5 5 2 use_digit unal bit(1), /* if "1"b and units are half words units are really digits */ 5 6 2 array_units unal bit(2), 5 7 2 units unal bit(2), /* addressing units */ 5 8 2 type unal bit(6), /* data type */ 5 9 2 level unal bit(6), /* structure level */ 5 10 2 ndims unal bit(6), /* number of dimensions */ 5 11 2 bits unal, 5 12 3 aligned bit(1), 5 13 3 packed bit(1), 5 14 3 simple bit(1), 5 15 2 skip unal bit(1), 5 16 2 scale unal bit(8), /* arithmetic scale factor */ 5 17 2 name unal bit(18), /* rel ptr to acc name */ 5 18 2 brother unal bit(18), /* rel ptr to brother entry */ 5 19 2 father unal bit(18), /* rel ptr to father entry */ 5 20 2 son unal bit(18), /* rel ptr to son entry */ 5 21 2 address unal, 5 22 3 location bit(18), /* location in storage class */ 5 23 3 class bit(4), /* storage class */ 5 24 3 next bit(14), /* rel ptr to next of same class */ 5 25 2 size fixed bin(35), /* encoded string|arith size */ 5 26 2 offset fixed bin(35), /* encoded offset from address */ 5 27 2 virtual_org fixed bin(35), 5 28 2 bounds(1), 5 29 3 lower fixed bin(35), /* encoded lower bound */ 5 30 3 upper fixed bin(35), /* encoded upper bound */ 5 31 3 multiplier fixed bin(35); /* encoded multiplier */ 5 32 5 33 dcl 1 runtime_bound based, 5 34 2 lower fixed bin(35), 5 35 2 upper fixed bin(35), 5 36 2 multiplier fixed bin(35); 5 37 5 38 dcl 1 runtime_block aligned based, 5 39 2 flag unal bit(1), /* always "1"b for Version II */ 5 40 2 quick unal bit(1), /* "1"b if quick block */ 5 41 2 fortran unal bit(1), /* "1"b if fortran program */ 5 42 2 standard unal bit(1), /* "1"b if program has std obj segment */ 5 43 2 owner_flag unal bit(1), /* "1"b if block has valid owner field */ 5 44 2 skip unal bit(1), 5 45 2 type unal bit(6), /* = 0 for a block node */ 5 46 2 number unal bit(6), /* begin block number */ 5 47 2 start unal bit(18), /* rel ptr to start of symbols */ 5 48 2 name unal bit(18), /* rel ptr to name of proc */ 5 49 2 brother unal bit(18), /* rel ptr to brother block */ 5 50 2 father unal bit(18), /* rel ptr to father block */ 5 51 2 son unal bit(18), /* rel ptr to son block */ 5 52 2 map unal, 5 53 3 first bit(18), /* rel ptr to first word of map */ 5 54 3 last bit(18), /* rel ptr to last word of map */ 5 55 2 entry_info unal bit(18), /* info about entry of quick block */ 5 56 2 header unal bit(18), /* rel ptr to symbol header */ 5 57 2 chain(4) unal bit(18), /* chain(i) is rel ptr to first symbol 5 58* on start list with length >= 2**i */ 5 59 2 token(0:5) unal bit(18), /* token(i) is rel ptr to first token 5 60* on list with length >= 2 ** i */ 5 61 2 owner unal bit(18); /* rel ptr to owner block */ 5 62 5 63 dcl 1 runtime_token aligned based, 5 64 2 next unal bit(18), /* rel ptr to next token */ 5 65 2 dcl unal bit(18), /* rel ptr to first dcl of this token */ 5 66 2 name, /* ACC */ 5 67 3 size unal unsigned fixed bin (9), /* number of chars in token */ 5 68 3 string unal char(n refer(runtime_token.size)); 5 69 5 70 dcl 1 encoded_value aligned based, 5 71 2 flag bit (2) unal, 5 72 2 code bit (4) unal, 5 73 2 n1 bit (6) unal, 5 74 2 n2 bit (6) unal, 5 75 2 n3 bit (18) unal; 5 76 5 77 /* END INCLUDE FILE ... runtime_symbol.incl.pl1 */ 57 6 1 dcl 1 frame aligned based, 6 2 2 pointers(0:7) ptr, 6 3 2 back ptr, 6 4 2 next ptr, 6 5 2 return ptr, 6 6 2 entry ptr, 6 7 2 operator ptr, 6 8 2 argptr ptr, 6 9 2 skip1(2) fixed bin, 6 10 2 on_unit_info(2) bit(18) unaligned, 6 11 2 translator_id bit(18) unaligned, 6 12 2 operator_return bit(18) unaligned, 6 13 2 display ptr, 6 14 2 skip2(2) fixed bin, 6 15 2 linkage ptr; 58 59 /* */ 60 sntp = a_sntp; /* copy arg. */ 61 if sntp -> snt.symflag then call db_get_sym (sntp); /* attempt to get symbol pointer */ 62 current_block = sntp -> snt.symp; 63 64 if current_block = null 65 then do; 66 err2: code = 2; /* no symbol table */ 67 return; 68 end; 69 70 if baseno (sntp -> snt.lp) = "0"b then sntp -> snt.lp = null; 71 72 code = 0; 73 74 symbol_pt = db_var (1, (1), data_ptr, ref_pt, stack_pt); 75 76 if symbol_pt = null 77 then do; 78 err1: code = 1; /* symbol not found */ 79 return; 80 end; 81 82 if data_ptr = null 83 then do; 84 err5: code = 5; /* couldn't get address */ 85 return; 86 end; 87 88 /* have Version II symbol node */ 89 90 type = fixed (symbol_pt -> runtime_symbol.type, 6); 91 92 if type = 38 | type = 39 then mode = "comp-5"; 93 else if type = 41 then mode = "comp-8"; 94 else if type = 63 then do; /* PICTURE */ 95 mode = "a"; 96 p = ptr (snt.pp, symbol_pt -> runtime_symbol.size); 97 size = p -> picture_image.varlength; 98 type = 21; 99 goto l2; 100 end; 101 else mode = substr (decode_type, type+1, 1); 102 var_flag = 0; 103 104 if mode = "p" then do; 105 if symbol_pt -> runtime_symbol.packed then size = 36; 106 else size = 72; 107 go to l2; 108 end; 109 110 if mode = "v" then do; 111 var_flag = 1; 112 mode = substr (decode_type, type, 1); 113 a_size = data_ptr -> f17; 114 data_ptr = addrel (data_ptr, 1); 115 type = type - 1; 116 end; 117 118 size = symbol_pt -> symbol_node.size; 119 if size < 0 120 then do; 121 size = stu_$decode_runtime_value (size, found_block, stack_pt, 122 sntp -> snt.lp, sntp -> snt.pp, ref_pt, code); 123 if code ^= 0 then do; 124 code = 6; 125 return; 126 end; 127 end; 128 129 130 if type = 3|type = 4 then size = size + 8; /* floating-point, add in bits for exp */ 131 132 else if type = 14 then size = 36; /* offset must be one fullword */ 133 134 /* packed decimal */ 135 else if type = 38 then size = divide (size*9, 2, 17, 0); /* unsigned */ 136 else if type = 39 | type = 41 then size = divide ((size+1)*9, 2, 17, 0); /* sign uses one digit */ 137 138 else if mode ^= "a" & mode ^= "b" then do; 139 if ^symbol_pt -> symbol_node.packed then /* unpacked, round size up to word */ 140 if size < 36 then size = 36; 141 else size = 72; 142 else size = size + 1; /* add sign bit to precision */ 143 end; 144 145 l2: bn = baseno (data_ptr); 146 147 m_size = size; 148 if var_flag = 0 then a_size = size; 149 else a_size = min (a_size, size); 150 151 if bn = baseno (sntp -> snt.sp) 152 then do; 153 type_char = "s"; 154 offset = fixed (rel (data_ptr), 18) - fixed (rel (sntp -> snt.sp), 18); 155 return; 156 end; 157 158 if bn = baseno (sntp -> snt.static_ptr) 159 then do; 160 type_char = "i"; 161 offset = fixed (rel (data_ptr), 18) - fixed (rel (sntp -> snt.static_ptr), 18); 162 return; 163 end; 164 165 if bn = baseno (sntp -> snt.lp) 166 then do; 167 type_char = "l"; 168 offset = fixed (rel (data_ptr), 18) - fixed (rel (sntp -> snt.lp), 18); 169 return; 170 end; 171 172 type_char = "i"; 173 offset = 0; 174 exit: return; 175 176 text_ref: data_ptr = ptr (sntp -> snt.pp, 0); 177 type_char = "t"; 178 mode = "i"; 179 goto l1; 180 181 link_ref: if rel (sntp -> snt.lp) = (18)"0"b 182 then do; 183 err3: code = 3; /* no linkage */ 184 return; 185 end; 186 187 data_ptr = sntp -> snt.lp; 188 type_char = "l"; 189 190 l1: data_ptr = addrel (data_ptr, offset); 191 return; 192 193 err4: code = 4; /* no stack frame */ 194 return; 195 196 err7: code = 7; /* syntax error */ 197 return; 198 199 err8: code = 8; /* array error */ 200 return; 201 202 err9: code = 9; /* value error */ 203 return; 204 205 err10: code = 10; /* based error */ 206 return; 207 208 err11: code = 11; /* more than 64 structure levels */ 209 return; 210 211 err12: code = 12; /* symbol too long */ 212 return; 213 214 err13: code = 13; /* ambiguous reference */ 215 return; 216 217 err14: code = 14; /* entry constant */ 218 return; 219 220 err15: code = 15; /* unsupported symbol table format (V1, Pascal) */ 221 return; 222 223 db_var: proc (start_pos, end_pos, data_pt_out, ref_pt_out, stack_pt_out) returns (ptr); 224 225 dcl start_pos fixed bin, /* start index in line */ 226 end_pos fixed bin, /* finish index in line (output) */ 227 data_pt_out ptr, /* ptr to datum (output) */ 228 ref_pt_out ptr, /* ref ptr for datum (output) */ 229 stack_pt_out ptr; /* stack pointer for datum (output) */ 230 231 dcl (p, q, s_pt, d_pt, r_pt, sp, dummy_pt, subs_pt) ptr, 232 (pos, n, m, val, type, steps, subscript (32)) fixed bin, 233 (thru, nosign) bit (1), 234 ch char (1), 235 db_get_count$dec entry (char (*) aligned, fixed bin, fixed bin) returns (fixed bin); 236 237 dcl char_type (0: 127) fixed bin int static 238 init ((33)0, 1, (2)0, 1, (9)0, 1, 0, (10)2, (7)0, (26)1, (4)0, 1, 0, (26)1, (5)0); 239 240 /* char_type: 2 number 241* 1 letter ! $ . _ 242* 0 other 243* */ 244 245 dcl line_ char (72) aligned; 246 247 dcl fix_single fixed bin (17) based, 248 fix_double fixed bin (53) based, 249 flt_single float bin (27) based, 250 flt_double float bin (63) based; 251 252 pos = start_pos; 253 thru = "0"b; 254 r_pt, d_pt, s_pt = null; 255 256 again: call sob; 257 if thru then goto err7; 258 259 n = pos; 260 loop: ch = substr (line, pos, 1); 261 type = char_type (fixed (unspec (ch), 9)); 262 263 if type > 0 264 then do; 265 pos = pos + 1; 266 if pos <= length (line) then goto loop; 267 thru = "1"b; 268 end; 269 270 s_pt = stu_$find_runtime_symbol (current_block, substr (line, n, pos-n), found_block, steps); 271 272 if s_pt = null 273 then if steps = -2 then goto err11; 274 else if steps = -3 then goto err12; 275 else if steps = -5 then goto err13; 276 else goto err1; 277 278 if ^s_pt -> runtime_symbol.flag then go to err15; 279 280 subs_pt = null; 281 282 if thru 283 then do; 284 chk_tl: if n > 1 then goto ga; 285 286 offset = fixed (s_pt -> symbol_node.offset, 18); 287 288 if s_pt -> symbol_node.class = "1100"b /* check for label/entry constant */ 289 then if s_pt -> runtime_symbol.flag 290 then if s_pt -> runtime_symbol.type = "011000"b 291 then goto text_ref; /* label constant is simple */ 292 else if s_pt -> runtime_symbol.type = "011001"b 293 then go to err14; else; 294 else if s_pt -> symbol_node.type = "000000100101"b 295 then goto text_ref; 296 else if s_pt -> symbol_node.type = "000000100100"b 297 then go to err14; 298 299 if s_pt -> symbol_node.class = "1101"b 300 then if s_pt -> runtime_symbol.flag 301 then if s_pt -> runtime_symbol.type = "011010"b /* ext entry in */ 302 then go to err14; 303 else go to link_ref; 304 305 else if s_pt -> symbol_node.type = "000000100100"b /* likewise */ 306 then go to err14; 307 else go to link_ref; 308 309 goto ga; 310 end; 311 312 call sob; 313 if thru then goto chk_tl; 314 315 if ch ^= "(" then goto ga; 316 317 n = 1; 318 sub_loop: pos = pos + 1; 319 call sob; 320 if thru then goto err7; 321 322 val = 0; 323 nosign = "1"b; 324 type = char_type (fixed (unspec (ch), 9)); 325 326 if type ^= 1 then goto s1; 327 328 p = db_var (pos, pos, q, dummy_pt, dummy_pt); 329 330 if p = null then goto err1; 331 if q = null then goto err1; 332 333 if p -> runtime_symbol.flag then type = fixed (p -> runtime_symbol.type, 6); 334 else do; 335 type = fixed (p -> symbol_node.type, 12); 336 if type > 16 then type = type - 16; 337 end; 338 339 if type = 1 then val = q -> fix_single; 340 else if type = 2 then val = q -> fix_double; 341 else if type = 3 then val = q -> flt_single; 342 else if type = 4 then val = q -> flt_double; 343 else goto err9; 344 345 nosign = "0"b; 346 347 call sob; 348 if thru then goto err7; 349 350 s1: if ch = "+" | ch = "-" | (type = 2 & nosign) 351 then do; 352 line_ = line; 353 val = val + db_get_count$dec (line_, pos, pos); 354 call sob; 355 if thru then goto err7; 356 end; 357 358 subscript (n) = val; 359 360 if ch = "," 361 then do; 362 n = n + 1; 363 if n > 32 then goto err8; 364 goto sub_loop; 365 end; 366 367 if ch ^= ")" then goto err7; 368 369 if n ^= fixed (s_pt -> symbol_node.ndims, 6) then goto err8; 370 371 if current_block -> runtime_block.flag 372 then if current_block -> runtime_block.fortran 373 then do i = 1 to divide (n, 2, 17, 0); 374 m = subscript (i); 375 subscript (i) = subscript (n-i+1); 376 subscript (n-i+1) = m; 377 end; 378 379 subs_pt = addr (subscript (1)); 380 381 pos = pos + 1; 382 call sob; 383 384 ga: 385 sp = sntp -> snt.sp; 386 387 do i = 1 to steps while (sp ^= null); 388 sp = sp -> frame.display; 389 end; 390 391 392 d_pt = stu_$get_runtime_address (found_block, s_pt, sp, sntp -> snt.lp, 393 sntp -> snt.pp, r_pt, subs_pt); 394 395 if d_pt = null then goto err5; 396 397 if thru then goto done; 398 399 if substr (line, pos, 2) = "->" 400 then do; 401 pos = pos + 2; 402 403 if s_pt -> runtime_symbol.type = "001110"b /* offset */ 404 then do; 405 r_pt = stu_$offset_to_pointer (found_block, s_pt, d_pt, 406 sp, sntp -> snt.lp, sntp -> snt.pp); 407 go to again; 408 end; 409 410 if s_pt -> runtime_symbol.type ^= "001101"b 411 then if s_pt -> runtime_symbol.type ^= "011101"b 412 then goto err10; 413 if ^ s_pt -> runtime_symbol.flag 414 then if substr (s_pt -> symbol_node.type, 1, 6) 415 then goto err10; 416 if s_pt -> runtime_symbol.packed then r_pt = d_pt -> packed_ptr; 417 else r_pt = d_pt -> based_ptr; 418 goto again; 419 end; 420 421 done: end_pos = pos; 422 data_pt_out = d_pt; 423 ref_pt_out = r_pt; 424 stack_pt_out = sp; 425 return (s_pt); 426 427 sob: proc; 428 429 sl: if pos > length (line) 430 then do; 431 fini: thru = "1"b; 432 return; 433 end; 434 435 ch = substr (line, pos, 1); 436 if ch ^= " " then return; 437 pos = pos + 1; 438 goto sl; 439 end; 440 441 442 end db_var; 443 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/04/86 1042.2 db_sym.pl1 >special_ldd>install>MR12.0-1206>db_sym.pl1 50 1 11/06/75 1110.0 db_snt.incl.pl1 >ldd>include>db_snt.incl.pl1 52 2 11/03/86 1114.7 stack_frame.incl.pl1 >special_ldd>install>MR12.0-1206>stack_frame.incl.pl1 53 3 06/28/79 1204.8 picture_image.incl.pl1 >ldd>include>picture_image.incl.pl1 55 4 05/06/74 1752.6 symbol_node.incl.pl1 >ldd>include>symbol_node.incl.pl1 57 5 11/26/79 1320.6 runtime_symbol.incl.pl1 >ldd>include>runtime_symbol.incl.pl1 58 6 05/06/74 1752.6 stu_frame.incl.pl1 >ldd>include>stu_frame.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. a_size parameter fixed bin(17,0) dcl 18 set ref 11 113* 148* 149* 149 a_sntp parameter pointer dcl 18 ref 11 60 addr builtin function dcl 30 ref 379 addrel builtin function dcl 30 ref 114 190 address 3 based structure level 2 packed unaligned dcl 4-1 based_ptr based pointer dcl 34 ref 417 baseno builtin function dcl 30 ref 70 145 151 158 165 bits 0(24) based structure level 2 in structure "runtime_symbol" packed unaligned dcl 5-3 in procedure "db_sym" bits 0(24) based structure level 2 in structure "symbol_node" packed unaligned dcl 4-1 in procedure "db_sym" bn 000120 automatic bit(18) dcl 34 set ref 145* 151 158 165 ch 000170 automatic char(1) unaligned dcl 231 set ref 260* 261 315 324 350 350 360 367 435* 436 char_type 000000 constant fixed bin(17,0) initial array dcl 237 ref 261 324 class 3(18) based bit(4) level 3 packed unaligned dcl 4-1 ref 288 299 code parameter fixed bin(17,0) dcl 18 set ref 11 66* 72* 78* 84* 121* 123 124* 183* 193* 196* 199* 202* 205* 208* 211* 214* 217* 220* current_block 000116 automatic pointer dcl 34 set ref 62* 64 270* 371 371 d_pt 000106 automatic pointer dcl 231 set ref 254* 392* 395 405* 416 417 422 data_pt_out parameter pointer dcl 225 set ref 223 422* data_ptr parameter pointer dcl 18 set ref 11 74* 82 113 114* 114 145 154 161 168 176* 187* 190* 190 db_get_count$dec 000022 constant entry external dcl 231 ref 353 db_get_sym 000010 constant entry external dcl 34 ref 61 decode_type 000200 constant char(32) initial dcl 47 ref 101 112 display 40 based pointer level 2 dcl 6-1 ref 388 divide builtin function dcl 30 ref 135 136 371 dummy_pt 000114 automatic pointer dcl 231 set ref 328* 328* end_pos parameter fixed bin(17,0) dcl 225 set ref 223 421* f17 based fixed bin(17,0) dcl 34 ref 113 fix_double based fixed bin(53,0) dcl 247 ref 340 fix_single based fixed bin(17,0) dcl 247 ref 339 fixed builtin function dcl 30 ref 90 154 154 161 161 168 168 261 286 324 333 335 369 flag based bit(1) level 2 in structure "runtime_symbol" packed unaligned dcl 5-3 in procedure "db_sym" ref 278 288 299 333 413 flag based bit(1) level 2 in structure "runtime_block" packed unaligned dcl 5-38 in procedure "db_sym" ref 371 flt_double based float bin(63) dcl 247 ref 342 flt_single based float bin(27) dcl 247 ref 341 fortran 0(02) based bit(1) level 2 packed unaligned dcl 5-38 ref 371 found_block 000110 automatic pointer dcl 34 set ref 121* 270* 392* 405* frame based structure level 1 dcl 6-1 i 000102 automatic fixed bin(17,0) dcl 34 set ref 371* 374 375 375 376* 387* length builtin function dcl 30 ref 266 429 line parameter varying char(72) dcl 18 ref 11 260 266 270 270 352 399 429 435 line_ 000171 automatic char(72) dcl 245 set ref 352* 353* lp 76 based pointer level 2 dcl 1-9 set ref 70 70* 121* 165 168 181 187 392* 405* m 000122 automatic fixed bin(17,0) dcl 231 set ref 374* 376 m_size parameter fixed bin(17,0) dcl 18 set ref 11 147* min builtin function dcl 30 ref 149 mode parameter char dcl 18 set ref 11 92* 93* 95* 101* 104 110 112* 138 138 178* n 000121 automatic fixed bin(17,0) dcl 231 set ref 259* 270 270 270 270 284 317* 358 362* 362 363 369 371 375 376 ndims 0(18) based bit(6) level 2 packed unaligned dcl 4-1 ref 369 nosign 000167 automatic bit(1) unaligned dcl 231 set ref 323* 345* 350 null builtin function dcl 30 ref 64 70 76 82 254 272 280 330 331 387 395 offset parameter fixed bin(17,0) dcl 18 in procedure "db_sym" set ref 11 154* 161* 168* 173* 190 286* offset 3 based bit(18) level 3 in structure "symbol_node" packed unaligned dcl 4-1 in procedure "db_sym" ref 286 p 000100 automatic pointer dcl 231 in procedure "db_var" set ref 328* 330 333 333 335 p 000104 automatic pointer dcl 34 in procedure "db_sym" set ref 96* 97 packed 0(25) based bit(1) level 3 in structure "symbol_node" packed unaligned dcl 4-1 in procedure "db_sym" ref 139 packed 0(25) based bit(1) level 3 in structure "runtime_symbol" packed unaligned dcl 5-3 in procedure "db_sym" ref 105 416 packed_ptr based pointer unaligned dcl 34 ref 416 picture_image based structure level 1 dcl 3-6 pos 000120 automatic fixed bin(17,0) dcl 231 set ref 252* 259 260 265* 265 266 270 270 318* 318 328* 328* 353* 353* 381* 381 399 401* 401 421 429 435 437* 437 pp 72 based pointer level 2 dcl 1-9 set ref 96 121* 176 392* 405* ptr builtin function dcl 30 ref 96 176 q 000102 automatic pointer dcl 231 set ref 328* 331 339 340 341 342 r_pt 000110 automatic pointer dcl 231 set ref 254* 392* 405* 416* 417* 423 ref_pt 000114 automatic pointer dcl 34 set ref 74* 121* ref_pt_out parameter pointer dcl 225 set ref 223 423* rel builtin function dcl 30 ref 154 154 161 161 168 168 181 runtime_block based structure level 1 dcl 5-38 runtime_symbol based structure level 1 dcl 5-3 s_pt 000104 automatic pointer dcl 231 set ref 254* 270* 272 278 286 288 288 288 292 294 296 299 299 299 305 369 392* 403 405* 410 410 413 413 416 425 size 4 based fixed bin(35,0) level 2 in structure "runtime_symbol" dcl 5-3 in procedure "db_sym" ref 96 size 4 based fixed bin(35,0) level 2 in structure "symbol_node" dcl 4-1 in procedure "db_sym" ref 118 size 000100 automatic fixed bin(17,0) dcl 18 in procedure "db_sym" set ref 97* 105* 106* 118* 119 121* 121* 130* 130 132* 135* 135 136* 136 139 139* 141* 142* 142 147 148 149 snt based structure level 1 dcl 1-9 sntp 000122 automatic pointer dcl 1-7 set ref 60* 61 61* 62 70 70 96 121 121 151 154 158 161 165 168 176 181 187 384 392 392 405 405 sp 74 based pointer level 2 in structure "snt" dcl 1-9 in procedure "db_sym" ref 151 154 384 sp 000112 automatic pointer dcl 231 in procedure "db_var" set ref 384* 387 388* 388 392* 405* 424 stack_pt 000106 automatic pointer dcl 34 set ref 74* 121* stack_pt_out parameter pointer dcl 225 set ref 223 424* start_pos parameter fixed bin(17,0) dcl 225 ref 223 252 static_ptr 106 based pointer level 2 dcl 1-9 ref 158 161 steps 000125 automatic fixed bin(17,0) dcl 231 set ref 270* 272 274 275 387 stu_$decode_runtime_value 000020 constant entry external dcl 34 ref 121 stu_$find_runtime_symbol 000012 constant entry external dcl 34 ref 270 stu_$get_runtime_address 000014 constant entry external dcl 34 ref 392 stu_$offset_to_pointer 000016 constant entry external dcl 34 ref 405 subs_pt 000116 automatic pointer dcl 231 set ref 280* 379* 392* subscript 000126 automatic fixed bin(17,0) array dcl 231 set ref 358* 374 375* 375 376* 379 substr builtin function dcl 30 ref 101 112 260 270 270 399 413 435 symbol_node based structure level 1 dcl 4-1 symbol_pt 000112 automatic pointer dcl 34 set ref 74* 76 90 96 105 118 139 symflag 102 based bit(1) level 2 packed unaligned dcl 1-9 ref 61 symp 100 based pointer level 2 dcl 1-9 ref 62 thru 000166 automatic bit(1) unaligned dcl 231 set ref 253* 257 267* 282 313 320 348 355 397 431* type based bit(12) level 2 in structure "symbol_node" packed unaligned dcl 4-1 in procedure "db_sym" ref 294 296 305 335 413 type 0(06) based bit(6) level 2 in structure "runtime_symbol" packed unaligned dcl 5-3 in procedure "db_sym" ref 90 288 292 299 333 403 410 410 type parameter fixed bin(17,0) dcl 34 in procedure "db_sym" set ref 11 90* 92 92 93 94 98* 101 112 115* 115 130 130 132 135 136 136 type 000124 automatic fixed bin(17,0) dcl 231 in procedure "db_var" set ref 261* 263 324* 326 333* 335* 336 336* 336 339 340 341 342 350 type_char parameter char(1) dcl 18 set ref 11 153* 160* 167* 172* 177* 188* unspec builtin function dcl 30 ref 261 324 val 000123 automatic fixed bin(17,0) dcl 231 set ref 322* 339* 340* 341* 342* 353* 353 358 var_flag 000101 automatic fixed bin(17,0) dcl 32 set ref 102* 111* 148 varlength 1 based fixed bin(8,0) level 2 packed unaligned dcl 3-6 ref 97 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. RETURN_PTR_MASK internal static bit(72) initial unaligned dcl 2-19 TRANSLATOR_ID_ALM internal static bit(18) initial unaligned dcl 2-25 TRANSLATOR_ID_PL1V1 internal static bit(18) initial unaligned dcl 2-26 TRANSLATOR_ID_PL1V2 internal static bit(18) initial unaligned dcl 2-24 TRANSLATOR_ID_SIGNALLER internal static bit(18) initial unaligned dcl 2-28 TRANSLATOR_ID_SIGNAL_CALLER internal static bit(18) initial unaligned dcl 2-27 encoded_value based structure level 1 dcl 5-70 j automatic fixed bin(17,0) dcl 34 n automatic fixed bin(17,0) dcl 34 picture_char_type internal static fixed bin(8,0) initial unaligned dcl 3-20 picture_complexfix_type internal static fixed bin(8,0) initial unaligned dcl 3-20 picture_complexflo_type internal static fixed bin(8,0) initial unaligned dcl 3-20 picture_realfix_type internal static fixed bin(8,0) initial unaligned dcl 3-20 picture_realflo_type internal static fixed bin(8,0) initial unaligned dcl 3-20 runtime_bound based structure level 1 unaligned dcl 5-33 runtime_token based structure level 1 dcl 5-63 sp automatic pointer dcl 2-31 stack_frame based structure level 1 dcl 2-36 stack_frame_flags based structure level 1 dcl 2-64 stack_frame_min_length internal static fixed bin(17,0) initial dcl 2-33 steps automatic fixed bin(17,0) dcl 34 sym_bound based structure level 1 unaligned dcl 4-28 symbol_block based structure level 1 dcl 4-33 NAMES DECLARED BY EXPLICIT CONTEXT. again 001045 constant label dcl 256 ref 407 418 chk_tl 001205 constant label dcl 284 ref 313 db_sym 000236 constant entry external dcl 11 db_var 001030 constant entry internal dcl 223 ref 74 328 done 002025 constant label dcl 421 ref 397 err1 000340 constant label dcl 78 ref 276 330 331 err10 000777 constant label dcl 205 ref 410 413 err11 001003 constant label dcl 208 ref 272 err12 001007 constant label dcl 211 ref 274 err13 001013 constant label dcl 214 ref 275 err14 001017 constant label dcl 217 ref 292 296 299 305 err15 001023 constant label dcl 220 ref 278 err2 000275 constant label dcl 66 err3 000737 constant label dcl 183 err4 000757 constant label dcl 193 err5 000351 constant label dcl 84 ref 395 err7 000763 constant label dcl 196 ref 257 320 348 355 367 err8 000767 constant label dcl 199 ref 363 369 err9 000773 constant label dcl 202 ref 342 exit 000717 constant label dcl 174 fini 002050 constant label dcl 431 ga 001634 constant label dcl 384 ref 284 309 315 l1 000750 constant label dcl 190 ref 179 l2 000620 constant label dcl 145 ref 99 107 link_ref 000734 constant label dcl 181 ref 303 307 loop 001055 constant label dcl 260 ref 266 s1 001465 constant label dcl 350 ref 326 sl 002042 constant label dcl 429 ref 438 sob 002041 constant entry internal dcl 427 ref 256 312 319 347 354 382 sub_loop 001331 constant label dcl 318 ref 364 text_ref 000720 constant label dcl 176 ref 288 294 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2210 2234 2076 2220 Length 2534 2076 24 263 111 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME db_sym 126 external procedure is an external procedure. db_var 174 internal procedure calls itself recursively. sob internal procedure shares stack frame of internal procedure db_var. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME db_sym 000100 size db_sym 000101 var_flag db_sym 000102 i db_sym 000104 p db_sym 000106 stack_pt db_sym 000110 found_block db_sym 000112 symbol_pt db_sym 000114 ref_pt db_sym 000116 current_block db_sym 000120 bn db_sym 000122 sntp db_sym db_var 000100 p db_var 000102 q db_var 000104 s_pt db_var 000106 d_pt db_var 000110 r_pt db_var 000112 sp db_var 000114 dummy_pt db_var 000116 subs_pt db_var 000120 pos db_var 000121 n db_var 000122 m db_var 000123 val db_var 000124 type db_var 000125 steps db_var 000126 subscript db_var 000166 thru db_var 000167 nosign db_var 000170 ch db_var 000171 line_ db_var THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_char_temp call_ext_out_desc call_ext_out call_int_this call_int_other return_mac fl2_to_fx1 tra_ext_1 shorten_stack ext_entry_desc int_entry THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. db_get_count$dec db_get_sym stu_$decode_runtime_value stu_$find_runtime_symbol stu_$get_runtime_address stu_$offset_to_pointer NO EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 11 000226 60 000251 61 000255 62 000266 64 000271 66 000275 67 000300 70 000301 72 000307 74 000311 76 000334 78 000340 79 000343 82 000344 84 000351 85 000354 90 000355 92 000361 93 000373 94 000403 95 000405 96 000412 97 000420 98 000423 99 000425 101 000426 102 000433 104 000434 105 000440 106 000446 107 000450 110 000451 111 000455 112 000457 113 000463 114 000466 115 000471 118 000473 119 000476 121 000477 123 000525 124 000530 125 000532 130 000533 132 000543 135 000550 136 000557 138 000571 139 000603 141 000614 142 000617 145 000620 147 000625 148 000627 149 000634 151 000641 153 000646 154 000650 155 000657 158 000660 160 000664 161 000666 162 000675 165 000676 167 000702 168 000704 169 000713 172 000714 173 000716 174 000717 176 000720 177 000724 178 000726 179 000733 181 000734 183 000737 184 000742 187 000743 188 000746 190 000750 191 000756 193 000757 194 000762 196 000763 197 000766 199 000767 200 000772 202 000773 203 000776 205 000777 206 001002 208 001003 209 001006 211 001007 212 001012 214 001013 215 001016 217 001017 218 001022 220 001023 221 001026 223 001027 252 001035 253 001040 254 001041 256 001045 257 001046 259 001053 260 001055 261 001065 263 001071 265 001072 266 001073 267 001076 270 001100 272 001141 274 001154 275 001162 276 001170 278 001173 280 001201 282 001203 284 001205 286 001210 288 001216 292 001240 293 001246 294 001247 296 001257 299 001265 303 001303 305 001306 307 001315 309 001320 312 001321 313 001322 315 001324 317 001327 318 001331 319 001332 320 001333 322 001340 323 001341 324 001343 326 001347 328 001351 330 001370 331 001377 333 001406 335 001416 336 001421 339 001425 340 001433 341 001440 342 001446 345 001456 347 001457 348 001460 350 001465 352 001477 353 001506 354 001532 355 001533 358 001540 360 001543 362 001546 363 001547 364 001555 367 001556 369 001563 371 001573 374 001614 375 001616 376 001624 377 001626 379 001630 381 001632 382 001633 384 001634 387 001640 388 001656 389 001661 392 001663 395 001711 397 001720 399 001722 401 001732 403 001734 405 001742 407 001766 410 001767 413 001776 416 002007 417 002021 418 002024 421 002025 422 002030 423 002032 424 002034 425 002036 427 002041 429 002042 431 002050 432 002052 435 002053 436 002057 437 002063 438 002064 ----------------------------------------------------------- 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