Return to dofio.c CVS log

Up to [CSRG BSD Unix] / 40BSD / lib / libI77uc

Annotation of 40BSD/lib/libI77uc/dofio.c, revision 1.1.1.1

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

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