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/rdfmt.c 92.6 06/21/99 10:37:55"
00039
00040 #include <memory.h>
00041 #include <stdlib.h>
00042 #include <string.h>
00043 #include <fortran.h>
00044 #include <cray/fmtconv.h>
00045 #include <cray/format.h>
00046 #include <cray/nassert.h>
00047 #ifdef _CRAYT3D
00048 #include <cray/mppsdd.h>
00049 #define MAXSH 512
00050 #else
00051 #define MAXSH 1
00052 #endif
00053 #include "fio.h"
00054 #include "fmt.h"
00055 #include "f90io.h"
00056 #include "lio.h"
00057
00058 extern const ic_func *_iconvtab[LAST_DATA_ED + 1];
00059 extern const short _idedtab[DVTYPE_NTYPES];
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080
00081
00082 int
00083 _rdfmt(
00084 FIOSPTR css,
00085 unit *cup,
00086 void *dptr,
00087 type_packet *tip,
00088 int _Unused
00089 )
00090 {
00091 register short cswitch;
00092 register short fmtop;
00093 register short part;
00094 register ftype_t type;
00095 register int32 chxfer;
00096 register int32 delta;
00097 register int32 field;
00098 register int32 i;
00099 register int32 itemch;
00100 register int32 kount;
00101 register int32 length;
00102 register int32 padcnt;
00103 register int32 repcnt;
00104 int cinc[2];
00105 register int stat;
00106 register int stride;
00107 register char *cptr;
00108 register char *ctmp;
00109 long digits;
00110 long mode;
00111 long *tptr;
00112 long width;
00113 register long count;
00114 register long dfmode;
00115 fmt_type pfmt;
00116 #ifdef _CRAYT3D
00117 register short shared;
00118 register int elwords;
00119 register int offset;
00120 register int32 tcount;
00121 long shrd[MAXSH];
00122 #endif
00123
00124 int _nicverr(
00125 const int _Nicverror);
00126
00127 const ic_func *ngcf;
00128
00129
00130
00131 assert (cup != NULL);
00132 assert (tip != NULL);
00133
00134 type = tip->type90;
00135 count = tip->count;
00136
00137 chxfer = 0;
00138 cswitch = 0;
00139 stat = 0;
00140 part = 1;
00141
00142 pfmt = *css->u.fmt.u.fe.pfcp;
00143 repcnt = *css->u.fmt.u.fe.pftocs;
00144 length = tip->elsize;
00145 stride = tip->stride * length;
00146 cinc[1] = stride;
00147
00148
00149
00150 if (type == DVTYPE_COMPLEX) {
00151 length = length / 2;
00152 cinc[0] = length;
00153 cinc[1] = stride - length;
00154 cswitch = 1;
00155 part = 0;
00156 }
00157
00158 dfmode = ((css->u.fmt.blank0 == 1) ? MODEBZ : MODEBN);
00159
00160 #ifdef _CRAYT3D
00161 if (_issddptr(dptr)) {
00162 offset = 0;
00163 elwords = tip->elsize / sizeof(long);
00164 shared = 1;
00165 stride = tip->elsize;
00166 tcount = count;
00167 css->f_shrdput = 1;
00168 }
00169 else
00170 shared = 0;
00171
00172 do {
00173 if (shared) {
00174
00175
00176
00177
00178
00179 count = MIN (MAXSH / elwords, (tcount - offset));
00180 cptr = (char *) shrd;
00181 }
00182 else
00183 #endif
00184 {
00185 cptr = (char *) dptr;
00186 }
00187
00188 do {
00189
00190 fmtop = pfmt.op_code;
00191 width = pfmt.field_width;
00192 digits = pfmt.digits_field;
00193
00194
00195
00196 if (fmtop > LAST_OP || fmtop < FIRST_DATA_ED) {
00197 stat = FEINTIPF;
00198 goto done;
00199 }
00200
00201 if (fmtop <= LAST_DATA_ED) {
00202
00203
00204
00205
00206
00207
00208 if (count == 0)
00209 goto done;
00210
00211
00212
00213
00214
00215
00216
00217 if (INVALID_RTYPE(fmtop, type)) {
00218 stat = FERDTYPE;
00219 goto done;
00220 }
00221
00222 if (fmtop == G_ED) {
00223
00224 fmtop = _idedtab[type];
00225
00226 if (type != DVTYPE_REAL &&
00227 type != DVTYPE_COMPLEX)
00228 digits = 1;
00229 }
00230
00231 if (type == DVTYPE_ASCII)
00232 mode = 0;
00233 else {
00234 mode = (long) _rd_ilchk[fmtop-1][length-1];
00235
00236 if (mode == INVALID_INTLEN) {
00237 stat = FERDTYPE;
00238 goto done;
00239 }
00240 }
00241
00242 mode = mode | dfmode;
00243
00244
00245
00246
00247
00248 if (width == 0) {
00249 register int exp;
00250
00251 switch (fmtop) {
00252
00253
00254
00255
00256
00257
00258 case A_ED:
00259 case R_ED:
00260 width = length;
00261 break;
00262
00263
00264
00265
00266
00267
00268
00269 case B_ED:
00270 case I_ED:
00271 case O_ED:
00272 case Z_ED:
00273 width = _rw_mxdgt[fmtop-1][length-1];
00274
00275
00276
00277 if (width == 127)
00278 width = 128;
00279
00280
00281
00282 width = width + 1;
00283
00284 if (fmtop == I_ED)
00285 width = width + 1;
00286
00287 if (pfmt.default_digits)
00288 digits = 1;
00289 break;
00290
00291
00292
00293
00294
00295
00296
00297
00298
00299
00300
00301 case D_ED:
00302 case E_ED:
00303 case EN_ED:
00304 case ES_ED:
00305 case F_ED:
00306 case G_ED:
00307 if (pfmt.default_digits)
00308 digits = _rw_mxdgt[fmtop-1][length-1];
00309
00310 if (length == 16)
00311 exp = DEXP16;
00312 #ifdef _F_REAL4
00313 else if (length == 4)
00314 exp = DEXP4;
00315 #endif
00316 else
00317 exp = DEXP8;
00318
00319 width = digits + exp + 6;
00320 break;
00321
00322
00323
00324
00325
00326
00327 case L_ED:
00328 width = _rw_mxdgt[fmtop-1][length-1];
00329 break;
00330
00331
00332
00333
00334
00335 case Q_ED:
00336 width = 0;
00337 break;
00338
00339
00340
00341
00342 default:
00343 width = -1;
00344 break;
00345 }
00346
00347
00348
00349
00350 if (width < 0) {
00351 stat = FERDTYPE;
00352 goto done;
00353 }
00354 }
00355
00356
00357
00358
00359
00360 if (cup->uend) {
00361 stat = FERDPEOF;
00362 goto done;
00363 }
00364
00365
00366
00367
00368
00369
00370
00371 kount = MIN(repcnt,
00372 ((count << cswitch) - (part & cswitch)));
00373 field = width * kount;
00374
00375
00376
00377
00378
00379
00380
00381 if (field > cup->ulinecnt) {
00382
00383 field = width;
00384 kount = 1;
00385
00386 if (width > cup->ulinecnt) {
00387
00388
00389
00390
00391
00392
00393
00394
00395
00396
00397 if (css->u.fmt.nonadv)
00398 stat = FEEORCND;
00399 else
00400 if (cup->upad == OS_NO)
00401 stat = FERDPEOR;
00402
00403
00404
00405
00406
00407
00408
00409 if (cup->ulinecnt <= 0 &&
00410 cup->upad == OS_NO)
00411 goto done;
00412 }
00413 }
00414 }
00415
00416 switch (fmtop) {
00417
00418
00419
00420 case B_ED:
00421 case D_ED:
00422 case E_ED:
00423 case EN_ED:
00424 case ES_ED:
00425 case F_ED:
00426 case G_ED:
00427 case I_ED:
00428 case L_ED:
00429 case O_ED:
00430 case Z_ED:
00431
00432 ngcf = _iconvtab[fmtop];
00433
00434 #ifdef _CRAY
00435 #pragma _CRI align
00436 #endif
00437
00438 for (i = 0; i < kount; i++) {
00439 register short j;
00440 long nstat;
00441
00442
00443
00444 if (length > sizeof(int))
00445 for (j = 1; j < (length/sizeof(int)); j++)
00446 ((int *) cptr)[j] = 0;
00447
00448 itemch = MIN(MAX(0, cup->ulinecnt), width);
00449 tptr = cup->ulineptr + itemch;
00450 nstat = -1;
00451
00452 (void) ngcf(cup->ulineptr, &width, &tptr, &mode,
00453 cptr, &nstat, &digits,
00454 &css->u.fmt.u.fe.scale);
00455
00456 if (nstat < 0) {
00457 stat = _nicverr(nstat);
00458 if (stat > 0)
00459 goto done;
00460 }
00461
00462
00463
00464 cup->ulineptr = cup->ulineptr + itemch;
00465 cup->ulinecnt = cup->ulinecnt - itemch;
00466 chxfer = chxfer + itemch;
00467 count = count - part;
00468 cptr = cptr + cinc[part];
00469 part = part ^ cswitch;
00470 }
00471
00472 repcnt = repcnt - kount;
00473
00474 break;
00475
00476
00477
00478 case A_ED:
00479 case R_ED:
00480
00481 delta = length - width;
00482
00483
00484
00485
00486
00487
00488
00489 if (delta == 0 && tip->stride == 1 && cswitch == 0) {
00490
00491 itemch = MIN(MAX(0, cup->ulinecnt), field);
00492
00493 (void) _pack(cup->ulineptr, cptr, itemch, -1);
00494
00495 padcnt = field - itemch;
00496
00497 if (padcnt > 0)
00498 (void) memset(cptr + itemch, BLANK, (size_t) padcnt);
00499
00500 cup->ulineptr = cup->ulineptr + itemch;
00501 cup->ulinecnt = cup->ulinecnt - itemch;
00502 chxfer = chxfer + itemch;
00503 count = count - kount;
00504 cptr = cptr + (stride * kount);
00505 }
00506 else
00507
00508 #ifdef _CRAY
00509 #pragma _CRI align
00510 #endif
00511
00512 for (i = 0; i < kount; i++) {
00513
00514 ctmp = cptr;
00515 itemch = MIN(MAX(0, cup->ulinecnt), width);
00516
00517
00518
00519
00520
00521
00522
00523
00524 if (delta < 0) {
00525 itemch = itemch + delta;
00526 cup->ulinecnt = cup->ulinecnt + delta;
00527 cup->ulineptr = cup->ulineptr - delta;
00528 padcnt = (delta + width) - itemch;
00529 }
00530
00531
00532
00533
00534
00535
00536
00537
00538
00539 else {
00540 padcnt = delta + (width - itemch);
00541
00542 if (fmtop == R_ED && delta > 0) {
00543 register int fill;
00544
00545 fill = (type == DVTYPE_ASCII) ?
00546 BLANK : 0;
00547
00548 (void) memset(ctmp, fill, (size_t) delta);
00549
00550 ctmp = ctmp + delta;
00551 padcnt = padcnt - delta;
00552 }
00553 }
00554
00555
00556
00557 if (itemch > 0)
00558 (void) _pack(cup->ulineptr, ctmp, itemch, -1);
00559
00560
00561
00562
00563
00564
00565
00566 if (padcnt > 0)
00567 (void) memset(ctmp + itemch, BLANK, (size_t) padcnt);
00568
00569
00570
00571 cup->ulineptr = cup->ulineptr + itemch;
00572 cup->ulinecnt = cup->ulinecnt - itemch;
00573 chxfer = chxfer + itemch;
00574 count = count - part;
00575 cptr = cptr + cinc[part];
00576 part = part ^ cswitch;
00577 }
00578
00579 repcnt = repcnt - kount;
00580 break;
00581
00582 case Q_ED:
00583 if (length == 4)
00584 *(_f_int4 *)cptr = MAX(cup->ulinecnt, 0);
00585 else if (length == 8)
00586 *(_f_int8 *)cptr = MAX(cup->ulinecnt, 0);
00587 else if (length == 2)
00588 *(_f_int2 *)cptr = MAX(cup->ulinecnt, 0);
00589 else
00590 *(_f_int1 *)cptr = MAX(cup->ulinecnt, 0);
00591
00592
00593
00594 count = count - part;
00595 cptr = cptr + cinc[part];
00596 part = part ^ cswitch;
00597 repcnt = repcnt - 1;
00598 break;
00599
00600 case SLASH_ED:
00601 stat = (*css->u.fmt.endrec)(css, cup, width);
00602 repcnt = repcnt - 1;
00603 break;
00604
00605 case TR_ED:
00606 cup->ulineptr = cup->ulineptr + width;
00607 cup->ulinecnt = cup->ulinecnt - width;
00608 repcnt = repcnt - 1;
00609 break;
00610
00611 case T_ED:
00612 tptr = cup->ulineptr;
00613 cup->ulineptr = css->u.fmt.leftablim + width - 1;
00614 cup->ulinecnt = cup->ulinecnt + (tptr - cup->ulineptr);
00615 repcnt = 0;
00616 break;
00617
00618 case TL_ED:
00619 cup->ulineptr = cup->ulineptr - width;
00620 cup->ulinecnt = cup->ulinecnt + width;
00621
00622
00623
00624
00625 if (cup->ulineptr < css->u.fmt.leftablim) {
00626 cup->ulinecnt = cup->ulinecnt -
00627 (css->u.fmt.leftablim - cup->ulineptr);
00628 cup->ulineptr = css->u.fmt.leftablim;
00629 }
00630 repcnt = repcnt - 1;
00631 break;
00632
00633 case STRING_ED:
00634
00635
00636
00637
00638 stat = FEFMTLII;
00639 repcnt = repcnt - 1;
00640 break;
00641
00642 case BN_ED:
00643 css->u.fmt.blank0 = 0;
00644 dfmode = dfmode & ~MODEBZ;
00645 dfmode = dfmode | MODEBN;
00646 repcnt = 0;
00647 break;
00648
00649 case BZ_ED:
00650 css->u.fmt.blank0 = 1;
00651 dfmode = dfmode & ~MODEBN;
00652 dfmode = dfmode | MODEBZ;
00653 repcnt = 0;
00654 break;
00655
00656 case DOLLAR_ED:
00657 case S_ED:
00658 case SS_ED:
00659 case SP_ED:
00660 repcnt = 0;
00661 break;
00662
00663 case P_ED:
00664 css->u.fmt.u.fe.scale = pfmt.rep_count;
00665 repcnt = 0;
00666 break;
00667
00668 case COLON_ED:
00669
00670
00671
00672
00673 if (count == 0)
00674 goto done;
00675
00676 repcnt = 0;
00677 break;
00678
00679 case REPEAT_OP:
00680
00681
00682
00683
00684 *css->u.fmt.u.fe.pftocs++ = pfmt.rep_count;
00685 repcnt = 0;
00686 break;
00687
00688 case ENDREP_OP:
00689
00690
00691
00692
00693
00694
00695
00696
00697 if ( --(*(css->u.fmt.u.fe.pftocs - 1)) < 1)
00698 css->u.fmt.u.fe.pftocs--;
00699 else
00700 css->u.fmt.u.fe.pfcp = css->u.fmt.u.fe.pfcp +
00701 pfmt.rep_count;
00702
00703 repcnt = repcnt - 1;
00704
00705 break;
00706
00707 case REVERT_OP:
00708
00709
00710
00711
00712
00713
00714 if (pfmt.rgcdedf == 0 && count > 0)
00715 stat = FEFMTILF;
00716 else {
00717
00718
00719
00720
00721
00722
00723
00724
00725
00726
00727
00728 if (count == 0)
00729 goto done;
00730
00731
00732
00733 stat = (*css->u.fmt.endrec)(css, cup, 1);
00734 repcnt = 0;
00735
00736
00737
00738 css->u.fmt.u.fe.pfcp = css->u.fmt.u.fe.pfcp +
00739 pfmt.rep_count - 1;
00740 }
00741 break;
00742
00743 default:
00744 stat = FEINTIPF;
00745 break;
00746
00747 }
00748
00749
00750
00751
00752
00753
00754 if (stat == 0 && repcnt < 1) {
00755
00756 if (fmtop == STRING_ED)
00757 css->u.fmt.u.fe.pfcp = css->u.fmt.u.fe.pfcp +
00758 ((width +
00759 FMT_ENTRY_BYTE_SIZE - 1) /
00760 FMT_ENTRY_BYTE_SIZE);
00761
00762 css->u.fmt.u.fe.pfcp = css->u.fmt.u.fe.pfcp + 1;
00763 pfmt = *css->u.fmt.u.fe.pfcp;
00764 repcnt = pfmt.rep_count;
00765 css->u.fmt.u.fe.fmtcol = pfmt.offset;
00766 }
00767
00768 } while (stat == 0);
00769 done:
00770
00771 #ifdef _CRAYT3D
00772 if (shared && ((long *) cptr != shrd)) {
00773 register int items;
00774
00775
00776
00777 items = ((long *) cptr - shrd) / elwords;
00778 (void) _cpytosdd(dptr, shrd, items, elwords, tip->stride, offset);
00779 offset = offset + items;
00780 }
00781
00782 } while (stat == 0 && shared && offset < tcount);
00783 #endif
00784
00785
00786
00787 *css->u.fmt.u.fe.pftocs = repcnt;
00788
00789 if (css->u.fmt.nonadv)
00790 css->u.fmt.u.fe.charcnt = css->u.fmt.u.fe.charcnt + chxfer;
00791
00792
00793
00794 if (stat == FEEORCND) {
00795 if ((cup->uflag & (_UEORF | _UIOSTF)) == 0)
00796 _ferr(css, stat);
00797
00798 cup->pnonadv = 0;
00799 }
00800 else if (stat > 0) {
00801 if ((cup->uflag & (_UERRF | _UIOSTF)) == 0)
00802 _ferr(css, stat);
00803 }
00804 else if (stat < 0) {
00805 if ((cup->uflag & (_UENDF | _UIOSTF)) == 0)
00806 _ferr(css, stat);
00807 }
00808
00809 return(stat);
00810 }
00811
00812 #if defined(__mips) || (defined(_LITTLE_ENDIAN) && defined(__sv2))
00813 #include <ieeefp.h>
00814 #elif defined(_LITTLE_ENDIAN) && !(__sv2)
00815 #include <fpu_control.h>
00816 #endif
00817
00818
00819
00820
00821
00822
00823
00824
00825
00826
00827 int
00828 _nicverr(const int nicverror)
00829 {
00830 int errn;
00831
00832 switch (nicverror) {
00833 case EX_ILLCHAR:
00834 errn = FENICVIC;
00835 break;
00836 case EX_FIXOFLO:
00837 errn = FENICVOF;
00838 break;
00839 case EX_EXPUFLO:
00840 errn = FENICVEU;
00841 #if defined(__mips) || (defined(_LITTLE_ENDIAN) && defined(__sv2))
00842
00843 if ((fpgetmask() & FP_X_UFL) == 0)
00844 errn = 0;
00845 #elif defined (_LITTLE_ENDIAN) && !defined(__sv2)
00846 #endif
00847 break;
00848 case EX_EXPOFLO:
00849 errn = FENICVEO;
00850 #if defined(__mips) || (defined(_LITTLE_ENDIAN) && defined(__sv2))
00851
00852 if ((fpgetmask() & FP_X_OFL) == 0)
00853 errn = 0;
00854 #elif defined (_LITTLE_ENDIAN) && !defined(__sv2)
00855 #endif
00856 break;
00857 case EX_NULLFLD:
00858 errn = FENICVBK;
00859 break;
00860 case EX_INVLOGI:
00861 errn = FERDIVLG;
00862 break;
00863 default:
00864 errn = FEINTUNK;
00865 break;
00866 }
00867
00868 return(errn);
00869 }