00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038 #pragma ident "@(#) libf/fio/read.c 92.2 06/21/99 10:37:55"
00039
00040
00041
00042
00043
00044 #include <errno.h>
00045 #include <foreign.h>
00046 #include <fortran.h>
00047 #include <liberrno.h>
00048 #include <cray/dopevec.h>
00049 #include "fio.h"
00050
00051 #define ret_err(errnum) { \
00052 *words = 0; \
00053 *status = errnum; \
00054 goto done; \
00055 }
00056
00057 #define UBC 5
00058
00059 static void __READ();
00060
00061 #undef READ
00062
00063
00064
00065
00066 void
00067 READP(
00068 _f_int *unump,
00069 _f_int *uda,
00070 _f_int *words,
00071 _f_int *status,
00072 _f_int *ubc)
00073 {
00074 _f_int locubc, *ubcp;
00075
00076 if (_numargs() < UBC) {
00077 locubc = 0;
00078 ubcp = &locubc;
00079 }
00080 else
00081 ubcp = ubc;
00082
00083
00084 __READ(PARTIAL, unump, uda, words, status, ubcp);
00085 }
00086
00087
00088
00089
00090 _f_int
00091 READ(
00092 _f_int *unump,
00093 _f_int *uda,
00094 _f_int *words,
00095 _f_int *status,
00096 _f_int *ubc)
00097 {
00098 _f_int locubc, *ubcp;
00099
00100 if (_numargs() < UBC) {
00101 locubc = 0;
00102 ubcp = &locubc;
00103 }
00104 else
00105 ubcp = ubc;
00106
00107 __READ(FULL, unump, uda, words, status, ubcp);
00108
00109 return(0);
00110 }
00111
00112
00113
00114
00115
00116
00117
00118 static void
00119 __READ(
00120 int fulp,
00121 _f_int *unump,
00122 _f_int *uda,
00123 _f_int *words,
00124 _f_int *status,
00125 _f_int *ubc)
00126 {
00127 register int ret;
00128 int rstat;
00129 int wubc;
00130 long wr;
00131 register unum_t unum;
00132 unit *cup;
00133 type_packet tip;
00134 struct fiostate cfs;
00135
00136 unum = *unump;
00137 wubc = *ubc;
00138
00139 STMT_BEGIN(unum, 0, T_RSU, NULL, &cfs, cup);
00140
00141
00142
00143 if (cup == NULL) {
00144 int ostat;
00145
00146 cup = _imp_open(&cfs, SEQ, UNF, unum, 1, &ostat);
00147
00148 if (cup == NULL)
00149 ret_err(ostat);
00150 }
00151
00152 if (!cup->ok_rd_seq_unf) {
00153 ret = _get_mismatch_error(1, T_RSU, cup, &cfs);
00154 ret_err(ret);
00155 }
00156
00157 cup->uwrt = 0;
00158 wr = 0;
00159 tip.type90 = DVTYPE_TYPELESS;
00160 tip.type77 = -1;
00161 tip.intlen = sizeof(long) << 3;
00162 tip.extlen = tip.intlen;
00163 tip.elsize = sizeof(long);
00164 tip.cnvindx = 0;
00165 tip.count = *words;
00166 tip.stride = 1;
00167
00168 ret = _frwd(cup, uda, &tip, fulp, &wubc, &wr, &rstat);
00169
00170 if ( ret == IOERR ) {
00171 if ( errno == FETAPUTE ) {
00172 *words = wr;
00173 *status = 4;
00174 }
00175 else if (errno >= 5) {
00176 *words = 0;
00177 *status = errno;
00178 }
00179 else {
00180 *words = 0;
00181
00182
00183
00184 switch (errno) {
00185 case 1:
00186 *status = FEKLUDG1;
00187 break;
00188 case 2:
00189 *status = FEKLUDG2;
00190 break;
00191 case 3:
00192 *status = FEKLUDG3;
00193 break;
00194 case 4:
00195 *status = FEKLUDG4;
00196 break;
00197 }
00198 }
00199 }
00200 else {
00201 if ( rstat == EOR ) {
00202 cup->uend = BEFORE_ENDFILE;
00203 *status = 0;
00204 *words = ret;
00205
00206 if ( ret == 0 )
00207 *status = 1;
00208 }
00209 else if ( rstat == CNT ) {
00210 cup->uend = BEFORE_ENDFILE;
00211 *status = -1;
00212 *words = ret;
00213 }
00214 else if ( rstat == EOD) {
00215 *status = 3;
00216 *words = 0;
00217
00218 if (cup->ubmx)
00219 *status = 2;
00220 }
00221 else {
00222 cup->uend = PHYSICAL_ENDFILE;
00223 *status = 2;
00224 *words = 0;
00225 }
00226 }
00227
00228 done:
00229 *ubc = wubc;
00230
00231 STMT_END(cup, TF_READ, NULL, &cfs);
00232
00233 return;
00234 }