cifftnrecs.c

Go to the documentation of this file.
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