|
Open64 (mfef90, whirl2f, and IR tools)
TAG: version-openad; SVN changeset: 916
|
|
Open64 (mfef90, whirl2f, and IR tools)
TAG: version-openad; SVN changeset: 916
|
00001 /* 00002 00003 Copyright (C) 2000, 2001 Silicon Graphics, Inc. All Rights Reserved. 00004 00005 This program is free software; you can redistribute it and/or modify it 00006 under the terms of version 2 of the GNU General Public License as 00007 published by the Free Software Foundation. 00008 00009 This program is distributed in the hope that it would be useful, but 00010 WITHOUT ANY WARRANTY; without even the implied warranty of 00011 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 00012 00013 Further, this software is distributed without any warranty that it is 00014 free of the rightful claim of any third person regarding infringement 00015 or the like. Any license provided herein, whether implied or 00016 otherwise, applies only to this software file. Patent licenses, if 00017 any, provided herein do not apply to combinations of this program with 00018 other software, or any other product whatsoever. 00019 00020 You should have received a copy of the GNU General Public License along 00021 with this program; if not, write the Free Software Foundation, Inc., 59 00022 Temple Place - Suite 330, Boston MA 02111-1307, USA. 00023 00024 Contact information: Silicon Graphics, Inc., 1600 Amphitheatre Pky, 00025 Mountain View, CA 94043, or: 00026 00027 http://www.sgi.com 00028 00029 For further information regarding this notice, see: 00030 00031 http://oss.sgi.com/projects/GenInfo/NoticeExplan 00032 00033 */ 00034 00035 00036 00037 static char USMID[] = "\n@(#)5.0_pl/sources/src_input.c 5.5 10/20/99 17:17:46\n"; 00038 00039 # include "defines.h" /* Machine dependent ifdefs */ 00040 00041 # include "host.m" /* Host machine dependent macros.*/ 00042 # include "host.h" /* Host machine dependent header.*/ 00043 # include "target.m" /* Target machine dependent macros.*/ 00044 # include "target.h" /* Target machine dependent header.*/ 00045 00046 # include "globals.m" 00047 # include "tokens.m" 00048 # include "sytb.m" 00049 # include "p_globals.m" 00050 # include "src_input.m" 00051 # include "debug.m" 00052 00053 # include "globals.h" 00054 # include "tokens.h" 00055 # include "sytb.h" 00056 # include "p_globals.h" 00057 # include "src_input.h" 00058 00059 00060 /*****************************************************************\ 00061 |* function prototypes of static functions declared in this file *| 00062 \*****************************************************************/ 00063 00064 static boolean is_pound_line_dir(void); 00065 static void fixed_classify_line (void); 00066 static void fixed_get_stmt (void); 00067 boolean read_line (boolean); 00068 static void free_classify_line (void); 00069 static void free_get_stmt (void); 00070 void ntr_next_msg_queue(int,int,msg_severities_type, 00071 int,char *, long,int); 00072 static void move_up_next_msg_queue(void); 00073 static boolean open_include_file (boolean); 00074 static void update_global_line (void); 00075 static int whats_after_paren_group(int *, int *, int); 00076 static int whats_after_brkt_group(int *, int *, int); 00077 static void print_nxt_line(void); 00078 static void classify_line(void); 00079 static boolean get_nxt_line(void); 00080 static void pp_get_stmt (void); 00081 static void shift_to_line_size(int); 00082 00083 static boolean issue_classify_msg = TRUE; 00084 00085 # ifdef _DEBUG 00086 00087 static void print_stmt (void); 00088 static void print_src (void); 00089 00090 00091 00092 /******************************************************************************\ 00093 |* *| 00094 |* Description: *| 00095 |* Print_stmt prints the source input to stderr. *| 00096 |* *| 00097 |* Input parameters: *| 00098 |* NONE *| 00099 |* *| 00100 |* Output parameters: *| 00101 |* NONE *| 00102 |* *| 00103 |* Returns: *| 00104 |* NOTHING *| 00105 |* *| 00106 |* Note: This routine has been superceded by the print routine in miflib *| 00107 |* called CIF_postprocessor (for debugging the front-end, we still *| 00108 |* use print_buffered_messages). print_stmt has been left here in *| 00109 |* case we need to go back to this method for any reason. It only *| 00110 |* exists in debug compilers anyway. *| 00111 |* *| 00112 \******************************************************************************/ 00113 00114 static void print_stmt() 00115 00116 { 00117 int idx; 00118 int line; 00119 int ich2; 00120 00121 00122 for (line = 1; line <= lines_in_buf; line++) { 00123 00124 for (idx = 0; 00125 (((ich2 = stmt_buf[idx + stmt_line_start_idx[line]]) != newline) 00126 && (ich2 != eos)); 00127 idx++) { 00128 fprintf(stderr, "%c", ich2); 00129 } 00130 fprintf(stderr, "\n"); 00131 } 00132 00133 return; 00134 00135 } /* print_stmt */ 00136 00137 00138 00139 /******************************************************************************\ 00140 |* *| 00141 |* Description: *| 00142 |* Print_src is an expanded version of print_stmt that dumps the source *| 00143 |* input. This prints the source form and marks character constants. *| 00144 |* *| 00145 |* Input parameters: *| 00146 |* NONE *| 00147 |* *| 00148 |* Output parameters: *| 00149 |* NONE *| 00150 |* *| 00151 |* Returns: *| 00152 |* NOTHING *| 00153 |* *| 00154 \******************************************************************************/ 00155 static void print_src() 00156 { 00157 int idx; 00158 int line; 00159 00160 if (source_form == Fixed_Form) { 00161 fprintf(stderr, "Fixed_Form\n"); 00162 } 00163 else { 00164 fprintf(stderr, "Free_Form\n"); 00165 } 00166 00167 for (line = 1; line <= lines_in_buf; line++) { 00168 00169 fprintf(stderr, "global line num = %d\n", stmt_line_num[line]); 00170 for (idx = stmt_line_start_idx[line]; idx < stmt_line_end_idx[line]; 00171 idx++) { 00172 00173 if (stmt_buf[idx] < 0) { 00174 fprintf(stderr, "^%c", stmt_buf[idx]); 00175 } 00176 else { 00177 fprintf(stderr, "%c", stmt_buf[idx]); 00178 } 00179 } 00180 fprintf(stderr, "\n"); 00181 } 00182 fprintf(stderr, "*******************************************************\n"); 00183 00184 return; 00185 00186 } /* print_src */ 00187 00188 # endif 00189 00190 00191 /******************************************************************************\ 00192 |* *| 00193 |* Description: *| 00194 |* Init_src is called by compiler initialization in main to open the *| 00195 |* source input file and initialize the data structures used by this *| 00196 |* module. *| 00197 |* *| 00198 |* Input parameters: *| 00199 |* NONE *| 00200 |* *| 00201 |* Output parameters: *| 00202 |* NONE *| 00203 |* *| 00204 |* Returns: *| 00205 |* NOTHING *| 00206 |* *| 00207 \******************************************************************************/ 00208 00209 void init_src_input (void) 00210 00211 { 00212 TRACE (Func_Entry, "init_src_input", NULL); 00213 00214 dot_i_fptr = stdout; /* default is stdout */ 00215 00216 if (on_off_flags.save_dot_i) { 00217 dot_i_fptr = fopen(dot_i_file, "w"); 00218 } 00219 00220 previous_global_line = 0; 00221 00222 /* allocate memory for src_stk and set src_stk_idx to 1 */ 00223 00224 CHECK_INITIAL_ALLOC(src_stk, 1); 00225 00226 /* This field will get updated by update_global_line. */ 00227 00228 SRC_STK_GLOBAL_LINE_IDX(src_stk_idx) = NULL_IDX; 00229 SRC_STK_PREV_SRC_FORM(src_stk_idx) = source_form; /* Init to current */ 00230 00231 /* initialize base entry in src_stk with source file info */ 00232 00233 if (src_file[0] == EOS) { /* src file is stdin */ 00234 SRC_STK_FILE_LINE(SRC_STK_BASE_IDX) = 0; 00235 SRC_STK_FILE_TYPE(SRC_STK_BASE_IDX) = Stdin_Src; 00236 SRC_STK_FILE_PTR(SRC_STK_BASE_IDX) = stdin; 00237 strcpy (src_file, "'stdin'"); /* use 'stdin' as name*/ 00238 } 00239 else { 00240 SRC_STK_FILE_LINE(SRC_STK_BASE_IDX) = 0; 00241 SRC_STK_FILE_TYPE(SRC_STK_BASE_IDX) = Input_Src; 00242 00243 SRC_STK_FILE_PTR(SRC_STK_BASE_IDX) = fopen (src_file, "r"); 00244 00245 if (SRC_STK_FILE_PTR(SRC_STK_BASE_IDX) == NULL) { 00246 PRINTMSG (0, 49, Log_Error, 0, src_file); /* Can't open src file*/ 00247 exit_compiler (RC_USER_ERROR); 00248 } 00249 } 00250 00251 if (on_off_flags.output_pound_lines && 00252 (on_off_flags.preprocess_only || on_off_flags.save_dot_i)) { 00253 fprintf(dot_i_fptr, "# 1 \"%s\"\n", src_file); 00254 } 00255 00256 /* Make relative path for source file absolute. */ 00257 00258 if (src_file[0] != SLASH) 00259 { 00260 getcwd (SRC_STK_PATH_NAME(SRC_STK_BASE_IDX), MAX_FILE_NAME_SIZE); 00261 /* Mac getcwd supplies separator */ 00262 strcat (SRC_STK_PATH_NAME(SRC_STK_BASE_IDX), "/"); 00263 SRC_STK_FILE_IDX(SRC_STK_BASE_IDX) = 00264 strlen(SRC_STK_PATH_NAME(SRC_STK_BASE_IDX)); 00265 strcat (SRC_STK_PATH_NAME(SRC_STK_BASE_IDX), src_file); 00266 } 00267 else { 00268 SRC_STK_FILE_IDX(SRC_STK_BASE_IDX) = 0; 00269 strcpy (SRC_STK_PATH_NAME(SRC_STK_BASE_IDX), src_file); 00270 } 00271 00272 /* Initialize base entry of global_line_tbl with first line of source file.*/ 00273 00274 update_global_line(); 00275 00276 /* Set the line numbers in this entry correctly. */ 00277 /* Always set GL_CIF_FILE_ID; it's needed for buffered message output. */ 00278 00279 GL_GLOBAL_LINE(global_line_tbl_idx) = 1; 00280 GL_FILE_LINE(global_line_tbl_idx) = 1; 00281 00282 /* Initialize idx to start of next stmt, after ; */ 00283 00284 starting_pt = NULL_IDX; 00285 00286 /* Flag controls Ansi msg for line over 72 chars so it is issued once. */ 00287 00288 have_issued_msg_37 = FALSE; 00289 00290 havent_issued_tab_ansi = TRUE; 00291 havent_issued_at_ansi = TRUE; 00292 havent_issued_dollar_ansi = TRUE; 00293 00294 nxt_line_start_idx[0] = 0; 00295 nxt_line_end_idx[0] = 0; 00296 nxt_line_col[0] = 0; 00297 nxt_line_num_lines = 1; 00298 pp_line_idx = 1; 00299 00300 pp_nxt_line_type[0] = Regular_Line; 00301 00302 /* Manufacture dummy 0th line of fixed source file in nxt_line buffer. */ 00303 00304 nxt_line_start_idx[1] = 1; 00305 nxt_line_end_idx[1] = 2; 00306 nxt_line[0] = blank; 00307 nxt_line[1] = newline; 00308 nxt_line[2] = eos; 00309 nxt_line_idx = 1; 00310 nxt_line_num = 0; 00311 nxt_line_type = Comment_Line; 00312 PP_LINE_TYPE = Comment_Line; 00313 PP_EOL = 1; 00314 00315 if (source_form == Fixed_Form) { 00316 /* set source line size from command line */ 00317 if (cmd_line_flags.line_size_80) { 00318 line_size = FIXED_SRC_LINE_SIZE_80; 00319 } 00320 else if (cmd_line_flags.line_size_132) { 00321 line_size = FIXED_SRC_LINE_SIZE_132; 00322 } 00323 else { 00324 line_size = FIXED_SRC_LINE_SIZE_72; 00325 } 00326 00327 if (! on_off_flags.preprocess_only) { 00328 fixed_get_stmt (); 00329 } 00330 } 00331 else { 00332 /* set source line size to standard free form length */ 00333 line_size = FREE_SRC_LINE_SIZE; 00334 if (! on_off_flags.preprocess_only) { 00335 expected_line = Regular_Line; 00336 free_get_stmt (); 00337 } 00338 } 00339 00340 if (change_orig_src_file) { 00341 /* reset the file name in the src stk and update global line again. */ 00342 00343 if (pound_file[0] != SLASH) { 00344 getcwd (SRC_STK_PATH_NAME(SRC_STK_BASE_IDX), MAX_FILE_NAME_SIZE); 00345 strcat (SRC_STK_PATH_NAME(SRC_STK_BASE_IDX), "/"); 00346 SRC_STK_FILE_IDX(SRC_STK_BASE_IDX) = 00347 strlen(SRC_STK_PATH_NAME(SRC_STK_BASE_IDX)); 00348 strcat (SRC_STK_PATH_NAME(SRC_STK_BASE_IDX), pound_file); 00349 } 00350 else { 00351 SRC_STK_FILE_IDX(SRC_STK_BASE_IDX) = 0; 00352 strcpy (SRC_STK_PATH_NAME(SRC_STK_BASE_IDX), pound_file); 00353 } 00354 00355 /* If CIF records have been requested, output the Source File record. */ 00356 /* Always output a File Name record for the source file. */ 00357 00358 c_i_f = cif_actual_file; 00359 SRC_STK_CIF_FILE_ID(SRC_STK_BASE_IDX) = 00360 cif_file_name_rec(SRC_STK_PATH_NAME(SRC_STK_BASE_IDX), pound_file); 00361 00362 if (cif_flags) { 00363 cif_source_file_rec(SRC_STK_CIF_FILE_ID(SRC_STK_BASE_IDX), 00364 cmd_line_flags.src_form); 00365 } 00366 00367 c_i_f = cif_tmp_file; 00368 00369 cif_file_rec_issued = TRUE; 00370 00371 global_line_tbl_idx = 0; 00372 SRC_STK_FILE_LINE(SRC_STK_BASE_IDX) = 0; 00373 SRC_STK_GLOBAL_LINE_IDX(src_stk_idx) = NULL_IDX; 00374 update_global_line(); 00375 00376 /* Set the line numbers in this entry correctly. */ 00377 /* Always set GL_CIF_FILE_ID; it's needed for buffered message output. */ 00378 00379 GL_CIF_FILE_ID(global_line_tbl_idx) = 00380 SRC_STK_CIF_FILE_ID(SRC_STK_BASE_IDX); 00381 GL_GLOBAL_LINE(global_line_tbl_idx) = 1; 00382 GL_FILE_LINE(global_line_tbl_idx) = 1; 00383 00384 if (source_form == Fixed_Form) { 00385 if (! on_off_flags.preprocess_only) { 00386 fixed_get_stmt (); 00387 } 00388 } 00389 else { 00390 if (! on_off_flags.preprocess_only) { 00391 expected_line = Regular_Line; 00392 free_get_stmt (); 00393 } 00394 } 00395 } 00396 else if (! cif_file_rec_issued ) { 00397 /* If CIF records have been requested, output the Source File record. */ 00398 /* Always output a File Name record for the source file. */ 00399 00400 c_i_f = cif_actual_file; 00401 SRC_STK_CIF_FILE_ID(SRC_STK_BASE_IDX) = 00402 cif_file_name_rec(SRC_STK_PATH_NAME(SRC_STK_BASE_IDX), src_file); 00403 00404 if (cif_flags) { 00405 cif_source_file_rec(SRC_STK_CIF_FILE_ID(SRC_STK_BASE_IDX), 00406 cmd_line_flags.src_form); 00407 } 00408 00409 c_i_f = cif_tmp_file; 00410 cif_file_rec_issued = TRUE; 00411 00412 /* Set the line numbers in this entry correctly. */ 00413 /* Always set GL_CIF_FILE_ID; it's needed for buffered message output. */ 00414 00415 GL_CIF_FILE_ID(global_line_tbl_idx) = 00416 SRC_STK_CIF_FILE_ID(SRC_STK_BASE_IDX); 00417 } 00418 00419 TRACE (Func_Exit, "init_src_input", SRC_STK_FILE_NAME(SRC_STK_BASE_IDX)); 00420 00421 return; 00422 00423 } /* init_src_input */ 00424 00425 /******************************************************************************\ 00426 |* *| 00427 |* Description: *| 00428 |* Reset_src_input is called by lex routines to back up the src input *| 00429 |* character stream when splitting tokens or when a reparse of the input *| 00430 |* is requested by the parser. *| 00431 |* *| 00432 |* Reset can only occur within the range of a single statement. *| 00433 |* *| 00434 |* Input parameters: *| 00435 |* buf_idx stmt_buf_idx will be reset to this. *| 00436 |* stmt_num compared to statement_number to ensure that *| 00437 |* we are resetting within the same statement. *| 00438 |* *| 00439 |* Output parameters: *| 00440 |* NONE *| 00441 |* *| 00442 |* Returns: *| 00443 |* NOTHING *| 00444 |* *| 00445 \******************************************************************************/ 00446 00447 void reset_src_input (int buf_idx, 00448 int stmt_num) 00449 00450 { 00451 char ch; 00452 int i; 00453 00454 TRACE (Func_Entry, "reset_src_input", NULL); 00455 00456 /* These checks can be placed under _DEBUG later. For */ 00457 /* now, however, I want them executed in both compilers */ 00458 00459 /* Attempt to set src to line not in buffer */ 00460 00461 if (stmt_num != statement_number && !in_action_stmt_of_if_where_or_forall) { 00462 PRINTMSG (stmt_line_num[stmt_line_idx], 207, Internal, 1); 00463 } 00464 00465 if (buf_idx < 0) { 00466 PRINTMSG (stmt_line_num[stmt_line_idx], 626, Internal, 1, 00467 "valid buf_idx", 00468 "reset_src_input"); 00469 } 00470 00471 stmt_line_idx = 0; 00472 00473 if (buf_idx == 0) { 00474 stmt_line_idx = 1; 00475 } 00476 else { 00477 for (i = 1; i <= lines_in_buf; i++) { 00478 if (buf_idx >= stmt_line_start_idx[i] && 00479 buf_idx <= stmt_line_end_idx[i]) { 00480 stmt_line_idx = i; 00481 break; 00482 } 00483 } 00484 } 00485 00486 # ifdef _DEBUG 00487 if (stmt_line_idx == 0) { 00488 PRINTMSG(1,626,Internal,1, 00489 "valid stmt_line_idx", 00490 "reset_src_input"); 00491 } 00492 # endif 00493 00494 stmt_buf_idx = buf_idx; 00495 00496 if (stmt_buf_idx == 0 || 00497 stmt_buf[stmt_buf_idx] == '\0' || 00498 stmt_buf[stmt_buf_idx] == '\n') { 00499 ch = ' '; 00500 } 00501 else { 00502 ch = stmt_buf[stmt_buf_idx]; 00503 } 00504 00505 if (islower(ch)) { /* lowercase char */ 00506 ch = TOUPPER(ch); /* cnvrt lwr to upr */ 00507 } 00508 00509 LA_CH_VALUE = ch; 00510 LA_CH_LINE = stmt_line_num[stmt_line_idx]; 00511 LA_CH_COLUMN = stmt_buf_col[stmt_buf_idx]; 00512 LA_CH_BUF_IDX = stmt_buf_idx; 00513 LA_CH_STMT_NUM = statement_number; 00514 LA_CH_CLASS = (ch == (char) EOF) ? Ch_Class_EOF : ch_class[LA_CH_VALUE]; 00515 00516 TRACE (Func_Exit, "reset_src_input", NULL); 00517 00518 return; 00519 00520 } /* reset_src_input */ 00521 00522 /******************************************************************************\ 00523 |* *| 00524 |* Description: *| 00525 |* Fixed_get_char is called to obtain the next non-space character from *| 00526 |* the source line buffer when outside a character literal context. *| 00527 |* *| 00528 |* Lowercase letters are converted to uppercase. End of statement *| 00529 |* causes an EOS to be returned. *| 00530 |* *| 00531 |* Input parameters: *| 00532 |* NONE *| 00533 |* *| 00534 |* Output parameters: *| 00535 |* la_ch next look ahead character from source line *| 00536 |* *| 00537 |* Returns: *| 00538 |* NOTHING *| 00539 |* *| 00540 \******************************************************************************/ 00541 00542 void fixed_get_char (void) 00543 00544 { 00545 char ch; 00546 int ich; 00547 00548 00549 TRACE (Func_Entry, "fixed_get_char", NULL); 00550 00551 /* if previous la_ch was end of stmt, then get next stmt */ 00552 00553 if (LA_CH_VALUE == EOS) { 00554 stmt_end_line = LA_CH_LINE; 00555 stmt_end_col = LA_CH_COLUMN - 1; 00556 00557 if (change_source_form) { 00558 change_source_form = FALSE; 00559 line_size = FREE_SRC_LINE_SIZE; 00560 expected_line = Regular_Line; 00561 get_char = free_get_char; 00562 get_char_literal = free_get_char_literal; 00563 source_form = Free_Form; 00564 00565 free_get_char (); 00566 00567 TRACE (Func_Exit, "fixed_get_char", 00568 ch_str[(unsigned char)LA_CH_VALUE]); 00569 00570 return; 00571 } 00572 00573 fixed_get_stmt (); /* get next src line */ 00574 00575 /* the only time that stmt_buf_type is comment is EOF of include file */ 00576 while (stmt_buf_type == Comment_Line) { 00577 if (change_source_form) { 00578 change_source_form = FALSE; 00579 line_size = FREE_SRC_LINE_SIZE; 00580 expected_line = Regular_Line; 00581 get_char = free_get_char; 00582 get_char_literal = free_get_char_literal; 00583 source_form = Free_Form; 00584 00585 free_get_char (); 00586 00587 TRACE (Func_Exit, "fixed_get_char", 00588 ch_str[(unsigned char)LA_CH_VALUE]); 00589 00590 return; 00591 } 00592 else { 00593 fixed_get_stmt (); 00594 } 00595 } 00596 00597 00598 ich = stmt_buf[stmt_buf_idx + 1]; 00599 00600 while (((ich == newline) | 00601 (ich == semi_colon) | 00602 (ich == bang)) && 00603 (stmt_line_idx >= lines_in_buf)) { 00604 00605 fixed_get_stmt (); 00606 00607 while (stmt_buf_type == Comment_Line) { 00608 if (change_source_form) { 00609 change_source_form = FALSE; 00610 line_size = FREE_SRC_LINE_SIZE; 00611 expected_line = Regular_Line; 00612 get_char = free_get_char; 00613 get_char_literal = free_get_char_literal; 00614 source_form = Free_Form; 00615 00616 free_get_char (); 00617 00618 TRACE (Func_Exit, "fixed_get_char", 00619 ch_str[(unsigned char)LA_CH_VALUE]); 00620 00621 return; 00622 } 00623 else { 00624 fixed_get_stmt (); 00625 } 00626 } 00627 00628 ich = stmt_buf[stmt_buf_idx + 1]; 00629 } 00630 00631 if (stmt_buf_type == Dir_Line) { /* directive line */ 00632 ch = stmt_buf[stmt_buf_idx]; /* next src character */ 00633 00634 if (islower(ch)) { 00635 ch = TOUPPER(ch); 00636 } 00637 00638 LA_CH_VALUE = ch; 00639 LA_CH_LINE = stmt_line_num[stmt_line_idx]; /* global line num */ 00640 LA_CH_COLUMN = stmt_buf_col[stmt_buf_idx]; 00641 LA_CH_BUF_IDX = stmt_buf_idx; 00642 LA_CH_STMT_NUM = statement_number; 00643 00644 switch (stmt_prefix_len) { 00645 case 1 : 00646 LA_CH_CLASS = Ch_Class_Dir1; /* directive class */ 00647 break; 00648 case 2 : 00649 LA_CH_CLASS = Ch_Class_Dir2; /* directive class */ 00650 break; 00651 case 3 : 00652 LA_CH_CLASS = Ch_Class_Dir3; /* directive class */ 00653 break; 00654 case 4 : 00655 LA_CH_CLASS = Ch_Class_Dir4; /* directive class */ 00656 break; 00657 case 7 : 00658 /* eraxxon: OpenAD directive */ 00659 LA_CH_CLASS = Ch_Class_Dir7; /* directive class */ 00660 break; 00661 } 00662 00663 TRACE (Func_Exit, "fixed_get_char", 00664 ch_str[(unsigned char) LA_CH_VALUE]); 00665 00666 return; 00667 } 00668 } 00669 00670 /* find next significant char if there is one */ 00671 00672 do { 00673 ich = stmt_buf[++stmt_buf_idx]; /* next src character */ 00674 00675 if (stmt_buf_idx == stmt_buf_EOS_idx) { 00676 ich = eos; 00677 } 00678 else if (stmt_buf_idx == stmt_line_end_idx[stmt_line_idx]) { 00679 00680 if (stmt_line_idx < lines_in_buf) { /* stmt continues */ 00681 ++stmt_line_idx; 00682 stmt_buf_idx = stmt_line_start_idx[stmt_line_idx] 00683 + stmt_line_offset[stmt_line_idx]; 00684 00685 ich = blank; /* loop again */ 00686 } 00687 else { /* end of statement */ 00688 ich = eos; /* cnvrt \n,'!' to EOS*/ 00689 } 00690 } 00691 } 00692 while ((ich == blank) | (ich == tab)); /* skip white space */ 00693 00694 LA_CH_LINE = stmt_line_num[stmt_line_idx]; /* global line num */ 00695 LA_CH_COLUMN = stmt_buf_col[stmt_buf_idx]; 00696 LA_CH_BUF_IDX = stmt_buf_idx; 00697 LA_CH_STMT_NUM = statement_number; 00698 00699 00700 if (havent_issued_at_ansi && ich == at_sign) { 00701 havent_issued_at_ansi = FALSE; 00702 ntr_msg_queue(LA_CH_LINE, 900, Ansi, 00703 LA_CH_COLUMN, 00704 (char *)NULL, 00705 0, 00706 NO_ARG); 00707 } 00708 00709 if (havent_issued_dollar_ansi && ich == dollar) { 00710 havent_issued_dollar_ansi = FALSE; 00711 ntr_msg_queue(LA_CH_LINE, 901, Ansi, 00712 LA_CH_COLUMN, 00713 (char *)NULL, 00714 0, 00715 NO_ARG); 00716 } 00717 00718 ch = ich; 00719 00720 if (islower(ch)) { /* lowercase char */ 00721 ch = TOUPPER(ch); /* cnvrt lwr to upr */ 00722 } 00723 00724 LA_CH_VALUE = ch; /* next look ahead ch */ 00725 LA_CH_CLASS = (ch == (char) EOF) ? Ch_Class_EOF : ch_class[LA_CH_VALUE]; 00726 00727 TRACE (Func_Exit, "fixed_get_char", ch_str[(unsigned char) LA_CH_VALUE]); 00728 00729 return; 00730 00731 } /* fixed_get_char */ 00732 00733 /******************************************************************************\ 00734 |* *| 00735 |* Description: *| 00736 |* Fixed_get_char_literal is called to obtain the next character from *| 00737 |* the source line buffer when inside a character literal context. *| 00738 |* End of statement causes an EOS to be returned. *| 00739 |* *| 00740 |* Input parameters: *| 00741 |* NONE *| 00742 |* *| 00743 |* Output parameters: *| 00744 |* la_ch next look ahead character from source line *| 00745 |* *| 00746 |* Returns: *| 00747 |* NOTHING *| 00748 |* *| 00749 \******************************************************************************/ 00750 00751 void fixed_get_char_literal (void) 00752 00753 { 00754 char ch; 00755 int ich; 00756 00757 00758 TRACE (Func_Entry, "fixed_get_char_literal", NULL); 00759 00760 ich = stmt_buf[++stmt_buf_idx]; /* next src character */ 00761 00762 if (stmt_buf_idx == stmt_line_end_idx[stmt_line_idx]) { 00763 00764 if (stmt_line_idx < lines_in_buf) { /* check for cont line*/ 00765 ++stmt_line_idx; 00766 stmt_buf_idx = stmt_line_start_idx[stmt_line_idx] 00767 + stmt_line_offset[stmt_line_idx]; 00768 00769 ich = stmt_buf[++stmt_buf_idx]; /* next src character */ 00770 } 00771 else { /* end of statement */ 00772 ich = eos; /* cnvrt \n to EOS */ 00773 } 00774 } 00775 00776 ch = ich; 00777 LA_CH_VALUE = ch; /* next look ahead ch */ 00778 LA_CH_LINE = stmt_line_num[stmt_line_idx]; 00779 LA_CH_COLUMN = stmt_buf_col[stmt_buf_idx]; 00780 LA_CH_BUF_IDX = stmt_buf_idx; 00781 LA_CH_STMT_NUM = statement_number; 00782 LA_CH_CLASS = (ch == (char) EOF) ? Ch_Class_EOF : ch_class[LA_CH_VALUE]; 00783 00784 TRACE (Func_Exit, "fixed_get_char_literal", 00785 ch_str[(unsigned char) LA_CH_VALUE]); 00786 00787 return; 00788 00789 } /* fixed_get_char_literal */ 00790 00791 00792 /******************************************************************************\ 00793 |* *| 00794 |* Description: *| 00795 |* Free_get_char is called to obtain the next character from the source *| 00796 |* line buffer when outside a character literal context. Space chars *| 00797 |* are returned here since they are significant in free source form. *| 00798 |* *| 00799 |* Lowercase letters are converted to uppercase. End of statement *| 00800 |* causes an EOS to be returned. *| 00801 |* *| 00802 |* Input parameters: *| 00803 |* NONE *| 00804 |* *| 00805 |* Output parameters: *| 00806 |* la_ch next look ahead character from source line *| 00807 |* *| 00808 |* Returns: *| 00809 |* NOTHING *| 00810 |* *| 00811 \******************************************************************************/ 00812 00813 void free_get_char (void) 00814 00815 { 00816 char ch; 00817 int ich; 00818 00819 00820 TRACE (Func_Entry, "free_get_char", NULL); 00821 00822 sig_blank = FALSE; 00823 00824 /* If previous la_ch was end of stmt, then get next stmt. */ 00825 00826 if (LA_CH_VALUE == EOS) { 00827 stmt_end_line = LA_CH_LINE; 00828 stmt_end_col = LA_CH_COLUMN - 1; 00829 00830 if (change_source_form) { 00831 change_source_form = FALSE; 00832 00833 if (cmd_line_flags.line_size_80) { 00834 line_size = FIXED_SRC_LINE_SIZE_80; 00835 } 00836 else if (cmd_line_flags.line_size_132) { 00837 line_size = FIXED_SRC_LINE_SIZE_132; 00838 } 00839 else { 00840 line_size = FIXED_SRC_LINE_SIZE_72; 00841 } 00842 get_char = fixed_get_char; 00843 get_char_literal = fixed_get_char_literal; 00844 source_form = Fixed_Form; 00845 00846 fixed_get_char (); 00847 00848 TRACE (Func_Exit, "free_get_char", 00849 ch_str[(unsigned char) LA_CH_VALUE]); 00850 00851 return; 00852 } 00853 00854 free_get_stmt (); 00855 00856 /* the only time that stmt_buf_type is comment is EOF of include file */ 00857 while (stmt_buf_type == Comment_Line) { 00858 if (change_source_form) { 00859 change_source_form = FALSE; 00860 00861 if (cmd_line_flags.line_size_80) { 00862 line_size = FIXED_SRC_LINE_SIZE_80; 00863 } 00864 else if (cmd_line_flags.line_size_132) { 00865 line_size = FIXED_SRC_LINE_SIZE_132; 00866 } 00867 else { 00868 line_size = FIXED_SRC_LINE_SIZE_72; 00869 } 00870 00871 get_char = fixed_get_char; 00872 get_char_literal = fixed_get_char_literal; 00873 source_form = Fixed_Form; 00874 00875 fixed_get_char (); 00876 00877 TRACE (Func_Exit, "free_get_char", 00878 ch_str[(unsigned char) LA_CH_VALUE]); 00879 00880 return; 00881 } 00882 else { 00883 free_get_stmt (); 00884 } 00885 } 00886 00887 ich = stmt_buf[stmt_buf_idx + 1]; 00888 00889 while (((ich == newline) | 00890 (ich == semi_colon) | 00891 (ich == bang)) && 00892 (stmt_line_idx >= lines_in_buf)) { 00893 00894 free_get_stmt (); 00895 00896 while (stmt_buf_type == Comment_Line) { 00897 if (change_source_form) { 00898 change_source_form = FALSE; 00899 00900 if (cmd_line_flags.line_size_80) { 00901 line_size = FIXED_SRC_LINE_SIZE_80; 00902 } 00903 else if (cmd_line_flags.line_size_132) { 00904 line_size = FIXED_SRC_LINE_SIZE_132; 00905 } 00906 else { 00907 line_size = FIXED_SRC_LINE_SIZE_72; 00908 } 00909 00910 get_char = fixed_get_char; 00911 get_char_literal = fixed_get_char_literal; 00912 source_form = Fixed_Form; 00913 00914 fixed_get_char (); 00915 00916 TRACE (Func_Exit, "free_get_char", 00917 ch_str[(unsigned char) LA_CH_VALUE]); 00918 00919 return; 00920 } 00921 else { 00922 free_get_stmt (); 00923 } 00924 } 00925 00926 ich = stmt_buf[stmt_buf_idx + 1]; 00927 } 00928 00929 00930 if (stmt_buf_type == Dir_Line) { /* directive line */ 00931 ch = stmt_buf[stmt_buf_idx]; /* next src character */ 00932 00933 if (islower(ch)) { 00934 ch = TOUPPER(ch); 00935 } 00936 00937 LA_CH_VALUE = ch; 00938 LA_CH_LINE = stmt_line_num[stmt_line_idx]; 00939 LA_CH_COLUMN = stmt_buf_col[stmt_buf_idx]; 00940 LA_CH_BUF_IDX = stmt_buf_idx; 00941 LA_CH_STMT_NUM = statement_number; 00942 00943 switch (stmt_prefix_len) { 00944 case 1 : 00945 LA_CH_CLASS = Ch_Class_Dir1; /* directive class */ 00946 break; 00947 case 2 : 00948 LA_CH_CLASS = Ch_Class_Dir2; /* directive class */ 00949 break; 00950 case 3 : 00951 LA_CH_CLASS = Ch_Class_Dir3; /* directive class */ 00952 break; 00953 case 4 : 00954 LA_CH_CLASS = Ch_Class_Dir4; /* directive class */ 00955 break; 00956 case 7 : 00957 /* eraxxon: OpenAD directive */ 00958 LA_CH_CLASS = Ch_Class_Dir7; /* directive class */ 00959 break; 00960 } 00961 00962 TRACE (Func_Exit, "free_get_char", 00963 ch_str[(unsigned char) LA_CH_VALUE]); 00964 00965 return; 00966 } 00967 } 00968 00969 /* handling of continued lines must be in a loop to process special cases. */ 00970 /* beginning of line cases, '& \n' and '& !' have been detected and */ 00971 /* reported by free_classify_line. end of line case, 'text & text' is */ 00972 /* detected here. The '&' is considered part of the token string. */ 00973 /* a last special case, '&&' is handled here. It is treated as both a */ 00974 /* continuation and continued line with zero characters of the token. */ 00975 00976 ich = stmt_buf[++stmt_buf_idx]; /* next src character */ 00977 00978 if (ich == blank || ich == tab) { /* skip no-op blanks */ 00979 00980 do { 00981 ich = stmt_buf[++stmt_buf_idx]; /* next src character */ 00982 } 00983 while (ich == blank || ich == tab); /* skip white space */ 00984 00985 sig_blank = TRUE; 00986 } 00987 00988 if (stmt_buf_idx == stmt_buf_EOS_idx) { 00989 ich = eos; 00990 } 00991 else if (stmt_buf_idx == stmt_line_end_idx[stmt_line_idx]) { 00992 00993 if (stmt_line_idx < lines_in_buf) { /* stmt continues */ 00994 ++stmt_line_idx; 00995 stmt_buf_idx = stmt_line_start_idx[stmt_line_idx] 00996 + stmt_line_offset[stmt_line_idx]; 00997 ich = stmt_buf[++stmt_buf_idx]; 00998 } 00999 else { 01000 ich = eos; 01001 } 01002 01003 if (ich == blank || ich == tab) { /* skip no-op blanks */ 01004 01005 do { 01006 ich = stmt_buf[++stmt_buf_idx]; /* next src character */ 01007 } 01008 while (ich == blank || ich == tab); /* skip white space */ 01009 01010 sig_blank = TRUE; 01011 } 01012 01013 if (stmt_buf_idx == stmt_buf_EOS_idx) { 01014 ich = eos; 01015 } 01016 } 01017 01018 LA_CH_LINE = stmt_line_num[stmt_line_idx]; 01019 LA_CH_COLUMN = stmt_buf_col[stmt_buf_idx]; 01020 LA_CH_BUF_IDX = stmt_buf_idx; 01021 LA_CH_STMT_NUM = statement_number; 01022 01023 if (havent_issued_at_ansi && ich == at_sign) { 01024 havent_issued_at_ansi = FALSE; 01025 ntr_msg_queue(LA_CH_LINE, 900, Ansi, 01026 LA_CH_COLUMN, 01027 (char *)NULL, 01028 0, 01029 NO_ARG); 01030 } 01031 01032 if (havent_issued_dollar_ansi && ich == dollar) { 01033 havent_issued_dollar_ansi = FALSE; 01034 ntr_msg_queue(LA_CH_LINE, 901, Ansi, 01035 LA_CH_COLUMN, 01036 (char *)NULL, 01037 0, 01038 NO_ARG); 01039 } 01040 01041 ch = ich; 01042 01043 if (islower(ch)) { /* lowercase char */ 01044 ch = TOUPPER(ch); /* cnvrt lwr to upr */ 01045 } 01046 01047 LA_CH_VALUE = ch; /* next look ahead ch */ 01048 LA_CH_CLASS = (ch == (char) EOF) ? Ch_Class_EOF : ch_class[LA_CH_VALUE]; 01049 01050 TRACE (Func_Exit, "free_get_char", 01051 ch_str[(unsigned char) LA_CH_VALUE]); 01052 01053 return; 01054 01055 } /* free_get_char */ 01056 01057 /******************************************************************************\ 01058 |* *| 01059 |* Description: *| 01060 |* Free_get_char_literal is called to obtain the next character from *| 01061 |* the source line buffer when inside a character literal context. *| 01062 |* End of statement causes an EOS to be returned. *| 01063 |* *| 01064 |* Input parameters: *| 01065 |* NONE *| 01066 |* *| 01067 |* Output parameters: *| 01068 |* la_ch next look ahead character from source line *| 01069 |* *| 01070 |* Returns: *| 01071 |* NOTHING *| 01072 |* *| 01073 \******************************************************************************/ 01074 01075 void free_get_char_literal (void) 01076 01077 { 01078 char ch; 01079 int ich; 01080 01081 01082 TRACE (Func_Entry, "free_get_char_literal", NULL); 01083 01084 /* ? */ 01085 /* handling of continued lines must be in a loop to process special cases. */ 01086 /* beginning of line cases, '& \n' and '& !' have been detected and */ 01087 /* reported by free_classify_line. end of line case, 'text & text' is */ 01088 /* detected here. The '&' is considered part of the character literal. */ 01089 /* a last special case, '&&' is handled here. It is treated as both a */ 01090 /* continuation and continued line with zero characters of the literal. */ 01091 /* ? */ 01092 01093 ich = stmt_buf[++stmt_buf_idx]; /* next src character */ 01094 01095 01096 if (stmt_buf_idx == stmt_line_end_idx[stmt_line_idx]) { 01097 01098 if (stmt_line_idx < lines_in_buf) { 01099 ++stmt_line_idx; 01100 stmt_buf_idx = stmt_line_start_idx[stmt_line_idx] 01101 + stmt_line_offset[stmt_line_idx]; 01102 01103 ich = stmt_buf[++stmt_buf_idx]; 01104 } 01105 else { 01106 ich = eos; 01107 } 01108 } 01109 01110 ch = ich; 01111 01112 LA_CH_VALUE = ch; /* next look ahead ch */ 01113 LA_CH_LINE = stmt_line_num[stmt_line_idx]; 01114 LA_CH_COLUMN = stmt_buf_col[stmt_buf_idx]; 01115 LA_CH_BUF_IDX = stmt_buf_idx; 01116 LA_CH_STMT_NUM = statement_number; 01117 LA_CH_CLASS = (ch == (char) EOF) ? Ch_Class_EOF : ch_class[LA_CH_VALUE]; 01118 01119 TRACE (Func_Exit, "free_get_char_literal", 01120 ch_str[(unsigned char) LA_CH_VALUE]); 01121 01122 return; 01123 01124 } /* free_get_char_literal */ 01125 01126 /******************************************************************************\ 01127 |* *| 01128 |* Description: *| 01129 |* Fixed_get_stmt obtains the next src input stmt. It will fill *| 01130 |* stmt_buf array with a full statement using repeated calls to *| 01131 |* read_line. *| 01132 |* *| 01133 |* The line is classified as a comment, include, dir, regular, or *| 01134 |* continuation line by calling fixed_classify_line. Checks involving *| 01135 |* relationships between lines (eg. continued followed by continuation) *| 01136 |* are performed here. Comment and include lines are not returned. *| 01137 |* Character constants are marked. *| 01138 |* *| 01139 |* An EOF line is returned when end of the input source file is *| 01140 |* encountered. Include lines cause a file switch. End of include *| 01141 |* files are treated as comments. *| 01142 |* *| 01143 |* Input parameters: *| 01144 |* NONE *| 01145 |* *| 01146 |* Output parameters: *| 01147 |* NONE *| 01148 |* *| 01149 |* Returns: *| 01150 |* NOTHING *| 01151 |* *| 01152 \******************************************************************************/ 01153 01154 static void fixed_get_stmt (void) 01155 { 01156 int idx; 01157 int line_counter = 1; 01158 int loc_stmt_num; 01159 int save_idx; 01160 int stmt_buf_EOS; 01161 01162 01163 TRACE (Func_Entry, "fixed_get_stmt", NULL); 01164 01165 /* Issue any deferred src_input messages. */ 01166 01167 issue_deferred_msgs(); 01168 01169 01170 if (stmt_buf_type == EOF_Line) { 01171 /* Attempt to read past end of file */ 01172 PRINTMSG (0, 50, Internal, 1); /* all done now */ 01173 } 01174 01175 stmt_line_idx = NULL_IDX; /* line array index */ 01176 stmt_buf_idx = NULL_IDX; /* global stmt buf idx*/ 01177 lines_in_buf = 0; /* total lines in buf */ 01178 01179 label_ok = FALSE; 01180 01181 /* loop while stmt continues */ 01182 do { 01183 01184 save_idx = 0; 01185 01186 /* add nxt_line to stmt_buf */ 01187 01188 stmt_line_num[++stmt_line_idx] = nxt_line_num; 01189 01190 /* stmt_line_offset holds offset to first significant char of line */ 01191 01192 if (starting_pt) { 01193 stmt_line_offset[stmt_line_idx] = starting_pt - 2; 01194 label_ok = FALSE; 01195 } 01196 else { 01197 stmt_line_offset[stmt_line_idx] = nxt_line_idx - 1; 01198 starting_pt = nxt_line_idx; 01199 01200 if (nxt_line_label) { 01201 label_ok = TRUE; 01202 } 01203 } 01204 01205 /* stmt_line_start_idx points to where line starts in stmt_buf */ 01206 01207 stmt_line_start_idx[stmt_line_idx] = line_counter; 01208 01209 /* stmt_line_end_idx points to newline or bang */ 01210 01211 stmt_line_end_idx[stmt_line_idx] = nxt_line_EOL + line_counter - 1; 01212 01213 /* record the statement type */ 01214 01215 if (nxt_line_type != Continuation_Line && 01216 nxt_line_type != Dir_Continuation_Line) { 01217 stmt_buf_type = nxt_line_type; 01218 01219 if (nxt_line_type == Dir_Line) { 01220 stmt_prefix_len = nxt_line_prefix_len; 01221 stmt_buf_dir_prefix = nxt_line_dir_prefix; 01222 } 01223 01224 if (stmt_buf_type != Comment_Line && 01225 stmt_buf_type != Pound_Src_Line && 01226 stmt_buf_type != Pound_Include_Exit_Line) { 01227 INCREMENT_STATEMENT_NUMBER; 01228 } 01229 } 01230 01231 if (stmt_buf_type == Dir_Line) { 01232 line_dir_prefix[stmt_line_idx] = nxt_line_actual_dir_prefix; 01233 } 01234 01235 move_up_next_msg_queue(); 01236 01237 /* copy nxt_line to proper part of stmt_buf, backwards */ 01238 01239 stmt_buf_idx = line_counter + nxt_line_EOL - 1; 01240 line_counter += nxt_line_EOL; 01241 01242 for (idx = nxt_line_EOL; idx > 0; idx --) { 01243 stmt_buf[stmt_buf_idx] = nxt_line[NXT_COL(idx)]; 01244 stmt_buf_col[stmt_buf_idx] = nxt_line_col[NXT_COL(idx)]; 01245 stmt_buf_idx--; 01246 01247 if (havent_issued_tab_ansi && 01248 idx < nxt_line_EOL && 01249 nxt_line[NXT_COL(idx)] == tab) { 01250 havent_issued_tab_ansi = FALSE; 01251 ntr_msg_queue(nxt_line_num, 899, Ansi, 01252 idx, 01253 (char *)NULL, 01254 0, 01255 NO_ARG); 01256 } 01257 01258 if (nxt_line[NXT_COL(idx)] == semi_colon && 01259 stmt_buf_type != Dir_Line) { 01260 if ((idx > starting_pt) && (idx < nxt_line_EOL)) { 01261 save_idx = idx; 01262 } 01263 } 01264 } 01265 01266 idx = 0; 01267 lines_in_buf++; 01268 01269 /* save_idx is the point in nxt_line where the next ';' is */ 01270 /* If there is a semi_colon then I don't replace nxt_line */ 01271 /* or classify it again. I simply recopy nxt_line into the */ 01272 /* stmt_buf and start processing after the ;. */ 01273 /* Must check if nxt_line_type is a comment line because */ 01274 /* when an include file ends, comment lines come through. */ 01275 01276 if (save_idx && 01277 nxt_line_type != Comment_Line) { 01278 01279 stmt_buf_EOS = save_idx; 01280 idx = save_idx; 01281 while ((nxt_line[NXT_COL(idx)] == semi_colon) | 01282 (nxt_line[NXT_COL(idx)] == blank) | 01283 (nxt_line[NXT_COL(idx)] == tab)) { 01284 idx++; 01285 } 01286 01287 /* starting_pt is the idx I start processing the next time around */ 01288 01289 starting_pt = idx; 01290 nxt_line_type = Regular_Line; 01291 continuation_count = 0; /* clear cont counter */ 01292 include_found = FALSE; /* and include flags */ 01293 include_complete = FALSE; 01294 } 01295 else { 01296 stmt_buf_EOS = nxt_line_EOL; 01297 starting_pt = NULL_IDX; 01298 } 01299 01300 /* don't read past end of source file */ 01301 /* and don't get new nxt_line if had semi-colon. */ 01302 01303 if ((stmt_buf_type != EOF_Line) && 01304 (starting_pt == NULL_IDX)) { 01305 01306 /* get next line from src input file */ 01307 do { 01308 nxt_line_type = Regular_Line; 01309 01310 if (get_nxt_line ()) { /* read next src line */ 01311 01312 if (include_switch) { 01313 update_global_line(); /* enter global_line_tbl */ 01314 include_switch = FALSE; 01315 } 01316 01317 if (issue_pound_exit_line) { 01318 OUTPUT_POUND_INCLUDE_EXIT_LINE(curr_glb_line); 01319 issue_pound_exit_line = FALSE; 01320 } 01321 01322 nxt_line_mp_line = FALSE; 01323 01324 if (nxt_line_type != Cond_Comp_Line) { 01325 PP_ORIG_SIZE = line_size; 01326 classify_line(); 01327 } 01328 01329 if (on_off_flags.save_dot_i) { 01330 01331 if (ignore_source_line || 01332 nxt_line_type == Cond_Comp_Line || 01333 nxt_line_type == Include_Line) { 01334 01335 /* print blank line */ 01336 fprintf(dot_i_fptr, "\n"); 01337 previous_global_line++; 01338 } 01339 else { 01340 print_nxt_line(); 01341 } 01342 } 01343 01344 switch (nxt_line_type) { 01345 case Comment_Line: /* ignore comments */ 01346 break; 01347 01348 case Cond_Comp_Line: 01349 if (parse_cc_line()) { 01350 01351 /* if result is true, then it was an include line */ 01352 01353 nxt_line_type = Include_Line; 01354 include_stmt_file_line = SRC_STK_FILE_LINE(src_stk_idx); 01355 01356 if (open_include_file (TRUE)) { 01357 include_found = TRUE; /* flag begin of file */ 01358 include_switch = TRUE; /* flag file switch */ 01359 } 01360 } 01361 else { 01362 nxt_line_type = Comment_Line; 01363 } 01364 angle_brkt_include = FALSE; 01365 break; 01366 01367 case Dir_Line: 01368 case Regular_Line: 01369 continuation_count = 0; /* clear cont counter */ 01370 include_found = FALSE; /* and include flags */ 01371 include_complete = FALSE; 01372 break; 01373 01374 case Continuation_Line: 01375 case Dir_Continuation_Line: 01376 01377 if (++continuation_count == MAX_ANSI_FIXED_LINES) { 01378 01379 /* Too many continuation lines is non-standard. */ 01380 01381 ntr_msg_queue(nxt_line_num, 52, Ansi, 01382 CONTINUE_COLUMN, 01383 "fixed", 01384 (MAX_ANSI_FIXED_LINES - 1), 01385 ARG_STR_ARG); 01386 } 01387 01388 if (continuation_count == MAX_FIXED_LINES) { 01389 01390 /* this is it. I cn give ya na more powr cap'n */ 01391 01392 ntr_msg_queue(nxt_line_num, 524, Error, 01393 CONTINUE_COLUMN, 01394 (char *)NULL, 01395 0, 01396 NO_ARG); 01397 } 01398 01399 if (continuation_count >= MAX_FIXED_LINES) { 01400 nxt_line_type = Comment_Line; 01401 break; 01402 } 01403 01404 if (stmt_buf_type == Dir_Line && 01405 nxt_line_type == Continuation_Line) { 01406 01407 /* Invalid continuation of comment or directive */ 01408 01409 ntr_msg_queue(nxt_line_num, 51, Error, 01410 CONTINUE_COLUMN, 01411 (char *)NULL, 01412 0, 01413 NO_ARG); 01414 } 01415 01416 if (include_found) { 01417 include_found = FALSE; 01418 01419 /* First line of included file must not be a cont line*/ 01420 01421 ntr_msg_queue(nxt_line_num, 53, Error, 01422 CONTINUE_COLUMN, 01423 (char *)NULL, 01424 0, 01425 NO_ARG); 01426 } 01427 01428 if (include_complete) { 01429 include_complete = FALSE; 01430 01431 /* Next line of file after include must not be a cont */ 01432 01433 ntr_msg_queue(nxt_line_num, 54, Error, 01434 CONTINUE_COLUMN, 01435 (char *)NULL, 01436 0, 01437 NO_ARG); 01438 } 01439 01440 if (cif_flags & MISC_RECS) { 01441 cif_cont_line_rec( 01442 (nxt_line_type == Continuation_Line) ? 0 : 1, 01443 nxt_line_num); 01444 } 01445 01446 break; 01447 01448 case Pound_Src_Line: 01449 break; 01450 01451 case Pound_Include_Exit_Line: 01452 include_complete = TRUE; 01453 nxt_line_type = Comment_Line; 01454 curr_glb_line--; 01455 SRC_STK_FILE_LINE(src_stk_idx)--; 01456 GL_SOURCE_LINES(SRC_STK_GLOBAL_LINE_IDX(src_stk_idx)) = 01457 SRC_STK_FILE_LINE(src_stk_idx); 01458 set_related_gl_source_lines( 01459 SRC_STK_GLOBAL_LINE_IDX(src_stk_idx)); 01460 01461 if (source_form != SRC_STK_PREV_SRC_FORM(src_stk_idx)) { 01462 change_source_form = TRUE; 01463 } 01464 POP_SRC; 01465 include_switch = TRUE; 01466 break; 01467 01468 case Pound_Include_Enter_Line: 01469 case Include_Line: 01470 01471 include_stmt_file_line = SRC_STK_FILE_LINE(src_stk_idx); 01472 01473 if (open_include_file (FALSE)) { 01474 include_found = TRUE; /* flag begin of file */ 01475 include_switch = TRUE; /* flag file switch */ 01476 } 01477 01478 break; 01479 } /* switch */ 01480 } 01481 else { /* EOF on source file */ 01482 01483 /* need to bump pp_line_idx since classify_line was not called */ 01484 01485 if (cmd_line_flags.pp_macro_expansion) { 01486 pp_line_idx++; 01487 } 01488 01489 /* check for termination of include file */ 01490 01491 if (src_stk_idx > SRC_STK_BASE_IDX) { /* curr src is include*/ 01492 include_complete = TRUE; /* flag end of file */ 01493 nxt_line_type = Comment_Line; /* make EOF a comment */ 01494 nxt_line_EOL = 2; 01495 curr_glb_line--; /* don't count this line */ 01496 01497 GL_SOURCE_LINES(SRC_STK_GLOBAL_LINE_IDX(src_stk_idx)) = 01498 SRC_STK_FILE_LINE(src_stk_idx); 01499 set_related_gl_source_lines( 01500 SRC_STK_GLOBAL_LINE_IDX(src_stk_idx)); 01501 01502 if (source_form != SRC_STK_PREV_SRC_FORM(src_stk_idx)) { 01503 change_source_form = TRUE; 01504 } 01505 POP_SRC; 01506 include_switch = TRUE; /* flag file switch */ 01507 issue_pound_exit_line = TRUE; 01508 break; 01509 } 01510 else { /* curr src is input */ 01511 GL_SOURCE_LINES(SRC_STK_GLOBAL_LINE_IDX(src_stk_idx)) = 01512 SRC_STK_FILE_LINE(src_stk_idx); 01513 set_related_gl_source_lines( 01514 SRC_STK_GLOBAL_LINE_IDX(src_stk_idx)); 01515 nxt_line_type = EOF_Line; /* end of compilation */ 01516 nxt_line_EOL = 2; 01517 } 01518 } 01519 } 01520 while (nxt_line_type == Comment_Line | 01521 nxt_line_type == Include_Line | 01522 nxt_line_type == Pound_Include_Enter_Line); 01523 01524 } 01525 } 01526 while (nxt_line_type == Continuation_Line || 01527 nxt_line_type == Dir_Continuation_Line); 01528 01529 if (prev_statement_number != statement_number) { 01530 loc_stmt_num = statement_number; 01531 statement_number = prev_statement_number; 01532 prev_statement_number = loc_stmt_num; 01533 } 01534 01535 stmt_buf_EOS_idx = stmt_line_start_idx[lines_in_buf] + stmt_buf_EOS - 1; 01536 stmt_EOS_la_ch.line = stmt_line_num[lines_in_buf]; 01537 stmt_EOS_la_ch.column = stmt_buf_col[stmt_buf_EOS_idx]; 01538 stmt_EOS_la_ch.stmt_buf_idx = stmt_buf_EOS_idx; 01539 stmt_EOS_la_ch.stmt_num = statement_number; 01540 01541 stmt_buf_idx = stmt_line_offset[1] + 1; 01542 stmt_line_idx = SRC_STK_BASE_IDX; 01543 01544 PRINT_STMT_SRC(); /* If DEBUG and -u src or -u stmt set print source */ 01545 01546 TRACE (Func_Exit, "fixed_get_stmt", NULL); 01547 01548 return; 01549 01550 } /* fixed_get_stmt */ 01551 01552 /******************************************************************************\ 01553 |* *| 01554 |* Description: *| 01555 |* Reads next line of source characters from source file into source *| 01556 |* buffer. A line is delimited by a new line character followed by EOS. *| 01557 |* *| 01558 |* Input parameters: *| 01559 |* NONE *| 01560 |* *| 01561 |* Output parameters: *| 01562 |* NONE *| 01563 |* *| 01564 |* Returns: *| 01565 |* TRUE if source input line was read, FALSE on EOF or error. *| 01566 |* *| 01567 \******************************************************************************/ 01568 01569 boolean read_line (boolean cc_continuation_line) 01570 01571 { 01572 int ch; 01573 int i; 01574 int k; 01575 int limit; 01576 boolean result = TRUE; /* assume success */ 01577 01578 01579 TRACE (Func_Entry, "read_line", NULL); 01580 01581 if (extra_nxt_line != 0 && 01582 nxt_line_num_lines == 0) { 01583 01584 /* just move the extra line into the first line spot */ 01585 01586 nxt_line_num_lines++; 01587 01588 if (pp_nxt_line_type[extra_nxt_line] == EOF_Line) { 01589 nxt_line_start_idx[1] = 1; 01590 nxt_line_end_idx[1] = 2; 01591 nxt_line[1] = EOF; 01592 nxt_line[2] = eos; 01593 pp_nxt_line_length[1] = 1; 01594 pp_nxt_line_type[1] = EOF_Line; 01595 pp_nxt_line_idx[1] = NULL_IDX; 01596 result = FALSE; /* return EOF result */ 01597 } 01598 else { 01599 k = 0; 01600 for (i = nxt_line_start_idx[extra_nxt_line]; 01601 i <= nxt_line_end_idx[extra_nxt_line]; 01602 i++) { 01603 01604 nxt_line[++k] = (nxt_line[i] & 0xFF); 01605 nxt_line_col[k] = nxt_line_col[i]; 01606 } 01607 nxt_line_start_idx[1] = 1; 01608 nxt_line_end_idx[1] = k; 01609 pp_nxt_line_length[1] = k-1; 01610 } 01611 01612 pp_nxt_line_num[1] = pp_nxt_line_num[extra_nxt_line]; 01613 pp_nxt_line_mp_line[1] = pp_nxt_line_mp_line[extra_nxt_line]; 01614 01615 if (pp_nxt_line_type[extra_nxt_line] == Include_Line) { 01616 nxt_line_type = Include_Line; 01617 } 01618 01619 extra_nxt_line = NULL_IDX; 01620 01621 goto EXIT; 01622 } 01623 01624 /* copy max number characters in the next line to the source input buffer */ 01625 01626 ch = getc(SRC_STK_FILE_PTR(src_stk_idx)); 01627 01628 if (on_off_flags.preprocess && 01629 ch != newline && 01630 ch != EOF && 01631 (ch == '#' || cc_continuation_line)) { 01632 01633 limit = MAX_STMT_CHAR_SIZE - 4; 01634 01635 if (! cc_continuation_line) { 01636 cc_stmt_buf_idx = NULL_IDX; 01637 cc_stmt_buf_num_lines = 0; 01638 } 01639 01640 cc_stmt_buf_line[++cc_stmt_buf_num_lines].line = ++curr_glb_line; 01641 cc_stmt_buf_line[cc_stmt_buf_num_lines].start_idx = cc_stmt_buf_idx; 01642 SRC_STK_FILE_LINE(src_stk_idx)++; 01643 01644 cc_stmt_buf[++cc_stmt_buf_idx] = ch; 01645 01646 while ((ch = getc(SRC_STK_FILE_PTR(src_stk_idx))) != newline && 01647 ch != EOF){ 01648 01649 if (limit > 0) { 01650 cc_stmt_buf[++cc_stmt_buf_idx] = ch; 01651 limit--; 01652 } 01653 } 01654 01655 cc_stmt_buf[++cc_stmt_buf_idx] = newline; 01656 cc_stmt_buf[++cc_stmt_buf_idx] = eos; 01657 01658 nxt_line_type = Cond_Comp_Line; 01659 01660 goto EXIT; 01661 } 01662 01663 nxt_line_start_idx[nxt_line_num_lines + 1] = 01664 nxt_line_end_idx[nxt_line_num_lines] + 1; 01665 01666 nxt_line_num_lines++; 01667 01668 for (i = nxt_line_start_idx[nxt_line_num_lines] - 1; 01669 i <= nxt_line_start_idx[nxt_line_num_lines] + line_size; 01670 i++) { 01671 nxt_line_col[i] = (i - nxt_line_start_idx[nxt_line_num_lines]) + 1; 01672 } 01673 01674 nxt_line_idx = nxt_line_start_idx[nxt_line_num_lines] - 1; 01675 01676 if (ch != newline && ch != EOF) { 01677 limit = nxt_line_idx + FREE_SRC_LINE_SIZE; 01678 01679 nxt_line[++nxt_line_idx] = ch; 01680 01681 while ((ch = getc(SRC_STK_FILE_PTR(src_stk_idx))) != newline && 01682 ch != EOF){ 01683 01684 if (nxt_line_idx < limit) { 01685 nxt_line[++nxt_line_idx] = ch; 01686 } 01687 } 01688 } 01689 01690 01691 if (nxt_line_idx > 01692 (nxt_line_start_idx[nxt_line_num_lines] - 1) + line_size) { 01693 01694 nxt_line_idx = (nxt_line_start_idx[nxt_line_num_lines] - 1) + line_size; 01695 } 01696 01697 if (nxt_line_idx == nxt_line_start_idx[nxt_line_num_lines] - 1 && 01698 ch == EOF) { 01699 /* file ends with '\n'*/ 01700 nxt_line[nxt_line_start_idx[nxt_line_num_lines]] = EOF; 01701 nxt_line[nxt_line_start_idx[nxt_line_num_lines] + 1] = eos; 01702 pp_nxt_line_length[nxt_line_num_lines] = 1; 01703 nxt_line_end_idx[nxt_line_num_lines] = 01704 nxt_line_start_idx[nxt_line_num_lines] + 1; 01705 pp_nxt_line_num[nxt_line_num_lines] = ++curr_glb_line; 01706 pp_nxt_line_type[nxt_line_num_lines] = EOF_Line; 01707 pp_nxt_line_idx[nxt_line_num_lines] = NULL_IDX; 01708 result = FALSE; /* return EOF result */ 01709 } 01710 else { /* return next line */ 01711 if (source_form == Fixed_Form) { 01712 /* pad to continue col*/ 01713 while (nxt_line_idx < 01714 (nxt_line_start_idx[nxt_line_num_lines] - 1) + CONTINUE_COLUMN) { 01715 nxt_line[++nxt_line_idx] = blank; 01716 } 01717 } 01718 01719 pp_nxt_line_num[nxt_line_num_lines] = ++curr_glb_line; 01720 SRC_STK_FILE_LINE(src_stk_idx)++; /* upd file line num */ 01721 01722 nxt_line[++nxt_line_idx] = newline; /* end line w/ \n/EOS */ 01723 pp_nxt_line_length[nxt_line_num_lines] = nxt_line_idx - 01724 (nxt_line_start_idx[nxt_line_num_lines] - 1); 01725 nxt_line[++nxt_line_idx] = eos; 01726 nxt_line_end_idx[nxt_line_num_lines] = nxt_line_idx; 01727 01728 if (pp_nxt_line_length[nxt_line_num_lines] > 73 && 01729 source_form == Fixed_Form && 01730 ! have_issued_msg_37 && 01731 issue_classify_msg) { 01732 have_issued_msg_37 = TRUE; 01733 ntr_next_msg_queue(curr_glb_line, 37, Ansi, 01734 0, 01735 (char *)NULL, 01736 0, 01737 NO_ARG); 01738 } 01739 01740 01741 # if 0 01742 01743 /* LRR: The following code to issue message 55 is being #ifdef'd out */ 01744 /* because we can think of no reason for it being here, but I don't */ 01745 /* want to lose it entirely in case in the future we do find a need for */ 01746 /* it. It does nothing to fix the file anyway. The newline has already*/ 01747 /* been inserted by code above this. And if message 55 ever does get */ 01748 /* issued, the message handler can't process it correctly because it */ 01749 /* hits the EOF before it increments its line counter which makes it */ 01750 /* look like it could not find the source line. See SPR 84130. */ 01751 01752 if (ch == EOF) { /* File line does not end with newline. */ 01753 PRINTMSG (curr_glb_line, 55, Warning, 0); 01754 } 01755 01756 # endif 01757 01758 01759 } 01760 01761 EXIT: 01762 01763 TRACE (Func_Exit, "read_line", NULL); 01764 01765 return (result); 01766 01767 } /* read_line */ 01768 01769 /******************************************************************************\ 01770 |* *| 01771 |* Description: *| 01772 |* <description> *| 01773 |* *| 01774 |* Input parameters: *| 01775 |* NONE *| 01776 |* *| 01777 |* Output parameters: *| 01778 |* NONE *| 01779 |* *| 01780 |* Returns: *| 01781 |* NOTHING *| 01782 |* *| 01783 \******************************************************************************/ 01784 01785 static boolean is_pound_line_dir(void) 01786 01787 { 01788 int ch; 01789 boolean dir = FALSE; 01790 int idx; 01791 01792 TRACE (Func_Entry, "is_pound_line_dir", NULL); 01793 01794 ch = nxt_line[NXT_COL(1)]; /* column 1 char */ 01795 01796 if (ch == pound) { 01797 idx = NXT_COL(2); 01798 ch = nxt_line[idx]; 01799 01800 while (ch == blank | ch == tab) { 01801 idx++; 01802 ch = nxt_line[idx]; 01803 } 01804 01805 if (isdigit(ch)) { 01806 dir = TRUE; 01807 } 01808 } 01809 01810 TRACE (Func_Exit, "is_pound_line_dir", NULL); 01811 01812 return(dir); 01813 01814 } /* is_pound_line_dir */ 01815 01816 /******************************************************************************\ 01817 |* *| 01818 |* Description: *| 01819 |* The line in the input buffer is classified as a comment, include, *| 01820 |* dir, continuation, or regular line. Fixed source form rules apply. *| 01821 |* Character constants are marked with a set sign bit in each character. *| 01822 |* *| 01823 |* Input parameters: *| 01824 |* NONE *| 01825 |* *| 01826 |* Output parameters: *| 01827 |* NONE *| 01828 |* *| 01829 |* Returns: *| 01830 |* NOTHING *| 01831 |* *| 01832 \******************************************************************************/ 01833 01834 static void fixed_classify_line (void) 01835 01836 { 01837 int ch; 01838 char form[4] = " "; 01839 char ch_tmp; 01840 int cont_col; 01841 char delim; 01842 char err_str[2]; 01843 int i; 01844 int ich; 01845 int idx; 01846 int incl_idx; 01847 boolean label; 01848 int line_num; 01849 char line_num_str[24]; 01850 int nxt_idx; 01851 int save_curr_glb_line; 01852 01853 TRACE (Func_Entry, "fixed_classify_line", NULL); 01854 01855 PP_EOL = nxt_line_end_idx[pp_line_idx] - 1; 01856 01857 START: 01858 01859 cont_col = NXT_COL(CONTINUE_COLUMN); 01860 01861 PP_IDX = NXT_COL(0); 01862 PP_LABEL = FALSE; 01863 01864 ch = nxt_line[NXT_COL(1)]; 01865 01866 # ifdef _FRONTEND_CONDITIONAL_COMP 01867 if (ch == pound && 01868 on_off_flags.preprocess) { 01869 01870 PP_LINE_TYPE = Cond_Comp_Line; 01871 } else 01872 # endif 01873 if (is_pound_line_dir()) { 01874 PP_IDX = NXT_COL(2); 01875 ch = nxt_line[PP_IDX]; 01876 01877 while (ch == blank | ch == tab) { 01878 PP_IDX++; 01879 ch = nxt_line[PP_IDX]; 01880 } 01881 01882 if (isdigit(ch)) { 01883 idx = 0; 01884 line_num_str[idx++] = ch; 01885 ch = nxt_line[++PP_IDX]; 01886 while (isdigit(ch)) { 01887 line_num_str[idx++] = ch; 01888 ch = nxt_line[++PP_IDX]; 01889 } 01890 01891 line_num_str[idx] = '\0'; 01892 line_num = atoi(line_num_str); 01893 01894 while (ch == blank | ch == tab) { 01895 PP_IDX++; 01896 ch = nxt_line[PP_IDX]; 01897 } 01898 01899 if (ch == quote | ch == db_quote) { 01900 char_delim = ch; 01901 ch = nxt_line[++PP_IDX]; 01902 01903 idx = 0; 01904 while (ch != char_delim) { 01905 include_file[idx++] = ch; 01906 ch = nxt_line[++PP_IDX]; 01907 } 01908 include_file[idx] = '\0'; 01909 01910 ch = nxt_line[++PP_IDX]; 01911 while (ch == blank | ch == tab) { 01912 PP_IDX++; 01913 ch = nxt_line[PP_IDX]; 01914 } 01915 01916 if (ch == '1') { 01917 PP_LINE_TYPE = Pound_Include_Enter_Line; 01918 } 01919 else if (ch == '2') { 01920 PP_LINE_TYPE = Pound_Include_Exit_Line; 01921 } 01922 else { 01923 PP_LINE_TYPE = Comment_Line; 01924 01925 /* reset the curr_glb_line */ 01926 /* line_num is a file line, not a global line */ 01927 01928 save_curr_glb_line = curr_glb_line; 01929 curr_glb_line = line_num + GL_GLOBAL_LINE(global_line_tbl_idx) - 01930 GL_FILE_LINE(global_line_tbl_idx); 01931 curr_glb_line--; 01932 01933 if (first_pound_line) { 01934 PP_LINE_TYPE = Pound_Src_Line; 01935 change_orig_src_file = TRUE; 01936 strcpy(pound_file, include_file); 01937 } 01938 else { 01939 SRC_STK_FILE_LINE(src_stk_idx) += 01940 curr_glb_line - save_curr_glb_line; 01941 } 01942 } 01943 01944 first_pound_line = FALSE; 01945 01946 } 01947 else if (ch == newline) { 01948 01949 PP_LINE_TYPE = Comment_Line; 01950 01951 /* reset the curr_glb_line */ 01952 /* line_num is a file line, not a global line */ 01953 01954 save_curr_glb_line = curr_glb_line; 01955 curr_glb_line = line_num + GL_GLOBAL_LINE(global_line_tbl_idx) - 01956 GL_FILE_LINE(global_line_tbl_idx); 01957 curr_glb_line--; 01958 01959 SRC_STK_FILE_LINE(src_stk_idx) += 01960 curr_glb_line - save_curr_glb_line; 01961 01962 first_pound_line = FALSE; 01963 } 01964 else { 01965 PP_LINE_TYPE = Comment_Line; 01966 } 01967 } 01968 else { 01969 PP_LINE_TYPE = Comment_Line; 01970 } 01971 } 01972 else if (ignore_source_line) { 01973 PP_LINE_TYPE = Comment_Line; 01974 } 01975 # ifdef _D_LINES_SUPPORTED 01976 else if (ch == uc_d | ch == lc_d) { 01977 /* this is a debug line. */ 01978 01979 if (on_off_flags.d_lines) { 01980 nxt_line[NXT_COL(1)] = ' '; 01981 goto START; 01982 } 01983 else { 01984 PP_LINE_TYPE = Comment_Line; 01985 } 01986 } 01987 # endif 01988 else if (ch == uc_c | ch == lc_c | ch == bang | ch == star) { 01989 01990 if (((ch = nxt_line[NXT_COL(2)]) == uc_d || ch == lc_d) && 01991 ((ch = nxt_line[NXT_COL(3)]) == uc_i || ch == lc_i) && 01992 ((ch = nxt_line[NXT_COL(4)]) == uc_r || ch == lc_r) && 01993 ((ch = nxt_line[NXT_COL(5)]) == dollar || ch == at_sign)) { 01994 01995 PP_PREFIX_LEN = 4; 01996 01997 first_line = FALSE; 01998 01999 /* mark the sign bit of the dollar or at_sign */ 02000 MARK_CHAR_CONST(nxt_line[NXT_COL(5)]); 02001 02002 02003 if (nxt_line[NXT_COL(6)] == zero) { 02004 nxt_line[NXT_COL(6)] = blank; 02005 } 02006 02007 if ((ch = nxt_line[NXT_COL(6)]) != blank && ch != tab) { 02008 02009 if (IS_DIR_CONTINUATION(Cdir_Dir)) { 02010 02011 PP_LINE_TYPE = Dir_Continuation_Line; 02012 PP_ACTUAL_DIR_PREFIX = Cdir_Dir; 02013 in_format = FALSE; 02014 PP_IDX = NXT_COL(6); 02015 } 02016 else { 02017 PP_LINE_TYPE = Comment_Line; 02018 } 02019 } 02020 else { 02021 PP_IDX = NXT_COL(2); /* skip 'C' char */ 02022 PP_LINE_TYPE = Dir_Line; 02023 PP_DIR_PREFIX = Cdir_Dir; 02024 PP_ACTUAL_DIR_PREFIX = Cdir_Dir; 02025 in_format = FALSE; 02026 idx = NXT_COL(6); 02027 do { 02028 ch = nxt_line[++idx]; 02029 } 02030 while (ch == blank | ch == tab); 02031 02032 if (ch == lc_f | ch == uc_f) { 02033 i = 0; 02034 while (i < 4) { 02035 ch = nxt_line[++idx]; 02036 02037 if (ch == newline) { 02038 break; 02039 } 02040 02041 if (! (ch == blank | ch == tab)) { 02042 if (islower(ch)) { 02043 form[i] = TOUPPER(ch); 02044 } 02045 else { 02046 form[i] = ch; 02047 } 02048 i++; 02049 } 02050 } 02051 02052 if (strncmp(form, "REE ", 4) == 0 && 02053 !disregard_directive[Tok_Dir_Free-Tok_Dir_Start]) { 02054 PP_CHANGE_SOURCE_FORM = TRUE; 02055 } 02056 } 02057 } 02058 } 02059 else if (((ch = nxt_line[NXT_COL(2)]) == uc_m || ch == lc_m) && 02060 ((ch = nxt_line[NXT_COL(3)]) == uc_i || ch == lc_i) && 02061 ((ch = nxt_line[NXT_COL(4)]) == uc_c || ch == lc_c) && 02062 ((ch = nxt_line[NXT_COL(5)]) == dollar || ch == at_sign)) { 02063 02064 PP_PREFIX_LEN = 4; 02065 02066 first_line = FALSE; 02067 02068 /* mark the sign bit of the dollar or at_sign */ 02069 MARK_CHAR_CONST(nxt_line[NXT_COL(5)]); 02070 02071 02072 if ((ch = nxt_line[NXT_COL(6)]) != blank && ch != tab) { 02073 02074 if (IS_DIR_CONTINUATION(Cmic_Dir)) { 02075 02076 PP_LINE_TYPE = Dir_Continuation_Line; 02077 PP_ACTUAL_DIR_PREFIX = Cmic_Dir; 02078 in_format = FALSE; 02079 PP_IDX = NXT_COL(6); 02080 } 02081 else { 02082 PP_LINE_TYPE = Comment_Line; 02083 } 02084 } 02085 else { 02086 02087 PP_IDX = NXT_COL(2); /* skip 'C' char */ 02088 in_format = FALSE; 02089 PP_LINE_TYPE = Dir_Line; 02090 PP_DIR_PREFIX = Cmic_Dir; 02091 PP_ACTUAL_DIR_PREFIX = Cmic_Dir; 02092 02093 idx = NXT_COL(6); 02094 } 02095 } 02096 else if (((ch = nxt_line[NXT_COL(2)]) == dollar) && 02097 ((ch = nxt_line[NXT_COL(3)]) == uc_o || ch == lc_o) && 02098 ((ch = nxt_line[NXT_COL(4)]) == uc_m || ch == lc_m) && 02099 ((ch = nxt_line[NXT_COL(5)]) == uc_p || ch == lc_p)) { 02100 02101 /* C$omp */ 02102 02103 PP_PREFIX_LEN = 4; 02104 02105 first_line = FALSE; 02106 02107 /* mark the sign bit of the dollar or at_sign */ 02108 MARK_CHAR_CONST(nxt_line[NXT_COL(2)]); 02109 02110 if (nxt_line[NXT_COL(6)] == zero) { 02111 nxt_line[NXT_COL(6)] = blank; 02112 } 02113 02114 if ((ch = nxt_line[NXT_COL(6)]) != blank && ch != tab) { 02115 02116 if (IS_DIR_CONTINUATION(Comp_Dir)) { 02117 02118 PP_LINE_TYPE = Dir_Continuation_Line; 02119 PP_ACTUAL_DIR_PREFIX = Comp_Dir; 02120 in_format = FALSE; 02121 PP_IDX = NXT_COL(6); 02122 } 02123 else { 02124 PP_LINE_TYPE = Comment_Line; 02125 } 02126 } 02127 else { 02128 02129 PP_IDX = NXT_COL(2); /* skip 'C' char */ 02130 in_format = FALSE; 02131 PP_LINE_TYPE = Dir_Line; 02132 PP_DIR_PREFIX = Comp_Dir; 02133 PP_ACTUAL_DIR_PREFIX = Comp_Dir; 02134 02135 idx = NXT_COL(6); 02136 02137 # if ! defined(_TARGET_OS_MAX) 02138 if (! dump_flags.open_mp && 02139 ! on_off_flags.preprocess_only) { 02140 PP_LINE_TYPE = Comment_Line; 02141 } 02142 # endif 02143 } 02144 } 02145 # if defined(GENERATE_WHIRL) 02146 else if (((ch = nxt_line[NXT_COL(2)]) == dollar) && 02147 ((ch = nxt_line[NXT_COL(3)]) == uc_s || ch == lc_s) && 02148 ((ch = nxt_line[NXT_COL(4)]) == uc_g || ch == lc_g) && 02149 ((ch = nxt_line[NXT_COL(5)]) == uc_i || ch == lc_i)) { 02150 02151 /* C$sgi */ 02152 02153 PP_PREFIX_LEN = 4; 02154 02155 first_line = FALSE; 02156 02157 /* mark the sign bit of the dollar or at_sign */ 02158 MARK_CHAR_CONST(nxt_line[NXT_COL(2)]); 02159 02160 if (nxt_line[NXT_COL(6)] == zero) { 02161 nxt_line[NXT_COL(6)] = blank; 02162 } 02163 02164 if ((ch = nxt_line[NXT_COL(6)]) != blank && ch != tab) { 02165 02166 if (IS_DIR_CONTINUATION(Comp_Dir)) { 02167 02168 PP_LINE_TYPE = Dir_Continuation_Line; 02169 PP_ACTUAL_DIR_PREFIX = Csgi_Dir; 02170 in_format = FALSE; 02171 PP_IDX = NXT_COL(6); 02172 } 02173 else { 02174 PP_LINE_TYPE = Comment_Line; 02175 } 02176 } 02177 else { 02178 02179 PP_IDX = NXT_COL(2); /* skip 'C' char */ 02180 in_format = FALSE; 02181 PP_LINE_TYPE = Dir_Line; 02182 PP_DIR_PREFIX = Comp_Dir; 02183 PP_ACTUAL_DIR_PREFIX = Csgi_Dir; 02184 02185 idx = NXT_COL(6); 02186 02187 if (! dump_flags.open_mp && 02188 ! on_off_flags.preprocess_only) { 02189 PP_LINE_TYPE = Comment_Line; 02190 } 02191 } 02192 } 02193 else if (((ch = nxt_line[NXT_COL(2)]) == dollar) && 02194 ((ch = nxt_line[NXT_COL(3)]) == uc_o || ch == lc_o) && 02195 ((ch = nxt_line[NXT_COL(4)]) == uc_p || ch == lc_p) && 02196 ((ch = nxt_line[NXT_COL(5)]) == uc_e || ch == lc_e) && 02197 ((ch = nxt_line[NXT_COL(6)]) == uc_n || ch == lc_n) && 02198 ((ch = nxt_line[NXT_COL(7)]) == uc_a || ch == lc_a) && 02199 ((ch = nxt_line[NXT_COL(8)]) == uc_d || ch == lc_d)) { 02200 02201 /* eraxxon: OpenAD directive */ 02202 /* C$OpenAD */ 02203 02204 PP_PREFIX_LEN = 7; 02205 02206 first_line = FALSE; 02207 02208 /* mark the sign bit of the dollar or at_sign */ 02209 MARK_CHAR_CONST(nxt_line[NXT_COL(2)]); 02210 02211 if (nxt_line[NXT_COL(9)] == zero) { 02212 nxt_line[NXT_COL(9)] = blank; 02213 } 02214 02215 if ((ch = nxt_line[NXT_COL(9)]) != blank && ch != tab) { 02216 02217 if (IS_DIR_CONTINUATION(Copenad_Dir)) { 02218 02219 PP_LINE_TYPE = Dir_Continuation_Line; 02220 PP_ACTUAL_DIR_PREFIX = Copenad_Dir; 02221 in_format = FALSE; 02222 PP_IDX = NXT_COL(9); 02223 } 02224 else { 02225 PP_LINE_TYPE = Comment_Line; 02226 } 02227 } 02228 else { 02229 02230 PP_IDX = NXT_COL(2); /* skip 'C' char */ 02231 in_format = FALSE; 02232 PP_LINE_TYPE = Dir_Line; 02233 PP_DIR_PREFIX = Copenad_Dir; 02234 PP_ACTUAL_DIR_PREFIX = Copenad_Dir; 02235 02236 idx = NXT_COL(9); 02237 } 02238 } 02239 # endif 02240 else if (((ch = nxt_line[NXT_COL(2)]) == dollar) && 02241 ((ch = nxt_line[NXT_COL(3)]) == uc_p || ch == lc_p) && 02242 ((ch = nxt_line[NXT_COL(4)]) == uc_a || ch == lc_a) && 02243 ((ch = nxt_line[NXT_COL(5)]) == uc_r || ch == lc_r)) { 02244 02245 /* C$par */ 02246 02247 PP_PREFIX_LEN = 4; 02248 02249 first_line = FALSE; 02250 02251 /* mark the sign bit of the dollar or at_sign */ 02252 MARK_CHAR_CONST(nxt_line[NXT_COL(2)]); 02253 02254 if ((ch = nxt_line[NXT_COL(6)]) == amp) { 02255 02256 if (IS_DIR_CONTINUATION(Cpar_Dir)) { 02257 02258 PP_LINE_TYPE = Dir_Continuation_Line; 02259 PP_ACTUAL_DIR_PREFIX = Cpar_Dir; 02260 in_format = FALSE; 02261 PP_IDX = NXT_COL(6); 02262 } 02263 else { 02264 PP_LINE_TYPE = Comment_Line; 02265 } 02266 } 02267 else { 02268 02269 PP_IDX = NXT_COL(2); /* skip 'C' char */ 02270 in_format = FALSE; 02271 PP_LINE_TYPE = Dir_Line; 02272 PP_DIR_PREFIX = Cpar_Dir; 02273 PP_ACTUAL_DIR_PREFIX = Cpar_Dir; 02274 02275 idx = NXT_COL(6); 02276 02277 if ((! dump_flags.mp && 02278 ! on_off_flags.preprocess_only) || 02279 ! is_par_directive(idx)) { 02280 PP_LINE_TYPE = Comment_Line; 02281 } 02282 } 02283 } 02284 else if (((ch = nxt_line[NXT_COL(2)]) == star) && 02285 ((ch = nxt_line[NXT_COL(3)]) == dollar) && 02286 ((ch = nxt_line[NXT_COL(4)]) == star)) { 02287 02288 /* C*$* */ 02289 02290 PP_PREFIX_LEN = 3; 02291 02292 first_line = FALSE; 02293 02294 /* mark the sign bit of the dollar or at_sign */ 02295 MARK_CHAR_CONST(nxt_line[NXT_COL(3)]); 02296 02297 02298 if ((ch = nxt_line[NXT_COL(5)]) == amp) { 02299 02300 if (IS_DIR_CONTINUATION(Cstar_Dir)) { 02301 02302 PP_LINE_TYPE = Dir_Continuation_Line; 02303 PP_ACTUAL_DIR_PREFIX = Cstar_Dir; 02304 in_format = FALSE; 02305 PP_IDX = NXT_COL(5); 02306 } 02307 else { 02308 PP_LINE_TYPE = Comment_Line; 02309 } 02310 } 02311 else { 02312 02313 PP_IDX = NXT_COL(2); /* skip 'C' char */ 02314 in_format = FALSE; 02315 PP_LINE_TYPE = Dir_Line; 02316 PP_DIR_PREFIX = Cstar_Dir; 02317 PP_ACTUAL_DIR_PREFIX = Cstar_Dir; 02318 02319 idx = NXT_COL(5); 02320 02321 # if defined(GENERATE_WHIRL) 02322 if (! is_star_directive(idx)) { 02323 PP_LINE_TYPE = Comment_Line; 02324 } 02325 # else 02326 if ((! dump_flags.mp && 02327 ! on_off_flags.preprocess_only) || 02328 ! is_star_directive(idx)) { 02329 PP_LINE_TYPE = Comment_Line; 02330 } 02331 # endif 02332 } 02333 } 02334 else if ((ch = nxt_line[NXT_COL(2)]) == dollar) { 02335 02336 /* C$ */ 02337 02338 PP_PREFIX_LEN = 1; 02339 02340 first_line = FALSE; 02341 02342 /* mark the sign bit of the dollar or at_sign */ 02343 MARK_CHAR_CONST(nxt_line[NXT_COL(2)]); 02344 02345 02346 if ((ch = nxt_line[NXT_COL(3)]) == amp && 02347 dump_flags.mp) { 02348 02349 if (IS_DIR_CONTINUATION(Cdollar_Dir)) { 02350 02351 PP_LINE_TYPE = Dir_Continuation_Line; 02352 PP_ACTUAL_DIR_PREFIX = Cdollar_Dir; 02353 in_format = FALSE; 02354 PP_IDX = NXT_COL(3); 02355 } 02356 else { 02357 PP_LINE_TYPE = Comment_Line; 02358 } 02359 } 02360 else { 02361 02362 PP_IDX = NXT_COL(2); /* skip 'C' char */ 02363 in_format = FALSE; 02364 PP_LINE_TYPE = Dir_Line; 02365 PP_DIR_PREFIX = Cdollar_Dir; 02366 PP_ACTUAL_DIR_PREFIX = Cdollar_Dir; 02367 02368 idx = NXT_COL(3); 02369 02370 if (dump_flags.mp && 02371 is_dollar_directive(idx)) { 02372 /* intentionally blank */ 02373 } 02374 else { 02375 02376 ch = nxt_line[NXT_COL(3)]; 02377 02378 if (ch == ' ' || 02379 ch == '\t' || 02380 isdigit(ch)) { 02381 02382 PP_MP_LINE = TRUE; 02383 } 02384 02385 if ((dump_flags.mp || 02386 dump_flags.open_mp || 02387 on_off_flags.preprocess_only) && 02388 ! cmd_line_flags.disregard_conditional_omp && 02389 PP_MP_LINE) { 02390 02391 nxt_line[NXT_COL(1)] = ' '; 02392 nxt_line[NXT_COL(2)] = ' '; 02393 goto START; 02394 } 02395 else { 02396 PP_LINE_TYPE = Comment_Line; 02397 PP_MP_LINE = FALSE; 02398 } 02399 } 02400 } 02401 } 02402 # ifdef _DEBUG 02403 else if (((ch = nxt_line[NXT_COL(2)]) == uc_d || ch == lc_d) && 02404 ((ch = nxt_line[NXT_COL(3)]) == uc_b || ch == lc_b) && 02405 ((ch = nxt_line[NXT_COL(4)]) == uc_g || ch == lc_g) && 02406 ((ch = nxt_line[NXT_COL(5)]) == dollar)) { 02407 02408 PP_PREFIX_LEN = 4; 02409 02410 first_line = FALSE; 02411 02412 /* mark the sign bit of the dollar or at_sign */ 02413 02414 MARK_CHAR_CONST(nxt_line[NXT_COL(5)]); 02415 02416 if ((ch = nxt_line[NXT_COL(6)]) != blank && ch != tab) { 02417 02418 if (IS_DIR_CONTINUATION(Cdbg_Dir)) { 02419 02420 PP_LINE_TYPE = Dir_Continuation_Line; 02421 PP_ACTUAL_DIR_PREFIX = Cdbg_Dir; 02422 in_format = FALSE; 02423 PP_IDX = NXT_COL(6); 02424 } 02425 else { 02426 PP_LINE_TYPE = Comment_Line; 02427 } 02428 } 02429 else { 02430 02431 PP_IDX = NXT_COL(2); /* skip 'C' char */ 02432 in_format = FALSE; 02433 PP_LINE_TYPE = Dir_Line; 02434 PP_DIR_PREFIX = Cdbg_Dir; 02435 PP_ACTUAL_DIR_PREFIX = Cdbg_Dir; 02436 02437 idx = NXT_COL(6); 02438 } 02439 } 02440 # endif 02441 else { 02442 PP_LINE_TYPE = Comment_Line; 02443 } 02444 } 02445 else if (ch == star) { 02446 if ((ch = nxt_line[NXT_COL(2)]) == dollar && 02447 (ch = nxt_line[NXT_COL(3)]) == star) { 02448 02449 /* *$* */ 02450 02451 PP_PREFIX_LEN = 3; 02452 02453 first_line = FALSE; 02454 02455 /* mark the sign bit of the dollar or at_sign */ 02456 MARK_CHAR_CONST(nxt_line[NXT_COL(2)]); 02457 02458 02459 if ((ch = nxt_line[NXT_COL(4)]) == amp) { 02460 02461 if (IS_DIR_CONTINUATION(Cstar_Dir)) { 02462 02463 PP_LINE_TYPE = Dir_Continuation_Line; 02464 PP_ACTUAL_DIR_PREFIX = Cstar_Dir; 02465 in_format = FALSE; 02466 PP_IDX = NXT_COL(4); 02467 } 02468 else { 02469 PP_LINE_TYPE = Comment_Line; 02470 } 02471 } 02472 else { 02473 02474 PP_IDX = NXT_COL(1); 02475 in_format = FALSE; 02476 PP_LINE_TYPE = Dir_Line; 02477 PP_DIR_PREFIX = Cstar_Dir; 02478 PP_ACTUAL_DIR_PREFIX = Cstar_Dir; 02479 02480 idx = NXT_COL(4); 02481 02482 # if defined(GENERATE_WHIRL) 02483 if (! is_star_directive(idx)) { 02484 PP_LINE_TYPE = Comment_Line; 02485 } 02486 # else 02487 if ((! dump_flags.mp && 02488 ! on_off_flags.preprocess_only) || 02489 ! is_star_directive(idx)) { 02490 PP_LINE_TYPE = Comment_Line; 02491 } 02492 # endif 02493 } 02494 } 02495 else { 02496 PP_LINE_TYPE = Comment_Line; 02497 } 02498 } 02499 else if (ch == bang | ch == star) { /* column 1 '!' | '*' */ 02500 PP_LINE_TYPE = Comment_Line; 02501 } 02502 else { /* columns 2-72|80 */ 02503 /* check for tab expansion character in label or continuation field */ 02504 do { 02505 if (nxt_line[++PP_IDX] == tab) { 02506 02507 /* DEC rules for tab expansion apply in label field */ 02508 /* C2345678 -> C2345678 */ 02509 /* t1 + 27 -> 1 + 27 */ 02510 /* tI = 3 -> I = 3 */ 02511 /* 10tJ=5 -> 10 J=5 */ 02512 /* where 't' is a tab character expanded to blanks */ 02513 02514 if (IS_1TO9(nxt_line[PP_IDX+1])) { /* digits '1'..'9' */ 02515 cont_col = PP_IDX+1; 02516 } 02517 else { /* stmt in next col */ 02518 cont_col = PP_IDX; 02519 } 02520 } 02521 } 02522 while (PP_IDX < cont_col); 02523 02524 if (nxt_line[cont_col] == zero) { /* '0' NOT a continue */ 02525 nxt_line[cont_col] = blank; /* convert to a blank */ 02526 } 02527 02528 PP_IDX = NXT_COL(NULL_IDX); /* beginning of line */ 02529 02530 do { /* find 1st non-blank */ 02531 ch = nxt_line[++PP_IDX]; 02532 } 02533 while (ch == blank | ch == tab); /* skip white space */ 02534 02535 if (ch == newline) { /* blank line */ 02536 PP_EOL = PP_IDX; 02537 PP_LINE_TYPE = Comment_Line; 02538 } 02539 else if (ch == bang) { /* comment ? */ 02540 if (PP_IDX == cont_col) { /* continuation col */ 02541 PP_LINE_TYPE = Continuation_Line; 02542 } 02543 else { 02544 PP_LINE_TYPE = Comment_Line; 02545 } 02546 } 02547 else if (PP_IDX > cont_col) { /* statement columns */ 02548 PP_IDX--; /* restore position */ 02549 PP_LINE_TYPE = Regular_Line; 02550 format_idx = -1; 02551 in_format = FALSE; 02552 } 02553 else if (PP_IDX < cont_col) { /* label columns */ 02554 02555 label = TRUE; 02556 02557 /* verify that we've got numbers here */ 02558 i = PP_IDX; 02559 while (i < cont_col) { 02560 02561 if (nxt_line[i] == blank || 02562 nxt_line[i] == tab || 02563 (nxt_line[i] >= zero && nxt_line[i] <= nine)) { 02564 02565 i++; 02566 } 02567 else { 02568 label = FALSE; 02569 break; 02570 } 02571 } 02572 02573 if (label) { 02574 02575 if (nxt_line[cont_col] != blank && /* continuation too ? */ 02576 nxt_line[cont_col] != tab) { 02577 02578 /* Continuation line must not contain a label. */ 02579 02580 if (issue_classify_msg) { 02581 ntr_next_msg_queue(PP_LINE_NUM, 56, Error, 02582 nxt_line_col[PP_IDX], 02583 (char *)NULL, 02584 0, 02585 NO_ARG); 02586 } 02587 02588 PP_IDX = cont_col; /* set position */ 02589 PP_LINE_TYPE = Continuation_Line; 02590 } 02591 else { 02592 PP_LABEL = TRUE; 02593 PP_IDX--; /* restore position */ 02594 PP_LINE_TYPE = Regular_Line; 02595 format_idx = 0; /* format possible */ 02596 in_format = FALSE; 02597 } 02598 } 02599 else { 02600 02601 /* Invalid characters found in label field. */ 02602 02603 if (issue_classify_msg) { 02604 ntr_next_msg_queue(PP_LINE_NUM, 400, Error, 02605 nxt_line_col[PP_IDX], 02606 (char *)NULL, 02607 0, 02608 NO_ARG); 02609 } 02610 02611 if (nxt_line[cont_col] != blank && /* continuation too ? */ 02612 nxt_line[cont_col] != tab) { 02613 PP_IDX = cont_col; /* set position */ 02614 PP_LINE_TYPE = Continuation_Line; 02615 } 02616 else { 02617 PP_IDX = cont_col; /* set position */ 02618 PP_LINE_TYPE = Regular_Line; 02619 format_idx = -1; /* no label, no format*/ 02620 in_format = FALSE; 02621 } 02622 } 02623 } 02624 else { /* continuation col */ 02625 PP_LINE_TYPE = Continuation_Line; 02626 02627 if (! valid_f90_char[nxt_line[cont_col]] && 02628 issue_classify_msg) { 02629 err_str[0] = nxt_line[cont_col]; 02630 err_str[1] = '\0'; 02631 ntr_next_msg_queue(PP_LINE_NUM, 799, Ansi, 02632 nxt_line_col[cont_col], 02633 err_str, 02634 0, 02635 STR_ARG); 02636 } 02637 } 02638 02639 if (first_line && PP_LINE_TYPE != Comment_Line) { 02640 02641 if (PP_LINE_TYPE == Continuation_Line && issue_classify_msg) { 02642 ntr_next_msg_queue(PP_LINE_NUM, 211, Error, 02643 nxt_line_col[cont_col], 02644 (char *)NULL, 02645 0, 02646 NO_ARG); 02647 } 02648 02649 first_line = FALSE; 02650 } 02651 } 02652 02653 if (PP_LINE_TYPE == Regular_Line | 02654 PP_LINE_TYPE == Dir_Line | 02655 PP_LINE_TYPE == Dir_Continuation_Line | 02656 PP_LINE_TYPE == Continuation_Line) { 02657 idx = NXT_COL(0); 02658 02659 if (PP_LINE_TYPE != Continuation_Line && 02660 PP_LINE_TYPE != Dir_Continuation_Line) { 02661 previous_char = 0; 02662 } 02663 02664 /* check for possible format stmt first. */ 02665 /* Format_idx is both a flag and an array index. */ 02666 /* It is set to -1 when not expecting possible */ 02667 /* format stmt, set to 0 after encountering a */ 02668 /* label, and then is incremented up to 7 to test*/ 02669 /* each letter in the string. */ 02670 02671 if (format_idx >= 0) { 02672 02673 if (PP_IDX > cont_col) { 02674 idx = PP_IDX; 02675 } 02676 else { 02677 idx = cont_col; 02678 } 02679 02680 ich = nxt_line[idx]; 02681 while ((format_idx < 7) && (ich)) { 02682 02683 do { 02684 ich = nxt_line[++idx]; 02685 } 02686 while (ich == blank | ich == tab); 02687 02688 if ((ich == newline) | (ich == bang)) { 02689 PP_EOL = idx; 02690 break; 02691 } 02692 if (! ((ich == format_str[format_idx][0]) | 02693 (ich == format_str[format_idx][1]))) { 02694 format_idx = -1; 02695 idx--; 02696 break; 02697 } 02698 format_idx++; 02699 02700 } 02701 02702 if (format_idx == 7) { 02703 /* must be format stmt */ 02704 in_format = TRUE; 02705 format_idx = -1; 02706 previous_char = ich; 02707 } 02708 } /* check for format line */ 02709 02710 /* mark all characters in character constant */ 02711 if (format_idx < 0) { 02712 02713 if (PP_LINE_TYPE != Continuation_Line && 02714 PP_LINE_TYPE != Dir_Continuation_Line) { 02715 char_delim = 0; 02716 digit_start = 0; 02717 seen_lp_eq_slash = FALSE; 02718 } 02719 02720 if (idx == NXT_COL(0)) { 02721 idx = PP_IDX; 02722 } 02723 02724 if (PP_LINE_TYPE == Continuation_Line && 02725 prev_char_delim != 0 && 02726 idx == cont_col && 02727 nxt_line[idx + 1] == prev_char_delim) { 02728 02729 /* set the character context flag on both this char */ 02730 /* and the last one on the previous line. */ 02731 02732 if (nxt_line_num_lines > 1) { 02733 MARK_CHAR_CONST(nxt_line[prev_char_delim_idx]); 02734 } 02735 else { 02736 MARK_CHAR_CONST(stmt_buf[stmt_line_start_idx[lines_in_buf] + 02737 prev_char_delim_idx - 1]); 02738 } 02739 idx++; 02740 MARK_CHAR_CONST(nxt_line[idx]); 02741 nxt_line[idx] |= (1 << 9); 02742 02743 /* reset char_delim to the previous char_delim */ 02744 /* we are still in character context. */ 02745 02746 char_delim = prev_char_delim; 02747 } 02748 02749 prev_char_delim = 0; 02750 02751 /* Char_delim will hold either the character that */ 02752 /* is the string delimiter, or negative the hollerith */ 02753 /* count. */ 02754 02755 do { 02756 while (char_delim == 0) { 02757 ich = nxt_line[++idx]; 02758 02759 /* skip thru blanks */ 02760 02761 while ((ich == blank) | 02762 (ich == tab)) { 02763 ich = nxt_line[++idx]; 02764 } 02765 02766 /* Make tests on significant character.*/ 02767 /* These tests are order sensitive!! */ 02768 02769 if ((ich == newline) | 02770 (ich == bang)) { /* done for now. */ 02771 PP_EOL = idx; 02772 idx = 0; 02773 break; 02774 } 02775 02776 else if (ich == semi_colon) { /* end of stmt */ 02777 digit_start = 0; 02778 in_format = FALSE; 02779 seen_lp_eq_slash = FALSE; 02780 } 02781 02782 else if ((ich == quote) | 02783 (ich == db_quote)) { /* begin of ch const */ 02784 char_delim = ich; 02785 digit_start = 0; 02786 } 02787 02788 else if ((in_format) && (ich == star)) { /* also ch const */ 02789 char_delim = ich; 02790 digit_start = 0; 02791 } 02792 02793 else if (ich != EOF && 02794 ch_class[(char)ich] == Ch_Class_Digit) { /*possible holl*/ 02795 02796 if (digit_start == 0) { 02797 02798 if (PP_LINE_TYPE != Continuation_Line && 02799 PP_LINE_TYPE != Dir_Continuation_Line) { 02800 digit_start = idx; 02801 } 02802 else if (nxt_line_num_lines > 1) { 02803 digit_start = idx; 02804 } 02805 else { 02806 digit_start = stmt_line_end_idx[lines_in_buf] + idx; 02807 } 02808 num_idx = 0; 02809 } 02810 else { 02811 num_idx++; 02812 } 02813 if (num_idx <= 4) { 02814 num_str[num_idx] = ich; 02815 num_str[num_idx + 1] = '\0'; 02816 } 02817 /* if num_idx > 4 we've got some sort of error */ 02818 02819 continue; 02820 } 02821 02822 else if ((ich == lparen) | /* record weve seen these */ 02823 (ich == equal) | 02824 (ich == slash)) { 02825 seen_lp_eq_slash = TRUE; 02826 digit_start = 0; 02827 } 02828 02829 /* check for hollerith, already seen number, (not label) */ 02830 02831 else if ((digit_start) && (previous_char)) { 02832 if (in_format) { 02833 if ((ich == lc_h) | (ich == uc_h)) { 02834 /* have hollerith */ 02835 sscanf(num_str, "%d",&char_delim); 02836 char_delim = - char_delim; 02837 } 02838 } 02839 else if ((ich == lc_h) | 02840 (ich == lc_r) | 02841 (ich == lc_l) | 02842 (ich == uc_h) | 02843 (ich == uc_r) | 02844 (ich == uc_l)) { 02845 02846 if (previous_char == star) { 02847 02848 if (seen_lp_eq_slash) { 02849 sscanf(num_str,"%d",&char_delim); 02850 char_delim = - char_delim; 02851 } 02852 } 02853 else if (previous_char == EOF) { 02854 02855 /* definately have hollerith */ 02856 02857 sscanf(num_str,"%d",&char_delim); 02858 char_delim = - char_delim; 02859 } 02860 else if (ch_class[previous_char] != Ch_Class_Letter && 02861 previous_char != dollar && 02862 previous_char != at_sign && 02863 previous_char != underscore) { 02864 sscanf(num_str,"%d",&char_delim); 02865 char_delim = - char_delim; 02866 } 02867 } 02868 digit_start = 0; 02869 02870 } /* if digit_start */ 02871 02872 /* end of tests, record this sig char */ 02873 02874 previous_char = ich; 02875 02876 } /* while (char_delim == 0) */ 02877 02878 02879 /* found char constant so mark the characters */ 02880 02881 if (char_delim) { 02882 previous_char = ' '; 02883 02884 /* char_delim < 0 means hollerith, - (length) is stored */ 02885 02886 if (char_delim < 0) { 02887 /* I've got hollerith */ 02888 /* idx => h, r, or l */ 02889 for (; char_delim < 0; char_delim++) { 02890 if (nxt_line[++idx] == newline) { 02891 if (idx <= NXT_COL(PP_ORIG_SIZE)) { 02892 shift_to_line_size((NXT_COL(PP_ORIG_SIZE)-idx)+1); 02893 nxt_line[idx] = marked_blank; 02894 for (i = idx + 1; i <= NXT_COL(PP_ORIG_SIZE); i++) { 02895 nxt_line[i] = blank; 02896 } 02897 nxt_line[i] = newline; 02898 PP_EOL = NXT_COL(PP_ORIG_SIZE) + 1; 02899 } 02900 else { 02901 PP_EOL = idx; 02902 idx = 0; 02903 break; 02904 } 02905 } 02906 else { 02907 MARK_CHAR_CONST(nxt_line[idx]); 02908 } 02909 } /* for */ 02910 } 02911 else { 02912 02913 /* char_delim holds delimiter */ 02914 02915 while (TRUE) { 02916 if (nxt_line[++idx] == newline) { 02917 if (idx <= NXT_COL(PP_ORIG_SIZE)) { 02918 shift_to_line_size((NXT_COL(PP_ORIG_SIZE)-idx)+1); 02919 /* pad with blanks */ 02920 for (; idx <= NXT_COL(PP_ORIG_SIZE); idx++) { 02921 nxt_line[idx] = marked_blank; 02922 } 02923 nxt_line[idx] = newline; 02924 } 02925 PP_EOL = NXT_COL(PP_ORIG_SIZE) + 1; 02926 idx = 0; 02927 break; 02928 } 02929 else if (nxt_line[idx] == char_delim) { 02930 if (nxt_line[idx + 1] == char_delim) { 02931 MARK_CHAR_CONST(nxt_line[idx]); 02932 ++idx; 02933 MARK_CHAR_CONST(nxt_line[idx]); 02934 nxt_line[idx] |= (1 << 9); 02935 } 02936 else if (nxt_line[idx + 1] == newline && 02937 idx == NXT_COL(PP_ORIG_SIZE)) { 02938 02939 prev_char_delim = char_delim; 02940 prev_char_delim_idx = idx; 02941 char_delim = 0; 02942 break; 02943 } 02944 else { 02945 /* end of char constant */ 02946 char_delim = 0; 02947 break; 02948 } 02949 } else { 02950 MARK_CHAR_CONST(nxt_line[idx]); 02951 } 02952 } /* while (1) */ 02953 } 02954 02955 } /* if char_delim != 0 */ 02956 } 02957 while (idx); 02958 02959 } /* if format_idx < 0 .... mark character constants */ 02960 } /* if reg or continue line */ 02961 02962 /* check regular lines for INCLUDE "filename" line */ 02963 if (PP_LINE_TYPE == Regular_Line) { 02964 nxt_idx = cont_col; /* beginning of stmt */ 02965 02966 do { /* get 1st non-blank */ 02967 ch = nxt_line[++nxt_idx]; 02968 } 02969 while (ch == blank | ch == tab); /* skip white space */ 02970 02971 if (ch == uc_i | ch == lc_i) { /* possible include */ 02972 incl_idx = NULL_IDX; 02973 02974 do { 02975 ch_tmp = ch; 02976 if (islower(ch_tmp)) { /* lowercase char */ 02977 ch = TOUPPER(ch_tmp); /* cnvrt lwr to upr */ 02978 } 02979 include_file[incl_idx++] = ch; 02980 02981 do { /* get next non-blank */ 02982 ch = nxt_line[++nxt_idx]; 02983 } 02984 while (ch == blank | ch == tab); /* skip white space */ 02985 } 02986 while (incl_idx < 7 && ch != eos); /* get 7 chars or EOS */ 02987 02988 include_file[incl_idx] = EOS; /* terminate text str */ 02989 02990 if (EQUAL_STRS(include_file, "INCLUDE")) { /* match INCLUDE str */ 02991 if (ch == quote | ch == db_quote) { /* have include line */ 02992 PP_LINE_TYPE = Comment_Line; 02993 02994 /* get requested file name */ 02995 delim = ch; /* save delimiter */ 02996 incl_idx = NULL_IDX; 02997 02998 while ((ch = nxt_line[++nxt_idx]) != delim && ch != eos) { 02999 if (incl_idx < MAX_FILE_NAME_SIZE) { 03000 include_file[incl_idx++] = ch; 03001 } 03002 else if (incl_idx == MAX_FILE_NAME_SIZE) { 03003 03004 /* Include file name length exceeds maximum. */ 03005 03006 ntr_next_msg_queue(PP_LINE_NUM, 57, Error, 03007 nxt_line_col[nxt_idx], 03008 (char *)NULL, 03009 (MAX_FILE_NAME_SIZE - 1), 03010 ARG_ARG); 03011 } 03012 } 03013 include_file[incl_idx] = eos; /* terminate file name*/ 03014 03015 if (incl_idx == NULL_IDX) { /* Include file name missing. */ 03016 ntr_next_msg_queue(PP_LINE_NUM, 58, Error, 03017 nxt_line_col[nxt_idx], 03018 (char *)NULL, 03019 0, 03020 NO_ARG); 03021 } 03022 else if (ch == eos) { /* Missing delimiter on include file name*/ 03023 ntr_next_msg_queue(PP_LINE_NUM, 59, Error, 03024 nxt_line_col[NXT_COL(PP_ORIG_SIZE)], 03025 (char *)NULL, 03026 0, 03027 NO_ARG); 03028 } 03029 else { /* check for comments */ 03030 03031 do { 03032 ch = nxt_line[++nxt_idx]; 03033 } 03034 while (ch == blank | ch == tab);/* skip white space */ 03035 03036 if (ch != newline && ch != bang) { /* end of line */ 03037 03038 /* Text following include file name is not a comment. */ 03039 03040 ntr_next_msg_queue(PP_LINE_NUM, 60, Error, 03041 nxt_line_col[nxt_idx], 03042 (char *)NULL, 03043 0, 03044 NO_ARG); 03045 } 03046 else if (PP_IDX < cont_col) { /* check for label */ 03047 03048 /* Include line must not contain a statement label. */ 03049 03050 ntr_next_msg_queue(PP_LINE_NUM, 61, Error, 03051 nxt_line_col[PP_IDX], 03052 (char *)NULL, 03053 0, 03054 NO_ARG); 03055 } 03056 else { /* valid include line */ 03057 PP_LINE_TYPE = Include_Line; 03058 } 03059 } /* else */ 03060 } /* if */ 03061 } /* if */ 03062 } /* if */ 03063 } /* if */ 03064 03065 if (!issue_obsolete_src_form_msg && !PP_CHANGE_SOURCE_FORM && 03066 issue_classify_msg) { 03067 issue_obsolete_src_form_msg = TRUE; 03068 ntr_next_msg_queue(PP_LINE_NUM, 1582, Comment, 0, 03069 (char *)NULL, 03070 0, 03071 NO_ARG); 03072 } 03073 03074 TRACE (Func_Exit, "fixed_classify_line", line_type_str[PP_LINE_TYPE]); 03075 03076 return; 03077 03078 } /* fixed_classify_line */ 03079 03080 /******************************************************************************\ 03081 |* *| 03082 |* Description: *| 03083 |* Calls read_line to get the next line image from the currently *| 03084 |* active source file. An EOF line is returned when end of the input *| 03085 |* source file is encountered. Include lines cause a file switch. *| 03086 |* End of include files are treated as comments. *| 03087 |* *| 03088 |* The line is classified as a comment, include, dir, regular, or *| 03089 |* continuation line by calling free_classify_line. Checks involving *| 03090 |* relationships between lines (eg. continued followed by continuation) *| 03091 |* are performed here. Comment and include lines are not returned. *| 03092 |* *| 03093 |* Input parameters: *| 03094 |* expected_line Regular_Line or Continuation_Line expected. *| 03095 |* *| 03096 |* Output parameters: *| 03097 |* NONE *| 03098 |* *| 03099 |* Returns: *| 03100 |* NOTHING *| 03101 |* *| 03102 \******************************************************************************/ 03103 03104 static void free_get_stmt (void) 03105 03106 { 03107 int idx; 03108 int line_counter = 1; 03109 int loc_stmt_num; 03110 int save_idx; 03111 int stmt_buf_EOS; 03112 03113 TRACE (Func_Entry, "free_get_stmt", NULL); 03114 03115 /* Issue any deferred src_input messages. */ 03116 03117 issue_deferred_msgs(); 03118 03119 03120 if (stmt_buf_type == EOF_Line) { 03121 /* Attempt to read past end of file */ 03122 PRINTMSG (0, 50, Internal, 0); /* all done now */ 03123 } 03124 03125 stmt_line_idx = NULL_IDX; 03126 stmt_buf_idx = NULL_IDX; 03127 lines_in_buf = 0; 03128 label_ok = TRUE; 03129 03130 /* loop while stmt continues */ 03131 do { 03132 03133 save_idx = 0; 03134 03135 /* add nxt_line to stmt_buf */ 03136 03137 stmt_line_num[++stmt_line_idx] = nxt_line_num; 03138 03139 /* stmt_line_offset holds offset to first significant char of line */ 03140 03141 if (starting_pt) { 03142 stmt_line_offset[stmt_line_idx] = starting_pt - 2; 03143 } 03144 else { 03145 stmt_line_offset[stmt_line_idx] = nxt_line_idx - 1; 03146 } 03147 03148 /* stmt_line_start_idx points to where line starts in stmt_buf */ 03149 03150 stmt_line_start_idx[stmt_line_idx] = line_counter; 03151 03152 /* stmt_line_end_idx points to newline, bang or ampersand */ 03153 03154 stmt_line_end_idx[stmt_line_idx] = nxt_line_EOL + line_counter - 1; 03155 03156 /* record the statement type */ 03157 03158 if (nxt_line_type != Continuation_Line && 03159 nxt_line_type != Dir_Continuation_Line) { 03160 stmt_buf_type = nxt_line_type; 03161 03162 if (nxt_line_type == Dir_Line) { 03163 stmt_prefix_len = nxt_line_prefix_len; 03164 stmt_buf_dir_prefix = nxt_line_dir_prefix; 03165 } 03166 03167 if (stmt_buf_type != Comment_Line && 03168 stmt_buf_type != Pound_Src_Line && 03169 stmt_buf_type != Pound_Include_Exit_Line) { 03170 INCREMENT_STATEMENT_NUMBER; 03171 } 03172 } 03173 03174 if (stmt_buf_type == Dir_Line) { 03175 line_dir_prefix[stmt_line_idx] = nxt_line_actual_dir_prefix; 03176 } 03177 03178 move_up_next_msg_queue(); 03179 03180 /* copy nxt_line to proper part of stmt_buf, backwards */ 03181 03182 stmt_buf_idx = line_counter + nxt_line_EOL - 1; 03183 line_counter += nxt_line_EOL; 03184 03185 for (idx = nxt_line_EOL; idx > 0; idx --) { 03186 stmt_buf[stmt_buf_idx] = nxt_line[NXT_COL(idx)]; 03187 stmt_buf_col[stmt_buf_idx] = nxt_line_col[NXT_COL(idx)]; 03188 stmt_buf_idx--; 03189 03190 if (havent_issued_tab_ansi && 03191 idx < nxt_line_EOL && 03192 nxt_line[NXT_COL(idx)] == tab) { 03193 havent_issued_tab_ansi = FALSE; 03194 ntr_msg_queue(nxt_line_num, 899, Ansi, 03195 nxt_line_col[NXT_COL(idx)], 03196 (char *)NULL, 03197 0, 03198 NO_ARG); 03199 } 03200 03201 if (nxt_line[NXT_COL(idx)] == semi_colon && 03202 stmt_buf_type != Dir_Line) { 03203 if ((idx > starting_pt) && (idx < nxt_line_EOL)) { 03204 save_idx = idx; 03205 } 03206 } 03207 } 03208 03209 lines_in_buf++; 03210 03211 /* save_idx is the point in nxt_line where the next ';' is */ 03212 /* If there is a semi_colon then I don't replace nxt_line */ 03213 /* or classify it again. I simply recopy nxt_line into the */ 03214 /* stmt_buf and start processing after the ;. */ 03215 /* Must check if nxt_line_type is a comment line because */ 03216 /* when an include file ends, comment lines come through. */ 03217 03218 if (save_idx && 03219 nxt_line_type != Comment_Line) { 03220 03221 stmt_buf_EOS = save_idx; 03222 idx = save_idx; 03223 while ((nxt_line[NXT_COL(idx)] == semi_colon) | 03224 (nxt_line[NXT_COL(idx)] == blank) | 03225 (nxt_line[NXT_COL(idx)] == tab)) { 03226 idx++; 03227 } 03228 03229 /* starting_pt is the idx I start processing the next time around */ 03230 03231 starting_pt = idx; 03232 nxt_line_type = Regular_Line; 03233 continuation_count = 0; /* clear cont counter */ 03234 include_found = FALSE; /* and include flags */ 03235 include_complete = FALSE; 03236 } 03237 else { 03238 stmt_buf_EOS = nxt_line_EOL; 03239 starting_pt = NULL_IDX; 03240 } 03241 03242 03243 /* don't read past end of source file */ 03244 /* and don't get new nxt_line if had semi-colon. */ 03245 03246 if ((stmt_buf_type != EOF_Line) && 03247 (starting_pt == NULL_IDX)) { 03248 03249 /* get next line from src input file */ 03250 do { 03251 03252 nxt_line_type = Regular_Line; 03253 03254 if (get_nxt_line ()) { /* read next src line */ 03255 03256 if (include_switch) { 03257 update_global_line (); /* enter global_line_tbl */ 03258 include_switch = FALSE; 03259 } 03260 03261 if (issue_pound_exit_line) { 03262 OUTPUT_POUND_INCLUDE_EXIT_LINE(curr_glb_line); 03263 issue_pound_exit_line = FALSE; 03264 } 03265 03266 nxt_line_mp_line = FALSE; 03267 03268 if (nxt_line_type != Cond_Comp_Line) { 03269 PP_ORIG_SIZE = line_size; 03270 classify_line(); 03271 } 03272 03273 if (on_off_flags.save_dot_i) { 03274 03275 if (ignore_source_line || 03276 nxt_line_type == Cond_Comp_Line || 03277 nxt_line_type == Include_Line) { 03278 03279 /* print blank line */ 03280 fprintf(dot_i_fptr, "\n"); 03281 previous_global_line++; 03282 } 03283 else { 03284 print_nxt_line(); 03285 } 03286 } 03287 03288 switch (nxt_line_type) { 03289 case Comment_Line: /* ignore comments */ 03290 break; 03291 03292 case Cond_Comp_Line: 03293 if (parse_cc_line()) { 03294 03295 /* if result is true, then it was an include line */ 03296 03297 nxt_line_type = Include_Line; 03298 include_stmt_file_line = SRC_STK_FILE_LINE(src_stk_idx); 03299 03300 if (open_include_file (TRUE)) { 03301 include_found = TRUE; /* flag begin of file */ 03302 include_switch = TRUE; /* flag file switch */ 03303 } 03304 } 03305 else { 03306 nxt_line_type = Comment_Line; 03307 } 03308 angle_brkt_include = FALSE; 03309 break; 03310 03311 case Dir_Line: 03312 case Regular_Line: 03313 continuation_count = 0; /* clear cont counter */ 03314 include_found = FALSE; /* and include flags */ 03315 include_complete = FALSE; 03316 break; 03317 03318 case Continuation_Line: 03319 case Dir_Continuation_Line: 03320 03321 if (++continuation_count == MAX_ANSI_FREE_LINES) { 03322 03323 /* Too many continuation lines is non-standard in form. */ 03324 03325 ntr_msg_queue(nxt_line_num, 52, Ansi, 03326 nxt_line_idx, 03327 "free", 03328 (MAX_ANSI_FREE_LINES - 1), 03329 ARG_STR_ARG); 03330 } 03331 03332 if (continuation_count == MAX_FREE_LINES) { 03333 03334 /* this is it. I cn give ya na more powr cap'n */ 03335 03336 ntr_msg_queue(nxt_line_num, 525, Error, 03337 CONTINUE_COLUMN, 03338 (char *)NULL, 03339 0, 03340 NO_ARG); 03341 } 03342 03343 if (continuation_count >= MAX_FREE_LINES) { 03344 nxt_line_type = Comment_Line; 03345 break; 03346 } 03347 03348 if (include_found) { 03349 03350 /* First line of included file must not be a cont line */ 03351 03352 ntr_msg_queue(nxt_line_num, 53, Error, 03353 nxt_line_idx, 03354 (char *)NULL, 03355 0, 03356 NO_ARG); 03357 03358 include_found = FALSE; 03359 } 03360 03361 if (include_complete) { 03362 03363 /* Nxt line of file after include must not be a cont line*/ 03364 03365 ntr_msg_queue(nxt_line_num, 54, Error, 03366 nxt_line_idx, 03367 (char *)NULL, 03368 0, 03369 NO_ARG); 03370 03371 include_complete = FALSE; 03372 } 03373 03374 if (cif_flags & MISC_RECS) { 03375 cif_cont_line_rec( 03376 (nxt_line_type == Continuation_Line) ? 0 : 1, 03377 nxt_line_num); 03378 } 03379 03380 break; 03381 03382 case Pound_Src_Line: 03383 break; 03384 03385 case Pound_Include_Exit_Line: 03386 include_complete = TRUE; 03387 nxt_line_type = Comment_Line; 03388 curr_glb_line--; 03389 SRC_STK_FILE_LINE(src_stk_idx)--; 03390 GL_SOURCE_LINES(SRC_STK_GLOBAL_LINE_IDX(src_stk_idx)) = 03391 SRC_STK_FILE_LINE(src_stk_idx); 03392 set_related_gl_source_lines( 03393 SRC_STK_GLOBAL_LINE_IDX(src_stk_idx)); 03394 03395 if (source_form != SRC_STK_PREV_SRC_FORM(src_stk_idx)) { 03396 change_source_form = TRUE; 03397 } 03398 POP_SRC; 03399 include_switch = TRUE; 03400 break; 03401 03402 case Pound_Include_Enter_Line: 03403 case Include_Line: 03404 03405 include_stmt_file_line = SRC_STK_FILE_LINE(src_stk_idx); 03406 03407 if (open_include_file (FALSE)) { 03408 include_found = TRUE; /* flag begin of file */ 03409 include_switch = TRUE; /* flag file switch */ 03410 } 03411 break; 03412 } /* switch */ 03413 } 03414 else { /* EOF on source file */ 03415 03416 /* need to bump pp_line_idx since classify_line was not called */ 03417 03418 if (cmd_line_flags.pp_macro_expansion) { 03419 pp_line_idx++; 03420 } 03421 03422 if (expected_line == Continuation_Line) { 03423 ntr_msg_queue(stmt_line_num[lines_in_buf], 539, Error, 03424 stmt_line_end_idx[lines_in_buf] - 03425 stmt_line_start_idx[lines_in_buf] + 1, 03426 (char *)NULL, 03427 0, 03428 NO_ARG); 03429 } 03430 03431 /* check for termination of include file */ 03432 03433 if (src_stk_idx > SRC_STK_BASE_IDX) { /* curr src is include*/ 03434 include_complete = TRUE; /* flag end of file */ 03435 nxt_line_type = Comment_Line; /* make EOF a comment */ 03436 nxt_line_EOL = 2; 03437 curr_glb_line--; /* don't count this line */ 03438 03439 GL_SOURCE_LINES(SRC_STK_GLOBAL_LINE_IDX(src_stk_idx)) = 03440 SRC_STK_FILE_LINE(src_stk_idx); 03441 set_related_gl_source_lines( 03442 SRC_STK_GLOBAL_LINE_IDX(src_stk_idx)); 03443 03444 if (source_form != SRC_STK_PREV_SRC_FORM(src_stk_idx)) { 03445 change_source_form = TRUE; 03446 } 03447 POP_SRC; 03448 include_switch = TRUE; /* flag file switch */ 03449 issue_pound_exit_line = TRUE; 03450 break; 03451 } 03452 else { /* curr src is input */ 03453 GL_SOURCE_LINES(SRC_STK_GLOBAL_LINE_IDX(src_stk_idx)) = 03454 SRC_STK_FILE_LINE(src_stk_idx); 03455 set_related_gl_source_lines( 03456 SRC_STK_GLOBAL_LINE_IDX(src_stk_idx)); 03457 nxt_line_type = EOF_Line; /* end of compilation */ 03458 nxt_line_EOL = 2; 03459 } 03460 } 03461 } 03462 while (nxt_line_type == Comment_Line | 03463 nxt_line_type == Include_Line | 03464 nxt_line_type == Pound_Include_Enter_Line); 03465 } 03466 } 03467 while (nxt_line_type == Continuation_Line || 03468 nxt_line_type == Dir_Continuation_Line); 03469 03470 if (prev_statement_number != statement_number) { 03471 loc_stmt_num = statement_number; 03472 statement_number = prev_statement_number; 03473 prev_statement_number = loc_stmt_num; 03474 } 03475 03476 stmt_buf_EOS_idx = stmt_line_start_idx[lines_in_buf] + stmt_buf_EOS - 1; 03477 stmt_EOS_la_ch.line = stmt_line_num[lines_in_buf]; 03478 stmt_EOS_la_ch.column = stmt_buf_col[stmt_buf_EOS_idx]; 03479 stmt_EOS_la_ch.stmt_buf_idx = stmt_buf_EOS_idx; 03480 stmt_EOS_la_ch.stmt_num = statement_number; 03481 03482 stmt_buf_idx = stmt_line_offset[1] + 1; 03483 stmt_line_idx = SRC_STK_BASE_IDX; 03484 03485 PRINT_STMT_SRC(); /* If DEBUG and -u src or -u stmt set print source */ 03486 03487 TRACE (Func_Exit, "free_get_stmt", NULL); 03488 03489 return; 03490 03491 } /* free_get_stmt */ 03492 03493 /******************************************************************************\ 03494 |* *| 03495 |* Description: *| 03496 |* The line in the input buffer is classified as a comment, include, *| 03497 |* dir, continuation or regular line. Free source form rules apply. *| 03498 |* *| 03499 |* Input parameters: *| 03500 |* expected_line Regular_Line or Continuation_Line expected. *| 03501 |* *| 03502 |* Output parameters: *| 03503 |* NONE *| 03504 |* *| 03505 |* Returns: *| 03506 |* NOTHING *| 03507 |* *| 03508 \******************************************************************************/ 03509 03510 static void free_classify_line (void) 03511 03512 { 03513 int ch; 03514 char delim; 03515 char form[5] = " "; 03516 boolean had_amp = FALSE; 03517 int i; 03518 int ich; 03519 int idx; 03520 int incl_idx; 03521 boolean label_found = FALSE; 03522 int line_num; 03523 char line_num_str[24]; 03524 int save_curr_glb_line; 03525 int src_idx; 03526 int sv_amp; 03527 03528 03529 03530 TRACE (Func_Entry, "free_classify_line", NULL); 03531 03532 PP_EOL = nxt_line_end_idx[pp_line_idx] - 1; 03533 PP_EXPECTED_LINE = expected_line; 03534 03535 03536 START: 03537 03538 ch = nxt_line[NXT_COL(1)]; 03539 03540 # ifdef _FRONTEND_CONDITIONAL_COMP 03541 if (ch == pound && 03542 on_off_flags.preprocess) { 03543 03544 PP_LINE_TYPE = Cond_Comp_Line; 03545 } else 03546 # endif 03547 if (is_pound_line_dir()) { 03548 PP_IDX = NXT_COL(2); 03549 ch = nxt_line[PP_IDX]; 03550 03551 while (ch == blank | ch == tab) { 03552 PP_IDX++; 03553 ch = nxt_line[PP_IDX]; 03554 } 03555 03556 if (isdigit(ch)) { 03557 idx = 0; 03558 line_num_str[idx++] = ch; 03559 ch = nxt_line[++PP_IDX]; 03560 while (isdigit(ch)) { 03561 line_num_str[idx++] = ch; 03562 ch = nxt_line[++PP_IDX]; 03563 } 03564 03565 line_num_str[idx] = '\0'; 03566 line_num = atoi(line_num_str); 03567 03568 while (ch == blank | ch == tab) { 03569 PP_IDX++; 03570 ch = nxt_line[PP_IDX]; 03571 } 03572 03573 if (ch == quote | ch == db_quote) { 03574 char_delim = ch; 03575 ch = nxt_line[++PP_IDX]; 03576 03577 idx = 0; 03578 while (ch != char_delim) { 03579 include_file[idx++] = ch; 03580 ch = nxt_line[++PP_IDX]; 03581 } 03582 include_file[idx] = '\0'; 03583 03584 ch = nxt_line[++PP_IDX]; 03585 while (ch == blank | ch == tab) { 03586 PP_IDX++; 03587 ch = nxt_line[PP_IDX]; 03588 } 03589 03590 if (ch == '1') { 03591 PP_LINE_TYPE = Pound_Include_Enter_Line; 03592 } 03593 else if (ch == '2') { 03594 PP_LINE_TYPE = Pound_Include_Exit_Line; 03595 } 03596 else { 03597 PP_LINE_TYPE = Comment_Line; 03598 03599 /* reset the curr_glb_line */ 03600 /* line_num is a file line, not a global line */ 03601 03602 save_curr_glb_line = curr_glb_line; 03603 curr_glb_line = line_num + GL_GLOBAL_LINE(global_line_tbl_idx) - 03604 GL_FILE_LINE(global_line_tbl_idx); 03605 curr_glb_line--; 03606 03607 if (first_pound_line) { 03608 PP_LINE_TYPE = Pound_Src_Line; 03609 change_orig_src_file = TRUE; 03610 strcpy(pound_file, include_file); 03611 } 03612 else { 03613 SRC_STK_FILE_LINE(src_stk_idx) += 03614 curr_glb_line - save_curr_glb_line; 03615 } 03616 } 03617 03618 first_pound_line = FALSE; 03619 03620 } 03621 else if (ch == newline) { 03622 03623 PP_LINE_TYPE = Comment_Line; 03624 03625 /* reset the curr_glb_line */ 03626 /* line_num is a file line, not a global line */ 03627 03628 save_curr_glb_line = curr_glb_line; 03629 curr_glb_line = line_num + GL_GLOBAL_LINE(global_line_tbl_idx) - 03630 GL_FILE_LINE(global_line_tbl_idx); 03631 curr_glb_line--; 03632 03633 SRC_STK_FILE_LINE(src_stk_idx) += 03634 curr_glb_line - save_curr_glb_line; 03635 03636 first_pound_line = FALSE; 03637 } 03638 else { 03639 PP_LINE_TYPE = Comment_Line; 03640 } 03641 } 03642 else { 03643 PP_LINE_TYPE = Comment_Line; 03644 } 03645 } 03646 else if (ignore_source_line) { 03647 PP_LINE_TYPE = Comment_Line; 03648 } 03649 else { 03650 03651 PP_IDX = NXT_COL(NULL_IDX); /* beginning of line */ 03652 03653 do { /* find 1st non-blank */ 03654 ch = nxt_line[++PP_IDX]; 03655 } 03656 while (ch == blank || ch == tab); /* skip white space */ 03657 03658 switch (ch) { /* handle special ch */ 03659 case BANG: /* directive ? */ 03660 if (((ch = nxt_line[PP_IDX+1]) == uc_d || ch == lc_d) && 03661 ((ch = nxt_line[PP_IDX+2]) == uc_i || ch == lc_i) && 03662 ((ch = nxt_line[PP_IDX+3]) == uc_r || ch == lc_r) && 03663 ((ch = nxt_line[PP_IDX+4]) == dollar || ch == at_sign)) { 03664 03665 PP_PREFIX_LEN = 4; 03666 03667 /* mark the sign bit of the dollar and at_sign */ 03668 MARK_CHAR_CONST(nxt_line[PP_IDX+4]); 03669 03670 if (nxt_line[PP_IDX+5] == zero) { 03671 nxt_line[PP_IDX+5] = blank; 03672 } 03673 03674 if (issue_classify_msg && 03675 expected_line == Continuation_Line) { 03676 03677 ntr_next_msg_queue(PP_LINE_NUM, 1656, Error, nxt_line_col[PP_IDX], 03678 (char *)NULL, 03679 0, 03680 NO_ARG); 03681 expected_line = Regular_Line; 03682 PP_EXPECTED_LINE = expected_line; 03683 } 03684 03685 if ((ch = nxt_line[PP_IDX+5]) != blank && ch != tab) { 03686 03687 if (IS_DIR_CONTINUATION(Cdir_Dir)) { 03688 03689 PP_LINE_TYPE = Dir_Continuation_Line; 03690 PP_ACTUAL_DIR_PREFIX = Cdir_Dir; 03691 in_format = FALSE; 03692 PP_IDX = PP_IDX+5; 03693 } 03694 else { 03695 PP_LINE_TYPE = Comment_Line; 03696 } 03697 } 03698 else { 03699 PP_IDX++; /* skip '!' char */ 03700 PP_LINE_TYPE = Dir_Line; 03701 PP_DIR_PREFIX = Cdir_Dir; 03702 PP_ACTUAL_DIR_PREFIX = Cdir_Dir; 03703 in_format = FALSE; 03704 03705 idx = PP_IDX + 4; 03706 do { 03707 ch = nxt_line[++idx]; 03708 } 03709 while (ch == blank | ch == tab); 03710 03711 if (ch == lc_f | ch == uc_f) { 03712 for (i = 0; i < 5; i++) { 03713 ch = nxt_line[++idx]; 03714 03715 if (ch == newline) { 03716 break; 03717 } 03718 03719 if (islower(ch)) { 03720 form[i] = TOUPPER(ch); 03721 } 03722 else { 03723 form[i] = ch; 03724 } 03725 } 03726 03727 if (strncmp(form, "IXED ", 5) == 0 && 03728 !disregard_directive[Tok_Dir_Fixed-Tok_Dir_Start]) { 03729 PP_CHANGE_SOURCE_FORM = TRUE; 03730 03731 if (!issue_obsolete_src_form_msg && issue_classify_msg) { 03732 ntr_next_msg_queue(PP_LINE_NUM, 1582, Comment, 0, 03733 (char *)NULL, 03734 0, 03735 NO_ARG); 03736 issue_obsolete_src_form_msg = TRUE; 03737 } 03738 } 03739 } 03740 } 03741 } 03742 else if (((ch = nxt_line[PP_IDX+1]) == uc_m || ch == lc_m) && 03743 ((ch = nxt_line[PP_IDX+2]) == uc_i || ch == lc_i) && 03744 ((ch = nxt_line[PP_IDX+3]) == uc_c || ch == lc_c) && 03745 ((ch = nxt_line[PP_IDX+4]) == dollar || ch == at_sign)) { 03746 03747 PP_PREFIX_LEN = 4; 03748 03749 /* mark the sign bit of the dollar and at_sign */ 03750 MARK_CHAR_CONST(nxt_line[PP_IDX+4]); 03751 03752 if (issue_classify_msg && 03753 expected_line == Continuation_Line) { 03754 03755 ntr_next_msg_queue(PP_LINE_NUM, 1656, Error, nxt_line_col[PP_IDX], 03756 (char *)NULL, 03757 0, 03758 NO_ARG); 03759 expected_line = Regular_Line; 03760 PP_EXPECTED_LINE = expected_line; 03761 } 03762 03763 if ((ch = nxt_line[PP_IDX+5]) != blank && ch != tab) { 03764 03765 if (IS_DIR_CONTINUATION(Cmic_Dir)) { 03766 03767 PP_LINE_TYPE = Dir_Continuation_Line; 03768 PP_ACTUAL_DIR_PREFIX = Cmic_Dir; 03769 in_format = FALSE; 03770 PP_IDX = PP_IDX+5; 03771 } 03772 else { 03773 PP_LINE_TYPE = Comment_Line; 03774 } 03775 } 03776 else { 03777 PP_IDX++; /* skip '!' char */ 03778 PP_LINE_TYPE = Dir_Line; 03779 PP_DIR_PREFIX = Cmic_Dir; 03780 PP_ACTUAL_DIR_PREFIX = Cmic_Dir; 03781 in_format = FALSE; 03782 03783 idx = NXT_COL(6); 03784 } 03785 } 03786 else if (((ch = nxt_line[PP_IDX+1]) == dollar) && 03787 ((ch = nxt_line[PP_IDX+2]) == uc_o || ch == lc_o) && 03788 ((ch = nxt_line[PP_IDX+3]) == uc_m || ch == lc_m) && 03789 ((ch = nxt_line[PP_IDX+4]) == uc_p || ch == lc_p)) { 03790 03791 /* !$omp */ 03792 03793 PP_PREFIX_LEN = 4; 03794 03795 /* mark the sign bit of the dollar and at_sign */ 03796 MARK_CHAR_CONST(nxt_line[PP_IDX+1]); 03797 03798 if (issue_classify_msg && 03799 dump_flags.open_mp && 03800 expected_line == Continuation_Line) { 03801 03802 ntr_next_msg_queue(PP_LINE_NUM, 1656, Error, nxt_line_col[PP_IDX], 03803 (char *)NULL, 03804 0, 03805 NO_ARG); 03806 expected_line = Regular_Line; 03807 PP_EXPECTED_LINE = expected_line; 03808 } 03809 03810 if (expected_line == Dir_Continuation_Line) { 03811 03812 PP_EXPECTED_LINE = Regular_Line; 03813 03814 if (IS_DIR_CONTINUATION(Comp_Dir)) { 03815 03816 PP_LINE_TYPE = Dir_Continuation_Line; 03817 PP_ACTUAL_DIR_PREFIX = Comp_Dir; 03818 in_format = FALSE; 03819 PP_IDX = PP_IDX+5; 03820 03821 src_idx = PP_IDX; 03822 03823 do { 03824 ch = nxt_line[++src_idx]; /* get next src char */ 03825 } 03826 while (ch == blank || ch == tab); 03827 03828 if (ch == AMP) { 03829 03830 PP_IDX = src_idx; 03831 03832 do { 03833 ch = nxt_line[++src_idx]; 03834 } 03835 while (ch == blank || ch == tab); 03836 03837 if (ch == newline || ch == bang) { 03838 PP_EOL = src_idx; 03839 03840 /* Cont lines must contain text following */ 03841 /* the & in free src form. */ 03842 03843 if (issue_classify_msg) { 03844 ntr_next_msg_queue(PP_LINE_NUM, 71, Ansi, 03845 nxt_line_col[src_idx], 03846 (char *)NULL, 03847 0, 03848 NO_ARG); 03849 } 03850 03851 PP_LINE_TYPE = Comment_Line; 03852 } 03853 03854 had_amp = TRUE; 03855 } 03856 } 03857 else { 03858 PP_LINE_TYPE = Comment_Line; 03859 } 03860 } 03861 else if ((ch = nxt_line[PP_IDX+5]) != blank && ch != tab) { 03862 PP_LINE_TYPE = Comment_Line; 03863 } 03864 else { 03865 idx = PP_IDX+5; 03866 PP_IDX++; /* skip '!' char */ 03867 PP_LINE_TYPE = Dir_Line; 03868 PP_DIR_PREFIX = Comp_Dir; 03869 PP_ACTUAL_DIR_PREFIX = Comp_Dir; 03870 in_format = FALSE; 03871 03872 # if ! defined(_TARGET_OS_MAX) 03873 if (! dump_flags.open_mp && 03874 ! on_off_flags.preprocess_only) { 03875 PP_LINE_TYPE = Comment_Line; 03876 } 03877 # endif 03878 } 03879 } 03880 # if defined(GENERATE_WHIRL) 03881 else if (((ch = nxt_line[PP_IDX+1]) == dollar) && 03882 ((ch = nxt_line[PP_IDX+2]) == uc_s || ch == lc_s) && 03883 ((ch = nxt_line[PP_IDX+3]) == uc_g || ch == lc_g) && 03884 ((ch = nxt_line[PP_IDX+4]) == uc_i || ch == lc_i)) { 03885 03886 /* !$sgi */ 03887 03888 PP_PREFIX_LEN = 4; 03889 03890 /* mark the sign bit of the dollar and at_sign */ 03891 MARK_CHAR_CONST(nxt_line[PP_IDX+1]); 03892 03893 if (issue_classify_msg && 03894 dump_flags.open_mp && 03895 expected_line == Continuation_Line) { 03896 03897 ntr_next_msg_queue(PP_LINE_NUM, 1656, Error, nxt_line_col[PP_IDX], 03898 (char *)NULL, 03899 0, 03900 NO_ARG); 03901 expected_line = Regular_Line; 03902 PP_EXPECTED_LINE = expected_line; 03903 } 03904 03905 if (expected_line == Dir_Continuation_Line) { 03906 03907 PP_EXPECTED_LINE = Regular_Line; 03908 03909 if (IS_DIR_CONTINUATION(Comp_Dir)) { 03910 03911 PP_LINE_TYPE = Dir_Continuation_Line; 03912 PP_ACTUAL_DIR_PREFIX = Csgi_Dir; 03913 in_format = FALSE; 03914 PP_IDX = PP_IDX+5; 03915 03916 src_idx = PP_IDX; 03917 03918 do { 03919 ch = nxt_line[++src_idx]; /* get next src char */ 03920 } 03921 while (ch == blank || ch == tab); 03922 03923 if (ch == AMP) { 03924 03925 PP_IDX = src_idx; 03926 03927 do { 03928 ch = nxt_line[++src_idx]; 03929 } 03930 while (ch == blank || ch == tab); 03931 03932 if (ch == newline || ch == bang) { 03933 PP_EOL = src_idx; 03934 03935 /* Cont lines must contain text following */ 03936 /* the & in free src form. */ 03937 03938 if (issue_classify_msg) { 03939 ntr_next_msg_queue(PP_LINE_NUM, 71, Ansi, 03940 nxt_line_col[src_idx], 03941 (char *)NULL, 03942 0, 03943 NO_ARG); 03944 } 03945 03946 PP_LINE_TYPE = Comment_Line; 03947 } 03948 03949 had_amp = TRUE; 03950 } 03951 } 03952 else { 03953 PP_LINE_TYPE = Comment_Line; 03954 } 03955 } 03956 else if ((ch = nxt_line[PP_IDX+5]) != blank && ch != tab) { 03957 PP_LINE_TYPE = Comment_Line; 03958 } 03959 else { 03960 idx = PP_IDX+5; 03961 PP_IDX++; /* skip '!' char */ 03962 PP_LINE_TYPE = Dir_Line; 03963 PP_DIR_PREFIX = Comp_Dir; 03964 PP_ACTUAL_DIR_PREFIX = Csgi_Dir; 03965 in_format = FALSE; 03966 03967 if (! dump_flags.open_mp && 03968 ! on_off_flags.preprocess_only) { 03969 PP_LINE_TYPE = Comment_Line; 03970 } 03971 } 03972 } 03973 else if (((ch = nxt_line[PP_IDX+1]) == dollar) && 03974 ((ch = nxt_line[PP_IDX+2]) == uc_o || ch == lc_o) && 03975 ((ch = nxt_line[PP_IDX+3]) == uc_p || ch == lc_p) && 03976 ((ch = nxt_line[PP_IDX+4]) == uc_e || ch == lc_e) && 03977 ((ch = nxt_line[PP_IDX+5]) == uc_n || ch == lc_n) && 03978 ((ch = nxt_line[PP_IDX+6]) == uc_a || ch == lc_a) && 03979 ((ch = nxt_line[PP_IDX+7]) == uc_d || ch == lc_d)) { 03980 03981 /* eraxxon: OpenAD directive */ 03982 /* !$OpenAD */ 03983 03984 PP_PREFIX_LEN = 7; 03985 03986 /* mark the sign bit of the dollar and at_sign */ 03987 MARK_CHAR_CONST(nxt_line[PP_IDX+1]); 03988 03989 if (issue_classify_msg && 03990 dump_flags.open_mp && 03991 expected_line == Continuation_Line) { 03992 03993 ntr_next_msg_queue(PP_LINE_NUM, 1656, Error, nxt_line_col[PP_IDX], 03994 (char *)NULL, 03995 0, 03996 NO_ARG); 03997 expected_line = Regular_Line; 03998 PP_EXPECTED_LINE = expected_line; 03999 } 04000 04001 if (expected_line == Dir_Continuation_Line) { 04002 04003 PP_EXPECTED_LINE = Regular_Line; 04004 04005 if (IS_DIR_CONTINUATION(Copenad_Dir)) { 04006 04007 PP_LINE_TYPE = Dir_Continuation_Line; 04008 PP_ACTUAL_DIR_PREFIX = Copenad_Dir; 04009 in_format = FALSE; 04010 PP_IDX = PP_IDX+8; 04011 04012 src_idx = PP_IDX; 04013 04014 do { 04015 ch = nxt_line[++src_idx]; /* get next src char */ 04016 } 04017 while (ch == blank || ch == tab); 04018 04019 if (ch == AMP) { 04020 04021 PP_IDX = src_idx; 04022 04023 do { 04024 ch = nxt_line[++src_idx]; 04025 } 04026 while (ch == blank || ch == tab); 04027 04028 if (ch == newline || ch == bang) { 04029 PP_EOL = src_idx; 04030 04031 /* Cont lines must contain text following */ 04032 /* the & in free src form. */ 04033 04034 if (issue_classify_msg) { 04035 ntr_next_msg_queue(PP_LINE_NUM, 71, Ansi, 04036 nxt_line_col[src_idx], 04037 (char *)NULL, 04038 0, 04039 NO_ARG); 04040 } 04041 04042 PP_LINE_TYPE = Comment_Line; 04043 } 04044 04045 had_amp = TRUE; 04046 } 04047 } 04048 else { 04049 PP_LINE_TYPE = Comment_Line; 04050 } 04051 } 04052 else if ((ch = nxt_line[PP_IDX+8]) != blank && ch != tab) { 04053 PP_LINE_TYPE = Comment_Line; 04054 } 04055 else { 04056 idx = PP_IDX+8; 04057 PP_IDX++; /* skip '!' char */ 04058 PP_LINE_TYPE = Dir_Line; 04059 PP_DIR_PREFIX = Copenad_Dir; 04060 PP_ACTUAL_DIR_PREFIX = Copenad_Dir; 04061 in_format = FALSE; 04062 } 04063 } 04064 # endif 04065 else if (((ch = nxt_line[PP_IDX+1]) == dollar) && 04066 ((ch = nxt_line[PP_IDX+2]) == uc_p || ch == lc_p) && 04067 ((ch = nxt_line[PP_IDX+3]) == uc_a || ch == lc_a) && 04068 ((ch = nxt_line[PP_IDX+4]) == uc_r || ch == lc_r)) { 04069 04070 /* !$par */ 04071 04072 PP_PREFIX_LEN = 4; 04073 04074 /* mark the sign bit of the dollar and at_sign */ 04075 MARK_CHAR_CONST(nxt_line[PP_IDX+1]); 04076 04077 if (issue_classify_msg && 04078 expected_line == Continuation_Line && 04079 dump_flags.mp && 04080 is_par_directive(PP_IDX+5)) { 04081 04082 ntr_next_msg_queue(PP_LINE_NUM, 1656, Error, nxt_line_col[PP_IDX], 04083 (char *)NULL, 04084 0, 04085 NO_ARG); 04086 expected_line = Regular_Line; 04087 PP_EXPECTED_LINE = expected_line; 04088 } 04089 04090 if ((ch = nxt_line[PP_IDX+5]) == amp) { 04091 04092 if (IS_DIR_CONTINUATION(Cpar_Dir)) { 04093 04094 PP_LINE_TYPE = Dir_Continuation_Line; 04095 PP_ACTUAL_DIR_PREFIX = Cpar_Dir; 04096 in_format = FALSE; 04097 PP_IDX = PP_IDX+5; 04098 } 04099 else { 04100 PP_LINE_TYPE = Comment_Line; 04101 } 04102 } 04103 else { 04104 idx = PP_IDX+5; 04105 PP_IDX++; /* skip '!' char */ 04106 PP_LINE_TYPE = Dir_Line; 04107 PP_DIR_PREFIX = Cpar_Dir; 04108 PP_ACTUAL_DIR_PREFIX = Cpar_Dir; 04109 in_format = FALSE; 04110 04111 if ((! dump_flags.mp && 04112 ! on_off_flags.preprocess_only) || 04113 ! is_par_directive(idx)) { 04114 PP_LINE_TYPE = Comment_Line; 04115 } 04116 } 04117 } 04118 else if (((ch = nxt_line[PP_IDX+1]) == star) && 04119 ((ch = nxt_line[PP_IDX+2]) == dollar) && 04120 ((ch = nxt_line[PP_IDX+3]) == star)) { 04121 04122 /* !*$* */ 04123 04124 PP_PREFIX_LEN = 3; 04125 04126 /* mark the sign bit of the dollar and at_sign */ 04127 MARK_CHAR_CONST(nxt_line[PP_IDX+2]); 04128 04129 if (issue_classify_msg && 04130 expected_line == Continuation_Line && 04131 dump_flags.mp && 04132 is_star_directive(PP_IDX+4)) { 04133 04134 ntr_next_msg_queue(PP_LINE_NUM, 1656, Error, nxt_line_col[PP_IDX], 04135 (char *)NULL, 04136 0, 04137 NO_ARG); 04138 expected_line = Regular_Line; 04139 PP_EXPECTED_LINE = expected_line; 04140 } 04141 04142 if ((ch = nxt_line[PP_IDX+4]) == amp) { 04143 04144 if (IS_DIR_CONTINUATION(Cstar_Dir)) { 04145 04146 PP_LINE_TYPE = Dir_Continuation_Line; 04147 PP_ACTUAL_DIR_PREFIX = Cstar_Dir; 04148 in_format = FALSE; 04149 PP_IDX = PP_IDX+4; 04150 } 04151 else { 04152 PP_LINE_TYPE = Comment_Line; 04153 } 04154 } 04155 else { 04156 idx = PP_IDX+4; 04157 PP_IDX++; /* skip '!' char */ 04158 PP_LINE_TYPE = Dir_Line; 04159 PP_DIR_PREFIX = Cstar_Dir; 04160 PP_ACTUAL_DIR_PREFIX = Cstar_Dir; 04161 in_format = FALSE; 04162 04163 # if defined(GENERATE_WHIRL) 04164 if (! is_star_directive(idx)) { 04165 PP_LINE_TYPE = Comment_Line; 04166 } 04167 # else 04168 if ((! dump_flags.mp && 04169 ! on_off_flags.preprocess_only) || 04170 ! is_star_directive(idx)) { 04171 PP_LINE_TYPE = Comment_Line; 04172 } 04173 # endif 04174 } 04175 } 04176 else if ((ch = nxt_line[PP_IDX+1]) == dollar) { 04177 04178 /* !$ */ 04179 04180 PP_PREFIX_LEN = 1; 04181 04182 /* mark the sign bit of the dollar and at_sign */ 04183 MARK_CHAR_CONST(nxt_line[PP_IDX+1]); 04184 04185 if ((ch = nxt_line[PP_IDX+2]) == amp && 04186 dump_flags.mp && 04187 IS_DIR_CONTINUATION(Cdollar_Dir)) { 04188 04189 PP_LINE_TYPE = Dir_Continuation_Line; 04190 PP_ACTUAL_DIR_PREFIX = Cdollar_Dir; 04191 in_format = FALSE; 04192 PP_IDX = PP_IDX+2; 04193 } 04194 else { 04195 idx = PP_IDX+2; 04196 PP_IDX++; /* skip '!' char */ 04197 PP_LINE_TYPE = Dir_Line; 04198 PP_DIR_PREFIX = Cdollar_Dir; 04199 PP_ACTUAL_DIR_PREFIX = Cdollar_Dir; 04200 in_format = FALSE; 04201 04202 if (dump_flags.mp && 04203 is_dollar_directive(idx)) { 04204 04205 if (issue_classify_msg && 04206 expected_line == Continuation_Line) { 04207 04208 ntr_next_msg_queue(PP_LINE_NUM, 1656, Error, 04209 nxt_line_col[PP_IDX], 04210 (char *)NULL, 04211 0, 04212 NO_ARG); 04213 expected_line = Regular_Line; 04214 PP_EXPECTED_LINE = expected_line; 04215 } 04216 } 04217 else { 04218 04219 ch = nxt_line[idx]; 04220 04221 if (ch == ' ' || 04222 ch == '\t' || 04223 ch == amp || 04224 isdigit(ch)) { 04225 04226 PP_MP_LINE = TRUE; 04227 } 04228 04229 if ((dump_flags.mp || 04230 dump_flags.open_mp || 04231 on_off_flags.preprocess_only) && 04232 ! cmd_line_flags.disregard_conditional_omp && 04233 PP_MP_LINE) { 04234 04235 nxt_line[PP_IDX - 1] = ' '; 04236 nxt_line[PP_IDX] = ' '; 04237 goto START; 04238 } 04239 else { 04240 PP_LINE_TYPE = Comment_Line; 04241 PP_MP_LINE = FALSE; 04242 } 04243 } 04244 } 04245 } 04246 # ifdef _DEBUG 04247 else if (((ch = nxt_line[PP_IDX+1]) == uc_d || ch == lc_d) && 04248 ((ch = nxt_line[PP_IDX+2]) == uc_b || ch == lc_b) && 04249 ((ch = nxt_line[PP_IDX+3]) == uc_g || ch == lc_g) && 04250 ((ch = nxt_line[PP_IDX+4]) == dollar)) { 04251 04252 PP_PREFIX_LEN = 4; 04253 04254 /* mark the sign bit of the dollar and at_sign */ 04255 MARK_CHAR_CONST(nxt_line[PP_IDX+4]); 04256 04257 if ((ch = nxt_line[PP_IDX+5]) != blank && ch != tab) { 04258 04259 if (IS_DIR_CONTINUATION(Cdbg_Dir)) { 04260 04261 PP_LINE_TYPE = Dir_Continuation_Line; 04262 PP_ACTUAL_DIR_PREFIX = Cdbg_Dir; 04263 in_format = FALSE; 04264 PP_IDX = PP_IDX+5; 04265 } 04266 else { 04267 PP_LINE_TYPE = Comment_Line; 04268 } 04269 } 04270 else { 04271 PP_IDX++; /* skip '!' char */ 04272 PP_LINE_TYPE = Dir_Line; 04273 PP_DIR_PREFIX = Cdbg_Dir; 04274 PP_ACTUAL_DIR_PREFIX = Cdbg_Dir; 04275 in_format = FALSE; 04276 04277 idx = NXT_COL(6); 04278 } 04279 } 04280 # endif 04281 else { 04282 PP_LINE_TYPE = Comment_Line; 04283 } 04284 break; 04285 04286 case NEWLINE: /* blank line */ 04287 PP_LINE_TYPE = Comment_Line; 04288 break; 04289 04290 case AMP: /* continuation ? */ 04291 if (expected_line == Continuation_Line) { /* expected */ 04292 04293 /* make sure line doesn't begin with '& \n' or '& !' */ 04294 src_idx = PP_IDX; 04295 04296 do { 04297 ch = nxt_line[++src_idx]; /* get next src char */ 04298 } 04299 while (ch == blank || ch == tab); /* skip white space */ 04300 04301 if (ch == newline || ch == bang) { 04302 PP_EOL = src_idx; 04303 04304 /* Cont lines must contain text following the & in free src form. */ 04305 04306 if (issue_classify_msg) { 04307 ntr_next_msg_queue(PP_LINE_NUM, 71, Ansi, 04308 nxt_line_col[src_idx], 04309 (char *)NULL, 04310 0, 04311 NO_ARG); 04312 } 04313 04314 PP_LINE_TYPE = Comment_Line; 04315 } 04316 else { 04317 PP_LINE_TYPE = Continuation_Line; 04318 /* PP_IDX++; */ /* skip past & */ 04319 } 04320 04321 had_amp = TRUE; 04322 } 04323 else { /* unexpected */ 04324 /* Continuation line may only follow a line continued with the &. */ 04325 if (issue_classify_msg) { 04326 ntr_next_msg_queue(PP_LINE_NUM, 703, Error, 04327 nxt_line_col[PP_IDX], 04328 (char *)NULL, 04329 0, 04330 NO_ARG); 04331 } 04332 04333 PP_LINE_TYPE = Comment_Line; 04334 } 04335 break; 04336 04337 default: 04338 if (expected_line == Continuation_Line) { /* continue expected */ 04339 04340 if (char_delim != 0 && issue_classify_msg) { 04341 /* message about starting & missing */ 04342 ntr_next_msg_queue(PP_LINE_NUM, 505, Error, 04343 nxt_line_col[PP_IDX], 04344 (char *)NULL, 04345 0, 04346 NO_ARG); 04347 } 04348 PP_IDX = NXT_COL(NULL_IDX); /* col 1 is 1st char */ 04349 PP_LINE_TYPE = Continuation_Line; 04350 } 04351 else { 04352 PP_IDX--; /* reset position */ 04353 PP_LINE_TYPE = Regular_Line; 04354 04355 /* check regular lines for INCLUDE "filename" line */ 04356 src_idx = PP_IDX; /* beginning of stmt */ 04357 04358 do { /* get 1st non-blank */ 04359 ch = nxt_line[++src_idx]; 04360 04361 if (isdigit(ch)) { /* labeled stmt */ 04362 label_found = TRUE; /* save for later */ 04363 ch = blank; /* keep looking */ 04364 } 04365 } 04366 while (ch == blank || ch == tab); /* skip label/spaces */ 04367 04368 if (ch == 'I' || ch == 'i') { /* possible include */ 04369 incl_idx = NULL_IDX; 04370 04371 do { 04372 if (islower(ch)) { /* lowercase char */ 04373 ch = TOUPPER(ch); /* cnvrt lwr to upr */ 04374 } 04375 include_file[incl_idx++] = ch; 04376 ch = nxt_line[++src_idx]; /* get next src char */ 04377 } 04378 while (incl_idx < 7 && ch != eos); /* get 7 chars or EOS */ 04379 04380 include_file[incl_idx] = EOS; /* terminate text str */ 04381 04382 if (EQUAL_STRS(include_file, "INCLUDE")) { /* match INCLUDE str */ 04383 do { /* get next non-blank */ 04384 ch = nxt_line[++src_idx]; 04385 } 04386 while (ch == blank || ch == tab); /* skip white space */ 04387 04388 if (ch == quote || ch == db_quote) { /* have include line */ 04389 PP_LINE_TYPE = Comment_Line; 04390 04391 /* get requested file name */ 04392 delim = ch; /* save delimiter */ 04393 incl_idx = NULL_IDX; 04394 04395 while ((ch = nxt_line[++src_idx]) != delim && ch != eos) { 04396 if (incl_idx < MAX_FILE_NAME_SIZE) { 04397 include_file[incl_idx++] = ch; 04398 } 04399 else if (incl_idx == MAX_FILE_NAME_SIZE) { 04400 04401 /* Include file name length exceeds maximum */ 04402 04403 ntr_next_msg_queue(PP_LINE_NUM, 57, Error, 04404 nxt_line_col[src_idx], 04405 (char *)NULL, 04406 (MAX_FILE_NAME_SIZE - 1), 04407 ARG_ARG); 04408 } 04409 } 04410 include_file[incl_idx] = EOS; /* terminate file name*/ 04411 04412 if (incl_idx == NULL_IDX) { /* missing file name */ 04413 04414 /* Include file name missing. */ 04415 04416 ntr_next_msg_queue(PP_LINE_NUM, 58, Error, 04417 nxt_line_col[src_idx], 04418 (char *)NULL, 04419 0, 04420 NO_ARG); 04421 } 04422 else if (ch == eos) { /* missing delimiter */ 04423 04424 /* Missing delimiter on include file name. */ 04425 04426 ntr_next_msg_queue(PP_LINE_NUM, 59, Error, 04427 nxt_line_col[NXT_COL(PP_ORIG_SIZE)], 04428 (char *)NULL, 04429 0, 04430 NO_ARG); 04431 } 04432 else { /* check for comments */ 04433 04434 do { 04435 ch = nxt_line[++src_idx]; 04436 } 04437 while (ch == blank || ch == tab);/* skip white space */ 04438 04439 if (ch != newline && ch != bang) { /* end of line */ 04440 04441 /* Text following include file name is not a comment. */ 04442 04443 ntr_next_msg_queue(PP_LINE_NUM, 60, Error, 04444 nxt_line_col[src_idx], 04445 (char *)NULL, 04446 0, 04447 NO_ARG); 04448 } 04449 else if (label_found) { /* check for label */ 04450 04451 /* Include line must not contain a statement label. */ 04452 04453 ntr_next_msg_queue(PP_LINE_NUM, 61, Error, 04454 nxt_line_col[PP_IDX], 04455 (char *)NULL, 04456 0, 04457 NO_ARG); 04458 } 04459 else { /* valid include line */ 04460 PP_LINE_TYPE = Include_Line; 04461 } 04462 } /* else */ 04463 } /* if */ 04464 } /* if */ 04465 } /* if */ 04466 } /* else */ 04467 break; 04468 } /* switch */ 04469 } /* else */ 04470 04471 if (PP_LINE_TYPE != Comment_Line && 04472 PP_LINE_TYPE != Cond_Comp_Line && 04473 PP_LINE_TYPE != Dir_Line) { 04474 PP_EXPECTED_LINE = Regular_Line; 04475 } 04476 04477 /* mark character constants */ 04478 /* must check for format stmt after every ; also */ 04479 04480 /* check for possible format stmt first. */ 04481 /* Format_idx is both a flag and an array index. */ 04482 /* It is set to -1 when not expecting possible */ 04483 /* format stmt, set to 0 after encountering a */ 04484 /* label, and then is incremented up to 7 to test*/ 04485 /* each letter in the string. */ 04486 04487 /* Char_delim will hold either the character that */ 04488 /* is the string delimiter, or negative the hollerith */ 04489 /* count. */ 04490 04491 04492 if (PP_LINE_TYPE == Regular_Line | 04493 PP_LINE_TYPE == Dir_Line | 04494 PP_LINE_TYPE == Dir_Continuation_Line | 04495 PP_LINE_TYPE == Continuation_Line) { 04496 04497 if (PP_LINE_TYPE != Continuation_Line && 04498 PP_LINE_TYPE != Dir_Continuation_Line) { 04499 seen_lp_eq_slash = FALSE; 04500 char_delim = 0; 04501 digit_start = 0; 04502 previous_char = 0; 04503 format_idx = -1; 04504 in_format = FALSE; 04505 } 04506 04507 idx = PP_IDX; 04508 04509 if (PP_LINE_TYPE == Continuation_Line && 04510 prev_char_delim != 0 && 04511 had_amp && 04512 nxt_line[idx + 1] == prev_char_delim) { 04513 04514 /* set the character context flag on both this char */ 04515 /* and the last one on the previous line. */ 04516 04517 if (nxt_line_num_lines > 1) { 04518 MARK_CHAR_CONST(nxt_line[prev_char_delim_idx]); 04519 } 04520 else { 04521 MARK_CHAR_CONST(stmt_buf[stmt_line_start_idx[lines_in_buf] + 04522 prev_char_delim_idx - 1]); 04523 } 04524 idx++; 04525 MARK_CHAR_CONST(nxt_line[idx]); 04526 nxt_line[idx] |= (1 << 9); 04527 04528 /* reset char_delim to the previous char_delim */ 04529 /* we are still in character context. */ 04530 04531 char_delim = prev_char_delim; 04532 } 04533 04534 prev_char_delim = 0; 04535 04536 04537 do { 04538 while (char_delim == 0) { 04539 ich = nxt_line[++idx]; 04540 04541 /* skip thru blanks, noting that a blank kills possible */ 04542 /* format match in free form. */ 04543 04544 if (ich == blank | ich == tab) { 04545 if ((format_idx > 0) && (format_idx < 6)) { 04546 format_idx = -1; 04547 } 04548 ich = nxt_line[++idx]; 04549 04550 while ((ich == blank) | 04551 (ich == tab)) { 04552 ich = nxt_line[++idx]; 04553 } 04554 } 04555 04556 /* make tests on significant character */ 04557 04558 if ((ich == newline) | 04559 (ich == bang)) { /* done for now. */ 04560 PP_EOL = idx; 04561 idx = 0; 04562 break; 04563 } 04564 04565 else if (ich == semi_colon) { /* end of stmt */ 04566 in_format = FALSE; 04567 format_idx = -1; 04568 seen_lp_eq_slash = FALSE; 04569 digit_start = 0; 04570 } 04571 04572 else if (ich == amp) { /* test for continue */ 04573 PP_EOL = idx; 04574 ich = nxt_line[++idx]; 04575 04576 while ((ich == blank) | 04577 (ich == tab)) { 04578 ich = nxt_line[++idx]; 04579 } 04580 if (ich == newline | ich == bang) { 04581 04582 if (PP_LINE_TYPE == Dir_Line || 04583 PP_LINE_TYPE == Dir_Continuation_Line) { 04584 04585 PP_EXPECTED_LINE = Dir_Continuation_Line; 04586 } 04587 else { 04588 PP_EXPECTED_LINE = Continuation_Line; 04589 } 04590 idx = 0; 04591 break; 04592 } 04593 else { 04594 format_idx = -1; 04595 idx--; 04596 } 04597 } 04598 04599 else if ((ich == quote) | 04600 (ich == db_quote)) { /* begin of ch const */ 04601 char_delim = ich; 04602 digit_start = 0; 04603 format_idx = -1; 04604 } 04605 04606 else if ((in_format) && (ich == star)) { /* also ch const */ 04607 char_delim = ich; 04608 digit_start = 0; 04609 format_idx = -1; 04610 } 04611 04612 else if (ich != (char) EOF && ch_class[(char) ich] == Ch_Class_Digit) { 04613 04614 if ((previous_char == 0) | (previous_char == semi_colon)) { 04615 04616 /* then this is a label */ 04617 04618 format_idx = 0; 04619 digit_start = -1; 04620 } 04621 else if (digit_start >= 0) { 04622 format_idx = -1; 04623 if (digit_start == 0) { 04624 if (PP_LINE_TYPE != Continuation_Line && 04625 PP_LINE_TYPE != Dir_Continuation_Line) { 04626 digit_start = idx; 04627 } 04628 else if (nxt_line_num_lines > 1) { 04629 digit_start = idx; 04630 } 04631 else { 04632 digit_start = stmt_line_end_idx[lines_in_buf] + idx; 04633 } 04634 num_idx = 0; 04635 } 04636 else { 04637 num_idx++; 04638 } 04639 if (num_idx <= 4) { 04640 num_str[num_idx] = ich; 04641 num_str[num_idx + 1] = '\0'; 04642 } 04643 /* if num_idx > 4 we've got some sort of error */ 04644 04645 continue; 04646 } 04647 } 04648 04649 else if (format_idx >= 0) { /* match format str */ 04650 digit_start = 0; 04651 if (! ((ich == format_str[format_idx][0]) | 04652 (ich == format_str[format_idx][1]))) { 04653 format_idx = -1; 04654 idx--; 04655 continue; 04656 } 04657 else if (format_idx == 6) { 04658 in_format = TRUE; 04659 format_idx = -1; 04660 seen_lp_eq_slash = TRUE; 04661 } 04662 else { 04663 format_idx++; 04664 } 04665 } 04666 04667 else if ((ich == lparen) | 04668 (ich == equal) | 04669 (ich == slash)) { /* record weve seen these */ 04670 seen_lp_eq_slash = TRUE; 04671 format_idx = -1; 04672 digit_start = 0; 04673 } 04674 04675 /* check for hollerith, already seen number, (not label) */ 04676 04677 else if ((digit_start > 0) && (previous_char)) { 04678 format_idx = -1; 04679 if (in_format) { 04680 if ((ich == lc_h) | (ich == uc_h)) { 04681 /* have hollerith */ 04682 sscanf(num_str, "%d",&char_delim); 04683 char_delim = - char_delim; 04684 } 04685 } 04686 else if ((ich == lc_h) | 04687 (ich == lc_r) | 04688 (ich == lc_l) | 04689 (ich == uc_h) | 04690 (ich == uc_r) | 04691 (ich == uc_l)) { 04692 04693 if (previous_char == star) { 04694 04695 if (seen_lp_eq_slash) { 04696 sscanf(num_str,"%d",&char_delim); 04697 char_delim = - char_delim; 04698 } 04699 } 04700 else if (previous_char == EOF) { 04701 sscanf(num_str,"%d",&char_delim); 04702 char_delim = - char_delim; 04703 } 04704 else if (ch_class[previous_char] != Ch_Class_Letter && 04705 previous_char != dollar && 04706 previous_char != at_sign && 04707 previous_char != underscore) { 04708 sscanf(num_str,"%d",&char_delim); 04709 char_delim = - char_delim; 04710 } 04711 } 04712 digit_start = 0; 04713 04714 } /* if digit_start */ 04715 04716 /* end of tests, record this sig char */ 04717 04718 previous_char = ich; 04719 04720 } /* while (char_delim == 0) */ 04721 04722 /* found char constant so mark the characters */ 04723 04724 if (char_delim) { 04725 previous_char = ' '; 04726 04727 /* char_delim < 0 means hollerith, - (length) is stored */ 04728 04729 if (char_delim < 0) { 04730 /* I've got hollerith */ 04731 /* idx => h, r, or l */ 04732 for (; char_delim < 0; char_delim++) { 04733 if (nxt_line[++idx] == newline) { 04734 if (idx <= NXT_COL(PP_ORIG_SIZE)) { 04735 shift_to_line_size((NXT_COL(PP_ORIG_SIZE)-idx)+1); 04736 nxt_line[idx] = marked_blank; 04737 for (i = idx + 1; i <= NXT_COL(PP_ORIG_SIZE); i++) { 04738 nxt_line[i] = blank; 04739 } 04740 nxt_line[i] = newline; 04741 PP_EOL = NXT_COL(PP_ORIG_SIZE) + 1; 04742 } 04743 else { 04744 PP_EOL = idx; 04745 idx = 0; 04746 break; 04747 } 04748 } 04749 else if (nxt_line[idx] == amp) { 04750 PP_EOL = idx; 04751 sv_amp = idx; 04752 ich = nxt_line[++idx]; 04753 04754 while ((ich == blank) | 04755 (ich == tab)) { 04756 ich = nxt_line[++idx]; 04757 } 04758 04759 if (ich == newline) { 04760 04761 if (PP_LINE_TYPE == Dir_Line || 04762 PP_LINE_TYPE == Dir_Continuation_Line) { 04763 04764 PP_EXPECTED_LINE = Dir_Continuation_Line; 04765 } 04766 else { 04767 PP_EXPECTED_LINE = Continuation_Line; 04768 } 04769 idx = 0; 04770 break; 04771 } 04772 else { 04773 idx = sv_amp; 04774 MARK_CHAR_CONST(nxt_line[idx]); 04775 } 04776 } 04777 else { 04778 MARK_CHAR_CONST(nxt_line[idx]); 04779 } 04780 } /* for */ 04781 } 04782 else { 04783 04784 /* char_delim holds delimiter */ 04785 04786 while (1) { 04787 if (nxt_line[++idx] == newline) { 04788 if (idx <= NXT_COL(PP_ORIG_SIZE)) { 04789 shift_to_line_size((NXT_COL(PP_ORIG_SIZE)-idx)+1); 04790 /* pad with blanks */ 04791 for (; idx <= NXT_COL(PP_ORIG_SIZE); idx++) { 04792 nxt_line[idx] = marked_blank; 04793 } 04794 nxt_line[idx] = newline; 04795 } 04796 PP_EOL = NXT_COL(PP_ORIG_SIZE) + 1; 04797 idx = 0; 04798 break; 04799 } 04800 else if (nxt_line[idx] == char_delim) { 04801 if (nxt_line[idx + 1] == char_delim) { 04802 MARK_CHAR_CONST(nxt_line[idx]); 04803 ++idx; 04804 MARK_CHAR_CONST(nxt_line[idx]); 04805 nxt_line[idx] |= (1 << 9); 04806 } 04807 else if (nxt_line[idx + 1] == amp) { 04808 prev_char_delim = char_delim; 04809 prev_char_delim_idx = idx; 04810 char_delim = 0; 04811 break; 04812 } 04813 else { 04814 /* end of char constant */ 04815 char_delim = 0; 04816 break; 04817 } 04818 } 04819 else if (nxt_line[idx] == amp) { 04820 PP_EOL = idx; 04821 sv_amp = idx; 04822 ich = nxt_line[++idx]; 04823 04824 while ((ich == blank) | 04825 (ich == tab)) { 04826 ich = nxt_line[++idx]; 04827 } 04828 04829 if (ich == newline) { 04830 04831 if (PP_LINE_TYPE == Dir_Line || 04832 PP_LINE_TYPE == Dir_Continuation_Line) { 04833 04834 PP_EXPECTED_LINE = Dir_Continuation_Line; 04835 } 04836 else { 04837 PP_EXPECTED_LINE = Continuation_Line; 04838 } 04839 idx = 0; 04840 break; 04841 } 04842 else { 04843 idx = sv_amp; 04844 MARK_CHAR_CONST(nxt_line[idx]); 04845 } 04846 } 04847 else { 04848 MARK_CHAR_CONST(nxt_line[idx]); 04849 } 04850 } /* while (1) */ 04851 } 04852 04853 } /* if char_delim != 0 */ 04854 } 04855 while (idx); 04856 04857 } /* if reg or continue line */ 04858 04859 TRACE (Func_Exit, "free_classify_line", line_type_str[PP_LINE_TYPE]); 04860 04861 return; 04862 04863 } /* free_classify_line */ 04864 04865 04866 /******************************************************************************\ 04867 |* *| 04868 |* Description: *| 04869 |* Open_include_file attempts to locate and open the requested include *| 04870 |* file. The src_stk is checked to prevent recursive use of the file. *| 04871 |* *| 04872 |* Input parameters: *| 04873 |* NONE *| 04874 |* *| 04875 |* Output parameters: *| 04876 |* NONE *| 04877 |* *| 04878 |* Returns: *| 04879 |* TRUE if include file is found and opened successfully, else FALSE *| 04880 |* *| 04881 \******************************************************************************/ 04882 04883 static boolean open_include_file (boolean pound_include_line) 04884 04885 { 04886 char *char_ptr; 04887 int cif_file_id; 04888 int i; 04889 int include_idx; 04890 int include_file_len = 0; 04891 FILE *include_file_ptr = NULL; 04892 char include_path[MAX_PATH_NAME_SIZE]; 04893 int include_path_len = 0; 04894 boolean more = TRUE; 04895 boolean recursive_use = FALSE; 04896 boolean result = FALSE; 04897 int save_stmt_start_line; 04898 int save_stmt_start_col; 04899 int src_stk_i; 04900 char str[MAX_PATH_NAME_SIZE+10]; 04901 04902 # if 0 04903 int full_include_name_len; 04904 int prev_include_idx; 04905 # endif 04906 04907 04908 TRACE (Func_Entry, "open_include_file", NULL); 04909 04910 statement_number++; 04911 04912 if (! cif_file_rec_issued ) { 04913 /* If CIF records have been requested, output the Source File record. */ 04914 /* Always output a File Name record for the source file. */ 04915 04916 c_i_f = cif_actual_file; 04917 SRC_STK_CIF_FILE_ID(SRC_STK_BASE_IDX) = 04918 cif_file_name_rec(SRC_STK_PATH_NAME(SRC_STK_BASE_IDX), src_file); 04919 04920 if (cif_flags) { 04921 cif_source_file_rec(SRC_STK_CIF_FILE_ID(SRC_STK_BASE_IDX), 04922 cmd_line_flags.src_form); 04923 } 04924 04925 c_i_f = cif_tmp_file; 04926 cif_file_rec_issued = TRUE; 04927 04928 /* Set the line numbers in this entry correctly. */ 04929 /* Always set GL_CIF_FILE_ID; it's needed for buffered message output. */ 04930 04931 GL_CIF_FILE_ID(global_line_tbl_idx) = 04932 SRC_STK_CIF_FILE_ID(SRC_STK_BASE_IDX); 04933 } 04934 04935 if (nxt_line_type == Pound_Include_Enter_Line) { 04936 if (include_file[0] != SLASH) { 04937 getcwd (include_path, MAX_FILE_NAME_SIZE); 04938 strcat (include_path, "/"); 04939 include_path_len = strlen(include_path); 04940 strcat (include_path, include_file); 04941 } 04942 else { 04943 include_path_len = 0; 04944 strcpy (include_path, include_file); 04945 } 04946 04947 /* use previous file ptr */ 04948 include_file_ptr = SRC_STK_FILE_PTR(src_stk_idx); 04949 } 04950 else if (include_file[0] == SLASH) /* absolute path name */ 04951 { 04952 include_path_len = 0; /* path prefix len */ 04953 include_file_len = strlen(include_file); 04954 strcpy (include_path, include_file); 04955 04956 /* attempt to open include file for input */ 04957 04958 include_file_ptr = fopen (include_path, "r"); 04959 } 04960 else { /* find directory */ 04961 04962 include_file_len = strlen (include_file); /* file name length */ 04963 include_idx = include_path_idx; /* glb idx to start */ 04964 04965 if (angle_brkt_include) { 04966 if (include_idx != NULL_IDX) { 04967 strcpy (include_path, FP_NAME_PTR(include_idx)); 04968 include_idx = FP_NEXT_FILE_IDX(include_idx); 04969 } 04970 else { 04971 /* nothing to search */ 04972 more = FALSE; 04973 } 04974 } 04975 else { 04976 strcpy(include_path, SRC_STK_PATH_NAME(src_stk_idx)); 04977 04978 /* Find out if there is a directory separator in the current name */ 04979 04980 char_ptr = strrchr(include_path, SLASH); 04981 04982 if (char_ptr == NULL) { /* No path precedes the name */ 04983 char_ptr = include_path; 04984 *char_ptr++ = '.'; 04985 } 04986 *char_ptr = EOS; 04987 04988 } 04989 04990 /* Append file_name to each directory name in include search list. */ 04991 04992 while (more) { 04993 include_path_len = strlen(include_path) + 1; 04994 04995 /* don't bother checking path names greater than max length */ 04996 04997 if ((include_path_len + include_file_len) < MAX_PATH_NAME_SIZE) { 04998 strcat (include_path, "/"); 04999 strcat (include_path, include_file); 05000 05001 /* attempt to open include file for input */ 05002 include_file_ptr = fopen (include_path, "r"); 05003 } 05004 05005 if (include_file_ptr != NULL || include_idx == NULL_IDX) { 05006 break; 05007 } 05008 05009 strcpy (include_path, FP_NAME_PTR(include_idx)); 05010 include_idx = FP_NEXT_FILE_IDX(include_idx); 05011 } 05012 } 05013 05014 if (on_off_flags.output_pound_lines && 05015 (on_off_flags.preprocess_only || on_off_flags.save_dot_i)) { 05016 05017 if (cmd_line_flags.pp_macro_expansion) { 05018 nxt_line_start_idx[nxt_line_num_lines+1] = 05019 nxt_line_end_idx[nxt_line_num_lines]+1; 05020 nxt_line_num_lines++; 05021 pp_line_idx++; 05022 PP_LINE_TYPE = Comment_Line; 05023 PP_LINE_NUM = curr_glb_line; 05024 PP_EXPECTED_LINE = Regular_Line; 05025 05026 sprintf(str, "# 1 \"%s\" 1\n", include_path); 05027 05028 i = 0; 05029 while (str[i] != '\0') { 05030 nxt_line[nxt_line_start_idx[nxt_line_num_lines] + i] = str[i]; 05031 i++; 05032 } 05033 05034 nxt_line[nxt_line_start_idx[nxt_line_num_lines] + i] = '\0'; 05035 nxt_line_end_idx[nxt_line_num_lines] = 05036 nxt_line_start_idx[nxt_line_num_lines] + i; 05037 } 05038 else { 05039 fprintf(dot_i_fptr, "# 1 \"%s\" 1\n", include_path); 05040 } 05041 } 05042 05043 /* Make sure records associated with the INCLUDE line are buffered because */ 05044 /* the INCLUDE line is always processed in "lookahead" mode which means */ 05045 /* the records belong to a following program unit in cases like this: */ 05046 /* ... */ 05047 /* END */ 05048 /* SUBROUTINE sub */ 05049 /* INCLUDE '...' */ 05050 /* The INCLUDE line is processed when the EOS at the end of the END stmt */ 05051 /* is eaten. */ 05052 /* If cif_need_unit_rec is TRUE, the current CIF is the temp CIF so don't */ 05053 /* change it. c_i_f is switched back the actual file a ways down. */ 05054 05055 if (! cif_need_unit_rec) { 05056 c_i_f = cif_tmp_file; 05057 } 05058 05059 save_stmt_start_line = stmt_start_line; 05060 save_stmt_start_col = stmt_start_col; 05061 stmt_start_line = nxt_line_num; 05062 stmt_start_col = nxt_line_idx + 1; 05063 if (cif_flags & MISC_RECS) { 05064 cif_stmt_type_rec(TRUE, CIF_Include_Stmt, statement_number); 05065 } 05066 stmt_start_line = save_stmt_start_line; 05067 stmt_start_col = save_stmt_start_col; 05068 05069 05070 # if 0 05071 05072 /* 05073 * Although the following code that ensures that a single File Name record 05074 * is produced no matter how many times the name appears in INCLUDE lines 05075 * is the "correct" thing to do (this is the way it's documented), it is 05076 * commented out for now because we use the file id as the Source Position 05077 * record source id and this makes the source id *not* unique. That is, 05078 * we end up with multiple Source Position records with the same source 05079 * id. When all the visual tools get upgraded to CIF Version 3, then 05080 * they'll start using the Source Position records (which means the source 05081 * position ids will come from a counter separate from the file ids) and 05082 * we can go back to using this code. That will mean that several Source 05083 * Position records (with unique source position ids) will point to the 05084 * same file id (back to a unique File Name record). 05085 * So for now, go back to the old lazy way of just slamming out a File Name 05086 * record each time a file name is seen. 05087 */ 05088 05089 05090 /* If this fully expanded INCLUDE file name has not been encountered */ 05091 /* before then call cif_file_name_rec in order to get the next CIF file */ 05092 /* id. Otherwise, use the file id already assigned to this file. */ 05093 /* It's saved away (farther below) in the source stack so that buffered */ 05094 /* message processing can use it at the end of the compilation. */ 05095 05096 full_include_name_len = include_path_len + include_file_len; 05097 include_idx = full_include_name_idx; 05098 prev_include_idx = NULL_IDX; 05099 05100 while (include_idx != NULL_IDX) { 05101 05102 if (FP_NAME_LEN(include_idx) == full_include_name_len && 05103 EQUAL_STRS(include_path, FP_NAME_PTR(include_idx))) { 05104 break; 05105 } 05106 else { 05107 prev_include_idx = include_idx; 05108 include_idx = FP_NEXT_FILE_IDX(include_idx); 05109 } 05110 } 05111 05112 if (include_idx == NULL_IDX) { 05113 TBL_REALLOC_CK(file_path_tbl, 1); 05114 CLEAR_TBL_NTRY(file_path_tbl, file_path_tbl_idx); 05115 05116 if (full_include_name_idx == NULL_IDX) { 05117 full_include_name_idx = file_path_tbl_idx; 05118 } 05119 else { 05120 FP_NEXT_FILE_IDX(prev_include_idx) = file_path_tbl_idx; 05121 } 05122 05123 FP_NAME_IDX(file_path_tbl_idx) = str_pool_idx + 1; 05124 FP_NAME_LEN(file_path_tbl_idx) = full_include_name_len; 05125 05126 TBL_REALLOC_CK(str_pool, WORD_LEN(full_include_name_len)); 05127 05128 str_pool[str_pool_idx].name_long = 0; /* Zero out last word. */ 05129 05130 strcpy(FP_NAME_PTR(file_path_tbl_idx), include_path); 05131 05132 cif_file_id = cif_file_name_rec(include_path, include_file); 05133 FP_CIF_ID(file_path_tbl_idx) = cif_file_id; 05134 } 05135 else { 05136 cif_file_id = FP_CIF_ID(include_idx); 05137 } 05138 05139 # endif 05140 05141 /* Delete the following line when the above code is reinstated. */ 05142 05143 cif_file_id = cif_file_name_rec(include_path, include_file); 05144 05145 05146 if (nxt_line_type != Pound_Include_Enter_Line && 05147 ! pound_include_line) { 05148 for (i = nxt_line_idx + 8; /* The char following INCLUDE. */ 05149 nxt_line[NXT_COL(i)] != QUOTE && 05150 nxt_line[NXT_COL(i)] != DBL_QUOTE && 05151 i < nxt_line_idx + line_size; 05152 ++i) { 05153 } 05154 05155 include_stmt_file_col = ++i; 05156 } 05157 else { 05158 /* since this is from an "# lineno 'file.f' " line, */ 05159 /* we'll just guess at column 10 here. */ 05160 05161 include_stmt_file_col = 10; 05162 } 05163 05164 cif_include_rec(nxt_line_num, 05165 include_stmt_file_col, 05166 cif_file_id); 05167 05168 05169 /* OK, switch the CIF back now. */ 05170 05171 if (! cif_need_unit_rec) { 05172 c_i_f = cif_actual_file; 05173 } 05174 05175 05176 if (include_file_ptr == NULL) { 05177 05178 /* Can't open INCLUDE file. */ 05179 ntr_msg_queue(curr_glb_line, 63, Error, 05180 0, 05181 include_file, 05182 0, 05183 STR_ARG); 05184 } 05185 else { /* Check for recursive use of INCLUDE file name. */ 05186 05187 for (src_stk_i = src_stk_idx; src_stk_i > NULL_IDX; src_stk_i--) { 05188 05189 if (EQUAL_STRS(include_path, SRC_STK_PATH_NAME(src_stk_i))) { 05190 recursive_use = TRUE; 05191 break; 05192 } 05193 } 05194 05195 if (recursive_use) { /* Recursive use of include file */ 05196 ntr_msg_queue(curr_glb_line, 64, Error, 05197 0, 05198 include_file, 05199 0, 05200 STR_ARG); 05201 } 05202 else { /* update source stack with open file info */ 05203 TBL_REALLOC_CK (src_stk, 1); 05204 SRC_STK_FILE_LINE(src_stk_idx) = 0; 05205 05206 /* This field will get set by update_global_line */ 05207 05208 SRC_STK_GLOBAL_LINE_IDX(src_stk_idx) = NULL_IDX; 05209 SRC_STK_FILE_TYPE(src_stk_idx) = Include_Src; 05210 SRC_STK_PREV_SRC_FORM(src_stk_idx) = source_form; 05211 SRC_STK_FILE_PTR(src_stk_idx) = include_file_ptr; 05212 SRC_STK_FILE_IDX(src_stk_idx) = include_path_len; 05213 strcpy (SRC_STK_PATH_NAME(src_stk_idx), include_path); 05214 05215 if (nxt_line_type == Pound_Include_Enter_Line) { 05216 SRC_STK_DO_NOT_FCLOSE(src_stk_idx) = TRUE; 05217 } 05218 else { 05219 SRC_STK_DO_NOT_FCLOSE(src_stk_idx) = FALSE; 05220 } 05221 05222 /* Always set the CIF File Id. It's needed for the buffered */ 05223 /* message file. */ 05224 05225 SRC_STK_CIF_FILE_ID(src_stk_idx) = cif_file_id; 05226 05227 result = TRUE; 05228 } 05229 } 05230 05231 TRACE (Func_Exit, "open_include_file", include_path); 05232 05233 return (result); 05234 05235 } /* open_include_file */ 05236 05237 05238 /******************************************************************************\ 05239 |* *| 05240 |* Description: *| 05241 |* Update_global_line adds a new entry to the global_line_tbl each time *| 05242 |* an include file is opened, or when an EOF is encountered reading an *| 05243 |* include file. *| 05244 |* *| 05245 |* Input parameters: *| 05246 |* NONE *| 05247 |* *| 05248 |* Output parameters: *| 05249 |* NONE *| 05250 |* *| 05251 |* Returns: *| 05252 |* NOTHING *| 05253 |* *| 05254 \******************************************************************************/ 05255 05256 static void update_global_line (void) 05257 05258 { 05259 int idx; 05260 int length; 05261 int lengthp; 05262 05263 05264 TRACE (Func_Entry, "update_global_line", NULL); 05265 05266 TBL_REALLOC_CK (global_line_tbl, 1); 05267 GL_GLOBAL_LINE(global_line_tbl_idx) = curr_glb_line; 05268 GL_FILE_LINE(global_line_tbl_idx) = SRC_STK_FILE_LINE(src_stk_idx); 05269 GL_CIF_FILE_ID(global_line_tbl_idx) = SRC_STK_CIF_FILE_ID(src_stk_idx); 05270 05271 /* Clear the field. It gets set at EOF of each file. */ 05272 /* It also holds a running total of file lines at each end statement */ 05273 /* because of mif inflexibility. */ 05274 05275 GL_SOURCE_LINES(global_line_tbl_idx) = 0; 05276 GL_INCLUDE_FILE_LINE(global_line_tbl_idx) = include_stmt_file_line; 05277 GL_INCLUDE_FILE_COL(global_line_tbl_idx) = include_stmt_file_col; 05278 include_stmt_file_line = 0; 05279 include_stmt_file_col = 0; 05280 05281 /* Need to keep track of the first entry in the global */ 05282 /* line table, that describes the current source file. */ 05283 05284 if (SRC_STK_GLOBAL_LINE_IDX(src_stk_idx) == NULL_IDX) { 05285 SRC_STK_GLOBAL_LINE_IDX(src_stk_idx) = global_line_tbl_idx; 05286 } 05287 05288 /* prevent duplication of file name strings in string pool */ 05289 05290 GL_FILE_NAME_IDX(global_line_tbl_idx) = NULL_IDX; 05291 GL_PATH_NAME_IDX(global_line_tbl_idx) = NULL_IDX; 05292 length = strlen(SRC_STK_FILE_NAME(src_stk_idx)); 05293 lengthp = strlen(SRC_STK_PATH_NAME(src_stk_idx)); 05294 05295 for (idx = global_line_tbl_idx - 1; idx > NULL_IDX; idx--) { 05296 05297 if (GL_FILE_NAME_LEN(idx) == length && 05298 EQUAL_STRS(SRC_STK_FILE_NAME(src_stk_idx), GL_FILE_NAME_PTR(idx))) { 05299 GL_FILE_NAME_IDX(global_line_tbl_idx) = GL_FILE_NAME_IDX(idx); 05300 GL_FILE_NAME_LEN(global_line_tbl_idx) = length; 05301 break; 05302 } 05303 } 05304 05305 for (idx = global_line_tbl_idx - 1; idx > NULL_IDX; idx--) { 05306 05307 if (GL_PATH_NAME_LEN(idx) == lengthp && 05308 EQUAL_STRS(SRC_STK_PATH_NAME(src_stk_idx), GL_PATH_NAME_PTR(idx))) { 05309 GL_PATH_NAME_IDX(global_line_tbl_idx) = GL_PATH_NAME_IDX(idx); 05310 GL_PATH_NAME_LEN(global_line_tbl_idx) = lengthp; 05311 break; 05312 } 05313 } 05314 05315 /* check for file name already in the string pool */ 05316 05317 if (GL_FILE_NAME_IDX(global_line_tbl_idx) == NULL_IDX) { 05318 GL_FILE_NAME_LEN(global_line_tbl_idx) = length; 05319 GL_FILE_NAME_IDX(global_line_tbl_idx) = str_pool_idx+1; 05320 TBL_REALLOC_CK(str_pool, WORD_LEN(length)); 05321 05322 for (idx = GL_FILE_NAME_IDX(global_line_tbl_idx); 05323 idx <= str_pool_idx; idx++) { 05324 str_pool[idx].name_long = 0; 05325 } 05326 05327 strcpy(GL_FILE_NAME_PTR(global_line_tbl_idx), 05328 SRC_STK_FILE_NAME(src_stk_idx)); 05329 } 05330 05331 if (GL_PATH_NAME_IDX(global_line_tbl_idx) == NULL_IDX) { 05332 GL_PATH_NAME_LEN(global_line_tbl_idx) = lengthp; 05333 GL_PATH_NAME_IDX(global_line_tbl_idx) = str_pool_idx+1; 05334 TBL_REALLOC_CK(str_pool, WORD_LEN(lengthp)); 05335 05336 for (idx = GL_PATH_NAME_IDX(global_line_tbl_idx); 05337 idx <= str_pool_idx; idx++) { 05338 str_pool[idx].name_long = 0; 05339 } 05340 05341 strcpy(GL_PATH_NAME_PTR(global_line_tbl_idx), 05342 SRC_STK_PATH_NAME(src_stk_idx)); 05343 } 05344 05345 TRACE (Func_Exit, "update_global_line", NULL); 05346 05347 return; 05348 05349 } /* update_global_line */ 05350 05351 /******************************************************************************\ 05352 |* *| 05353 |* Description: *| 05354 |* Prints the source line to stderr. *| 05355 |* *| 05356 |* Input parameters: *| 05357 |* line - source line to be printed. *| 05358 |* column - column position for pointer. *| 05359 |* *| 05360 |* Output parameters: *| 05361 |* NONE *| 05362 |* *| 05363 |* Returns: *| 05364 |* NOTHING *| 05365 |* *| 05366 \******************************************************************************/ 05367 05368 void print_err_line(line, column) 05369 { 05370 char buf[MAX_SRC_LINE_SIZE]; 05371 char buf2[MAX_SRC_LINE_SIZE]; 05372 int col_idx = 0; 05373 int i; 05374 int line_idx; 05375 05376 05377 if (line != stmt_line_num[stmt_line_idx]) { 05378 05379 for (line_idx = 1; line_idx <= lines_in_buf; line_idx++) { 05380 05381 if (line == stmt_line_num[line_idx]) { 05382 break; 05383 } 05384 } 05385 } 05386 else { 05387 line_idx = stmt_line_idx; 05388 } 05389 05390 if (line == stmt_line_num[line_idx]) { 05391 05392 for (i = 0; 05393 i <= stmt_line_end_idx[line_idx]-stmt_line_start_idx[line_idx]; 05394 i++) { 05395 05396 if (i >= MAX_SRC_LINE_SIZE) { 05397 break; 05398 } 05399 05400 buf2[i] = stmt_buf[stmt_line_start_idx[line_idx] + i]; 05401 05402 if (stmt_buf_col[stmt_line_start_idx[line_idx] + i] == column) { 05403 col_idx = i; 05404 } 05405 05406 if (buf2[i] == '\0') { 05407 buf[i] = '\0'; 05408 break; 05409 } 05410 else if (buf2[i] == (char)EOF) { 05411 buf[i] = '\0'; 05412 buf2[i] = '\0'; 05413 break; 05414 } 05415 else if (buf2[i] == '\n') { 05416 buf[i] = ' '; 05417 break; 05418 } 05419 else if (buf2[i] == '\t') { 05420 buf[i] = '\t'; 05421 } 05422 else { 05423 buf[i] = ' '; 05424 } 05425 } 05426 05427 buf[++i] = '\0'; 05428 buf2[i] = '\0'; 05429 fprintf(stderr, "%s", buf2); 05430 05431 if (column != 0) { 05432 buf[col_idx] = '^'; 05433 fprintf(stderr, "%s\n", buf); 05434 } 05435 } 05436 else if (line == nxt_line_num) { 05437 05438 for (i = 0; i <= nxt_line_EOL; i++) { 05439 if (i >= MAX_SRC_LINE_SIZE) { 05440 break; 05441 } 05442 05443 buf2[i] = nxt_line[NXT_COL(i)]; 05444 05445 if (nxt_line_col[NXT_COL(i)] == column) { 05446 col_idx = i; 05447 } 05448 05449 if (buf2[i] == '\0') { 05450 buf[i] = '\0'; 05451 break; 05452 } 05453 else if (buf2[i] == (char)EOF) { 05454 buf[i] = '\0'; 05455 buf2[i] = '\0'; 05456 break; 05457 } 05458 else if (buf2[i] == '\n') { 05459 buf[i] = ' '; 05460 break; 05461 } 05462 else if (buf2[i] == '\t') { 05463 buf[i] = '\t'; 05464 } 05465 else { 05466 buf[i] = ' '; 05467 } 05468 } 05469 05470 buf[++i] = '\0'; 05471 buf2[i] = '\0'; 05472 fprintf(stderr, "%s", buf2); 05473 05474 if (column != 0) { 05475 buf[col_idx] = '^'; 05476 fprintf(stderr, "%s\n", buf); 05477 } 05478 } 05479 05480 return; 05481 05482 } /* print_err_line */ 05483 05484 05485 /******************************************************************************\ 05486 |* *| 05487 |* Description: *| 05488 |* looks ahead in stmt_buf to find what follows a paren group. *| 05489 |* *| 05490 |* Input parameters: *| 05491 |* cnt - number of paren groups to look for (1 or 2). *| 05492 |* *| 05493 |* Output parameters: *| 05494 |* NONE *| 05495 |* *| 05496 |* Returns: *| 05497 |* char following parens. *| 05498 |* *| 05499 \******************************************************************************/ 05500 05501 char scan_thru_close_paren(int idx, int line_idx, int cnt) 05502 05503 { 05504 char ch; 05505 int ich; 05506 int paren_level = 1; 05507 05508 TRACE (Func_Entry, "scan_thru_close_paren", &LA_CH_VALUE); 05509 05510 if (line_idx == 0) { 05511 idx = stmt_buf_idx; 05512 line_idx = stmt_line_idx; 05513 } 05514 ich = stmt_buf[idx]; 05515 while ((ich == lparen) && (cnt > 0)) { 05516 while (idx < stmt_buf_EOS_idx) { 05517 ich = stmt_buf[++idx]; 05518 if (ich == rparen) { 05519 paren_level--; 05520 05521 if (paren_level == 0) { 05522 do { 05523 ich = stmt_buf[++idx]; 05524 05525 if (idx == stmt_line_end_idx[line_idx]) { 05526 05527 if (line_idx < lines_in_buf) { 05528 ++line_idx; 05529 idx = stmt_line_start_idx[line_idx] + 05530 stmt_line_offset[line_idx]; 05531 ich = blank; 05532 } 05533 else { 05534 ich = eos; 05535 } 05536 } 05537 } 05538 while ((ich == blank) | (ich == tab)); 05539 paren_level = 1; 05540 break; 05541 } 05542 } 05543 else if (ich == lparen) { 05544 paren_level++; 05545 } 05546 else if (idx == stmt_line_end_idx[line_idx]) { 05547 05548 if (line_idx < lines_in_buf) { 05549 ++line_idx; 05550 idx = stmt_line_start_idx[line_idx] + 05551 stmt_line_offset[line_idx]; 05552 } 05553 else { 05554 ich = eos; 05555 break; 05556 } 05557 } 05558 } /* while */ 05559 05560 cnt--; 05561 05562 } /* while lparen */ 05563 05564 ch = ich; 05565 05566 if (islower(ch)) { /* lowercase char */ 05567 ch = TOUPPER(ch); /* cnvrt lwr to upr */ 05568 } 05569 05570 TRACE (Func_Exit, "scan_thru_close_paren", NULL); 05571 05572 return (ch); 05573 05574 } /* scan_thru_close_paren */ 05575 05576 /******************************************************************************\ 05577 |* *| 05578 |* Description: *| 05579 |* Checks if character following id and possible paren groups implies *| 05580 |* that the stmt is an assignment statement. *| 05581 |* *| 05582 |* *| 05583 |* Input parameters: *| 05584 |* NONE *| 05585 |* *| 05586 |* Output parameters: *| 05587 |* NONE *| 05588 |* *| 05589 |* Returns: *| 05590 |* TRUE if not assignment. *| 05591 |* *| 05592 \******************************************************************************/ 05593 05594 boolean set_stmt_type_known(void) 05595 05596 { 05597 05598 int ich; 05599 int idx; 05600 int lblank = ' '; 05601 int line_idx; 05602 boolean lsig_blank; 05603 int ltab = '\t'; 05604 boolean stmt_type_known = FALSE; 05605 05606 05607 TRACE (Func_Entry, "set_stmt_type_known", NULL); 05608 05609 idx = stmt_buf_idx; 05610 line_idx = stmt_line_idx; 05611 ich = stmt_buf[idx]; 05612 lsig_blank = sig_blank; 05613 05614 if (source_form != Fixed_Form) { 05615 lblank = -1; 05616 ltab = -1; 05617 } 05618 05619 BACK: 05620 05621 while ((ich != EOF) && 05622 ((ch_class[ich] == Ch_Class_Letter) | 05623 (ch_class[ich] == Ch_Class_Digit) | 05624 (ich == underscore) | 05625 (ich == dollar) | 05626 (ich == at_sign) | 05627 (ich == lblank) | 05628 (ich == ltab) | 05629 (ich == newline) | 05630 (ich == bang)) && 05631 (! lsig_blank)) { 05632 05633 if (idx == stmt_line_end_idx[line_idx]) { 05634 05635 if (line_idx < lines_in_buf) { 05636 ++line_idx; 05637 idx = stmt_line_start_idx[line_idx] 05638 + stmt_line_offset[line_idx]; 05639 } 05640 else { 05641 goto DONE; 05642 } 05643 } 05644 ich = stmt_buf[++idx]; 05645 } /* while */ 05646 05647 while ((ich == blank) | 05648 (ich == tab) | 05649 (ich == newline) | 05650 (ich == bang)) { 05651 05652 if (idx == stmt_line_end_idx[line_idx]) { 05653 05654 if (line_idx < lines_in_buf) { 05655 ++line_idx; 05656 idx = stmt_line_start_idx[line_idx] 05657 + stmt_line_offset[line_idx]; 05658 } 05659 else { 05660 goto DONE; 05661 } 05662 } 05663 ich = stmt_buf[++idx]; 05664 } 05665 05666 if (ich == lparen) { 05667 ich = whats_after_paren_group(&idx, &line_idx, 2); 05668 } 05669 05670 # ifdef COARRAY_FORTRAN 05671 if (ich == lbrkt && cmd_line_flags.co_array_fortran) { 05672 ich = whats_after_brkt_group(&idx, &line_idx, 2); 05673 } 05674 # endif 05675 05676 if (ich == percent) { 05677 05678 if (idx == stmt_line_end_idx[line_idx]) { 05679 05680 if (line_idx < lines_in_buf) { 05681 ++line_idx; 05682 idx = stmt_line_start_idx[line_idx] 05683 + stmt_line_offset[line_idx]; 05684 } 05685 else { 05686 goto DONE; 05687 } 05688 } 05689 ich = stmt_buf[++idx]; 05690 05691 while ((ich == blank) | 05692 (ich == tab) | 05693 (ich == newline) | 05694 (ich == bang)) { 05695 05696 if (idx == stmt_line_end_idx[line_idx]) { 05697 05698 if (line_idx < lines_in_buf) { 05699 ++line_idx; 05700 idx = stmt_line_start_idx[line_idx] 05701 + stmt_line_offset[line_idx]; 05702 } 05703 else { 05704 goto DONE; 05705 } 05706 } 05707 ich = stmt_buf[++idx]; 05708 } 05709 05710 lsig_blank = FALSE; 05711 goto BACK; 05712 } 05713 05714 DONE: 05715 05716 if (ich != equal) { 05717 stmt_type_known = TRUE; 05718 } 05719 05720 TRACE (Func_Exit, "set_stmt_type_known", NULL); 05721 05722 return(stmt_type_known); 05723 05724 } /* set_stmt_type_known */ 05725 05726 /******************************************************************************\ 05727 |* *| 05728 |* Description: *| 05729 |* looks ahead in stmt_buf to find what follows a paren group. *| 05730 |* *| 05731 |* Input parameters: *| 05732 |* cnt - number of paren groups to look for (1 or 2). *| 05733 |* *| 05734 |* Output parameters: *| 05735 |* NONE *| 05736 |* *| 05737 |* Returns: *| 05738 |* char following parens. *| 05739 |* *| 05740 \******************************************************************************/ 05741 05742 static int whats_after_paren_group(int *idx, int *line_idx, int cnt) 05743 05744 { 05745 int ich; 05746 int paren_level = 1; 05747 05748 TRACE (Func_Entry, "whats_after_paren_group", &LA_CH_VALUE); 05749 05750 ich = stmt_buf[*idx]; 05751 05752 while ((ich == lparen) && (cnt > 0)) { 05753 while (*idx < stmt_buf_EOS_idx) { 05754 ich = stmt_buf[++(*idx)]; 05755 if (ich == rparen) { 05756 paren_level--; 05757 05758 if (paren_level == 0) { 05759 do { 05760 ich = stmt_buf[++(*idx)]; 05761 05762 if (*idx == stmt_line_end_idx[*line_idx]) { 05763 05764 if (*line_idx < lines_in_buf) { 05765 *idx = stmt_line_start_idx[++(*line_idx)] + 05766 stmt_line_offset[*line_idx]; 05767 ich = blank; 05768 } 05769 else { 05770 ich = eos; 05771 } 05772 } 05773 } 05774 while ((ich == blank) | (ich == tab)); 05775 paren_level = 1; 05776 break; 05777 } 05778 } 05779 else if (ich == lparen) { 05780 paren_level++; 05781 } 05782 else if (*idx == stmt_line_end_idx[*line_idx]) { 05783 05784 if (*line_idx < lines_in_buf) { 05785 *idx = stmt_line_start_idx[++(*line_idx)] + 05786 stmt_line_offset[*line_idx]; 05787 } 05788 else { 05789 ich = eos; 05790 break; 05791 } 05792 } 05793 } /* while */ 05794 05795 cnt--; 05796 05797 } /* while lparen */ 05798 05799 TRACE (Func_Exit, "whats_after_paren_group", NULL); 05800 05801 return (ich); 05802 05803 } /* whats_after_paren_group */ 05804 05805 /******************************************************************************\ 05806 |* *| 05807 |* Description: *| 05808 |* looks ahead in stmt_buf to find what follows a brkt group. *| 05809 |* *| 05810 |* Input parameters: *| 05811 |* cnt - number of brkt groups to look for (1 or 2). *| 05812 |* *| 05813 |* Output parameters: *| 05814 |* NONE *| 05815 |* *| 05816 |* Returns: *| 05817 |* char following parens. *| 05818 |* *| 05819 \******************************************************************************/ 05820 05821 static int whats_after_brkt_group(int *idx, int *line_idx, int cnt) 05822 05823 { 05824 int ich; 05825 int brkt_level = 1; 05826 05827 TRACE (Func_Entry, "whats_after_brkt_group", &LA_CH_VALUE); 05828 05829 ich = stmt_buf[*idx]; 05830 05831 while ((ich == lbrkt) && (cnt > 0)) { 05832 while (*idx < stmt_buf_EOS_idx) { 05833 ich = stmt_buf[++(*idx)]; 05834 if (ich == rbrkt) { 05835 brkt_level--; 05836 05837 if (brkt_level == 0) { 05838 do { 05839 ich = stmt_buf[++(*idx)]; 05840 05841 if (*idx == stmt_line_end_idx[*line_idx]) { 05842 05843 if (*line_idx < lines_in_buf) { 05844 *idx = stmt_line_start_idx[++(*line_idx)] + 05845 stmt_line_offset[*line_idx]; 05846 ich = blank; 05847 } 05848 else { 05849 ich = eos; 05850 } 05851 } 05852 } 05853 while ((ich == blank) | (ich == tab)); 05854 brkt_level = 1; 05855 break; 05856 } 05857 } 05858 else if (ich == lbrkt) { 05859 brkt_level++; 05860 } 05861 else if (*idx == stmt_line_end_idx[*line_idx]) { 05862 if (*line_idx < lines_in_buf) { 05863 *idx = stmt_line_start_idx[++(*line_idx)] + 05864 stmt_line_offset[*line_idx]; 05865 } 05866 else { 05867 ich = eos; 05868 break; 05869 } 05870 } 05871 } /* while */ 05872 05873 cnt--; 05874 05875 } /* while lbrkt */ 05876 05877 TRACE (Func_Exit, "whats_after_brkt_group", NULL); 05878 05879 return (ich); 05880 05881 } /* whats_after_brkt_group */ 05882 05883 /******************************************************************************\ 05884 |* *| 05885 |* Description: *| 05886 |* Checks if character after id is =. *| 05887 |** This means keyword. *| 05888 |* *| 05889 |* Input parameters: *| 05890 |* NONE *| 05891 |* *| 05892 |* Output parameters: *| 05893 |* NONE *| 05894 |* *| 05895 |* Returns: *| 05896 |* TRUE if keyword *| 05897 |* *| 05898 \******************************************************************************/ 05899 05900 boolean next_arg_is_kwd_equal (void) 05901 05902 { 05903 05904 int ich; 05905 int idx; 05906 int lamp = '&'; 05907 int lblank = ' '; 05908 int line_idx; 05909 int ltab = '\t'; 05910 int kwd = FALSE; 05911 05912 TRACE (Func_Entry, "next_arg_is_kwd_equal", NULL); 05913 05914 idx = stmt_buf_idx; 05915 05916 line_idx = stmt_line_idx; 05917 05918 ich = stmt_buf[idx]; 05919 05920 if (source_form != Fixed_Form) { 05921 lblank = -1; 05922 ltab = -1; 05923 } 05924 else { 05925 lamp = -1; 05926 } 05927 05928 while ((ich != EOF) && 05929 (ch_class[(char)ich] == Ch_Class_Letter) | 05930 (ch_class[(char)ich] == Ch_Class_Digit) | 05931 (ich == underscore) | 05932 (ich == dollar) | 05933 (ich == at_sign) | 05934 (ich == lblank) | 05935 (ich == ltab) | 05936 (ich == lamp) | 05937 (ich == newline) | 05938 (ich == bang)) { 05939 05940 if (idx == stmt_line_end_idx[line_idx]) { 05941 05942 if (line_idx < lines_in_buf) { 05943 ++line_idx; 05944 idx = stmt_line_start_idx[line_idx] 05945 + stmt_line_offset[line_idx]; 05946 } 05947 else { 05948 break; 05949 } 05950 } 05951 else if (ich == lamp) { 05952 break; 05953 } 05954 ich = stmt_buf[++idx]; 05955 } /* while */ 05956 05957 while ((ich == blank) | 05958 (ich == tab) | 05959 (ich == lamp) | 05960 (ich == newline) | 05961 (ich == bang)) { 05962 05963 if (idx == stmt_line_end_idx[line_idx]) { 05964 05965 if (line_idx < lines_in_buf) { 05966 ++line_idx; 05967 idx = stmt_line_start_idx[line_idx] 05968 + stmt_line_offset[line_idx]; 05969 } 05970 else { 05971 break; 05972 } 05973 } 05974 else if (ich == lamp) { 05975 break; 05976 } 05977 05978 ich = stmt_buf[++idx]; 05979 } 05980 05981 kwd = (ich == equal); 05982 05983 if (!kwd) { 05984 goto EXIT; 05985 } 05986 05987 ich = stmt_buf[++idx]; 05988 05989 while ((ich == lblank) | 05990 (ich == ltab) | 05991 (ich == lamp) | 05992 (ich == newline) | 05993 (ich == bang)) { 05994 05995 if (idx == stmt_line_end_idx[line_idx]) { 05996 05997 if (line_idx < lines_in_buf) { 05998 ++line_idx; 05999 idx = stmt_line_start_idx[line_idx] 06000 + stmt_line_offset[line_idx]; 06001 } 06002 else { 06003 break; 06004 } 06005 } 06006 else if (ich == lamp) { 06007 break; 06008 } 06009 06010 ich = stmt_buf[++idx]; 06011 } 06012 06013 kwd = (ich != equal); 06014 06015 EXIT: 06016 06017 TRACE (Func_Exit, "next_arg_is_kwd_equal", NULL); 06018 06019 return(kwd); 06020 06021 } /* next_arg_is_kwd_equal */ 06022 06023 /******************************************************************************\ 06024 |* *| 06025 |* Description: *| 06026 |* Checks if possible data stmt is an assignment. *| 06027 |* *| 06028 |* Input parameters: *| 06029 |* NONE *| 06030 |* *| 06031 |* Output parameters: *| 06032 |* NONE *| 06033 |* *| 06034 |* Returns: *| 06035 |* TRUE if stmt is DATA stmt. *| 06036 |* *| 06037 \******************************************************************************/ 06038 06039 boolean stmt_is_DATA_stmt (void) 06040 06041 { 06042 int ich; 06043 int idx; 06044 int line_idx; 06045 int paren_level = 0; 06046 boolean result = TRUE; 06047 06048 TRACE (Func_Entry, "stmt_is_DATA_stmt", NULL); 06049 06050 ich = stmt_buf[stmt_buf_idx]; 06051 06052 06053 /* In free form, a blank cannot be inside an identifier. */ 06054 06055 if (sig_blank && 06056 ich != equal && 06057 ich != percent && 06058 ich != lparen) { 06059 goto EXIT; 06060 } 06061 06062 idx = stmt_buf_idx - 1; 06063 06064 line_idx = stmt_line_idx; 06065 06066 do { 06067 ich = stmt_buf[++idx]; 06068 06069 if (ich == lparen) { 06070 paren_level++; 06071 continue; 06072 } 06073 else if (ich == rparen) { 06074 paren_level--; 06075 continue; 06076 } 06077 06078 if (ich == equal && paren_level == 0) { 06079 result = FALSE; 06080 break; 06081 } 06082 06083 if (idx == stmt_line_end_idx[line_idx]) { 06084 06085 if (line_idx < lines_in_buf) { 06086 ++line_idx; 06087 idx = stmt_line_start_idx[line_idx] 06088 + stmt_line_offset[line_idx]; 06089 } 06090 else { 06091 break; 06092 } 06093 } 06094 } 06095 while (ich != slash | paren_level); 06096 06097 EXIT: 06098 06099 TRACE (Func_Exit, "stmt_is_DATA_stmt", NULL); 06100 06101 return(result); 06102 06103 } /* stmt_is_DATA_stmt */ 06104 06105 /******************************************************************************\ 06106 |* *| 06107 |* Description: *| 06108 |* Checks if stmt has double colon at zero paren level. *| 06109 |* *| 06110 |* Input parameters: *| 06111 |* NONE *| 06112 |* *| 06113 |* Output parameters: *| 06114 |* NONE *| 06115 |* *| 06116 |* Returns: *| 06117 |* TRUE if double paren found. *| 06118 |* *| 06119 \******************************************************************************/ 06120 06121 boolean stmt_has_double_colon (void) 06122 06123 { 06124 boolean colon_found = FALSE; 06125 boolean found = FALSE; 06126 int ich; 06127 int idx; 06128 int lblank = ' '; 06129 int ltab = '\t'; 06130 int line_idx; 06131 int paren_level = 0; 06132 06133 TRACE (Func_Entry, "stmt_has_double_colon", NULL); 06134 06135 idx = stmt_buf_idx - 1; 06136 06137 line_idx = stmt_line_idx; 06138 06139 if (source_form != Fixed_Form) { 06140 lblank = -1; 06141 ltab = -1; 06142 } 06143 06144 06145 do { 06146 ich = stmt_buf[++idx]; 06147 06148 if (ich == lparen) { 06149 paren_level++; 06150 colon_found = FALSE; 06151 continue; 06152 } 06153 else if (ich == rparen) { 06154 paren_level--; 06155 colon_found = FALSE; 06156 continue; 06157 } 06158 06159 if (idx == stmt_line_end_idx[line_idx]) { 06160 06161 if (line_idx < lines_in_buf) { 06162 ++line_idx; 06163 idx = stmt_line_start_idx[line_idx] 06164 + stmt_line_offset[line_idx]; 06165 continue; 06166 } 06167 else { 06168 break; 06169 } 06170 } 06171 06172 if (ich == colon && paren_level == 0) { 06173 06174 if (colon_found) { 06175 found = TRUE; 06176 break; 06177 } 06178 else { 06179 colon_found = TRUE; 06180 continue; 06181 } 06182 } 06183 06184 if (ich == lblank | ich == ltab) { 06185 continue; 06186 } 06187 06188 colon_found = FALSE; 06189 } 06190 while (TRUE); 06191 06192 TRACE (Func_Exit, "stmt_has_double_colon", NULL); 06193 06194 return(found); 06195 06196 } /* stmt_has_double_colon */ 06197 06198 06199 /******************************************************************************\ 06200 |* *| 06201 |* Description: *| 06202 |* Checks if stmt has comma after equal. Called for Do token. *| 06203 |* *| 06204 |* Input parameters: *| 06205 |* NONE *| 06206 |* *| 06207 |* Output parameters: *| 06208 |* NONE *| 06209 |* *| 06210 |* Returns: *| 06211 |* TRUE if stmt is DO stmt. *| 06212 |* *| 06213 \******************************************************************************/ 06214 06215 boolean stmt_is_DO_stmt (void) 06216 06217 { 06218 boolean found_eq = FALSE; 06219 int ich; 06220 int idx; 06221 int line_idx; 06222 int paren_level = 0; 06223 boolean result = FALSE; 06224 06225 TRACE (Func_Entry, "stmt_is_DO_stmt", NULL); 06226 06227 idx = stmt_buf_idx - 1; 06228 06229 line_idx = stmt_line_idx; 06230 06231 do { 06232 ich = stmt_buf[++idx]; 06233 06234 if (ich == lparen) { 06235 paren_level++; 06236 continue; 06237 } 06238 else if (ich == rparen) { 06239 paren_level--; 06240 continue; 06241 } 06242 06243 if (ich == equal && paren_level == 0) { 06244 found_eq = TRUE; 06245 continue; 06246 } 06247 06248 if (ich == comma && paren_level == 0 && found_eq) { 06249 result = TRUE; 06250 break; 06251 } 06252 06253 if (idx == stmt_line_end_idx[line_idx]) { 06254 06255 if (line_idx < lines_in_buf) { 06256 ++line_idx; 06257 idx = stmt_line_start_idx[line_idx] 06258 + stmt_line_offset[line_idx]; 06259 } 06260 else { 06261 break; 06262 } 06263 } 06264 } 06265 while (TRUE); 06266 06267 TRACE (Func_Exit, "stmt_is_DO_stmt", NULL); 06268 06269 return (result); 06270 06271 } /* stmt_is_DO_stmt */ 06272 06273 /******************************************************************************\ 06274 |* *| 06275 |* Description: *| 06276 |* Translates an index in the format string to line and column number. *| 06277 |* *| 06278 |* Input parameters: *| 06279 |* format_col - index in the format string. *| 06280 |* *| 06281 |* Output parameters: *| 06282 |* line - line number in source. *| 06283 |* col - column number in source. *| 06284 |* *| 06285 |* Returns: *| 06286 |* NOTHING *| 06287 |* *| 06288 \******************************************************************************/ 06289 06290 void format_line_n_col (int *line, 06291 int *col, 06292 int format_col) 06293 06294 { 06295 int dbl_delim_mask = (1 << 9); 06296 int i; 06297 int ich; 06298 int idx; 06299 int line_idx = NULL_IDX; 06300 06301 TRACE (Func_Entry, "format_line_n_col", NULL); 06302 06303 idx = format_start_idx - 1; 06304 06305 for (i = 1; i <= lines_in_buf; i++) { 06306 if (idx + 1 >= stmt_line_start_idx[i] && 06307 idx + 1 <= stmt_line_end_idx[i]) { 06308 06309 line_idx = i; 06310 break; 06311 } 06312 } 06313 06314 # ifdef _DEBUG 06315 if (line_idx == NULL_IDX) { 06316 PRINTMSG(1, 626, Internal, 1, 06317 "valid line_idx", 06318 "format_line_n_col"); 06319 } 06320 # endif 06321 06322 if (stmt_type == Format_Stmt) { 06323 06324 while (format_col > 0) { 06325 if (idx + format_col < stmt_line_end_idx[line_idx]) { 06326 idx += format_col; 06327 format_col = 0; 06328 } 06329 else { 06330 format_col -= stmt_line_end_idx[line_idx] - idx; 06331 if (line_idx < lines_in_buf) { 06332 ++line_idx; 06333 idx = stmt_line_start_idx[line_idx] 06334 + stmt_line_offset[line_idx] + 1; 06335 } 06336 else { 06337 idx = stmt_line_end_idx[line_idx] - 1; 06338 break; 06339 } 06340 } 06341 } 06342 } 06343 else { 06344 06345 while (format_col > 0) { 06346 06347 ich = stmt_buf[++idx]; 06348 06349 if (idx == stmt_line_end_idx[line_idx]) { 06350 06351 if (line_idx < lines_in_buf) { 06352 ++line_idx; 06353 idx = stmt_line_start_idx[line_idx] 06354 + stmt_line_offset[line_idx]; 06355 ich = stmt_buf[++idx]; 06356 } 06357 else { 06358 break; 06359 } 06360 } 06361 06362 if ((ich & dbl_delim_mask) == 0) { 06363 format_col--; 06364 } 06365 } 06366 } 06367 06368 *line = stmt_line_num[line_idx]; 06369 06370 *col = stmt_buf_col[idx]; 06371 06372 TRACE (Func_Exit, "format_line_n_col", NULL); 06373 06374 return; 06375 06376 } /* format_line_n_col */ 06377 06378 /******************************************************************************\ 06379 |* *| 06380 |* Description: *| 06381 |* This routine sets the global variable format_start_idx to the *| 06382 |* stmt buffer idx that matches the input line and column value. *| 06383 |* *| 06384 |* Input parameters: *| 06385 |* NONE *| 06386 |* *| 06387 |* Output parameters: *| 06388 |* NONE *| 06389 |* *| 06390 |* Returns: *| 06391 |* NOTHING *| 06392 |* *| 06393 \******************************************************************************/ 06394 06395 void set_format_start_idx(int buf_idx) 06396 06397 { 06398 06399 TRACE (Func_Entry, "set_format_start_idx", NULL); 06400 06401 /* get past the quote */ 06402 buf_idx++; 06403 06404 format_start_idx = buf_idx; 06405 06406 TRACE (Func_Exit, "set_format_start_idx", NULL); 06407 06408 return; 06409 06410 } /* set_format_start_idx */ 06411 06412 /******************************************************************************\ 06413 |* *| 06414 |* Description: *| 06415 |* Place the next character constant into the constant table. *| 06416 |* Resets LA_CH *| 06417 |* *| 06418 |* Input parameters: *| 06419 |* NONE *| 06420 |* *| 06421 |* Output parameters: *| 06422 |* NONE *| 06423 |* *| 06424 |* Returns: *| 06425 |* index into constant table. *| 06426 |* *| 06427 \******************************************************************************/ 06428 06429 int put_char_const_in_tbl (char holler, /* In */ 06430 int *len) /* Out */ 06431 06432 { 06433 int char_idx = NULL_IDX; 06434 char *char_ptr; 06435 int dbl_delim_mask = (1 << 9); 06436 int ich; 06437 int idx; 06438 long64 length = 0; 06439 linear_type_type linear_type; 06440 int line_idx; 06441 int type_idx; 06442 06443 06444 TRACE (Func_Entry, "put_char_const_in_tbl", NULL); 06445 06446 ich = stmt_buf[stmt_buf_idx]; 06447 idx = stmt_buf_idx; 06448 line_idx = stmt_line_idx; 06449 06450 while (ich < 0) { 06451 06452 if ((ich & dbl_delim_mask) == 0) { 06453 length++; 06454 } 06455 ich = stmt_buf[++idx]; 06456 06457 if (idx == stmt_line_end_idx[line_idx]) { 06458 06459 if (line_idx < lines_in_buf) { 06460 ++line_idx; 06461 idx = stmt_line_start_idx[line_idx] 06462 + stmt_line_offset[line_idx]; 06463 ich = stmt_buf[++idx]; 06464 } 06465 else { 06466 break; 06467 } 06468 } 06469 } /* while */ 06470 06471 *len = length; 06472 06473 if (holler != '\0') { 06474 06475 if (WORD_ALIGNED_BIT_LENGTH(CHAR_BIT * length) <= 06476 MAX_SHORT_TYPELESS_BITS) { 06477 linear_type = Short_Typeless_Const; 06478 } 06479 else { 06480 linear_type = Long_Typeless; 06481 } 06482 06483 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX); 06484 TYP_TYPE(TYP_WORK_IDX) = Typeless; 06485 TYP_LINEAR(TYP_WORK_IDX) = linear_type; 06486 TYP_BIT_LEN(TYP_WORK_IDX) = WORD_ALIGNED_BIT_LENGTH(CHAR_BIT * length); 06487 type_idx = ntr_type_tbl(); 06488 } 06489 else { 06490 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX); 06491 TYP_TYPE(TYP_WORK_IDX) = Character; 06492 TYP_LINEAR(TYP_WORK_IDX) = CHARACTER_DEFAULT_TYPE; 06493 TYP_DESC(TYP_WORK_IDX) = Default_Typed; 06494 TYP_CHAR_CLASS(TYP_WORK_IDX)= Const_Len_Char; 06495 TYP_FLD(TYP_WORK_IDX) = CN_Tbl_Idx; 06496 TYP_IDX(TYP_WORK_IDX) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, length), 06497 type_idx = ntr_type_tbl(); 06498 } 06499 06500 char_idx = ntr_const_tbl(type_idx, TRUE, NULL); 06501 char_ptr = (char *) &CN_CONST(char_idx); 06502 idx = 0; 06503 06504 if (holler == 'R') { 06505 06506 while (idx < (TARGET_CHARS_PER_WORD - (length % TARGET_CHARS_PER_WORD)) % 06507 TARGET_CHARS_PER_WORD){ 06508 idx++; 06509 } 06510 } 06511 06512 idx--; 06513 ich = stmt_buf[stmt_buf_idx]; 06514 06515 while (ich < 0) { 06516 06517 if ((ich & dbl_delim_mask) == 0) { 06518 char_ptr[++idx] = ich; 06519 } 06520 ich = stmt_buf[++stmt_buf_idx]; 06521 06522 if (stmt_buf_idx == stmt_line_end_idx[stmt_line_idx]) { 06523 06524 if (stmt_line_idx < lines_in_buf) { 06525 ++stmt_line_idx; 06526 stmt_buf_idx = stmt_line_start_idx[stmt_line_idx] 06527 + stmt_line_offset[stmt_line_idx]; 06528 ich = stmt_buf[++stmt_buf_idx]; 06529 } 06530 else { 06531 break; 06532 } 06533 } 06534 } 06535 06536 if (holler == 'H' || holler == '\0') { 06537 06538 while ((++idx) % TARGET_CHARS_PER_WORD != 0) { 06539 char_ptr[idx] = ' '; 06540 } 06541 } 06542 06543 stmt_buf_idx--; 06544 06545 NEXT_LA_CH; 06546 06547 TRACE (Func_Exit, "put_char_const_in_tbl", NULL); 06548 06549 return(char_idx); 06550 06551 } /* put_char_const_in_tbl */ 06552 06553 /******************************************************************************\ 06554 |* *| 06555 |* Description: *| 06556 |* Places a format string into the constant table. *| 06557 |* Resets LA_CH *| 06558 |* *| 06559 |* Input parameters: *| 06560 |* NONE *| 06561 |* *| 06562 |* Output parameters: *| 06563 |* NONE *| 06564 |* *| 06565 |* Returns: *| 06566 |* index into constant table. *| 06567 |* *| 06568 \******************************************************************************/ 06569 06570 int put_format_in_tbl (void) 06571 06572 { 06573 int char_idx = NULL_IDX; 06574 char *char_ptr; 06575 char *char_ptr2; 06576 int ich; 06577 int idx; 06578 long64 length = 0; 06579 int line_idx; 06580 long64 new_length; 06581 int paren_lvl = 0; 06582 int type_idx; 06583 06584 06585 TRACE (Func_Entry, "put_format_in_tbl", NULL); 06586 06587 idx = stmt_buf_idx - 1; 06588 line_idx = stmt_line_idx; 06589 06590 ich = stmt_buf[stmt_buf_idx]; 06591 06592 char_idx = (MASK_CHAR_CONST_IDX & ich) >> 8; 06593 06594 if (char_idx != NULL_IDX) { 06595 length = CN_INT_TO_C(TYP_IDX(CN_TYPE_IDX(char_idx))); 06596 06597 while (length > 0) { 06598 06599 if ((stmt_buf_idx + length) < stmt_line_end_idx[stmt_line_idx]) { 06600 stmt_buf_idx += length; 06601 length = 0; 06602 } 06603 else { 06604 length -= stmt_line_end_idx[stmt_line_idx] - stmt_buf_idx; 06605 ++stmt_line_idx; 06606 stmt_buf_idx = stmt_line_start_idx[stmt_line_idx] 06607 + stmt_line_offset[stmt_line_idx] + 1; 06608 } 06609 } 06610 goto EXIT; 06611 } 06612 06613 06614 /* figure the length */ 06615 do { 06616 ++idx; 06617 06618 if (idx == stmt_line_end_idx[line_idx]) { 06619 06620 if (line_idx < lines_in_buf) { 06621 ++line_idx; 06622 idx = stmt_line_start_idx[line_idx] 06623 + stmt_line_offset[line_idx]; 06624 continue; 06625 } 06626 else { 06627 break; 06628 } 06629 } 06630 ich = stmt_buf[idx]; 06631 length++; 06632 06633 if (ich == lparen) { 06634 paren_lvl++; 06635 } 06636 else if (ich == rparen) { 06637 paren_lvl--; 06638 } 06639 } 06640 while (paren_lvl); 06641 06642 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX); 06643 06644 /* 06645 # ifndef SOURCE_TO_SOURCE 06646 new_length = length + AT_NAME_LEN(stmt_label_idx); 06647 # else 06648 */ 06649 new_length = length; 06650 /* # endif */ 06651 06652 TYP_TYPE(TYP_WORK_IDX) = Character; 06653 TYP_LINEAR(TYP_WORK_IDX) = CHARACTER_DEFAULT_TYPE; 06654 TYP_DESC(TYP_WORK_IDX) = Default_Typed; 06655 TYP_CHAR_CLASS(TYP_WORK_IDX) = Const_Len_Char; 06656 TYP_FLD(TYP_WORK_IDX) = CN_Tbl_Idx; 06657 TYP_IDX(TYP_WORK_IDX) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, 06658 new_length), 06659 type_idx = ntr_type_tbl(); 06660 char_idx = ntr_const_tbl(type_idx, TRUE, NULL); 06661 06662 stmt_buf[stmt_buf_idx] |= (char_idx << 8); 06663 06664 char_ptr = (char *) &CN_CONST(char_idx); 06665 char_ptr2 = (char *)AT_OBJ_NAME_PTR(stmt_label_idx); 06666 06667 # ifndef SOURCE_TO_SOURCE 06668 /* 06669 for (idx = 0; idx < AT_NAME_LEN(stmt_label_idx); idx++) { 06670 char_ptr[idx] = char_ptr2[idx]; 06671 } 06672 */ 06673 # endif 06674 06675 idx=0; 06676 stmt_buf_idx--; 06677 06678 while (length > 0) { 06679 06680 stmt_buf_idx++; 06681 06682 if (stmt_buf_idx == stmt_line_end_idx[stmt_line_idx]) { 06683 06684 if (stmt_line_idx < lines_in_buf) { 06685 ++stmt_line_idx; 06686 stmt_buf_idx = stmt_line_start_idx[stmt_line_idx] 06687 + stmt_line_offset[stmt_line_idx]; 06688 continue; 06689 } 06690 else { 06691 break; 06692 } 06693 } 06694 06695 char_ptr[idx] = stmt_buf[stmt_buf_idx]; 06696 idx++; 06697 length--; 06698 } /* while */ 06699 06700 stmt_buf_idx++; 06701 06702 EXIT: 06703 06704 stmt_buf_idx--; 06705 06706 NEXT_LA_CH; 06707 06708 06709 TRACE (Func_Exit, "put_format_in_tbl", NULL); 06710 06711 return(char_idx); 06712 06713 } /* put_format_in_tbl */ 06714 06715 /******************************************************************************\ 06716 |* *| 06717 |* Description: *| 06718 |* Places a format string into the constant table. *| 06719 |* Resets LA_CH *| 06720 |* *| 06721 |* Input parameters: *| 06722 |* NONE *| 06723 |* *| 06724 |* Output parameters: *| 06725 |* NONE *| 06726 |* *| 06727 |* Returns: *| 06728 |* index into constant table. *| 06729 |* *| 06730 \******************************************************************************/ 06731 06732 boolean is_implied_do (void) 06733 06734 { 06735 boolean had_equal = FALSE; 06736 int ich; 06737 int idx; 06738 boolean imp_do = FALSE; 06739 int lblank = ' '; 06740 int ltab = '\t'; 06741 int line_idx; 06742 int paren_lvl = 0; 06743 int prev_ich; 06744 06745 TRACE (Func_Entry, "is_implied_do", NULL); 06746 06747 idx = stmt_buf_idx; 06748 line_idx = stmt_line_idx; 06749 ich = stmt_buf[idx]; 06750 prev_ich = ich; 06751 06752 if (source_form != Fixed_Form) { 06753 lblank = -1; 06754 ltab = -1; 06755 } 06756 06757 do { 06758 06759 if (had_equal) { 06760 06761 if (ich == equal) { 06762 had_equal = FALSE; 06763 } 06764 else if (ich != lblank && ich != ltab) { 06765 imp_do = TRUE; 06766 break; 06767 } 06768 } 06769 else if (ich == lparen) { 06770 paren_lvl++; 06771 } 06772 else if (ich == rparen) { 06773 paren_lvl--; 06774 } 06775 else if (ich == equal && paren_lvl == 1 && 06776 prev_ich != slash && 06777 prev_ich != greater && 06778 prev_ich != less) { 06779 had_equal = TRUE; 06780 } 06781 06782 if (++idx == stmt_line_end_idx[line_idx]) { 06783 06784 if (line_idx < lines_in_buf) { 06785 ++line_idx; 06786 idx = stmt_line_start_idx[line_idx] 06787 + stmt_line_offset[line_idx] + 1; 06788 } 06789 else { 06790 break; 06791 } 06792 } 06793 06794 if (ich != lblank && ich != ltab) { 06795 prev_ich = ich; 06796 } 06797 06798 ich = stmt_buf[idx]; 06799 } 06800 while (paren_lvl > 0); 06801 06802 TRACE (Func_Exit, "is_implied_do", NULL); 06803 06804 return(imp_do); 06805 06806 } /* is_implied_do */ 06807 06808 /******************************************************************************\ 06809 |* *| 06810 |* Description: *| 06811 |* Looks for a colon in a paren group, to tell the difference between *| 06812 |* a character function and a substring reference. *| 06813 |* *| 06814 |* Input parameters: *| 06815 |* NONE *| 06816 |* *| 06817 |* Output parameters: *| 06818 |* NONE *| 06819 |* *| 06820 |* Returns: *| 06821 |* TRUE if colon found. *| 06822 |* *| 06823 \******************************************************************************/ 06824 06825 boolean is_substring_ref (void) 06826 06827 { 06828 int ich; 06829 int idx; 06830 int line_idx; 06831 int paren_lvl = 0; 06832 boolean substring = FALSE; 06833 06834 TRACE (Func_Entry, "is_substring_ref", NULL); 06835 06836 idx = stmt_buf_idx; 06837 line_idx = stmt_line_idx; 06838 06839 ich = stmt_buf[idx]; 06840 do { 06841 if (ich == lparen) { 06842 paren_lvl++; 06843 } 06844 else if (ich == rparen) { 06845 paren_lvl--; 06846 } 06847 else if (ich == colon && paren_lvl == 1) { 06848 06849 if (substring) { 06850 substring = FALSE; 06851 break; 06852 } 06853 else { 06854 substring = TRUE; 06855 } 06856 } 06857 else if (ich == comma && paren_lvl == 1) { 06858 substring = FALSE; 06859 break; 06860 } 06861 06862 if (++idx == stmt_line_end_idx[line_idx]) { 06863 06864 if (line_idx < lines_in_buf) { 06865 ++line_idx; 06866 idx = stmt_line_start_idx[line_idx] 06867 + stmt_line_offset[line_idx] + 1; 06868 } 06869 else { 06870 break; 06871 } 06872 } 06873 ich = stmt_buf[idx]; 06874 } 06875 while (paren_lvl); 06876 06877 TRACE (Func_Exit, "is_substring_ref", NULL); 06878 06879 return(substring); 06880 } /* is_substring_ref */ 06881 06882 /******************************************************************************\ 06883 |* *| 06884 |* Description: *| 06885 |* Looks for an equal sign following the next identifier. Looks past *| 06886 |* the entire reference. *| 06887 |* *| 06888 |* Input parameters: *| 06889 |* NONE *| 06890 |* *| 06891 |* Output parameters: *| 06892 |* NONE *| 06893 |* *| 06894 |* Returns: *| 06895 |* TRUE if this identifier is the implied do control variable. *| 06896 |* *| 06897 \******************************************************************************/ 06898 06899 boolean next_id_is_imp_control(void) 06900 { 06901 boolean cont_var = FALSE; 06902 int ich; 06903 int idx; 06904 int line_idx; 06905 int paren_lvl = 0; 06906 06907 TRACE (Func_Entry, "next_id_is_imp_control", NULL); 06908 06909 idx = stmt_buf_idx; 06910 line_idx = stmt_line_idx; 06911 ich = stmt_buf[idx]; 06912 06913 do { 06914 if (ich == lparen) { 06915 paren_lvl++; 06916 } 06917 else if (ich == rparen) { 06918 paren_lvl--; 06919 } 06920 else if (paren_lvl != 0) { 06921 } 06922 else if (ich == equal) { 06923 cont_var = TRUE; 06924 break; 06925 } 06926 else if (ich == EOF) { 06927 break; 06928 } 06929 else if (ich == blank | 06930 ich == tab | 06931 ich == percent | 06932 ich == underscore | 06933 ich == dollar | 06934 ich == at_sign | 06935 ch_class[ich] == Ch_Class_Digit | 06936 ch_class[ich] == Ch_Class_Letter) { 06937 } 06938 else { 06939 break; 06940 } 06941 06942 if (++idx == stmt_line_end_idx[line_idx]) { 06943 06944 if (line_idx < lines_in_buf) { 06945 ++line_idx; 06946 idx = stmt_line_start_idx[line_idx] 06947 + stmt_line_offset[line_idx] + 1; 06948 } 06949 else { 06950 break; 06951 } 06952 } 06953 ich = stmt_buf[idx]; 06954 } 06955 while (paren_lvl >= 0); 06956 06957 TRACE (Func_Exit, "next_id_is_imp_control", NULL); 06958 06959 return(cont_var); 06960 06961 } /* next_id_is_imp_control */ 06962 06963 /******************************************************************************\ 06964 |* *| 06965 |* Description: *| 06966 |* Issue all deferred msgs. *| 06967 |* *| 06968 |* Input parameters: *| 06969 |* NONE *| 06970 |* *| 06971 |* Output parameters: *| 06972 |* NONE *| 06973 |* *| 06974 |* Returns: *| 06975 |* NOTHING *| 06976 |* *| 06977 \******************************************************************************/ 06978 06979 void issue_deferred_msgs (void) 06980 06981 { 06982 char *arg1; 06983 char *arg2; 06984 char *arg3; 06985 char *arg4; 06986 int i; 06987 char *ptr; 06988 06989 06990 TRACE (Func_Entry, "issue_deferred_msgs", NULL); 06991 06992 i = 1; 06993 06994 while (i <= msg_queue_idx) { 06995 06996 switch (msg_queue[i].order) { 06997 06998 case NO_ARG : 06999 PRINTMSG(msg_queue[i].line_num, msg_queue[i].msg_num, 07000 msg_queue[i].sever, msg_queue[i].col_num); 07001 break; 07002 07003 case STR_ARG : 07004 PRINTMSG(msg_queue[i].line_num, msg_queue[i].msg_num, 07005 msg_queue[i].sever, msg_queue[i].col_num, 07006 (char *) (&msg_queue[i+1])); 07007 break; 07008 07009 case ARG_ARG : 07010 PRINTMSG(msg_queue[i].line_num, msg_queue[i].msg_num, 07011 msg_queue[i].sever, msg_queue[i].col_num, 07012 msg_queue[i].arg); 07013 break; 07014 07015 case STR_ARG_ARG : 07016 PRINTMSG(msg_queue[i].line_num, msg_queue[i].msg_num, 07017 msg_queue[i].sever, msg_queue[i].col_num, 07018 (char *) (&msg_queue[i+1]), 07019 msg_queue[i].arg); 07020 break; 07021 07022 case ARG_STR_ARG : 07023 PRINTMSG(msg_queue[i].line_num, msg_queue[i].msg_num, 07024 msg_queue[i].sever, msg_queue[i].col_num, 07025 msg_queue[i].arg, 07026 (char *) (&msg_queue[i+1])); 07027 break; 07028 07029 case MULT_STR_ARG : 07030 07031 /* Find out how many arguments there are. There are at least 2 */ 07032 07033 ptr = (char *) (&msg_queue[i+1]); 07034 arg1 = strtok(ptr, "\n"); 07035 arg2 = strtok(NULL, "\n"); 07036 arg3 = strtok(NULL, "\n"); 07037 arg4 = NULL; 07038 07039 if (arg3 != NULL) { 07040 arg4 = strtok(NULL, "\n"); 07041 } 07042 07043 PRINTMSG(msg_queue[i].line_num, msg_queue[i].msg_num, 07044 msg_queue[i].sever, msg_queue[i].col_num, 07045 arg1, arg2, arg3, arg4); 07046 break; 07047 } 07048 07049 i = msg_queue[i].next_msg; 07050 } 07051 07052 msg_queue_idx = NULL_IDX; 07053 07054 TRACE (Func_Exit, "issue_deferred_msgs", NULL); 07055 07056 return; 07057 07058 } /* <func name> */ 07059 07060 07061 # ifdef _DEBUG 07062 07063 /******************************************************************************\ 07064 |* *| 07065 |* Description: *| 07066 |* Print a single src_stk entry to stderr. This routine exist in this *| 07067 |* file because the definition of src_stk and the macros that access it *| 07068 |* are defined in src_input.h and src_input.m. *| 07069 |* *| 07070 |* Input parameters: *| 07071 |* The index of the src_stk entry to display. *| 07072 |* *| 07073 |* Output parameters: *| 07074 |* NONE *| 07075 |* *| 07076 |* Returns: *| 07077 |* NOTHING *| 07078 |* *| 07079 \******************************************************************************/ 07080 07081 void print_src_stk_entry(int ss_idx) 07082 07083 { 07084 char file_type[12]; 07085 07086 07087 TRACE (Func_Entry, "print_src_stk_entry", NULL); 07088 07089 switch (SRC_STK_FILE_TYPE(ss_idx)) { 07090 07091 case Stdin_Src: 07092 strcpy(file_type, "Stdin_Src"); 07093 break; 07094 07095 case Input_Src: 07096 strcpy(file_type, "Input_Src"); 07097 break; 07098 07099 case Include_Src: 07100 strcpy(file_type, "Include_Src"); 07101 } 07102 07103 fprintf(stderr, "Entry #%3d File line = %-5d%12sFile type = %s\n" 07104 "%13sPrev src form = %10s File name start = %d\n" 07105 "%13sFull path name = %s", 07106 ss_idx, SRC_STK_FILE_LINE(ss_idx), " ", file_type, 07107 " ", (SRC_STK_PREV_SRC_FORM(ss_idx) == Fixed_Form) ? 07108 "Fixed Form" : "Free Form", 07109 SRC_STK_FILE_IDX(ss_idx), 07110 " ", SRC_STK_PATH_NAME(ss_idx)); 07111 07112 fprintf(stderr, "\n%13sCIF file id = %d", 07113 " ", SRC_STK_CIF_FILE_ID(ss_idx)); 07114 07115 putc('\n', stderr); 07116 07117 TRACE (Func_Exit, "print_src_stk_entry", NULL); 07118 07119 return; 07120 07121 } /* print_src_stk_entry */ 07122 07123 07124 /******************************************************************************\ 07125 |* *| 07126 |* Description: *| 07127 |* Used by mem_report to print starting info about the src tables. *| 07128 |* *| 07129 |* Input parameters: *| 07130 |* NONE *| 07131 |* *| 07132 |* Output parameters: *| 07133 |* NONE *| 07134 |* *| 07135 |* Returns: *| 07136 |* NOTHING *| 07137 |* *| 07138 \******************************************************************************/ 07139 07140 void print_src_input_tbls(void) 07141 07142 { 07143 fprintf (debug_file, "%-20s %-9s= %-8d %-9s= %-6d %-9s= %-7d\n", 07144 "msg_queue", 07145 "init size", msg_queue_init_size, 07146 "increment", msg_queue_inc, 07147 "num words", msg_queue_num_wds); 07148 fprintf (debug_file, "%-20s %-9s= %-8d %-9s= %-6d %-9s= %-7d\n", 07149 "src_stk", 07150 "init size", src_stk_init_size, 07151 "increment", src_stk_inc, 07152 "num words", src_stk_num_wds); 07153 07154 return; 07155 07156 } /* print_src_input_tbls */ 07157 # endif 07158 07159 /******************************************************************************\ 07160 |* *| 07161 |* Description: *| 07162 |* This scan routine makes the guess about whether a digit string is *| 07163 |* a format label or the start of a something else. *| 07164 |* *| 07165 |* Input parameters: *| 07166 |* NONE *| 07167 |* *| 07168 |* Output parameters: *| 07169 |* NONE *| 07170 |* *| 07171 |* Returns: *| 07172 |* NOTHING *| 07173 |* *| 07174 \******************************************************************************/ 07175 07176 boolean digit_is_format_label(void) 07177 07178 { 07179 int ich; 07180 int idx; 07181 boolean is_label = TRUE; 07182 int lblank = ' '; 07183 int line_idx; 07184 int ltab = '\t'; 07185 07186 TRACE (Func_Entry, "digit_is_format_label", NULL); 07187 07188 idx = stmt_buf_idx; 07189 line_idx = stmt_line_idx; 07190 ich = stmt_buf[idx]; 07191 07192 if (source_form == Free_Form) { 07193 lblank = -1; 07194 ltab = -1; 07195 } 07196 07197 while (ich != EOF && (ch_class[ich] == Ch_Class_Digit || 07198 ich == lblank || ich == ltab)) { 07199 07200 if (++idx == stmt_line_end_idx[line_idx]) { 07201 07202 if (line_idx < lines_in_buf) { 07203 ++line_idx; 07204 idx = stmt_line_start_idx[line_idx] 07205 + stmt_line_offset[line_idx] + 1; 07206 } 07207 else { 07208 break; 07209 } 07210 } 07211 ich = stmt_buf[idx]; 07212 } 07213 07214 if (ich == dot || 07215 ich == underscore || 07216 ich == lc_d || ich == uc_d || 07217 ich == lc_e || ich == uc_e || 07218 ich == lc_b || ich == uc_b || 07219 ich == lc_h || ich == uc_h || 07220 ich == lc_l || ich == uc_l || 07221 ich == lc_r || ich == uc_r) { 07222 07223 is_label = FALSE; 07224 } 07225 07226 TRACE (Func_Exit, "digit_is_format_label", NULL); 07227 07228 return(is_label); 07229 07230 } /* digit_is_format_label */ 07231 07232 /******************************************************************************\ 07233 |* *| 07234 |* Description: *| 07235 |* This routine returns the base path name for the file. It exists *| 07236 |* because src_stk is only defined in terms of this module and it *| 07237 |* would be quite an implementation to move all this out to the *| 07238 |* global level. This is only used by the PDGCS_debug_init call. *| 07239 |* *| 07240 |* Input parameters: *| 07241 |* NONE *| 07242 |* *| 07243 |* Output parameters: *| 07244 |* NONE *| 07245 |* *| 07246 |* Returns: *| 07247 |* NOTHING *| 07248 |* *| 07249 \******************************************************************************/ 07250 07251 char *get_src_path_name(void) 07252 { 07253 07254 return(SRC_STK_PATH_NAME(SRC_STK_BASE_IDX)); 07255 07256 } /* get_src_path_name */ 07257 07258 07259 07260 /******************************************************************************\ 07261 |* *| 07262 |* Description: *| 07263 |* This routine checks to see if the next two characters are (/. *| 07264 |* *| 07265 |* Input parameters: *| 07266 |* NONE *| 07267 |* *| 07268 |* Output parameters: *| 07269 |* NONE *| 07270 |* *| 07271 |* Returns: *| 07272 |* NOTHING *| 07273 |* *| 07274 \******************************************************************************/ 07275 07276 boolean next_tok_is_paren_slash(void) 07277 07278 { 07279 int ich; 07280 int idx; 07281 int line_idx; 07282 int lblank = ' '; 07283 int ltab = '\t'; 07284 boolean paren_slash = FALSE; 07285 07286 TRACE (Func_Entry, "next_tok_is_paren_slash", NULL); 07287 07288 idx = stmt_buf_idx; 07289 line_idx = stmt_line_idx; 07290 07291 if (source_form != Fixed_Form) { 07292 lblank = -1; 07293 ltab = -1; 07294 } 07295 07296 ich = stmt_buf[idx]; 07297 07298 if (ich == lparen) { 07299 07300 do { 07301 idx++; 07302 07303 if (idx == stmt_line_end_idx[line_idx]) { 07304 07305 if (line_idx < lines_in_buf) { 07306 ++line_idx; 07307 idx = stmt_line_start_idx[line_idx] 07308 + stmt_line_offset[line_idx] + 1; 07309 } 07310 else { 07311 break; 07312 } 07313 } 07314 07315 ich = stmt_buf[idx]; 07316 } 07317 while (ich == lblank | ich == ltab); 07318 07319 if (ich == slash) { 07320 paren_slash = TRUE; 07321 } 07322 } 07323 07324 07325 TRACE (Func_Exit, "next_tok_is_paren_slash", NULL); 07326 07327 return(paren_slash); 07328 07329 } /* next_tok_is_paren_slash */ 07330 07331 /******************************************************************************\ 07332 |* *| 07333 |* Description: *| 07334 |* Search back from the LA_CH to find the column and line of the previous*| 07335 |* significant character. *| 07336 |* *| 07337 |* Input parameters: *| 07338 |* NONE *| 07339 |* *| 07340 |* Output parameters: *| 07341 |* NONE *| 07342 |* *| 07343 |* Returns: *| 07344 |* NOTHING *| 07345 |* *| 07346 \******************************************************************************/ 07347 07348 void prev_char_line_and_col(int *line, 07349 int *col) 07350 07351 { 07352 int ich; 07353 int idx; 07354 int line_idx; 07355 07356 TRACE (Func_Entry, "prev_char_line_and_col", NULL); 07357 07358 idx = stmt_buf_idx; 07359 line_idx = stmt_line_idx; 07360 07361 do { 07362 07363 idx--; 07364 07365 if (idx <= stmt_line_start_idx[line_idx] + stmt_line_offset[line_idx]) { 07366 07367 if (line_idx > 1) { 07368 line_idx--; 07369 idx = stmt_line_end_idx[line_idx]; 07370 ich = blank; 07371 continue; 07372 } 07373 else { 07374 break; 07375 } 07376 } 07377 07378 ich = stmt_buf[idx]; 07379 } 07380 while (ich == blank | ich == tab); 07381 07382 *line = stmt_line_num[line_idx]; 07383 *col = stmt_buf_col[idx]; 07384 07385 TRACE (Func_Exit, "prev_char_line_and_col", NULL); 07386 07387 return; 07388 07389 } /* prev_char_line_and_col */ 07390 07391 /******************************************************************************\ 07392 |* *| 07393 |* Description: *| 07394 |* This routine is called when the initial token of a stmt is Savelast. *| 07395 |* If in free form, just return false. If in fixed form, this becomes *| 07396 |* a SAVE stmt. LA_CH must be reset to be the "L" in LAST. *| 07397 |* *| 07398 |* Input parameters: *| 07399 |* NONE *| 07400 |* *| 07401 |* Output parameters: *| 07402 |* NONE *| 07403 |* *| 07404 |* Returns: *| 07405 |* NOTHING *| 07406 |* *| 07407 \******************************************************************************/ 07408 07409 boolean stmt_is_save_stmt(int buf_idx, int stmt_num) 07410 07411 { 07412 boolean is_save_stmt = FALSE; 07413 07414 TRACE (Func_Entry, "stmt_is_save_stmt", NULL); 07415 07416 if (source_form == Free_Form) { 07417 goto EXIT; 07418 } 07419 else { 07420 is_save_stmt = TRUE; 07421 } 07422 07423 reset_src_input(buf_idx, stmt_num); 07424 07425 while (LA_CH_VALUE != 'L') { 07426 NEXT_LA_CH; 07427 } 07428 07429 EXIT: 07430 07431 TRACE (Func_Exit, "stmt_is_save_stmt", NULL); 07432 07433 return(is_save_stmt); 07434 07435 } /* stmt_is_save_stmt */ 07436 07437 /******************************************************************************\ 07438 |* *| 07439 |* Description: *| 07440 |* This routine adds a message to the message queue. *| 07441 |* *| 07442 |* Input parameters: *| 07443 |* NONE *| 07444 |* *| 07445 |* Output parameters: *| 07446 |* NONE *| 07447 |* *| 07448 |* Returns: *| 07449 |* NOTHING *| 07450 |* *| 07451 \******************************************************************************/ 07452 07453 void ntr_msg_queue(int line, 07454 int msg_num, 07455 msg_severities_type severity, 07456 int column, 07457 char *str, 07458 long arg, 07459 int order) 07460 07461 { 07462 char *char_idx; 07463 int idx; 07464 int length; 07465 int next_msg_idx; 07466 int num_entries; 07467 07468 07469 TRACE (Func_Entry, "ntr_msg_queue", NULL); 07470 07471 if (msg_queue_size == 0) { 07472 CHECK_INITIAL_ALLOC(msg_queue, 1); 07473 } 07474 else { 07475 TBL_REALLOC_CK(msg_queue, 1); 07476 } 07477 07478 CLEAR_TBL_NTRY(msg_queue, msg_queue_idx); 07479 07480 msg_queue[msg_queue_idx].line_num = line; 07481 msg_queue[msg_queue_idx].col_num = column; 07482 msg_queue[msg_queue_idx].sever = severity; 07483 msg_queue[msg_queue_idx].msg_num = msg_num; 07484 msg_queue[msg_queue_idx].order = order; 07485 msg_queue[msg_queue_idx].arg = arg; 07486 07487 if (str == NULL) { 07488 msg_queue[msg_queue_idx].str_len = 0; 07489 msg_queue[msg_queue_idx].next_msg = msg_queue_idx + 1; 07490 } 07491 else { 07492 next_msg_idx = msg_queue_idx + 1; 07493 length = strlen(str); 07494 num_entries = (WORD_LEN(length) + NUM_MQ_WDS-1) / NUM_MQ_WDS; 07495 msg_queue_idx += num_entries; 07496 07497 msg_queue[next_msg_idx - 1].next_msg = msg_queue_idx + 1; 07498 msg_queue[next_msg_idx - 1].str_len = length; 07499 07500 CHECK_TBL_ALLOC_SIZE(msg_queue, msg_queue_idx); 07501 07502 char_idx = ((char *) (&msg_queue[next_msg_idx])); 07503 07504 for (idx = 0; idx < num_entries; idx++) { 07505 CLEAR_TBL_NTRY(msg_queue, next_msg_idx + idx); 07506 } 07507 07508 strcpy(char_idx, str); 07509 } 07510 07511 TRACE (Func_Exit, "ntr_msg_queue", NULL); 07512 07513 return; 07514 07515 } /* ntr_msg_queue */ 07516 07517 /******************************************************************************\ 07518 |* *| 07519 |* Description: *| 07520 |* This routine adds a message to the message queue for the next_line. *| 07521 |* *| 07522 |* Input parameters: *| 07523 |* NONE *| 07524 |* *| 07525 |* Output parameters: *| 07526 |* NONE *| 07527 |* *| 07528 |* Returns: *| 07529 |* NOTHING *| 07530 |* *| 07531 \******************************************************************************/ 07532 07533 void ntr_next_msg_queue(int line, 07534 int msg_num, 07535 msg_severities_type severity, 07536 int column, 07537 char *str, 07538 long arg, 07539 int order) 07540 07541 { 07542 char *char_idx; 07543 int idx; 07544 int length; 07545 int next_msg_idx; 07546 int num_entries; 07547 07548 07549 TRACE (Func_Entry, "ntr_next_msg_queue", NULL); 07550 07551 if (next_msg_queue_size == 0) { 07552 CHECK_INITIAL_ALLOC(next_msg_queue, 1); 07553 } 07554 else { 07555 TBL_REALLOC_CK(next_msg_queue, 1); 07556 } 07557 07558 CLEAR_TBL_NTRY(next_msg_queue, next_msg_queue_idx); 07559 07560 next_msg_queue[next_msg_queue_idx].line_num = line; 07561 next_msg_queue[next_msg_queue_idx].col_num = column; 07562 next_msg_queue[next_msg_queue_idx].sever = severity; 07563 next_msg_queue[next_msg_queue_idx].msg_num = msg_num; 07564 next_msg_queue[next_msg_queue_idx].order = order; 07565 next_msg_queue[next_msg_queue_idx].arg = arg; 07566 07567 if (str == NULL) { 07568 next_msg_queue[next_msg_queue_idx].str_len = 0; 07569 next_msg_queue[next_msg_queue_idx].next_msg = next_msg_queue_idx + 1; 07570 } 07571 else { 07572 next_msg_idx = next_msg_queue_idx + 1; 07573 length = strlen(str); 07574 num_entries = (WORD_LEN(length) + NUM_MQ_WDS-1) / NUM_MQ_WDS; 07575 next_msg_queue_idx += num_entries; 07576 07577 next_msg_queue[next_msg_idx - 1].next_msg = next_msg_queue_idx + 1; 07578 next_msg_queue[next_msg_idx - 1].str_len = length; 07579 07580 CHECK_TBL_ALLOC_SIZE(next_msg_queue, next_msg_queue_idx); 07581 07582 char_idx = ((char *) (&next_msg_queue[next_msg_idx])); 07583 07584 for (idx = 0; idx < num_entries; idx++) { 07585 CLEAR_TBL_NTRY(next_msg_queue, next_msg_idx + idx); 07586 } 07587 07588 strcpy(char_idx, str); 07589 } 07590 07591 TRACE (Func_Exit, "ntr_next_msg_queue", NULL); 07592 07593 return; 07594 07595 } /* ntr_next_msg_queue */ 07596 07597 07598 /******************************************************************************\ 07599 |* *| 07600 |* Description: *| 07601 |* Move the contents of next_msg_queue into msg_queue. *| 07602 |* *| 07603 |* Input parameters: *| 07604 |* NONE *| 07605 |* *| 07606 |* Output parameters: *| 07607 |* NONE *| 07608 |* *| 07609 |* Returns: *| 07610 |* NOTHING *| 07611 |* *| 07612 \******************************************************************************/ 07613 07614 static void move_up_next_msg_queue(void) 07615 07616 { 07617 char *chptr; 07618 int i; 07619 int k; 07620 boolean duplicate; 07621 07622 TRACE (Func_Entry, "move_up_next_msg_queue", NULL); 07623 07624 i = 1; 07625 while (i <= next_msg_queue_idx) { 07626 07627 duplicate = FALSE; 07628 07629 switch(next_msg_queue[i].order) { 07630 case NO_ARG : 07631 case ARG_ARG : 07632 chptr = NULL; 07633 break; 07634 07635 case STR_ARG : 07636 case STR_ARG_ARG : 07637 case ARG_STR_ARG : 07638 chptr = (char *) (&next_msg_queue[i+1]); 07639 break; 07640 } 07641 07642 k = 1; 07643 07644 while (k < i) { 07645 if (next_msg_queue[k].msg_num == next_msg_queue[i].msg_num && 07646 next_msg_queue[k].line_num == next_msg_queue[i].line_num && 07647 next_msg_queue[k].col_num == next_msg_queue[i].col_num) { 07648 07649 duplicate = TRUE; 07650 break; 07651 } 07652 07653 k = next_msg_queue[k].next_msg; 07654 } 07655 07656 if (extra_nxt_line != NULL_IDX && 07657 next_msg_queue[i].line_num == pp_nxt_line_num[extra_nxt_line]) { 07658 07659 /* this will be classified again, so skip this message */ 07660 duplicate = TRUE; 07661 } 07662 07663 if (! duplicate ) { 07664 ntr_msg_queue(next_msg_queue[i].line_num, 07665 next_msg_queue[i].msg_num, 07666 next_msg_queue[i].sever, 07667 next_msg_queue[i].col_num, 07668 chptr, 07669 next_msg_queue[i].arg, 07670 next_msg_queue[i].order); 07671 } 07672 07673 i = next_msg_queue[i].next_msg; 07674 } 07675 07676 next_msg_queue_idx = NULL_IDX; 07677 07678 TRACE (Func_Exit, "move_up_next_msg_queue", NULL); 07679 07680 return; 07681 07682 } /* move_up_next_msg_queue */ 07683 07684 # ifdef _DEBUG 07685 07686 /******************************************************************************\ 07687 |* *| 07688 |* Description: *| 07689 |* This routine is called after compilation to gather memory usage *| 07690 |* statistics. *| 07691 |* *| 07692 |* Input parameters: *| 07693 |* NONE *| 07694 |* *| 07695 |* Output parameters: *| 07696 |* NONE *| 07697 |* *| 07698 |* Returns: *| 07699 |* NOTHING *| 07700 |* *| 07701 \******************************************************************************/ 07702 07703 void final_src_input(void) 07704 07705 { 07706 TRACE (Func_Entry, "final_src_input", NULL); 07707 07708 MEM_REPORT(src_stk); 07709 MEM_REPORT(msg_queue); 07710 07711 TRACE (Func_Exit, "final_src_input", NULL); 07712 07713 return; 07714 07715 } /* final_src_input */ 07716 # endif 07717 07718 /******************************************************************************\ 07719 |* *| 07720 |* Description: *| 07721 |* <description> *| 07722 |* *| 07723 |* Input parameters: *| 07724 |* NONE *| 07725 |* *| 07726 |* Output parameters: *| 07727 |* NONE *| 07728 |* *| 07729 |* Returns: *| 07730 |* NOTHING *| 07731 |* *| 07732 \******************************************************************************/ 07733 07734 void preprocess_only_driver(void) 07735 07736 { 07737 TRACE (Func_Entry, "preprocess_only_driver", NULL); 07738 07739 nxt_line_type = Comment_Line; 07740 include_found = FALSE; 07741 include_switch = FALSE; 07742 include_complete = FALSE; 07743 07744 issue_classify_msg = FALSE; 07745 07746 while (nxt_line_type != EOF_Line) { 07747 07748 nxt_line_type = Regular_Line; 07749 07750 if (get_nxt_line()) { 07751 07752 if (include_switch) { 07753 update_global_line(); /* enter global_line_tbl */ 07754 include_switch = FALSE; 07755 } 07756 07757 if (issue_pound_exit_line) { 07758 OUTPUT_POUND_INCLUDE_EXIT_LINE(curr_glb_line); 07759 issue_pound_exit_line = FALSE; 07760 } 07761 07762 nxt_line_mp_line = FALSE; 07763 07764 if (nxt_line_type != Cond_Comp_Line) { 07765 PP_ORIG_SIZE = line_size; 07766 classify_line(); 07767 } 07768 07769 if (change_source_form) { 07770 if (source_form == Fixed_Form) { 07771 source_form = Free_Form; 07772 line_size = FREE_SRC_LINE_SIZE; 07773 expected_line = Regular_Line; 07774 } 07775 else { 07776 source_form = Fixed_Form; 07777 if (cmd_line_flags.line_size_80) { 07778 line_size = FIXED_SRC_LINE_SIZE_80; 07779 } 07780 else if (cmd_line_flags.line_size_132) { 07781 line_size = FIXED_SRC_LINE_SIZE_132; 07782 } 07783 else { 07784 line_size = FIXED_SRC_LINE_SIZE_72; 07785 } 07786 } 07787 07788 change_source_form = FALSE; 07789 } 07790 07791 if (nxt_line_type == Cond_Comp_Line) { 07792 07793 fprintf(dot_i_fptr, "\n"); 07794 previous_global_line++; 07795 07796 if (parse_cc_line()) { 07797 07798 /* if result is true, then it was an include line */ 07799 07800 include_stmt_file_line = SRC_STK_FILE_LINE(src_stk_idx); 07801 07802 if (open_include_file (TRUE)) { 07803 include_found = TRUE; /* flag begin of file */ 07804 include_switch = TRUE; /* flag file switch */ 07805 } 07806 } 07807 07808 } 07809 else { 07810 if (ignore_source_line) { 07811 07812 fprintf(dot_i_fptr, "\n"); 07813 previous_global_line++; 07814 } 07815 else { 07816 print_nxt_line(); 07817 } 07818 } 07819 } 07820 else { 07821 /* need to bump up pp_line_idx since classify_line was not called */ 07822 07823 if (cmd_line_flags.pp_macro_expansion) { 07824 pp_line_idx++; 07825 } 07826 07827 /* check for termination of include file */ 07828 07829 if (src_stk_idx > SRC_STK_BASE_IDX) { /* curr src is include*/ 07830 include_complete = TRUE; /* flag end of file */ 07831 nxt_line_type = Comment_Line; /* make EOF a comment */ 07832 curr_glb_line--; /* don't count this line */ 07833 07834 GL_SOURCE_LINES(SRC_STK_GLOBAL_LINE_IDX(src_stk_idx)) = 07835 SRC_STK_FILE_LINE(src_stk_idx); 07836 set_related_gl_source_lines(SRC_STK_GLOBAL_LINE_IDX(src_stk_idx)); 07837 07838 if (source_form != SRC_STK_PREV_SRC_FORM(src_stk_idx)) { 07839 change_source_form = TRUE; 07840 } 07841 POP_SRC; 07842 include_switch = TRUE; /* flag file switch */ 07843 issue_pound_exit_line = TRUE; 07844 } 07845 else { /* curr src is input */ 07846 GL_SOURCE_LINES(SRC_STK_GLOBAL_LINE_IDX(src_stk_idx)) = 07847 SRC_STK_FILE_LINE(src_stk_idx); 07848 set_related_gl_source_lines(SRC_STK_GLOBAL_LINE_IDX(src_stk_idx)); 07849 nxt_line_type = EOF_Line; /* end of compilation */ 07850 nxt_line_EOL = 0; 07851 } 07852 } 07853 07854 move_up_next_msg_queue(); 07855 } 07856 07857 issue_classify_msg = TRUE; 07858 07859 TRACE (Func_Exit, "preprocess_only_driver", NULL); 07860 07861 return; 07862 07863 } /* preprocess_only_driver */ 07864 07865 /******************************************************************************\ 07866 |* *| 07867 |* Description: *| 07868 |* <description> *| 07869 |* *| 07870 |* Input parameters: *| 07871 |* NONE *| 07872 |* *| 07873 |* Output parameters: *| 07874 |* NONE *| 07875 |* *| 07876 |* Returns: *| 07877 |* NOTHING *| 07878 |* *| 07879 \******************************************************************************/ 07880 07881 void set_related_gl_source_lines(int gl_idx) 07882 07883 { 07884 int i; 07885 int id; 07886 07887 TRACE (Func_Entry, "set_related_gl_source_lines", NULL); 07888 07889 id = GL_CIF_FILE_ID(gl_idx); 07890 07891 for (i = gl_idx - 1; i > 0; i--) { 07892 if (GL_CIF_FILE_ID(i) == id) { 07893 GL_SOURCE_LINES(i) = GL_SOURCE_LINES(gl_idx); 07894 } 07895 } 07896 07897 TRACE (Func_Exit, "set_related_gl_source_lines", NULL); 07898 07899 return; 07900 07901 } /* set_related_gl_source_lines */ 07902 07903 /******************************************************************************\ 07904 |* *| 07905 |* Description: *| 07906 |* <description> *| 07907 |* *| 07908 |* Input parameters: *| 07909 |* NONE *| 07910 |* *| 07911 |* Output parameters: *| 07912 |* NONE *| 07913 |* *| 07914 |* Returns: *| 07915 |* NOTHING *| 07916 |* *| 07917 \******************************************************************************/ 07918 07919 int ntr_io_string_constant(void) 07920 07921 { 07922 char *char_ptr; 07923 int cn_idx = NULL_IDX; 07924 long count = 0; 07925 int idx; 07926 int ich; 07927 int line_idx; 07928 int type_idx; 07929 07930 TRACE (Func_Entry, "ntr_io_string_constant", NULL); 07931 07932 /* first, count the significant characters */ 07933 07934 for (line_idx = 1; line_idx <= lines_in_buf; line_idx++) { 07935 idx = stmt_line_start_idx[line_idx] + stmt_line_offset[line_idx] + 1; 07936 07937 while (idx < stmt_line_end_idx[line_idx]) { 07938 07939 ich = stmt_buf[idx]; 07940 07941 # ifndef SOURCE_TO_SOURCE 07942 #if 0 07943 if (ich == blank | ich == tab | ich == newline) { 07944 /* intentionally blank */ 07945 } 07946 else 07947 #endif 07948 # endif 07949 { 07950 count++; 07951 } 07952 idx++; 07953 } 07954 } 07955 07956 /* get an empty character constant */ 07957 07958 CLEAR_TBL_NTRY(type_tbl, TYP_WORK_IDX); 07959 TYP_TYPE(TYP_WORK_IDX) = Character; 07960 TYP_LINEAR(TYP_WORK_IDX) = CHARACTER_DEFAULT_TYPE; 07961 TYP_DESC(TYP_WORK_IDX) = Default_Typed; 07962 TYP_CHAR_CLASS(TYP_WORK_IDX) = Const_Len_Char; 07963 TYP_FLD(TYP_WORK_IDX) = CN_Tbl_Idx; 07964 TYP_IDX(TYP_WORK_IDX) = C_INT_TO_CN(CG_INTEGER_DEFAULT_TYPE, count), 07965 type_idx = ntr_type_tbl(); 07966 cn_idx = ntr_const_tbl(type_idx, TRUE, NULL); 07967 07968 /* fill in the character constant */ 07969 07970 char_ptr = (char *) &CN_CONST(cn_idx); 07971 07972 count = 0; 07973 07974 for (line_idx = 1; line_idx <= lines_in_buf; line_idx++) { 07975 idx = stmt_line_start_idx[line_idx] + stmt_line_offset[line_idx] + 1; 07976 07977 while (idx < stmt_line_end_idx[line_idx]) { 07978 07979 ich = stmt_buf[idx]; 07980 07981 # ifndef SOURCE_TO_SOURCE 07982 #if 0 07983 if (ich == blank | ich == tab | ich == newline) { 07984 /* intentionally blank */ 07985 } 07986 else 07987 #endif 07988 # endif 07989 07990 { 07991 char_ptr[count] = ich; 07992 count++; 07993 } 07994 idx++; 07995 } 07996 } 07997 07998 07999 TRACE (Func_Exit, "ntr_io_string_constant", NULL); 08000 08001 return(cn_idx); 08002 08003 } /* ntr_io_string_constant */ 08004 08005 /******************************************************************************\ 08006 |* *| 08007 |* Description: *| 08008 |* <description> *| 08009 |* *| 08010 |* Input parameters: *| 08011 |* NONE *| 08012 |* *| 08013 |* Output parameters: *| 08014 |* NONE *| 08015 |* *| 08016 |* Returns: *| 08017 |* NOTHING *| 08018 |* *| 08019 \******************************************************************************/ 08020 08021 boolean omp_extension_prefix(int line) 08022 08023 { 08024 boolean is_extension = FALSE; 08025 int line_idx; 08026 08027 TRACE (Func_Entry, "omp_extension_prefix", NULL); 08028 08029 for (line_idx = 1; line_idx <= lines_in_buf; line_idx++) { 08030 if (line == stmt_line_num[line_idx]) { 08031 break; 08032 } 08033 } 08034 08035 if (line_idx <= lines_in_buf && 08036 line_dir_prefix[line_idx] == Csgi_Dir) { 08037 08038 is_extension = TRUE; 08039 } 08040 08041 08042 TRACE (Func_Exit, "omp_extension_prefix", NULL); 08043 08044 return(is_extension); 08045 08046 } /* omp_extension_prefix */ 08047 08048 /******************************************************************************\ 08049 |* *| 08050 |* Description: *| 08051 |* <description> *| 08052 |* *| 08053 |* Input parameters: *| 08054 |* NONE *| 08055 |* *| 08056 |* Output parameters: *| 08057 |* NONE *| 08058 |* *| 08059 |* Returns: *| 08060 |* NOTHING *| 08061 |* *| 08062 \******************************************************************************/ 08063 08064 static void print_nxt_line(void) 08065 08066 { 08067 int break_point; 08068 char ch; 08069 int i; 08070 int remaining_room; 08071 int whats_left; 08072 boolean continued_line = FALSE; 08073 08074 TRACE (Func_Entry, "print_nxt_line", NULL); 08075 08076 if (PP_LINE_TYPE == Comment_Line && 08077 nxt_line[NXT_COL(1)] == '#') { 08078 08079 for (i = NXT_COL(1); i < nxt_line_end_idx[pp_line_idx]; i++) { 08080 fprintf(dot_i_fptr, "%c", (char)nxt_line[i]); 08081 } 08082 goto EXIT; 08083 } 08084 08085 i = 1; 08086 whats_left = PP_IDX_TO_COL(PP_EOL) - 1; 08087 remaining_room = line_size; 08088 08089 while (whats_left > 0) { 08090 08091 if (whats_left > remaining_room && 08092 PP_LINE_TYPE != Comment_Line) { 08093 /* find break_point */ 08094 break_point = i + remaining_room - 2; 08095 08096 while (ch_class[nxt_line[NXT_COL(break_point)]] == Ch_Class_Letter || 08097 ch_class[nxt_line[NXT_COL(break_point)]] == Ch_Class_Digit || 08098 nxt_line[NXT_COL(break_point)] == USCORE || 08099 nxt_line[NXT_COL(break_point)] == DOLLAR || 08100 nxt_line[NXT_COL(break_point)] == AT_SIGN) { 08101 08102 break_point--; 08103 } 08104 } 08105 else { 08106 break_point = -1; 08107 } 08108 08109 if (PP_LINE_TYPE == Comment_Line) { 08110 previous_global_line++; 08111 } 08112 else { 08113 if (PP_LINE_NUM != previous_global_line + 1 && 08114 ! continued_line) { 08115 OUTPUT_POUND_LINE_NUM(PP_LINE_NUM); 08116 } 08117 08118 previous_global_line = PP_LINE_NUM; 08119 } 08120 08121 while (i != break_point && 08122 (ch = nxt_line[NXT_COL(i)]) != newline && ch != eos) { 08123 08124 if (i == 1 && 08125 PP_MP_LINE) { 08126 08127 /* replace blanks with !$ */ 08128 08129 fprintf(dot_i_fptr, "!$"); 08130 i += 2; 08131 whats_left -= 2; 08132 } 08133 else { 08134 fprintf(dot_i_fptr, "%c", ch); 08135 i++; 08136 whats_left--; 08137 } 08138 } 08139 08140 if (i == break_point) { 08141 /* continue the line */ 08142 remaining_room = line_size; 08143 continued_line = TRUE; 08144 08145 if (source_form == Fixed_Form) { 08146 fprintf(dot_i_fptr, "\n"); 08147 OUTPUT_POUND_LINE_NUM(PP_LINE_NUM); 08148 08149 if (PP_LINE_TYPE == Dir_Line) { 08150 switch (PP_ACTUAL_DIR_PREFIX) { 08151 case Cdir_Dir: 08152 fprintf(dot_i_fptr, "!DIR$& "); 08153 remaining_room -= 7; 08154 break; 08155 08156 case Cmic_Dir: 08157 fprintf(dot_i_fptr, "!MIC$& "); 08158 remaining_room -= 7; 08159 break; 08160 08161 case Cpar_Dir: 08162 fprintf(dot_i_fptr, "!$PAR& "); 08163 remaining_room -= 7; 08164 break; 08165 08166 case Cstar_Dir: 08167 fprintf(dot_i_fptr, "!*$*& "); 08168 remaining_room -= 6; 08169 break; 08170 08171 case Cdollar_Dir: 08172 fprintf(dot_i_fptr, "!$& "); 08173 remaining_room -= 4; 08174 break; 08175 08176 case Comp_Dir: 08177 fprintf(dot_i_fptr, "!$OMP& "); 08178 remaining_room -= 7; 08179 break; 08180 08181 case Cdbg_Dir: 08182 fprintf(dot_i_fptr, "!DBG$& "); 08183 remaining_room -= 7; 08184 break; 08185 08186 case Csgi_Dir: 08187 fprintf(dot_i_fptr, "!$SGI& "); 08188 remaining_room -= 7; 08189 break; 08190 08191 /* eraxxon: OpenAD directive */ 08192 case Copenad_Dir: 08193 fprintf(dot_i_fptr, "!$OPENAD& "); 08194 remaining_room -= 10; 08195 break; 08196 08197 } 08198 } 08199 else if (PP_MP_LINE) { 08200 fprintf(dot_i_fptr, "!$ ."); 08201 remaining_room -= 7; 08202 } 08203 else { 08204 fprintf(dot_i_fptr, " ."); 08205 remaining_room -= 7; 08206 } 08207 } 08208 else { 08209 /* source == Free_Form */ 08210 08211 if (PP_LINE_TYPE == Dir_Line) { 08212 switch (PP_ACTUAL_DIR_PREFIX) { 08213 case Cdir_Dir: 08214 fprintf(dot_i_fptr, "\n"); 08215 OUTPUT_POUND_LINE_NUM(PP_LINE_NUM); 08216 fprintf(dot_i_fptr, "!DIR$& "); 08217 remaining_room -= 7; 08218 break; 08219 08220 case Cmic_Dir: 08221 fprintf(dot_i_fptr, "\n"); 08222 OUTPUT_POUND_LINE_NUM(PP_LINE_NUM); 08223 fprintf(dot_i_fptr, "!MIC$& "); 08224 remaining_room -= 7; 08225 break; 08226 08227 case Cpar_Dir: 08228 fprintf(dot_i_fptr, "\n"); 08229 OUTPUT_POUND_LINE_NUM(PP_LINE_NUM); 08230 fprintf(dot_i_fptr, "!$PAR& "); 08231 remaining_room -= 7; 08232 break; 08233 08234 case Cstar_Dir: 08235 fprintf(dot_i_fptr, "\n"); 08236 OUTPUT_POUND_LINE_NUM(PP_LINE_NUM); 08237 fprintf(dot_i_fptr, "!*$*& "); 08238 remaining_room -= 6; 08239 break; 08240 08241 case Cdollar_Dir: 08242 fprintf(dot_i_fptr, "\n"); 08243 OUTPUT_POUND_LINE_NUM(PP_LINE_NUM); 08244 fprintf(dot_i_fptr, "!$& "); 08245 remaining_room -= 4; 08246 break; 08247 08248 case Comp_Dir: 08249 fprintf(dot_i_fptr, "&\n"); 08250 OUTPUT_POUND_LINE_NUM(PP_LINE_NUM); 08251 fprintf(dot_i_fptr, "!$OMP& "); 08252 remaining_room -= 7; 08253 break; 08254 08255 case Cdbg_Dir: 08256 fprintf(dot_i_fptr, "\n"); 08257 OUTPUT_POUND_LINE_NUM(PP_LINE_NUM); 08258 fprintf(dot_i_fptr, "!DBG$& "); 08259 remaining_room -= 7; 08260 break; 08261 08262 case Csgi_Dir: 08263 fprintf(dot_i_fptr, "&\n"); 08264 OUTPUT_POUND_LINE_NUM(PP_LINE_NUM); 08265 fprintf(dot_i_fptr, "!$SGI& "); 08266 remaining_room -= 7; 08267 break; 08268 08269 /* eraxxon: OpenAD directive */ 08270 case Copenad_Dir: 08271 fprintf(dot_i_fptr, "&\n"); 08272 OUTPUT_POUND_LINE_NUM(PP_LINE_NUM); 08273 fprintf(dot_i_fptr, "!$OPENAD& "); 08274 remaining_room -= 10; 08275 break; 08276 08277 } 08278 } 08279 else if (PP_MP_LINE) { 08280 fprintf(dot_i_fptr, "&\n"); 08281 OUTPUT_POUND_LINE_NUM(PP_LINE_NUM); 08282 fprintf(dot_i_fptr, "!$ & "); 08283 remaining_room -= 5; 08284 } 08285 else { 08286 fprintf(dot_i_fptr, "&\n"); 08287 OUTPUT_POUND_LINE_NUM(PP_LINE_NUM); 08288 fprintf(dot_i_fptr, "& "); 08289 remaining_room -= 2; 08290 } 08291 } 08292 } 08293 } 08294 fprintf(dot_i_fptr, "\n"); 08295 08296 EXIT: 08297 08298 TRACE (Func_Exit, "print_nxt_line", NULL); 08299 08300 return; 08301 08302 } /* print_nxt_line */ 08303 08304 /******************************************************************************\ 08305 |* *| 08306 |* Description: *| 08307 |* Wrapper routine for fixed_classify_line and free_classify_line. *| 08308 |* *| 08309 |* Input parameters: *| 08310 |* NONE *| 08311 |* *| 08312 |* Output parameters: *| 08313 |* NONE *| 08314 |* *| 08315 |* Returns: *| 08316 |* NOTHING *| 08317 |* *| 08318 \******************************************************************************/ 08319 08320 static void classify_line(void) 08321 08322 { 08323 08324 08325 TRACE (Func_Entry, "classify_line", NULL); 08326 08327 if (cmd_line_flags.pp_macro_expansion) { 08328 pp_line_idx++; 08329 08330 # ifdef _DEBUG 08331 if (pp_line_idx > nxt_line_num_lines) { 08332 PRINTMSG(pp_nxt_line_num[pp_line_idx-1], 626, Internal, 1, 08333 "valid pp_line_idx", "classify_line"); 08334 } 08335 # endif 08336 } 08337 else { 08338 08339 PP_MP_LINE = FALSE; 08340 PP_CHANGE_SOURCE_FORM = FALSE; 08341 08342 if (source_form == Fixed_Form) { 08343 fixed_classify_line(); 08344 } 08345 else { 08346 free_classify_line(); 08347 } 08348 } 08349 08350 if (source_form == Free_Form) { 08351 expected_line = PP_EXPECTED_LINE; 08352 } 08353 08354 nxt_line_idx = PP_IDX_TO_COL(PP_IDX); 08355 nxt_line_label = PP_LABEL; 08356 nxt_line_length = pp_nxt_line_length[pp_line_idx]; 08357 nxt_line_num = PP_LINE_NUM; 08358 nxt_line_type = PP_LINE_TYPE; 08359 nxt_line_EOL = PP_IDX_TO_COL(PP_EOL); 08360 nxt_line_prefix_len = PP_PREFIX_LEN; 08361 nxt_line_dir_prefix = PP_DIR_PREFIX; 08362 nxt_line_actual_dir_prefix = PP_ACTUAL_DIR_PREFIX; 08363 nxt_line_mp_line = PP_MP_LINE; 08364 change_source_form = PP_CHANGE_SOURCE_FORM; 08365 08366 TRACE (Func_Exit, "classify_line", NULL); 08367 08368 return; 08369 08370 } /* classify_line */ 08371 08372 /******************************************************************************\ 08373 |* *| 08374 |* Description: *| 08375 |* <description> *| 08376 |* *| 08377 |* Input parameters: *| 08378 |* NONE *| 08379 |* *| 08380 |* Output parameters: *| 08381 |* NONE *| 08382 |* *| 08383 |* Returns: *| 08384 |* NOTHING *| 08385 |* *| 08386 \******************************************************************************/ 08387 08388 static boolean get_nxt_line(void) 08389 08390 { 08391 boolean not_EOF = TRUE; 08392 08393 TRACE (Func_Entry, "get_nxt_line", NULL); 08394 08395 if (! cmd_line_flags.pp_macro_expansion) { 08396 nxt_line_num_lines = 0; 08397 08398 not_EOF = read_line(FALSE); 08399 } 08400 else { 08401 if (pp_line_idx >= nxt_line_num_lines) { 08402 pp_get_stmt(); 08403 } 08404 08405 /* reset nxt_line_type so that Cond_Comp_Lines aren't done twice */ 08406 nxt_line_type = Regular_Line; 08407 08408 if (pp_nxt_line_type[pp_line_idx + 1] == EOF_Line) { 08409 not_EOF = FALSE; 08410 nxt_line_idx = pp_nxt_line_idx[pp_line_idx + 1]; 08411 } 08412 } 08413 08414 TRACE (Func_Exit, "get_nxt_line", NULL); 08415 08416 return(not_EOF); 08417 08418 } /* get_nxt_line */ 08419 08420 /******************************************************************************\ 08421 |* *| 08422 |* Description: *| 08423 |* <description> *| 08424 |* *| 08425 |* Input parameters: *| 08426 |* NONE *| 08427 |* *| 08428 |* Output parameters: *| 08429 |* NONE *| 08430 |* *| 08431 |* Returns: *| 08432 |* NOTHING *| 08433 |* *| 08434 \******************************************************************************/ 08435 08436 static void pp_get_stmt (void) 08437 08438 { 08439 boolean cc_include_line; 08440 08441 TRACE (Func_Entry, "pp_get_stmt", NULL); 08442 08443 SAVE_GLOBAL_VARIABLES 08444 08445 pp_line_idx = 0; 08446 nxt_line_num_lines = 0; 08447 08448 /* loop while stmt continues */ 08449 do { 08450 08451 /* get next line from src input file */ 08452 08453 nxt_line_type = Regular_Line; 08454 cc_include_line = FALSE; 08455 08456 if (read_line (FALSE)) { /* read next src line */ 08457 08458 if (include_switch) { 08459 update_global_line(); /* enter global_line_tbl */ 08460 include_switch = FALSE; 08461 } 08462 08463 if (issue_pound_exit_line) { 08464 OUTPUT_POUND_INCLUDE_EXIT_LINE(curr_glb_line); 08465 issue_pound_exit_line = FALSE; 08466 } 08467 08468 if (nxt_line_type != Cond_Comp_Line) { 08469 pp_line_idx++; 08470 PP_MP_LINE = FALSE; 08471 PP_CHANGE_SOURCE_FORM = FALSE; 08472 PP_ORIG_SIZE = line_size; 08473 08474 if (source_form == Fixed_Form) { 08475 fixed_classify_line(); 08476 08477 while (PP_LINE_TYPE == Comment_Line && 08478 nxt_line[NXT_COL(1)] > 0 && 08479 (nxt_line[NXT_COL(1)] == uc_c || 08480 nxt_line[NXT_COL(1)] == lc_c) && 08481 scan_fixed_comment()) { 08482 08483 PP_MP_LINE = FALSE; 08484 PP_CHANGE_SOURCE_FORM = FALSE; 08485 fixed_classify_line(); 08486 } 08487 } 08488 else { 08489 free_classify_line(); 08490 expected_line = PP_EXPECTED_LINE; 08491 } 08492 08493 switch (PP_LINE_TYPE) { 08494 case Comment_Line: 08495 08496 if (on_off_flags.preprocess_only || on_off_flags.save_dot_i) { 08497 08498 if (ignore_source_line) { 08499 /* print blank line */ 08500 fprintf(dot_i_fptr, "\n"); 08501 previous_global_line++; 08502 } 08503 else { 08504 print_nxt_line(); 08505 } 08506 } 08507 08508 pp_line_idx--; 08509 nxt_line_num_lines--; 08510 break; 08511 08512 case Dir_Line: 08513 case Regular_Line: 08514 include_found = FALSE; /* and include flags */ 08515 include_complete = FALSE; 08516 break; 08517 08518 case Continuation_Line: 08519 case Dir_Continuation_Line: 08520 if (include_found) { 08521 include_found = FALSE; 08522 08523 /* First line of included file must not be a cont line*/ 08524 08525 ntr_msg_queue(PP_LINE_NUM, 53, Error, 08526 (source_form == Fixed_Form ? CONTINUE_COLUMN : 08527 nxt_line_col[PP_IDX]), 08528 (char *)NULL, 08529 0, 08530 NO_ARG); 08531 } 08532 08533 if (include_complete) { 08534 include_complete = FALSE; 08535 08536 /* Next line of file after include must not be a cont */ 08537 08538 ntr_msg_queue(PP_LINE_NUM, 54, Error, 08539 (source_form == Fixed_Form ? CONTINUE_COLUMN : 08540 nxt_line_col[PP_IDX]), 08541 (char *)NULL, 08542 0, 08543 NO_ARG); 08544 } 08545 break; 08546 08547 case Include_Line: 08548 08549 cc_include_line = TRUE; 08550 pp_line_idx--; 08551 nxt_line_num_lines--; 08552 08553 include_stmt_file_line = SRC_STK_FILE_LINE(src_stk_idx); 08554 08555 if (open_include_file (FALSE)) { 08556 include_found = TRUE; /* flag begin of file */ 08557 include_switch = TRUE; /* flag file switch */ 08558 } 08559 08560 break; 08561 } /* switch */ 08562 } 08563 else if (parse_cc_line()) { 08564 08565 /* if result is true, then it was an include line */ 08566 08567 cc_include_line = TRUE; 08568 include_stmt_file_line = SRC_STK_FILE_LINE(src_stk_idx); 08569 08570 if (open_include_file (TRUE)) { 08571 include_found = TRUE; /* flag begin of file */ 08572 include_switch = TRUE; /* flag file switch */ 08573 } 08574 } 08575 } 08576 else { /* EOF on source file */ 08577 08578 /* need to bump pp_line_idx since classify_line was not called */ 08579 08580 if (cmd_line_flags.pp_macro_expansion) { 08581 pp_line_idx++; 08582 PP_MP_LINE = FALSE; 08583 PP_CHANGE_SOURCE_FORM = FALSE; 08584 } 08585 } 08586 } 08587 while (PP_LINE_TYPE != EOF_Line && 08588 nxt_line_num_lines < MAX_FIXED_LINES && 08589 ! PP_CHANGE_SOURCE_FORM && 08590 (nxt_line_num_lines <= 1 || 08591 cc_include_line || 08592 PP_LINE_TYPE == Comment_Line || 08593 PP_LINE_TYPE == Continuation_Line || 08594 PP_LINE_TYPE == Dir_Continuation_Line)); 08595 08596 08597 if (nxt_line_num_lines > 1 && 08598 pp_nxt_line_type[nxt_line_num_lines] != Comment_Line && 08599 pp_nxt_line_type[nxt_line_num_lines] != Continuation_Line && 08600 pp_nxt_line_type[nxt_line_num_lines] != Dir_Continuation_Line) { 08601 08602 extra_nxt_line = nxt_line_num_lines; 08603 nxt_line_num_lines--; 08604 } 08605 08606 if (pp_nxt_line_type[1] != EOF_Line) { 08607 08608 while (scan_fortran_stmt()) { 08609 pp_line_idx = 0; 08610 08611 RESTORE_GLOBAL_VARIABLES 08612 08613 while (++pp_line_idx <= nxt_line_num_lines) { 08614 08615 if (PP_LINE_TYPE == Comment_Line && 08616 nxt_line[NXT_COL(1)] == '#') { 08617 continue; 08618 } 08619 08620 PP_MP_LINE = FALSE; 08621 PP_CHANGE_SOURCE_FORM = FALSE; 08622 08623 if (source_form == Fixed_Form) { 08624 fixed_classify_line(); 08625 } 08626 else { 08627 free_classify_line(); 08628 expected_line = PP_EXPECTED_LINE; 08629 } 08630 } 08631 } 08632 } 08633 08634 expected_line = save_expected_line; 08635 08636 /* reset pp_line_idx to 0 on exit */ 08637 pp_line_idx = 0; 08638 08639 TRACE (Func_Exit, "pp_get_stmt", NULL); 08640 08641 return; 08642 08643 } /* pp_get_stmt */ 08644 08645 /******************************************************************************\ 08646 |* *| 08647 |* Description: *| 08648 |* <description> *| 08649 |* *| 08650 |* Input parameters: *| 08651 |* NONE *| 08652 |* *| 08653 |* Output parameters: *| 08654 |* NONE *| 08655 |* *| 08656 |* Returns: *| 08657 |* NOTHING *| 08658 |* *| 08659 \******************************************************************************/ 08660 08661 static void shift_to_line_size(int shift) 08662 08663 { 08664 int end_line; 08665 int i; 08666 int start_idx; 08667 08668 TRACE (Func_Entry, "shift_to_line_size", NULL); 08669 08670 if (extra_nxt_line) { 08671 end_line = extra_nxt_line; 08672 } 08673 else { 08674 end_line = nxt_line_num_lines; 08675 } 08676 08677 start_idx = nxt_line_end_idx[pp_line_idx]; 08678 08679 if (shift > 0) { 08680 for (i = nxt_line_end_idx[end_line]; i >= start_idx; i--) { 08681 nxt_line[i+shift] = nxt_line[i]; 08682 nxt_line_col[i+shift] = nxt_line_col[i]; 08683 } 08684 } 08685 else if (shift < 0) { 08686 for (i = start_idx; i <= nxt_line_end_idx[end_line]; i++) { 08687 nxt_line[i+shift] = nxt_line[i]; 08688 nxt_line_col[i+shift] = nxt_line_col[i]; 08689 } 08690 } 08691 08692 nxt_line_end_idx[pp_line_idx] += shift; 08693 pp_nxt_line_length[pp_line_idx] += shift; 08694 pp_nxt_line_EOL[pp_line_idx] += shift; 08695 08696 for (i = pp_line_idx + 1; i <= end_line; i++) { 08697 nxt_line_start_idx[i] += shift; 08698 nxt_line_end_idx[i] += shift; 08699 pp_nxt_line_EOL[i] += shift; 08700 } 08701 08702 TRACE (Func_Exit, "shift_to_line_size", NULL); 08703 08704 return; 08705 08706 } /* shift_to_line_size */ 08707 08708 /******************************************************************************\ 08709 |* *| 08710 |* Description: *| 08711 |* <description> *| 08712 |* *| 08713 |* Input parameters: *| 08714 |* NONE *| 08715 |* *| 08716 |* Output parameters: *| 08717 |* NONE *| 08718 |* *| 08719 |* Returns: *| 08720 |* NOTHING *| 08721 |* *| 08722 \******************************************************************************/ 08723 08724 void get_curr_file_name(char *str) 08725 08726 { 08727 08728 08729 TRACE (Func_Entry, "get_curr_file_name", NULL); 08730 08731 sprintf(str, "\"%s\"", SRC_STK_FILE_NAME(src_stk_idx)); 08732 08733 TRACE (Func_Exit, "get_curr_file_name", NULL); 08734 08735 return; 08736 08737 } /* get_curr_file_name */
1.7.6.1 
