117727Sralph#ifdef FORT 217727Sralph#undef BUFSTDERR 317727Sralph#endif 417727Sralph#ifndef ONEPASS 517727Sralph#undef BUFSTDERR 617727Sralph#endif 717727Sralph# ifndef EXIT 817727Sralph# define EXIT exit 917727Sralph# endif 1017727Sralph 1117727Sralphint nerrors = 0; /* number of errors */ 1217727Sralph 1317727Sralphextern unsigned int offsz; 1417727Sralph 1517727Sralphunsigned caloff(){ 1617727Sralph register i; 1717727Sralph unsigned int temp; 1817727Sralph unsigned int off; 1917727Sralph temp = 1; 2017727Sralph i = 0; 2117727Sralph do { 2217727Sralph temp <<= 1; 2317727Sralph ++i; 24*17745Sralph } while( temp != 0 ); 2517727Sralph off = 1 << (i-1); 2617727Sralph return (off); 2717727Sralph } 2817727Sralph 2917727SralphNODE *lastfree; /* pointer to last free node; (for allocator) */ 3017727Sralph 3117727Sralph /* VARARGS1 */ 3217727Sralphuerror( s, a ) char *s; { /* nonfatal error message */ 3317727Sralph /* the routine where is different for pass 1 and pass 2; 3417727Sralph /* it tells where the error took place */ 3517727Sralph 3617727Sralph ++nerrors; 3717727Sralph where('u'); 3817727Sralph fprintf( stderr, s, a ); 3917727Sralph fprintf( stderr, "\n" ); 4017727Sralph#ifdef BUFSTDERR 4117727Sralph fflush(stderr); 4217727Sralph#endif 4317727Sralph if( nerrors > 30 ) cerror( "too many errors"); 4417727Sralph } 4517727Sralph 4617727Sralph /* VARARGS1 */ 4717727Sralphcerror( s, a, b, c ) char *s; { /* compiler error: die */ 4817727Sralph where('c'); 4917727Sralph if( nerrors && nerrors <= 30 ){ /* give the compiler the benefit of the doubt */ 5017727Sralph fprintf( stderr, "cannot recover from earlier errors: goodbye!\n" ); 5117727Sralph } 5217727Sralph else { 5317727Sralph fprintf( stderr, "compiler error: " ); 5417727Sralph fprintf( stderr, s, a, b, c ); 5517727Sralph fprintf( stderr, "\n" ); 5617727Sralph } 5717727Sralph#ifdef BUFSTDERR 5817727Sralph fflush(stderr); 5917727Sralph#endif 6017727Sralph EXIT(1); 6117727Sralph } 6217727Sralph 6317727Sralphint Wflag = 0; /* Non-zero means do not print warnings */ 6417727Sralph 6517727Sralph /* VARARGS1 */ 6617727Sralphwerror( s, a, b ) char *s; { /* warning */ 6717727Sralph if(Wflag) return; 6817727Sralph where('w'); 6917727Sralph fprintf( stderr, "warning: " ); 7017727Sralph fprintf( stderr, s, a, b ); 7117727Sralph fprintf( stderr, "\n" ); 7217727Sralph#ifdef BUFSTDERR 7317727Sralph fflush(stderr); 7417727Sralph#endif 7517727Sralph } 7617727Sralph 7717727Sralphtinit(){ /* initialize expression tree search */ 7817727Sralph 7917727Sralph NODE *p; 8017727Sralph 8117727Sralph for( p=node; p<= &node[TREESZ-1]; ++p ) p->in.op = FREE; 8217727Sralph lastfree = node; 8317727Sralph 8417727Sralph } 8517727Sralph 8617727Sralph# define TNEXT(p) (p== &node[TREESZ-1]?node:p+1) 8717727Sralph 8817727SralphNODE * 8917727Sralphtalloc(){ 9017727Sralph NODE *p, *q; 9117727Sralph 9217727Sralph q = lastfree; 9317727Sralph for( p = TNEXT(q); p!=q; p= TNEXT(p)) 9417727Sralph if( p->in.op ==FREE ) return(lastfree=p); 9517727Sralph 9617727Sralph cerror( "out of tree space; simplify expression"); 9717727Sralph /* NOTREACHED */ 9817727Sralph } 9917727Sralph 10017727Sralphtcheck(){ /* ensure that all nodes have been freed */ 10117727Sralph 10217727Sralph NODE *p; 10317727Sralph 10417727Sralph if( !nerrors ) 10517727Sralph for( p=node; p<= &node[TREESZ-1]; ++p ) 10617727Sralph if( p->in.op != FREE ) cerror( "wasted space: %o", p ); 10717727Sralph tinit(); 10817727Sralph#ifdef FLEXNAMES 10917727Sralph freetstr(); 11017727Sralph#endif 11117727Sralph } 11217727Sralphtfree( p ) NODE *p; { 11317727Sralph /* free the tree p */ 11417727Sralph extern tfree1(); 11517727Sralph 11617727Sralph if( p->in.op != FREE ) walkf( p, tfree1 ); 11717727Sralph 11817727Sralph } 11917727Sralph 12017727Sralphtfree1(p) NODE *p; { 12117727Sralph if( p == 0 ) cerror( "freeing blank tree!"); 12217727Sralph else p->in.op = FREE; 12317727Sralph } 12417727Sralph 12517727Sralphfwalk( t, f, down ) register NODE *t; int (*f)(); { 12617727Sralph 12717727Sralph int down1, down2; 12817727Sralph 12917727Sralph more: 13017727Sralph down1 = down2 = 0; 13117727Sralph 13217727Sralph (*f)( t, down, &down1, &down2 ); 13317727Sralph 13417727Sralph switch( optype( t->in.op ) ){ 13517727Sralph 13617727Sralph case BITYPE: 13717727Sralph fwalk( t->in.left, f, down1 ); 13817727Sralph t = t->in.right; 13917727Sralph down = down2; 14017727Sralph goto more; 14117727Sralph 14217727Sralph case UTYPE: 14317727Sralph t = t->in.left; 14417727Sralph down = down1; 14517727Sralph goto more; 14617727Sralph 14717727Sralph } 14817727Sralph } 14917727Sralph 15017727Sralphwalkf( t, f ) register NODE *t; int (*f)(); { 15117727Sralph register opty; 15217727Sralph 15317727Sralph opty = optype(t->in.op); 15417727Sralph 15517727Sralph if( opty != LTYPE ) walkf( t->in.left, f ); 15617727Sralph if( opty == BITYPE ) walkf( t->in.right, f ); 15717727Sralph (*f)( t ); 15817727Sralph } 15917727Sralph 16017727Sralph 16117727Sralph 16217727Sralphint dope[ DSIZE ]; 16317727Sralphchar *opst[DSIZE]; 16417727Sralph 16517727Sralphstruct dopest { int dopeop; char opst[8]; int dopeval; } indope[] = { 16617727Sralph 16717727Sralph NAME, "NAME", LTYPE, 16817727Sralph STRING, "STRING", LTYPE, 16917727Sralph REG, "REG", LTYPE, 17017727Sralph OREG, "OREG", LTYPE, 17117727Sralph ICON, "ICON", LTYPE, 17217727Sralph FCON, "FCON", LTYPE, 173*17745Sralph DCON, "DCON", LTYPE, 17417727Sralph CCODES, "CCODES", LTYPE, 17517727Sralph UNARY MINUS, "U-", UTYPE, 17617727Sralph UNARY MUL, "U*", UTYPE, 17717727Sralph UNARY AND, "U&", UTYPE, 17817727Sralph UNARY CALL, "UCALL", UTYPE|CALLFLG, 17917727Sralph UNARY FORTCALL, "UFCALL", UTYPE|CALLFLG, 18017727Sralph NOT, "!", UTYPE|LOGFLG, 18117727Sralph COMPL, "~", UTYPE, 18217727Sralph FORCE, "FORCE", UTYPE, 18317727Sralph INIT, "INIT", UTYPE, 18417727Sralph SCONV, "SCONV", UTYPE, 18517727Sralph PCONV, "PCONV", UTYPE, 18617727Sralph PLUS, "+", BITYPE|FLOFLG|SIMPFLG|COMMFLG, 18717727Sralph ASG PLUS, "+=", BITYPE|ASGFLG|ASGOPFLG|FLOFLG|SIMPFLG|COMMFLG, 18817727Sralph MINUS, "-", BITYPE|FLOFLG|SIMPFLG, 18917727Sralph ASG MINUS, "-=", BITYPE|FLOFLG|SIMPFLG|ASGFLG|ASGOPFLG, 19017727Sralph MUL, "*", BITYPE|FLOFLG|MULFLG, 19117727Sralph ASG MUL, "*=", BITYPE|FLOFLG|MULFLG|ASGFLG|ASGOPFLG, 19217727Sralph AND, "&", BITYPE|SIMPFLG|COMMFLG, 19317727Sralph ASG AND, "&=", BITYPE|SIMPFLG|COMMFLG|ASGFLG|ASGOPFLG, 19417727Sralph QUEST, "?", BITYPE, 19517727Sralph COLON, ":", BITYPE, 19617727Sralph ANDAND, "&&", BITYPE|LOGFLG, 19717727Sralph OROR, "||", BITYPE|LOGFLG, 19817727Sralph CM, ",", BITYPE, 19917727Sralph COMOP, ",OP", BITYPE, 20017727Sralph ASSIGN, "=", BITYPE|ASGFLG, 20117727Sralph DIV, "/", BITYPE|FLOFLG|MULFLG|DIVFLG, 20217727Sralph ASG DIV, "/=", BITYPE|FLOFLG|MULFLG|DIVFLG|ASGFLG|ASGOPFLG, 20317727Sralph MOD, "%", BITYPE|DIVFLG, 20417727Sralph ASG MOD, "%=", BITYPE|DIVFLG|ASGFLG|ASGOPFLG, 20517727Sralph LS, "<<", BITYPE|SHFFLG, 20617727Sralph ASG LS, "<<=", BITYPE|SHFFLG|ASGFLG|ASGOPFLG, 20717727Sralph RS, ">>", BITYPE|SHFFLG, 20817727Sralph ASG RS, ">>=", BITYPE|SHFFLG|ASGFLG|ASGOPFLG, 20917727Sralph OR, "|", BITYPE|COMMFLG|SIMPFLG, 21017727Sralph ASG OR, "|=", BITYPE|COMMFLG|SIMPFLG|ASGFLG|ASGOPFLG, 21117727Sralph ER, "^", BITYPE|COMMFLG|SIMPFLG, 21217727Sralph ASG ER, "^=", BITYPE|COMMFLG|SIMPFLG|ASGFLG|ASGOPFLG, 21317727Sralph INCR, "++", BITYPE|ASGFLG, 21417727Sralph DECR, "--", BITYPE|ASGFLG, 21517727Sralph STREF, "->", BITYPE, 21617727Sralph CALL, "CALL", BITYPE|CALLFLG, 21717727Sralph FORTCALL, "FCALL", BITYPE|CALLFLG, 21817727Sralph EQ, "==", BITYPE|LOGFLG, 21917727Sralph NE, "!=", BITYPE|LOGFLG, 22017727Sralph LE, "<=", BITYPE|LOGFLG, 22117727Sralph LT, "<", BITYPE|LOGFLG, 22217727Sralph GE, ">", BITYPE|LOGFLG, 22317727Sralph GT, ">", BITYPE|LOGFLG, 22417727Sralph UGT, "UGT", BITYPE|LOGFLG, 22517727Sralph UGE, "UGE", BITYPE|LOGFLG, 22617727Sralph ULT, "ULT", BITYPE|LOGFLG, 22717727Sralph ULE, "ULE", BITYPE|LOGFLG, 22817727Sralph ARS, "A>>", BITYPE, 22917727Sralph TYPE, "TYPE", LTYPE, 23017727Sralph LB, "[", BITYPE, 23117727Sralph CBRANCH, "CBRANCH", BITYPE, 23217727Sralph FLD, "FLD", UTYPE, 23317727Sralph PMCONV, "PMCONV", BITYPE, 23417727Sralph PVCONV, "PVCONV", BITYPE, 23517727Sralph RETURN, "RETURN", BITYPE|ASGFLG|ASGOPFLG, 23617727Sralph CAST, "CAST", BITYPE|ASGFLG|ASGOPFLG, 23717727Sralph GOTO, "GOTO", UTYPE, 23817727Sralph STASG, "STASG", BITYPE|ASGFLG, 23917727Sralph STARG, "STARG", UTYPE, 24017727Sralph STCALL, "STCALL", BITYPE|CALLFLG, 24117727Sralph UNARY STCALL, "USTCALL", UTYPE|CALLFLG, 24217727Sralph 24317727Sralph -1, "", 0 24417727Sralph}; 24517727Sralph 24617727Sralphmkdope(){ 24717727Sralph register struct dopest *q; 24817727Sralph 24917727Sralph for( q = indope; q->dopeop >= 0; ++q ){ 25017727Sralph dope[q->dopeop] = q->dopeval; 25117727Sralph opst[q->dopeop] = q->opst; 25217727Sralph } 25317727Sralph } 25417727Sralph# ifndef BUG4 25517727Sralphtprint( t ) TWORD t; { /* output a nice description of the type of t */ 25617727Sralph 25717727Sralph static char * tnames[] = { 25817727Sralph "undef", 25917727Sralph "farg", 26017727Sralph "char", 26117727Sralph "short", 26217727Sralph "int", 26317727Sralph "long", 26417727Sralph "float", 26517727Sralph "double", 26617727Sralph "strty", 26717727Sralph "unionty", 26817727Sralph "enumty", 26917727Sralph "moety", 27017727Sralph "uchar", 27117727Sralph "ushort", 27217727Sralph "unsigned", 27317727Sralph "ulong", 27417727Sralph "?", "?" 27517727Sralph }; 27617727Sralph 27717727Sralph for(;; t = DECREF(t) ){ 27817727Sralph 27917727Sralph if( ISPTR(t) ) printf( "PTR " ); 28017727Sralph else if( ISFTN(t) ) printf( "FTN " ); 28117727Sralph else if( ISARY(t) ) printf( "ARY " ); 28217727Sralph else { 28317727Sralph printf( "%s", tnames[t] ); 28417727Sralph return; 28517727Sralph } 28617727Sralph } 28717727Sralph } 28817727Sralph# endif 28917727Sralph 29017727Sralph#ifdef FLEXNAMES 29117727Sralph#define NTSTRBUF 40 29217727Sralph#define TSTRSZ 2048 29317727Sralphchar itstrbuf[TSTRSZ]; 29417727Sralphchar *tstrbuf[NTSTRBUF] = { itstrbuf }; 29517727Sralphchar **curtstr = tstrbuf; 29617727Sralphint tstrused; 29717727Sralph 29817727Sralphchar * 29917727Sralphtstr(cp) 30017727Sralph register char *cp; 30117727Sralph{ 30217727Sralph register int i = strlen(cp); 30317727Sralph register char *dp; 30417727Sralph 30517727Sralph if (tstrused + i >= TSTRSZ) { 30617727Sralph if (++curtstr >= &tstrbuf[NTSTRBUF]) 30717727Sralph cerror("out of temporary string space"); 30817727Sralph tstrused = 0; 30917727Sralph if (*curtstr == 0) { 31017727Sralph dp = (char *)malloc(TSTRSZ); 31117727Sralph if (dp == 0) 31217727Sralph cerror("out of memory (tstr)"); 31317727Sralph *curtstr = dp; 31417727Sralph } 31517727Sralph } 31617727Sralph strcpy(dp = *curtstr+tstrused, cp); 31717727Sralph tstrused += i + 1; 31817727Sralph return (dp); 31917727Sralph} 32017727Sralph#endif 321