|
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/cifftnrecs.c 5.2 06/17/99 09:28:10\n"; 00038 00039 #include <stdio.h> 00040 00041 00042 #define CIF_VERSION 3 00043 00044 #include "cif.m" 00045 00046 #include "cif.h" 00047 00048 extern void Cif_Error (void); 00049 00050 00051 /* ************************************************************************** */ 00052 /* */ 00053 /* The following definitions are temporarily included directly in this */ 00054 /* until such time as this file is integrated into libcif. At that point, */ 00055 /* these definitions should probably be split out into a libcif header */ 00056 /* file. */ 00057 /* */ 00058 /* ************************************************************************** */ 00059 00060 /* MPP Geometry record [26]. */ 00061 00062 /* Note: This record is not yet output by CF90 and may have a different */ 00063 /* form depending on what happens to CRAFT. */ 00064 /* */ 00065 /* It will also need a declaration of the following type because a */ 00066 /* number of these can be passed: */ 00067 00068 struct Cif_geometry_dim_entry 00069 { 00070 int distribution; /* Dimension distribution. */ 00071 char *weight; /* Weight. */ 00072 int weight_file_id; /* Weight file id. */ 00073 int weight_line_number; 00074 /* Weight file line number. */ 00075 int weight_column_number; 00076 /* Weight column number. */ 00077 char *block_size; /* Block size. */ 00078 int block_size_file_id; 00079 /* Block size file id. */ 00080 int block_size_line_number; 00081 /* Block size file line num. */ 00082 int block_size_column_number; 00083 /* Block size column number. */ 00084 }; 00085 00086 typedef struct Cif_geometry_dim_entry Cif_geometry_dim; 00087 00088 00089 00090 00091 /* Object record [36]. */ 00092 00093 /* Note: The Distribution and Geometry Id fields are not currently being */ 00094 /* output by the front-end. These fields may change depending on */ 00095 /* the final CRAFT design. */ 00096 00097 /* The bound information must be in character form because a bound can be an */ 00098 /* expression which is represented by the character "E". */ 00099 00100 struct Cif_f90_dim_entry { char *lower_bound; 00101 char *upper_bound; 00102 }; 00103 00104 typedef struct Cif_f90_dim_entry Cif_f90_dim; 00105 00106 00107 00108 00109 /* Note: Since we've added many new options, surely this record */ 00110 /* will need to be expanded. */ 00111 00112 00113 /* Optimization Options record [38]. */ 00114 00115 00116 struct Cif_f90_level_opt_entry { 00117 int option; /* Option flag. */ 00118 int level; /* The optimization level. */ 00119 }; 00120 00121 typedef struct Cif_f90_level_opt_entry Cif_f90_level_opt; 00122 00123 00124 00125 /* ************************************************************************** */ 00126 /* */ 00127 /* End temporary definitions. */ 00128 /* */ 00129 /* ************************************************************************** */ 00130 00131 00132 00133 /******************************************************************************\ 00134 |* *| 00135 |* Description: *| 00136 |* Output a CDIR$ record [5]. *| 00137 |* *| 00138 |* Input parameters: *| 00139 |* c_i_f: The file pointer to the CIF being produced. *| 00140 |* directive_type: *| 00141 |* file_id: *| 00142 |* line_number: *| 00143 |* column_number: *| 00144 |* num_copy_vars: *| 00145 |* copy_var_sym_id: *| 00146 |* *| 00147 |* Output parameters: *| 00148 |* NONE *| 00149 |* *| 00150 |* Returns: *| 00151 |* NOTHING *| 00152 |* *| 00153 \******************************************************************************/ 00154 00155 void Cif_Cdir_Rec(FILE *c_i_f, 00156 int directive_type, 00157 int file_id, 00158 int line_number, 00159 int column_number, 00160 int num_copy_vars, 00161 long *copy_var_sym_id) 00162 00163 { 00164 int i; 00165 00166 00167 if (fprintf(c_i_f, "%d%c%d%c%d%c%d%c%d%c%d", 00168 CIF_CDIR, EOI, 00169 directive_type, EOI, 00170 file_id, EOI, 00171 line_number, EOI, 00172 column_number, EOI, 00173 num_copy_vars) < 0) { 00174 Cif_Error(); 00175 } 00176 00177 00178 for (i = 0; i < num_copy_vars; ++i) { 00179 00180 if (fprintf(c_i_f, "%c%ld", 00181 EOI, copy_var_sym_id[i]) < 0) { 00182 Cif_Error(); 00183 } 00184 } 00185 00186 if (fprintf(c_i_f, "%c", EOR) < 0) { 00187 Cif_Error(); 00188 } 00189 00190 return; 00191 00192 } /* Cif_Cdir_Rec */ 00193 00194 00195 /******************************************************************************\ 00196 |* *| 00197 |* Description: *| 00198 |* Output an Include record [9]. *| 00199 |* *| 00200 |* Input parameters: *| 00201 |* c_i_f: The file pointer to the CIF being produced. *| 00202 |* parent_file_id: *| 00203 |* line_number: *| 00204 |* column_number: *| 00205 |* include_file_id: *| 00206 |* *| 00207 |* Output parameters: *| 00208 |* NONE *| 00209 |* *| 00210 |* Returns: *| 00211 |* NOTHING *| 00212 |* *| 00213 \******************************************************************************/ 00214 00215 void Cif_Include_Rec(FILE *c_i_f, 00216 int parent_file_id, 00217 int line_number, 00218 int column_number, 00219 int include_file_id) 00220 { 00221 if (fprintf(c_i_f, "%d%c%d%c%d%c%d%c%d%c", 00222 CIF_INCLUDE, EOI, 00223 parent_file_id, EOI, 00224 line_number, EOI, 00225 column_number, EOI, 00226 include_file_id, EOR) < 0) { 00227 Cif_Error(); 00228 } 00229 00230 return; 00231 00232 } /* Cif_Include_Rec */ 00233 00234 00235 /******************************************************************************\ 00236 |* *| 00237 |* Description: *| 00238 |* Output a Source File record [14]. *| 00239 |* *| 00240 |* Input parameters: *| 00241 |* c_i_f: The file pointer to the CIF being produced. *| 00242 |* file_id: The file id of the file containing the program. *| 00243 |* source_form: The source form in which the program is written (at *| 00244 |* least initially). *| 00245 |* *| 00246 |* Output parameters: *| 00247 |* NONE *| 00248 |* *| 00249 |* Returns: *| 00250 |* NOTHING *| 00251 |* *| 00252 \******************************************************************************/ 00253 00254 void Cif_Srcfile_Rec(FILE *c_i_f, 00255 int file_id, 00256 int source_form) 00257 { 00258 if (fprintf(c_i_f, "%d%c%d%c%d%c", 00259 CIF_SRCFILE, EOI, 00260 file_id, EOI, 00261 source_form, EOR) < 0) { 00262 Cif_Error(); 00263 } 00264 00265 return; 00266 00267 } /* Cif_Srcfile_Rec */ 00268 00269 00270 /******************************************************************************\ 00271 |* *| 00272 |* Description: *| 00273 |* Output a DOSHARED CDIR$ record [16]. *| 00274 |* *| 00275 |* *** NOT YET PRODUCED BY THE FRONT-END. INCOMPLETE *** *| 00276 |* *| 00277 |* Input parameters: *| 00278 |* c_i_f: The file pointer to the CIF being produced. *| 00279 |* *| 00280 |* Output parameters: *| 00281 |* NONE *| 00282 |* *| 00283 |* Returns: *| 00284 |* NOTHING *| 00285 |* *| 00286 \******************************************************************************/ 00287 00288 # if 0 00289 void Cif_Doshared_Cdir_Rec(FILE *c_i_f, 00290 int doshared_type, 00291 int random, 00292 int file_id, 00293 int line_number, 00294 int column_number, 00295 char *m_value, 00296 int m_file_id, 00297 int m_line_number, 00298 int m_column_number, 00299 int num_control_vars, 00300 long *control_var_sym_id) 00301 { 00302 if (fprintf(c_i_f, "%d%c", 00303 CIF_CDIR_DOSHARED, EOR) < 0) { 00304 Cif_Error(); 00305 } 00306 00307 return; 00308 00309 } /* Cif_Doshared_Cdir_Rec */ 00310 # endif 00311 00312 00313 /******************************************************************************\ 00314 |* *| 00315 |* Description: *| 00316 |* Output a Usage record [19]. *| 00317 |* *| 00318 |* Input parameters: *| 00319 |* c_i_f: The file pointer to the CIF being produced. *| 00320 |* sym_id: *| 00321 |* file_id: *| 00322 |* line_number: The line number containing the symbol for which this *| 00323 |* Usage record is being produced. *| 00324 |* col_number: The column number for the symbol. *| 00325 |* usage_code: The CIF-defined usage code. *| 00326 |* num_other_sym_ids: *| 00327 |* component_sym_id: *| 00328 |* *| 00329 |* Output parameters: *| 00330 |* NONE *| 00331 |* *| 00332 |* Returns: *| 00333 |* NOTHING *| 00334 |* *| 00335 \******************************************************************************/ 00336 00337 void Cif_Usage_Rec(FILE *c_i_f, 00338 int sym_id, 00339 int file_id, 00340 int line_number, 00341 int col_number, 00342 int usage_code, 00343 int num_other_sym_ids, 00344 long *component_sym_id) 00345 { 00346 int i; 00347 00348 00349 if (fprintf(c_i_f, "%d%c%d%c%d%c%d%c%d%c%d%c%d", 00350 CIF_USAGE, EOI, 00351 sym_id, EOI, 00352 file_id, EOI, 00353 line_number, EOI, 00354 col_number, EOI, 00355 usage_code, EOI, 00356 num_other_sym_ids) < 0) { 00357 Cif_Error(); 00358 } 00359 00360 for (i = 0; i < num_other_sym_ids; ++i) { 00361 00362 if (fprintf(c_i_f, "%c%ld", 00363 EOI, component_sym_id[i]) < 0) { 00364 Cif_Error(); 00365 } 00366 } 00367 00368 if (fprintf(c_i_f, "%c", EOR) < 0) { 00369 Cif_Error(); 00370 } 00371 00372 return; 00373 00374 } /* Cif_Usage_Rec */ 00375 00376 00377 /******************************************************************************\ 00378 |* *| 00379 |* Description: *| 00380 |* Output an Enable/Disable Compiler Options record [21]. *| 00381 |* *| 00382 |* Input parameters: *| 00383 |* c_i_f: The file pointer to the CIF being produced. *| 00384 |* enable_disable_opts: *| 00385 |* *| 00386 |* Output parameters: *| 00387 |* NONE *| 00388 |* *| 00389 |* Returns: *| 00390 |* NOTHING *| 00391 |* *| 00392 \******************************************************************************/ 00393 00394 void Cif_EDopts_Rec(FILE *c_i_f, 00395 int enable_disable_opts) 00396 { 00397 if (fprintf(c_i_f, "%d%c%x%c", 00398 CIF_EDOPTS, EOI, 00399 enable_disable_opts, EOR) < 0) { 00400 Cif_Error(); 00401 } 00402 00403 return; 00404 00405 } /* Cif_EDopts_Rec */ 00406 00407 00408 /******************************************************************************\ 00409 |* *| 00410 |* Description: *| 00411 |* Output a Machine Characteristics record [22]. *| 00412 |* *| 00413 |* Input parameters: *| 00414 |* c_i_f: The file pointer to the CIF being produced. *| 00415 |* cpu_type: *| 00416 |* memory_speed: *| 00417 |* memory_size: *| 00418 |* characteristics: *| 00419 |* num_memory_banks: *| 00420 |* num_cpus: *| 00421 |* instruction_buffer_size: *| 00422 |* clock_period: *| 00423 |* num_cluster_reg_sets: *| 00424 |* bank_busy_time: *| 00425 |* word_bit_len: *| 00426 |* *| 00427 |* Output parameters: *| 00428 |* NONE *| 00429 |* *| 00430 |* Returns: *| 00431 |* NOTHING *| 00432 |* *| 00433 \******************************************************************************/ 00434 00435 void Cif_Mach_Char_Rec(FILE *c_i_f, 00436 char *cpu_type, 00437 long memory_speed, 00438 long memory_size, 00439 int characteristics, 00440 long num_memory_banks, 00441 long num_cpus, 00442 long instruction_buffer_size, 00443 long clock_period, 00444 long num_cluster_reg_sets, 00445 long bank_busy_time, 00446 int word_bit_len) 00447 { 00448 if (fprintf(c_i_f, "%d%c%s%c%ld%c%ld%c%x%c%ld%c%ld%c%ld%c%ld%c%ld%c%ld%c%d%c", 00449 CIF_MACH_CHAR, EOI, 00450 cpu_type, EOI, 00451 memory_speed, EOI, 00452 memory_size, EOI, 00453 characteristics, EOI, 00454 num_memory_banks, EOI, 00455 num_cpus, EOI, 00456 instruction_buffer_size, EOI, 00457 clock_period, EOI, 00458 num_cluster_reg_sets, EOI, 00459 bank_busy_time, EOI, 00460 word_bit_len, EOR) < 0) { 00461 Cif_Error(); 00462 } 00463 00464 return; 00465 00466 } /* Cif_Mach_Char_Rec */ 00467 00468 00469 /******************************************************************************\ 00470 |* *| 00471 |* Description: *| 00472 |* Output a Statement Type record [25]. *| 00473 |* *| 00474 |* Input parameters: *| 00475 |* c_i_f: The file pointer to the CIF being produced. *| 00476 |* stmt_type: *| 00477 |* file_id: *| 00478 |* line_number: *| 00479 |* column_number: *| 00480 |* stmt_number: *| 00481 |* *| 00482 |* Output parameters: *| 00483 |* NONE *| 00484 |* *| 00485 |* Returns: *| 00486 |* NOTHING *| 00487 |* *| 00488 \******************************************************************************/ 00489 00490 void Cif_Stmt_Type_Rec(FILE *c_i_f, 00491 int stmt_type, 00492 int file_id, 00493 int line_number, 00494 int column_number, 00495 int stmt_number) 00496 { 00497 /* The definition of the Stmt Type record has an "end file id" (efid) */ 00498 /* field, an "end line number" (eline) field, and "end character position" */ 00499 /* (ecpos) field. The full layout of the ASCII Stmt Type record is: */ 00500 /* rectype, type, fid, line, cpos, efid, eline, ecpos */ 00501 /* Fortran does not currently use the efid, eline, or ecpos fields. Since */ 00502 /* we don't use them, we overload the eline field with the statement */ 00503 /* number. */ 00504 00505 if (fprintf(c_i_f, "%d%c%d%c%d%c%d%c%d%c%d%c%d%c%d%c", 00506 CIF_STMT_TYPE, EOI, 00507 stmt_type, EOI, 00508 file_id, EOI, 00509 line_number, EOI, 00510 column_number, EOI, 00511 0, EOI, 00512 stmt_number, EOI, 00513 0, EOR) < 0) { 00514 Cif_Error(); 00515 } 00516 00517 return; 00518 00519 } /* Cif_Stmt_Type_Rec */ 00520 00521 00522 /******************************************************************************\ 00523 |* *| 00524 |* Description: *| 00525 |* Output an MPP Geometry record [26]. ** NOT YET IMPLEMENTED ** *| 00526 |* *| 00527 |* Input parameters: *| 00528 |* c_i_f: The file pointer to the CIF being produced. *| 00529 |* name: *| 00530 |* sym_id: *| 00531 |* num_dims: *| 00532 |* dim: *| 00533 |* *| 00534 |* Output parameters: *| 00535 |* NONE *| 00536 |* *| 00537 |* Returns: *| 00538 |* NOTHING *| 00539 |* *| 00540 \******************************************************************************/ 00541 00542 # if 0 00543 void Cif_Mpp_Geometry_Rec(FILE *c_i_f, 00544 char *name, 00545 int sym_id, 00546 int num_dims, 00547 Cif_geometry_dim *dim) 00548 { 00549 return; 00550 00551 } /* Cif_Mpp_Geometry_Rec */ 00552 # endif 00553 00554 00555 /******************************************************************************\ 00556 |* *| 00557 |* Description: *| 00558 |* Output a Continuation Line record [27]. *| 00559 |* *| 00560 |* Input parameters: *| 00561 |* c_i_f: The file pointer to the CIF being produced. *| 00562 |* continuation_type: *| 00563 |* file_id: *| 00564 |* line_number: *| 00565 |* column_number: *| 00566 |* *| 00567 |* Output parameters: *| 00568 |* NONE *| 00569 |* *| 00570 |* Returns: *| 00571 |* NOTHING *| 00572 |* *| 00573 \******************************************************************************/ 00574 00575 void Cif_Continuation_Rec(FILE *c_i_f, 00576 int continuation_type, 00577 int file_id, 00578 int line_number, 00579 int column_number) 00580 { 00581 if (fprintf(c_i_f, "%d%c%d%c%d%c%d%c%d%c", 00582 CIF_CONTINUATION, EOI, 00583 continuation_type, EOI, 00584 file_id, EOI, 00585 line_number, EOI, 00586 column_number, EOR) < 0) { 00587 Cif_Error(); 00588 } 00589 00590 return; 00591 00592 } /* Cif_Continuation_Rec */ 00593 00594 00595 /******************************************************************************\ 00596 |* *| 00597 |* Description: *| 00598 |* Output a Call Site record [28]. *| 00599 |* *| 00600 |* Input parameters: *| 00601 |* c_i_f: The file pointer to the CIF being produced. *| 00602 |* sym_id: *| 00603 |* scope_id: *| 00604 |* file_id: *| 00605 |* line_number: *| 00606 |* column_number: *| 00607 |* specific_proc_sym_id: *| 00608 |* max_num_actual_args: *| 00609 |* arg_sym_id: *| 00610 |* arg_rank: *| 00611 |* *| 00612 |* Output parameters: *| 00613 |* NONE *| 00614 |* *| 00615 |* Returns: *| 00616 |* NOTHING *| 00617 |* *| 00618 \******************************************************************************/ 00619 00620 void Cif_F90_Callsite_Rec(FILE *c_i_f, 00621 int sym_id, 00622 int scope_id, 00623 int file_id, 00624 int line_number, 00625 int column_number, 00626 int specific_proc_sym_id, 00627 int max_num_actual_args, 00628 char *arg_sym_id[], 00629 int *arg_rank) 00630 { 00631 int i; 00632 00633 00634 if (fprintf(c_i_f, "%d%c%d%c%d%c%d%c%d%c%d%c%d%c%d", 00635 CIF_F90_CALLSITE, EOI, 00636 sym_id, EOI, 00637 scope_id, EOI, 00638 file_id, EOI, 00639 line_number, EOI, 00640 column_number, EOI, 00641 specific_proc_sym_id, EOI, 00642 max_num_actual_args) < 0) { 00643 Cif_Error(); 00644 } 00645 00646 if (max_num_actual_args > 0) { 00647 00648 for (i = 0; i < max_num_actual_args; ++i) { 00649 00650 if (fprintf(c_i_f, "%c%s", 00651 EOI, arg_sym_id[i]) < 0) { 00652 Cif_Error(); 00653 } 00654 } 00655 00656 for (i = 0; i < max_num_actual_args; ++i) { 00657 00658 if (fprintf(c_i_f, "%c%d", 00659 EOI, arg_rank[i]) < 0) { 00660 Cif_Error(); 00661 } 00662 } 00663 } 00664 00665 if (fprintf(c_i_f, "%c", EOR) < 0) { 00666 Cif_Error(); 00667 } 00668 00669 return; 00670 00671 } /* Cif_F90_Callsite_Rec */ 00672 00673 00674 /******************************************************************************\ 00675 |* *| 00676 |* Description: *| 00677 |* Output a Common Block [29] record. *| 00678 |* *| 00679 |* Input parameters: *| 00680 |* c_i_f: The file pointer to the CIF being produced. *| 00681 |* name: *| 00682 |* sym_id: *| 00683 |* scope_id: *| 00684 |* storage_class: *| 00685 |* module_sym_id: *| 00686 |* common_block_length: *| 00687 |* distribution: *| 00688 |* *| 00689 |* Output parameters: *| 00690 |* NONE *| 00691 |* *| 00692 |* Returns: *| 00693 |* NOTHING *| 00694 |* *| 00695 \******************************************************************************/ 00696 00697 void Cif_F90_Comblk_Rec(FILE *c_i_f, 00698 char *name, 00699 int sym_id, 00700 int scope_id, 00701 int storage_class, 00702 int module_sym_id, 00703 int common_block_length, 00704 int distribution) 00705 { 00706 if (fprintf(c_i_f, "%d%c%s%c%d%c%d%c%d%c%d%c%d%c%d%c", 00707 CIF_F90_COMBLK, EOI, 00708 name, EOI, 00709 sym_id, EOI, 00710 scope_id, EOI, 00711 storage_class, EOI, 00712 module_sym_id, EOI, 00713 common_block_length, EOI, 00714 distribution, EOR) < 0) { 00715 Cif_Error(); 00716 } 00717 00718 return; 00719 00720 } /* Cif_F90_Comblk_Rec */ 00721 00722 00723 /******************************************************************************\ 00724 |* *| 00725 |* Description: *| 00726 |* Output a Named Constant [30] record. *| 00727 |* *| 00728 |* Input parameters: *| 00729 |* c_i_f: The file pointer to the CIF being produced. *| 00730 |* sym_id: *| 00731 |* scope_id: *| 00732 |* scalar_aggregate: *| 00733 |* value: *| 00734 |* file_id: *| 00735 |* start_line_number: *| 00736 |* start_column_number: *| 00737 |* end_line_number: *| 00738 |* end_column_number: *| 00739 |* original_form_flag: These two will be output maybe some day but *| 00740 |* original_form: are not being output for the time being. *| 00741 |* *| 00742 |* Output parameters: *| 00743 |* NONE *| 00744 |* *| 00745 |* Returns: *| 00746 |* NOTHING *| 00747 |* *| 00748 \******************************************************************************/ 00749 00750 void Cif_F90_Const_Rec(FILE *c_i_f, 00751 int sym_id, 00752 int scope_id, 00753 int scalar_aggregate, 00754 char *value, 00755 int file_id, 00756 int start_line_number, 00757 int start_column_number, 00758 int end_line_number, 00759 int end_column_number) 00760 { 00761 if (fprintf(c_i_f, "%d%c%d%c%d%c%d%c%s%c%d%c%d%c%d%c%d%c%d%c", 00762 CIF_F90_CONST, EOI, 00763 sym_id, EOI, 00764 scope_id, EOI, 00765 scalar_aggregate, EOI, 00766 value, EOI, 00767 file_id, EOI, 00768 start_line_number, EOI, 00769 start_column_number, EOI, 00770 end_line_number, EOI, 00771 end_column_number, EOR) < 0) { 00772 Cif_Error(); 00773 } 00774 00775 return; 00776 00777 } /* Cif_F90_Const_Rec */ 00778 00779 00780 /******************************************************************************\ 00781 |* *| 00782 |* Description: *| 00783 |* Output an Entry Point [31] record. *| 00784 |* *| 00785 |* Input parameters: *| 00786 |* c_i_f: The file pointer to the CIF being produced. *| 00787 |* name: *| 00788 |* sym_id: *| 00789 |* scope_id: *| 00790 |* program_unit_type: *| 00791 |* procedure_type: *| 00792 |* attributes: *| 00793 |* result_sym_id: *| 00794 |* module_sym_id: *| 00795 |* num_dummy_args: *| 00796 |* dummy_arg_sym_id: *| 00797 |* *| 00798 |* Output parameters: *| 00799 |* NONE *| 00800 |* *| 00801 |* Returns: *| 00802 |* NOTHING *| 00803 |* *| 00804 \******************************************************************************/ 00805 00806 void Cif_F90_Entry_Rec(FILE *c_i_f, 00807 char *name, 00808 int sym_id, 00809 int scope_id, 00810 int program_unit_type, 00811 int procedure_type, 00812 int attributes, 00813 int result_sym_id, 00814 int module_sym_id, 00815 int num_dummy_args, 00816 long *dummy_arg_sym_id) 00817 { 00818 int i; 00819 00820 00821 if (fprintf(c_i_f, 00822 "%d%c%s%c%d%c%d%c%d%c%d%c%x%c%d%c%d%c%d", 00823 CIF_F90_ENTRY, EOI, 00824 name, EOI, 00825 sym_id, EOI, 00826 scope_id, EOI, 00827 program_unit_type, EOI, 00828 procedure_type, EOI, 00829 attributes, EOI, 00830 result_sym_id, EOI, 00831 module_sym_id, EOI, 00832 num_dummy_args) < 0) { 00833 Cif_Error(); 00834 } 00835 00836 for (i = 0; i < num_dummy_args; i++) { 00837 00838 if (fprintf(c_i_f, "%c%ld", EOI, dummy_arg_sym_id[i]) < 0) { 00839 Cif_Error(); 00840 } 00841 } 00842 00843 if (fprintf(c_i_f, "%c", EOR) < 0) { 00844 Cif_Error(); 00845 } 00846 00847 return; 00848 00849 } /* Cif_F90_Entry_Rec */ 00850 00851 00852 /******************************************************************************\ 00853 |* *| 00854 |* Description: *| 00855 |* Output a Loop Definitions record [32]. *| 00856 |* *| 00857 |* Input parameters: *| 00858 |* c_i_f: The file pointer to the CIF being produced. *| 00859 |* scope_id: *| 00860 |* loop_type: *| 00861 |* start_file_id: *| 00862 |* start_line_number: *| 00863 |* start_column_number: *| 00864 |* end_file_id: *| 00865 |* end_line_number: *| 00866 |* end_column_number: *| 00867 |* do_var_sym_id: *| 00868 |* term_label_sym_id: *| 00869 |* construct_name_sym_id: *| 00870 |* end_stmt_num: *| 00871 |* *| 00872 |* Output parameters: *| 00873 |* NONE *| 00874 |* *| 00875 |* Returns: *| 00876 |* NOTHING *| 00877 |* *| 00878 \******************************************************************************/ 00879 00880 void Cif_F90_Loop_Rec(FILE *c_i_f, 00881 int scope_id, 00882 int loop_type, 00883 int start_file_id, 00884 int start_line_number, 00885 int start_column_number, 00886 int end_file_id, 00887 int end_line_number, 00888 int end_column_number, 00889 int do_var_sym_id, 00890 int term_label_sym_id, 00891 int construct_name_sym_id, 00892 int end_stmt_num) 00893 { 00894 if (fprintf(c_i_f, "%d%c%d%c%d%c%d%c%d%c%d%c%d%c%d%c%d%c%d%c%d%c%d%c%d%c", 00895 CIF_F90_LOOP, EOI, 00896 scope_id, EOI, 00897 loop_type, EOI, 00898 start_file_id, EOI, 00899 start_line_number, EOI, 00900 start_column_number, EOI, 00901 end_file_id, EOI, 00902 end_line_number, EOI, 00903 end_column_number, EOI, 00904 do_var_sym_id, EOI, 00905 term_label_sym_id, EOI, 00906 construct_name_sym_id, EOI, 00907 end_stmt_num, EOR) < 0) { 00908 Cif_Error(); 00909 } 00910 00911 return; 00912 00913 } /* Cif_F90_Loop_Rec */ 00914 00915 00916 /******************************************************************************\ 00917 |* *| 00918 |* Description: *| 00919 |* Output a Derived Type record [33]. *| 00920 |* *| 00921 |* Input parameters: *| 00922 |* c_i_f: The file pointer to the CIF being produced. *| 00923 |* name: *| 00924 |* sym_id: *| 00925 |* scope_id: *| 00926 |* derived_type_id: *| 00927 |* attributes: *| 00928 |* num_components: *| 00929 |* component_sym_id: *| 00930 |* module_sym_id: *| 00931 |* *| 00932 |* Output parameters: *| 00933 |* NONE *| 00934 |* *| 00935 |* Returns: *| 00936 |* NOTHING *| 00937 |* *| 00938 \******************************************************************************/ 00939 00940 void Cif_F90_Derived_Type_Rec(FILE *c_i_f, 00941 char *name, 00942 int sym_id, 00943 int scope_id, 00944 int derived_type_id, 00945 int attributes, 00946 int num_components, 00947 long *component_sym_id, 00948 int module_sym_id) 00949 { 00950 int i; 00951 00952 if (fprintf(c_i_f, "%d%c%s%c%d%c%d%c%d%c%x%c%d", 00953 CIF_F90_DERIVED_TYPE, EOI, 00954 name, EOI, 00955 sym_id, EOI, 00956 scope_id, EOI, 00957 derived_type_id, EOI, 00958 attributes, EOI, 00959 num_components) < 0) { 00960 Cif_Error(); 00961 } 00962 00963 for (i = 0; i < num_components; ++i) { 00964 00965 if (fprintf(c_i_f, "%c%ld", 00966 EOI, component_sym_id[i]) < 0) { 00967 Cif_Error(); 00968 } 00969 } 00970 00971 if (fprintf(c_i_f, "%c%d%c", 00972 EOI, 00973 module_sym_id, EOR) < 0) { 00974 Cif_Error(); 00975 } 00976 00977 return; 00978 00979 } /* Cif_F90_Derived_Type_Rec */ 00980 00981 00982 /******************************************************************************\ 00983 |* *| 00984 |* Description: *| 00985 |* Output a Label record [34]. *| 00986 |* *| 00987 |* Input parameters: *| 00988 |* c_i_f: The file pointer to the CIF being produced. *| 00989 |* name: *| 00990 |* sym_id: *| 00991 |* scope_id: *| 00992 |* label_class: *| 00993 |* *| 00994 |* Output parameters: *| 00995 |* NONE *| 00996 |* *| 00997 |* Returns: *| 00998 |* NOTHING *| 00999 |* *| 01000 \******************************************************************************/ 01001 01002 void Cif_F90_Label_Rec(FILE *c_i_f, 01003 char *name, 01004 int sym_id, 01005 int scope_id, 01006 int label_class) 01007 01008 { 01009 if (fprintf(c_i_f, 01010 "%d%c%s%c%d%c%d%c%d%c", 01011 CIF_F90_LABEL, EOI, 01012 name, EOI, 01013 sym_id, EOI, 01014 scope_id, EOI, 01015 label_class, EOR) < 0) { 01016 Cif_Error(); 01017 } 01018 01019 return; 01020 01021 } /* Cif_F90_Label_Rec */ 01022 01023 01024 /******************************************************************************\ 01025 |* *| 01026 |* Description: *| 01027 |* Output a Namelist record [35]. *| 01028 |* *| 01029 |* Input parameters: *| 01030 |* c_i_f: The file pointer to the CIF being produced. *| 01031 |* name: *| 01032 |* sym_id: *| 01033 |* scope_id: *| 01034 |* module_sym_id: *| 01035 |* num_members: *| 01036 |* member_sym_id: *| 01037 |* *| 01038 |* Output parameters: *| 01039 |* NONE *| 01040 |* *| 01041 |* Returns: *| 01042 |* NOTHING *| 01043 |* *| 01044 \******************************************************************************/ 01045 01046 void Cif_F90_Namelist_Rec(FILE *c_i_f, 01047 char *name, 01048 int sym_id, 01049 int scope_id, 01050 int module_sym_id, 01051 int num_members, 01052 long *member_sym_id) 01053 01054 { 01055 int i; 01056 01057 01058 if (fprintf(c_i_f, "%d%c%s%c%d%c%d%c%d%c%d", 01059 CIF_F90_NAMELIST, EOI, 01060 name, EOI, 01061 sym_id, EOI, 01062 scope_id, EOI, 01063 module_sym_id, EOI, 01064 num_members) < 0) { 01065 Cif_Error(); 01066 } 01067 01068 for (i = 0; i < num_members; ++i) { 01069 01070 if (fprintf(c_i_f, "%c%ld", 01071 EOI, member_sym_id[i]) < 0) { 01072 Cif_Error(); 01073 } 01074 } 01075 01076 if (fprintf(c_i_f, "%c", EOR) < 0) { 01077 Cif_Error(); 01078 } 01079 01080 return; 01081 01082 } /* Cif_F90_Namelist_Rec */ 01083 01084 01085 /******************************************************************************\ 01086 |* *| 01087 |* Description: *| 01088 |* Output a Object record [36]. *| 01089 |* *| 01090 |* Input parameters: *| 01091 |* c_i_f: The file pointer to the CIF being produced. *| 01092 |* name: *| 01093 |* sym_id: *| 01094 |* scope_id: *| 01095 |* data_type: *| 01096 |* symbol_class: *| 01097 |* storage_class: *| 01098 |* storage_sym_id: *| 01099 |* offset: *| 01100 |* attributes: *| 01101 |* derived_type_id: *| 01102 |* char_len: *| 01103 |* num_dimensions: *| 01104 |* array_type: *| 01105 |* dim: *| 01106 |* distribution: *| 01107 |* geometry_id: *| 01108 |* cri_ptr_sym_id: *| 01109 |* *| 01110 |* Output parameters: *| 01111 |* NONE *| 01112 |* *| 01113 |* Returns: *| 01114 |* NOTHING *| 01115 |* *| 01116 \******************************************************************************/ 01117 01118 void Cif_F90_Object_Rec(FILE *c_i_f, 01119 char *name, 01120 int sym_id, 01121 int scope_id, 01122 int data_type, 01123 int symbol_class, 01124 int storage_class, 01125 int storage_sym_id, 01126 int offset, 01127 int attributes, 01128 int derived_type_id, 01129 char *char_len, 01130 int num_dimensions, 01131 int array_type, 01132 Cif_f90_dim *dim, 01133 int distribution, 01134 int geometry_id, 01135 int cri_ptr_sym_id) 01136 { 01137 int i; 01138 01139 if (fprintf(c_i_f, 01140 "%d%c%s%c%d%c%d%c%d%c%d%c%d%c%d%c%d%c%x%c%d%c%s%c%d%c%d%c", 01141 CIF_F90_OBJECT, EOI, 01142 name, EOI, 01143 sym_id, EOI, 01144 scope_id, EOI, 01145 data_type, EOI, 01146 symbol_class, EOI, 01147 storage_class, EOI, 01148 storage_sym_id, EOI, 01149 offset, EOI, 01150 attributes, EOI, 01151 derived_type_id, EOI, 01152 char_len, EOI, 01153 num_dimensions, EOI, 01154 array_type, EOI) < 0) { 01155 Cif_Error(); 01156 } 01157 01158 if (num_dimensions > 0 && array_type != CIF_AT_DEFERRED) { 01159 01160 for (i = 0; i < num_dimensions; ++i) { 01161 01162 if (dim[i].lower_bound != NULL) { 01163 01164 if (fprintf(c_i_f, "%s%c", 01165 dim[i].lower_bound, EOI) < 0) { 01166 Cif_Error(); 01167 } 01168 } 01169 01170 if (dim[i].upper_bound != NULL) { 01171 01172 if (fprintf(c_i_f, "%s%c", 01173 dim[i].upper_bound, EOI) < 0) { 01174 Cif_Error(); 01175 } 01176 } 01177 } 01178 } 01179 01180 if (fprintf(c_i_f, "%d%c%d%c%d%c", 01181 distribution, EOI, 01182 geometry_id, EOI, 01183 cri_ptr_sym_id, EOR) < 0) { 01184 Cif_Error(); 01185 } 01186 01187 return; 01188 01189 } /* Cif_F90_Object_Rec */ 01190 01191 01192 /******************************************************************************\ 01193 |* *| 01194 |* Description: *| 01195 |* Output a Miscellaneous Compiler Options record [37]. *| 01196 |* *| 01197 |* Input parameters: *| 01198 |* c_i_f: The file pointer to the CIF being produced. *| 01199 |* i_opt_value: *| 01200 |* m_opt_value: *| 01201 |* V_opt: *| 01202 |* t_opt_enabled: *| 01203 |* t_opt_value: *| 01204 |* num_disabled_msgs: *| 01205 |* msg_num: *| 01206 |* num_disabled_cdirs: *| 01207 |* cdir_name: *| 01208 |* dot_o_name: *| 01209 |* cal_file_name: *| 01210 |* inline_file_name: *| 01211 |* cif_name: *| 01212 |* C_opt_flags: *| 01213 |* N_opt_value: *| 01214 |* num_I_opts: *| 01215 |* I_opt_path_name: *| 01216 |* num_p_opts: *| 01217 |* p_opt_path_name: *| 01218 |* source_form: *| 01219 |* R_opt_flags: *| 01220 |* *| 01221 |* Output parameters: *| 01222 |* NONE *| 01223 |* *| 01224 |* Returns: *| 01225 |* NOTHING *| 01226 |* *| 01227 \******************************************************************************/ 01228 01229 void Cif_F90_Misc_Opts_Rec(FILE *c_i_f, 01230 int i_opt_value, 01231 int m_opt_value, 01232 int V_opt, 01233 int t_opt_enabled, 01234 int t_opt_value, 01235 int num_disabled_msgs, 01236 long *msg_num, 01237 int num_disabled_cdirs, 01238 char *cdir_name[], 01239 char *dot_o_name, 01240 char *cal_file_name, 01241 char *inline_file_name, 01242 char *cif_name, 01243 int C_opt_flags, 01244 int N_opt_value, 01245 int num_I_opts, 01246 char *I_opt_path_name[], 01247 int num_p_opts, 01248 char *p_opt_path_name[], 01249 int source_form, 01250 int R_opt_flags) 01251 { 01252 int i; 01253 01254 01255 /* KAY - check why R_opt_flags isn't being used. */ 01256 01257 if (fprintf(c_i_f, "%d%c%d%c%d%c%d%c%d%c%d%c%d%c", 01258 CIF_F90_MISC_OPTS, EOI, 01259 i_opt_value, EOI, 01260 m_opt_value, EOI, 01261 V_opt, EOI, 01262 t_opt_enabled, EOI, 01263 t_opt_value, EOI, 01264 num_disabled_msgs, EOI) < 0) { 01265 Cif_Error(); 01266 } 01267 01268 for (i = 0; i < num_disabled_msgs; ++i) { 01269 01270 if (fprintf(c_i_f, "%ld%c", 01271 msg_num[i], EOI) < 0) { 01272 Cif_Error(); 01273 } 01274 } 01275 01276 if (fprintf(c_i_f, "%d%c", num_disabled_cdirs, EOI) < 0) { 01277 Cif_Error(); 01278 } 01279 01280 for (i = 0; i < num_disabled_cdirs; ++i) { 01281 01282 if (fprintf(c_i_f, "%s%c", 01283 cdir_name[i], EOI) < 0) { 01284 Cif_Error(); 01285 } 01286 } 01287 01288 if (fprintf(c_i_f, "%s%c%s%c%s%c%s%c%x%c%d%c%d%c", 01289 dot_o_name, EOI, 01290 cal_file_name, EOI, 01291 inline_file_name, EOI, 01292 cif_name, EOI, 01293 C_opt_flags, EOI, 01294 N_opt_value, EOI, 01295 num_I_opts, EOI) < 0) { 01296 01297 Cif_Error(); 01298 } 01299 01300 for (i = 0; i < num_I_opts; ++i) { 01301 01302 if (fprintf(c_i_f, "%s%c", 01303 I_opt_path_name[i], EOI) < 0) { 01304 Cif_Error(); 01305 } 01306 } 01307 01308 if (fprintf(c_i_f, "%d%c", 01309 num_p_opts, EOI) < 0) { 01310 Cif_Error(); 01311 } 01312 01313 for (i = 0; i < num_p_opts; ++i) { 01314 01315 if (fprintf(c_i_f, "%s%c", 01316 p_opt_path_name[i], EOI) < 0) { 01317 Cif_Error(); 01318 } 01319 } 01320 01321 if (fprintf(c_i_f, "%d%c", 01322 source_form, EOR) < 0) { 01323 Cif_Error(); 01324 } 01325 01326 return; 01327 01328 } /* Cif_F90_Misc_Opts_Rec */ 01329 01330 01331 /******************************************************************************\ 01332 |* *| 01333 |* Description: *| 01334 |* Output a Optimization Options record [38]. *| 01335 |* *| 01336 |* Input parameters: *| 01337 |* c_i_f: The file pointer to the CIF being produced. *| 01338 |* options: *| 01339 |* num_level_opts: *| 01340 |* level_opt: *| 01341 |* *| 01342 |* Output parameters: *| 01343 |* NONE *| 01344 |* *| 01345 |* Returns: *| 01346 |* NOTHING *| 01347 |* *| 01348 \******************************************************************************/ 01349 01350 void Cif_F90_Opt_Opts_Rec(FILE *c_i_f, 01351 int options, 01352 int num_level_opts, 01353 Cif_f90_level_opt *level_opt) 01354 { 01355 int i; 01356 01357 01358 if (fprintf(c_i_f, "%d%c%x%c%d", 01359 CIF_F90_OPT_OPTS, EOI, 01360 options, EOI, 01361 num_level_opts) < 0) { 01362 Cif_Error(); 01363 } 01364 01365 for (i = 0; i < num_level_opts; ++i) { 01366 01367 if (fprintf(c_i_f, "%c%x%c%d", 01368 EOI, level_opt[i].option, 01369 EOI, level_opt[i].level) < 0) { 01370 Cif_Error(); 01371 } 01372 } 01373 01374 if (fprintf(c_i_f, "%c", EOR) < 0) { 01375 Cif_Error(); 01376 } 01377 01378 return; 01379 01380 } /* Cif_Opt_Opts_Rec */ 01381 01382 01383 /******************************************************************************\ 01384 |* *| 01385 |* Description: *| 01386 |* Output a Begin Scope record [39]. *| 01387 |* *| 01388 |* Input parameters: *| 01389 |* c_i_f: The file pointer to the CIF being produced. *| 01390 |* scope_id: *| 01391 |* sym_id: *| 01392 |* file_id: *| 01393 |* line_number: *| 01394 |* column_number: *| 01395 |* scope_type: *| 01396 |* nesting_level: *| 01397 |* parent_scope_id: *| 01398 |* *| 01399 |* Output parameters: *| 01400 |* NONE *| 01401 |* *| 01402 |* Returns: *| 01403 |* NOTHING *| 01404 |* *| 01405 \******************************************************************************/ 01406 01407 void Cif_F90_Begin_Scope_Rec(FILE *c_i_f, 01408 int scope_id, 01409 int sym_id, 01410 int file_id, 01411 int line_number, 01412 int column_number, 01413 int scope_type, 01414 int nesting_level, 01415 int parent_scope_id) 01416 { 01417 if (fprintf(c_i_f, "%d%c%d%c%d%c%d%c%d%c%d%c%d%c%d%c%d%c", 01418 CIF_F90_BEGIN_SCOPE, EOI, 01419 scope_id, EOI, 01420 sym_id, EOI, 01421 file_id, EOI, 01422 line_number, EOI, 01423 column_number, EOI, 01424 scope_type, EOI, 01425 nesting_level, EOI, 01426 parent_scope_id, EOR) < 0) { 01427 Cif_Error(); 01428 } 01429 01430 return; 01431 01432 } /* Cif_F90_Begin_Scope_Rec */ 01433 01434 01435 /******************************************************************************\ 01436 |* *| 01437 |* Description: *| 01438 |* Output a End Scope record [40]. *| 01439 |* *| 01440 |* Input parameters: *| 01441 |* c_i_f: The file pointer to the CIF being produced. *| 01442 |* scope_id: *| 01443 |* file_id: *| 01444 |* line_number: *| 01445 |* column_number: *| 01446 |* scope_in_error: *| 01447 |* *| 01448 |* Output parameters: *| 01449 |* NONE *| 01450 |* *| 01451 |* Returns: *| 01452 |* NOTHING *| 01453 |* *| 01454 \******************************************************************************/ 01455 01456 void Cif_F90_End_Scope_Rec(FILE *c_i_f, 01457 int scope_id, 01458 int file_id, 01459 int line_number, 01460 int column_number, 01461 int scope_in_error) 01462 01463 { 01464 if (fprintf(c_i_f, "%d%c%d%c%d%c%d%c%d%c%d%c", 01465 CIF_F90_END_SCOPE, EOI, 01466 scope_id, EOI, 01467 file_id, EOI, 01468 line_number, EOI, 01469 column_number, EOI, 01470 scope_in_error, EOR) < 0) { 01471 Cif_Error(); 01472 } 01473 01474 return; 01475 01476 } /* Cif_F90_End_Scope_Rec */ 01477 01478 01479 /******************************************************************************\ 01480 |* *| 01481 |* Description: *| 01482 |* Output a Scope Info record [41]. *| 01483 |* *| 01484 |* Input parameters: *| 01485 |* c_i_f: The file pointer to the CIF being produced. *| 01486 |* scope_id: *| 01487 |* attributes: *| 01488 |* num_alt_entries: *| 01489 |* alt_entry_sym_id: *| 01490 |* *| 01491 |* Output parameters: *| 01492 |* NONE *| 01493 |* *| 01494 |* Returns: *| 01495 |* NOTHING *| 01496 |* *| 01497 \******************************************************************************/ 01498 01499 void Cif_F90_Scope_Info_Rec(FILE *c_i_f, 01500 int scope_id, 01501 int attributes, 01502 int num_alt_entries, 01503 long *alt_entry_sym_id) 01504 { 01505 int i; 01506 01507 01508 if (fprintf(c_i_f, "%d%c%d%c%x%c%d", 01509 CIF_F90_SCOPE_INFO, EOI, 01510 scope_id, EOI, 01511 attributes, EOI, 01512 num_alt_entries) < 0) { 01513 Cif_Error(); 01514 } 01515 01516 for (i = 0; i < num_alt_entries; ++i) { 01517 01518 if (fprintf(c_i_f, "%c%ld", 01519 EOI, alt_entry_sym_id[i]) < 0) { 01520 Cif_Error(); 01521 } 01522 } 01523 01524 if (fprintf(c_i_f, "%c", EOR) < 0) { 01525 Cif_Error(); 01526 } 01527 01528 return; 01529 01530 } /* Cif_F90_Scope_Info_Rec */ 01531 01532 01533 /******************************************************************************\ 01534 |* *| 01535 |* Description: *| 01536 |* Output a Use Module record [42]. *| 01537 |* *| 01538 |* Input parameters: *| 01539 |* c_i_f: The file pointer to the CIF being produced. *| 01540 |* module_sym_id: *| 01541 |* module_file_id: *| 01542 |* flag: *| 01543 |* *| 01544 |* Output parameters: *| 01545 |* NONE *| 01546 |* *| 01547 |* Returns: *| 01548 |* NOTHING *| 01549 |* *| 01550 \******************************************************************************/ 01551 01552 void Cif_F90_Use_Module_Rec(FILE *c_i_f, 01553 int module_sym_id, 01554 int module_file_id, 01555 int flag) 01556 { 01557 if (fprintf(c_i_f, 01558 "%d%c%d%c%d%c%d%c", 01559 CIF_F90_USE_MODULE, EOI, 01560 module_sym_id, EOI, 01561 module_file_id, EOI, 01562 flag, EOR) < 0) { 01563 Cif_Error(); 01564 } 01565 01566 return; 01567 01568 } /* Cif_F90_Use_Module_Rec */ 01569 01570 01571 /******************************************************************************\ 01572 |* *| 01573 |* Description: *| 01574 |* Output a Rename record [43]. *| 01575 |* *| 01576 |* Input parameters: *| 01577 |* c_i_f: The file pointer to the CIF being produced. *| 01578 |* scope_id: *| 01579 |* name_in_module: *| 01580 |* name_in_module_sym_id: *| 01581 |* module_sym_id: *| 01582 |* original_name: *| 01583 |* original_module_sym_id: *| 01584 |* local_name_sym_id: *| 01585 |* *| 01586 |* Output parameters: *| 01587 |* NONE *| 01588 |* *| 01589 |* Returns: *| 01590 |* NOTHING *| 01591 |* *| 01592 \******************************************************************************/ 01593 01594 void Cif_F90_Rename_Rec(FILE *c_i_f, 01595 int scope_id, 01596 char *name_in_module, 01597 int name_in_module_sym_id, 01598 int module_sym_id, 01599 char *original_name, 01600 int original_module_sym_id, 01601 long local_name_sym_id) 01602 { 01603 if (fprintf(c_i_f, 01604 "%d%c%d%c%s%c%d%c%d%c%s%c%d%c%ld%c", 01605 CIF_F90_RENAME, EOI, 01606 scope_id, EOI, 01607 name_in_module, EOI, 01608 name_in_module_sym_id, EOI, 01609 module_sym_id, EOI, 01610 original_name, EOI, 01611 original_module_sym_id, EOI, 01612 local_name_sym_id, EOR) < 0) { 01613 Cif_Error(); 01614 } 01615 01616 return; 01617 01618 } /* Cif_F90_Rename_Rec */ 01619 01620 01621 /******************************************************************************\ 01622 |* *| 01623 |* Description: *| 01624 |* Output an Interface Block record [44]. *| 01625 |* *| 01626 |* Input parameters: *| 01627 |* c_i_f: The file pointer to the CIF being produced. *| 01628 |* name: *| 01629 |* sym_id: *| 01630 |* scope_id: *| 01631 |* int_block_type: *| 01632 |* attributes: *| 01633 |* num_interfaces: *| 01634 |* specific_proc_sym_id: *| 01635 |* module_sym_id: *| 01636 |* *| 01637 |* Output parameters: *| 01638 |* NONE *| 01639 |* *| 01640 |* Returns: *| 01641 |* NOTHING *| 01642 |* *| 01643 \******************************************************************************/ 01644 01645 void Cif_F90_Int_Block_Rec(FILE *c_i_f, 01646 char *name, 01647 int sym_id, 01648 int scope_id, 01649 int int_block_type, 01650 int attributes, 01651 int num_interfaces, 01652 long *specific_proc_sym_id, 01653 int module_sym_id) 01654 { 01655 int i; 01656 01657 01658 if (fprintf(c_i_f, "%d%c%s%c%d%c%d%c%d%c%x%c%d", 01659 CIF_F90_INT_BLOCK, EOI, 01660 name, EOI, 01661 sym_id, EOI, 01662 scope_id, EOI, 01663 int_block_type, EOI, 01664 attributes, EOI, 01665 num_interfaces) < 0) { 01666 Cif_Error(); 01667 } 01668 01669 for (i = 0; i < num_interfaces; ++i) { 01670 01671 if (fprintf(c_i_f, "%c%ld", 01672 EOI, specific_proc_sym_id[i]) < 0) { 01673 Cif_Error(); 01674 } 01675 } 01676 01677 if (fprintf(c_i_f, "%c%d%c", 01678 EOI, 01679 module_sym_id, EOR) < 0) { 01680 Cif_Error(); 01681 } 01682 01683 return; 01684 01685 } /* Cif_F90_Int_Block_Rec */ 01686
1.7.6.1 
