projects / unix-history / blobdiff
? search:
summary | tags | clone url | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
BSD 4 development
[unix-history] / usr / src / cmd / f77 / intr.c
diff --git a/usr/src/cmd/f77/intr.c b/usr/src/cmd/f77/intr.c
index cba5a49..66ad886 100644 (file)
--- a/usr/src/cmd/f77/intr.c
+++ b/usr/src/cmd/f77/intr.c
@@ -33,7 +33,9 @@ LOCAL struct Intrblock
 "dfloat",      { INTRCONV, TYDREAL },
 "sngl",        { INTRCONV, TYREAL },
 "ichar",       { INTRCONV, TYLONG },
 "dfloat",      { INTRCONV, TYDREAL },
 "sngl",        { INTRCONV, TYREAL },
 "ichar",       { INTRCONV, TYLONG },
+"iachar",      { INTRCONV, TYLONG },
 "char",        { INTRCONV, TYCHAR },
 "char",        { INTRCONV, TYCHAR },
+"achar",       { INTRCONV, TYCHAR },
 
 "max",                 { INTRMAX, TYUNKNOWN },
 "max0",        { INTRMAX, TYLONG },
 
 "max",                 { INTRMAX, TYUNKNOWN },
 "max0",        { INTRMAX, TYLONG },
@@ -393,19 +395,18 @@ char callbyvalue[ ][XL] =
        "tanh"
        };
 \f
        "tanh"
        };
 \f
-struct Exprblock *intrcall(np, argsp, nargs)
-struct Nameblock *np;
+expptr intrcall(np, argsp, nargs)
+Namep np;
 struct Listblock *argsp;
 int nargs;
 {
 int i, rettype;
 struct Listblock *argsp;
 int nargs;
 {
 int i, rettype;
-struct Addrblock *ap;
+Addrp ap;
 register struct Specblock *sp;
 register struct Specblock *sp;
-struct Exprblock *q, *inline();
 register struct Chain *cp;
 register struct Chain *cp;
-struct Constblock *mkcxcon(), *mkrealcon();
+expptr inline(), mkcxcon(), mkrealcon();
 register struct Incstblock *cstp;
 register struct Incstblock *cstp;
-expptr ep;
+expptr q, ep;
 int mtype;
 int op;
 int f1field, f2field, f3field;
 int mtype;
 int op;
 int f1field, f2field, f3field;
@@ -420,9 +421,9 @@ if(nargs == 0)
 mtype = 0;
 for(cp = argsp->listp ; cp ; cp = cp->nextp)
        {
 mtype = 0;
 for(cp = argsp->listp ; cp ; cp = cp->nextp)
        {
-/* TEMPORARY */ ep = cp->datap;
+/* TEMPORARY */ ep = (expptr) (cp->datap);
 /* TEMPORARY */        if( ISCONST(ep) && ep->headblock.vtype==TYSHORT )
 /* TEMPORARY */        if( ISCONST(ep) && ep->headblock.vtype==TYSHORT )
-/* TEMPORARY */                cp->datap = mkconv(tyint, ep);
+/* TEMPORARY */                cp->datap = (tagptr) mkconv(tyint, ep);
        mtype = maxtype(mtype, ep->headblock.vtype);
        }
 
        mtype = maxtype(mtype, ep->headblock.vtype);
        }
 
@@ -436,7 +437,7 @@ switch(f1field)
                        {
                        if(nargs != 1)
                                goto badnargs;
                        {
                        if(nargs != 1)
                                goto badnargs;
-                       q = mkexpr(OPBITNOT, argsp->listp->datap, NULL);
+                       q = mkexpr(OPBITNOT, argsp->listp->datap, ENULL);
                        }
                else
                        {
                        }
                else
                        {
@@ -446,7 +447,7 @@ switch(f1field)
                                argsp->listp->nextp->datap);
                        }
                frchain( &(argsp->listp) );
                                argsp->listp->nextp->datap);
                        }
                frchain( &(argsp->listp) );
-               free(argsp);
+               free( (charptr) argsp);
                return(q);
 
        case INTRCONV:
                return(q);
 
        case INTRCONV:
@@ -456,8 +457,8 @@ switch(f1field)
                if( ISCOMPLEX(rettype) && nargs==2)
                        {
                        expptr qr, qi;
                if( ISCOMPLEX(rettype) && nargs==2)
                        {
                        expptr qr, qi;
-                       qr = argsp->listp->datap;
-                       qi = argsp->listp->nextp->datap;
+                       qr = (expptr) (argsp->listp->datap);
+                       qi = (expptr) (argsp->listp->nextp->datap);
                        if(ISCONST(qr) && ISCONST(qi))
                                q = mkcxcon(qr,qi);
                        else    q = mkexpr(OPCONV,mkconv(rettype-2,qr),
                        if(ISCONST(qr) && ISCONST(qi))
                                q = mkcxcon(qr,qi);
                        else    q = mkexpr(OPCONV,mkconv(rettype-2,qr),
@@ -467,9 +468,9 @@ switch(f1field)
                        q = mkconv(rettype, argsp->listp->datap);
                else goto badnargs;
 
                        q = mkconv(rettype, argsp->listp->datap);
                else goto badnargs;
 
-               q->vtype = rettype;
+               q->headblock.vtype = rettype;
                frchain(&(argsp->listp));
                frchain(&(argsp->listp));
-               free(argsp);
+               free( (charptr) argsp);
                return(q);
 
 
                return(q);
 
 
@@ -486,11 +487,11 @@ switch(f1field)
                switch(cstp->rtype)
                        {
                        case TYLONG:
                switch(cstp->rtype)
                        {
                        case TYLONG:
-                               return( mkintcon(intcon[cstp->constno]) );
+                               return(mkintcon(intcon[cstp->constno]));
 
                        case TYREAL:
                        case TYDREAL:
 
                        case TYREAL:
                        case TYDREAL:
-                               return( mkrealcon(cstp->rtype,
+                               return(mkrealcon(cstp->rtype,
                                        realcon[cstp->constno]) );
 
                        default:
                                        realcon[cstp->constno]) );
 
                        default:
@@ -514,7 +515,7 @@ switch(f1field)
        case INTRSPEC:
                sp = spectab + f3field;
        specfunct:
        case INTRSPEC:
                sp = spectab + f3field;
        specfunct:
-               if(tyint==TYLONG && sp->rtype==TYSHORT
+               if(tyint==TYLONG && ONEOF(sp->rtype,M(TYSHORT)|M(TYLOGICAL))
                        && (sp+1)->atype==sp->atype)
                                ++sp;
 
                        && (sp+1)->atype==sp->atype)
                                ++sp;
 
@@ -526,7 +527,7 @@ switch(f1field)
                if(q = inline(sp-spectab, mtype, argsp->listp))
                        {
                        frchain( &(argsp->listp) );
                if(q = inline(sp-spectab, mtype, argsp->listp))
                        {
                        frchain( &(argsp->listp) );
-                       free(argsp);
+                       free( (charptr) argsp);
                        }
                else if(sp->othername)
                        {
                        }
                else if(sp->othername)
                        {
@@ -548,9 +549,9 @@ switch(f1field)
                if( ! ONEOF(mtype, MSKINT|MSKREAL) )
                        goto badtype;
                argsp->vtype = mtype;
                if( ! ONEOF(mtype, MSKINT|MSKREAL) )
                        goto badtype;
                argsp->vtype = mtype;
-               q = mkexpr( (f1field==INTRMIN ? OPMIN : OPMAX), argsp, NULL);
+               q = mkexpr( (f1field==INTRMIN ? OPMIN : OPMAX), argsp, ENULL);
 
 
-               q->vtype = mtype;
+               q->headblock.vtype = mtype;
                rettype = f2field;
                if(rettype == TYLONG)
                        rettype = tyint;
                rettype = f2field;
                if(rettype == TYLONG)
                        rettype = tyint;
@@ -604,10 +605,10 @@ return(0);
 
 
 
 
 
 
-struct Addrblock *intraddr(np)
-struct Nameblock *np;
+Addrp intraddr(np)
+Namep np;
 {
 {
-struct Addrblock *q;
+Addrp q;
 register struct Specblock *sp;
 int f3field;
 
 register struct Specblock *sp;
 int f3field;
 
@@ -640,7 +641,7 @@ switch(packed.bits.f1)
                        varstr(VL,np->varname));
                return( errnode() );
        }
                        varstr(VL,np->varname));
                return( errnode() );
        }
-fatali("intraddr: impossible f1=%d\n", packed.bits.f1);
+fatali("intraddr: impossible f1=%d\n", (int) packed.bits.f1);
 /* NOTREACHED */
 }
 
 /* NOTREACHED */
 }
 
@@ -648,12 +649,12 @@ fatali("intraddr: impossible f1=%d\n", packed.bits.f1);
 
 
 
 
 
 
-struct Exprblock *inline(fno, type, args)
+expptr inline(fno, type, args)
 int fno;
 int type;
 struct Chain *args;
 {
 int fno;
 int type;
 struct Chain *args;
 {
-register struct Exprblock *q, *t, *t1;
+register expptr q, t, t1;
 
 switch(fno)
        {
 
 switch(fno)
        {
@@ -661,16 +662,17 @@ switch(fno)
        case 9: /* short int abs */
        case 10:        /* long int abs */
        case 11:        /* double precision abs */
        case 9: /* short int abs */
        case 10:        /* long int abs */
        case 11:        /* double precision abs */
-               if( addressable(q = args->datap) )
+               if( addressable(q = (expptr) (args->datap)) )
                        {
                        t = q;
                        q = NULL;
                        }
                else
                        {
                        t = q;
                        q = NULL;
                        }
                else
-                       t = mktemp(type);
-               t1 = mkexpr(OPQUEST,  mkexpr(OPLE, mkconv(type,ICON(0)), cpexpr(t)),
+                       t = (expptr) mktemp(type,PNULL);
+               t1 = mkexpr(OPQUEST,
+                       mkexpr(OPLE, mkconv(type,ICON(0)), cpexpr(t)),
                        mkexpr(OPCOLON, cpexpr(t),
                        mkexpr(OPCOLON, cpexpr(t),
-                               mkexpr(OPNEG, cpexpr(t), NULL) ));
+                               mkexpr(OPNEG, cpexpr(t), ENULL) ));
                if(q)
                        t1 = mkexpr(OPCOMMA, mkexpr(OPASSIGN, cpexpr(t),q), t1);
                frexpr(t);
                if(q)
                        t1 = mkexpr(OPCOMMA, mkexpr(OPASSIGN, cpexpr(t),q), t1);
                frexpr(t);
@@ -681,13 +683,14 @@ switch(fno)
                return(q);
 
        case 27:        /* len of character string */
                return(q);
 
        case 27:        /* len of character string */
-               q = cpexpr(args->datap->vleng);
+               q = (expptr) cpexpr(args->datap->headblock.vleng);
                frexpr(args->datap);
                return(q);
 
        case 14:        /* half-integer mod */
        case 15:        /* mod */
                frexpr(args->datap);
                return(q);
 
        case 14:        /* half-integer mod */
        case 15:        /* mod */
-               return( mkexpr(OPMOD, args->datap, args->nextp->datap) );
+               return( mkexpr(OPMOD, (expptr) (args->datap),
+                       (expptr) (args->nextp->datap) ));
        }
 return(NULL);
 }
        }
 return(NULL);
 }
Continuous source code history from original PDP-7 UNIX to FreeBSD 2, the first fully unencumbered FreeBSD release.