Return to dofio.c CVS log

Up to [CSRG BSD Unix] / 42BSD / usr.lib / libI77

Annotation of 42BSD/usr.lib/libI77/dofio.c, revision 1.1.1.1

1.1       root        1: /*
                      2: char id_dofio[] = "@(#)dofio.c 1.3";
                      3:  *
                      4:  * fortran format executer
                      5:  */
                      6: 
                      7: #include "fio.h"
                      8: #include "format.h"
                      9: 
                     10: #define DO(x)  if(n=x) err(n>0?errflag:endflag,n,dfio)
                     11: #define STKSZ 10
                     12: int cnt[STKSZ],ret[STKSZ],cp,rp;
                     13: char *dfio = "dofio";
                     14: 
                     15: en_fio()
                     16: {      ftnint one=1;
                     17:        return(do_fio(&one,NULL,0L));
                     18: }
                     19: 
                     20: do_fio(number,ptr,len) ftnint *number; ftnlen len; char *ptr;
                     21: {      struct syl *p;
                     22:        int n,i,more;
                     23:        more = *number;
                     24:        for(;;)
                     25:        switch(type_f((p= &syl[pc])->op))
                     26:        {
                     27:        case NED:
                     28:                DO((*doned)(p,ptr))
                     29:                pc++;
                     30:                break;
                     31:        case ED:
                     32:                if(ptr==NULL)
                     33:                {       DO((*doend)('\n'))
                     34:                        return(OK);
                     35:                }
                     36:                if(cnt[cp]<=0)
                     37:                {       cp--;
                     38:                        pc++;
                     39:                        break;
                     40:                }
                     41:                if(!more) return(OK);
                     42:                DO((*doed)(p,ptr,len))
                     43:                cnt[cp]--;
                     44:                ptr += len;
                     45:                more--;
                     46:                break;
                     47:        case STACK:             /* repeat count */
                     48:                if(++cp==STKSZ) err(errflag,F_ERFMT,"too many nested ()")
                     49:                cnt[cp]=p->p1;
                     50:                pc++;
                     51:                break;
                     52:        case RET:               /* open paren */
                     53:                if(++rp==STKSZ) err(errflag,F_ERFMT,"too many nested ()")
                     54:                ret[rp]=p->p1;
                     55:                pc++;
                     56:                break;
                     57:        case GOTO:              /* close paren */
                     58:                if(--cnt[cp]<=0)
                     59:                {       cp--;
                     60:                        rp--;
                     61:                        pc++;
                     62:                }
                     63:                else pc = ret[rp--] + 1;
                     64:                break;
                     65:        case REVERT:            /* end of format */
                     66:                if(ptr==NULL)
                     67:                {       DO((*doend)('\n'))
                     68:                        return(OK);
                     69:                }
                     70:                if(!more) return(OK);
                     71:                rp=cp=0;
                     72:                pc = p->p1;
                     73:                DO((*dorevert)())
                     74:                break;
                     75:        case COLON:
                     76: #ifndef KOSHER
                     77:        case DOLAR:                             /*** NOT STANDARD FORTRAN ***/
                     78: #endif
                     79:                if (ptr == NULL)
                     80:                {       DO((*doend)((char)p->p1))
                     81:                        return(OK);
                     82:                }
                     83:                if (!more) return(OK);
                     84:                pc++;
                     85:                break;
                     86: #ifndef KOSHER
                     87:        case SU:                                /*** NOT STANDARD FORTRAN ***/
                     88: #endif
                     89:        case SS:
                     90:        case SP:
                     91:        case S: cplus = p->p1;
                     92:                signit = p->p2;
                     93:                pc++;
                     94:                break;
                     95:        case P:
                     96:                scale = p->p1;
                     97:                pc++;
                     98:                break;
                     99: #ifndef KOSHER
                    100:        case R:                                 /*** NOT STANDARD FORTRAN ***/
                    101:                radix = p->p1;
                    102:                pc++;
                    103:                break;
                    104: #endif
                    105:        case BN:
                    106:        case BZ:
                    107:                cblank = p->p1;
                    108:                pc++;
                    109:                break;
                    110:        default:
                    111:                err(errflag,F_ERFMT,"impossible code")
                    112:        }
                    113: }
                    114: 
                    115: fmt_bg()
                    116: {
                    117:        cp=rp=pc=cursor=0;
                    118:        cnt[0]=ret[0]=0;
                    119: }
                    120: 
                    121: type_f(n)
                    122: {
                    123: #ifdef DEBUG
                    124:        fprintf(stderr," pc=%d, cnt[%d]=%d, ret[%d]=%d, op=%d\n",
                    125:                pc,cp,cnt[cp],rp,ret[rp],n); /*for debug*/
                    126: #endif
                    127:        switch(n)
                    128:        {
                    129:        case X:                 /* non-editing specifications */
                    130:        case SLASH:
                    131:        case APOS: case H:
                    132:        case T: case TL: case TR:
                    133:                                return(NED);
                    134: 
                    135:        case F:                 /* editing conversions */
                    136:        case I: case IM:
                    137:        case A: case AW:
                    138:        case L:
                    139:        case E: case EE: case D: case DE:
                    140:        case G: case GE:
                    141:                                return(ED);
                    142: 
                    143:        default: return(n);
                    144:        }
                    145: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.