COMPILATION LISTING OF SEGMENT lister_compile_select_ Compiled by: Multics PL/I Compiler, Release 28d, of October 4, 1983 Compiled at: Honeywell Multics Op. - System M Compiled on: 11/05/84 1150.8 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_COMPILE_SELECT_ - Program to parse a select expression into a structure that drives 19* lister_select_. 20* 21* Written 761104 by PG 22* Modified 770818 by PG to cleanup error handling (bugs 1 and 9) 23* Modified 770921 by PG to make implementation agree with revised documentation 24* Modified 791210 by PG to implement sugg 37 (numeric selection), and to fix bugs 10 (null select expr 25* gets wrong error msg) and 19 (must accept singular and plural comparison ops). 26* Modified 800813 by PB to recognize :uid. 27* Modified 840523 by PB to add begins and ends operators. 28**/ 29 30 /* format: style3 */ 31 lister_compile_select_: 32 procedure (bv_select_string, bv_input_ptr, bv_area_ptr, bv_select_ptr, bv_error_token, bv_code) options (packed_decimal); 33 34 /* parameters */ 35 36 dcl ( 37 bv_area_ptr ptr, 38 bv_code fixed bin (35), 39 bv_error_token char (*), 40 bv_input_ptr ptr, 41 bv_select_ptr ptr, 42 bv_select_string char (*) 43 ) parameter; 44 45 /* automatic */ 46 47 dcl op_table (3) bit (9) aligned initial (SELECT_AND, SELECT_OR, SELECT_NOT); 48 49 dcl comparison_opcode (14) bit (9) aligned 50 initial (SELECT_EQ, SELECT_EQ, SELECT_LT, SELECT_GT, SELECT_FIND, SELECT_FIND, SELECT_NEQ, 51 SELECT_NEQ, SELECT_NLT, SELECT_NGT, SELECT_BEG, SELECT_BEG, SELECT_END, SELECT_END); 52 53 dcl code fixed bin (35), 54 i fixed bin, 55 ltx fixed bin, 56 selx fixed bin, 57 token_temp_seg_ptr ptr; 58 59 /* builtins */ 60 61 dcl (addr, collate, convert, hbound, lbound, length, null, substr, translate) 62 builtin; 63 64 /* conditions */ 65 66 dcl conversion condition; 67 68 /* entries */ 69 70 dcl lex_string_$init_lex_delims 71 entry (char (*), char (*), char (*), char (*), char (*), bit (*), char (*) varying aligned, 72 char (*) varying aligned, char (*) varying aligned, char (*) varying aligned), 73 lex_string_$lex entry (ptr, fixed bin (21), fixed bin (21), ptr, bit (*), char (*), char (*), char (*), 74 char (*), char (*), char (*) varying aligned, char (*) varying aligned, 75 char (*) varying aligned, char (*) varying aligned, ptr, ptr, fixed bin (35)), 76 translator_temp_$get_segment 77 entry (char (*), ptr, fixed bin (35)), 78 translator_temp_$release_all_segments 79 entry (ptr, fixed bin (35)); 80 81 /* external static */ 82 83 declare ( 84 error_table_$zero_length_seg, 85 lister_codes_$expression_too_complicated, 86 lister_codes_$incomplete_select_expression, 87 lister_codes_$invalid_op_null, 88 lister_codes_$invalid_op_numeric, 89 lister_codes_$missing_right_paren, 90 lister_codes_$null_select_expr, 91 lister_codes_$select_syntax_error, 92 lister_codes_$too_many_literals, 93 lister_codes_$undefined_fieldname, 94 lister_codes_$unknown_comparison_op 95 ) fixed bin (35) external static; 96 97 /* internal static */ 98 99 dcl comparison_op (14) char (8) varying internal static 100 initial ("equal", "equals", "less", "greater", "contain", "contains", "nequal", "nequals", 101 "nless", "ngreater", "begins", "begin", "ends", "end"); 102 103 dcl ( 104 (BREAKS, IGBREAKS, LEXCTL, LEXDLM) 105 char (128) varying aligned, 106 first_time bit (1) aligned initial ("1"b), 107 lower_case char (26) initial ("abcdefghijklmnopqrstuvwxyz"), 108 upper_case char (26) initial ("ABCDEFGHIJKLMNOPQRSTUVWXYZ") 109 ) internal static; 110 111 /* include files */ 112 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 ----------------------------------- */ 113 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 -------------------------------- */ 114 3 1 /* START OF: lex_descriptors_.incl.pl1 * * * * * * */ 3 2 3 3 /* * * * * * * * * * * * * * * * * * * * * * * */ 3 4 /* */ 3 5 /* Name: lex_descriptors_.incl.pl1 */ 3 6 /* */ 3 7 /* This include segment defines the structure of the token */ 3 8 /* descriptor, statement descriptor, and comment descriptor created */ 3 9 /* by the lex_string_ program. */ 3 10 /* */ 3 11 /* Status: */ 3 12 /* */ 3 13 /* 0) Created: Dec, 1973 by G. C. Dixon */ 3 14 /* */ 3 15 /* * * * * * * * * * * * * * * * * * * * * * * */ 3 16 3 17 3 18 3 19 3 20 dcl 3 21 1 comment aligned based (Pcomment), 3 22 /* descriptor for a comment. */ 3 23 2 group1 unaligned, 3 24 3 version fixed bin(17), /* comment descriptor version. */ 3 25 3 size fixed bin(17), /* comment descriptor size (in words). */ 3 26 2 Pnext ptr unal, /* ptr to next comment descriptor. */ 3 27 2 Plast ptr unal, /* ptr to last comment descriptor. */ 3 28 2 Pvalue ptr unal, /* ptr to comment. */ 3 29 2 Lvalue fixed bin(18), /* length of comment. */ 3 30 2 group2 unaligned, 3 31 3 line_no fixed bin(17), /* line no of line containing comment. */ 3 32 3 S, /* switches: */ 3 33 4 before_stmt bit(1), /* comment is before 1st token of stmt. */ 3 34 4 contiguous bit(1), /* no tokens between this and last comment. */ 3 35 4 pad bit(16), 3 36 comment_value char(comment.Lvalue) based (comment.Pvalue), 3 37 /* body of comment. */ 3 38 Pcomment ptr; /* ptr to comment descriptor. */ 3 39 3 40 dcl 3 41 1 stmt aligned based (Pstmt), 3 42 /* descriptor for a statement. */ 3 43 2 group1 unaligned, 3 44 3 version fixed bin(17), /* statement descriptor version. */ 3 45 3 size fixed bin(17), /* statement descriptor size (in words). */ 3 46 2 Pnext ptr unal, /* ptr to next statement descriptor. */ 3 47 2 Plast ptr unal, /* ptr to last statement descriptor. */ 3 48 2 Pvalue ptr unal, /* ptr to statement. */ 3 49 2 Lvalue fixed bin(18), /* length of statement. */ 3 50 2 Pfirst_token ptr unal, /* ptr to 1st token of statement. */ 3 51 2 Plast_token ptr unal, /* ptr to last token of statement. */ 3 52 2 Pcomments ptr unal, /* ptr to comments in statement. */ 3 53 2 Puser ptr unal, /* user-defined ptr. */ 3 54 2 group2 unaligned, 3 55 3 Ntokens fixed bin(17), /* number of tokens in statement. */ 3 56 3 line_no fixed bin(17), /* line no of line on which statement begins. */ 3 57 3 Istmt_in_line fixed bin(17), /* number of stmts in line containing this stmt. */ 3 58 /* (the number includes this stmt.) */ 3 59 3 semant_type fixed bin(17), /* semantic type of the statement. */ 3 60 3 S, /* switches: */ 3 61 4 error_in_stmt bit(1), /* stmt contains a syntactic error. */ 3 62 4 output_in_err_msg bit(1), /* stmt has been output in previous error message.*/ 3 63 4 pad bit(34), 3 64 stmt_value char(stmt.Lvalue) based (stmt.Pvalue), 3 65 /* text of the statement. */ 3 66 Pstmt ptr; /* ptr to a stmt descriptor. */ 3 67 3 68 dcl 3 69 1 token aligned based (Ptoken), 3 70 /* descriptor for a token. */ 3 71 2 group1 unaligned, 3 72 3 version fixed bin(17), /* token descriptor version. */ 3 73 3 size fixed bin(17), /* token descriptor size (in words). */ 3 74 2 Pnext ptr unal, /* ptr to next token descriptor. */ 3 75 2 Plast ptr unal, /* ptr to last token descriptor. */ 3 76 2 Pvalue ptr unal, /* ptr to token. */ 3 77 2 Lvalue fixed bin(18), /* length of token. */ 3 78 2 Pstmt ptr unal, /* ptr to descriptor of stmt containing token. */ 3 79 2 Psemant ptr unal, /* ptr to descriptor(s) of token's semantic value.*/ 3 80 2 group2 unaligned, 3 81 3 Itoken_in_stmt fixed bin(17), /* position of token within its statement. */ 3 82 3 line_no fixed bin(17), /* line number of the line containing the token. */ 3 83 3 Nvalue fixed bin(35), /* numeric value of decimal-integer tokens. */ 3 84 3 S, /* switches: */ 3 85 4 end_of_stmt bit(1), /* token is an end-of-stmt token. */ 3 86 4 quoted_string bit(1), /* token is a quoted string. */ 3 87 4 quotes_in_string bit(1), /* on if quote-close delimiters appear in quoted */ 3 88 /* string (as doubled quotes on input.) */ 3 89 4 quotes_doubled bit(1), /* on if quotes in the string are doubled after */ 3 90 /* string has been lexed into a token. */ 3 91 4 pad2 bit(32), 3 92 token_value char(token.Lvalue) based (token.Pvalue), 3 93 /* value of the token. */ 3 94 Ptoken ptr; /* ptr to a token descriptor. */ 3 95 3 96 /* END OF: lex_descriptors_.incl.pl1 * * * * * * */ 115 116 117 /* program */ 118 119 /* The syntax of the select string is: 120* 121* {|anyfield} [not] {|null} 122**/ 123 124 area_ptr = bv_area_ptr; 125 select_ptr = null; 126 in_file_ptr = bv_input_ptr; 127 bv_code = 0; 128 selx = 0; 129 ltx = 0; 130 131 n = 100; 132 allocate literal_table in (system_area) set (ltp); 133 134 n = 100; 135 allocate select_expression in (system_area) set (select_ptr); 136 select_expression.literal_table_ptr = ltp; 137 select_expression.last_element = 0; 138 139 if first_time 140 then do; 141 IGBREAKS = substr (collate (), 1, 8) || substr (collate (), 10, 24); 142 BREAKS = IGBREAKS || "()"; 143 call lex_string_$init_lex_delims ("""", """", "", "", "", "11"b, BREAKS, IGBREAKS, LEXDLM, LEXCTL); 144 first_time = "0"b; 145 end; 146 147 call translator_temp_$get_segment ("lister", token_temp_seg_ptr, code); 148 if token_temp_seg_ptr = null 149 then do; 150 bv_error_token = "Making temporary segment in process directory."; 151 bv_code = code; 152 return; 153 end; 154 155 call lex_string_$lex (addr (bv_select_string), length (bv_select_string), 0, token_temp_seg_ptr, "0000"b, """", 156 """", "", "", "", BREAKS, IGBREAKS, LEXDLM, LEXCTL, Pstmt, Ptoken, code); 157 if code ^= 0 158 then do; 159 if code = error_table_$zero_length_seg 160 then code = lister_codes_$null_select_expr; 161 162 bv_error_token = ""; 163 bv_code = code; 164 return; 165 end; 166 167 on conversion 168 go to recover_from_bad_literal; 169 170 n = expression_parse (code); /* parse the expression */ 171 select_expression.last_element = selx; 172 if (code = 0) & (Ptoken ^= null) /* Make sure we have scanned all input */ 173 then do; 174 bv_error_token = "At """ || token_value || """"; 175 code = lister_codes_$select_syntax_error; 176 end; 177 178 finish: 179 if code ^= 0 180 then do; 181 free literal_table in (system_area); 182 ltp = null; 183 free select_expression in (system_area); 184 select_ptr = null; 185 end; 186 187 bv_select_ptr = select_ptr; 188 call translator_temp_$release_all_segments (token_temp_seg_ptr, (0)); 189 bv_code = code; 190 return; 191 192 recover_from_bad_literal: 193 bv_error_token = token_value || " is not a number."; 194 code = lister_codes_$select_syntax_error; 195 go to finish; 196 197 expression_parse: 198 procedure (bv_code) returns (fixed bin); /* parameters */ 199 200 dcl bv_code fixed bin (35) parameter; 201 202 /* automatic */ 203 204 dcl (i, si) fixed bin, 205 opindex fixed bin (5), 206 stack (0:12) fixed bin; 207 208 /* internal static */ 209 210 dcl precedence (3) fixed bin internal static initial (2, 211 /* and */ 212 1, /* or */ 213 4); /* not */ 214 215 dcl op_names (3) char (4) varying internal static initial ("and", "or", "not"); 216 217 /* This procedure parses expressions using a simple operator 218* precedence technique. The syntax parsed is 219* 220* ::= [ ]... 221* 222* where the nth operator and its operands are stacked if the 223* n+1st operator has higher precedence. The primitive is parsed by 224* the internal entry called "primitive". The primitives include 225* parenthesized expressions, prefix operators, and exponentiation. */ 226 227 bv_code = 0; 228 si = 0; 229 stack (0) = primitive (); 230 231 fetchop: 232 if Ptoken ^= null 233 then do; 234 do i = lbound (op_names, 1) to hbound (op_names, 1) while (token_value ^= op_names (i)); 235 end; 236 237 if i <= hbound (op_names, 1) 238 then do; 239 if si ^= 0 /* If past first op then check prec. */ 240 then do; 241 opindex = stack (si - 1); 242 if precedence (opindex) >= precedence (i) 243 then go to unstack; 244 end; 245 246 si = si + 1; 247 stack (si) = i; 248 si = si + 1; 249 Ptoken = token.Pnext; 250 stack (si) = primitive (); 251 go to fetchop; 252 end; 253 end; 254 255 if si = 0 256 then return (selx); 257 258 opindex = stack (si - 1); 259 260 unstack: 261 selx = selx + 1; 262 if selx > hbound (select_expression.element, 1) 263 then do; 264 bv_code = lister_codes_$expression_too_complicated; 265 go to fail; 266 end; 267 268 select_expression.element (selx).opcode = op_table (opindex); 269 select_expression.element (selx).field_index = stack (si - 2); 270 select_expression.element (selx).literal_index = stack (si); 271 si = si - 2; 272 stack (si) = selx; 273 go to fetchop; 274 275 fail: 276 bv_error_token = ""; 277 return (0); 278 279 fail_with_token: 280 return (0); 281 282 /* Primitive parses prefix expressions and parenthesized expressions. */ 283 284 primitive: 285 procedure () returns (fixed bin); 286 287 /* automatic */ 288 289 dcl (hashx, i) fixed bin; 290 dcl code fixed bin (35); 291 dcl cx fixed bin; 292 293 /* program */ 294 295 if Ptoken = null 296 then go to not_enough_input; 297 298 if token_value = "not" 299 then do; 300 Ptoken = token.Pnext; 301 i = primitive (); 302 selx = selx + 1; 303 if selx > hbound (select_expression.element, 1) 304 then do; 305 bv_code = lister_codes_$expression_too_complicated; 306 go to fail; 307 end; 308 309 select_expression.element (selx).opcode = SELECT_NOT; 310 select_expression.element (selx).field_index = i; 311 return (selx); 312 end; 313 else if token_value = "(" 314 then do; 315 Ptoken = token.Pnext; 316 i = expression_parse (code); 317 if code ^= 0 318 then do; 319 bv_code = code; 320 if code = lister_codes_$undefined_fieldname 321 then go to fail_with_token; 322 else goto fail; 323 end; 324 325 if Ptoken = null 326 then do; 327 bv_error_token = "At end of select expression."; 328 bv_code = lister_codes_$missing_right_paren; 329 go to fail_with_token; 330 end; 331 332 if token_value ^= ")" 333 then do; 334 bv_error_token = "At """ || token_value || """"; 335 bv_code = lister_codes_$missing_right_paren; 336 go to fail_with_token; 337 end; 338 339 Ptoken = token.Pnext; 340 return (i); 341 end; 342 else do; 343 selx = selx + 1; 344 345 if token_value = ":any" 346 then select_expression.element (selx).field_index = ANY_FIELD; 347 else if token_value = ":uid" 348 then select_expression.element (selx).field_index = UID; 349 else do; 350 351 /* token_value must be passed by value since it gets modified by the hash subroutine. */ 352 353 hashx = lister_hash_fid_ (in_file_ptr, (token_value)); 354 if hashx = -1 355 then do; 356 bv_error_token = token_value; 357 bv_code = lister_codes_$undefined_fieldname; 358 go to fail_with_token; 359 end; 360 361 select_expression.element (selx).field_index = hashx; 362 end; 363 364 Ptoken = token.Pnext; 365 if Ptoken = null 366 then go to not_enough_input; 367 368 if token_value = "not" 369 then do; 370 select_expression.element (selx).not = "1"b; 371 372 Ptoken = token.Pnext; 373 if Ptoken = null 374 then go to not_enough_input; 375 end; 376 else select_expression.element (selx).not = "0"b; 377 378 do cx = lbound (comparison_op, 1) to hbound (comparison_op, 1) while (comparison_op (cx) ^= token_value); 379 end; 380 381 if cx > hbound (comparison_op, 1) 382 then do; 383 bv_code = lister_codes_$unknown_comparison_op; 384 bv_error_token = token_value; 385 go to fail_with_token; 386 end; 387 388 select_expression.element (selx).opcode = comparison_opcode (cx); 389 390 Ptoken = token.Pnext; 391 if Ptoken = null 392 then go to not_enough_input; 393 394 if (token_value = ":null") | (token_value = ":numeric") 395 then if (comparison_opcode (cx) ^= SELECT_EQ) & (comparison_opcode (cx) ^= SELECT_NEQ) 396 then do; 397 if token_value = ":null" 398 then bv_code = lister_codes_$invalid_op_null; 399 else bv_code = lister_codes_$invalid_op_numeric; 400 go to fail; 401 end; 402 else if token_value = ":null" 403 then select_expression.element (selx).literal_index = NULL_FIELD; 404 else select_expression.element (selx).literal_index = NUMERIC_FIELD; 405 else select_expression.element (selx).literal_index = allocate_literal (cx > 6 & cx < 11); 406 407 select_expression.element (selx).top = "0"b; 408 select_expression.element (selx).unused = ""b; 409 Ptoken = token.Pnext; 410 return (selx); 411 end; 412 413 not_enough_input: 414 bv_code = lister_codes_$incomplete_select_expression; 415 go to fail; 416 417 allocate_literal: 418 procedure (P_numeric_literal) returns (fixed bin); 419 420 /* parameters */ 421 422 declare P_numeric_literal bit (1) aligned parameter; 423 424 /* program */ 425 426 ltx = ltx + 1; 427 if ltx > hbound (literal_table.literal, 1) 428 then do; 429 bv_code = lister_codes_$too_many_literals; 430 go to fail; 431 end; 432 433 if P_numeric_literal 434 then do; 435 allocate numeric_atom in (system_area) set (atomp); 436 numeric_atom.flag = numeric_flag; 437 438 (conversion): 439 numeric_atom.value = convert (numeric_atom.value, token_value); 440 end; 441 else do; 442 atom_length = length (token_value); 443 allocate atom in (system_area) set (atomp); 444 atom = token_value; 445 end; 446 447 literal_table.literal (ltx) = atomp; 448 literal_table.n_literals = literal_table.n_literals + 1; 449 return (ltx); 450 451 end allocate_literal; 452 453 end /* primitive */; 454 455 end /* expression_parse */; 456 457 end /* lister_compile_select_ */; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 11/02/84 1204.7 lister_compile_select_.pl1 >special_ldd>online>6883-11/02/84>lister_compile_select_.pl1 113 1 04/25/81 0728.4 lister_entries.incl.pl1 >ldd>include>lister_entries.incl.pl1 114 2 11/02/84 1208.5 lister_structures.incl.pl1 >special_ldd>online>6883-11/02/84>lister_structures.incl.pl1 115 3 04/18/75 1242.4 lex_descriptors_.incl.pl1 >ldd>include>lex_descriptors_.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. ANY_FIELD constant fixed bin(8,0) initial dcl 2-183 ref 345 BREAKS 000010 internal static varying char(128) dcl 103 set ref 142* 143* 155* IGBREAKS 000051 internal static varying char(128) dcl 103 set ref 141* 142 143* 155* LEXCTL 000112 internal static varying char(128) dcl 103 set ref 143* 155* LEXDLM 000153 internal static varying char(128) dcl 103 set ref 143* 155* Lvalue 4 based fixed bin(18,0) level 2 dcl 3-68 ref 174 192 234 298 313 332 334 345 347 353 356 368 378 384 394 394 397 402 438 442 444 NULL_FIELD constant fixed bin(8,0) initial dcl 2-183 ref 402 NUMERIC_FIELD constant fixed bin(8,0) initial dcl 2-183 ref 404 P_numeric_literal parameter bit(1) dcl 422 ref 417 433 Pnext 1 based pointer level 2 packed unaligned dcl 3-68 ref 249 300 315 339 364 372 390 409 Pstmt 000152 automatic pointer dcl 3-40 set ref 155* Ptoken 000154 automatic pointer dcl 3-68 set ref 155* 172 174 174 192 192 231 234 234 249* 249 295 298 298 300* 300 313 313 315* 315 325 332 332 334 334 339* 339 345 345 347 347 353 353 356 356 364* 364 365 368 368 372* 372 373 378 378 384 384 390* 390 391 394 394 394 394 397 397 402 402 409* 409 438 438 442 442 444 444 Pvalue 3 based pointer level 2 packed unaligned dcl 3-68 ref 174 192 234 298 313 332 334 345 347 353 356 368 378 384 394 394 397 402 438 442 444 SELECT_AND constant bit(9) initial dcl 2-164 ref 47 SELECT_BEG constant bit(9) initial dcl 2-164 ref 49 49 SELECT_END constant bit(9) initial dcl 2-164 ref 49 49 SELECT_EQ constant bit(9) initial dcl 2-164 ref 49 49 394 SELECT_FIND constant bit(9) initial dcl 2-164 ref 49 49 SELECT_GT constant bit(9) initial dcl 2-164 ref 49 SELECT_LT constant bit(9) initial dcl 2-164 ref 49 SELECT_NEQ constant bit(9) initial dcl 2-164 ref 49 49 394 SELECT_NGT constant bit(9) initial dcl 2-164 ref 49 SELECT_NLT constant bit(9) initial dcl 2-164 ref 49 SELECT_NOT constant bit(9) initial dcl 2-164 ref 47 309 SELECT_OR constant bit(9) initial dcl 2-164 ref 47 UID constant fixed bin(8,0) initial dcl 2-183 ref 347 addr builtin function dcl 61 ref 155 155 area_ptr 000150 automatic pointer dcl 2-96 set ref 124* 132 135 181 183 435 443 atom based varying char dcl 2-71 set ref 443 444* atom_length 000134 automatic fixed bin(17,0) initial dcl 2-71 set ref 2-71* 442* 443 444 atomp 000136 automatic pointer dcl 2-71 set ref 435* 436 438 438 443* 444 447 bv_area_ptr parameter pointer dcl 36 ref 31 124 bv_code parameter fixed bin(35,0) dcl 200 in procedure "expression_parse" set ref 197 227* 264* 305* 319* 328* 335* 357* 383* 397* 399* 413* 429* bv_code parameter fixed bin(35,0) dcl 36 in procedure "lister_compile_select_" set ref 31 127* 151* 163* 189* bv_error_token parameter char unaligned dcl 36 set ref 31 150* 162* 174* 192* 275* 327* 334* 356* 384* bv_input_ptr parameter pointer dcl 36 ref 31 126 bv_select_ptr parameter pointer dcl 36 set ref 31 187* bv_select_string parameter char unaligned dcl 36 set ref 31 155 155 155 155 code 000102 automatic fixed bin(35,0) dcl 290 in procedure "primitive" set ref 316* 317 319 320 code 000121 automatic fixed bin(35,0) dcl 53 in procedure "lister_compile_select_" set ref 147* 151 155* 157 159 159* 163 170* 172 175* 178 189 194* collate builtin function dcl 61 ref 141 141 comparison_op 000011 constant varying char(8) initial array dcl 99 ref 378 378 378 381 comparison_opcode 000103 automatic bit(9) initial array dcl 49 set ref 49* 49* 49* 49* 49* 49* 49* 49* 49* 49* 49* 49* 49* 49* 388 394 394 conversion 000126 stack reference condition dcl 66 ref 167 convert builtin function dcl 61 ref 438 cx 000103 automatic fixed bin(17,0) dcl 291 set ref 378* 378* 381 388 394 394 405 405 element 4 based structure array level 2 dcl 2-143 set ref 262 303 error_table_$zero_length_seg 000226 external static fixed bin(35,0) dcl 83 ref 159 field_index 4(18) based fixed bin(8,0) array level 3 packed unaligned dcl 2-143 set ref 269* 310* 345* 347* 361* first_time 000214 internal static bit(1) initial dcl 103 set ref 139 144* flag based fixed bin(35,0) level 2 dcl 2-190 set ref 436* hashx 000100 automatic fixed bin(17,0) dcl 289 set ref 353* 354 361 hbound builtin function dcl 61 ref 234 237 262 303 378 381 427 i 000101 automatic fixed bin(17,0) dcl 289 in procedure "primitive" set ref 301* 310 316* 340 i 000100 automatic fixed bin(17,0) dcl 204 in procedure "expression_parse" set ref 234* 234* 237 242 247 in_file_ptr 000140 automatic pointer dcl 2-75 set ref 126* 353* last_element 3 based fixed bin(17,0) level 2 dcl 2-143 set ref 137* 171* lbound builtin function dcl 61 ref 234 378 length builtin function dcl 61 ref 155 155 442 lex_string_$init_lex_delims 000216 constant entry external dcl 70 ref 143 lex_string_$lex 000220 constant entry external dcl 70 ref 155 lister_codes_$expression_too_complicated 000230 external static fixed bin(35,0) dcl 83 ref 264 305 lister_codes_$incomplete_select_expression 000232 external static fixed bin(35,0) dcl 83 ref 413 lister_codes_$invalid_op_null 000234 external static fixed bin(35,0) dcl 83 ref 397 lister_codes_$invalid_op_numeric 000236 external static fixed bin(35,0) dcl 83 ref 399 lister_codes_$missing_right_paren 000240 external static fixed bin(35,0) dcl 83 ref 328 335 lister_codes_$null_select_expr 000242 external static fixed bin(35,0) dcl 83 ref 159 lister_codes_$select_syntax_error 000244 external static fixed bin(35,0) dcl 83 ref 175 194 lister_codes_$too_many_literals 000246 external static fixed bin(35,0) dcl 83 ref 429 lister_codes_$undefined_fieldname 000250 external static fixed bin(35,0) dcl 83 ref 320 357 lister_codes_$unknown_comparison_op 000252 external static fixed bin(35,0) dcl 83 ref 383 lister_hash_fid_ 000254 constant entry external dcl 1-105 ref 353 literal 2 based pointer array level 2 packed unaligned dcl 2-124 set ref 427 447* literal_index 4(27) based fixed bin(8,0) array level 3 packed unaligned dcl 2-143 set ref 270* 402* 404* 405* literal_table based structure level 1 dcl 2-124 set ref 132 181 literal_table_ptr based pointer level 2 dcl 2-143 set ref 136* ltp 000142 automatic pointer dcl 2-75 set ref 132* 136 181 182* 427 447 448 448 ltx 000122 automatic fixed bin(17,0) dcl 53 set ref 129* 426* 426 427 447 449 n 000146 automatic fixed bin(17,0) dcl 2-75 set ref 131* 132 132 134* 135 135 170* n_literals 1 based fixed bin(17,0) level 2 dcl 2-124 set ref 448* 448 not 4(09) based bit(1) array level 3 packed unaligned dcl 2-143 set ref 370* 376* null builtin function dcl 61 ref 125 148 172 182 184 231 295 325 365 373 391 numeric_atom based structure level 1 dcl 2-190 set ref 435 numeric_flag constant fixed bin(35,0) initial dcl 2-194 ref 436 op_names 000000 constant varying char(4) initial array dcl 215 ref 234 234 234 237 op_table 000100 automatic bit(9) initial array dcl 47 set ref 47* 47* 47* 268 opcode 4 based bit(9) array level 3 packed unaligned dcl 2-143 set ref 268* 309* 388* opindex 000102 automatic fixed bin(5,0) dcl 204 set ref 241* 242 258* 268 precedence 000006 constant fixed bin(17,0) initial array dcl 210 ref 242 242 select_expression based structure level 1 dcl 2-143 set ref 135 183 select_ptr 000144 automatic pointer dcl 2-75 set ref 125* 135* 136 137 171 183 184* 187 262 268 269 270 303 309 310 345 347 361 370 376 388 402 404 405 407 408 selx 000123 automatic fixed bin(17,0) dcl 53 set ref 128* 171 255 260* 260 262 268 269 270 272 302* 302 303 309 310 311 343* 343 345 347 361 370 376 388 402 404 405 407 408 410 si 000101 automatic fixed bin(17,0) dcl 204 set ref 228* 239 241 246* 246 247 248* 248 250 255 258 269 270 271* 271 272 size 2 based fixed bin(17,0) level 2 in structure "select_expression" dcl 2-143 in procedure "lister_compile_select_" set ref 135* 183 262 303 size based fixed bin(17,0) level 2 in structure "literal_table" dcl 2-124 in procedure "lister_compile_select_" set ref 132* 181 427 stack 000103 automatic fixed bin(17,0) array dcl 204 set ref 229* 241 247* 250* 258 269 270 272* substr builtin function dcl 61 ref 141 141 system_area based area(261120) dcl 2-95 ref 132 135 181 183 435 443 token based structure level 1 dcl 3-68 token_temp_seg_ptr 000124 automatic pointer dcl 53 set ref 147* 148 155* 188* token_value based char unaligned dcl 3-68 ref 174 192 234 298 313 332 334 345 347 353 356 368 378 384 394 394 397 402 438 442 444 top 4(10) based bit(1) array level 3 packed unaligned dcl 2-143 set ref 407* translator_temp_$get_segment 000222 constant entry external dcl 70 ref 147 translator_temp_$release_all_segments 000224 constant entry external dcl 70 ref 188 unused 4(11) based bit(7) array level 3 packed unaligned dcl 2-143 set ref 408* value 1 based float dec(29) level 2 packed unaligned dcl 2-190 set ref 438* 438 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. 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 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 Pcomment automatic pointer dcl 3-20 SELECT_GE internal static bit(9) initial dcl 2-164 SELECT_LE internal static bit(9) initial dcl 2-164 SELECT_NGE internal static bit(9) initial dcl 2-164 SELECT_NLE internal static bit(9) initial dcl 2-164 center internal static bit(2) initial dcl 2-129 comment based structure level 1 dcl 3-20 comment_value based char unaligned dcl 3-20 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 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 i automatic fixed bin(17,0) dcl 53 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 lower_case internal static char(26) initial unaligned dcl 103 n_items_to_sort automatic fixed bin(17,0) dcl 2-198 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 sort_list based structure level 1 dcl 2-201 sort_list_ptr automatic pointer dcl 2-198 stmt based structure level 1 dcl 3-40 stmt_value based char unaligned dcl 3-40 translate builtin function dcl 61 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 upper_case internal static char(26) initial unaligned dcl 103 NAMES DECLARED BY EXPLICIT CONTEXT. allocate_literal 002111 constant entry internal dcl 417 ref 405 expression_parse 001107 constant entry internal dcl 197 ref 170 316 fail 001260 constant label dcl 275 ref 265 306 322 400 415 430 fail_with_token 001272 constant label dcl 279 ref 320 329 336 358 385 fetchop 001125 constant label dcl 231 ref 251 273 finish 001016 constant label dcl 178 ref 195 lister_compile_select_ 000221 constant entry external dcl 31 not_enough_input 002101 constant label dcl 413 ref 295 365 373 391 primitive 001276 constant entry internal dcl 284 ref 229 250 301 recover_from_bad_literal 001056 constant label dcl 192 ref 167 unstack 001222 constant label dcl 260 ref 242 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 2542 3020 2250 2552 Length 3320 2250 256 263 272 206 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME lister_compile_select_ 236 external procedure is an external procedure. on unit on line 167 64 on unit expression_parse 86 internal procedure is called by several nonquick procedures. primitive 266 internal procedure calls itself recursively. allocate_literal internal procedure shares stack frame of internal procedure primitive. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 BREAKS lister_compile_select_ 000051 IGBREAKS lister_compile_select_ 000112 LEXCTL lister_compile_select_ 000153 LEXDLM lister_compile_select_ 000214 first_time lister_compile_select_ STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME expression_parse 000100 i expression_parse 000101 si expression_parse 000102 opindex expression_parse 000103 stack expression_parse lister_compile_select_ 000100 op_table lister_compile_select_ 000103 comparison_opcode lister_compile_select_ 000121 code lister_compile_select_ 000122 ltx lister_compile_select_ 000123 selx lister_compile_select_ 000124 token_temp_seg_ptr lister_compile_select_ 000134 atom_length lister_compile_select_ 000136 atomp lister_compile_select_ 000140 in_file_ptr lister_compile_select_ 000142 ltp lister_compile_select_ 000144 select_ptr lister_compile_select_ 000146 n lister_compile_select_ 000150 area_ptr lister_compile_select_ 000152 Pstmt lister_compile_select_ 000154 Ptoken lister_compile_select_ primitive 000100 hashx primitive 000101 i primitive 000102 code primitive 000103 cx primitive THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. r_l_a r_g_a alloc_cs cat_realloc_cs call_ext_out_desc call_ext_out call_int_this call_int_other return tra_ext enable shorten_stack ext_entry_desc int_entry any_to_any_rd alloc_based free_based THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. lex_string_$init_lex_delims lex_string_$lex lister_hash_fid_ translator_temp_$get_segment translator_temp_$release_all_segments THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$zero_length_seg lister_codes_$expression_too_complicated lister_codes_$incomplete_select_expression lister_codes_$invalid_op_null lister_codes_$invalid_op_numeric lister_codes_$missing_right_paren lister_codes_$null_select_expr lister_codes_$select_syntax_error lister_codes_$too_many_literals lister_codes_$undefined_fieldname lister_codes_$unknown_comparison_op LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 31 000213 47 000241 49 000256 2 71 000342 124 000343 125 000347 126 000351 127 000354 128 000355 129 000356 131 000357 132 000361 134 000371 135 000373 136 000403 137 000405 139 000406 141 000411 142 000425 143 000450 144 000524 147 000526 148 000550 150 000554 151 000562 152 000564 155 000565 157 000677 159 000701 162 000706 163 000714 164 000715 167 000716 170 000735 171 000745 172 000750 174 000756 175 001012 178 001016 181 001020 182 001024 183 001026 184 001033 187 001035 188 001040 189 001052 190 001055 192 001056 194 001101 195 001105 197 001106 227 001114 228 001116 229 001117 231 001125 234 001132 235 001152 237 001154 239 001157 241 001161 242 001163 246 001167 247 001170 248 001173 249 001174 250 001201 251 001210 255 001211 258 001220 260 001222 262 001224 264 001230 265 001234 268 001235 269 001242 270 001247 271 001252 272 001254 273 001257 275 001260 277 001267 279 001272 284 001275 295 001303 298 001311 300 001322 301 001324 302 001333 303 001336 305 001342 306 001347 309 001352 310 001356 311 001362 313 001366 315 001372 316 001374 317 001405 319 001407 320 001412 322 001420 325 001423 327 001431 328 001437 329 001444 332 001447 334 001460 335 001510 336 001516 339 001521 340 001523 343 001527 345 001530 347 001542 353 001554 354 001603 356 001607 357 001622 358 001627 361 001632 364 001641 365 001644 368 001650 370 001656 372 001662 373 001664 375 001670 376 001671 378 001675 379 001717 381 001721 383 001724 384 001731 385 001745 388 001750 390 001757 391 001762 394 001766 397 002007 399 002021 400 002026 402 002031 404 002041 405 002045 407 002066 408 002070 409 002072 410 002075 413 002101 415 002106 417 002111 426 002113 427 002116 429 002121 430 002126 433 002131 435 002134 436 002145 438 002147 440 002162 442 002163 443 002166 444 002202 447 002215 448 002225 449 002226 ----------------------------------------------------------- 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