COMPILATION LISTING OF SEGMENT lister_format_parse_ Compiled by: Multics PL/I Compiler, Release 33a, of May 30, 1990 Compiled at: ACTC Technologies Inc. Compiled on: 10/17/90 0942.6 mdt Wed Options: optimize map 1 /****^ *********************************************************** 2* * * 3* * Copyright, (C) BULL HN Information Systems Inc., 1990 * 4* * * 5* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 6* * * 7* * Copyright (c) 1972 by Massachusetts Institute of * 8* * Technology and Honeywell Information Systems, Inc. * 9* * * 10* *********************************************************** */ 11 12 13 14 /****^ HISTORY COMMENTS: 15* 1) change(90-08-15,Gray), approve(90-08-15,MCR8157), audit(90-10-17,Bubric), 16* install(90-10-17,MR12.4-1046): 17* Fix error message when there is no "" token. Wordpro 1152 18* END HISTORY COMMENTS */ 19 20 21 /* Modified 780407 by PG to implement :argN and suggestion 20 (map << to <) 22* Modified 781010 by PG to get :argN to parse correctly. 23* Modified 791217 by PG to fix 027 (pls dies if fieldname used in Before or After section). 24* Modified 800414 by PB to put line numbers in listform error messages. 25* Modified 800813 by PB to recognize :uid. 26* Modified 840521 by PB to allow :argumentN as alternate for :argN. 27**/ 28 29 /* format: style3 */ 30 lister_format_parse_: 31 procedure (bv_in_file_ptr, bv_area_ptr, bv_input, bv_format_table_ptr, bv_error_token, bv_code) options (packed_decimal); 32 33 /* parameters */ 34 35 declare ( 36 bv_in_file_ptr ptr, 37 bv_area_ptr ptr, 38 bv_input char (*), 39 bv_format_table_ptr ptr, 40 bv_error_token char (*), 41 bv_code fixed bin (35) 42 ) parameter; 43 44 /* automatic */ 45 46 declare c char (1) aligned, 47 code fixed bin (35), 48 comma_seen bit (1) aligned, 49 commax fixed bin (21), 50 done bit (1) aligned, 51 eof bit (1) aligned, 52 field_arg_number fixed bin, 53 field_index fixed bin, 54 field_justification bit (2) aligned, 55 field_width fixed bin (21), 56 fmt_length fixed bin (21), 57 fmtx fixed bin, 58 format_begin fixed bin, 59 keyword_type fixed bin, 60 line_no fixed bin, 61 literals_done bit (1) aligned, 62 litx fixed bin, 63 scan_index fixed bin (21), 64 scan_start fixed bin (21), 65 token_len fixed bin (21); 66 67 /* builtin */ 68 69 declare (char, hbound, index, length, ltrim, null, substr, verify) 70 builtin; 71 72 /* entries */ 73 74 declare cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin); 75 76 /* external static */ 77 78 declare ( 79 lister_codes_$dup_format, 80 lister_codes_$listform_bad_arg_number, 81 lister_codes_$listform_bad_justify, 82 lister_codes_$listform_bad_width, 83 lister_codes_$listform_misplaced_fieldname, 84 lister_codes_$listform_missing_begin, 85 lister_codes_$listform_missing_gt, 86 lister_codes_$listform_missing_lt, 87 lister_codes_$listform_unknown_fieldname, 88 lister_codes_$listform_unknown_keyword 89 ) fixed bin (35) external static; 90 91 /* internal static */ 92 93 declare ( 94 NL char (1) initial (" 95 "), 96 NL_HT_SP_VT_NP char (5) initial (" 97 "), 98 format_type (3) char (6) varying initial ("before", "record", "after"), 99 BEFORE fixed bin initial (1), 100 RECORD fixed bin initial (2), 101 AFTER fixed bin initial (3) 102 ) internal static; 103 104 /* include files */ 105 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 ----------------------------------- */ 106 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 -------------------------------- */ 107 108 109 /* program */ 110 111 in_file_ptr = bv_in_file_ptr; 112 area_ptr = bv_area_ptr; 113 bv_format_table_ptr = null; 114 bv_code = 0; 115 116 /* Allocate initial format table and literal table. */ 117 118 n = 50; 119 allocate format_table in (system_area) set (format_table_ptr); 120 format_table.size = n; 121 format_table.before = 0; 122 format_table.after = 0; 123 format_table.record = 0; 124 125 n = 50; 126 allocate literal_table in (system_area) set (ltp); 127 format_table.literal_table = ltp; 128 literal_table.size = n; 129 literal_table.n_literals = 0; 130 131 fmtx = 0; /* no formats so far */ 132 litx = 0; /* no literals so far */ 133 134 /* Now parse the listform segment. */ 135 136 scan_start = 1; 137 line_no = 1; 138 eof = "0"b; 139 do while (^eof); 140 141 /* Skip white space */ 142 143 scan_index = verify (substr (bv_input, scan_start), NL_HT_SP_VT_NP) - 1; 144 145 if scan_index ^= -1 146 then do; 147 call bump_line_no (scan_start, scan_index); 148 scan_start = scan_start + scan_index; 149 150 call parse_block (); 151 if bv_code ^= 0 152 then return; 153 end; 154 else eof = "1"b; 155 end; 156 157 /* All done, wrap things up... */ 158 159 bv_format_table_ptr = format_table_ptr; 160 return; 161 162 parse_block: 163 procedure (); 164 165 /* program */ 166 167 if substr (bv_input, scan_start, 1) ^= "<" 168 then do; 169 bv_code = lister_codes_$listform_missing_lt; 170 bv_error_token = NL||"Error in line "||ltrim (char (line_no))||"."; 171 return; 172 end; 173 174 scan_start = scan_start + 1; 175 176 if substr (bv_input, scan_start, 6) ^= "Begin " 177 then do; 178 bv_code = lister_codes_$listform_missing_begin; 179 bv_error_token = NL||"Error in line "||ltrim (char (line_no))||"."; 180 return; 181 end; 182 183 scan_start = scan_start + 6; 184 185 if substr (bv_input, scan_start, 8) = "before:>" 186 then keyword_type = BEFORE; 187 else if substr (bv_input, scan_start, 8) = "record:>" 188 then keyword_type = RECORD; 189 else if substr (bv_input, scan_start, 7) = "after:>" 190 then keyword_type = AFTER; 191 else do; 192 bv_code = lister_codes_$listform_unknown_keyword; 193 bv_error_token = substr (bv_input, scan_start, index (substr (bv_input, scan_start), ">") - 1)||NL||"Error in line "||ltrim (char (line_no))||"."; 194 return; 195 end; 196 197 if keyword_type = AFTER 198 then scan_start = scan_start + 7; 199 else scan_start = scan_start + 8; 200 201 format_begin = fmtx + 1; 202 done = "0"b; 203 do while (^done); 204 205 /* Scan literal field */ 206 207 literals_done = "0"b; 208 do while (^literals_done); 209 scan_index = index (substr (bv_input, scan_start), "<") - 1; 210 if scan_index = -1 211 then do; 212 bv_code = lister_codes_$listform_missing_lt; 213 bv_error_token = NL || "Error at end of listform segment. Missing """" string."; 214 return; 215 end; 216 217 /* Check for "<<" ... gets mapped into "<" */ 218 219 if scan_start + scan_index < length (bv_input) 220 then if substr (bv_input, scan_start + scan_index + 1, 1) = "<" 221 then scan_index = scan_index + 1; /* include first < in current literal */ 222 else literals_done = "1"b; 223 else literals_done = "1"b; 224 225 if scan_index > 0 226 then do; /* We have a literal, save it */ 227 fmtx = fmtx + 1; 228 if fmtx > hbound (format_table.item, 1) 229 then call reallocate_format_table; 230 231 if substr (bv_input, scan_start, scan_index) = "" 232 then do; 233 format_table.item (fmtx).action = PUT_SPACES; 234 format_table.item (fmtx).width = scan_index; 235 end; 236 else do; 237 format_table.item (fmtx).action = PUT_LITERAL; 238 format_table.item (fmtx).width = save_literal (scan_start, scan_index); 239 end; 240 241 call bump_line_no (scan_start, scan_index); 242 scan_start = scan_start + scan_index; 243 /* step over literal */ 244 245 end; 246 247 /* Current char = "<". Step over it. */ 248 249 scan_start = scan_start + 1; 250 end; 251 252 /* Scan format field. */ 253 254 fmt_length = index (substr (bv_input, scan_start), ">"); 255 if fmt_length = 0 256 then do; 257 bv_code = lister_codes_$listform_missing_gt; 258 bv_error_token = NL||"Error in line "||ltrim (char (line_no))||"."; 259 return; 260 end; 261 262 if substr (bv_input, scan_start, fmt_length) = "end;>" 263 then do; 264 scan_start = scan_start + 5; /* step over "end;>" */ 265 266 if keyword_type = BEFORE 267 then do; 268 if format_table.before ^= 0 269 then go to duplicate_keyword; 270 271 format_table.before = format_begin; 272 end; 273 else if keyword_type = RECORD 274 then do; 275 if format_table.record ^= 0 276 then go to duplicate_keyword; 277 278 format_table.record = format_begin; 279 end; 280 else do; 281 if format_table.after ^= 0 282 then do; 283 284 duplicate_keyword: 285 bv_code = lister_codes_$dup_format; 286 bv_error_token = format_type (keyword_type)||NL||"Error in line "||ltrim (char (line_no))||"."; 287 return; 288 end; 289 290 format_table.after = format_begin; 291 end; 292 293 fmtx = fmtx + 1; 294 if fmtx > hbound (format_table.item, 1) 295 then call reallocate_format_table; 296 297 format_table.item (fmtx).action = PUT_END; 298 done = "1"b; 299 end; 300 else do; 301 302 /* Scanning regular format. Syntax is: */ 303 304 commax = index (substr (bv_input, scan_start, fmt_length), ","); 305 if commax = 0 306 then do; 307 comma_seen = "0"b; 308 token_len = fmt_length - 1; 309 end; 310 else do; 311 comma_seen = "1"b; 312 token_len = commax - 1; 313 end; 314 315 field_index = lister_hash_fid_ (in_file_ptr, substr (bv_input, scan_start, token_len)); 316 if field_index = -1 317 then if substr (bv_input, scan_start, token_len) = ":date" 318 then field_index = PUT_DATE; 319 else if substr (bv_input, scan_start, token_len) = ":time" 320 then field_index = PUT_TIME; 321 else if substr (bv_input, scan_start, token_len) = ":record_count" 322 then field_index = PUT_RECORD_COUNT; 323 else if substr (bv_input, scan_start, token_len) = ":uid" 324 then field_index = PUT_UID; 325 else do; 326 call check_for_arg; 327 if bv_code ^= 0 328 then return; 329 end; 330 else field_arg_number = 0; 331 332 if (field_index >= 0) & (keyword_type ^= RECORD) 333 then do; 334 bv_code = lister_codes_$listform_misplaced_fieldname; 335 bv_error_token = substr (bv_input, scan_start, token_len)||NL||"Error in line "||ltrim (char (line_no))||"."; 336 return; 337 end; 338 339 call bump_line_no (scan_start, token_len); 340 scan_start = scan_start + token_len; 341 /* step over fieldname */ 342 fmt_length = fmt_length - token_len; 343 /* reduce format length */ 344 345 if comma_seen 346 then do; 347 scan_start = scan_start + 1; 348 fmt_length = fmt_length - 1; 349 end; 350 351 /* Fieldname scanned, check for field width */ 352 353 commax = index (substr (bv_input, scan_start, fmt_length), ","); 354 if commax = 0 355 then do; 356 comma_seen = "0"b; 357 token_len = fmt_length - 1; 358 end; 359 else do; 360 comma_seen = "1"b; 361 token_len = commax - 1; 362 end; 363 364 if token_len > 0 365 then do; 366 field_width = cv_dec_check_ (substr (bv_input, scan_start, token_len), code); 367 if code ^= 0 | field_width < 0 368 then do; 369 bv_code = lister_codes_$listform_bad_width; 370 bv_error_token = substr (bv_input, scan_start, token_len)||NL||"Error in line "||ltrim (char (line_no))||"."; 371 return; 372 end; 373 end; 374 else field_width = 0; 375 376 call bump_line_no (scan_start, token_len); 377 scan_start = scan_start + token_len; 378 fmt_length = fmt_length - token_len; 379 380 if comma_seen 381 then do; 382 scan_start = scan_start + 1; 383 fmt_length = fmt_length - 1; 384 end; 385 386 /* Width scanned, check for justification */ 387 388 token_len = fmt_length - 1; 389 390 if token_len > 0 391 then do; 392 c = substr (bv_input, scan_start, 1); 393 394 if ((c = "l") | (c = "L")) & token_len = 1 395 then field_justification = flush_left; 396 else if ((c = "r") | (c = "R")) & token_len = 1 397 then field_justification = flush_right; 398 else if ((c = "c") | (c = "C")) & token_len = 1 399 then field_justification = center; 400 else do; 401 bv_code = lister_codes_$listform_bad_justify; 402 bv_error_token = substr (bv_input, scan_start, token_len)||NL||"Error in line "||ltrim (char (line_no))||"."; 403 return; 404 end; 405 end; 406 else field_justification = flush_left; 407 408 call bump_line_no (scan_start, fmt_length); 409 scan_start = scan_start + fmt_length; 410 /* step over rest of format */ 411 412 fmtx = fmtx + 1; 413 if fmtx > hbound (format_table.item, 1) 414 then call reallocate_format_table; 415 416 format_table.item (fmtx).action = field_index; 417 format_table.item (fmtx).width = field_width; 418 format_table.item (fmtx).justification = field_justification; 419 format_table.item (fmtx).argument_number = field_arg_number; 420 end; 421 end; /* do while (^done) */ 422 423 reallocate_format_table: 424 procedure (); 425 426 /* automatic */ 427 428 declare fmx fixed bin, 429 new_format_table_ptr 430 ptr; 431 432 /* program */ 433 434 n = format_table.size + 50; 435 allocate format_table in (system_area) set (new_format_table_ptr); 436 437 new_format_table_ptr -> format_table.size = n; 438 new_format_table_ptr -> format_table.before = format_table.before; 439 new_format_table_ptr -> format_table.after = format_table.after; 440 new_format_table_ptr -> format_table.record = format_table.record; 441 new_format_table_ptr -> format_table.literal_table = format_table.literal_table; 442 443 do fmx = 1 to format_table.size; 444 new_format_table_ptr -> format_table.item (fmx) = format_table.item (fmx); 445 end; 446 447 n = format_table.size; 448 free format_table in (system_area); 449 format_table_ptr = new_format_table_ptr; 450 return; 451 452 end reallocate_format_table; 453 454 reallocate_literal_table: 455 procedure (); 456 457 /* automatic */ 458 459 declare ltx fixed bin, 460 new_ltp ptr; 461 462 /* program */ 463 464 n = literal_table.size + 50; 465 allocate literal_table in (system_area) set (new_ltp); 466 467 new_ltp -> literal_table.size = n; 468 new_ltp -> literal_table.n_literals = literal_table.n_literals; 469 470 do ltx = 1 to literal_table.size; 471 new_ltp -> literal_table.literal (ltx) = literal_table.literal (ltx); 472 end; 473 474 n = literal_table.size; 475 free literal_table in (system_area); 476 477 ltp = new_ltp; 478 format_table.literal_table = ltp; 479 return; 480 481 end reallocate_literal_table; 482 483 484 save_literal: 485 procedure (bv_lit_start, bv_lit_length) returns (fixed bin); 486 487 /* parameters */ 488 489 declare ( 490 bv_lit_start fixed bin (21), 491 bv_lit_length fixed bin (21) 492 ) parameter; 493 494 /* automatic */ 495 496 declare found bit (1) aligned, 497 new_litx fixed bin; 498 499 /* program */ 500 501 found = "0"b; 502 do new_litx = 1 to litx while (^found); 503 if length (literal_table.literal (new_litx) -> atom) = bv_lit_length 504 then if literal_table.literal (new_litx) -> atom = substr (bv_input, bv_lit_start, bv_lit_length) 505 then found = "1"b; 506 end; 507 508 if ^found 509 then do; 510 atom_length = bv_lit_length; 511 allocate atom in (system_area) set (atomp); 512 atom = substr (bv_input, bv_lit_start, bv_lit_length); 513 new_litx, litx = litx + 1; 514 if litx > hbound (literal_table.literal, 1) 515 then call reallocate_literal_table; 516 517 literal_table.literal (new_litx) = atomp; 518 literal_table.n_literals = literal_table.n_literals + 1; 519 end; 520 else new_litx = new_litx - 1; 521 522 return (new_litx); 523 524 end save_literal; 525 526 end /* parse_block */; 527 528 529 bump_line_no: 530 procedure (bv_scan_start, bv_bump_amt); 531 532 /* parameters */ 533 534 declare ( 535 bv_scan_start fixed bin (21), 536 bv_bump_amt fixed bin (21) 537 ) parameter; 538 539 /* automatic */ 540 541 declare offset fixed bin, 542 index_cnt fixed bin; 543 544 /* program */ 545 546 offset = 0; 547 index_cnt = index (substr (bv_input, bv_scan_start + offset, bv_bump_amt - offset), NL); 548 do while (index_cnt ^= 0); 549 line_no = line_no + 1; 550 offset = offset + index_cnt; 551 index_cnt = index (substr (bv_input, bv_scan_start + offset, bv_bump_amt - offset), NL); 552 end; 553 554 end bump_line_no; 555 556 check_for_arg: 557 proc; 558 559 if token_len > 4 & token_len < 10 560 then if substr (bv_input, scan_start, 4) = ":arg" & token_len < 10 561 then do; 562 field_index = PUT_ARGUMENT; 563 field_arg_number = 564 cv_dec_check_ (substr (bv_input, scan_start + 4, token_len - 4), code); 565 if code ^= 0 | field_arg_number < 0 566 then do; 567 bv_code = lister_codes_$listform_bad_arg_number; 568 bv_error_token = substr (bv_input, scan_start + 4, token_len - 4) 569 ||NL||"Error in line "||ltrim (char (line_no))||"."; 570 end; 571 return; 572 end; 573 if token_len > 9 574 then if substr (bv_input, scan_start, 9) = ":argument" 575 then do; 576 field_index = PUT_ARGUMENT; 577 field_arg_number = 578 cv_dec_check_ (substr (bv_input, scan_start + 9, token_len - 9), code); 579 if code ^= 0 | field_arg_number < 0 580 then do; 581 bv_code = lister_codes_$listform_bad_arg_number; 582 bv_error_token = substr (bv_input, scan_start + 9, token_len - 9)||NL||"Error in line "||ltrim (char (line_no))||"."; 583 end; 584 return; 585 end; 586 bv_code = lister_codes_$listform_unknown_fieldname; 587 bv_error_token = substr (bv_input, scan_start, token_len)||NL||"Error in line "||ltrim (char (line_no))||"."; 588 589 end check_for_arg; 590 591 end /* lister_format_parse_ */; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 10/17/90 0942.6 lister_format_parse_.pl1 >spec>install>1046>lister_format_parse_.pl1 106 1 04/25/81 0828.4 lister_entries.incl.pl1 >ldd>include>lister_entries.incl.pl1 107 2 11/06/84 1047.7 lister_structures.incl.pl1 >ldd>include>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. AFTER constant fixed bin(17,0) initial dcl 93 ref 189 197 BEFORE constant fixed bin(17,0) initial dcl 93 ref 185 266 NL 003462 constant char(1) initial packed unaligned dcl 93 ref 170 179 193 213 258 286 335 370 402 547 551 568 582 587 NL_HT_SP_VT_NP 000012 constant char(5) initial packed unaligned dcl 93 ref 143 PUT_ARGUMENT constant fixed bin(17,0) initial dcl 2-100 ref 562 576 PUT_DATE constant fixed bin(17,0) initial dcl 2-100 ref 316 PUT_END constant fixed bin(17,0) initial dcl 2-100 ref 297 PUT_LITERAL constant fixed bin(17,0) initial dcl 2-100 ref 237 PUT_RECORD_COUNT constant fixed bin(17,0) initial dcl 2-100 ref 321 PUT_SPACES constant fixed bin(17,0) initial dcl 2-100 ref 233 PUT_TIME constant fixed bin(17,0) initial dcl 2-100 ref 319 PUT_UID constant fixed bin(17,0) initial dcl 2-100 ref 323 RECORD constant fixed bin(17,0) initial dcl 93 ref 187 273 332 action 4 based fixed bin(17,0) array level 3 packed packed unaligned dcl 2-111 set ref 233* 237* 297* 416* after 1 based fixed bin(17,0) level 2 packed packed unaligned dcl 2-111 set ref 122* 281 290* 439* 439 area_ptr 000140 automatic pointer dcl 2-96 set ref 112* 119 126 435 448 465 475 511 argument_number 4(20) based fixed bin(15,0) array level 3 packed packed unaligned dcl 2-111 set ref 419* atom based varying char dcl 2-71 set ref 503 503 511 512* atom_length 000124 automatic fixed bin(17,0) initial dcl 2-71 set ref 2-71* 510* 511 512 atomp 000126 automatic pointer dcl 2-71 set ref 511* 512 517 before 0(18) based fixed bin(17,0) level 2 packed packed unaligned dcl 2-111 set ref 121* 268 271* 438* 438 bv_area_ptr parameter pointer dcl 35 ref 30 112 bv_bump_amt parameter fixed bin(21,0) dcl 534 ref 529 547 551 bv_code parameter fixed bin(35,0) dcl 35 set ref 30 114* 151 169* 178* 192* 212* 257* 284* 327 334* 369* 401* 567* 581* 586* bv_error_token parameter char packed unaligned dcl 35 set ref 30 170* 179* 193* 213* 258* 286* 335* 370* 402* 568* 582* 587* bv_format_table_ptr parameter pointer dcl 35 set ref 30 113* 159* bv_in_file_ptr parameter pointer dcl 35 ref 30 111 bv_input parameter char packed unaligned dcl 35 ref 30 143 167 176 185 187 189 193 193 209 219 219 231 254 262 304 315 315 316 319 321 323 335 353 366 366 370 392 402 503 512 547 551 559 563 563 568 573 577 577 582 587 bv_lit_length parameter fixed bin(21,0) dcl 489 ref 484 503 503 510 512 bv_lit_start parameter fixed bin(21,0) dcl 489 ref 484 503 512 bv_scan_start parameter fixed bin(21,0) dcl 534 ref 529 547 551 c 000100 automatic char(1) dcl 46 set ref 392* 394 394 396 396 398 398 center constant bit(2) initial dcl 2-129 ref 398 char builtin function dcl 69 ref 170 179 193 258 286 335 370 402 568 582 587 code 000101 automatic fixed bin(35,0) dcl 46 set ref 366* 367 563* 565 577* 579 comma_seen 000102 automatic bit(1) dcl 46 set ref 307* 311* 345 356* 360* 380 commax 000103 automatic fixed bin(21,0) dcl 46 set ref 304* 305 312 353* 354 361 cv_dec_check_ 000010 constant entry external dcl 74 ref 366 563 577 done 000104 automatic bit(1) dcl 46 set ref 202* 203 298* eof 000105 automatic bit(1) dcl 46 set ref 138* 139 154* field_arg_number 000106 automatic fixed bin(17,0) dcl 46 set ref 330* 419 563* 565 577* 579 field_index 000107 automatic fixed bin(17,0) dcl 46 set ref 315* 316 316* 319* 321* 323* 332 416 562* 576* field_justification 000110 automatic bit(2) dcl 46 set ref 394* 396* 398* 406* 418 field_width 000111 automatic fixed bin(21,0) dcl 46 set ref 366* 367 374* 417 flush_left constant bit(2) initial dcl 2-129 ref 394 406 flush_right constant bit(2) initial dcl 2-129 ref 396 fmt_length 000112 automatic fixed bin(21,0) dcl 46 set ref 254* 255 262 304 308 342* 342 348* 348 353 357 378* 378 383* 383 388 408* 409 fmtx 000113 automatic fixed bin(17,0) dcl 46 set ref 131* 201 227* 227 228 233 234 237 238 293* 293 294 297 412* 412 413 416 417 418 419 fmx 000156 automatic fixed bin(17,0) dcl 428 set ref 443* 444 444* format_begin 000114 automatic fixed bin(17,0) dcl 46 set ref 201* 271 278 290 format_table based structure level 1 dcl 2-111 set ref 119 435 448 format_table_ptr 000130 automatic pointer dcl 2-75 set ref 119* 120 121 122 123 127 159 228 233 234 237 238 268 271 275 278 281 290 294 297 413 416 417 418 419 434 438 439 440 441 443 444 447 448 449* 478 format_type 000000 constant varying char(6) initial array dcl 93 ref 286 found 000226 automatic bit(1) dcl 496 set ref 501* 502 503* 508 hbound builtin function dcl 69 ref 228 294 413 514 in_file_ptr 000132 automatic pointer dcl 2-75 set ref 111* 315* index builtin function dcl 69 ref 193 209 254 304 353 547 551 index_cnt 000241 automatic fixed bin(17,0) dcl 541 set ref 547* 548 550 551* item 4 based structure array level 2 dcl 2-111 set ref 228 294 413 444* 444 justification 4(18) based bit(2) array level 3 packed packed unaligned dcl 2-111 set ref 418* keyword_type 000115 automatic fixed bin(17,0) dcl 46 set ref 185* 187* 189* 197 266 273 286 332 length builtin function dcl 69 ref 219 503 line_no 000116 automatic fixed bin(17,0) dcl 46 set ref 137* 170 179 193 258 286 335 370 402 549* 549 568 582 587 lister_codes_$dup_format 000012 external static fixed bin(35,0) dcl 78 ref 284 lister_codes_$listform_bad_arg_number 000014 external static fixed bin(35,0) dcl 78 ref 567 581 lister_codes_$listform_bad_justify 000016 external static fixed bin(35,0) dcl 78 ref 401 lister_codes_$listform_bad_width 000020 external static fixed bin(35,0) dcl 78 ref 369 lister_codes_$listform_misplaced_fieldname 000022 external static fixed bin(35,0) dcl 78 ref 334 lister_codes_$listform_missing_begin 000024 external static fixed bin(35,0) dcl 78 ref 178 lister_codes_$listform_missing_gt 000026 external static fixed bin(35,0) dcl 78 ref 257 lister_codes_$listform_missing_lt 000030 external static fixed bin(35,0) dcl 78 ref 169 212 lister_codes_$listform_unknown_fieldname 000032 external static fixed bin(35,0) dcl 78 ref 586 lister_codes_$listform_unknown_keyword 000034 external static fixed bin(35,0) dcl 78 ref 192 lister_hash_fid_ 000036 constant entry external dcl 1-105 ref 315 literal 2 based pointer array level 2 packed packed unaligned dcl 2-124 set ref 471* 471 503 503 514 517* literal_table 2 based pointer level 2 in structure "format_table" dcl 2-111 in procedure "lister_format_parse_" set ref 127* 441* 441 478* literal_table based structure level 1 dcl 2-124 in procedure "lister_format_parse_" set ref 126 465 475 literals_done 000117 automatic bit(1) dcl 46 set ref 207* 208 222* 223* litx 000120 automatic fixed bin(17,0) dcl 46 set ref 132* 502 513 513* 514 ltp 000134 automatic pointer dcl 2-75 set ref 126* 127 128 129 464 468 470 471 474 475 477* 478 503 503 514 517 518 518 ltrim builtin function dcl 69 ref 170 179 193 258 286 335 370 402 568 582 587 ltx 000212 automatic fixed bin(17,0) dcl 459 set ref 470* 471 471* n 000136 automatic fixed bin(17,0) dcl 2-75 set ref 118* 119 119 120 125* 126 126 128 434* 435 435 437 447* 464* 465 465 467 474* n_literals 1 based fixed bin(17,0) level 2 dcl 2-124 set ref 129* 468* 468 518* 518 new_format_table_ptr 000160 automatic pointer dcl 428 set ref 435* 437 438 439 440 441 444 449 new_litx 000227 automatic fixed bin(17,0) dcl 496 set ref 502* 503 503* 513* 517 520* 520 522 new_ltp 000214 automatic pointer dcl 459 set ref 465* 467 468 471 477 null builtin function dcl 69 ref 113 offset 000240 automatic fixed bin(17,0) dcl 541 set ref 546* 547 547 550* 550 551 551 record 1(18) based fixed bin(17,0) level 2 packed packed unaligned dcl 2-111 set ref 123* 275 278* 440* 440 scan_index 000121 automatic fixed bin(21,0) dcl 46 set ref 143* 145 147* 148 209* 210 219 219 219* 219 225 231 234 238* 241* 242 scan_start 000122 automatic fixed bin(21,0) dcl 46 set ref 136* 143 147* 148* 148 167 174* 174 176 183* 183 185 187 189 193 193 197* 197 199* 199 209 219 219 231 238* 241* 242* 242 249* 249 254 262 264* 264 304 315 315 316 319 321 323 335 339* 340* 340 347* 347 353 366 366 370 376* 377* 377 382* 382 392 402 408* 409* 409 559 563 563 568 573 577 577 582 587 size based fixed bin(17,0) level 2 in structure "format_table" packed packed unaligned dcl 2-111 in procedure "lister_format_parse_" set ref 119* 120* 228 294 413 434 435* 437* 443 447 448 size based fixed bin(17,0) level 2 in structure "literal_table" dcl 2-124 in procedure "lister_format_parse_" set ref 126* 128* 464 465* 467* 470 474 475 514 substr builtin function dcl 69 ref 143 167 176 185 187 189 193 193 209 219 231 254 262 304 315 315 316 319 321 323 335 353 366 366 370 392 402 503 512 547 551 559 563 563 568 573 577 577 582 587 system_area based area(261120) dcl 2-95 ref 119 126 435 448 465 475 511 token_len 000123 automatic fixed bin(21,0) dcl 46 set ref 308* 312* 315 315 316 319 321 323 335 339* 340 342 357* 361* 364 366 366 370 376* 377 378 388* 390 394 396 398 402 559 559 559 563 563 568 573 577 577 582 587 verify builtin function dcl 69 ref 143 width 5 based fixed bin(21,0) array level 3 dcl 2-111 set ref 234* 238* 417* 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 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 element automatic structure level 1 dcl 2-143 fidp automatic pointer dcl 2-75 field_identifier based structure level 1 dcl 2-89 field_table based structure level 1 dcl 2-79 field_table_ptr automatic pointer dcl 2-75 input_file based structure level 1 dcl 2-14 input_record based structure level 1 dcl 2-50 list_node based structure level 1 dcl 2-137 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_ 000000 constant entry external dcl 1-70 lister_create_record_$after 000000 constant entry external dcl 1-76 lister_create_record_$retain_uid 000000 constant entry external dcl 1-83 lister_delete_ 000000 constant entry external dcl 1-90 lister_expand_ 000000 constant entry external dcl 1-95 lister_file_version_2 internal static fixed bin(17,0) initial dcl 2-11 lister_format_parse_ 000000 constant entry external dcl 1-119 lister_hash_fid_$enter 000000 constant entry external dcl 1-112 lister_merge_ 000000 constant entry external dcl 1-128 lister_print_ 000000 constant entry external dcl 1-139 lister_select_ 000000 constant entry external dcl 1-154 lister_sort_ 000000 constant entry external dcl 1-162 lister_status_ 000000 constant entry external dcl 1-167 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 out_file_ptr automatic pointer dcl 2-75 output_file based structure level 1 dcl 2-38 output_record based structure level 1 dcl 2-64 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. bump_line_no 002463 constant entry internal dcl 529 ref 147 241 339 376 408 check_for_arg 002540 constant entry internal dcl 556 ref 326 duplicate_keyword 001150 constant label dcl 284 ref 268 275 lister_format_parse_ 000112 constant entry external dcl 30 parse_block 000257 constant entry internal dcl 162 ref 150 reallocate_format_table 002206 constant entry internal dcl 423 ref 228 294 413 reallocate_literal_table 002273 constant entry internal dcl 454 ref 514 save_literal 002343 constant entry internal dcl 484 ref 238 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 3670 3730 3466 3700 Length 4154 3466 40 210 202 0 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME lister_format_parse_ 219 external procedure is an external procedure. parse_block internal procedure shares stack frame of external procedure lister_format_parse_. reallocate_format_table internal procedure shares stack frame of external procedure lister_format_parse_. reallocate_literal_table internal procedure shares stack frame of external procedure lister_format_parse_. save_literal internal procedure shares stack frame of external procedure lister_format_parse_. bump_line_no internal procedure shares stack frame of external procedure lister_format_parse_. check_for_arg internal procedure shares stack frame of external procedure lister_format_parse_. STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME lister_format_parse_ 000100 c lister_format_parse_ 000101 code lister_format_parse_ 000102 comma_seen lister_format_parse_ 000103 commax lister_format_parse_ 000104 done lister_format_parse_ 000105 eof lister_format_parse_ 000106 field_arg_number lister_format_parse_ 000107 field_index lister_format_parse_ 000110 field_justification lister_format_parse_ 000111 field_width lister_format_parse_ 000112 fmt_length lister_format_parse_ 000113 fmtx lister_format_parse_ 000114 format_begin lister_format_parse_ 000115 keyword_type lister_format_parse_ 000116 line_no lister_format_parse_ 000117 literals_done lister_format_parse_ 000120 litx lister_format_parse_ 000121 scan_index lister_format_parse_ 000122 scan_start lister_format_parse_ 000123 token_len lister_format_parse_ 000124 atom_length lister_format_parse_ 000126 atomp lister_format_parse_ 000130 format_table_ptr lister_format_parse_ 000132 in_file_ptr lister_format_parse_ 000134 ltp lister_format_parse_ 000136 n lister_format_parse_ 000140 area_ptr lister_format_parse_ 000156 fmx reallocate_format_table 000160 new_format_table_ptr reallocate_format_table 000212 ltx reallocate_literal_table 000214 new_ltp reallocate_literal_table 000226 found save_literal 000227 new_litx save_literal 000240 offset bump_line_no 000241 index_cnt bump_line_no THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_l_a r_e_as alloc_char_temp cat_realloc_chars call_ext_out_desc return_mac shorten_stack ext_entry_desc op_alloc_ op_freen_ THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cv_dec_check_ lister_hash_fid_ THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. lister_codes_$dup_format lister_codes_$listform_bad_arg_number lister_codes_$listform_bad_justify lister_codes_$listform_bad_width lister_codes_$listform_misplaced_fieldname lister_codes_$listform_missing_begin lister_codes_$listform_missing_gt lister_codes_$listform_missing_lt lister_codes_$listform_unknown_fieldname lister_codes_$listform_unknown_keyword LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 30 000104 2 71 000132 111 000133 112 000137 113 000142 114 000144 118 000145 119 000147 121 000161 122 000163 123 000165 126 000167 127 000177 129 000201 131 000202 132 000203 136 000204 137 000206 138 000210 139 000211 143 000214 145 000235 147 000237 148 000241 150 000243 151 000244 153 000247 154 000250 155 000252 159 000253 160 000256 162 000257 167 000260 169 000267 170 000272 171 000351 174 000353 176 000354 178 000361 179 000364 180 000443 183 000445 185 000447 187 000461 189 000466 192 000476 193 000501 194 000615 197 000617 199 000624 201 000626 202 000631 203 000632 207 000634 208 000635 209 000640 210 000660 212 000662 213 000665 214 000702 219 000704 222 000716 223 000721 225 000723 227 000725 228 000726 231 000733 233 000743 234 000751 235 000754 237 000755 238 000763 241 000774 242 000776 249 001000 250 001001 254 001002 255 001023 257 001024 258 001027 259 001106 262 001110 264 001115 266 001117 268 001122 271 001126 272 001131 273 001132 275 001134 278 001141 279 001143 281 001144 284 001150 286 001153 287 001255 290 001257 293 001262 294 001263 297 001270 298 001276 299 001300 304 001301 305 001312 307 001313 308 001314 309 001317 311 001320 312 001322 315 001324 316 001354 319 001373 321 001402 323 001411 326 001420 327 001421 329 001425 330 001426 332 001427 334 001434 335 001440 336 001540 339 001542 340 001544 342 001546 345 001550 347 001552 348 001553 353 001555 354 001572 356 001573 357 001574 358 001577 360 001600 361 001602 364 001604 366 001605 367 001637 369 001644 370 001650 371 001750 373 001752 374 001753 376 001754 377 001756 378 001760 380 001762 382 001764 383 001765 388 001767 390 001772 392 001773 394 002002 396 002015 398 002027 401 002041 402 002044 403 002143 405 002145 406 002146 408 002147 409 002151 412 002153 413 002154 416 002161 417 002171 418 002173 419 002200 421 002204 526 002205 423 002206 434 002207 435 002213 438 002225 439 002227 440 002232 441 002234 443 002236 444 002247 445 002257 447 002261 448 002264 449 002270 450 002272 454 002273 464 002274 465 002277 468 002307 470 002312 471 002321 472 002326 474 002330 475 002332 477 002335 478 002337 479 002342 484 002343 501 002345 502 002346 503 002357 506 002404 508 002406 510 002410 511 002413 512 002423 513 002437 514 002443 517 002447 518 002453 519 002454 520 002455 522 002457 529 002463 546 002465 547 002466 548 002507 549 002512 550 002513 551 002514 552 002536 554 002537 556 002540 559 002541 562 002561 563 002563 565 002616 567 002623 568 002627 570 002731 571 002732 573 002733 576 002745 577 002747 579 003002 581 003007 582 003013 583 003115 584 003116 586 003117 587 003123 589 003223 ----------------------------------------------------------- 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