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