scilab » libs » f2c » src

put.c File Reference

#include "defs.h"
#include "names.h"
#include "pccdefs.h"
#include "p1defs.h"

Include dependency graph for put.c:

Go to the source code of this file.

Defines

#define LIT_CHAR   1
#define LIT_FLOAT   2
#define LIT_INT   3
#define LIT_INTQ   4

Functions

void putexpr (expptr p)
expptr putassign (expptr lp, expptr rp)
void puteq (expptr lp, expptr rp)
expptr putsteq (Addrp a, Addrp b)
Addrp mkfield (register Addrp res, char *f, int ty)
Addrp realpart (register Addrp p)
expptr imagpart (register Addrp p)
int ncat (register expptr p)
ftnint lencat (register expptr p)
Addrp putconst (register Constp p)

Variables

int ops2 []

Define Documentation

#define LIT_CHAR   1

Definition at line 36 of file put.c.

Referenced by putconst().

#define LIT_FLOAT   2

Definition at line 37 of file put.c.

Referenced by putconst().

#define LIT_INT   3

Definition at line 38 of file put.c.

Referenced by putconst().

#define LIT_INTQ   4

Definition at line 39 of file put.c.

Referenced by putconst().

Function Documentation

expptr imagpart ( register Addrp  p  ) 

Definition at line 190 of file put.c.

References cds(), CNULL, cpexpr(), dtos(), ISCOMPLEX, ISINT, mkfield(), mkrealcon(), p, TADDR, TYCOMPLEX, TYDREAL, TYREAL, and UNAM_CONST.

Referenced by putcx1(), putcxcmp(), and putcxeq().

00192 {
00193         register Addrp q;
00194 
00195         if( ISCOMPLEX(p->vtype) )
00196         {
00197                 if (p->tag == TADDR && p->uname_tag == UNAM_CONST)
00198                         return mkrealcon (p -> vtype + TYREAL - TYCOMPLEX,
00199                                 p->user.kludge.vstg1 ? p->user.Const.cds[1]
00200                                 : cds(dtos(p->user.Const.cd[1]),CNULL));
00201                 q = (Addrp) cpexpr((expptr) p);
00202                 q = mkfield (q, "i", p -> vtype + TYREAL - TYCOMPLEX);
00203                 return( (expptr) q );
00204         }
00205         else
00206 
00207 /* Cast an integer type onto a Double Real type */
00208 
00209                 return( mkrealcon( ISINT(p->vtype) ? TYDREAL : p->vtype , "0"));
00210 }

Here is the call graph for this function:

Here is the caller graph for this function:

ftnint lencat ( register expptr  p  ) 

Definition at line 242 of file put.c.

References err, ISICON, NULL, OPCONCAT, TADDR, and TEXPR.

Referenced by doiolist(), and putch1().

00244 {
00245         if(p->tag==TEXPR && p->exprblock.opcode==OPCONCAT)
00246                 return( lencat(p->exprblock.leftp) + lencat(p->exprblock.rightp) );
00247         else if( p->headblock.vleng!=NULL && ISICON(p->headblock.vleng) )
00248                 return(p->headblock.vleng->constblock.Const.ci);
00249         else if(p->tag==TADDR && p->addrblock.varleng!=0)
00250                 return(p->addrblock.varleng);
00251         else
00252         {
00253                 err("impossible element in concatenation");
00254                 return(0);
00255         }
00256 }

Here is the caller graph for this function:

Addrp mkfield ( register Addrp  res,
char *  f,
int  ty 
)

Definition at line 149 of file put.c.

Referenced by imagpart(), and realpart().

00151 {
00152     res -> vtype = ty;
00153     res -> Field = f;
00154     return res;
00155 } /* mkfield */

Here is the caller graph for this function:

int ncat ( register expptr  p  ) 

Definition at line 223 of file put.c.

References ncat, OPCONCAT, and TEXPR.

00225 {
00226         if(p->tag==TEXPR && p->exprblock.opcode==OPCONCAT)
00227                 return( ncat(p->exprblock.leftp) + ncat(p->exprblock.rightp) );
00228         else    return(1);
00229 }

expptr putassign ( expptr  lp,
expptr  rp 
)

Definition at line 100 of file put.c.

References fixexpr(), lp, mkexpr(), OPASSIGN, and putx().

Referenced by intdouble(), krput(), putct1(), putcx1(), putcxeq(), putmnmx(), putpower(), and suboffset().

00102 {
00103         return putx(fixexpr((Exprp)mkexpr(OPASSIGN, lp, rp)));
00104 }

Here is the call graph for this function:

Here is the caller graph for this function:

Addrp putconst ( register Constp  p  ) 

Definition at line 272 of file put.c.

References ALLOC, BAD_MEMNO, badtag(), Constant::ccp0, Constant::ccp1, Literal::cds, cds(), Const, Addrblock::Const, cpexpr(), dtos(), frexpr(), halign, ICON, int, Addrblock::kludge, len, LIT_CHAR, LIT_FLOAT, LIT_INT, LIT_INTQ, Literal::litdval, Literal::litival2, Literal::litnum, litpool, Literal::littype, Literal::litval, memcmp(), Addrblock::memno, Addrblock::memoffset, newlabel(), nliterals, STGCONST, TADDR, Addrblock::tag, TCONST, TYADDR, TYCHAR, TYCOMPLEX, TYDCOMPLEX, TYDREAL, tyint, TYINT1, TYLOGICAL, TYLOGICAL1, TYLOGICAL2, TYLONG, type, TYQUAD, TYREAL, TYSHORT, UNAM_CONST, Addrblock::user, Addrblock::vleng, Addrblock::vstg, and Addrblock::vtype.

Referenced by doiolist(), fixargs(), fixexpr(), fixtype(), mkaddr(), mkpower(), putcall(), putcat(), putch1(), putcx1(), putio(), putop(), and putx().

00274 {
00275         register Addrp q;
00276         struct Literal *litp, *lastlit;
00277         int k, len, type;
00278         int litflavor;
00279         double cd[2];
00280         ftnint nblanks;
00281         char *strp;
00282         char cdsbuf0[64], cdsbuf1[64], *ds[2];
00283 
00284         if (p->tag != TCONST)
00285                 badtag("putconst", p->tag);
00286 
00287         q = ALLOC(Addrblock);
00288         q->tag = TADDR;
00289         type = p->vtype;
00290         q->vtype = ( type==TYADDR ? tyint : type );
00291         q->vleng = (expptr) cpexpr(p->vleng);
00292         q->vstg = STGCONST;
00293 
00294 /* Create the new label for the constant.  This is wasteful of labels
00295    because when the constant value already exists in the literal pool,
00296    this label gets thrown away and is never reclaimed.  It might be
00297    cleaner to move this down past the first   switch()   statement below */
00298 
00299         q->memno = newlabel();
00300         q->memoffset = ICON(0);
00301         q -> uname_tag = UNAM_CONST;
00302 
00303 /* Copy the constant info into the Addrblock; do this by copying the
00304    largest storage elts */
00305 
00306         q -> user.Const = p -> Const;
00307         q->user.kludge.vstg1 = p->vstg; /* distinguish string from binary fp */
00308 
00309         /* check for value in literal pool, and update pool if necessary */
00310 
00311         k = 1;
00312         switch(type)
00313         {
00314         case TYCHAR:
00315                 if (halign) {
00316                         strp = p->Const.ccp;
00317                         nblanks = p->Const.ccp1.blanks;
00318                         len = (int)p->vleng->constblock.Const.ci;
00319                         litflavor = LIT_CHAR;
00320                         goto loop;
00321                         }
00322                 else
00323                         q->memno = BAD_MEMNO;
00324                 break;
00325         case TYCOMPLEX:
00326         case TYDCOMPLEX:
00327                 k = 2;
00328                 if (p->vstg)
00329                         cd[1] = atof(ds[1] = p->Const.cds[1]);
00330                 else
00331                         ds[1] = cds(dtos(cd[1] = p->Const.cd[1]), cdsbuf1);
00332         case TYREAL:
00333         case TYDREAL:
00334                 litflavor = LIT_FLOAT;
00335                 if (p->vstg)
00336                         cd[0] = atof(ds[0] = p->Const.cds[0]);
00337                 else
00338                         ds[0] = cds(dtos(cd[0] = p->Const.cd[0]), cdsbuf0);
00339                 goto loop;
00340 
00341 #ifndef NO_LONG_LONG
00342         case TYQUAD:
00343                 litflavor = LIT_INTQ;
00344                 goto loop;
00345 #endif
00346 
00347         case TYLOGICAL1:
00348         case TYLOGICAL2:
00349         case TYLOGICAL:
00350         case TYLONG:
00351         case TYSHORT:
00352         case TYINT1:
00353 #ifdef TYQUAD0
00354         case TYQUAD:
00355 #endif
00356                 litflavor = LIT_INT;
00357 
00358 /* Scan the literal pool for this constant value.  If this same constant
00359    has been assigned before, use the same label.  Note that this routine
00360    does NOT consider two differently-typed constants with the same bit
00361    pattern to be the same constant */
00362 
00363  loop:
00364                 lastlit = litpool + nliterals;
00365                 for(litp = litpool ; litp<lastlit ; ++litp)
00366 
00367 /* Remove this type checking to ensure that all bit patterns are reused */
00368 
00369                         if(type == litp->littype) switch(litflavor)
00370                         {
00371                         case LIT_CHAR:
00372                                 if (len == (int)litp->litval.litival2[0]
00373                                 && nblanks == litp->litval.litival2[1]
00374                                 && !memcmp(strp, litp->cds[0], len)) {
00375                                         q->memno = litp->litnum;
00376                                         frexpr((expptr)p);
00377                                         q->user.Const.ccp1.ccp0 = litp->cds[0];
00378                                         return(q);
00379                                         }
00380                                 break;
00381                         case LIT_FLOAT:
00382                                 if(cd[0] == litp->litval.litdval[0]
00383                                 && !strcmp(ds[0], litp->cds[0])
00384                                 && (k == 1 ||
00385                                     cd[1] == litp->litval.litdval[1]
00386                                     && !strcmp(ds[1], litp->cds[1]))) {
00387 ret:
00388                                         q->memno = litp->litnum;
00389                                         frexpr((expptr)p);
00390                                         return(q);
00391                                         }
00392                                 break;
00393 
00394                         case LIT_INT:
00395                                 if(p->Const.ci == litp->litval.litival)
00396                                         goto ret;
00397                                 break;
00398 #ifndef NO_LONG_LONG
00399                         case LIT_INTQ:
00400                                 if(p->Const.cq == litp->litval.litqval)
00401                                         goto ret;
00402                                 break;
00403 #endif
00404                         }
00405 
00406 /* If there's room in the literal pool, add this new value to the pool */
00407 
00408                 if(nliterals < maxliterals)
00409                 {
00410                         ++nliterals;
00411 
00412                         /* litp   now points to the next free elt */
00413 
00414                         litp->littype = type;
00415                         litp->litnum = q->memno;
00416                         switch(litflavor)
00417                         {
00418                         case LIT_CHAR:
00419                                 litp->litval.litival2[0] = len;
00420                                 litp->litval.litival2[1] = nblanks;
00421                                 q->user.Const.ccp = litp->cds[0] = (char*)
00422                                         memcpy(gmem(len,0), strp, len);
00423                                 break;
00424 
00425                         case LIT_FLOAT:
00426                                 litp->litval.litdval[0] = cd[0];
00427                                 litp->cds[0] = copys(ds[0]);
00428                                 if (k == 2) {
00429                                         litp->litval.litdval[1] = cd[1];
00430                                         litp->cds[1] = copys(ds[1]);
00431                                         }
00432                                 break;
00433 
00434                         case LIT_INT:
00435                                 litp->litval.litival = p->Const.ci;
00436                                 break;
00437 #ifndef NO_LONG_LONG
00438                         case LIT_INTQ:
00439                                 litp->litval.litqval = p->Const.cq;
00440                                 break;
00441 #endif
00442                         } /* switch (litflavor) */
00443                 }
00444                 else
00445                         many("literal constants", 'L', maxliterals);
00446 
00447                 break;
00448         case TYADDR:
00449             break;
00450         default:
00451                 badtype ("putconst", p -> vtype);
00452                 break;
00453         } /* switch */
00454 
00455         if (type != TYCHAR || halign)
00456             frexpr((expptr)p);
00457         return( q );
00458 }

Here is the call graph for this function:

Here is the caller graph for this function:

void puteq ( expptr  lp,
expptr  rp 
)

Definition at line 115 of file put.c.

References lp, mkexpr(), OPASSIGN, and putexpr().

Referenced by cast_args(), doiolist(), enddo(), exdo(), and exequals().

00117 {
00118         putexpr(mkexpr(OPASSIGN, lp, rp) );
00119 }

Here is the call graph for this function:

Here is the caller graph for this function:

void putexpr ( expptr  p  ) 

Definition at line 81 of file put.c.

References fixtype(), p, p1_expr(), and putx().

Referenced by excall(), exstop(), ioset(), puteq(), putiocall(), and stfcall().

00083 {
00084 /* Write the expression to the p1 file */
00085 
00086         p = (expptr) putx (fixtype (p));
00087         p1_expr (p);
00088 }

Here is the call graph for this function:

Here is the caller graph for this function:

expptr putsteq ( Addrp  a,
Addrp  b 
)

Definition at line 132 of file put.c.

References a, b, cpexpr(), fixexpr(), mkexpr(), OPSTAREQ, and putx().

Referenced by putpower().

00134 {
00135         return putx( fixexpr((Exprp)
00136                 mkexpr(OPSTAREQ, cpexpr((expptr)a), cpexpr((expptr)b))));
00137 }

Here is the call graph for this function:

Here is the caller graph for this function:

Addrp realpart ( register Addrp  p  ) 

Definition at line 163 of file put.c.

References cds(), CNULL, cpexpr(), dtos(), ISCOMPLEX, mkfield(), mkrealcon(), p, TADDR, TYCOMPLEX, TYREAL, and UNAM_CONST.

Referenced by putcx1(), putcxcmp(), putcxeq(), putop(), and putx().

00165 {
00166         register Addrp q;
00167 
00168         if (p->tag == TADDR
00169          && p->uname_tag == UNAM_CONST
00170          && ISCOMPLEX (p->vtype))
00171                 return (Addrp)mkrealcon (p -> vtype + TYREAL - TYCOMPLEX,
00172                         p->user.kludge.vstg1 ? p->user.Const.cds[0]
00173                                 : cds(dtos(p->user.Const.cd[0]),CNULL));
00174 
00175         q = (Addrp) cpexpr((expptr) p);
00176         if( ISCOMPLEX(p->vtype) )
00177                 q = mkfield (q, "r", p -> vtype + TYREAL - TYCOMPLEX);
00178 
00179         return(q);
00180 }

Here is the call graph for this function:

Here is the caller graph for this function:

Variable Documentation

int ops2[]

Initial value:

{
        P2BAD, P2PLUS, P2MINUS, P2STAR, P2SLASH, P2BAD, P2NEG,
        P2OROR, P2ANDAND, P2EQ, P2NE, P2NOT,
        P2BAD,
        P2LT, P2EQ, P2GT, P2LE, P2NE, P2GE,
        P2CALL, P2CALL, P2ASSIGN, P2PLUSEQ, P2STAREQ, P2CONV, P2LSHIFT, P2MOD,
        P2COMOP, P2QUEST, P2COLON,
        1, P2BAD, P2BAD, P2BAD, P2BAD,
        P2BITOR, P2BITAND, P2BITXOR, P2BITNOT, P2RSHIFT,
        P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD, P2BAD,
        P2BAD, P2BAD, P2BAD, P2BAD,
        1,1,1,1,1, 
        1,1,1,1,   
        1,1,1,1,1  
}

Definition at line 58 of file put.c.

Generated on Sun Mar 4 15:10:58 2007 for Scilab [trunk] by  doxygen 1.5.1