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/fgetc.c 92.2 08/20/99 13:51:31" 00039 00040 00041 /* 00042 * Get a character from a logical unit bypassing fortran formatted 00043 * I/O. fgetc is called from f77 and f90 programs on mips only. 00044 * fgetc only applies to unit 5. The clen arg is ignored since only 00045 * a single character is read. 00046 * 00047 * calling sequence: 00048 * 00049 * INTEGER FGETC, IERROR, IUNIT 00050 * IERROR = FGETC (IUNIT, CHAR) 00051 * 00052 * where: 00053 * 00054 * char - return a character from logical unit 00055 * ierror .EQ. 0 - fgetc successful. 00056 * .LT. 0 - End-of-file, fgetc unsuccessful. 00057 * .GT. 0 - system or F77 error code, fgetc unsuccessful. 00058 * 00059 * Call fgetc_ from MIPS F77 or from MIPS F90 without a 00060 * compatibility module. 00061 * 00062 * Call fgetc_f90 from MIPS F90 without a compatibility module. 00063 * 00064 * Call fgetcf90_ from MIPS F90 with a compatibility module. 00065 * Call fgetcf90_8_ from MIPS F90 with a compatibility module. 00066 * Call fgetcf90_8_4_ from MIPS F90 with a compatibility module. 00067 * Call fgetcf90_4_8_ from MIPS F90 with a compatibility module. 00068 * 00069 */ 00070 00071 #include "fio.h" 00072 00073 extern int fgetc_(_f_int *u, char *c, int clen); 00074 extern int __fgetc_f90(_f_int *u, char *c, int clen); 00075 extern _f_int fgetcf90_(_f_int *u, char *c, int clen); 00076 extern _f_int8 fgetcf90_8_(_f_int8 *u, char *c, int clen); 00077 extern _f_int8 fgetcf90_8_4_(_f_int4 *u, char *c, int clen); 00078 extern _f_int4 fgetcf90_4_8_(_f_int8 *u, char *c, int clen); 00079 extern int getc_(char *c, int clen); 00080 extern _f_int4 getcf90_(char *c, int clen); 00081 extern _f_int8 getcf90_8_(char *c, int clen); 00082 00083 int 00084 __fgetc_f90(_f_int *u, char *c, int clen) 00085 { 00086 return fgetcf90_(u, c, clen); 00087 } 00088 00089 _f_int 00090 fgetcf90_(_f_int *u, char *c, int clen) 00091 { 00092 _f_int res; 00093 long buf; 00094 long status; 00095 struct fiostate cfs; /* fiosp */ 00096 unit *cup; /* Unit table pointer */ 00097 unum_t unum; 00098 00099 unum = *u; 00100 res = 0; 00101 00102 /* lock the unit */ 00103 STMT_BEGIN( unum, 0, T_RSF, NULL, &cfs, cup); 00104 00105 if (unum < 0 || !cup) 00106 return((errno=FEIVUNIT)); 00107 00108 if (_frch(cup, &buf, 1, PARTIAL, &status) == -1) 00109 res = errno; 00110 00111 *c = (char)buf; 00112 00113 /* unlock the unit */ 00114 STMT_END( cup, TF_READ, NULL, &cfs); 00115 00116 return(res); 00117 } 00118 00119 _f_int8 00120 fgetcf90_8_(_f_int8 *u, char *c, int clen) 00121 { 00122 _f_int8 res; 00123 long status; 00124 struct fiostate cfs; /* fiosp */ 00125 unit *cup; /* Unit table pointer */ 00126 unum_t unum; 00127 00128 unum = *u; 00129 res = 0; 00130 00131 /* lock the unit */ 00132 STMT_BEGIN( unum, 0, T_RSF, NULL, &cfs, cup); 00133 00134 if (unum < 0 || !cup) 00135 return((errno=FEIVUNIT)); 00136 00137 if (_frch(cup, (long *)c, 1, PARTIAL, &status) == -1) 00138 res = errno; 00139 00140 /* unlock the unit */ 00141 STMT_END( cup, TF_READ, NULL, &cfs); 00142 00143 return(res); 00144 } 00145 00146 _f_int8 00147 fgetcf90_8_4_(_f_int4 *u, char *c, int clen) 00148 { 00149 return (_f_int8)fgetcf90_(u, c, clen); 00150 } 00151 00152 _f_int4 00153 fgetcf90_4_8_(_f_int8 *u, char *c, int clen) 00154 { 00155 _f_int8 uunit; 00156 uunit = *u; 00157 return (_f_int4)fgetcf90_8_(&uunit, c, clen); 00158 } 00159 00160 /* 00161 * getc - get a character from the standard input unit 5 on mips. 00162 * 00163 * calling sequence: 00164 * 00165 * INTEGER getc 00166 * ierror = getc (char) 00167 * 00168 * where: 00169 * 00170 * char = character read from standard input, usually a terminal 00171 * ierror = 0 if successful. 00172 * = -1 if end-of-file read. 00173 * > 0 if system error code returned. 00174 * 00175 * Call getc_ from MIPS F77 or from MIPS F90 without a 00176 * compatibility module. Note thatit calls fgetc with unit 5. 00177 * 00178 * Call getcf90_ from MIPS F90 with a compatibility module. 00179 * Call getcf90_8_ from MIPS F90 with a compatibility module. 00180 * 00181 */ 00182 00183 int 00184 getc_(char *c, int clen) 00185 { 00186 int stdin_unit = 5; 00187 return fgetc_(&stdin_unit, c, clen); 00188 } 00189 00190 _f_int4 00191 getcf90_(char *c, int clen) 00192 { 00193 _f_int4 res; 00194 long status; 00195 struct fiostate cfs; /* fiosp */ 00196 unit *cup; /* Unit table pointer */ 00197 unum_t unum = 5; 00198 00199 res = 0; 00200 00201 /* lock the unit */ 00202 STMT_BEGIN( unum, 0, T_RSF, NULL, &cfs, cup); 00203 00204 if (!cup) 00205 return((errno=FEIVUNIT)); 00206 00207 if (_frch(cup, (long *)c, 1, PARTIAL, &status) == -1) 00208 res = errno; 00209 00210 /* unlock the unit */ 00211 STMT_END( cup, TF_READ, NULL, &cfs); 00212 00213 return(res); 00214 } 00215 00216 _f_int8 00217 getcf90_8_(char *c, int clen) 00218 { 00219 _f_int8 res; 00220 long status; 00221 struct fiostate cfs; /* fiosp */ 00222 unit *cup; /* Unit table pointer */ 00223 unum_t unum = 5; 00224 00225 res = 0; 00226 00227 /* lock the unit */ 00228 STMT_BEGIN( unum, 0, T_RSF, NULL, &cfs, cup); 00229 00230 if (!cup) 00231 return((errno=FEIVUNIT)); 00232 00233 if (_frch(cup, (long *)c, 1, PARTIAL, &status) == -1) 00234 res = errno; 00235 00236 /* unlock the unit */ 00237 STMT_END( cup, TF_READ, NULL, &cfs); 00238 00239 return(res); 00240 }