Return to fortran.c CVS log

Up to [CSRG BSD Unix] / 43BSDReno / pgrm / dbx

Annotation of 43BSDReno/pgrm/dbx/fortran.c, revision 1.1

1.1     ! root        1: /*
        !             2:  * Copyright (c) 1983 The Regents of the University of California.
        !             3:  * All rights reserved.
        !             4:  *
        !             5:  * Redistribution and use in source and binary forms are permitted
        !             6:  * provided that: (1) source distributions retain this entire copyright
        !             7:  * notice and comment, and (2) distributions including binaries display
        !             8:  * the following acknowledgement:  ``This product includes software
        !             9:  * developed by the University of California, Berkeley and its contributors''
        !            10:  * in the documentation or other materials provided with the distribution
        !            11:  * and in all advertising materials mentioning features or use of this
        !            12:  * software. Neither the name of the University nor the names of its
        !            13:  * contributors may be used to endorse or promote products derived
        !            14:  * from this software without specific prior written permission.
        !            15:  * THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR
        !            16:  * IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
        !            17:  * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
        !            18:  */
        !            19: 
        !            20: #ifndef lint
        !            21: static char sccsid[] = "@(#)fortran.c  5.7 (Berkeley) 6/1/90";
        !            22: #endif /* not lint */
        !            23: 
        !            24: /*
        !            25:  * FORTRAN dependent symbol routines.
        !            26:  */
        !            27: 
        !            28: #include "defs.h"
        !            29: #include "symbols.h"
        !            30: #include "printsym.h"
        !            31: #include "languages.h"
        !            32: #include "fortran.h"
        !            33: #include "tree.h"
        !            34: #include "eval.h"
        !            35: #include "operators.h"
        !            36: #include "mappings.h"
        !            37: #include "process.h"
        !            38: #include "runtime.h"
        !            39: #include "machine.h"
        !            40: 
        !            41: #define isspecial(range) ( \
        !            42:     range->symvalue.rangev.upper == 0 and range->symvalue.rangev.lower > 0 \
        !            43: )
        !            44: 
        !            45: #define isrange(t, name) (t->class == RANGE and istypename(t->type, name))
        !            46: 
        !            47: #define MAXDIM  20
        !            48: 
        !            49: private Language fort;
        !            50: 
        !            51: /*
        !            52:  * Initialize FORTRAN language information.
        !            53:  */
        !            54: 
        !            55: public fortran_init()
        !            56: {
        !            57:     fort = language_define("fortran", ".f");
        !            58:     language_setop(fort, L_PRINTDECL, fortran_printdecl);
        !            59:     language_setop(fort, L_PRINTVAL, fortran_printval);
        !            60:     language_setop(fort, L_TYPEMATCH, fortran_typematch);
        !            61:     language_setop(fort, L_BUILDAREF, fortran_buildaref);
        !            62:     language_setop(fort, L_EVALAREF, fortran_evalaref);
        !            63:     language_setop(fort, L_MODINIT, fortran_modinit);
        !            64:     language_setop(fort, L_HASMODULES, fortran_hasmodules);
        !            65:     language_setop(fort, L_PASSADDR, fortran_passaddr);
        !            66: }
        !            67: 
        !            68: /*
        !            69:  * Test if two types are compatible.
        !            70:  *
        !            71:  * Integers and reals are not compatible since they cannot always be mixed.
        !            72:  */
        !            73: 
        !            74: public Boolean fortran_typematch(type1, type2)
        !            75: Symbol type1, type2;
        !            76: {
        !            77: 
        !            78: /* only does integer for now; may need to add others
        !            79: */
        !            80: 
        !            81:     Boolean b;
        !            82:     register Symbol t1, t2, tmp;
        !            83: 
        !            84:     t1 = rtype(type1);
        !            85:     t2 = rtype(type2);
        !            86:     if(t1 == nil or t1->type == nil or t2 == nil or t2->type == nil ) b = false;
        !            87:     else { b = (Boolean)   (
        !            88:             (t1 == t2)  or 
        !            89:            (t1->type == t_int and (istypename(t2->type, "integer") or
        !            90:                                     istypename(t2->type, "integer*2"))  ) or
        !            91:            (t2->type == t_int and (istypename(t1->type, "integer") or
        !            92:                                     istypename(t1->type, "integer*2"))  ) 
        !            93:                     );
        !            94:          }
        !            95:     /*OUT fprintf(stderr," %d compat %s %s \n", b,
        !            96:       (t1 == nil or t1->type == nil ) ? "nil" : symname(t1->type),
        !            97:       (t2 == nil or t2->type == nil ) ? "nil" : symname(t2->type)  );*/
        !            98:     return b;
        !            99: }
        !           100: 
        !           101: private String typename(s)
        !           102: Symbol s;
        !           103: {
        !           104: int ub;
        !           105: static char buf[20];
        !           106: char *pbuf;
        !           107: Symbol st,sc;
        !           108: 
        !           109:      if(s->type->class == TYPE) return(symname(s->type));
        !           110: 
        !           111:      for(st = s->type; st->type->class != TYPE; st = st->type);
        !           112: 
        !           113:      pbuf=buf;
        !           114: 
        !           115:      if(istypename(st->type,"char"))  { 
        !           116:          sprintf(pbuf,"character*");
        !           117:           pbuf += strlen(pbuf);
        !           118:          sc = st->chain;
        !           119:           if(sc->symvalue.rangev.uppertype == R_ARG or
        !           120:              sc->symvalue.rangev.uppertype == R_TEMP) {
        !           121:              if( ! getbound(s,sc->symvalue.rangev.upper, 
        !           122:                     sc->symvalue.rangev.uppertype, &ub) )
        !           123:                sprintf(pbuf,"(*)");
        !           124:              else 
        !           125:                sprintf(pbuf,"%d",ub);
        !           126:           }
        !           127:          else sprintf(pbuf,"%d",sc->symvalue.rangev.upper);
        !           128:      }
        !           129:      else {
        !           130:           sprintf(pbuf,"%s ",symname(st->type));
        !           131:      }
        !           132:      return(buf);
        !           133: }
        !           134: 
        !           135: private Symbol mksubs(pbuf,st)
        !           136: Symbol st;
        !           137: char  **pbuf;
        !           138: {   
        !           139:    int lb, ub;
        !           140:    Symbol r, eltype;
        !           141: 
        !           142:    if(st->class != ARRAY or (istypename(st->type, "char")) ) return;
        !           143:    else {
        !           144:           mksubs(pbuf,st->type);
        !           145:           assert( (r = st->chain)->class == RANGE);
        !           146: 
        !           147:           if(r->symvalue.rangev.lowertype == R_ARG or
        !           148:              r->symvalue.rangev.lowertype == R_TEMP) {
        !           149:              if( ! getbound(st,r->symvalue.rangev.lower, 
        !           150:                     r->symvalue.rangev.lowertype, &lb) )
        !           151:                sprintf(*pbuf,"?:");
        !           152:              else 
        !           153:                sprintf(*pbuf,"%d:",lb);
        !           154:          }
        !           155:           else {
        !           156:                lb = r->symvalue.rangev.lower;
        !           157:                sprintf(*pbuf,"%d:",lb);
        !           158:                }
        !           159:          *pbuf += strlen(*pbuf);
        !           160: 
        !           161:           if(r->symvalue.rangev.uppertype == R_ARG or
        !           162:              r->symvalue.rangev.uppertype == R_TEMP) {
        !           163:              if( ! getbound(st,r->symvalue.rangev.upper, 
        !           164:                     r->symvalue.rangev.uppertype, &ub) )
        !           165:                sprintf(*pbuf,"?,");
        !           166:              else 
        !           167:                sprintf(*pbuf,"%d,",ub);
        !           168:          }
        !           169:           else {
        !           170:                ub = r->symvalue.rangev.upper;
        !           171:                sprintf(*pbuf,"%d,",ub);
        !           172:                }
        !           173:          *pbuf += strlen(*pbuf);
        !           174: 
        !           175:        }
        !           176: }
        !           177: 
        !           178: /*
        !           179:  * Print out the declaration of a FORTRAN variable.
        !           180:  */
        !           181: 
        !           182: public fortran_printdecl(s)
        !           183: Symbol s;
        !           184: {
        !           185:     Symbol eltype;
        !           186: 
        !           187:     switch (s->class) {
        !           188:        case CONST:
        !           189:            printf("parameter %s = ", symname(s));
        !           190:            eval(s->symvalue.constval);
        !           191:             printval(s);
        !           192:            break;
        !           193: 
        !           194:         case REF:
        !           195:             printf(" (dummy argument) ");
        !           196: 
        !           197:        case VAR:
        !           198:            if (s->type->class == ARRAY &&
        !           199:                 (not istypename(s->type->type,"char")) ) {
        !           200:                 char bounds[130], *p1, **p;
        !           201:                p1 = bounds;
        !           202:                 p = &p1;
        !           203:                 mksubs(p,s->type);
        !           204:                 *p -= 1; 
        !           205:                 **p = '\0';   /* get rid of trailing ',' */
        !           206:                printf(" %s %s[%s] ",typename(s), symname(s), bounds);
        !           207:            } else {
        !           208:                printf("%s %s", typename(s), symname(s));
        !           209:            }
        !           210:            break;
        !           211: 
        !           212:        case FUNC:
        !           213:            if (not istypename(s->type, "void")) {
        !           214:                 printf(" %s function ", typename(s) );
        !           215:            }
        !           216:            else printf(" subroutine");
        !           217:            printf(" %s ", symname(s));
        !           218:            fortran_listparams(s);
        !           219:            break;
        !           220: 
        !           221:        case MODULE:
        !           222:            printf("source file \"%s.c\"", symname(s));
        !           223:            break;
        !           224: 
        !           225:        case PROG:
        !           226:            printf("executable file \"%s\"", symname(s));
        !           227:            break;
        !           228: 
        !           229:        default:
        !           230:            error("class %s in fortran_printdecl", classname(s));
        !           231:     }
        !           232:     putchar('\n');
        !           233: }
        !           234: 
        !           235: /*
        !           236:  * List the parameters of a procedure or function.
        !           237:  * No attempt is made to combine like types.
        !           238:  */
        !           239: 
        !           240: public fortran_listparams(s)
        !           241: Symbol s;
        !           242: {
        !           243:     register Symbol t;
        !           244: 
        !           245:     putchar('(');
        !           246:     for (t = s->chain; t != nil; t = t->chain) {
        !           247:        printf("%s", symname(t));
        !           248:        if (t->chain != nil) {
        !           249:            printf(", ");
        !           250:        }
        !           251:     }
        !           252:     putchar(')');
        !           253:     if (s->chain != nil) {
        !           254:        printf("\n");
        !           255:        for (t = s->chain; t != nil; t = t->chain) {
        !           256:            if (t->class != REF) {
        !           257:                panic("unexpected class %d for parameter", t->class);
        !           258:            }
        !           259:            printdecl(t, 0);
        !           260:        }
        !           261:     } else {
        !           262:        putchar('\n');
        !           263:     }
        !           264: }
        !           265: 
        !           266: /*
        !           267:  * Print out the value on the top of the expression stack
        !           268:  * in the format for the type of the given symbol.
        !           269:  */
        !           270: 
        !           271: public fortran_printval(s)
        !           272: Symbol s;
        !           273: {
        !           274:     register Symbol t;
        !           275:     register Address a;
        !           276:     register int i, len;
        !           277:     double d1, d2;
        !           278: 
        !           279:     switch (s->class) {
        !           280:        case CONST:
        !           281:        case TYPE:
        !           282:        case VAR:
        !           283:        case REF:
        !           284:        case FVAR:
        !           285:        case TAG:
        !           286:            fortran_printval(s->type);
        !           287:            break;
        !           288: 
        !           289:        case ARRAY:
        !           290:            t = rtype(s->type);
        !           291:            if (t->class == RANGE and istypename(t->type, "char")) {
        !           292:                len = size(s);
        !           293:                sp -= len;
        !           294:                printf("\"%.*s\"", len, sp);
        !           295:            } else {
        !           296:                fortran_printarray(s);
        !           297:            }
        !           298:            break;
        !           299: 
        !           300:        case RANGE:
        !           301:             if (isspecial(s)) {
        !           302:                switch (s->symvalue.rangev.lower) {
        !           303:                    case sizeof(short):
        !           304:                        if (istypename(s->type, "logical*2")) {
        !           305:                            printlogical(pop(short));
        !           306:                        }
        !           307:                        break;
        !           308: 
        !           309:                    case sizeof(float):
        !           310:                        if (istypename(s->type, "logical")) {
        !           311:                            printlogical(pop(long));
        !           312:                        } else {
        !           313:                            prtreal(pop(float));
        !           314:                        }
        !           315:                        break;
        !           316: 
        !           317:                    case sizeof(double):
        !           318:                        if (istypename(s->type,"complex")) {
        !           319:                            d2 = pop(float);
        !           320:                            d1 = pop(float);
        !           321:                            printf("(");
        !           322:                            prtreal(d1);
        !           323:                            printf(",");
        !           324:                            prtreal(d2);
        !           325:                            printf(")");
        !           326:                        } else {
        !           327:                            prtreal(pop(double));
        !           328:                        }
        !           329:                        break;
        !           330: 
        !           331:                    case 2*sizeof(double):
        !           332:                        d2 = pop(double);
        !           333:                        d1 = pop(double);
        !           334:                        printf("(");
        !           335:                        prtreal(d1);
        !           336:                        printf(",");
        !           337:                        prtreal(d2);
        !           338:                        printf(")");
        !           339:                        break;
        !           340: 
        !           341:                    default:
        !           342:                        panic("bad size \"%d\" for special",
        !           343:                                   s->symvalue.rangev.lower);
        !           344:                        break;
        !           345:                }
        !           346:            } else {
        !           347:                printint(popsmall(s), s);
        !           348:            }
        !           349:            break;
        !           350: 
        !           351:        default:
        !           352:            if (ord(s->class) > ord(TYPEREF)) {
        !           353:                panic("printval: bad class %d", ord(s->class));
        !           354:            }
        !           355:            error("don't know how to print a %s", fortran_classname(s));
        !           356:            /* NOTREACHED */
        !           357:     }
        !           358: }
        !           359: 
        !           360: /*
        !           361:  * Print out a logical
        !           362:  */
        !           363: 
        !           364: private printlogical (i)
        !           365: integer i;
        !           366: {
        !           367:     if (i == 0) {
        !           368:        printf(".false.");
        !           369:     } else {
        !           370:        printf(".true.");
        !           371:     }
        !           372: }
        !           373: 
        !           374: /*
        !           375:  * Print out an int 
        !           376:  */
        !           377: 
        !           378: private printint(i, t)
        !           379: Integer i;
        !           380: register Symbol t;
        !           381: {
        !           382:     if (t->type == t_int or istypename(t->type, "integer") or
        !           383:        istypename(t->type,"integer*2")
        !           384:     ) {
        !           385:        printf("%ld", i);
        !           386:     } else if (istypename(t->type, "addr")) {
        !           387:        printf("0x%lx", i);
        !           388:     } else {
        !           389:        error("unknown type in fortran printint");
        !           390:     }
        !           391: }
        !           392: 
        !           393: /*
        !           394:  * Print out a null-terminated string (pointer to char)
        !           395:  * starting at the given address.
        !           396:  */
        !           397: 
        !           398: private printstring(addr)
        !           399: Address addr;
        !           400: {
        !           401:     register Address a;
        !           402:     register Integer i, len;
        !           403:     register Boolean endofstring;
        !           404:     union {
        !           405:        char ch[sizeof(Word)];
        !           406:        int word;
        !           407:     } u;
        !           408: 
        !           409:     putchar('"');
        !           410:     a = addr;
        !           411:     endofstring = false;
        !           412:     while (not endofstring) {
        !           413:        dread(&u, a, sizeof(u));
        !           414:        i = 0;
        !           415:        do {
        !           416:            if (u.ch[i] == '\0') {
        !           417:                endofstring = true;
        !           418:            } else {
        !           419:                printchar(u.ch[i]);
        !           420:            }
        !           421:            ++i;
        !           422:        } while (i < sizeof(Word) and not endofstring);
        !           423:        a += sizeof(Word);
        !           424:     }
        !           425:     putchar('"');
        !           426: }
        !           427: /*
        !           428:  * Return the FORTRAN name for the particular class of a symbol.
        !           429:  */
        !           430: 
        !           431: public String fortran_classname(s)
        !           432: Symbol s;
        !           433: {
        !           434:     String str;
        !           435: 
        !           436:     switch (s->class) {
        !           437:        case REF:
        !           438:            str = "dummy argument";
        !           439:            break;
        !           440: 
        !           441:        case CONST:
        !           442:            str = "parameter";
        !           443:            break;
        !           444: 
        !           445:        default:
        !           446:            str = classname(s);
        !           447:     }
        !           448:     return str;
        !           449: }
        !           450: 
        !           451: /* reverses the indices from the expr_list; should be folded into buildaref
        !           452:  * and done as one recursive routine
        !           453:  */
        !           454: Node private rev_index(here,n)
        !           455: register Node here,n;
        !           456: {
        !           457:  
        !           458:   register Node i;
        !           459: 
        !           460:   if( here == nil  or  here == n) i=nil;
        !           461:   else if( here->value.arg[1] == n) i = here;
        !           462:   else i=rev_index(here->value.arg[1],n);
        !           463:   return i;
        !           464: }
        !           465: 
        !           466: public Node fortran_buildaref(a, slist)
        !           467: Node a, slist;
        !           468: {
        !           469:     register Symbol as;      /* array of array of .. cursor */
        !           470:     register Node en;        /* Expr list cursor */
        !           471:     Symbol etype;            /* Type of subscript expr */
        !           472:     Node esub, tree;         /* Subscript expression ptr and tree to be built*/
        !           473: 
        !           474:     tree=a;
        !           475: 
        !           476:     as = rtype(tree->nodetype);     /* node->sym.type->array*/
        !           477:     if ( not (
        !           478:                (tree->nodetype->class == VAR or tree->nodetype->class == REF)
        !           479:                 and as->class == ARRAY
        !           480:              ) ) {
        !           481:        beginerrmsg();
        !           482:        prtree(stderr, a);
        !           483:        fprintf(stderr, " is not an array");
        !           484:        /*fprintf(stderr, " a-> %x as %x ", tree->nodetype, as ); OUT*/
        !           485:        enderrmsg();
        !           486:     } else {
        !           487:        for (en = rev_index(slist,nil); en != nil and as->class == ARRAY;
        !           488:                      en = rev_index(slist,en), as = as->type) {
        !           489:            esub = en->value.arg[0];
        !           490:            etype = rtype(esub->nodetype);
        !           491:             assert(as->chain->class == RANGE);
        !           492:            if ( not compatible( t_int, etype) ) {
        !           493:                beginerrmsg();
        !           494:                fprintf(stderr, "subscript ");
        !           495:                prtree(stderr, esub);
        !           496:                fprintf(stderr, " is type %s ",symname(etype->type) );
        !           497:                enderrmsg();
        !           498:            }
        !           499:            tree = build(O_INDEX, tree, esub);
        !           500:            tree->nodetype = as->type;
        !           501:        }
        !           502:        if (en != nil or
        !           503:              (as->class == ARRAY && (not istypename(as->type,"char"))) ) {
        !           504:            beginerrmsg();
        !           505:            if (en != nil) {
        !           506:                fprintf(stderr, "too many subscripts for ");
        !           507:            } else {
        !           508:                fprintf(stderr, "not enough subscripts for ");
        !           509:            }
        !           510:            prtree(stderr, tree);
        !           511:            enderrmsg();
        !           512:        }
        !           513:     }
        !           514:     return tree;
        !           515: }
        !           516: 
        !           517: /*
        !           518:  * Evaluate a subscript index.
        !           519:  */
        !           520: 
        !           521: public fortran_evalaref(s, base, i)
        !           522: Symbol s;
        !           523: Address base;
        !           524: long i;
        !           525: {
        !           526:     Symbol r, t;
        !           527:     long lb, ub;
        !           528: 
        !           529:     t = rtype(s);
        !           530:     r = t->chain;
        !           531:     if (
        !           532:        r->symvalue.rangev.lowertype == R_ARG or
        !           533:         r->symvalue.rangev.lowertype == R_TEMP
        !           534:     ) {
        !           535:        if (not getbound(
        !           536:            s, r->symvalue.rangev.lower, r->symvalue.rangev.lowertype, &lb
        !           537:        )) {
        !           538:           error("dynamic bounds not currently available");
        !           539:        }
        !           540:     } else {
        !           541:        lb = r->symvalue.rangev.lower;
        !           542:     }
        !           543:     if (
        !           544:        r->symvalue.rangev.uppertype == R_ARG or
        !           545:         r->symvalue.rangev.uppertype == R_TEMP
        !           546:     ) {
        !           547:        if (not getbound(
        !           548:            s, r->symvalue.rangev.upper, r->symvalue.rangev.uppertype, &ub
        !           549:        )) {
        !           550:           error("dynamic bounds not currently available");
        !           551:        }
        !           552:     } else {
        !           553:        ub = r->symvalue.rangev.upper;
        !           554:     }
        !           555: 
        !           556:     if (i < lb or i > ub) {
        !           557:        error("subscript out of range");
        !           558:     }
        !           559:     push(long, base + (i - lb) * size(t->type));
        !           560: }
        !           561: 
        !           562: private fortran_printarray(a)
        !           563: Symbol a;
        !           564: {
        !           565: struct Bounds { int lb, val, ub; } dim[MAXDIM];
        !           566: 
        !           567: Symbol sc,st,eltype;
        !           568: char buf[50];
        !           569: char *subscr;
        !           570: int i,ndim,elsize;
        !           571: Stack *savesp;
        !           572: Boolean done;
        !           573: 
        !           574: st = a;
        !           575: 
        !           576: savesp = sp;
        !           577: sp -= size(a);
        !           578: ndim=0;
        !           579: 
        !           580: for(;;){
        !           581:           sc = st->chain;
        !           582:           if(sc->symvalue.rangev.lowertype == R_ARG or
        !           583:              sc->symvalue.rangev.lowertype == R_TEMP) {
        !           584:              if( ! getbound(a,sc->symvalue.rangev.lower, 
        !           585:                     sc->symvalue.rangev.lowertype, &dim[ndim].lb) )
        !           586:                error(" dynamic bounds not currently available");
        !           587:          }
        !           588:          else dim[ndim].lb = sc->symvalue.rangev.lower;
        !           589: 
        !           590:           if(sc->symvalue.rangev.uppertype == R_ARG or
        !           591:              sc->symvalue.rangev.uppertype == R_TEMP) {
        !           592:              if( ! getbound(a,sc->symvalue.rangev.upper, 
        !           593:                     sc->symvalue.rangev.uppertype, &dim[ndim].ub) )
        !           594:                error(" dynamic bounds not currently available");
        !           595:          }
        !           596:          else dim[ndim].ub = sc->symvalue.rangev.upper;
        !           597: 
        !           598:           ndim ++;
        !           599:           if (st->type->class == ARRAY) st=st->type;
        !           600:          else break;
        !           601:      }
        !           602: 
        !           603: if(istypename(st->type,"char")) {
        !           604:                eltype = st;
        !           605:                ndim--;
        !           606:        }
        !           607: else eltype=st->type;
        !           608: elsize=size(eltype);
        !           609: sp += elsize;
        !           610:  /*printf("ndim %d elsize %lx in fortran_printarray\n",ndim,elsize);OUT*/
        !           611: 
        !           612: ndim--;
        !           613: for (i=0;i<=ndim;i++){
        !           614:          dim[i].val=dim[i].lb;
        !           615:          /*OUT printf(" %d %d %d \n",i,dim[i].lb,dim[i].ub);
        !           616:            fflush(stdout); OUT*/
        !           617: }
        !           618: 
        !           619: 
        !           620: for(;;) {
        !           621:        buf[0]=',';
        !           622:        subscr = buf+1;
        !           623: 
        !           624:        for (i=ndim-1;i>=0;i--)  {
        !           625: 
        !           626:                sprintf(subscr,"%d,",dim[i].val);
        !           627:                subscr += strlen(subscr);
        !           628:        }
        !           629:         *--subscr = '\0';
        !           630: 
        !           631:        for(i=dim[ndim].lb;i<=dim[ndim].ub;i++) {
        !           632:                printf("[%d%s]\t",i,buf);
        !           633:                printval(eltype);
        !           634:                printf("\n");
        !           635:                sp += 2*elsize;
        !           636:        }
        !           637:         dim[ndim].val=dim[ndim].ub;
        !           638: 
        !           639:         i=ndim-1;
        !           640:         if (i<0) break;
        !           641: 
        !           642:         done=false;
        !           643:         do {
        !           644:                dim[i].val++;
        !           645:                if(dim[i].val > dim[i].ub) { 
        !           646:                        dim[i].val = dim[i].lb;
        !           647:                        if(--i<0) done=true;
        !           648:                }
        !           649:                else done=true;
        !           650:          }
        !           651:         while (not done);
        !           652:          if (i<0) break;
        !           653:      }
        !           654: }
        !           655: 
        !           656: /*
        !           657:  * Initialize typetable at beginning of a module.
        !           658:  */
        !           659: 
        !           660: public fortran_modinit (typetable)
        !           661: Symbol typetable[];
        !           662: {
        !           663:     /* nothing for now */
        !           664: }
        !           665: 
        !           666: public boolean fortran_hasmodules ()
        !           667: {
        !           668:     return false;
        !           669: }
        !           670: 
        !           671: public boolean fortran_passaddr (param, exprtype)
        !           672: Symbol param, exprtype;
        !           673: {
        !           674:     return false;
        !           675: }

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