00295 {
00296         register char *s;
00297         register int i, j;
00298 
00299         lastiolabno = 100000;
00300         lastlabno = 0;
00301         lastvarno = 0;
00302         nliterals = 0;
00303         nerr = 0;
00304 
00305         infile = stdin;
00306 
00307         maxtoklen = 502;
00308         token = (char *)ckalloc(maxtoklen+2);
00309         memset(dflttype, tyreal, 26);
00310         memset(dflttype + 'i' - 'a', tyint, 6);
00311         memset(hextoi_tab, 16, sizeof(hextoi_tab));
00312         for(i = 0, s = "0123456789abcdef"; *s; i++, s++)
00313                 hextoi(*s) = i;
00314         for(i = 10, s = "ABCDEF"; *s; i++, s++)
00315                 hextoi(*s) = i;
00316         for(j = 0, s = "abcdefghijklmnopqrstuvwxyz"; i = *s++; j++)
00317                 Letters[i] = Letters[i+'A'-'a'] = j;
00318 
00319         ctls = ALLOCN(maxctl+1, Ctlframe);
00320         extsymtab = ALLOCN(maxext, Extsym);
00321         eqvclass = ALLOCN(maxequiv, Equivblock);
00322         hashtab = ALLOCN(maxhash, Hashentry);
00323         labeltab = ALLOCN(maxstno, Labelblock);
00324         litpool = ALLOCN(maxliterals, Literal);
00325         labarray = (struct Labelblock **)ckalloc(maxlablist*
00326                                         sizeof(struct Labelblock *));
00327         fmt_init();
00328         mem_init();
00329         np_init();
00330 
00331         ctlstack = ctls++;
00332         lastctl = ctls + maxctl;
00333         nextext = extsymtab;
00334         lastext = extsymtab + maxext;
00335         lasthash = hashtab + maxhash;
00336         labtabend = labeltab + maxstno;
00337         highlabtab = labeltab;
00338         main_alias[0] = '\0';
00339         if (forcedouble)
00340                 dfltproc[TYREAL] = dfltproc[TYDREAL];
00341 
00342 /* Initialize the routines for providing C output */
00343 
00344         out_init ();
00345 }

00349 {
00350         register struct Hashentry *hp;
00351         register Namep p;
00352         register struct Dimblock *q;
00353         register int i;
00354 
00355         for(hp = hashtab ; hp < lasthash ; ++hp)
00356                 if(p = hp->varp)
00357                 {
00358                         frexpr(p->vleng);
00359                         if(q = p->vdim)
00360                         {
00361                                 for(i = 0 ; i < q->ndim ; ++i)
00362                                 {
00363                                         frexpr(q->dims[i].dimsize);
00364                                         frexpr(q->dims[i].dimexpr);
00365                                 }
00366                                 frexpr(q->nelt);
00367                                 frexpr(q->baseoffset);
00368                                 frexpr(q->basexpr);
00369                                 free( (charptr) q);
00370                         }
00371                         if(p->vclass == CLNAMELIST)
00372                                 frchain( &(p->varxptr.namelist) );
00373                         free( (charptr) p);
00374                         hp->varp = NULL;
00375                 }
00376         }

00380 {
00381         register struct Labelblock *lp;
00382         struct Chain *cp;
00383         int i;
00384         struct memblock;
00385         extern struct memblock *curmemblock, *firstmemblock;
00386         extern char *mem_first, *mem_next, *mem_last, *mem0_last;
00387 
00388         curmemblock = firstmemblock;
00389         mem_next = mem_first;
00390         mem_last = mem0_last;
00391         ei_next = ei_first = ei_last = 0;
00392         wh_next = wh_first = wh_last = 0;
00393         iob_list = 0;
00394         for(i = 0; i < 9; i++)
00395                 io_structs[i] = 0;
00396 
00397         parstate = OUTSIDE;
00398         headerdone = NO;
00399         blklevel = 1;
00400         saveall = NO;
00401         substars = NO;
00402         nwarn = 0;
00403         thislabel = NULL;
00404         needkwd = 0;
00405 
00406         proctype = TYUNKNOWN;
00407         procname = "MAIN_";
00408         procclass = CLUNKNOWN;
00409         nentry = 0;
00410         nallargs = nallchargs = 0;
00411         multitype = NO;
00412         retslot = NULL;
00413         for(i = 0; i < NTYPES0; i++) {
00414                 frexpr((expptr)xretslot[i]);
00415                 xretslot[i] = 0;
00416                 }
00417         cxslot = -1;
00418         chslot = -1;
00419         chlgslot = -1;
00420         procleng = 0;
00421         blklevel = 1;
00422         lastargslot = 0;
00423 
00424         for(lp = labeltab ; lp < labtabend ; ++lp)
00425                 lp->stateno = 0;
00426 
00427         hashclear();
00428 
00429 /* Clear the list of newly generated identifiers from the previous
00430    function */
00431 
00432         frexchain(&new_vars);
00433         frexchain(&used_builtins);
00434         frchain(&assigned_fmts);
00435         frchain(&allargs);
00436         frchain(&earlylabs);
00437 
00438         nintnames = 0;
00439         highlabtab = labeltab;
00440 
00441         ctlstack = ctls - 1;
00442         for(i = TYADDR; i < TYVOID; i++) {
00443                 for(cp = templist[i]; cp ; cp = cp->nextp)
00444                         free( (charptr) (cp->datap) );
00445                 frchain(templist + i);
00446                 autonum[i] = 0;
00447                 }
00448         holdtemps = NULL;
00449         dorange = 0;
00450         nregvar = 0;
00451         highregvar = 0;
00452         entries = NULL;
00453         rpllist = NULL;
00454         inioctl = NO;
00455         eqvstart += nequiv;
00456         nequiv = 0;
00457         dcomplex_seen = 0;
00458 
00459         for(i = 0 ; i<NTYPES0 ; ++i)
00460                 rtvlabel[i] = 0;
00461 
00462         if(undeftype)
00463                 setimpl(TYUNKNOWN, (ftnint) 0, 'a', 'z');
00464         else
00465         {
00466                 setimpl(tyreal, (ftnint) 0, 'a', 'z');
00467                 setimpl(tyint,  (ftnint) 0, 'i', 'n');
00468         }
00469         setimpl(-STGBSS, (ftnint) 0, 'a', 'z'); /* set class */
00470 }

00484 {
00485         int i;
00486         char buff[100];
00487 
00488         if(c1==0 || c2==0)
00489                 return;
00490 
00491         if(c1 > c2) {
00492                 sprintf(buff, "characters out of order in implicit:%c-%c", c1, c2);
00493                 err(buff);
00494                 }
00495         else {
00496                 c1 = letter(c1);
00497                 c2 = letter(c2);
00498                 if(type < 0)
00499                         for(i = c1 ; i<=c2 ; ++i)
00500                                 implstg[i] = - type;
00501                 else {
00502                         type = lengtype(type, length);
00503                         if(type == TYCHAR) {
00504                                 if (length < 0) {
00505                                         err("length (*) in implicit");
00506                                         length = 1;
00507                                         }
00508                                 }
00509                         else if (type != TYLONG)
00510                                 length = 0;
00511                         for(i = c1 ; i<=c2 ; ++i) {
00512                                 impltype[i] = type;
00513                                 implleng[i] = length;
00514                                 }
00515                         }
00516                 }
00517         }

 {"??TYUNKNOWN??", "a","i1","s","i",

                         "i8",

                        "r","d","q","z","L1","L2","L","ch",
                         "??TYSUBR??", "??TYERROR??","ci", "ici",
                         "o", "cl", "al", "ioin" }

 {
        "U_fp", "??bug??", "I1_fp",
        "J_fp", "I_fp",

        "Q_fp",

        "R_fp", "D_fp", "C_fp", "Z_fp",
        "L1_fp", "L2_fp", "L_fp", "H_fp", "S_fp"
        }

 {
        0, 0, "(integer1 (*)())0",
        "(shortint (*)())0", "(integer (*)())0",

        "(longint (*)())0",

        "(real (*)())0",
        "(doublereal (*)())0", "(complex (*)())0", "(doublecomplex (*)())0",
        "(logical1 (*)())0", "(shortlogical (*)())0",
        "(logical (*)())0", "(char (*)())0", "(int (*)())0"
        }

 { "(U_fp)0", "(??bug??)0", "(I1_fp)0",
        "(J_fp)0", "(I_fp)0",

        "(Q_fp)0",

        "(R_fp)0", "(D_fp)0", "(C_fp)0", "(Z_fp)0",
        "(L1_fp)0","(L2_fp)0",
        "(L_fp)0", "(H_fp)0", "(S_fp)0"
        }

 {
        0, 0, "(integer1 *)0",
        "(shortint *)0", "(integer *)0",

        "(longint *)0",

        "(real *)0",
        "(doublereal *)0", "(complex *)0", "(doublecomplex *)0",
        "(logical1 *)0","(shortlogical *)0", "(logical *)0", "(char *)0"
        }

 { "external", "??", "integer*1",
        "integer*2", "integer",

        "integer*8",

        "real",
        "double precision", "complex", "double complex",
        "logical*1", "logical*2",
        "logical", "character", "subroutine",
        Bug,Bug,Bug,Bug,Bug,Bug,Bug,Bug,Bug, "ftnlen"
        }

 { 0,0,0,0,0,0,0,

                          0,

                          1, 1, 0, 0, 0, 2}

 {
        "?", "??", "integer1", "shortint", "integer",

        "longint",

        "real", "doublereal",
        "C_f", "Z_f", "logical1", "shortlogical", "logical", "H_f", "int"
        }

 { 0, 0, 3, 5, 7,

                         10,

                                8, 11, 9, 12, 1, 4, 6, 2 }

 {
        1, ALIADDR, 1, ALISHORT, ALILONG,

        ALIDOUBLE,

        ALILONG, ALIDOUBLE,
        ALILONG, ALIDOUBLE, 1, ALISHORT, ALILONG, 1, 1, 1,
        ALILONG, ALILONG, ALILONG, ALILONG, ALILONG, ALILONG}

 {
        "<<unknown>>",
        "address",
        "integer1",
        "shortint",
        "integer",

        "longint",

        "real",
        "doublereal",
        "complex",
        "doublecomplex",
        "logical1",
        "shortlogical",
        "logical",
        "char"  
        }

 {
        1, SZADDR, 1, SZSHORT, SZLONG,

                2*SZLONG,

                SZLONG, 2*SZLONG,
                2*SZLONG, 4*SZLONG, 1, SZSHORT, SZLONG, 1, 1, 0,
                4*SZLONG + SZADDR,      
                4*SZLONG + 2*SZADDR,    
                4*SZLONG + 5*SZADDR,    
                2*SZLONG + SZADDR,      
                2*SZLONG,               
                11*SZLONG + 15*SZADDR   
                }