COMPILATION LISTING OF SEGMENT lister_ Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell Multics Op. - System M Compiled on: 11/05/84 1153.4 mst Mon 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 /* LISTER_ - Subroutine interface to create & fill in a Lister file. 19* Written 770825 by PG 20* Modified 770919 by PG to add get_fieldnames entry. 21* Modified 791218 by PG to free old field_identifiers in in open_file. 22* Modified 800826 by PB for uid implementation. 23* Modified 801202 by PB to fix bug in get_fieldnames. 24* Modified 801205 by PB to fix bug when fieldname specified twice. 25* Modified 830907 by PB to use non-freeing areas. 26**/ 27 28 /* format: style3 */ 29 lister_$open_file: 30 procedure (bv_dname, bv_ename, bv_open_info_ptr, bv_file_info_ptr, bv_code) options (packed_decimal); 31 32 /* parameters */ 33 34 declare ( 35 bv_area_ptr ptr, 36 bv_code fixed bin (35), 37 bv_dname char (*), 38 bv_ename char (*), 39 bv_fieldname_info_ptr 40 ptr, 41 bv_file_info_ptr ptr, 42 bv_open_info_ptr ptr, 43 bv_record_info_ptr ptr 44 ) parameter; 45 46 /* automatic */ 47 48 declare bitcount fixed bin (24), 49 code fixed bin (35), 50 fieldx fixed bin, 51 field_len fixed bin (21), 52 field_ptr ptr, 53 file_info_ptr ptr, 54 open_info_ptr ptr, 55 out_recordp ptr, 56 record_info_ptr ptr, 57 selected_records_ptr 58 ptr; 59 60 /* based */ 61 62 declare field_value char (field_len) based (field_ptr); 63 64 declare 1 fieldname_info aligned based (open_info.fieldname_info_ptr), 65 2 version fixed bin, 66 2 n_fieldnames fixed bin, 67 2 name (n refer (fieldname_info.n_fieldnames)) char (32); 68 69 declare 1 file_info aligned based (file_info_ptr), 70 2 file_ptr ptr, 71 2 dname char (168) unal, 72 2 ename char (32) unal; 73 74 declare 1 local_open_info aligned like open_info; 75 declare 1 open_info aligned based (open_info_ptr), 76 2 version fixed bin, 77 2 flags aligned, 78 3 create bit (1) unal, 79 3 discard_records 80 bit (1) unal, 81 3 assign_fieldnames 82 bit (1) unal, 83 3 mbz bit (33) unal, 84 2 fieldname_info_ptr 85 ptr; 86 87 declare 1 record_info aligned based (record_info_ptr), 88 2 version fixed bin, 89 2 n_fields fixed bin, 90 2 field (n refer (record_info.n_fields)) aligned, 91 3 field_ptr ptr, 92 3 field_len fixed bin (21); 93 94 /* builtins */ 95 96 declare (dim, empty, hbound, lbound, null, offset, pointer, rtrim) 97 builtin; 98 99 /* conditions */ 100 101 declare cleanup condition; 102 103 /* entries */ 104 105 declare adjust_bit_count_ entry (char (*), char (*), bit (1) aligned, fixed bin (24), fixed bin (35)), 106 get_system_free_area_ 107 entry (ptr), 108 hcs_$initiate entry (char (*), char (*), char (*), fixed bin, fixed bin, ptr, fixed bin (35)), 109 hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)), 110 hcs_$terminate_noname 111 entry (ptr, fixed bin (35)); 112 113 /* external static */ 114 115 declare ( 116 lister_codes_$cant_assign_fieldnames, 117 lister_codes_$dup_fieldname, 118 lister_codes_$fieldname_info_ptr_null, 119 lister_codes_$file_info_ptr_null, 120 lister_codes_$open_info_mbz_bad, 121 lister_codes_$open_info_wrong_version, 122 lister_codes_$record_info_wrong_version, 123 lister_codes_$wrong_no_of_fields 124 ) external static; 125 126 /* internal static */ 127 128 /* include files */ 129 1 1 /* ====== BEGIN INCLUDE FILE lister_entries.incl.pl1 =================================== */ 1 2 1 3 /* 1 4* Modified 800521 by PB to add code to calling sequence for lister_merge_. 1 5* Modified 800702 by PB to add lister_status_. 1 6* Modified 800813 by PB to add lister_assign_. 1 7* Modified 800826 by PB to add lister_create_record_$retain_uid. 1 8* Modified 801008 by PB to add display to calling sequence for lister_print_. 1 9* Modified 801024 by PB to add lister_convert_. 1 10* Modified 810226 by PB to add listform_path to calling sequence for lister_print_. 1 11**/ 1 12 1 13 dcl lister_assign_ 1 14 entry (ptr, bit (1) aligned, ptr, ptr); 1 15 /* param 1 (input) ptr to lister segment */ 1 16 /* param 2 (input) "1"b iff all records are to be modified */ 1 17 /* param 3 (input) ptr to selected records */ 1 18 /* param 4 (input) ptr to assign info structure */ 1 19 1 20 dcl lister_compile_listin_ 1 21 entry (ptr, ptr, fixed bin (21), ptr, fixed bin, char (*), fixed bin (35)); 1 22 /* param 1 (input) ptr to new file segment */ 1 23 /* param 2 (input) ptr to listin segment */ 1 24 /* param 3 (input) length in chars of listin segment */ 1 25 /* param 4 (input) ptr to system free area */ 1 26 /* param 5 (output) number of records parsed */ 1 27 /* param 6 (output) error token, if any errors */ 1 28 /* param 7 (output) status code */ 1 29 1 30 dcl lister_compile_select_ 1 31 entry (char (*), ptr, ptr, ptr, char (*), fixed bin (35)); 1 32 /* param 1 (input) select expression to be parsed */ 1 33 /* param 2 (input) ptr to file that will be searched */ 1 34 /* param 3 (input) ptr to area */ 1 35 /* param 4 (output) ptr to compiled select expression */ 1 36 /* param 5 (output) error token */ 1 37 /* param 6 (output) standard status code */ 1 38 1 39 dcl lister_compile_sort_ 1 40 entry (char (*), ptr, ptr, ptr, char (*), fixed bin (35)); 1 41 /* param 1 (input) sort string to be parsed */ 1 42 /* param 2 (input) ptr to file */ 1 43 /* param 3 (input) ptr to area */ 1 44 /* param 4 (output) ptr to compiled sort expression */ 1 45 /* param 5 (output) token in error (if any error) */ 1 46 /* param 6 (output) standard status code */ 1 47 1 48 dcl lister_convert_ entry (ptr, fixed bin (35)); 1 49 /* param 1 (input) input file ptr */ 1 50 /* param 2 (output) standard status code */ 1 51 1 52 dcl lister_copy_file_head_ 1 53 entry (ptr, ptr); 1 54 /* param 1 (input) input file ptr */ 1 55 /* param 2 (input) output file ptr */ 1 56 1 57 dcl lister_copy_records_ 1 58 entry (ptr, ptr, ptr); 1 59 /* param 1 (input) ptr to input file */ 1 60 /* param 2 (input) ptr to output file */ 1 61 /* param 3 (input) ptr to list of records to be copied */ 1 62 1 63 dcl lister_compare_field_tables_ 1 64 entry (ptr, ptr) 1 65 returns (bit (1) aligned); 1 66 /* param 1 (input) ptr to file 1 */ 1 67 /* param 2 (input) ptr to file 2 */ 1 68 /* return (output) "1"b if field tables are equal */ 1 69 1 70 dcl lister_create_record_ 1 71 entry (ptr) 1 72 returns (ptr); 1 73 /* param 1 (input) file ptr */ 1 74 /* return (output) record ptr */ 1 75 1 76 dcl lister_create_record_$after 1 77 entry (ptr, ptr) 1 78 returns (ptr); 1 79 /* param 1 (input) ptr to file to create record in */ 1 80 /* param 2 (input) ptr to record that is to be just before created record */ 1 81 /* return (output) ptr to created record */ 1 82 1 83 dcl lister_create_record_$retain_uid 1 84 entry (ptr, fixed bin (24) unsigned unaligned) 1 85 returns (ptr); 1 86 /* param 1 (input) file ptr */ 1 87 /* param 2 (input) uid to be retained */ 1 88 /* return (output) record ptr */ 1 89 1 90 dcl lister_delete_ 1 91 entry (ptr, ptr); 1 92 /* param 1 (input) file ptr */ 1 93 /* param 2 (input) ptr to list of record to be deleted */ 1 94 1 95 dcl lister_expand_ 1 96 entry (ptr, ptr, fixed bin (21), fixed bin, bit (1) aligned) 1 97 returns (fixed bin); 1 98 /* param 1 (input) file ptr */ 1 99 /* param 2 (input) ptr to output segment */ 1 100 /* param 3 (in/out) 1-origin char index of next free char in output segment */ 1 101 /* param 4 (input) line length to use */ 1 102 /* param 5 (input) "1"b iff field names are always to appear */ 1 103 /* return (output) number of records expanded */ 1 104 1 105 dcl lister_hash_fid_ reducible 1 106 entry (ptr, char (*)) 1 107 returns (fixed bin); 1 108 /* param 1 (input) file ptr */ 1 109 /* param 2 (input) field identifier */ 1 110 /* return (output) field index */ 1 111 1 112 dcl lister_hash_fid_$enter irreducible 1 113 entry (ptr, char (*)) 1 114 returns (ptr); 1 115 /* param 1 (input) file ptr */ 1 116 /* param 2 (input) field identifier */ 1 117 /* return (output) field identifier node offset */ 1 118 1 119 dcl lister_format_parse_ 1 120 entry (ptr, ptr, char (*), ptr, char (*), fixed bin (35)); 1 121 /* param 1 (input) ptr to file containing field table */ 1 122 /* param 2 (input) ptr to area */ 1 123 /* param 3 (input) listform string */ 1 124 /* param 4 (output) format table ptr */ 1 125 /* param 5 (output) error token */ 1 126 /* param 6 (output) status code */ 1 127 1 128 dcl lister_merge_ entry (ptr, ptr, ptr, (*) fixed bin, fixed bin, fixed bin, fixed bin(35)) 1 129 returns ((3) fixed bin); 1 130 /* param 1 (input) input file ptr */ 1 131 /* param 2 (input) update file ptr */ 1 132 /* param 3 (input) output file ptr */ 1 133 /* param 4 (input) array of fields to merge on */ 1 134 /* param 5 (input) 1-origin number of elements in field_list */ 1 135 /* param 6 (input) type of merge */ 1 136 /* param 7 (output) status code */ 1 137 /* return (output) count of number of input, update, output records */ 1 138 1 139 dcl lister_print_ entry (ptr, ptr, ptr, fixed bin (21), bit (1) aligned, 1 140 ptr, ptr, fixed bin, bit (1) aligned, bit (1) aligned, char (*)); 1 141 /* param 1 (input) ptr to file to be printed */ 1 142 /* param 2 (input) format table ptr */ 1 143 /* param 3 (input) ptr to base of output segment */ 1 144 /* param 4 (in/out) index of next output character */ 1 145 /* param 5 (input) "1"b iff all records are to be printed */ 1 146 /* param 6 (input) ptr to list of records to print */ 1 147 /* null => print no records */ 1 148 /* param 7 (input) ptr to argument list for -ag */ 1 149 /* param 8 (input) index of -ag in above argument list */ 1 150 /* param 9 (input) brief error flag */ 1 151 /* param 10 (input) "1"b iff called by display_list af */ 1 152 /* param 11 (input) pathname of listform segment */ 1 153 1 154 dcl lister_select_ entry (ptr, ptr, ptr, ptr) 1 155 returns (fixed bin); 1 156 /* param 1 (input) ptr to file to be searched */ 1 157 /* param 2 (input) ptr to select_expression */ 1 158 /* param 3 (input) ptr to area */ 1 159 /* param 4 (output) ptr to list of selected records */ 1 160 /* return (output) number of records found */ 1 161 1 162 dcl lister_sort_ entry (ptr, ptr, ptr); 1 163 /* param 1 (input) file ptr */ 1 164 /* param 2 (input) ptr to list of records */ 1 165 /* param 3 (input) ptr to sort list array */ 1 166 1 167 dcl lister_status_ entry (ptr, char (*), bit (1) aligned, ptr); 1 168 /* param 1 (input) ptr to lister segment */ 1 169 /* param 2 (input) entryname of lister segment */ 1 170 /* param 3 (input) on if no selection expression given */ 1 171 /* param 4 (input) ptr to status info structure */ 1 172 1 173 /* ------ END INCLUDE FILE lister_entries.incl.pl1 ----------------------------------- */ 130 2 1 /* ====== BEGIN INCLUDE FILE lister_structures.incl.pl1 ================================ */ 2 2 2 3 /* 2 4* Modified 800813 by PB to add PUT_UID to listform declarations. 2 5* Modified 800825 by PB for version 2 lister file. 2 6* Modified 840523 by PB to add SELECT_BEG and SELECT_END. 2 7**/ 2 8 /* MASTER DECLARATIONS */ 2 9 2 10 /* format: style3 */ 2 11 dcl lister_file_version_2 2 12 fixed bin initial (2) internal static options (constant); 2 13 2 14 dcl 1 input_file based (in_file_ptr) aligned, 2 15 2 ( 2 16 field_table_offset, 2 17 record_head, 2 18 record_tail, 2 19 unused (2) 2 20 ) offset (input_file.area), 2 21 2 next_uid fixed bin (24) unsigned, 2 22 2 version fixed bin, 2 23 2 n_records fixed bin (17), 2 24 2 area area (261112); 2 25 2 26 dcl 1 update_file based (up_file_ptr) aligned, 2 27 2 ( 2 28 field_table_offset, 2 29 record_head, 2 30 record_tail, 2 31 unused (2) 2 32 ) offset (update_file.area), 2 33 2 next_uid fixed bin (24) unsigned, 2 34 2 version fixed bin, 2 35 2 n_records fixed bin (17), 2 36 2 area area (261112); 2 37 2 38 dcl 1 output_file based (out_file_ptr) aligned, 2 39 2 ( 2 40 field_table_offset, 2 41 record_head, 2 42 record_tail, 2 43 unused (2) 2 44 ) offset (output_file.area), 2 45 2 next_uid fixed bin (24) unsigned, 2 46 2 version fixed bin, 2 47 2 n_records fixed bin (17), 2 48 2 area area (261112); 2 49 2 50 dcl 1 input_record based (recordp) aligned, 2 51 2 next offset (input_file.area), 2 52 2 uid fixed bin (24) unsigned unaligned, 2 53 2 max_field_index fixed bin (12) unsigned unaligned, 2 54 2 field dim (0:field_table.max_field_index refer (input_record.max_field_index)) 2 55 offset (input_file.area); 2 56 2 57 dcl 1 update_record based aligned, 2 58 2 next offset (update_file.area), 2 59 2 uid fixed bin (24) unsigned unaligned, 2 60 2 max_field_index fixed bin (12) unsigned unaligned, 2 61 2 field dim (0:field_table.max_field_index refer (update_record.max_field_index)) 2 62 offset (update_file.area); 2 63 2 64 dcl 1 output_record based aligned, 2 65 2 next offset (output_file.area), 2 66 2 uid fixed bin (24) unsigned unaligned, 2 67 2 max_field_index fixed bin (12) unsigned unaligned, 2 68 2 field dim (0:field_table.max_field_index refer (output_record.max_field_index)) 2 69 offset (output_file.area); 2 70 2 71 dcl atom char (atom_length) based (atomp) varying aligned, 2 72 atom_length fixed bin initial (0), /* for table option */ 2 73 atomp ptr; 2 74 2 75 dcl (fidp, field_table_ptr, format_table_ptr, in_file_ptr, ltp, recordp, select_ptr, out_file_ptr, up_file_ptr) 2 76 ptr, 2 77 n fixed bin; 2 78 2 79 dcl 1 field_table based (field_table_ptr) aligned, 2 80 2 record_delimiter 2 81 unal char (1), 2 82 2 field_delimiter unal char (1), 2 83 2 max_field_index unal fixed bin (17), 2 84 2 hash_field_id_to_index 2 85 dimension (0:18) offset, 2 86 2 index_to_field_id 2 87 dimension (0:n refer (field_table.max_field_index)) offset; 2 88 2 89 dcl 1 field_identifier based (fidp) aligned, 2 90 2 next offset, 2 91 2 field_index unal fixed bin (17), 2 92 2 size unal fixed bin (17), 2 93 2 string unal char (n refer (field_identifier.size)); 2 94 2 95 dcl system_area area (261120) based (area_ptr); 2 96 dcl area_ptr ptr; 2 97 2 98 /* LISTFORM DECLARATIONS */ 2 99 2 100 declare ( 2 101 PUT_LITERAL initial (-1), 2 102 PUT_SPACES initial (-2), 2 103 PUT_END initial (-3), 2 104 PUT_DATE initial (-4), 2 105 PUT_TIME initial (-5), 2 106 PUT_RECORD_COUNT initial (-6), 2 107 PUT_ARGUMENT initial (-7), 2 108 PUT_UID initial (-8) 2 109 ) fixed bin internal static; 2 110 2 111 dcl 1 format_table aligned based (format_table_ptr), 2 112 2 size fixed bin (17) unal, 2 113 2 before fixed bin (17) unal, 2 114 2 after fixed bin (17) unal, 2 115 2 record fixed bin (17) unal, 2 116 2 literal_table ptr, 2 117 2 item dim (n refer (format_table.size)), 2 118 3 action fixed bin (17) unal, 2 119 3 justification bit (2) unal, 2 120 3 argument_number 2 121 fixed bin (15) unal, 2 122 3 width fixed bin (21); 2 123 2 124 dcl 1 literal_table aligned based (ltp), 2 125 2 size fixed bin, /* number of slots allocated */ 2 126 2 n_literals fixed bin, /* number of slots in use */ 2 127 2 literal dim (n refer (literal_table.size)) ptr unal; 2 128 2 129 dcl ( 2 130 flush_left initial ("00"b), 2 131 center initial ("01"b), 2 132 flush_right initial ("10"b) 2 133 ) bit (2) aligned internal static options (constant); 2 134 2 135 dcl MIN_FIELD_INDEX fixed bin initial (0) internal static options (constant); 2 136 2 137 dcl 1 list_node aligned based, 2 138 2 size fixed bin, 2 139 2 list dimension (n refer (list_node.size)) ptr; 2 140 2 141 /* SELECT DECLARATIONS */ 2 142 2 143 dcl 1 select_expression based (select_ptr) aligned, 2 144 2 literal_table_ptr 2 145 ptr, 2 146 2 size fixed bin, 2 147 2 last_element fixed bin, 2 148 2 element dim (n refer (select_expression.size)), 2 149 3 opcode unal bit (9), 2 150 3 not unal bit (1), 2 151 3 top unal bit (1), 2 152 3 unused unal bit (7), 2 153 3 field_index unal fixed bin (8), 2 154 3 literal_index unal fixed bin (8), 2 155 1 element aligned, 2 156 2 opcode fixed bin, 2 157 2 not bit (1) aligned, 2 158 2 top bit (1) aligned, 2 159 2 field_index fixed bin, 2 160 2 literal_index fixed bin, 2 161 operand1 fixed bin defined (element.field_index), 2 162 operand2 fixed bin defined (element.literal_index); 2 163 2 164 dcl ( 2 165 SELECT_AND init ("000000001"b), 2 166 SELECT_OR init ("000000010"b), 2 167 SELECT_NOT init ("000000011"b), 2 168 SELECT_FIND init ("000000100"b), 2 169 SELECT_EQ init ("000000101"b), 2 170 SELECT_LT init ("000000110"b), 2 171 SELECT_GT init ("000000111"b), 2 172 SELECT_LE init ("000001000"b), 2 173 SELECT_GE init ("000001001"b), 2 174 SELECT_NEQ init ("000001010"b), 2 175 SELECT_NLT init ("000001011"b), 2 176 SELECT_NGT init ("000001100"b), 2 177 SELECT_NLE init ("000001101"b), 2 178 SELECT_NGE init ("000001110"b), 2 179 SELECT_BEG init ("000001111"b), 2 180 SELECT_END init ("000010000"b) 2 181 ) bit (9) aligned internal static; 2 182 2 183 dcl ( 2 184 ANY_FIELD init (-1), 2 185 NULL_FIELD init (-2), 2 186 NUMERIC_FIELD init (-3), 2 187 UID init (-4) 2 188 ) aligned fixed bin (8) static; 2 189 2 190 dcl 1 numeric_atom aligned based (atomp), 2 191 2 flag fixed bin (35), /* must be -1 */ 2 192 2 value float dec (29) unal; 2 193 2 194 dcl numeric_flag fixed bin (35) internal static initial (-1) options (constant); 2 195 2 196 /* SORT DECLARATIONS */ 2 197 2 198 declare n_items_to_sort fixed bin, 2 199 sort_list_ptr ptr; 2 200 2 201 declare 1 sort_list aligned based (sort_list_ptr), 2 202 2 n_keys fixed bin, 2 203 2 key (n_items_to_sort refer (sort_list.n_keys)), 2 204 3 field_index fixed bin, 2 205 3 ascending bit (1) aligned, 2 206 3 numeric bit (1) aligned; 2 207 2 208 /* MERGE DECLARATIONS */ 2 209 2 210 dcl ( 2 211 MERGE_ADD init (0), 2 212 MERGE_AND init (1), 2 213 MERGE_OR init (2), 2 214 MERGE_SUBTRACT init (3) 2 215 ) fixed bin internal static options (constant); 2 216 2 217 /* ------ END INCLUDE FILE lister_structures.incl.pl1 -------------------------------- */ 131 132 133 /* program */ 134 135 selected_records_ptr = null; 136 file_info_ptr = null; 137 on cleanup 138 call clean_up; 139 140 open_info_ptr = bv_open_info_ptr; 141 142 if open_info.version ^= 1 143 then do; 144 bv_code = lister_codes_$open_info_wrong_version; 145 return; 146 end; 147 148 if open_info.mbz ^= ""b 149 then do; 150 bv_code = lister_codes_$open_info_mbz_bad; 151 return; 152 end; 153 154 if open_info.create 155 then call hcs_$make_seg (bv_dname, bv_ename, "", 1010b, out_file_ptr, code); 156 else call hcs_$initiate (bv_dname, bv_ename, "", 0, 1, out_file_ptr, code); 157 158 if out_file_ptr = null 159 then do; 160 bv_code = code; 161 return; 162 end; 163 164 call get_system_free_area_ (area_ptr); 165 166 allocate file_info in (system_area) set (file_info_ptr); 167 file_info.file_ptr = out_file_ptr; 168 file_info.dname = bv_dname; 169 file_info.ename = bv_ename; 170 171 if output_file.version = -1 /* Old file version */ 172 | output_file.version = 1 173 then output_file.version = lister_file_version_2; 174 175 if output_file.version = 0 /* Newly created file */ 176 then do; 177 output_file.area = empty (); 178 output_file.field_table_offset = null; 179 output_file.record_head = null; 180 output_file.record_tail = null; 181 output_file.unused (1) = null; 182 output_file.unused (2) = null; 183 output_file.next_uid = 1; 184 output_file.version = lister_file_version_2; 185 output_file.n_records = 0; 186 end; 187 188 if open_info.discard_records 189 then do; 190 n = lister_select_ (out_file_ptr, null, area_ptr, selected_records_ptr); 191 call lister_delete_ (out_file_ptr, selected_records_ptr); 192 end; 193 194 if open_info.assign_fieldnames 195 then if output_file.n_records ^= 0 196 then do; 197 bv_code = lister_codes_$cant_assign_fieldnames; 198 call clean_up; 199 return; 200 end; 201 else do; 202 203 if open_info.fieldname_info_ptr = null 204 then do; 205 bv_code = lister_codes_$fieldname_info_ptr_null; 206 call clean_up; 207 return; 208 end; 209 210 field_table_ptr = output_file.field_table_offset; 211 212 if field_table_ptr ^= null 213 then do; 214 do fieldx = lbound (field_table.index_to_field_id, 1) 215 to hbound (field_table.index_to_field_id, 1); 216 fidp = pointer (field_table.index_to_field_id (fieldx), output_file.area); 217 free fidp -> field_identifier in (output_file.area); 218 end; 219 free field_table_ptr -> field_table in (output_file.area); 220 end; 221 222 n = fieldname_info.n_fieldnames - 1; 223 224 allocate field_table in (output_file.area) set (field_table_ptr); 225 output_file.field_table_offset = field_table_ptr; 226 field_table.record_delimiter = "$"; 227 field_table.field_delimiter = "="; 228 field_table.hash_field_id_to_index (*) = null; 229 230 do fieldx = lbound (fieldname_info.name, 1) to hbound (fieldname_info.name, 1); 231 fidp = lister_hash_fid_$enter (out_file_ptr, rtrim (fieldname_info.name (fieldx))); 232 if fidp = null 233 then do; 234 bv_code = lister_codes_$dup_fieldname; 235 call clean_up; 236 return; 237 end; 238 field_table.index_to_field_id (fieldx - 1) = offset (fidp, output_file.area); 239 fidp -> field_identifier.field_index = fieldx - 1; 240 end; 241 end; 242 243 bv_file_info_ptr = file_info_ptr; 244 file_info_ptr = null; /* don't clean this up now! */ 245 call clean_up; 246 bv_code = 0; 247 return; 248 249 lister_$add_record: 250 entry (bv_file_info_ptr, bv_record_info_ptr, bv_code); 251 252 file_info_ptr = bv_file_info_ptr; 253 record_info_ptr = bv_record_info_ptr; 254 255 if record_info.version ^= 1 256 then do; 257 bv_code = lister_codes_$record_info_wrong_version; 258 return; 259 end; 260 261 if file_info_ptr = null 262 then do; 263 bv_code = lister_codes_$file_info_ptr_null; 264 return; 265 end; 266 267 out_file_ptr = file_info.file_ptr; 268 field_table_ptr = output_file.field_table_offset; 269 270 if field_table.max_field_index + 1 ^= record_info.n_fields 271 then do; 272 bv_code = lister_codes_$wrong_no_of_fields; 273 return; 274 end; 275 276 out_recordp = lister_create_record_ (out_file_ptr); 277 278 do fieldx = 1 to record_info.n_fields; 279 field_ptr = record_info.field (fieldx).field_ptr; 280 atom_length, field_len = record_info.field (fieldx).field_len; 281 282 allocate atom in (output_file.area) set (atomp); 283 out_recordp -> output_record.field (fieldx - 1) = atomp; 284 atom = field_value; 285 end; 286 287 bv_code = 0; 288 return; 289 290 lister_$get_fieldnames: 291 entry (bv_file_info_ptr, bv_area_ptr, bv_fieldname_info_ptr, bv_code); 292 293 file_info_ptr = bv_file_info_ptr; 294 area_ptr = bv_area_ptr; 295 bv_fieldname_info_ptr = null; 296 297 if file_info_ptr = null 298 then do; 299 bv_code = lister_codes_$file_info_ptr_null; 300 return; 301 end; 302 303 open_info_ptr = addr (local_open_info); 304 305 open_info.fieldname_info_ptr = null; 306 307 on cleanup 308 begin; 309 if open_info.fieldname_info_ptr ^= null 310 then free open_info.fieldname_info_ptr -> fieldname_info in (system_area); 311 end; 312 313 out_file_ptr = file_info.file_ptr; 314 field_table_ptr = output_file.field_table_offset; 315 316 n = dim (field_table.index_to_field_id, 1); 317 318 allocate fieldname_info in (system_area) set (open_info.fieldname_info_ptr); 319 fieldname_info.version = 1; 320 fieldname_info.n_fieldnames = n; 321 322 do fieldx = 1 to n; 323 fieldname_info.name (fieldx) = 324 pointer (field_table.index_to_field_id (fieldx - 1), output_file.area) -> field_identifier.string; 325 end; 326 327 bv_fieldname_info_ptr = open_info.fieldname_info_ptr; 328 bv_code = 0; 329 return; 330 331 lister_$close_file: 332 entry (bv_file_info_ptr, bv_code); 333 334 selected_records_ptr = null; 335 file_info_ptr = bv_file_info_ptr; 336 on cleanup 337 call clean_up; 338 339 call adjust_bit_count_ (file_info.dname, file_info.ename, "0"b, bitcount, code); 340 call hcs_$terminate_noname (file_info.file_ptr, code); 341 call clean_up; 342 bv_code = 0; 343 return; 344 345 clean_up: 346 procedure (); 347 348 if selected_records_ptr ^= null 349 then do; 350 free selected_records_ptr -> list_node; 351 selected_records_ptr = null; 352 end; 353 354 if file_info_ptr ^= null 355 then do; 356 free file_info_ptr -> file_info; 357 file_info_ptr = null; 358 end; 359 360 end clean_up; 361 362 end; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/05/84 1151.4 lister_.pl1 >special_ldd>online>6883-11/02/84>lister_.pl1 130 1 04/25/81 0728.4 lister_entries.incl.pl1 >ldd>include>lister_entries.incl.pl1 131 2 11/02/84 1208.5 lister_structures.incl.pl1 >special_ldd>online>6883-11/02/84>lister_structures.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. adjust_bit_count_ 000010 constant entry external dcl 105 ref 339 area 10 based area(261112) level 2 dcl 2-38 set ref 177* 210 216 217 219 224 225 238 268 282 283 314 323 area_ptr 000146 automatic pointer dcl 2-96 set ref 164* 166 190* 294* 309 318 assign_fieldnames 1(02) based bit(1) level 3 packed unaligned dcl 75 ref 194 atom based varying char dcl 2-71 set ref 282 284* atom_length 000132 automatic fixed bin(17,0) initial dcl 2-71 set ref 280* 282 284 2-71* atomp 000134 automatic pointer dcl 2-71 set ref 282* 283 284 bitcount 000100 automatic fixed bin(24,0) dcl 48 set ref 339* bv_area_ptr parameter pointer dcl 34 ref 290 294 bv_code parameter fixed bin(35,0) dcl 34 set ref 29 144* 150* 160* 197* 205* 234* 246* 249 257* 263* 272* 287* 290 299* 328* 331 342* bv_dname parameter char unaligned dcl 34 set ref 29 154* 156* 168 bv_ename parameter char unaligned dcl 34 set ref 29 154* 156* 169 bv_fieldname_info_ptr parameter pointer dcl 34 set ref 290 295* 327* bv_file_info_ptr parameter pointer dcl 34 set ref 29 243* 249 252 290 293 331 335 bv_open_info_ptr parameter pointer dcl 34 ref 29 140 bv_record_info_ptr parameter pointer dcl 34 ref 249 253 cleanup 000124 stack reference condition dcl 101 ref 137 307 336 code 000101 automatic fixed bin(35,0) dcl 48 set ref 154* 156* 160 339* 340* create 1 based bit(1) level 3 packed unaligned dcl 75 ref 154 dim builtin function dcl 96 ref 316 discard_records 1(01) based bit(1) level 3 packed unaligned dcl 75 ref 188 dname 2 based char(168) level 2 packed unaligned dcl 69 set ref 168* 339* empty builtin function dcl 96 ref 177 ename 54 based char(32) level 2 packed unaligned dcl 69 set ref 169* 339* fidp 000136 automatic pointer dcl 2-75 set ref 216* 217 231* 232 238 239 field 2 based structure array level 2 in structure "record_info" dcl 87 in procedure "lister_$open_file" field 2 based offset array level 2 in structure "output_record" dcl 2-64 in procedure "lister_$open_file" set ref 283* field_delimiter 0(09) based char(1) level 2 packed unaligned dcl 2-79 set ref 227* field_identifier based structure level 1 dcl 2-89 set ref 217 field_index 1 based fixed bin(17,0) level 2 packed unaligned dcl 2-89 set ref 239* field_len 000103 automatic fixed bin(21,0) dcl 48 in procedure "lister_$open_file" set ref 280* 284 field_len 4 based fixed bin(21,0) array level 3 in structure "record_info" dcl 87 in procedure "lister_$open_file" ref 280 field_ptr 2 based pointer array level 3 in structure "record_info" dcl 87 in procedure "lister_$open_file" ref 279 field_ptr 000104 automatic pointer dcl 48 in procedure "lister_$open_file" set ref 279* 284 field_table based structure level 1 dcl 2-79 set ref 219 224 field_table_offset based offset level 2 dcl 2-38 set ref 178* 210 225* 268 314 field_table_ptr 000140 automatic pointer dcl 2-75 set ref 210* 212 214 214 216 219 224* 225 226 227 228 238 268* 270 314* 316 323 field_value based char unaligned dcl 62 ref 284 fieldname_info based structure level 1 dcl 64 set ref 309 318 fieldname_info_ptr 2 based pointer level 2 dcl 75 set ref 203 222 230 230 231 231 305* 309 309 318* 319 320 323 327 fieldx 000102 automatic fixed bin(17,0) dcl 48 set ref 214* 216* 230* 231 231 238 239* 278* 279 280 283* 322* 323 323* file_info based structure level 1 dcl 69 set ref 166 356 file_info_ptr 000106 automatic pointer dcl 48 set ref 136* 166* 167 168 169 243 244* 252* 261 267 293* 297 313 335* 339 339 340 354 356 357* file_ptr based pointer level 2 dcl 69 set ref 167* 267 313 340* flags 1 based structure level 2 dcl 75 get_system_free_area_ 000012 constant entry external dcl 105 ref 164 hash_field_id_to_index 1 based offset array level 2 dcl 2-79 set ref 228* hbound builtin function dcl 96 ref 214 230 hcs_$initiate 000014 constant entry external dcl 105 ref 156 hcs_$make_seg 000016 constant entry external dcl 105 ref 154 hcs_$terminate_noname 000020 constant entry external dcl 105 ref 340 index_to_field_id 24 based offset array level 2 dcl 2-79 set ref 214 214 216 238* 316 323 lbound builtin function dcl 96 ref 214 230 list_node based structure level 1 dcl 2-137 ref 350 lister_codes_$cant_assign_fieldnames 000022 external static fixed bin(17,0) dcl 115 ref 197 lister_codes_$dup_fieldname 000024 external static fixed bin(17,0) dcl 115 ref 234 lister_codes_$fieldname_info_ptr_null 000026 external static fixed bin(17,0) dcl 115 ref 205 lister_codes_$file_info_ptr_null 000030 external static fixed bin(17,0) dcl 115 ref 263 299 lister_codes_$open_info_mbz_bad 000032 external static fixed bin(17,0) dcl 115 ref 150 lister_codes_$open_info_wrong_version 000034 external static fixed bin(17,0) dcl 115 ref 144 lister_codes_$record_info_wrong_version 000036 external static fixed bin(17,0) dcl 115 ref 257 lister_codes_$wrong_no_of_fields 000040 external static fixed bin(17,0) dcl 115 ref 272 lister_create_record_ 000042 constant entry external dcl 1-70 ref 276 lister_delete_ 000044 constant entry external dcl 1-90 ref 191 lister_file_version_2 constant fixed bin(17,0) initial dcl 2-11 ref 171 184 lister_hash_fid_$enter 000046 constant entry external dcl 1-112 ref 231 lister_select_ 000050 constant entry external dcl 1-154 ref 190 local_open_info 000120 automatic structure level 1 dcl 74 set ref 303 max_field_index 0(18) based fixed bin(17,0) level 2 packed unaligned dcl 2-79 set ref 214 219 224* 270 316 mbz 1(03) based bit(33) level 3 packed unaligned dcl 75 ref 148 n 000144 automatic fixed bin(17,0) dcl 2-75 set ref 190* 222* 224 224 316* 318 318 320 322 n_fieldnames 1 based fixed bin(17,0) level 2 dcl 64 set ref 222 230 309 318* 320* n_fields 1 based fixed bin(17,0) level 2 dcl 87 ref 270 278 n_records 7 based fixed bin(17,0) level 2 dcl 2-38 set ref 185* 194 name 2 based char(32) array level 2 dcl 64 set ref 230 230 231 231 323* next_uid 5 based fixed bin(24,0) level 2 unsigned dcl 2-38 set ref 183* null builtin function dcl 96 ref 135 136 158 178 179 180 181 182 190 190 203 212 228 232 244 261 295 297 305 309 334 348 351 354 357 offset builtin function dcl 96 ref 238 open_info based structure level 1 dcl 75 open_info_ptr 000110 automatic pointer dcl 48 set ref 140* 142 148 154 188 194 203 222 230 230 231 231 303* 305 309 309 318 319 320 323 327 out_file_ptr 000142 automatic pointer dcl 2-75 set ref 154* 156* 158 167 171 171 171 175 177 178 179 180 181 182 183 184 185 190* 191* 194 210 210 216 217 219 224 225 225 231* 238 267* 268 268 276* 282 283 313* 314 314 323 out_recordp 000112 automatic pointer dcl 48 set ref 276* 283 output_file based structure level 1 dcl 2-38 output_record based structure level 1 dcl 2-64 pointer builtin function dcl 96 ref 216 323 record_delimiter based char(1) level 2 packed unaligned dcl 2-79 set ref 226* record_head 1 based offset level 2 dcl 2-38 set ref 179* record_info based structure level 1 dcl 87 record_info_ptr 000114 automatic pointer dcl 48 set ref 253* 255 270 278 279 280 record_tail 2 based offset level 2 dcl 2-38 set ref 180* rtrim builtin function dcl 96 ref 231 231 selected_records_ptr 000116 automatic pointer dcl 48 set ref 135* 190* 191* 334* 348 350 351* size 1(18) based fixed bin(17,0) level 2 in structure "field_identifier" packed unaligned dcl 2-89 in procedure "lister_$open_file" ref 217 323 size based fixed bin(17,0) level 2 in structure "list_node" dcl 2-137 in procedure "lister_$open_file" ref 350 string 2 based char level 2 packed unaligned dcl 2-89 ref 323 system_area based area(261120) dcl 2-95 ref 166 309 318 unused 3 based offset array level 2 dcl 2-38 set ref 181* 182* version based fixed bin(17,0) level 2 in structure "open_info" dcl 75 in procedure "lister_$open_file" ref 142 version based fixed bin(17,0) level 2 in structure "record_info" dcl 87 in procedure "lister_$open_file" ref 255 version 6 based fixed bin(17,0) level 2 in structure "output_file" dcl 2-38 in procedure "lister_$open_file" set ref 171 171 171* 175 184* version based fixed bin(17,0) level 2 in structure "fieldname_info" dcl 64 in procedure "lister_$open_file" set ref 319* NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. ANY_FIELD internal static fixed bin(8,0) initial dcl 2-183 MERGE_ADD internal static fixed bin(17,0) initial dcl 2-210 MERGE_AND internal static fixed bin(17,0) initial dcl 2-210 MERGE_OR internal static fixed bin(17,0) initial dcl 2-210 MERGE_SUBTRACT internal static fixed bin(17,0) initial dcl 2-210 MIN_FIELD_INDEX internal static fixed bin(17,0) initial dcl 2-135 NULL_FIELD internal static fixed bin(8,0) initial dcl 2-183 NUMERIC_FIELD internal static fixed bin(8,0) initial dcl 2-183 PUT_ARGUMENT internal static fixed bin(17,0) initial dcl 2-100 PUT_DATE internal static fixed bin(17,0) initial dcl 2-100 PUT_END internal static fixed bin(17,0) initial dcl 2-100 PUT_LITERAL internal static fixed bin(17,0) initial dcl 2-100 PUT_RECORD_COUNT internal static fixed bin(17,0) initial dcl 2-100 PUT_SPACES internal static fixed bin(17,0) initial dcl 2-100 PUT_TIME internal static fixed bin(17,0) initial dcl 2-100 PUT_UID internal static fixed bin(17,0) initial dcl 2-100 SELECT_AND internal static bit(9) initial dcl 2-164 SELECT_BEG internal static bit(9) initial dcl 2-164 SELECT_END internal static bit(9) initial dcl 2-164 SELECT_EQ internal static bit(9) initial dcl 2-164 SELECT_FIND internal static bit(9) initial dcl 2-164 SELECT_GE internal static bit(9) initial dcl 2-164 SELECT_GT internal static bit(9) initial dcl 2-164 SELECT_LE internal static bit(9) initial dcl 2-164 SELECT_LT internal static bit(9) initial dcl 2-164 SELECT_NEQ internal static bit(9) initial dcl 2-164 SELECT_NGE internal static bit(9) initial dcl 2-164 SELECT_NGT internal static bit(9) initial dcl 2-164 SELECT_NLE internal static bit(9) initial dcl 2-164 SELECT_NLT internal static bit(9) initial dcl 2-164 SELECT_NOT internal static bit(9) initial dcl 2-164 SELECT_OR internal static bit(9) initial dcl 2-164 UID internal static fixed bin(8,0) initial dcl 2-183 center internal static bit(2) initial dcl 2-129 element automatic structure level 1 dcl 2-143 flush_left internal static bit(2) initial dcl 2-129 flush_right internal static bit(2) initial dcl 2-129 format_table based structure level 1 dcl 2-111 format_table_ptr automatic pointer dcl 2-75 in_file_ptr automatic pointer dcl 2-75 input_file based structure level 1 dcl 2-14 input_record based structure level 1 dcl 2-50 lister_assign_ 000000 constant entry external dcl 1-13 lister_compare_field_tables_ 000000 constant entry external dcl 1-63 lister_compile_listin_ 000000 constant entry external dcl 1-20 lister_compile_select_ 000000 constant entry external dcl 1-30 lister_compile_sort_ 000000 constant entry external dcl 1-39 lister_convert_ 000000 constant entry external dcl 1-48 lister_copy_file_head_ 000000 constant entry external dcl 1-52 lister_copy_records_ 000000 constant entry external dcl 1-57 lister_create_record_$after 000000 constant entry external dcl 1-76 lister_create_record_$retain_uid 000000 constant entry external dcl 1-83 lister_expand_ 000000 constant entry external dcl 1-95 lister_format_parse_ 000000 constant entry external dcl 1-119 lister_hash_fid_ 000000 constant entry external dcl 1-105 lister_merge_ 000000 constant entry external dcl 1-128 lister_print_ 000000 constant entry external dcl 1-139 lister_sort_ 000000 constant entry external dcl 1-162 lister_status_ 000000 constant entry external dcl 1-167 literal_table based structure level 1 dcl 2-124 ltp automatic pointer dcl 2-75 n_items_to_sort automatic fixed bin(17,0) dcl 2-198 numeric_atom based structure level 1 dcl 2-190 numeric_flag internal static fixed bin(35,0) initial dcl 2-194 operand1 defined fixed bin(17,0) dcl 2-143 operand2 defined fixed bin(17,0) dcl 2-143 recordp automatic pointer dcl 2-75 select_expression based structure level 1 dcl 2-143 select_ptr automatic pointer dcl 2-75 sort_list based structure level 1 dcl 2-201 sort_list_ptr automatic pointer dcl 2-198 up_file_ptr automatic pointer dcl 2-75 update_file based structure level 1 dcl 2-26 update_record based structure level 1 dcl 2-57 NAMES DECLARED BY EXPLICIT CONTEXT. clean_up 001342 constant entry internal dcl 345 ref 137 198 206 235 245 336 341 lister_$add_record 000665 constant entry external dcl 249 lister_$close_file 001224 constant entry external dcl 331 lister_$get_fieldnames 001041 constant entry external dcl 290 lister_$open_file 000033 constant entry external dcl 29 NAME DECLARED BY CONTEXT OR IMPLICATION. addr builtin function ref 303 STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 1762 2034 1400 1772 Length 2314 1400 52 243 362 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME lister_$open_file 178 external procedure is an external procedure. on unit on line 137 64 on unit on unit on line 307 64 on unit on unit on line 336 64 on unit clean_up 64 internal procedure is called by several nonquick procedures. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME lister_$open_file 000100 bitcount lister_$open_file 000101 code lister_$open_file 000102 fieldx lister_$open_file 000103 field_len lister_$open_file 000104 field_ptr lister_$open_file 000106 file_info_ptr lister_$open_file 000110 open_info_ptr lister_$open_file 000112 out_recordp lister_$open_file 000114 record_info_ptr lister_$open_file 000116 selected_records_ptr lister_$open_file 000120 local_open_info lister_$open_file 000132 atom_length lister_$open_file 000134 atomp lister_$open_file 000136 fidp lister_$open_file 000140 field_table_ptr lister_$open_file 000142 out_file_ptr lister_$open_file 000144 n lister_$open_file 000146 area_ptr lister_$open_file THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs call_ext_out_desc call_ext_out call_int_this call_int_other return enable shorten_stack ext_entry ext_entry_desc int_entry pointer_hard offset_hard alloc_based free_based empty THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. adjust_bit_count_ get_system_free_area_ hcs_$initiate hcs_$make_seg hcs_$terminate_noname lister_create_record_ lister_delete_ lister_hash_fid_$enter lister_select_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. lister_codes_$cant_assign_fieldnames lister_codes_$dup_fieldname lister_codes_$fieldname_info_ptr_null lister_codes_$file_info_ptr_null lister_codes_$open_info_mbz_bad lister_codes_$open_info_wrong_version lister_codes_$record_info_wrong_version lister_codes_$wrong_no_of_fields LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 2 71 000023 29 000026 135 000061 136 000063 137 000064 140 000106 142 000112 144 000115 145 000120 148 000121 150 000124 151 000127 154 000130 156 000174 158 000240 160 000244 161 000246 164 000247 166 000256 167 000263 168 000265 169 000273 171 000300 175 000307 177 000311 178 000314 179 000316 180 000320 181 000321 182 000322 183 000323 184 000325 185 000327 188 000330 190 000334 191 000355 194 000366 197 000375 198 000400 199 000404 203 000405 205 000411 206 000414 207 000420 210 000421 212 000425 214 000430 216 000441 217 000447 218 000457 219 000461 222 000467 224 000474 225 000505 226 000512 227 000515 228 000520 230 000531 231 000543 232 000614 234 000621 235 000624 236 000630 238 000631 239 000640 240 000645 243 000647 244 000651 245 000653 246 000657 247 000660 249 000661 252 000700 253 000703 255 000707 257 000712 258 000715 261 000716 263 000722 264 000725 267 000726 268 000730 270 000734 272 000742 273 000745 276 000746 278 000757 279 000767 280 000773 282 000776 283 001007 284 001016 285 001030 287 001032 288 001033 290 001034 293 001054 294 001057 295 001063 297 001065 299 001070 300 001073 303 001074 305 001076 307 001100 309 001114 311 001130 313 001131 314 001134 316 001140 318 001145 319 001157 320 001161 322 001163 323 001171 325 001210 327 001212 328 001216 329 001217 331 001220 334 001237 335 001241 336 001244 339 001266 340 001322 341 001333 342 001337 343 001340 345 001341 348 001347 350 001354 351 001361 354 001364 356 001370 357 001372 360 001375 ----------------------------------------------------------- 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