COMPILATION LISTING OF SEGMENT cv_cmcs_tree_ctl Compiled by: Multics PL/I Compiler, Release 28e, of February 14, 1985 Compiled at: Honeywell Multics Op. - System M Compiled on: 03/17/86 1452.8 mst Mon Options: optimize map 1 2 3 /* * * * * * * * * * * * * * * * * * * * * * * */ 4 /* */ 5 /* COMPILED OUTPUT OF SEGMENT cv_cmcs_tree_ctl.rd */ 6 /* Compiled by: reduction_compiler, Version 2.5 of Oct 21, 1985 */ 7 /* Compiled on: 03/17/86 1452.7 mst Mon */ 8 /* */ 9 /* * * * * * * * * * * * * * * * * * * * * * * */ 10 11 /* *********************************************************** 12* * * 13* * * 14* * Copyright, (C) Honeywell Information Systems Inc., 1981 * 15* * * 16* * * 17* *********************************************************** */ 18 19 20 /* Modified on 10/02/81 by FCH, incorrect diags sometimes generated, BUG512 */ 21 /* Modified on 06/01/81 by FCH, [4.4-2], once per process initialization, BUG468 */ 22 /* Modified on 04/22/81 by FCH, [4.4-1], accept 01 as level number, accept minus in queue names, BUG468 */ 23 /* Modified since Version 4.3 */ 24 25 26 /* This procedure converts the ASCII definition of a COBOL MCS queue hierarchy 27* into its binary representation. 28**/ 29 /*++ 30* 31* BEGIN / dcl 1 / / do_init \ 32*2 / dcl 01 / / do_init \ 33*3 / declare 1 / / do_init \ 34*4 / declare 01 / / do_init \ 35*5 / end ; / close_db / fini \ 36*6 / / ERROR (1) NEXT_STMT / BEGIN \ 37*7 / / ERROR (2) / abort \ 38* 39* do_init / / init_tree LEX (2) / get_level_name \ 40* 41* get_level_name / / set_level_name LEX (1) / follow \ 42*10 / / ERROR (3) NEXT_STMT / BEGIN \ 43*11 / / ERROR (2) / abort \ 44* 45* follow / , / close_tree_level LEX (1) / get_level_no \ 46*13 / ; / close_tree LEX (1) / BEGIN \ 47*14 / queue_name / LEX (1) / get_queue_name \ 48*15 / command_line / LEX (1) / get_command_line \ 49*16 / mp_line / LEX (1) / get_mp_line \ 50*17 / cobol_program_id / LEX (1) / get_program_id \ 51* follow_error / / ERROR (4) NEXT_STMT / BEGIN \ 52*19 / / ERROR (2) / abort \ 53* 54* get_queue_name / / set_queue_name LEX (1) / follow \ 55*21 / / ERROR (5) NEXT_STMT / BEGIN \ 56*22 / / ERROR (6) / abort \ 57* 58* get_command_line / / set_command_line LEX (1) / follow \ 59*24 / / ERROR (10) NEXT_STMT / BEGIN \ 60*25 / / ERROR (7) / abort \ 61* 62* get_mp_line / / set_mp_line LEX (1) / follow \ 63*27 / / ERROR (10) NEXT_STMT / BEGIN \ 64*28 / / ERROR (1) / abort \ 65* 66* get_program_id / / set_program_id LEX (1) / follow \ 67*30 / / ERROR (11) NEXT_STMT / BEGIN \ 68*31 / / ERROR (1) / abort \ 69* 70* get_level_no / / open_tree_level LEX (1) / get_level_name \ 71*33 / / ERROR (8) NEXT_STMT / BEGIN \ 72*34 / / ERROR (9) / abort \ 73* 74* abort / / / RETURN \ 75* fini / / / RETURN \ 76* 77* ++*/ 78 79 cv_cmcs_tree_ctl: proc; 80 81 dcl new_station_name char (12), 82 new_terminal_name char (8), 83 j fixed bin, 84 aclinfo_ptr ptr, /* for use by tssi_ */ 85 queue_name char (32), 86 temp3 char (3); 87 88 /* */ 1 1 /* BEGIN INCLUDE FILE... cmcs_control_hdr.incl.pl1 */ 1 2 1 3 /* This include file is the 1st part of all cobol_mcs tables */ 1 4 1 5 /* Bob May, 4/30/77 */ 1 6 1 7 dcl control_hdr_len fixed bin int static options (constant) init (32); 1 8 1 9 dcl control_hdr_ptr ptr; 1 10 1 11 dcl 1 control_hdr aligned based (control_hdr_ptr), 1 12 2 lockword bit (36) aligned, /* for process_id */ 1 13 2 version fixed bin, 1 14 2 clock_created fixed bin (71), 1 15 2 author aligned, 1 16 3 group_id char (32), /* person.proj.tag */ 1 17 3 process_id bit (36), 1 18 2 max_size fixed bin (18), /* maximum number of entries seg can hold */ 1 19 2 current_size fixed bin (18), /* index of last active entry */ 1 20 2 entry_count fixed bin (18), /* number of active entries */ 1 21 2 cmcs_control_hdr_filler (16) fixed bin; /* words (17-32) for later expansion */ 1 22 1 23 /* END INCLUDE FILE... cmcs_control_hdr.incl.pl1 */ 89 2 1 /* BEGIN INCLUDE FILE... cmcs_entry_dcls.incl.pl1 */ 2 2 2 3 /* Entry declarations for the COBOL MCS runtime support package */ 2 4 2 5 /* Modified on 04/29/81 by FCH, [4.4-1] */ 2 6 /* Bob May, 6/01/77 */ 2 7 2 8 dcl cmcs_create_queues_ entry (fixed bin (35)); 2 9 2 10 dcl cmcs_date_time_ entry (fixed bin (71), char (6) unaligned, char (8) unaligned); 2 11 2 12 dcl cmcs_decode_status_ entry (ptr, ptr, fixed bin, fixed bin, fixed bin (35)); 2 13 2 14 dcl cmcs_expand_tree_path_ entry (char (*), char (48), fixed bin (35)); 2 15 2 16 dcl cmcs_fillin_hdr_ entry (ptr, fixed bin, fixed bin, fixed bin, fixed bin (35)); 2 17 2 18 dcl cmcs_initiate_ctl_ entry (char (*), ptr, fixed bin (35)); 2 19 2 20 dcl cmcs_print_ entry (ptr, ptr, fixed bin (35), ptr, fixed bin (35)); 2 21 2 22 dcl cmcs_purge_queues_ entry (fixed bin, bit (1), fixed bin (35)); 2 23 2 24 dcl cmcs_queue_ctl_$accept_message_count entry (ptr, fixed bin, fixed bin (35)); 2 25 dcl cmcs_queue_ctl_$disable entry (ptr, fixed bin, char (10), fixed bin (35)); 2 26 dcl cmcs_queue_ctl_$enable entry (ptr, fixed bin, char (10), fixed bin (35)); 2 27 dcl cmcs_queue_ctl_$print entry (ptr, fixed bin, ptr, fixed bin (35)); 2 28 dcl cmcs_queue_ctl_$purge entry (ptr, fixed bin, fixed bin (35)); 2 29 dcl cmcs_queue_ctl_$receive entry (ptr, fixed bin, ptr, fixed bin, fixed bin (35)); 2 30 dcl cmcs_queue_ctl_$send entry (ptr, fixed bin, ptr, fixed bin, fixed bin, bit (36), fixed bin (35)); 2 31 dcl cmcs_queue_ctl_$stop_run entry (fixed bin, fixed bin (35)); 2 32 2 33 dcl cmcs_scramble_ entry (char (10)) returns (char (10)); 2 34 2 35 dcl cmcs_set_lock_$lock entry (bit (36) aligned, fixed bin (35)); 2 36 dcl cmcs_set_lock_$unlock entry (bit (36) aligned, fixed bin (35)); 2 37 2 38 dcl cmcs_station_ctl_$attach entry (char (12), fixed bin, fixed bin (35)); 2 39 dcl cmcs_station_ctl_$detach entry (fixed bin, fixed bin (35)); 2 40 dcl cmcs_station_ctl_$detach_name entry (char (12), fixed bin (35)); 2 41 dcl cmcs_station_ctl_$disable_input_terminal entry (ptr, char (10), fixed bin (35)); 2 42 dcl cmcs_station_ctl_$disable_output_terminal entry (ptr, char (10), fixed bin (35)); 2 43 dcl cmcs_station_ctl_$enable_input_terminal entry (ptr, char (10), fixed bin (35)); 2 44 dcl cmcs_station_ctl_$enable_output_terminal entry (ptr, char (10), fixed bin (35)); 2 45 dcl cmcs_station_ctl_$find_destination entry(char(12),fixed bin,ptr,fixed bin(35)); /*[4.4-1]*/ 2 46 dcl cmcs_station_ctl_$input_disabled entry (fixed bin, bit (1), fixed bin (35)); 2 47 dcl cmcs_station_ctl_$output_disabled entry (fixed bin, bit (1), fixed bin (35)); 2 48 dcl cmcs_station_ctl_$validate entry (char (12), fixed bin, fixed bin (35)); 2 49 2 50 dcl cmcs_status_list_ctl_$add entry (ptr, ptr, ptr, fixed bin, fixed bin (35)); 2 51 dcl cmcs_status_list_ctl_$delete entry (ptr, ptr, ptr, fixed bin, fixed bin (35)); 2 52 dcl cmcs_status_list_ctl_$move entry (ptr, ptr, ptr, fixed bin, fixed bin, fixed bin (35)); 2 53 2 54 dcl cmcs_terminal_ctl_$find entry (char (8), char (12), fixed bin (35)); 2 55 2 56 dcl cmcs_tree_ctl_$find_destination entry (char (12), fixed bin, ptr, fixed bin (35)); 2 57 dcl cmcs_tree_ctl_$find_index entry (fixed bin, ptr, fixed bin (35)); 2 58 dcl cmcs_tree_ctl_$find_tree_path entry (ptr, fixed bin, fixed bin, ptr, fixed bin (35)); 2 59 dcl cmcs_tree_ctl_$find_qual_name entry(char(12),fixed bin,ptr,char(52),fixed bin(35)); /*[4.4-1]*/ 2 60 2 61 dcl cmcs_wait_ctl_$add entry (char (48), fixed bin, fixed bin (35)); 2 62 dcl cmcs_wait_ctl_$delete entry (fixed bin, fixed bin (35)); 2 63 dcl cmcs_wait_ctl_$find entry (char (48), ptr, fixed bin (35)); 2 64 dcl cmcs_wait_ctl_$mp_available entry (fixed bin, fixed bin, fixed bin (35)); 2 65 dcl cmcs_wait_ctl_$mp_login entry (fixed bin, fixed bin (35)); 2 66 dcl cmcs_wait_ctl_$mp_logout entry (fixed bin, fixed bin (35)); 2 67 dcl cmcs_wait_ctl_$clear_mp entry (fixed bin (35)); 2 68 dcl cmcs_wait_ctl_$start_mp entry (fixed bin (35)); 2 69 dcl cmcs_wait_ctl_$stop_mp entry (fixed bin (35)); 2 70 2 71 /* END INCLUDE FILE... cmcs_entry_dcls.incl.pl1 */ 90 3 1 /* BEGIN INCLUDE FILE... cmcs_station_ctl.incl.pl1 */ 3 2 3 3 /* This include file defines the station control structure for COBOL MCS */ 3 4 3 5 /* Bob May, 5/31/77 */ 3 6 3 7 dcl (station_ctl_hdr_len init (0), /* no special fields in hdr */ 3 8 station_ctl_entry_len init (6), 3 9 station_ctl_version init (1)) fixed bin int static options (constant); 3 10 3 11 dcl station_ctl_ptr ptr int static; 3 12 3 13 dcl 1 station_ctl aligned based (station_ctl_ptr), 3 14 2 hdr like control_hdr, 3 15 2 entries (station_ctl.current_size) like station_ctl_entry; 3 16 3 17 dcl station_ctl_eindex fixed bin; 3 18 3 19 dcl station_ctl_eptr ptr; 3 20 3 21 dcl 1 station_ctl_entry aligned based (station_ctl_eptr), 3 22 2 station_name char (12), 3 23 2 lockword bit (36) aligned, /* owner process_id */ 3 24 2 flags, 3 25 (3 inactive_sw bit (1), /* station is currently not legal to use */ 3 26 3 destination_sw bit (1), /* station attached as a destination */ 3 27 3 input_disabled_sw bit (1), /* if terminal, can't input */ 3 28 3 output_disabled_sw bit (1), /* if terminal, can't get output */ 3 29 3 filler bit (32)) unaligned, 3 30 2 filler fixed bin; 3 31 3 32 /* END INCLUDE FILE... cmcs_station_ctl.incl.pl1 */ 91 4 1 /* BEGIN INCLUDE FILE ... cmcs_tree_ctl.incl.pl1 */ 4 2 4 3 /* 4 4* This COBOL MCS include file defines the sstructure used for accessing 4 5* the MCS queue hierarchy and controlling message I/O for each entry. 4 6**/ 4 7 4 8 /* Bob May, 5/31/77 */ 4 9 4 10 dcl (tree_ctl_hdr_len init (32), 4 11 tree_ctl_entry_len init (144), /* 136, plus fudge for ptr alignments */ 4 12 tree_ctl_version init (1)) fixed bin internal static options (constant); 4 13 4 14 dcl tree_ctl_ptr ptr int static; 4 15 4 16 dcl 1 tree_ctl aligned based (tree_ctl_ptr), 4 17 2 hdr like control_hdr, 4 18 2 queue_count fixed bin, /* total of queue entries for hierarchy */ 4 19 2 filler (31) fixed bin (35), 4 20 2 entries (tree_ctl.current_size) like tree_ctl_entry; 4 21 4 22 dcl tree_ctl_eindex fixed bin; 4 23 4 24 dcl tree_ctl_eptr ptr; 4 25 4 26 dcl 1 tree_ctl_entry aligned based (tree_ctl_eptr), 4 27 2 level_info, /* len = 15 */ 4 28 3 tree_path, 4 29 4 level_names (4) char (12), 4 30 3 entry_flags, 4 31 (4 inactive_sw bit (1), 4 32 4 cmd_sw bit (1), 4 33 4 mp_sw bit (1), 4 34 /* switch separator */ 4 35 4 cobol_program_id_sw bit (1), 4 36 4 queue_sw bit (1), 4 37 4 filler bit (31)) unaligned, 4 38 3 level_no fixed bin, /* level within the hierarchy */ 4 39 3 subtree_count fixed bin, 4 40 2 static_queue_info, /* len = 9 */ 4 41 3 queue_name char (32), /* without the .cmcs_queue suffix */ 4 42 3 queue_ctl_eindex fixed bin, /* to compute addr of table entry */ 4 43 2 command_info, /* len = 75 */ 4 44 3 cmd_line_len fixed bin, 4 45 3 cmd_line char (128), 4 46 3 mp_line_len fixed bin, 4 47 3 mp_line char (128), 4 48 3 cobol_program_id_len fixed bin, 4 49 3 cobol_program_id char (32), 4 50 2 io_info, /* len = 37, sum of all level 3s */ 4 51 3 io_flags, /* len = 1 */ 4 52 (4 io_in_process_sw bit (1), 4 53 4 partial_in_process_sw bit (1), 4 54 4 rcv_wait_sw bit (1), 4 55 /* switch separator */ 4 56 4 rcv_msg_sw bit (1), /* on if user did a receive msg */ 4 57 4 rcv_seg_sw bit (1), /* on if user did a receive seg */ 4 58 4 filler bit (31)) unaligned, 4 59 3 dynamic_queue_info, /* len = 13 */ 4 60 4 switch_name char (32) unaligned, 4 61 4 queue_ctl_eptr ptr, 4 62 4 iocb_ptr ptr, 4 63 4 vfile_status fixed bin, /* 0 - not active/detached */ 4 64 /* 1 - attached, but not open */ 4 65 /* 2 - open */ 4 66 3 msg_hdr_info, /* len = 9 */ 4 67 4 msg_hdr_ptr ptr, /* ptr to base of current msg */ 4 68 4 io_type fixed bin, 4 69 4 io_subtype fixed bin, 4 70 4 seg_count fixed bin (35), /* total no of msg segments */ 4 71 4 msg_len fixed bin (35), /* total msg length (sum of all segments) */ 4 72 4 msg_descr like vfile_descr, 4 73 4 msg_key, 4 74 5 msg_no fixed bin (35), 4 75 5 seg_no fixed bin (35), 4 76 3 tseg_info, /* len = 3 */ 4 77 4 tseg_ptr ptr, /* temp seg to build segment */ 4 78 4 tseg_len fixed bin (35), 4 79 3 msg_seg_info, /* len = 6 */ 4 80 4 msg_seg_ptr ptr, /* ptr to base of current msg_seg */ 4 81 4 msg_seg_descr like vfile_descr, 4 82 4 msg_seg_len fixed bin (35), 4 83 4 msg_seg_left_index fixed bin (35), 4 84 4 msg_seg_left_len fixed bin (35), 4 85 3 buffer_info, /* len = 5 */ 4 86 4 buffer_ptr ptr, 4 87 4 buffer_len fixed bin (35), 4 88 4 buffer_left_index fixed bin (35), 4 89 4 buffer_left_len fixed bin (35); 4 90 4 91 /* END INCLUDE FILE ... cmcs_tree_ctl.incl.pl1 */ 92 5 1 /* BEGIN INCLUDE FILE... cmcs_vfile_rs.incl.pl1 */ 5 2 5 3 /* This COBOL MCS include file is used to reference records by their 5 4* vfile_ descriptors. It is used mainly in the maintenance of 5 5* message status lists. */ 5 6 5 7 /* Bob May, 6/30/77 */ 5 8 5 9 dcl vfile_rs_version fixed bin int static options (constant) init (1); 5 10 5 11 dcl vfile_rs_ptr ptr; 5 12 5 13 dcl 1 vfile_rs aligned based (vfile_rs_ptr), 5 14 2 version fixed bin, /* currently must be set to 1 */ 5 15 2 flags, 5 16 (3 lock_sw bit (1), /* "1"b */ 5 17 3 unlock_sw bit (1), /* "1"b */ 5 18 3 create_sw bit (1), /* "0"b */ 5 19 /* switch separator */ 5 20 3 locate_sw bit (1), /* "0"b for current_rec, "1"b to use descriptor */ 5 21 3 filler bit (32)) unaligned, /* (32) "0"b */ 5 22 2 rec_len fixed bin (21), 5 23 2 max_rec_len fixed bin (21), 5 24 2 rec_ptr ptr, 5 25 2 descr like vfile_descr, /* process INdependent addressing */ 5 26 2 filler fixed bin; /* 0 */ 5 27 5 28 dcl 1 vfile_descr, /* process INdependent addressing */ 5 29 (2 comp_no fixed bin (17), /* component of MSF */ 5 30 2 comp_offset bit (18)) unaligned; /* offset of record in component */ 5 31 5 32 /* END INCLUDE FILE... cmcs_vfile_rs.incl.pl1 */ 93 94 95 /* */ 96 97 /* automatic */ 98 99 /* levels structure, used to keep control information until the complete level entry is 100* ready to be inserted into the tree_ctl structure */ 101 102 dcl (current_level, previous_level, queue_level) fixed bin; 103 104 105 dcl 1 levels (4), 106 2 flags, 107 (3 cmd_sw bit (1), 108 3 mp_sw bit (1), 109 3 cobol_program_id_sw bit (1), 110 3 queue_sw bit (1), 111 3 filler bit (33)) unaligned, 112 2 tree_entry_index fixed bin, 113 2 subtree_count fixed bin, 114 2 level_name char (12), 115 2 queue_name char (32), 116 2 cmd_line_len fixed bin, 117 2 cmd_line char (128), 118 2 mp_line_len fixed bin, 119 2 mp_line char (128), 120 2 cobol_program_id_len fixed bin, 121 2 cobol_program_id char (128); 122 123 124 declare (APstmt, APtoken) ptr, 125 area_ptr ptr, /* for use by lex_string_. */ 126 arg_length fixed bin (21), /* length of command argument. */ 127 arg_ptr ptr, /* ptr to command argument */ 128 bitcount fixed bin (24), 129 code fixed bin (35), 130 dname char (168), 131 ename char (32), 132 i fixed bin, 133 n_chars fixed bin (21), 134 object_name char (32), /* entry name of output control seg */ 135 (pntep, object_ptr) ptr, /* ptrs to base of pnte and pnt */ 136 source_ptr ptr; /* ptr to base of persmf */ 137 138 /* based */ 139 140 declare arg_string char (arg_length) based (arg_ptr) unaligned; 141 142 dcl tree_ctl_entry_overlay (size (tree_ctl_entry)) fixed bin based (tree_ctl_eptr); 143 /* used to zero out the entry before setting */ 144 145 /* builtin */ 146 147 declare (addr, collate, dimension, divide, index, length, null, 148 reverse, size, string, substr, verify) builtin; 149 150 /* conditions */ 151 152 declare cleanup condition; 153 154 /* entries */ 155 156 declare 157 clock_ entry () returns (fixed bin (71)), 158 com_err_ entry options (variable), 159 cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)), 160 cv_dec_check_ entry (char (*), fixed bin) returns (fixed bin (35)), 161 expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)), 162 get_group_id_ entry () returns (char (32) aligned), 163 get_process_id_ entry () returns (bit (36)), 164 get_wdir_ entry () returns (char (168) aligned), 165 hcs_$delentry_seg entry (ptr, fixed bin (35)), 166 hcs_$initiate_count entry (char (*), char (*), char (*), fixed bin (24), fixed bin (1), ptr, fixed bin (35)), 167 hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)), 168 hcs_$set_bc_seg entry (ptr, fixed bin (24), fixed bin (35)), 169 hcs_$terminate_noname entry (ptr, fixed bin (35)), 170 hcs_$truncate_seg entry (ptr, fixed bin (18), fixed bin (35)), 171 (ioa_, ioa_$ioa_switch) entry options (variable), 172 lex_error_ entry options (variable), 173 lex_string_$init_lex_delims entry (char (*), char (*), char (*), char (*), char (*), 174 bit (*), char (*) var, char (*) var, char (*) var, char (*) var), 175 lex_string_$lex entry (ptr, fixed bin (21), fixed bin, ptr, bit (*), char (*), char (*), char (*), 176 char (*), char (*), char (*) var, char (*) var, char (*) var, char (*) var, ptr, ptr, fixed bin (35)), 177 translator_temp_$get_segment entry (char (*), ptr, fixed bin (35)), 178 translator_temp_$release_all_segments entry (ptr, fixed bin (35)), 179 180 tssi_$get_segment entry (char (*), char (*), ptr, ptr, fixed bin (35)), 181 tssi_$finish_segment entry (ptr, fixed bin (24), bit (36) aligned, ptr, fixed bin (35)), 182 tssi_$clean_up_segment entry (ptr), 183 184 unique_chars_ entry (bit (*)) returns (char (15) aligned); 185 186 /* internal static */ 187 188 declare ((BREAKS, IGBREAKS, LEXCTL, LEXDLM) char (128) varying, 189 test_sw bit (1) init ("0"b), 190 /*[4.4-2]*/ first_time bit (1) aligned initial ("1"b)) int static; 191 192 dcl (LEGAL char (71) aligned initial ("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz'_-^`~ ."), 193 my_name char (16) initial ("cv_cmcs_tree_ctl"), 194 alphanumerics char (64) init ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_-") /*[4.4-1]*/ 195 ) internal static options (constant); 196 dcl letters char (52) defined (alphanumerics); 197 198 /* external static */ 199 200 declare ((error_table_$badopt, error_table_$entlong, 201 error_table_$bad_name, error_table_$translation_failed) fixed bin (35), 202 sys_info_$max_seg_size fixed bin (18) 203 ) external static; 204 205 206 /* */ 207 208 call cu_$arg_ptr (1, arg_ptr, arg_length, code); 209 210 if code ^= 0 211 then do; 212 213 call com_err_ (code, my_name, "Usage: cv_cmcs_tree_ctl pathname (-brief|-bf|-long|-lg)"); 214 return; 215 216 end; 217 218 call expand_pathname_ (arg_string, dname, ename, code); 219 220 if code ^= 0 221 then do; 222 223 call com_err_ (code, my_name, "^a", arg_string); 224 return; 225 226 end; 227 228 call cu_$arg_ptr (2, arg_ptr, arg_length, code); 229 230 if code = 0 231 then if arg_string = "-brief" | arg_string = "-bf" 232 then SERROR_CONTROL = "01"b; 233 else if arg_string = "-long" | arg_string = "-lg" 234 then SERROR_CONTROL = "10"b; 235 else do; 236 call com_err_ (error_table_$badopt, my_name, "^a", arg_string); 237 return; 238 end; 239 240 /*[5.0-1]*/ current_level,queue_level = 0; 241 242 source_ptr = null; /* Initialize for cleanup handler */ 243 object_ptr = null; /* .. */ 244 area_ptr = null; /* .. */ 245 aclinfo_ptr = null; /* .. */ 246 247 on cleanup call clean_up; 248 249 call hcs_$initiate_count (dname, ename, "", bitcount, 1b, source_ptr, code); 250 251 if source_ptr = null 252 then do; 253 254 report_error: 255 256 call com_err_ (code, my_name, "^a>^a", dname, ename); 257 return; 258 259 end; 260 261 i = index (ename, ".src") - 1; 262 263 if i < 1 then do; 264 265 call com_err_ (error_table_$bad_name, my_name, "Source segment must have "".src"" suffix."); 266 return; 267 268 end; 269 270 if i + length (".control") > length (object_name) 271 then do; 272 273 code = error_table_$entlong; 274 go to report_error; 275 276 end; 277 278 object_name = substr (ename, 1, i) || ".control"; 279 280 n_chars = divide (bitcount + 8, 9, 24, 0); 281 282 dname = get_wdir_ (); 283 284 call tssi_$get_segment (dname, object_name, object_ptr, aclinfo_ptr, code); 285 286 if code ^= 0 287 then do; 288 289 call com_err_ (code, my_name, "^a>^a", dname, object_name); 290 return; 291 292 end; 293 294 /* Initialize Header Info */ 295 296 tree_ctl_ptr = object_ptr; /* actual working ptr - other is generic ptr */ 297 298 call cmcs_fillin_hdr_ (object_ptr, tree_ctl_version, tree_ctl_hdr_len, tree_ctl_entry_len, code); 299 300 if code ^= 0 then call com_err_ (code, my_name, "Continuing compilation."); 301 302 tree_ctl.queue_count = 0; /* not part of common hdr */ 303 304 /* */ 305 306 /*[4.4-2]*/ if first_time 307 then do; 308 309 BREAKS = substr (collate, 1, 8) || substr (collate, 10, 24) || ":,()"; 310 IGBREAKS = substr (BREAKS, 1, 8+24); 311 312 call lex_string_$init_lex_delims ("""", """", "/*", "*/", ";", "10"b, 313 BREAKS, IGBREAKS, LEXDLM, LEXCTL); 314 315 /*[4.4-2]*/ first_time = "1"b; 316 317 end; 318 319 call translator_temp_$get_segment (my_name, area_ptr, code); 320 321 if area_ptr = null 322 then do; 323 324 call com_err_ (code, my_name, "Making temporary segment in process directory."); 325 return; 326 end; 327 328 call lex_string_$lex (source_ptr, n_chars, 0, area_ptr, "1000"b, """", """", "/*", "*/", ";", 329 BREAKS, IGBREAKS, LEXDLM, LEXCTL, APstmt, APtoken, code); 330 331 if code ^= 0 332 then do; 333 334 call com_err_ (code, my_name, ename); 335 return; 336 337 end; 338 339 Pthis_token = APtoken; 340 341 call SEMANTIC_ANALYSIS (); 342 343 if MERROR_SEVERITY > 1 344 then do; 345 346 call com_err_ (error_table_$translation_failed, my_name, ename); 347 call hcs_$delentry_seg (object_ptr, code); 348 349 end; 350 else do; 351 352 bitcount = 36 * (tree_ctl_hdr_len + tree_ctl_entry_len * tree_ctl.current_size); 353 354 call tssi_$finish_segment (object_ptr, bitcount, "101"b, aclinfo_ptr, code); /* rw, still needs copysw */ 355 356 if code ^= 0 357 then call com_err_ (code, my_name, "Unable to set bitcount on ^a>^a to ^d", dname, object_name, bitcount); 358 end; 359 360 call clean_up; /* terminate input segments */ 361 362 return; 363 364 /* Clean up procedure. Called if command is "quit" out of, and at end of normal processing. */ 365 366 clean_up: 367 procedure; 368 369 if source_ptr ^= null 370 then call hcs_$terminate_noname (source_ptr, code); 371 372 if object_ptr ^= null 373 then call hcs_$terminate_noname (object_ptr, code); 374 375 if area_ptr ^= null 376 then call translator_temp_$release_all_segments (area_ptr, code); 377 378 if aclinfo_ptr ^= null 379 then call tssi_$clean_up_segment (aclinfo_ptr); 380 381 end /* clean_up */ ; 382 383 384 385 declare 1 error_control_table (11) aligned internal static, 386 2 severity fixed bin (17) unaligned initial ( 387 (11) 3), 388 2 Soutput_stmt bit (1) unaligned initial ( 389 "1"b, 390 (10) (1) "0"b), 391 2 message char (96) varying initial ( 392 "New declarations must begin with ""declare 01"" or ""dcl 01"": ^a", /* 01 */ 393 "Premature end of input encountered.", /* 02 */ 394 "Invalid level name: ^a", /* 03 */ 395 "Level name must be followed by "","", queue, command, mp, or "";""", /* 04 */ 396 "Invalid queue name: ^a", /* 05 */ 397 "Unexpected EOF in source segment. Looking for queue name. ^a", /* 06 */ 398 "Unexpected EOF in source segment. Looking for command line. ^a", /* 07 */ 399 "Invalid tree level: ^a", /* 08 */ 400 "Unexpected EOF in source segment. Looking for tree level number. ^a", /* 09 */ 401 "Need quoted string for command or mp line: ^a", /* 10 */ 402 "Bad program-id for cobol_program_id: ^a"), /* 11 */ 403 2 brief_message char (24) varying initial ( 404 "Bad Declare: ^a", /* 01 */ 405 "Unexpected EOF", /* 02 */ 406 "Bad level name: ^a", /* 03 */ 407 "Bad level args: ^a", /* 04 */ 408 "Bad Queue Name: ^a", /* 05 */ 409 "Msg Queue Name: ^a", /* 06 */ 410 "Msg Command Line: ^a", /* 07 */ 411 "Bad Tree Level: ^a", /* 08 */ 412 "Msg Tree Level: ^a", /* 09 */ 413 "Need quoted string ^a", /* 10 */ 414 "Bad program-id ^a"); /* 11 */ 415 416 /* */ 417 418 /* */ 419 420 valid_level: proc () returns (bit (1) aligned); 421 422 if test_sw 423 then call ioa_ ("Parse: valid_level: ""^a"".", token_value); 424 425 i = cv_dec_check_ (token_value, j); 426 427 if j ^= 0 then return ("0"b); 428 429 if (i < 1 | i > 4) then return ("0"b); 430 431 if i > current_level 432 then do; 433 434 if i > current_level + 1 then return ("0"b); 435 if queue_level = current_level then return ("0"b); 436 437 end; 438 else do; /* new level <= current level */ 439 440 if queue_level = 0 then return ("0"b); /* didn't specify a queue name for abs tree path */ 441 else if queue_level ^= current_level then return ("0"b); /* should never find this */ 442 443 queue_level = 0; /* last level had good queue, set up for next time */ 444 445 end; 446 447 previous_level = current_level; 448 current_level = i; 449 return ("1"b); 450 451 end /* valid_level */ ; 452 453 /* */ 454 455 valid_program_id: proc () returns (bit (1) aligned); 456 457 if test_sw 458 then call ioa_ ("Parse: valid_program_id: ""^a"".", token_value); 459 460 if length (token_value) > 30 then return ("0"b); /* COBOL variables limited to 30 chars */ 461 462 if verify (token_value, alphanumerics) > 0 then return ("0"b); 463 464 if index (letters, substr (token_value, 1, 1)) = 0 then return ("0"b); /* 1st char must be letter */ 465 466 return ("1"b); 467 468 end /* valid_program_id */ ; 469 470 /* */ 471 472 valid_queue_name: proc () returns (bit (1) aligned); 473 474 if test_sw 475 then call ioa_ ("Parse: valid_queue_name: ""^a"".", token_value); 476 477 if length (token_value) > 21 then return ("0"b); /* COBOL queue names limited to 21 chars, plus suffix */ 478 479 if verify (token_value, alphanumerics) > 0 then return ("0"b); 480 481 if index (letters, substr (token_value, 1, 1)) = 0 then return ("0"b); /* 1st char must be letter */ 482 483 return ("1"b); 484 485 end /* valid_queue_name */ ; 486 487 /* */ 488 489 valid_level_name: proc () returns (bit (1) aligned); 490 491 if test_sw 492 then call ioa_ ("Parse: valid_level_name: ""^a"".", token_value); 493 494 if length (token_value) > 12 then return ("0"b); /* COBOL variables limited to 12 chars */ 495 496 if verify (token_value, alphanumerics) > 0 then return ("0"b); 497 498 if index (letters, substr (token_value, 1, 1)) = 0 then return ("0"b); /* 1st char must be letter */ 499 500 return ("1"b); 501 502 end /* valid_level_name */ ; 503 504 /* */ 505 506 close_db: proc (); 507 508 if test_sw 509 then call ioa_ ("Semantics: close_db: ""^a"".", token_value); 510 511 return; 512 513 end /* close_db */ ; 514 515 /* */ 516 517 close_tree: proc (); 518 519 if test_sw 520 then call ioa_ ("Semantics: close_tree: ""^a"".", token_value); 521 522 call close_tree_level; 523 524 end /* close_tree */ ; 525 526 /* */ 527 528 close_tree_level: proc (); 529 530 if test_sw 531 then call ioa_ ("Semantics: close_tree_level: ""^a"".", token_value); 532 533 i = levels (current_level).tree_entry_index; /* get location of tree_ctl_entry */ 534 tree_ctl_eptr = addr (tree_ctl.entries (i)); /* for based operations */ 535 tree_ctl_entry_overlay (*) = 0; /* wipe the slate clean */ 536 537 tree_ctl_entry.level_no = current_level; /* for perusing the tree elsewhere */ 538 tree_ctl_entry.cmd_sw = levels (current_level).cmd_sw; 539 tree_ctl_entry.queue_sw = levels (current_level).queue_sw; 540 tree_ctl_entry.mp_sw = levels (current_level).mp_sw; 541 tree_ctl_entry.cobol_program_id_sw = levels (current_level).cobol_program_id_sw; 542 543 queue_name, 544 tree_ctl_entry.queue_name = levels (current_level).queue_name; 545 tree_ctl_entry.cmd_line_len = levels (current_level).cmd_line_len; 546 tree_ctl_entry.mp_line_len = levels (current_level).mp_line_len; 547 tree_ctl_entry.cmd_line = levels (current_level).cmd_line; 548 549 /* set ptr variables to null () for subsequent testing */ 550 551 tree_ctl_entry.queue_ctl_eptr, 552 tree_ctl_entry.iocb_ptr, 553 tree_ctl_entry.msg_hdr_ptr, 554 tree_ctl_entry.msg_seg_ptr, 555 tree_ctl_entry.buffer_ptr, 556 tree_ctl_entry.tseg_ptr = null (); 557 558 tree_ctl_entry.switch_name = ""; /* so we dont print junk for unused entries */ 559 560 tree_ctl_entry.mp_line = levels (current_level).mp_line; 561 tree_ctl_entry.cobol_program_id_len = levels (current_level).cobol_program_id_len; 562 tree_ctl_entry.cobol_program_id = levels (current_level).cobol_program_id; 563 564 do i = 1 to 4; /* copy all level names, including blank trailing names */ 565 566 tree_ctl_entry.level_names (i) = levels (i).level_name; 567 568 end; 569 570 do i = 1 to current_level; /* copy all the subtree counts */ 571 572 j = levels (i).tree_entry_index; /* index into tree_ctl for the given entry */ 573 tree_ctl.entries (j).subtree_count = levels (i).subtree_count; 574 575 end; 576 577 if tree_ctl_entry.queue_sw /* if entry is for queue, bump count */ 578 then do; /* it's an entry for a queue */ 579 580 do j = 1 to tree_ctl.current_size - 1; 581 582 if queue_name = tree_ctl.entries (j).queue_name 583 then do; 584 585 tree_ctl_entry.queue_ctl_eindex = tree_ctl.entries (j).queue_ctl_eindex; 586 /* point to the first occurrance */ 587 go to close_tree_level_ret; 588 end; 589 end; 590 591 tree_ctl_entry.queue_ctl_eindex, 592 tree_ctl.queue_count = tree_ctl.queue_count + 1; /* drop-thru means first occurance */ 593 end; 594 595 close_tree_level_ret: 596 return; 597 598 end /* close_tree_level */ ; 599 600 /* */ 601 602 init_tree: proc (); 603 604 if test_sw 605 then call ioa_ ("Semantics: init_tree: ""^a"".", token_value); 606 607 current_level, previous_level = 1; /* initialize for new set */ 608 call open_tree_level; 609 610 return; 611 612 end /* init_tree */ ; 613 614 /* */ 615 616 open_tree_level: proc (); 617 618 if test_sw 619 then call ioa_ ("Semantics: open_tree_level: ""^a"".", token_value); 620 621 tree_ctl.current_size, tree_ctl.entry_count = tree_ctl.current_size + 1; /* next place to store an entry */ 622 levels (current_level).tree_entry_index = tree_ctl.current_size; /* remember it */ 623 624 if current_level = 1 625 then do; 626 627 string (levels (1).flags) = (36) "0"b; 628 629 levels (1).level_name, levels (2).level_name, levels (3).level_name, levels (4).level_name, 630 levels (1).queue_name, 631 levels (1).cmd_line, 632 levels (1).mp_line, 633 levels (1).cobol_program_id = ""; 634 635 levels (1).subtree_count, 636 levels (1).cmd_line_len, 637 levels (1).mp_line_len, 638 levels (1).cobol_program_id_len = 0; 639 640 end; 641 else do; /* current_level ^= 1 */ 642 643 do j = 1 to current_level - 1; 644 645 levels (j).subtree_count = levels (j).subtree_count + 1; /* bump all ancestor counts by 1 */ 646 647 end; 648 649 if current_level ^= 4 /* clear out all following level names */ 650 then do i = current_level + 1 to 4; /* just the trailing fields */ 651 652 levels (i).level_name = ""; 653 654 end; 655 656 j = current_level - 1; /* copy from prev level, newer args overlay */ 657 658 string (levels (current_level).flags) = string (levels (j).flags); 659 levels (current_level).level_name = levels (j).level_name; 660 levels (current_level).queue_name = levels (j).queue_name; 661 levels (current_level).subtree_count = 0; 662 levels (current_level).cmd_line_len = levels (j).cmd_line_len; 663 levels (current_level).cmd_line = levels (j).cmd_line; 664 levels (current_level).mp_line_len = levels (j).mp_line_len; 665 levels (current_level).mp_line = levels (j).mp_line; 666 levels (current_level).cobol_program_id_len = levels (j).cobol_program_id_len; 667 levels (current_level).cobol_program_id = levels (j).cobol_program_id; 668 669 if current_level > previous_level 670 then if previous_level = queue_level 671 then call ioa_ ("Warning: higher level follows queue_name level."); 672 else; 673 else queue_level = 0; /* ok - reset for next time */ 674 675 end; 676 677 return; 678 679 end /* open_tree_level */ ; 680 681 /* */ 682 683 set_mp_line: proc (); 684 685 if test_sw 686 then call ioa_ ("Semantics: set_mp_line: ""^a"".", token_value); 687 688 if length (token_value) > 128 689 then do; 690 691 levels (current_level).mp_line_len = 128; /* truncate and push on to catch other errors */ 692 levels (current_level).mp_line = substr (token_value, 1, 128); 693 694 if test_sw 695 then call ioa_ ("Warning: mp line truncated to 128 chars. Continuing."); 696 697 end; 698 699 else do; 700 701 levels (current_level).mp_line_len = length (token_value); 702 levels (current_level).mp_line = token_value; 703 704 end; 705 706 levels (current_level).mp_sw = "1"b; 707 708 return; 709 710 end /* set_mp_line */ ; 711 712 /* */ 713 714 set_command_line: proc (); 715 716 if test_sw 717 then call ioa_ ("Semantics: set_command_line: ""^a"".", token_value); 718 719 if length (token_value) > 128 720 then do; 721 722 levels (current_level).cmd_line_len = 128; /* truncate and push on to catch other errors */ 723 levels (current_level).cmd_line = substr (token_value, 1, 128); 724 725 if test_sw 726 then call ioa_ ("Warning: command line truncated to 128 chars. Continuing."); 727 728 end; 729 else do; 730 731 levels (current_level).cmd_line_len = length (token_value); 732 levels (current_level).cmd_line = token_value; 733 734 end; 735 levels (current_level).cmd_sw = "1"b; 736 737 call ioa_ ("Warning: The command_line arguments are ignored in this version."); /* just so they know */ 738 739 return; 740 741 end /* set_command_line */ ; 742 743 /* */ 744 745 set_program_id: proc (); 746 747 if test_sw 748 then call ioa_ ("Semantics: set_program_id: ""^a"".", token_value); 749 750 levels (current_level).cobol_program_id_len = length (token_value); 751 levels (current_level).cobol_program_id = token_value; 752 753 levels (current_level).cobol_program_id_sw = "1"b; 754 return; 755 756 end /* set_program_id */ ; 757 758 /* */ 759 760 set_queue_name: proc (); 761 762 if test_sw 763 then call ioa_ ("Semantics: set_queue_name: ""^a"".", token_value); 764 765 levels (current_level).queue_name = token_value; 766 queue_level = current_level; /* to check that queue was given when needed */ 767 levels (current_level).queue_sw = "1"b; 768 769 return; 770 771 end /* set_queue_name */ ; 772 773 /* */ 774 775 set_level_name: proc (); 776 777 if test_sw 778 then call ioa_ ("Semantics: set_level_name: ""^a"".", token_value); 779 780 levels (current_level).level_name = token_value; 781 782 return; 783 784 end /* set_level_name */ ; 785 786 test: entry; /* used to print out parse and semantics calls */ 787 788 test_sw = "1"b; 789 return; 790 791 792 793 dcl TRACING bit(1) aligned int static init("0"b); 794 795 6 1 /* START OF: rdc_start_.incl.pl1 * * * * * * */ 6 2 6 3 /* * * * * * * * * * * * * * * * * * * * * * * */ 6 4 /* */ 6 5 /* N__a_m_e: rdc_start_.incl.pl1 */ 6 6 /* */ 6 7 /* This include segment is used by compilers generated by the */ 6 8 /* reduction_compiler. Such compilers include a SEMANTIC_ANALYSIS */ 6 9 /* subroutine generated by the reduction_compiler. This subroutine */ 6 10 /* compares a chain of input tokens with token requirements */ 6 11 /* specified in reductions. This include segment declares the */ 6 12 /* structure of the input tokens (which are generated by lex_string_),*/ 6 13 /* defines the beginning of the SEMANTIC_ANALYSIS procedure, and */ 6 14 /* declares Pthis_token, a global pointer variable which points to */ 6 15 /* the "current" token being referenced by SEMANTIC_ANALYSIS. */ 6 16 /* */ 6 17 /* S__t_a_t_u_s */ 6 18 /* */ 6 19 /* 0) Created: April, 1974 by G. C. Dixon */ 6 20 /* */ 6 21 /* * * * * * * * * * * * * * * * * * * * * * * */ 6 22 6 23 dcl Pthis_token ptr; /* ptr to the "current" token being acted upon. */ 6 24 7 1 /* START OF: lex_descriptors_.incl.pl1 * * * * * * */ 7 2 7 3 /* * * * * * * * * * * * * * * * * * * * * * * */ 7 4 /* */ 7 5 /* Name: lex_descriptors_.incl.pl1 */ 7 6 /* */ 7 7 /* This include segment defines the structure of the token */ 7 8 /* descriptor, statement descriptor, and comment descriptor created */ 7 9 /* by the lex_string_ program. */ 7 10 /* */ 7 11 /* Status: */ 7 12 /* */ 7 13 /* 0) Created: Dec, 1973 by G. C. Dixon */ 7 14 /* */ 7 15 /* * * * * * * * * * * * * * * * * * * * * * * */ 7 16 7 17 7 18 7 19 7 20 dcl 7 21 1 comment aligned based (Pcomment), 7 22 /* descriptor for a comment. */ 7 23 2 group1 unaligned, 7 24 3 version fixed bin(17), /* comment descriptor version. */ 7 25 3 size fixed bin(17), /* comment descriptor size (in words). */ 7 26 2 Pnext ptr unal, /* ptr to next comment descriptor. */ 7 27 2 Plast ptr unal, /* ptr to last comment descriptor. */ 7 28 2 Pvalue ptr unal, /* ptr to comment. */ 7 29 2 Lvalue fixed bin(18), /* length of comment. */ 7 30 2 group2 unaligned, 7 31 3 line_no fixed bin(17), /* line no of line containing comment. */ 7 32 3 S, /* switches: */ 7 33 4 before_stmt bit(1), /* comment is before 1st token of stmt. */ 7 34 4 contiguous bit(1), /* no tokens between this and last comment. */ 7 35 4 pad bit(16), 7 36 comment_value char(comment.Lvalue) based (comment.Pvalue), 7 37 /* body of comment. */ 7 38 Pcomment ptr; /* ptr to comment descriptor. */ 7 39 7 40 dcl 7 41 1 stmt aligned based (Pstmt), 7 42 /* descriptor for a statement. */ 7 43 2 group1 unaligned, 7 44 3 version fixed bin(17), /* statement descriptor version. */ 7 45 3 size fixed bin(17), /* statement descriptor size (in words). */ 7 46 2 Pnext ptr unal, /* ptr to next statement descriptor. */ 7 47 2 Plast ptr unal, /* ptr to last statement descriptor. */ 7 48 2 Pvalue ptr unal, /* ptr to statement. */ 7 49 2 Lvalue fixed bin(18), /* length of statement. */ 7 50 2 Pfirst_token ptr unal, /* ptr to 1st token of statement. */ 7 51 2 Plast_token ptr unal, /* ptr to last token of statement. */ 7 52 2 Pcomments ptr unal, /* ptr to comments in statement. */ 7 53 2 Puser ptr unal, /* user-defined ptr. */ 7 54 2 group2 unaligned, 7 55 3 Ntokens fixed bin(17), /* number of tokens in statement. */ 7 56 3 line_no fixed bin(17), /* line no of line on which statement begins. */ 7 57 3 Istmt_in_line fixed bin(17), /* number of stmts in line containing this stmt. */ 7 58 /* (the number includes this stmt.) */ 7 59 3 semant_type fixed bin(17), /* semantic type of the statement. */ 7 60 3 S, /* switches: */ 7 61 4 error_in_stmt bit(1), /* stmt contains a syntactic error. */ 7 62 4 output_in_err_msg bit(1), /* stmt has been output in previous error message.*/ 7 63 4 pad bit(34), 7 64 stmt_value char(stmt.Lvalue) based (stmt.Pvalue), 7 65 /* text of the statement. */ 7 66 Pstmt ptr; /* ptr to a stmt descriptor. */ 7 67 7 68 dcl 7 69 1 token aligned based (Ptoken), 7 70 /* descriptor for a token. */ 7 71 2 group1 unaligned, 7 72 3 version fixed bin(17), /* token descriptor version. */ 7 73 3 size fixed bin(17), /* token descriptor size (in words). */ 7 74 2 Pnext ptr unal, /* ptr to next token descriptor. */ 7 75 2 Plast ptr unal, /* ptr to last token descriptor. */ 7 76 2 Pvalue ptr unal, /* ptr to token. */ 7 77 2 Lvalue fixed bin(18), /* length of token. */ 7 78 2 Pstmt ptr unal, /* ptr to descriptor of stmt containing token. */ 7 79 2 Psemant ptr unal, /* ptr to descriptor(s) of token's semantic value.*/ 7 80 2 group2 unaligned, 7 81 3 Itoken_in_stmt fixed bin(17), /* position of token within its statement. */ 7 82 3 line_no fixed bin(17), /* line number of the line containing the token. */ 7 83 3 Nvalue fixed bin(35), /* numeric value of decimal-integer tokens. */ 7 84 3 S, /* switches: */ 7 85 4 end_of_stmt bit(1), /* token is an end-of-stmt token. */ 7 86 4 quoted_string bit(1), /* token is a quoted string. */ 7 87 4 quotes_in_string bit(1), /* on if quote-close delimiters appear in quoted */ 7 88 /* string (as doubled quotes on input.) */ 7 89 4 quotes_doubled bit(1), /* on if quotes in the string are doubled after */ 7 90 /* string has been lexed into a token. */ 7 91 4 pad2 bit(32), 7 92 token_value char(token.Lvalue) based (token.Pvalue), 7 93 /* value of the token. */ 7 94 Ptoken ptr; /* ptr to a token descriptor. */ 7 95 7 96 /* END OF: lex_descriptors_.incl.pl1 * * * * * * */ 6 25 6 26 6 27 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 6 28 6 29 6 30 SEMANTIC_ANALYSIS: procedure; /* procedure which analyzes the syntax and */ 6 31 /* semantics of the tokens in the input list. */ 6 32 6 33 dcl /* automatic variables */ 6 34 LTOKEN_REQD_VALUE fixed bin(18), /* length of a token requirement. */ 6 35 NRED fixed bin, /* number of the reduction tokens are being */ 6 36 /* compared to. */ 6 37 PRED ptr, /* ptr to the reduction tokens are being */ 6 38 /* compared to. */ 6 39 PTOKEN_REQD ptr, /* ptr to token requirement descriptor associated */ 6 40 /* with reduction tokens are being compared to. */ 6 41 PTOKEN_REQD_VALUE ptr, /* ptr to a token requirement. */ 6 42 STOKEN_FCN bit(1) aligned, /* return value from a relative syntax function. */ 6 43 CODE fixed bin(35), /* an error code. */ 6 44 I fixed bin, /* a do-group index. */ 6 45 NUMBER fixed bin(35); /* fixed binary representation of a decimal */ 6 46 /* number character string. */ 6 47 6 48 dcl /* based variables */ 6 49 1 RED aligned based (PRED), 6 50 /* descriptor for reduction tokens are being */ 6 51 /* compared to. */ 6 52 2 TOKEN_REQD unaligned, 6 53 3 IFIRST fixed bin(17) unal, /* index of first token requirement. */ 6 54 3 ILAST fixed bin(17) unal, /* index of last token requirement associated */ 6 55 /* with this reduction. */ 6 56 1 TOKEN_REQD aligned based (PTOKEN_REQD), 6 57 /* a token requirement descriptor. */ 6 58 2 FORM fixed bin(17) unal, /* form of the token requirement: */ 6 59 /* -1 = relative token requirement function; */ 6 60 /* TYPE = index of the particular token */ 6 61 /* function in the token_fcn array. */ 6 62 /* 0 = built-in token requirement function; */ 6 63 /* TYPE = as defined below. */ 6 64 /* >0 = absolute token requirement: */ 6 65 /* FORM = index(TOKEN_STRINGS,TOKEN_REQD); */ 6 66 /* TYPE = length(TOKEN_REQD); */ 6 67 2 TYPE fixed bin(17) unal, /* TYPE of built-in token requirement function: */ 6 68 /* 1 = compile test to see if input token */ 6 69 /* chain is exhausted (). */ 6 70 /* 2 = compile test for any token value */ 6 71 /* (). */ 6 72 /* 3 = compile test for a PL/I identifier */ 6 73 /* () of 32 or fewer characters. */ 6 74 /* 4 = compile test for token which is a */ 6 75 /* . */ 6 76 /* 5 = compile test for token which is a single */ 6 77 /* backspace character (). */ 6 78 /* 6 = compile test for a token which is a */ 6 79 /* . */ 6 80 6 81 1 TOKEN_REQD_STRING aligned based (PTOKEN_REQD), 6 82 /* overlay for an absolute token requirement */ 6 83 /* descriptor. */ 6 84 2 I fixed bin(17) unal, /* index into list of token strings of the */ 6 85 /* absolute token string assoc w/ descriptor. */ 6 86 2 L fixed bin(17) unal, /* length of the absolute token string. */ 6 87 TOKEN_REQD_VALUE char(LTOKEN_REQD_VALUE) based (PTOKEN_REQD_VALUE); 6 88 /* absolute token string which token is reqd */ 6 89 /* to match in order for tokens which are */ 6 90 /* "current" on the list to match the reduction. */ 6 91 6 92 dcl /* builtin functions */ 6 93 (addr, max, null, search, substr, verify) 6 94 builtin; 6 95 6 96 dcl /* entries */ 6 97 cv_dec_check_ entry (char(*), fixed bin(35)) returns (fixed bin(35)); 6 98 6 99 dcl /* static variables */ 6 100 BACKSPACE char(1) aligned int static init (""); 6 101 6 102 /* END OF: rdc_start_.incl.pl1 * * * * * * */ 796 797 798 dcl DIRECTION fixed bin init(+1); /* direction in which tokens compared. */ 799 800 801 dcl 1 REDUCTION (36) unaligned based (addr (REDUCTIONS)), 802 /* object reductions. */ 803 2 TOKEN_REQD, 804 3 IFIRST fixed bin(17), /* index of first required token. */ 805 3 ILAST fixed bin(17), /* index of last required token. */ 806 807 REDUCTIONS (72) fixed bin(17) unaligned internal static options(constant) initial ( 808 1, 2, /* 1/ dcl 1 */ 809 3, 4, /* 2/ dcl 01 */ 810 5, 6, /* 3/ declare 1 */ 811 7, 8, /* 4/ declare 01 */ 812 9, 10, /* 5/ end ; */ 813 11, 11, /* 6/ */ 814 12, 12, /* 7/ */ 815 13, 12, /* 8/ */ 816 13, 13, /* 9/ */ 817 11, 11, /* 10/ */ 818 12, 12, /* 11/ */ 819 14, 14, /* 12/ , */ 820 10, 10, /* 13/ ; */ 821 15, 15, /* 14/ queue_name */ 822 16, 16, /* 15/ command_line */ 823 17, 17, /* 16/ mp_line */ 824 18, 18, /* 17/ cobol_program_id */ 825 11, 11, /* 18/ */ 826 12, 12, /* 19/ */ 827 19, 19, /* 20/ */ 828 11, 11, /* 21/ */ 829 12, 12, /* 22/ */ 830 20, 20, /* 23/ */ 831 11, 11, /* 24/ */ 832 12, 12, /* 25/ */ 833 20, 20, /* 26/ */ 834 11, 11, /* 27/ */ 835 12, 12, /* 28/ */ 836 21, 21, /* 29/ */ 837 11, 11, /* 30/ */ 838 12, 12, /* 31/ */ 839 22, 22, /* 32/ */ 840 11, 11, /* 33/ */ 841 12, 12, /* 34/ */ 842 23, 22, /* 35/ */ 843 23, 22); /* 36/ */ 844 845 dcl 1 TOKEN_REQUIREMENT (22) unaligned based (addr (TOKEN_REQUIREMENTS)), 846 /* object token requirements. */ 847 2 FORM fixed bin(17), /* form of the token requirement: */ 848 /* -1 = relative token requirement function; */ 849 /* TYPE = index of the particular token */ 850 /* function in the token_fcn array. */ 851 /* 0 = built-in token requirement function; */ 852 /* TYPE = as defined below. */ 853 /* >0 = absolute token requirement: */ 854 /* FORM = index(TOKEN_STRINGS,TOKEN_REQD); */ 855 /* TYPE = length(TOKEN_REQD); */ 856 2 TYPE fixed bin(17) unal, /* type of the built-in token requirement */ 857 /* function: */ 858 /* 1 = compile test to see if input token */ 859 /* chain is exhausted (). */ 860 /* 2 = compile test for any token value */ 861 /* (). */ 862 /* 3 = compile test for a PL/I identifier */ 863 /* () of 32 or fewer characters. */ 864 /* 4 = compile test for token which is a */ 865 /* . */ 866 /* 5 = compile test for token which is a single */ 867 /* backspace character (). */ 868 /* 6 = compile test for a token which is a */ 869 /* . */ 870 871 TOKEN_REQUIREMENTS (44) fixed bin(17) unaligned internal static options(constant) initial ( 872 1, 3, 4, 1, 1, 3, 5, 2, 7, 7, 4, 1, 7, 7, 873 5, 2, 14, 3, 17, 1, 0, 2, 0, 1, -1, 1, 18, 1, 874 19, 10, 29, 12, 41, 7, 48, 16, -1, 2, 0, 6, -1, 3, 875 -1, 4); 876 877 878 dcl TOKEN_STRINGS char(63) aligned based (addr (TOKEN_STRING_ARRAYS)), 879 /* object token values. */ 880 TOKEN_STRING_ARRAYS (1) char(100) aligned internal static options(constant) initial ( 881 "dcl101declareend;,queue_namecommand_linemp_linecobol_program_id"); 882 883 /* START OF: rdc_end_.incl.pl1 * * * * * * * * * * * * * * * * */ 8 2 8 3 8 4 /****^ HISTORY COMMENTS: 8 5* 1) change(86-02-14,GWMay), approve(), audit(), install(): 8 6* old history comments: 8 7* 0) Created: April, 1974 by G. C. Dixon 8 8* 1) Modified: Feb, 1975 by G. C. Dixon 8 9* a) support for Version 2.0 of reduction_compiler. 8 10* 2) Modified: Feb, 1981 by G. C. Dixon 8 11* a) support for Version 2.2 of reduction_compiler 8 12* 3) Modified: Aug, 1983 by G. C. Dixon - support for Version 2.3 of 8 13* reductions command. 8 14* 2) change(86-03-04,GDixon), approve(86-03-04,MCR7362), audit(86-03-17,GWMay), 8 15* install(86-03-17,MR12.0-1032): 8 16* Changed how the PUSH DOWN LANGUAGE (SPDL) definition of is 8 17* implemented to avoid references through a null pointer. The two 8 18* accepted uses are: 8 19* 8 20* / / ... / ... \ 8 21* A 8 22* | 8 23* Pthis_token (points to top of push down stack) 8 24* 8 25* which checks to see if the push down stack is totally exhausted (ie, 8 26* Ptoken = null); and: 8 27* 8 28* / SPEC1 ... SPECN / ... / ... \ 8 29* A 8 30* | 8 31* Pthis_token (points to top of push down stack) 8 32* 8 33* which checks to see whether SPECN is topmost on the push down stack 8 34* AND is the final token in the input list. 8 35* END HISTORY COMMENTS */ 8 36 8 37 8 38 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 8 39 /* */ 8 40 /* NAME: rdc_end_.incl.pl1 */ 8 41 /* */ 8 42 /* This include segment is used by compilers generated by the reduction_compiler. */ 8 43 /* Such compilers include a SEMANTIC_ANALYSIS subroutine generated by the */ 8 44 /* reduction_compiler. This subroutine compares a chain of input tokens with token */ 8 45 /* requirements specified in reductions. The code in this include segment performs the */ 8 46 /* actual comparisons. This code is the middle part of the SEMANTIC_ANALYSIS procedure. */ 8 47 /* */ 8 48 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 8 49 8 50 TRACING = TRACING; /* Kludge to prevent pl1 from making TRACING */ 8 51 /* options(constant) because it is never set. */ 8 52 NRED = 1; 8 53 go to RD_TEST_REDUCTION; 8 54 8 55 RD_NEXT_REDUCTION: 8 56 NRED = NRED + 1; 8 57 8 58 RD_TEST_REDUCTION: 8 59 PRED = addr(REDUCTION(NRED)); 8 60 Ptoken = Pthis_token; 8 61 8 62 do I = RED.TOKEN_REQD.IFIRST to RED.TOKEN_REQD.ILAST by DIRECTION; 8 63 PTOKEN_REQD = addr(TOKEN_REQUIREMENT(I)); 8 64 if Ptoken = null then do; 8 65 if TOKEN_REQD.FORM = 0 then /* No more tokens. Only matches spec. */ 8 66 if TOKEN_REQD.TYPE = 1 then 8 67 go to RD_TEST_TOKEN(1); 8 68 go to RD_NEXT_REDUCTION; 8 69 end; 8 70 if TOKEN_REQD.FORM = 0 then do; /* built-in syntax function. */ 8 71 go to RD_TEST_TOKEN(TOKEN_REQD.TYPE); 8 72 8 73 RD_TEST_TOKEN(1): if SPDL then /* */ 8 74 /* In push-down-language, there are 2 */ 8 75 /* interpretations of . */ 8 76 if RED.TOKEN_REQD.IFIRST = RED.TOKEN_REQD.ILAST & 8 77 Ptoken = null then /* When is only spec, the spec asks */ 8 78 go to RD_MATCH_NO_TOKEN; /* "Is push down stack empty (all input gone)?" */ 8 79 else if RED.TOKEN_REQD.IFIRST^= RED.TOKEN_REQD.ILAST & 8 80 RED.TOKEN_REQD.IFIRST = I & 8 81 token.Pnext = null then /* For SPEC1 ... SPECN , the spec asks */ 8 82 go to RD_MATCH_NO_TOKEN; /* "Are the topmost tokens on stack SPEC1 - SPECN,*/ 8 83 /* and is SPECN the final input token?" */ 8 84 else go to RD_NEXT_REDUCTION; /* Those are the only two defs allowed in push */ 8 85 /* down language mode for . */ 8 86 else if Ptoken = null then 8 87 go to RD_MATCH_NO_TOKEN; 8 88 go to RD_NEXT_REDUCTION; 8 89 8 90 RD_TEST_TOKEN(2): go to RD_MATCH; /* */ 8 91 8 92 RD_TEST_TOKEN(3): if token.Lvalue > 0 & /* */ 8 93 token.Lvalue <= 32 & ^token.S.quoted_string then 8 94 if search(substr(token_value,1,1),"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz") 8 95 > 0 then 8 96 if verify(token_value,"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_$") 8 97 = 0 then 8 98 go to RD_MATCH; 8 99 go to RD_NEXT_REDUCTION; 8 100 8 101 RD_TEST_TOKEN(4): /* */ 8 102 if token.Nvalue ^= 0 then /* token already determined to be a number. */ 8 103 go to RD_MATCH; 8 104 if token.S.quoted_string then 8 105 go to RD_NEXT_REDUCTION; 8 106 NUMBER = cv_dec_check_ (token_value, CODE); 8 107 if CODE = 0 then do; 8 108 token.Nvalue = NUMBER; 8 109 go to RD_MATCH; 8 110 end; 8 111 go to RD_NEXT_REDUCTION; 8 112 8 113 RD_TEST_TOKEN(5): if token.Lvalue = 1 then /* */ 8 114 if token_value = BACKSPACE & ^token.S.quoted_string then 8 115 go to RD_MATCH; 8 116 go to RD_NEXT_REDUCTION; 8 117 8 118 RD_TEST_TOKEN(6): if token.S.quoted_string then /* */ 8 119 go to RD_MATCH; 8 120 go to RD_NEXT_REDUCTION; 8 121 end; 8 122 8 123 else if TOKEN_REQD.FORM > 0 then do; /* absolute syntax specification. */ 8 124 if token.S.quoted_string then 8 125 go to RD_NEXT_REDUCTION; 8 126 PTOKEN_REQD_VALUE = addr(substr(TOKEN_STRINGS,TOKEN_REQD_STRING.I)); 8 127 LTOKEN_REQD_VALUE = TOKEN_REQD_STRING.L; 8 128 if token_value = TOKEN_REQD_VALUE then 8 129 go to RD_MATCH; 8 130 go to RD_NEXT_REDUCTION; 8 131 end; 8 132 8 133 /* END OF: rdc_end_.incl.pl1 * * * * * * * * * * * * * * * * */ 883 884 885 else do; /* relative syntax function. */ 886 go to RD_TOKEN_FCN(TOKEN_REQD.TYPE); 887 888 RD_TOKEN_FCN(1): STOKEN_FCN = valid_level_name(); 889 go to RD_TEST_RESULT; 890 RD_TOKEN_FCN(2): STOKEN_FCN = valid_queue_name(); 891 go to RD_TEST_RESULT; 892 RD_TOKEN_FCN(3): STOKEN_FCN = valid_program_id(); 893 go to RD_TEST_RESULT; 894 RD_TOKEN_FCN(4): STOKEN_FCN = valid_level(); 895 go to RD_TEST_RESULT; 896 897 RD_TEST_RESULT: if STOKEN_FCN then go to RD_MATCH; 898 else go to RD_NEXT_REDUCTION; 899 end; 900 901 RD_MATCH: Ptoken = token.Pnext; 902 RD_MATCH_NO_TOKEN: 903 end; 904 Ptoken = Pthis_token; 905 go to RD_ACTION(NRED); 906 907 908 RD_ACTION(1): /* / */ 909 NRED = 8; 910 go to RD_TEST_REDUCTION; /* / do_init \ */ 911 912 RD_ACTION(2): /* / */ 913 NRED = 8; 914 go to RD_TEST_REDUCTION; /* / do_init \ */ 915 916 RD_ACTION(3): /* / */ 917 NRED = 8; 918 go to RD_TEST_REDUCTION; /* / do_init \ */ 919 920 RD_ACTION(4): /* / */ 921 NRED = 8; 922 go to RD_TEST_REDUCTION; /* / do_init \ */ 923 924 RD_ACTION(5): /* / */ 925 call close_db(); 926 NRED = 36; 927 go to RD_TEST_REDUCTION; /* / fini \ */ 928 929 RD_ACTION(6): /* / */ 930 call ERROR ( 1 ); 931 call NEXT_STMT(); 932 NRED = 1; 933 go to RD_TEST_REDUCTION; /* / BEGIN \ */ 934 935 RD_ACTION(7): /* / */ 936 call ERROR ( 2 ); 937 NRED = 35; 938 go to RD_TEST_REDUCTION; /* / abort \ */ 939 940 RD_ACTION(8): /* / */ 941 call init_tree(); 942 call LEX ( 2 ); 943 NRED = 9; 944 go to RD_TEST_REDUCTION; /* / get_level_name \ */ 945 946 RD_ACTION(9): /* / */ 947 call set_level_name(); 948 call LEX ( 1 ); 949 NRED = 12; 950 go to RD_TEST_REDUCTION; /* / follow \ */ 951 952 RD_ACTION(10): /* / */ 953 call ERROR ( 3 ); 954 call NEXT_STMT(); 955 NRED = 1; 956 go to RD_TEST_REDUCTION; /* / BEGIN \ */ 957 958 RD_ACTION(11): /* / */ 959 call ERROR ( 2 ); 960 NRED = 35; 961 go to RD_TEST_REDUCTION; /* / abort \ */ 962 963 RD_ACTION(12): /* / */ 964 call close_tree_level(); 965 call LEX ( 1 ); 966 NRED = 32; 967 go to RD_TEST_REDUCTION; /* / get_level_no \ */ 968 969 RD_ACTION(13): /* / */ 970 call close_tree(); 971 call LEX ( 1 ); 972 NRED = 1; 973 go to RD_TEST_REDUCTION; /* / BEGIN \ */ 974 975 RD_ACTION(14): /* / */ 976 call LEX ( 1 ); 977 NRED = 20; 978 go to RD_TEST_REDUCTION; /* / get_queue_name \ */ 979 980 RD_ACTION(15): /* / */ 981 call LEX ( 1 ); 982 NRED = 23; 983 go to RD_TEST_REDUCTION; /* / get_command_line \ */ 984 985 RD_ACTION(16): /* / */ 986 call LEX ( 1 ); 987 NRED = 26; 988 go to RD_TEST_REDUCTION; /* / get_mp_line \ */ 989 990 RD_ACTION(17): /* / */ 991 call LEX ( 1 ); 992 NRED = 29; 993 go to RD_TEST_REDUCTION; /* / get_program_id \ */ 994 995 RD_ACTION(18): /* / */ 996 call ERROR ( 4 ); 997 call NEXT_STMT(); 998 NRED = 1; 999 go to RD_TEST_REDUCTION; /* / BEGIN \ */ 1000 1001 RD_ACTION(19): /* / */ 1002 call ERROR ( 2 ); 1003 NRED = 35; 1004 go to RD_TEST_REDUCTION; /* / abort \ */ 1005 1006 RD_ACTION(20): /* / */ 1007 call set_queue_name(); 1008 call LEX ( 1 ); 1009 NRED = 12; 1010 go to RD_TEST_REDUCTION; /* / follow \ */ 1011 1012 RD_ACTION(21): /* / */ 1013 call ERROR ( 5 ); 1014 call NEXT_STMT(); 1015 NRED = 1; 1016 go to RD_TEST_REDUCTION; /* / BEGIN \ */ 1017 1018 RD_ACTION(22): /* / */ 1019 call ERROR ( 6 ); 1020 NRED = 35; 1021 go to RD_TEST_REDUCTION; /* / abort \ */ 1022 1023 RD_ACTION(23): /* / */ 1024 call set_command_line(); 1025 call LEX ( 1 ); 1026 NRED = 12; 1027 go to RD_TEST_REDUCTION; /* / follow \ */ 1028 1029 RD_ACTION(24): /* / */ 1030 call ERROR ( 10 ); 1031 call NEXT_STMT(); 1032 NRED = 1; 1033 go to RD_TEST_REDUCTION; /* / BEGIN \ */ 1034 1035 RD_ACTION(25): /* / */ 1036 call ERROR ( 7 ); 1037 NRED = 35; 1038 go to RD_TEST_REDUCTION; /* / abort \ */ 1039 1040 RD_ACTION(26): /* / */ 1041 call set_mp_line(); 1042 call LEX ( 1 ); 1043 NRED = 12; 1044 go to RD_TEST_REDUCTION; /* / follow \ */ 1045 1046 RD_ACTION(27): /* / */ 1047 call ERROR ( 10 ); 1048 call NEXT_STMT(); 1049 NRED = 1; 1050 go to RD_TEST_REDUCTION; /* / BEGIN \ */ 1051 1052 RD_ACTION(28): /* / */ 1053 call ERROR ( 1 ); 1054 NRED = 35; 1055 go to RD_TEST_REDUCTION; /* / abort \ */ 1056 1057 RD_ACTION(29): /* / */ 1058 call set_program_id(); 1059 call LEX ( 1 ); 1060 NRED = 12; 1061 go to RD_TEST_REDUCTION; /* / follow \ */ 1062 1063 RD_ACTION(30): /* / */ 1064 call ERROR ( 11 ); 1065 call NEXT_STMT(); 1066 NRED = 1; 1067 go to RD_TEST_REDUCTION; /* / BEGIN \ */ 1068 1069 RD_ACTION(31): /* / */ 1070 call ERROR ( 1 ); 1071 NRED = 35; 1072 go to RD_TEST_REDUCTION; /* / abort \ */ 1073 1074 RD_ACTION(32): /* / */ 1075 call open_tree_level(); 1076 call LEX ( 1 ); 1077 NRED = 9; 1078 go to RD_TEST_REDUCTION; /* / get_level_name \ */ 1079 1080 RD_ACTION(33): /* / */ 1081 call ERROR ( 8 ); 1082 call NEXT_STMT(); 1083 NRED = 1; 1084 go to RD_TEST_REDUCTION; /* / BEGIN \ */ 1085 1086 RD_ACTION(34): /* / */ 1087 call ERROR ( 9 ); 1088 NRED = 35; 1089 go to RD_TEST_REDUCTION; /* / abort \ */ 1090 1091 RD_ACTION(35): /* / */ 1092 return; /* / RETURN \ */ 1093 1094 RD_ACTION(36): /* / */ 1095 return; /* / RETURN \ */ 1096 1097 1098 end SEMANTIC_ANALYSIS; 1099 1100 /* * * * * * * * * * * * * * * * * ** * * * * * * * * * * * * * * * * * * */ 1101 1102 dcl SPDL bit(1) aligned init ("0"b); 1103 /* off: This compiler parses a non-PUSH DOWN */ 1104 /* LANGUAGE. */ 1105 /* START OF: rdc_lex_.incl.pl1 * * * * * * * * * * * * * * * * */ 9 2 9 3 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 9 4 /* */ 9 5 /* N__a_m_e: rdc_lex_.incl.pl1 */ 9 6 /* */ 9 7 /* This include segment is used by compilers generated by the reduction_compiler. */ 9 8 /* It contains the LEX subroutine which is used to manipulate the pointer to the */ 9 9 /* "current" token, Pthis_token. */ 9 10 /* */ 9 11 /* E__n_t_r_y: LEX */ 9 12 /* */ 9 13 /* This entry makes the |_nth|-next (or -preceding) token the "current" token, where */ 9 14 /* _n is its positive (or negative) input argument. */ 9 15 /* */ 9 16 /* U__s_a_g_e */ 9 17 /* */ 9 18 /* call LEX(n); */ 9 19 /* */ 9 20 /* 1) n is the number of the token to be made the "current" token, relative to the */ 9 21 /* token identified by Pthis_token (the present "current" token). If n is */ 9 22 /* positive, the nth token following the "current" token made "current". If n */ 9 23 /* is negative, the nth token preceding the "current" token is made "current". */ 9 24 /* */ 9 25 /* S__t_a_t_u_s */ 9 26 /* */ 9 27 /* 0) Created by: G. C. Dixon in February, 1975 */ 9 28 /* */ 9 29 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 9 30 9 31 LEX: procedure (n); 9 32 9 33 dcl n fixed bin, 9 34 i fixed bin; 9 35 9 36 Ptoken = Pthis_token; /* do everything relative to "current" token. */ 9 37 if Ptoken = null then return; /* can't lex if token list exhausted. */ 9 38 if n >= 0 then do; /* new "current" token will follow present one. */ 9 39 do i = 1 to n while (token.Pnext ^= null); /* find new "current" token, taking care not to */ 9 40 Ptoken = token.Pnext; /* run off end of token list. */ 9 41 end; 9 42 if ^SPDL then if i <= n then Ptoken = null; /* if not in 'PUSH DOWN LANGUAGE' mode, allow */ 9 43 /* running off end of token list. */ 9 44 end; 9 45 else /* new "current" token precedes present one. */ 9 46 do i = -1 to n by -1 while (token.Plast ^= null); 9 47 Ptoken = token.Plast; 9 48 end; 9 49 Pthis_token = Ptoken; /* simple wasn't it. */ 9 50 9 51 end LEX; 9 52 9 53 /* END OF: rdc_lex_.incl.pl1 * * * * * * * * * * * * * * * * */ 1105 1106 1107 /* START OF: rdc_error_.incl.pl1 * * * * * * * * * * * * * * * * */ 10 2 10 3 dcl MERROR_SEVERITY fixed bin init (0), /* Severity of highest-severity error. */ 10 4 SERROR_CONTROL bit(2) init ("00"b),/* Global switches control error message format. */ 10 5 SERROR_PRINTED (dimension (error_control_table,1)) 10 6 bit(1) unaligned init ((dimension (error_control_table,1))(1)"0"b), 10 7 /* Array bit is on if corresponding error message */ 10 8 /* in error_control_table has already been printed*/ 10 9 MIN_PRINT_SEVERITY fixed bin init (0), /* Mimimum severity message that will be printed */ 10 10 PRINT_SEVERITY_CONTROL bit(2) init ("11"b);/* Action if severity < MIN_PRINT_SEVERITY */ 10 11 10 12 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 10 13 /* */ 10 14 /* N__a_m_e: rdc_error_.incl.pl1 */ 10 15 /* */ 10 16 /* This include segment is used by compilers generated by the reduction_compiler. */ 10 17 /* It defines a procedure which the compilers can use to print error messages. */ 10 18 /* */ 10 19 /* E__n_t_r_y: ERROR */ 10 20 /* */ 10 21 /* Given an error number, this procedure prints a corresponding error message. */ 10 22 /* The message is stored in a compiler-defined error_control_table, along with an integer */ 10 23 /* which specifies the severity level of the error, and a switch which specifies whether */ 10 24 /* the source statement in which the error occurred (if any) should be printed after the */ 10 25 /* error message. The printing of the error message may be supressed for all messages */ 10 26 /* having a severity less than a specified (MIN_PRINT_SEVERITY) value. The ERROR */ 10 27 /* procedure calls the lex_error_ subroutine to perform the formatting and printing of */ 10 28 /* the error message. */ 10 29 /* */ 10 30 /* U__s_a_g_e */ 10 31 /* */ 10 32 /* call ERROR (error_number); */ 10 33 /* */ 10 34 /* 1) error_number is the index of one of the structures in the error_control_table */ 10 35 /* which defines the error message to be printed. */ 10 36 /* */ 10 37 /* N__o_t_e_s */ 10 38 /* */ 10 39 /* The format of the error_control_table is shown below. */ 10 40 /* */ 10 41 /* dcl 1 error_control_table (2) aligned internal static, */ 10 42 /* 2 severity fixed bin(17) unaligned init (2,3), */ 10 43 /* 2 Soutput_stmt bit(1) unaligned initial ("0"b,"1"b), */ 10 44 /* 2 message char(252) varying initial ( */ 10 45 /* "The reduction source segment does not contain any reductions.", */ 10 46 /* "Reduction label '^a' is invalid."), */ 10 47 /* 2 brief_message char(100) varying initial ( */ 10 48 /* "", "'^a'"); */ 10 49 /* */ 10 50 /* error_control_table is an array of structures, with one array element per error. */ 10 51 /* Each structure contains: a severity level for the error; a switch which specifies */ 10 52 /* whether the source statement being processed should be output after the error message; */ 10 53 /* the long form of the error message text; and the brief form of the error message text.*/ 10 54 /* The dimension of the error_control_table array of structures, and the lengths of */ 10 55 /* message (long message) and brief_message (brief message), are compiler-defined. */ 10 56 /* structures and the lengths of the message and brief_message are compiler-defined. */ 10 57 /* The only requirement is that the messages be 256 characters or less in length. */ 10 58 /* (Remember that the longest character string which can be used in an initial attribute */ 10 59 /* is 254 characters in length.) */ 10 60 /* */ 10 61 /* The severity number causes the error message to be preceded by a herald which */ 10 62 /* includes one of the following prefixes: */ 10 63 /* */ 10 64 /* _s_e_v _p_r_e_f_i_x _e_x_p_l_a_n_a_t_i_o_n */ 10 65 /* 0 = COMMENT - this is a comment. */ 10 66 /* 1 = WARNING - a possible error has been detected. The */ 10 67 /* compiler will still generate an object segment. */ 10 68 /* 2 = ERROR - a probable error has been detected. The */ 10 69 /* compiler will still generate an object segment. */ 10 70 /* 3 = FATAL ERROR - an error has been detected which is so severe */ 10 71 /* that no object segment will be generated. */ 10 72 /* 4 = TRANSLATOR ERROR - an error has been detected in the operation of */ 10 73 /* the compiler or translator. No object segment */ 10 74 /* will be generated. */ 10 75 /* */ 10 76 /* Full error messages are of the form: */ 10 77 /* */ 10 78 /* _p_r_e_f_i_x _e_r_r_o_r__n_u_m_b_e_r, SEVERITY _s_e_v_e_r_i_t_y IN STATEMENT _n OF LINE _m */ 10 79 /* _t_e_x_t__o_f__e_r_r_o_r__m_e_s_s_a_g_e */ 10 80 /* SOURCE: */ 10 81 /* _s_o_u_r_c_e__s_t_a_t_e_m_e_n_t */ 10 82 /* */ 10 83 /* If only one statement appears in line _m, then "STATEMENT _n OF" is omitted. */ 10 84 /* If the source statement has been printed in a previous error message, it is omitted. */ 10 85 /* */ 10 86 /* The reduction compiler declares a bit string, SERROR_CONTROL, which controls the */ 10 87 /* text of an error message. The compiler may set this bit string, as shown below. */ 10 88 /* */ 10 89 /* SERROR_CONTROL _m_e_a_n_i_n_g */ 10 90 /* "00"b the first time a particular error occurs, the long message */ 10 91 /* is printed; the brief message is used in subsequent */ 10 92 /* occurrences of that error. */ 10 93 /* "10"b or "11"b the long error message is always used. */ 10 94 /* "01"b the brief error message is always used. */ 10 95 /* The initial value of SERROR_CONTROL is "00"b. */ 10 96 /* */ 10 97 /* The reduction_compiler creates a declaration for SERROR_PRINTED, an array */ 10 98 /* of switches (one per error). The switch corresponding to a particular error is */ 10 99 /* turned on whenever the error message is printed. This allows lex_error_ to detect */ 10 100 /* subsequent occurrences of that same error. */ 10 101 /* */ 10 102 /* The reduction_compiler creates MERROR_SEVERITY, a fixed bin(17) integer */ 10 103 /* in which the severity of the highest-severity error encountered is maintained. */ 10 104 /* The compiler may reference this integer. */ 10 105 /* */ 10 106 /* The reduction_compiler creates MIN_PRINT_SEVERITY, a fixed bin (17) integer */ 10 107 /* which controls the printing of error messages by the ERROR procedure. */ 10 108 /* Errors having a severity less than MIN_PRINT_SEVERITY will not cause lex_error_ to be */ 10 109 /* and no error will be printed. The behaviour of the ERROR procedure for such errors */ 10 110 /* is controlled by the value of PRINT_SEVERITY_CONTROL, described below. */ 10 111 /* The compiler may set the value of MIN_PRINT_SEVERITY; its initial value is 0. */ 10 112 10 113 /* */ 10 114 /* The reduction_compiler declares a bit string, PRINT_SEVERITY_CONTROL, which */ 10 115 /* controls the updating of MERROR_SEVERITY and SERROR_PRINTED when the severity of an */ 10 116 /* error is less than MIN_PRINT_SEVERITY. In such cases, the lex_error_ procedure is not */ 10 117 /* invoked, and the ERROR procedure must update these values as though lex_error_ were */ 10 118 /* called. The compiler may set this bit string, as shown below. */ 10 119 /* */ 10 120 /* PRINT_SEVERITY_CONTROL _m_e_a_n_i_n_g */ 10 121 /* "00"b update neither SERROR_PRINTED nor MERROR_SEVERITY. */ 10 122 /* "01"b update SERROR_PRINTED to reflect the error. */ 10 123 /* "10"b update MERROR_SEVERITY to reflect the error severity. */ 10 124 /* "11"b update SERROR_PRINTED and MERROR_SEVERITY appropriately. */ 10 125 /*The initial value of PRINT_SEVERITY_CONTROL is "11"b. */ 10 126 /* */ 10 127 /* The ERROR procedure is simple to use, but it does limit the flexibility of the */ 10 128 /* error message. A compiler action routine can output more flexible error messages */ 10 129 /* by calling lex_error_ directly. See lex_error_ documentation for more details. */ 10 130 /* */ 10 131 /* S__t_a_t_u_s */ 10 132 /* */ 10 133 /* 0) Created: April, 1974 by G. C. Dixon */ 10 134 /* 1) Modified: April, 1982 by E. N. Kittlitz. Added MIN_PRINT_SEVERITY, */ 10 135 /* PRINT_SEVERITY_CONTROL. */ 10 136 /* */ 10 137 /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ 10 138 10 139 ERROR: procedure (Nerror); 10 140 10 141 dcl Nerror fixed bin; /* Number of the error which was detected. (In) */ 10 142 10 143 dcl Pstmt ptr, 10 144 1 erring_token aligned based (Perring_token) like token, 10 145 Perring_token ptr, 10 146 erring_token_value char(erring_token.Lvalue) based (erring_token.Pvalue); 10 147 10 148 dcl (max, null) builtin; 10 149 10 150 dcl lex_error_ entry options (variable); 10 151 10 152 10 153 if error_control_table.severity(Nerror) < MIN_PRINT_SEVERITY then do; /* don't print */ 10 154 if PRINT_SEVERITY_CONTROL & "1"b then /* update MERROR_SEVERITY */ 10 155 MERROR_SEVERITY = max (MERROR_SEVERITY, error_control_table.severity(Nerror)); 10 156 if PRINT_SEVERITY_CONTROL & "01"b then /* update SERROR_PRINTED */ 10 157 SERROR_PRINTED(Nerror) = "1"b; 10 158 return; 10 159 end; 10 160 Perring_token = Pthis_token; /* address the current erring_token. */ 10 161 if error_control_table.Soutput_stmt(Nerror) then 10 162 if Perring_token = null then 10 163 Pstmt = null; 10 164 else 10 165 Pstmt = erring_token.Pstmt; /* address the statement descriptor. */ 10 166 else 10 167 Pstmt = null; 10 168 if Perring_token = null then 10 169 call lex_error_ (Nerror, SERROR_PRINTED(Nerror), (error_control_table.severity(Nerror)), 10 170 MERROR_SEVERITY, Pstmt, Perring_token, SERROR_CONTROL, (error_control_table.message(Nerror)), 10 171 (error_control_table.brief_message(Nerror))); 10 172 else 10 173 call lex_error_ (Nerror, SERROR_PRINTED(Nerror), (error_control_table.severity(Nerror)), 10 174 MERROR_SEVERITY, Pstmt, Perring_token, SERROR_CONTROL, (error_control_table.message(Nerror)), 10 175 (error_control_table.brief_message(Nerror)), erring_token_value, erring_token_value, erring_token_value); 10 176 10 177 end ERROR; 10 178 10 179 /* END OF: rdc_error_.incl.pl1 * * * * * * * * * * * * * * * * */ 1107 1108 1109 /* START OF: rdc_next_stmt_.incl.pl1 * * * * * * */ 11 2 11 3 /* * * * * * * * * * * * * * * * * * * * * * * */ 11 4 /* */ 11 5 /* N__a_m_e: rdc_next_stmt_.incl.pl1 */ 11 6 /* */ 11 7 /* This include segment is used by compilers generated by the */ 11 8 /* reduction_compiler. It includes a procedure which shifts the */ 11 9 /* compilation process to the next source statement. */ 11 10 /* */ 11 11 /* S__t_a_t_u_s */ 11 12 /* */ 11 13 /* 0) Created: April, 1974 by G. C. Dixon */ 11 14 /* */ 11 15 /* * * * * * * * * * * * * * * * * * * * * * * */ 11 16 11 17 11 18 NEXT_STMT: procedure; /* invoked to begin parsing the next statement of */ 11 19 /* the input tokens. */ 11 20 11 21 dcl null builtin, 11 22 Ssearching bit(1) aligned; 11 23 11 24 Ptoken = Pthis_token; /* make sure these pointers are the same. */ 11 25 Pstmt = token.Pstmt; /* address "current" statement's descriptor. */ 11 26 Ssearching = "1"b; /* start scanning forward for next statement. */ 11 27 do while (Ssearching & token.Pnext ^= null); 11 28 Ptoken = token.Pnext; 11 29 if token.Pstmt = Pstmt then; 11 30 else Ssearching = "0"b; 11 31 end; 11 32 if token.Pstmt = Pstmt then /* if there is no next statement, and */ 11 33 if SPDL then /* in PUSH DOWN LANGUAGE mode, can't run off */ 11 34 Ptoken = Ptoken; /* end of input list. */ 11 35 else Ptoken, Pthis_token = null; /* otherwise, input list exhausted. */ 11 36 else Pthis_token = Ptoken; /* normally, next statement exists and Ptoken */ 11 37 /* points to its 1st _n_o_n-__d_e_l_e_t_e_d token. */ 11 38 11 39 end NEXT_STMT; 11 40 11 41 /* END OF: rdc_next_stmt_.incl.pl1 * * * * * * */ 1109 1110 1111 end cv_cmcs_tree_ctl; SOURCE FILES USED IN THIS COMPILATION. LINE NUMBER DATE MODIFIED NAME PATHNAME 0 03/17/86 1452.8 cv_cmcs_tree_ctl.pl1 >spec>install>1032>cv_cmcs_tree_ctl.pl1 89 1 03/27/82 0439.5 cmcs_control_hdr.incl.pl1 >ldd>include>cmcs_control_hdr.incl.pl1 90 2 03/27/82 0431.4 cmcs_entry_dcls.incl.pl1 >ldd>include>cmcs_entry_dcls.incl.pl1 91 3 03/27/82 0439.6 cmcs_station_ctl.incl.pl1 >ldd>include>cmcs_station_ctl.incl.pl1 92 4 03/27/82 0439.6 cmcs_tree_ctl.incl.pl1 >ldd>include>cmcs_tree_ctl.incl.pl1 93 5 03/27/82 0439.6 cmcs_vfile_rs.incl.pl1 >ldd>include>cmcs_vfile_rs.incl.pl1 796 6 04/18/75 1242.4 rdc_start_.incl.pl1 >ldd>include>rdc_start_.incl.pl1 6-25 7 04/18/75 1242.4 lex_descriptors_.incl.pl1 >ldd>include>lex_descriptors_.incl.pl1 883 8 03/17/86 1404.9 rdc_end_.incl.pl1 >spec>install>1032>rdc_end_.incl.pl1 1105 9 04/18/75 1242.4 rdc_lex_.incl.pl1 >ldd>include>rdc_lex_.incl.pl1 1107 10 08/15/83 1511.7 rdc_error_.incl.pl1 >ldd>include>rdc_error_.incl.pl1 1109 11 04/18/75 1242.4 rdc_next_stmt_.incl.pl1 >ldd>include>rdc_next_stmt_.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. APstmt 001032 automatic pointer dcl 124 set ref 328* APtoken 001034 automatic pointer dcl 124 set ref 328* 339 BACKSPACE 007150 constant char(1) initial dcl 6-99 ref 8-113 BREAKS 000012 internal static varying char(128) dcl 188 set ref 309* 310 312* 328* CODE 001351 automatic fixed bin(35,0) dcl 6-33 set ref 8-106* 8-107 DIRECTION 001354 automatic fixed bin(17,0) initial dcl 798 set ref 8-62 798* FORM based fixed bin(17,0) level 2 packed unaligned dcl 6-48 ref 8-65 8-70 8-123 I based fixed bin(17,0) level 2 in structure "TOKEN_REQD_STRING" packed unaligned dcl 6-48 in procedure "SEMANTIC_ANALYSIS" ref 8-126 I 001352 automatic fixed bin(17,0) dcl 6-33 in procedure "SEMANTIC_ANALYSIS" set ref 8-62* 8-63 8-79* IFIRST based fixed bin(17,0) level 3 packed unaligned dcl 6-48 ref 8-62 8-73 8-79 8-79 IGBREAKS 000053 internal static varying char(128) dcl 188 set ref 310* 312* 328* ILAST 0(18) based fixed bin(17,0) level 3 packed unaligned dcl 6-48 ref 8-62 8-73 8-79 L 0(18) based fixed bin(17,0) level 2 packed unaligned dcl 6-48 ref 8-127 LEXCTL 000114 internal static varying char(128) dcl 188 set ref 312* 328* LEXDLM 000155 internal static varying char(128) dcl 188 set ref 312* 328* LTOKEN_REQD_VALUE 001340 automatic fixed bin(18,0) dcl 6-33 set ref 8-127* 8-128 Lvalue 4 based fixed bin(18,0) level 2 in structure "token" dcl 7-68 in procedure "cv_cmcs_tree_ctl" ref 422 422 425 425 457 457 460 462 464 474 474 477 479 481 491 491 494 496 498 508 508 519 519 530 530 604 604 618 618 685 685 688 692 701 702 716 716 719 723 731 732 747 747 750 751 762 762 765 777 777 780 8-92 8-92 8-92 8-92 8-106 8-106 8-113 8-113 8-128 Lvalue 4 based fixed bin(18,0) level 2 in structure "erring_token" dcl 10-143 in procedure "ERROR" ref 10-172 10-172 10-172 10-172 10-172 10-172 MERROR_SEVERITY 001163 automatic fixed bin(17,0) initial dcl 10-3 set ref 343 10-3* 10-154* 10-154 10-168* 10-172* MIN_PRINT_SEVERITY 001165 automatic fixed bin(17,0) initial dcl 10-3 set ref 10-3* 10-153 NRED 001341 automatic fixed bin(17,0) dcl 6-33 set ref 8-52* 8-55* 8-55 8-58 905 908* 912* 916* 920* 926* 932* 937* 943* 949* 955* 960* 966* 972* 977* 982* 987* 992* 998* 1003* 1009* 1015* 1020* 1026* 1032* 1037* 1043* 1049* 1054* 1060* 1066* 1071* 1077* 1083* 1088* NUMBER 001353 automatic fixed bin(35,0) dcl 6-33 set ref 8-106* 8-108 Nerror parameter fixed bin(17,0) dcl 10-141 set ref 10-139 10-153 10-154 10-156 10-161 10-168* 10-168 10-168 10-168 10-168 10-172* 10-172 10-172 10-172 10-172 Nvalue 10 based fixed bin(35,0) level 3 packed unaligned dcl 7-68 set ref 8-101 8-108* PRED 001342 automatic pointer dcl 6-33 set ref 8-58* 8-62 8-62 8-73 8-73 8-79 8-79 8-79 PRINT_SEVERITY_CONTROL 001166 automatic bit(2) initial unaligned dcl 10-3 set ref 10-3* 10-154 10-156 PTOKEN_REQD 001344 automatic pointer dcl 6-33 set ref 8-63* 8-65 8-65 8-70 8-71 8-123 8-126 8-127 886 PTOKEN_REQD_VALUE 001346 automatic pointer dcl 6-33 set ref 8-126* 8-128 Perring_token 001422 automatic pointer dcl 10-143 set ref 10-160* 10-161 10-164 10-168 10-168* 10-172* 10-172 10-172 10-172 10-172 10-172 10-172 10-172 10-172 10-172 Plast 2 based pointer level 2 packed unaligned dcl 7-68 ref 9-45 9-47 Pnext 1 based pointer level 2 packed unaligned dcl 7-68 ref 8-79 901 9-39 9-40 11-27 11-28 Pstmt 5 based pointer level 2 in structure "token" packed unaligned dcl 7-68 in procedure "cv_cmcs_tree_ctl" ref 11-25 11-29 11-32 Pstmt 5 based pointer level 2 in structure "erring_token" packed unaligned dcl 10-143 in procedure "ERROR" ref 10-164 Pstmt 001420 automatic pointer dcl 10-143 in procedure "ERROR" set ref 10-161* 10-164* 10-166* 10-168* 10-172* Pstmt 001156 automatic pointer dcl 7-40 in procedure "cv_cmcs_tree_ctl" set ref 11-25* 11-29 11-32 Pthis_token 001154 automatic pointer dcl 6-23 set ref 339* 8-60 904 9-36 9-49* 10-160 11-24 11-35* 11-36* Ptoken 001160 automatic pointer dcl 7-68 set ref 422 422 422 425 425 425 457 457 457 460 460 462 462 464 464 474 474 474 477 477 479 479 481 481 491 491 491 494 494 496 496 498 498 508 508 508 519 519 519 530 530 530 604 604 604 618 618 618 685 685 685 688 688 692 692 701 701 702 702 716 716 716 719 719 723 723 731 731 732 732 747 747 747 750 750 751 751 762 762 762 765 765 777 777 777 780 780 8-60* 8-64 8-73 8-79 8-86 8-92 8-92 8-92 8-92 8-92 8-92 8-92 8-101 8-104 8-106 8-106 8-106 8-108 8-113 8-113 8-113 8-113 8-118 8-124 8-128 8-128 901* 901 904* 9-36* 9-37 9-39 9-40* 9-40 9-42* 9-45 9-47* 9-47 9-49 11-24* 11-25 11-27 11-28* 11-28 11-29 11-32 11-32* 11-32 11-35* 11-36 Pvalue 3 based pointer level 2 in structure "token" packed unaligned dcl 7-68 in procedure "cv_cmcs_tree_ctl" ref 422 425 457 460 462 464 474 477 479 481 491 494 496 498 508 519 530 604 618 685 688 692 701 702 716 719 723 731 732 747 750 751 762 765 777 780 8-92 8-92 8-106 8-113 8-128 Pvalue 3 based pointer level 2 in structure "erring_token" packed unaligned dcl 10-143 in procedure "ERROR" ref 10-172 10-172 10-172 RED based structure level 1 dcl 6-48 REDUCTION based structure array level 1 packed unaligned dcl 801 set ref 8-58 REDUCTIONS 000710 constant fixed bin(17,0) initial array unaligned dcl 801 set ref 8-58 S 11 based structure level 3 packed unaligned dcl 7-68 SERROR_CONTROL 001164 automatic bit(2) initial unaligned dcl 10-3 set ref 230* 233* 10-3* 10-168* 10-172* SERROR_PRINTED 001165 automatic bit(1) initial array unaligned dcl 10-3 set ref 10-3* 10-156* 10-168* 10-172* SPDL 001162 automatic bit(1) initial dcl 1102 set ref 1102* 8-73 9-42 11-32 STOKEN_FCN 001350 automatic bit(1) dcl 6-33 set ref 888* 890* 892* 894* 897 Soutput_stmt 0(18) 000000 constant bit(1) initial array level 2 packed unaligned dcl 385 ref 10-161 Ssearching 001432 automatic bit(1) dcl 11-21 set ref 11-26* 11-27 11-30* TOKEN_REQD based structure level 1 dcl 6-48 in procedure "SEMANTIC_ANALYSIS" TOKEN_REQD based structure level 2 in structure "RED" packed unaligned dcl 6-48 in procedure "SEMANTIC_ANALYSIS" TOKEN_REQD_STRING based structure level 1 dcl 6-48 TOKEN_REQD_VALUE based char unaligned dcl 6-48 ref 8-128 TOKEN_REQUIREMENT based structure array level 1 packed unaligned dcl 845 set ref 8-63 TOKEN_REQUIREMENTS 000662 constant fixed bin(17,0) initial array unaligned dcl 845 set ref 8-63 TOKEN_STRINGS based char(63) dcl 878 set ref 8-126 TOKEN_STRING_ARRAYS 000631 constant char(100) initial array dcl 878 set ref 8-126 TRACING 000220 internal static bit(1) initial dcl 793 set ref 8-50* 8-50 TYPE 0(18) based fixed bin(17,0) level 2 packed unaligned dcl 6-48 ref 8-65 8-71 886 aclinfo_ptr 000102 automatic pointer dcl 81 set ref 245* 284* 354* 378 378* addr builtin function dcl 147 in procedure "cv_cmcs_tree_ctl" ref 534 addr builtin function dcl 6-92 in procedure "SEMANTIC_ANALYSIS" ref 8-58 8-58 8-63 8-63 8-126 8-126 alphanumerics 000754 constant char(64) initial unaligned dcl 192 ref 462 464 464 479 481 481 496 498 498 area_ptr 001036 automatic pointer dcl 124 set ref 244* 319* 321 328* 375 375* arg_length 001040 automatic fixed bin(21,0) dcl 124 set ref 208* 218 218 223 223 228* 230 230 233 233 236 236 arg_ptr 001042 automatic pointer dcl 124 set ref 208* 218 223 228* 230 230 233 233 236 arg_string based char unaligned dcl 140 set ref 218* 223* 230 230 233 233 236* bitcount 001044 automatic fixed bin(24,0) dcl 124 set ref 249* 280 352* 354* 356* brief_message 32 000000 constant varying char(24) initial array level 2 dcl 385 ref 10-168 10-172 buffer_info 210 based structure level 3 dcl 4-26 buffer_ptr 210 based pointer level 4 dcl 4-26 set ref 551* cleanup 001146 stack reference condition dcl 152 ref 247 cmcs_fillin_hdr_ 000222 constant entry external dcl 2-16 ref 298 cmd_line 20 000122 automatic char(128) array level 2 in structure "levels" packed unaligned dcl 105 in procedure "cv_cmcs_tree_ctl" set ref 547 629* 663* 663 723* 732* cmd_line 31 based char(128) level 3 in structure "tree_ctl_entry" dcl 4-26 in procedure "cv_cmcs_tree_ctl" set ref 547* cmd_line_len 30 based fixed bin(17,0) level 3 in structure "tree_ctl_entry" dcl 4-26 in procedure "cv_cmcs_tree_ctl" set ref 545* cmd_line_len 17 000122 automatic fixed bin(17,0) array level 2 in structure "levels" dcl 105 in procedure "cv_cmcs_tree_ctl" set ref 545 635* 662* 662 722* 731* cmd_sw 000122 automatic bit(1) array level 3 in structure "levels" packed unaligned dcl 105 in procedure "cv_cmcs_tree_ctl" set ref 538 735* cmd_sw 14(01) based bit(1) level 4 in structure "tree_ctl_entry" packed unaligned dcl 4-26 in procedure "cv_cmcs_tree_ctl" set ref 538* cobol_program_id 122 000122 automatic char(128) array level 2 in structure "levels" packed unaligned dcl 105 in procedure "cv_cmcs_tree_ctl" set ref 562 629* 667* 667 751* cobol_program_id 133 based char(32) level 3 in structure "tree_ctl_entry" dcl 4-26 in procedure "cv_cmcs_tree_ctl" set ref 562* cobol_program_id_len 132 based fixed bin(17,0) level 3 in structure "tree_ctl_entry" dcl 4-26 in procedure "cv_cmcs_tree_ctl" set ref 561* cobol_program_id_len 121 000122 automatic fixed bin(17,0) array level 2 in structure "levels" dcl 105 in procedure "cv_cmcs_tree_ctl" set ref 561 635* 666* 666 750* cobol_program_id_sw 14(03) based bit(1) level 4 in structure "tree_ctl_entry" packed unaligned dcl 4-26 in procedure "cv_cmcs_tree_ctl" set ref 541* cobol_program_id_sw 0(02) 000122 automatic bit(1) array level 3 in structure "levels" packed unaligned dcl 105 in procedure "cv_cmcs_tree_ctl" set ref 541 753* code 001045 automatic fixed bin(35,0) dcl 124 set ref 208* 210 213* 218* 220 223* 228* 230 249* 254* 273* 284* 286 289* 298* 300 300* 319* 324* 328* 331 334* 347* 354* 356 356* 369* 372* 375* collate builtin function dcl 147 ref 309 309 com_err_ 000224 constant entry external dcl 156 ref 213 223 236 254 265 289 300 324 334 346 356 command_info 30 based structure level 2 dcl 4-26 control_hdr based structure level 1 dcl 1-11 cu_$arg_ptr 000226 constant entry external dcl 156 ref 208 228 current_level 000117 automatic fixed bin(17,0) dcl 102 set ref 240* 431 434 435 441 447 448* 533 537 538 539 540 541 543 545 546 547 560 561 562 570 607* 622 624 643 649 649 656 658 659 660 661 662 663 664 665 666 667 669 691 692 701 702 706 722 723 731 732 735 750 751 753 765 766 767 780 current_size 16 based fixed bin(18,0) level 3 dcl 4-16 set ref 352 580 621 621* 622 cv_dec_check_ 000274 constant entry external dcl 6-96 in procedure "SEMANTIC_ANALYSIS" ref 8-106 cv_dec_check_ 000230 constant entry external dcl 156 in procedure "cv_cmcs_tree_ctl" ref 425 dimension builtin function dcl 147 ref 10-3 10-3 divide builtin function dcl 147 ref 280 dname 001046 automatic char(168) unaligned dcl 124 set ref 218* 249* 254* 282* 284* 289* 356* dynamic_queue_info 146 based structure level 3 dcl 4-26 ename 001120 automatic char(32) unaligned dcl 124 set ref 218* 249* 254* 261 278 334* 346* entries 100 based structure array level 2 dcl 4-16 set ref 534 entry_count 17 based fixed bin(18,0) level 3 dcl 4-16 set ref 621* entry_flags 14 based structure level 3 dcl 4-26 erring_token based structure level 1 dcl 10-143 erring_token_value based char unaligned dcl 10-143 set ref 10-172* 10-172* 10-172* error_control_table 000000 constant structure array level 1 dcl 385 ref 10-3 10-3 error_table_$bad_name 000270 external static fixed bin(35,0) dcl 200 set ref 265* error_table_$badopt 000264 external static fixed bin(35,0) dcl 200 set ref 236* error_table_$entlong 000266 external static fixed bin(35,0) dcl 200 ref 273 error_table_$translation_failed 000272 external static fixed bin(35,0) dcl 200 set ref 346* expand_pathname_ 000232 constant entry external dcl 156 ref 218 first_time 000217 internal static bit(1) initial dcl 188 set ref 306 315* flags 000122 automatic structure array level 2 packed unaligned dcl 105 set ref 627* 658* 658 get_wdir_ 000234 constant entry external dcl 156 ref 282 group2 7 based structure level 2 packed unaligned dcl 7-68 hcs_$delentry_seg 000236 constant entry external dcl 156 ref 347 hcs_$initiate_count 000240 constant entry external dcl 156 ref 249 hcs_$terminate_noname 000242 constant entry external dcl 156 ref 369 372 hdr based structure level 2 dcl 4-16 i 001406 automatic fixed bin(17,0) dcl 9-33 in procedure "LEX" set ref 9-39* 9-42 9-45* i 001130 automatic fixed bin(17,0) dcl 124 in procedure "cv_cmcs_tree_ctl" set ref 261* 263 270 278 425* 429 429 431 434 448 533* 534 564* 566 566* 570* 572 573* 649* 652* index builtin function dcl 147 ref 261 464 481 498 io_info 144 based structure level 2 dcl 4-26 ioa_ 000244 constant entry external dcl 156 ref 422 457 474 491 508 519 530 604 618 669 685 694 716 725 737 747 762 777 iocb_ptr 160 based pointer level 4 dcl 4-26 set ref 551* j 000100 automatic fixed bin(17,0) dcl 81 set ref 425* 427 572* 573 580* 582 585* 643* 645 645* 656* 658 659 660 662 663 664 665 666 667 length builtin function dcl 147 ref 270 270 460 477 494 688 701 719 731 750 letters defined char(52) unaligned dcl 196 ref 464 481 498 level_info 100 based structure array level 3 in structure "tree_ctl" dcl 4-16 in procedure "cv_cmcs_tree_ctl" level_info based structure level 2 in structure "tree_ctl_entry" dcl 4-26 in procedure "cv_cmcs_tree_ctl" level_name 4 000122 automatic char(12) array level 2 packed unaligned dcl 105 set ref 566 629* 629* 629* 629* 652* 659* 659 780* level_names based char(12) array level 4 dcl 4-26 set ref 566* level_no 15 based fixed bin(17,0) level 3 dcl 4-26 set ref 537* levels 000122 automatic structure array level 1 unaligned dcl 105 lex_error_ 000276 constant entry external dcl 10-150 ref 10-168 10-172 lex_string_$init_lex_delims 000246 constant entry external dcl 156 ref 312 lex_string_$lex 000250 constant entry external dcl 156 ref 328 max builtin function dcl 10-148 ref 10-154 message 1 000000 constant varying char(96) initial array level 2 dcl 385 ref 10-168 10-172 mp_line 72 based char(128) level 3 in structure "tree_ctl_entry" dcl 4-26 in procedure "cv_cmcs_tree_ctl" set ref 560* mp_line 61 000122 automatic char(128) array level 2 in structure "levels" packed unaligned dcl 105 in procedure "cv_cmcs_tree_ctl" set ref 560 629* 665* 665 692* 702* mp_line_len 60 000122 automatic fixed bin(17,0) array level 2 in structure "levels" dcl 105 in procedure "cv_cmcs_tree_ctl" set ref 546 635* 664* 664 691* 701* mp_line_len 71 based fixed bin(17,0) level 3 in structure "tree_ctl_entry" dcl 4-26 in procedure "cv_cmcs_tree_ctl" set ref 546* mp_sw 14(02) based bit(1) level 4 in structure "tree_ctl_entry" packed unaligned dcl 4-26 in procedure "cv_cmcs_tree_ctl" set ref 540* mp_sw 0(01) 000122 automatic bit(1) array level 3 in structure "levels" packed unaligned dcl 105 in procedure "cv_cmcs_tree_ctl" set ref 540 706* msg_hdr_info 164 based structure level 3 dcl 4-26 msg_hdr_ptr 164 based pointer level 4 dcl 4-26 set ref 551* msg_seg_info 202 based structure level 3 dcl 4-26 msg_seg_ptr 202 based pointer level 4 dcl 4-26 set ref 551* my_name 000774 constant char(16) initial unaligned dcl 192 set ref 213* 223* 236* 254* 265* 289* 300* 319* 324* 334* 346* 356* n parameter fixed bin(17,0) dcl 9-33 ref 9-31 9-38 9-39 9-42 9-45 n_chars 001131 automatic fixed bin(21,0) dcl 124 set ref 280* 328* null builtin function dcl 10-148 in procedure "ERROR" ref 10-161 10-161 10-166 10-168 null builtin function dcl 6-92 in procedure "SEMANTIC_ANALYSIS" ref 8-64 8-73 8-79 8-86 null builtin function dcl 147 in procedure "cv_cmcs_tree_ctl" ref 242 243 244 245 251 321 369 372 375 378 551 9-37 9-39 9-42 9-45 null builtin function dcl 11-21 in procedure "NEXT_STMT" ref 11-27 11-35 object_name 001132 automatic char(32) unaligned dcl 124 set ref 270 278* 284* 289* 356* object_ptr 001142 automatic pointer dcl 124 set ref 243* 284* 296 298* 347* 354* 372 372* previous_level 000120 automatic fixed bin(17,0) dcl 102 set ref 447* 607* 669 669 queue_count 40 based fixed bin(17,0) level 2 dcl 4-16 set ref 302* 591 591* queue_ctl_eindex 27 based fixed bin(17,0) level 3 in structure "tree_ctl_entry" dcl 4-26 in procedure "cv_cmcs_tree_ctl" set ref 585* 591* queue_ctl_eindex 127 based fixed bin(17,0) array level 4 in structure "tree_ctl" dcl 4-16 in procedure "cv_cmcs_tree_ctl" set ref 585 queue_ctl_eptr 156 based pointer level 4 dcl 4-26 set ref 551* queue_level 000121 automatic fixed bin(17,0) dcl 102 set ref 240* 435 440 441 443* 669 673* 766* queue_name 7 000122 automatic char(32) array level 2 in structure "levels" packed unaligned dcl 105 in procedure "cv_cmcs_tree_ctl" set ref 543 629* 660* 660 765* queue_name 000104 automatic char(32) unaligned dcl 81 in procedure "cv_cmcs_tree_ctl" set ref 543* 582 queue_name 17 based char(32) level 3 in structure "tree_ctl_entry" dcl 4-26 in procedure "cv_cmcs_tree_ctl" set ref 543* queue_name 117 based char(32) array level 4 in structure "tree_ctl" dcl 4-16 in procedure "cv_cmcs_tree_ctl" set ref 582 queue_sw 14(04) based bit(1) level 4 in structure "tree_ctl_entry" packed unaligned dcl 4-26 in procedure "cv_cmcs_tree_ctl" set ref 539* 577 queue_sw 0(03) 000122 automatic bit(1) array level 3 in structure "levels" packed unaligned dcl 105 in procedure "cv_cmcs_tree_ctl" set ref 539 767* quoted_string 11(01) based bit(1) level 4 packed unaligned dcl 7-68 ref 8-92 8-104 8-113 8-118 8-124 search builtin function dcl 6-92 ref 8-92 severity 000000 constant fixed bin(17,0) initial array level 2 packed unaligned dcl 385 ref 10-153 10-154 10-168 10-172 size builtin function dcl 147 ref 535 source_ptr 001144 automatic pointer dcl 124 set ref 242* 249* 251 328* 369 369* static_queue_info 17 based structure level 2 in structure "tree_ctl_entry" dcl 4-26 in procedure "cv_cmcs_tree_ctl" static_queue_info 117 based structure array level 3 in structure "tree_ctl" dcl 4-16 in procedure "cv_cmcs_tree_ctl" station_ctl_entry based structure level 1 dcl 3-21 string builtin function dcl 147 set ref 627* 658* 658 substr builtin function dcl 147 in procedure "cv_cmcs_tree_ctl" ref 278 309 309 310 464 481 498 692 723 substr builtin function dcl 6-92 in procedure "SEMANTIC_ANALYSIS" ref 8-92 8-126 subtree_count 3 000122 automatic fixed bin(17,0) array level 2 in structure "levels" dcl 105 in procedure "cv_cmcs_tree_ctl" set ref 573 635* 645* 645 661* subtree_count 116 based fixed bin(17,0) array level 4 in structure "tree_ctl" dcl 4-16 in procedure "cv_cmcs_tree_ctl" set ref 573* switch_name 146 based char(32) level 4 packed unaligned dcl 4-26 set ref 558* test_sw 000216 internal static bit(1) initial unaligned dcl 188 set ref 422 457 474 491 508 519 530 604 618 685 694 716 725 747 762 777 788* token based structure level 1 dcl 7-68 token_value based char unaligned dcl 7-68 set ref 422* 425* 457* 460 462 464 474* 477 479 481 491* 494 496 498 508* 519* 530* 604* 618* 685* 688 692 701 702 716* 719 723 731 732 747* 750 751 762* 765 777* 780 8-92 8-92 8-106* 8-113 8-128 translator_temp_$get_segment 000252 constant entry external dcl 156 ref 319 translator_temp_$release_all_segments 000254 constant entry external dcl 156 ref 375 tree_ctl based structure level 1 dcl 4-16 tree_ctl_entry based structure level 1 dcl 4-26 set ref 535 tree_ctl_entry_len 001000 constant fixed bin(17,0) initial dcl 4-10 set ref 298* 352 tree_ctl_entry_overlay based fixed bin(17,0) array dcl 142 set ref 535* tree_ctl_eptr 000114 automatic pointer dcl 4-24 set ref 534* 535 535 537 538 539 540 541 543 545 546 547 551 551 551 551 551 551 558 560 561 562 566 577 585 591 tree_ctl_hdr_len 001060 constant fixed bin(17,0) initial dcl 4-10 set ref 298* 352 tree_ctl_ptr 000010 internal static pointer dcl 4-14 set ref 296* 302 352 534 573 580 582 585 591 591 621 621 621 622 tree_ctl_version 001062 constant fixed bin(17,0) initial dcl 4-10 set ref 298* tree_entry_index 2 000122 automatic fixed bin(17,0) array level 2 dcl 105 set ref 533 572 622* tree_path based structure level 3 dcl 4-26 tseg_info 176 based structure level 3 dcl 4-26 tseg_ptr 176 based pointer level 4 dcl 4-26 set ref 551* tssi_$clean_up_segment 000262 constant entry external dcl 156 ref 378 tssi_$finish_segment 000260 constant entry external dcl 156 ref 354 tssi_$get_segment 000256 constant entry external dcl 156 ref 284 verify builtin function dcl 147 in procedure "cv_cmcs_tree_ctl" ref 462 479 496 verify builtin function dcl 6-92 in procedure "SEMANTIC_ANALYSIS" ref 8-92 vfile_descr 000116 automatic structure level 1 packed unaligned dcl 5-28 NAMES DECLARED BY DECLARE STATEMENT AND NEVER REFERENCED. LEGAL internal static char(71) initial dcl 192 Pcomment automatic pointer dcl 7-20 clock_ 000000 constant entry external dcl 156 cmcs_create_queues_ 000000 constant entry external dcl 2-8 cmcs_date_time_ 000000 constant entry external dcl 2-10 cmcs_decode_status_ 000000 constant entry external dcl 2-12 cmcs_expand_tree_path_ 000000 constant entry external dcl 2-14 cmcs_initiate_ctl_ 000000 constant entry external dcl 2-18 cmcs_print_ 000000 constant entry external dcl 2-20 cmcs_purge_queues_ 000000 constant entry external dcl 2-22 cmcs_queue_ctl_$accept_message_count 000000 constant entry external dcl 2-24 cmcs_queue_ctl_$disable 000000 constant entry external dcl 2-25 cmcs_queue_ctl_$enable 000000 constant entry external dcl 2-26 cmcs_queue_ctl_$print 000000 constant entry external dcl 2-27 cmcs_queue_ctl_$purge 000000 constant entry external dcl 2-28 cmcs_queue_ctl_$receive 000000 constant entry external dcl 2-29 cmcs_queue_ctl_$send 000000 constant entry external dcl 2-30 cmcs_queue_ctl_$stop_run 000000 constant entry external dcl 2-31 cmcs_scramble_ 000000 constant entry external dcl 2-33 cmcs_set_lock_$lock 000000 constant entry external dcl 2-35 cmcs_set_lock_$unlock 000000 constant entry external dcl 2-36 cmcs_station_ctl_$attach 000000 constant entry external dcl 2-38 cmcs_station_ctl_$detach 000000 constant entry external dcl 2-39 cmcs_station_ctl_$detach_name 000000 constant entry external dcl 2-40 cmcs_station_ctl_$disable_input_terminal 000000 constant entry external dcl 2-41 cmcs_station_ctl_$disable_output_terminal 000000 constant entry external dcl 2-42 cmcs_station_ctl_$enable_input_terminal 000000 constant entry external dcl 2-43 cmcs_station_ctl_$enable_output_terminal 000000 constant entry external dcl 2-44 cmcs_station_ctl_$find_destination 000000 constant entry external dcl 2-45 cmcs_station_ctl_$input_disabled 000000 constant entry external dcl 2-46 cmcs_station_ctl_$output_disabled 000000 constant entry external dcl 2-47 cmcs_station_ctl_$validate 000000 constant entry external dcl 2-48 cmcs_status_list_ctl_$add 000000 constant entry external dcl 2-50 cmcs_status_list_ctl_$delete 000000 constant entry external dcl 2-51 cmcs_status_list_ctl_$move 000000 constant entry external dcl 2-52 cmcs_terminal_ctl_$find 000000 constant entry external dcl 2-54 cmcs_tree_ctl_$find_destination 000000 constant entry external dcl 2-56 cmcs_tree_ctl_$find_index 000000 constant entry external dcl 2-57 cmcs_tree_ctl_$find_qual_name 000000 constant entry external dcl 2-59 cmcs_tree_ctl_$find_tree_path 000000 constant entry external dcl 2-58 cmcs_wait_ctl_$add 000000 constant entry external dcl 2-61 cmcs_wait_ctl_$clear_mp 000000 constant entry external dcl 2-67 cmcs_wait_ctl_$delete 000000 constant entry external dcl 2-62 cmcs_wait_ctl_$find 000000 constant entry external dcl 2-63 cmcs_wait_ctl_$mp_available 000000 constant entry external dcl 2-64 cmcs_wait_ctl_$mp_login 000000 constant entry external dcl 2-65 cmcs_wait_ctl_$mp_logout 000000 constant entry external dcl 2-66 cmcs_wait_ctl_$start_mp 000000 constant entry external dcl 2-68 cmcs_wait_ctl_$stop_mp 000000 constant entry external dcl 2-69 comment based structure level 1 dcl 7-20 comment_value based char unaligned dcl 7-20 control_hdr_len internal static fixed bin(17,0) initial dcl 1-7 control_hdr_ptr automatic pointer dcl 1-9 get_group_id_ 000000 constant entry external dcl 156 get_process_id_ 000000 constant entry external dcl 156 hcs_$make_seg 000000 constant entry external dcl 156 hcs_$set_bc_seg 000000 constant entry external dcl 156 hcs_$truncate_seg 000000 constant entry external dcl 156 ioa_$ioa_switch 000000 constant entry external dcl 156 lex_error_ 000000 constant entry external dcl 156 max builtin function dcl 6-92 new_station_name automatic char(12) unaligned dcl 81 new_terminal_name automatic char(8) unaligned dcl 81 pntep automatic pointer dcl 124 reverse builtin function dcl 147 station_ctl based structure level 1 dcl 3-13 station_ctl_eindex automatic fixed bin(17,0) dcl 3-17 station_ctl_entry_len internal static fixed bin(17,0) initial dcl 3-7 station_ctl_eptr automatic pointer dcl 3-19 station_ctl_hdr_len internal static fixed bin(17,0) initial dcl 3-7 station_ctl_ptr internal static pointer dcl 3-11 station_ctl_version internal static fixed bin(17,0) initial dcl 3-7 stmt based structure level 1 dcl 7-40 stmt_value based char unaligned dcl 7-40 sys_info_$max_seg_size external static fixed bin(18,0) dcl 200 temp3 automatic char(3) unaligned dcl 81 tree_ctl_eindex automatic fixed bin(17,0) dcl 4-22 unique_chars_ 000000 constant entry external dcl 156 vfile_rs based structure level 1 dcl 5-13 vfile_rs_ptr automatic pointer dcl 5-11 vfile_rs_version internal static fixed bin(17,0) initial dcl 5-9 NAMES DECLARED BY EXPLICIT CONTEXT. ERROR 006155 constant entry internal dcl 10-139 ref 929 935 952 958 995 1001 1012 1018 1029 1035 1046 1052 1063 1069 1080 1086 LEX 006070 constant entry internal dcl 9-31 ref 942 948 965 971 975 980 985 990 1008 1025 1042 1059 1076 NEXT_STMT 006466 constant entry internal dcl 11-18 ref 931 954 997 1014 1031 1048 1065 1082 RD_ACTION 000565 constant label array(36) dcl 908 ref 905 RD_MATCH 005500 constant label dcl 901 ref 8-90 8-92 8-101 8-109 8-113 8-118 8-128 897 RD_MATCH_NO_TOKEN 005503 constant label dcl 902 ref 8-73 8-79 8-86 RD_NEXT_REDUCTION 005173 constant label dcl 8-55 ref 8-68 8-84 8-88 8-99 8-104 8-111 8-116 8-120 8-124 8-130 898 RD_TEST_REDUCTION 005174 constant label dcl 8-58 ref 8-53 910 914 918 922 927 933 938 944 950 956 961 967 973 978 983 988 993 999 1004 1010 1016 1021 1027 1033 1038 1044 1050 1055 1061 1067 1072 1078 1084 1089 RD_TEST_RESULT 005474 constant label dcl 897 ref 889 891 893 895 RD_TEST_TOKEN 000553 constant label array(6) dcl 8-73 ref 8-65 8-71 RD_TOKEN_FCN 000561 constant label array(4) dcl 888 ref 886 SEMANTIC_ANALYSIS 005163 constant entry internal dcl 6-30 ref 341 clean_up 003151 constant entry internal dcl 366 ref 247 360 close_db 003702 constant entry internal dcl 506 ref 924 close_tree 003733 constant entry internal dcl 517 ref 969 close_tree_level 003765 constant entry internal dcl 528 ref 522 963 close_tree_level_ret 004252 constant label dcl 595 ref 587 cv_cmcs_tree_ctl 001572 constant entry external dcl 79 init_tree 004253 constant entry internal dcl 602 ref 940 open_tree_level 004310 constant entry internal dcl 616 ref 608 1074 report_error 002143 constant label dcl 254 ref 274 set_command_line 004662 constant entry internal dcl 714 ref 1023 set_level_name 005120 constant entry internal dcl 775 ref 946 set_mp_line 004556 constant entry internal dcl 683 ref 1040 set_program_id 005002 constant entry internal dcl 745 ref 1057 set_queue_name 005050 constant entry internal dcl 760 ref 1006 test 003136 constant entry external dcl 786 valid_level 003244 constant entry internal dcl 420 ref 894 valid_level_name 003603 constant entry internal dcl 489 ref 888 valid_program_id 003405 constant entry internal dcl 455 ref 892 valid_queue_name 003504 constant entry internal dcl 472 ref 890 THERE WERE NO NAMES DECLARED BY CONTEXT OR IMPLICATION. STORAGE REQUIREMENTS FOR THIS PROGRAM. Object Text Link Symbol Defs Static Start 0 0 7462 7762 7151 7472 Length 10472 7151 300 473 310 212 BLOCK NAME STACK SIZE TYPE WHY NONQUICK/WHO SHARES STACK FRAME cv_cmcs_tree_ctl 1506 external procedure is an external procedure. on unit on line 247 64 on unit clean_up 70 internal procedure is called by several nonquick procedures. valid_level internal procedure shares stack frame of external procedure cv_cmcs_tree_ctl. valid_program_id internal procedure shares stack frame of external procedure cv_cmcs_tree_ctl. valid_queue_name internal procedure shares stack frame of external procedure cv_cmcs_tree_ctl. valid_level_name internal procedure shares stack frame of external procedure cv_cmcs_tree_ctl. close_db internal procedure shares stack frame of external procedure cv_cmcs_tree_ctl. close_tree internal procedure shares stack frame of external procedure cv_cmcs_tree_ctl. close_tree_level internal procedure shares stack frame of external procedure cv_cmcs_tree_ctl. init_tree internal procedure shares stack frame of external procedure cv_cmcs_tree_ctl. open_tree_level internal procedure shares stack frame of external procedure cv_cmcs_tree_ctl. set_mp_line internal procedure shares stack frame of external procedure cv_cmcs_tree_ctl. set_command_line internal procedure shares stack frame of external procedure cv_cmcs_tree_ctl. set_program_id internal procedure shares stack frame of external procedure cv_cmcs_tree_ctl. set_queue_name internal procedure shares stack frame of external procedure cv_cmcs_tree_ctl. set_level_name internal procedure shares stack frame of external procedure cv_cmcs_tree_ctl. SEMANTIC_ANALYSIS internal procedure shares stack frame of external procedure cv_cmcs_tree_ctl. LEX internal procedure shares stack frame of external procedure cv_cmcs_tree_ctl. ERROR internal procedure shares stack frame of external procedure cv_cmcs_tree_ctl. NEXT_STMT internal procedure shares stack frame of external procedure cv_cmcs_tree_ctl. STORAGE FOR INTERNAL STATIC VARIABLES. LOC IDENTIFIER BLOCK NAME 000010 tree_ctl_ptr cv_cmcs_tree_ctl 000012 BREAKS cv_cmcs_tree_ctl 000053 IGBREAKS cv_cmcs_tree_ctl 000114 LEXCTL cv_cmcs_tree_ctl 000155 LEXDLM cv_cmcs_tree_ctl 000216 test_sw cv_cmcs_tree_ctl 000217 first_time cv_cmcs_tree_ctl 000220 TRACING cv_cmcs_tree_ctl STORAGE FOR AUTOMATIC VARIABLES. STACK FRAME LOC IDENTIFIER BLOCK NAME cv_cmcs_tree_ctl 000100 j cv_cmcs_tree_ctl 000102 aclinfo_ptr cv_cmcs_tree_ctl 000104 queue_name cv_cmcs_tree_ctl 000114 tree_ctl_eptr cv_cmcs_tree_ctl 000116 vfile_descr cv_cmcs_tree_ctl 000117 current_level cv_cmcs_tree_ctl 000120 previous_level cv_cmcs_tree_ctl 000121 queue_level cv_cmcs_tree_ctl 000122 levels cv_cmcs_tree_ctl 001032 APstmt cv_cmcs_tree_ctl 001034 APtoken cv_cmcs_tree_ctl 001036 area_ptr cv_cmcs_tree_ctl 001040 arg_length cv_cmcs_tree_ctl 001042 arg_ptr cv_cmcs_tree_ctl 001044 bitcount cv_cmcs_tree_ctl 001045 code cv_cmcs_tree_ctl 001046 dname cv_cmcs_tree_ctl 001120 ename cv_cmcs_tree_ctl 001130 i cv_cmcs_tree_ctl 001131 n_chars cv_cmcs_tree_ctl 001132 object_name cv_cmcs_tree_ctl 001142 object_ptr cv_cmcs_tree_ctl 001144 source_ptr cv_cmcs_tree_ctl 001154 Pthis_token cv_cmcs_tree_ctl 001156 Pstmt cv_cmcs_tree_ctl 001160 Ptoken cv_cmcs_tree_ctl 001162 SPDL cv_cmcs_tree_ctl 001163 MERROR_SEVERITY cv_cmcs_tree_ctl 001164 SERROR_CONTROL cv_cmcs_tree_ctl 001165 SERROR_PRINTED cv_cmcs_tree_ctl 001165 MIN_PRINT_SEVERITY cv_cmcs_tree_ctl 001166 PRINT_SEVERITY_CONTROL cv_cmcs_tree_ctl 001340 LTOKEN_REQD_VALUE SEMANTIC_ANALYSIS 001341 NRED SEMANTIC_ANALYSIS 001342 PRED SEMANTIC_ANALYSIS 001344 PTOKEN_REQD SEMANTIC_ANALYSIS 001346 PTOKEN_REQD_VALUE SEMANTIC_ANALYSIS 001350 STOKEN_FCN SEMANTIC_ANALYSIS 001351 CODE SEMANTIC_ANALYSIS 001352 I SEMANTIC_ANALYSIS 001353 NUMBER SEMANTIC_ANALYSIS 001354 DIRECTION SEMANTIC_ANALYSIS 001406 i LEX 001420 Pstmt ERROR 001422 Perring_token ERROR 001432 Ssearching NEXT_STMT THE FOLLOWING EXTERNAL OPERATORS ARE USED BY THIS PROGRAM. alloc_cs unpk_to_pk cat_realloc_cs call_ext_out_desc call_ext_out call_int_this call_int_other return alloc_auto_adj mpfx2 enable shorten_stack ext_entry int_entry set_cs_eis index_cs_eis THE FOLLOWING EXTERNAL ENTRIES ARE CALLED BY THIS PROGRAM. cmcs_fillin_hdr_ com_err_ cu_$arg_ptr cv_dec_check_ cv_dec_check_ expand_pathname_ get_wdir_ hcs_$delentry_seg hcs_$initiate_count hcs_$terminate_noname ioa_ lex_error_ lex_string_$init_lex_delims lex_string_$lex translator_temp_$get_segment translator_temp_$release_all_segments tssi_$clean_up_segment tssi_$finish_segment tssi_$get_segment THE FOLLOWING EXTERNAL VARIABLES ARE USED BY THIS PROGRAM. error_table_$bad_name error_table_$badopt error_table_$entlong error_table_$translation_failed LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC LINE LOC 1102 001533 10 3 001534 10 168 001565 79 001571 208 001600 210 001617 213 001621 214 001645 218 001646 220 001676 223 001700 224 001732 228 001733 230 001752 233 001773 236 002010 237 002042 240 002043 242 002045 243 002047 244 002050 245 002051 247 002052 249 002074 251 002137 254 002143 257 002176 261 002177 263 002207 265 002211 266 002235 270 002236 273 002241 274 002244 278 002245 280 002262 282 002267 284 002301 286 002331 289 002333 290 002366 296 002367 298 002372 300 002410 302 002441 306 002444 309 002446 310 002470 312 002476 315 002557 319 002562 321 002602 324 002606 325 002632 328 002633 331 002747 334 002751 335 002772 339 002773 341 002775 343 002776 346 003001 347 003022 349 003033 352 003034 354 003046 356 003066 360 003130 362 003134 786 003135 788 003144 789 003147 366 003150 369 003156 372 003173 375 003211 378 003227 381 003243 420 003244 422 003246 425 003275 427 003325 429 003332 431 003342 434 003344 435 003353 437 003361 440 003362 441 003367 443 003374 447 003375 448 003377 449 003401 455 003405 457 003407 460 003436 462 003445 464 003464 466 003500 472 003504 474 003506 477 003535 479 003544 481 003563 483 003577 489 003603 491 003605 494 003634 496 003643 498 003662 500 003676 506 003702 508 003703 511 003732 517 003733 519 003734 522 003763 524 003764 528 003765 530 003766 533 004015 534 004022 535 004027 537 004041 538 004043 539 004051 540 004056 541 004063 543 004070 545 004102 546 004104 547 004106 551 004112 558 004121 560 004124 561 004130 562 004132 564 004136 566 004143 568 004157 570 004161 572 004171 573 004175 575 004203 577 004205 580 004211 582 004223 585 004234 587 004240 589 004241 591 004243 595 004252 602 004253 604 004254 607 004303 608 004306 610 004307 616 004310 618 004311 621 004340 622 004346 624 004353 627 004356 629 004361 635 004411 640 004415 643 004416 645 004425 647 004427 649 004431 652 004441 654 004446 656 004450 658 004453 659 004470 660 004476 661 004503 662 004504 663 004506 664 004513 665 004515 666 004522 667 004524 669 004531 672 004553 673 004554 677 004555 683 004556 685 004557 688 004606 691 004612 692 004617 694 004624 697 004642 701 004643 702 004650 706 004655 708 004661 714 004662 716 004663 719 004712 722 004716 723 004723 725 004730 728 004746 731 004747 732 004754 735 004761 737 004765 739 005001 745 005002 747 005003 750 005032 751 005040 753 005045 754 005047 760 005050 762 005051 765 005100 766 005112 767 005115 769 005117 775 005120 777 005121 780 005150 782 005162 6 30 005163 798 005164 8 50 005166 8 52 005171 8 53 005172 8 55 005173 8 58 005174 8 60 005177 8 62 005201 8 63 005224 8 64 005227 8 65 005233 8 68 005243 8 70 005244 8 71 005250 8 73 005252 8 79 005271 8 84 005302 8 86 005303 8 88 005307 8 90 005310 8 92 005311 8 99 005345 8 101 005346 8 104 005351 8 106 005354 8 107 005400 8 108 005402 8 109 005405 8 111 005406 8 113 005407 8 116 005423 8 118 005424 8 120 005430 8 123 005431 8 124 005432 8 126 005436 8 127 005443 8 128 005447 8 130 005455 886 005456 888 005460 889 005462 890 005463 891 005465 892 005466 893 005470 894 005471 895 005473 897 005474 898 005477 901 005500 902 005503 904 005506 905 005510 908 005512 910 005514 912 005515 914 005517 916 005520 918 005522 920 005523 922 005525 924 005526 926 005527 927 005531 929 005532 931 005536 932 005537 933 005541 935 005542 937 005546 938 005550 940 005551 942 005552 943 005556 944 005560 946 005561 948 005562 949 005566 950 005570 952 005571 954 005575 955 005576 956 005600 958 005601 960 005605 961 005607 963 005610 965 005611 966 005615 967 005617 969 005620 971 005621 972 005625 973 005627 975 005630 977 005634 978 005636 980 005637 982 005643 983 005645 985 005646 987 005652 988 005654 990 005655 992 005661 993 005663 995 005664 997 005670 998 005671 999 005673 1001 005674 1003 005700 1004 005702 1006 005703 1008 005704 1009 005710 1010 005712 1012 005713 1014 005717 1015 005720 1016 005722 1018 005723 1020 005727 1021 005731 1023 005732 1025 005733 1026 005737 1027 005741 1029 005742 1031 005746 1032 005747 1033 005751 1035 005752 1037 005756 1038 005760 1040 005761 1042 005762 1043 005766 1044 005770 1046 005771 1048 005775 1049 005776 1050 006000 1052 006001 1054 006005 1055 006007 1057 006010 1059 006011 1060 006015 1061 006017 1063 006020 1065 006024 1066 006025 1067 006027 1069 006030 1071 006034 1072 006036 1074 006037 1076 006040 1077 006044 1078 006046 1080 006047 1082 006053 1083 006054 1084 006056 1086 006057 1088 006063 1089 006065 1091 006066 1094 006067 9 31 006070 9 36 006072 9 37 006074 9 38 006101 9 39 006103 9 40 006115 9 41 006117 9 42 006121 9 44 006131 9 45 006132 9 47 006145 9 48 006147 9 49 006152 9 51 006154 10 139 006155 10 153 006157 10 154 006167 10 156 006176 10 158 006205 10 160 006206 10 161 006210 10 164 006223 10 166 006227 10 168 006231 10 172 006335 10 177 006464 11 18 006466 11 24 006467 11 25 006471 11 26 006474 11 27 006476 11 28 006504 11 29 006506 11 30 006513 11 31 006514 11 32 006515 11 35 006526 11 36 006532 11 39 006533 ----------------------------------------------------------- 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