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.1 of the GNU Lesser General Public License 00007 as 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 Lesser General Public 00021 License along with this program; if not, write the Free Software 00022 Foundation, Inc., 59 Temple Place - Suite 330, Boston MA 02111-1307, 00023 USA. 00024 00025 Contact information: Silicon Graphics, Inc., 1600 Amphitheatre Pky, 00026 Mountain View, CA 94043, or: 00027 00028 http://www.sgi.com 00029 00030 For further information regarding this notice, see: 00031 00032 http://oss.sgi.com/projects/GenInfo/NoticeExplan 00033 00034 */ 00035 00036 00037 00038 #pragma ident "@(#) libf/fio/efi.c 92.1 06/18/99 10:21:14" 00039 00040 #include "fio.h" 00041 #include <errno.h> 00042 #include <liberrno.h> 00043 #include <fortran.h> 00044 #ifdef _CRAYMPP 00045 #include <stdarg.h> 00046 #endif 00047 00048 #ifdef _CRAY2 00049 #pragma _CRI duplicate $EFI as @EFI 00050 #endif 00051 00052 /* _numargs returns the number of words passed. We need to know */ 00053 /* the number of arguments. These macros convert words to arguments. */ 00054 #define ARGS_3 (1 + 2*sizeof(_fcd)/sizeof(long)) 00055 #define ARGS_4 (2 + 2*sizeof(_fcd)/sizeof(long)) 00056 #define ARGS_7 (5 + 2*sizeof(_fcd)/sizeof(long)) 00057 #define ARGS_9 (7 + 2*sizeof(_fcd)/sizeof(long)) 00058 00059 /* 00060 * $EFI - encode initialization 00061 * 00062 * CALL $EFI,(len, format, fwa, _arg4, _arg5, _arg6, pform, inumcfe) 00063 * 00064 * len Address of length (in characters) 00065 * format Address of format (Fortran character descriptor or 00066 * hollerith) 00067 * fwa Address of output character string 00068 * _arg4 Unused (old pform argument) 00069 * _arg5 Unused 00070 * _arg6 Unused 00071 * pform Address of address of parsed format (NULL if no 00072 * compiler-supplied word; points to NULL if not yet 00073 * parsed). This parameter is absent in CFT77 5.0.2 00074 * and previous on CX/CEA systems. 00075 * inumelt Address of number of interal array elements 00076 * (internal I/O only) 00077 * inumcfe Address of number of array elements in a character 00078 * format (to be added in a later compiler release). 00079 * 00080 * A zero argument indicates an unspecified option 00081 * 00082 * $EFI calls: 00083 * 00084 * $WFI 00085 */ 00086 00087 #ifdef _CRAYMPP 00088 int 00089 $EFI( 00090 long *len, /* Address of length (in characters) */ 00091 ... 00092 ) 00093 #else 00094 int 00095 $EFI( 00096 long *len, /* Address of length (in characters) */ 00097 _fcd format, /* Address of format (FCD or hollerith) */ 00098 _fcd fwa, /* Address of output character string */ 00099 fmt_type **_arg4, /* Unused (old pform arugment) */ 00100 long *_arg5, /* Unused */ 00101 long *_arg6, /* Unused */ 00102 fmt_type **pform, /* Address of address of parsed format */ 00103 long *inumelt, /* Address of int. array element count */ 00104 long *inumcfe /* Address of number of format elements */ 00105 ) 00106 #endif 00107 { 00108 long mone = -1L; 00109 _fcd fch; 00110 int nargs; 00111 00112 #ifdef _CRAYMPP 00113 va_list args; 00114 _fcd format; /* Address of format (FCD or hollerith) */ 00115 _fcd fwa; /* Address of output character string */ 00116 fmt_type **_arg4; /* Unused (old pform arugment) */ 00117 long *_arg5; /* Unused */ 00118 long *_arg6; /* Unused */ 00119 fmt_type **pform; /* Address of address of parsed format */ 00120 long *inumelt; /* Address of int. array element count */ 00121 long *inumcfe; /* Address of number of format elements */ 00122 00123 va_start(args, len); 00124 format = va_arg(args, _fcd); 00125 fwa = va_arg(args, _fcd); 00126 #endif 00127 00128 if (*len <= 0) /* If length is zero or negative */ 00129 _ferr(NULL, FEENCDRL); /* Invalid ENCODE record length */ 00130 00131 /* Round byte count up to a word multiple */ 00132 00133 fch = _cptofcd(_fcdtocp(fwa), (*len + 7) & ~07); 00134 00135 nargs = _numargs(); 00136 #ifdef _CRAYMPP 00137 if (nargs >= ARGS_7) { 00138 _arg4 = va_arg(args, fmt_type **); 00139 _arg5 = va_arg(args, long *); 00140 _arg6 = va_arg(args, long *); 00141 pform = va_arg(args, fmt_type **); 00142 if (nargs >= ARGS_9) { 00143 inumelt = va_arg(args, long *); 00144 inumcfe = va_arg(args, long *); 00145 } 00146 } 00147 va_end(args); 00148 #endif 00149 00150 00151 /* Map ENCODE into an internal WRITE */ 00152 00153 switch ( nargs ) { 00154 00155 #ifdef _CRAY2 00156 case ARGS_4: 00157 return ( $WFI(fch, format, NULL, NULL, NULL, NULL, 00158 _arg4, &mone) ); 00159 #else 00160 case ARGS_3: 00161 return ( $WFI(fch, format, NULL, NULL, NULL, NULL, 00162 NULL, &mone) ); 00163 #endif 00164 00165 case ARGS_7: 00166 return ( $WFI(fch, format, NULL, NULL, NULL, NULL, 00167 pform, &mone) ); 00168 00169 case ARGS_9: 00170 return ( $WFI(fch, format, NULL, NULL, NULL, NULL, 00171 pform, inumelt, inumcfe) ); 00172 00173 default: 00174 _ferr(NULL, FEINTUNK); 00175 00176 } /* switch */ 00177 00178 return(IO_ERR); /* Should never get here */ 00179 }