# 2.11BSD#431 - /usr/src/ucb/PORT/pascal/src/conv.c

##### Functions

    compat            X
    conv              X
    convert           X
    postcheck         X
    precheck          X
    rangechk          X

       1: /*
       2:  * Copyright (c) 1980 Regents of the University of California.
       3:  * All rights reserved.  The Berkeley software License Agreement
       4:  * specifies the terms and conditions for redistribution.
       5:  */
       6:
       7: #ifndef lint
       8: static char sccsid[] = "@(#)conv.c	5.1 (Berkeley) 6/5/85";
       9: #endif not lint
      10:
      11: #include "whoami.h"
      12: #ifdef PI
      13: #include "0.h"
      14: #include "opcode.h"
      15: #ifdef PC
      16: #   include <pcc.h>
      17: #endif PC
      18: #include "tree_ty.h"
      19:
      20: #ifndef PC
      21: #ifndef PI0
      22: /*
      23:  * Convert a p1 into a p2.
      24:  * Mostly used for different
      25:  * length integers and "to real" conversions.
      26:  */
      27: convert(p1, p2)
      28:     struct nl *p1, *p2;
      29: {
      30:     if (p1 == NLNIL || p2 == NLNIL)
      31:         return;
      32:     switch (width(p1) - width(p2)) {
      33:         case -7:
      34:         case -6:
      35:             (void) put(1, O_STOD);
      36:             return;
      37:         case -4:
      38:             (void) put(1, O_ITOD);
      39:             return;
      40:         case -3:
      41:         case -2:
      42:             (void) put(1, O_STOI);
      43:             return;
      44:         case -1:
      45:         case 0:
      46:         case 1:
      47:             return;
      48:         case 2:
      49:         case 3:
      50:             (void) put(1, O_ITOS);
      51:             return;
      52:         default:
      53:             panic("convert");
      54:     }
      55: }
      56: #endif
      57: #endif PC
      58:
      59: /*
      60:  * Compat tells whether
      61:  * p1 and p2 are compatible
      62:  * types for an assignment like
      63:  * context, i.e. value parameters,
      64:  * indicies for 'in', etc.
      65:  */
      66: compat(p1, p2, t)
      67:     struct nl *p1, *p2;
      68:     struct tnode *t;
      69: {
      70:     register c1, c2;
      71:
      72:     c1 = classify(p1);
      73:     if (c1 == NIL)
      74:         return (NIL);
      75:     c2 = classify(p2);
      76:     if (c2 == NIL)
      77:         return (NIL);
      78:     switch (c1) {
      79:         case TBOOL:
      80:         case TCHAR:
      81:             if (c1 == c2)
      82:                 return (1);
      83:             break;
      84:         case TINT:
      85:             if (c2 == TINT)
      86:                 return (1);
      87:         case TDOUBLE:
      88:             if (c2 == TDOUBLE)
      89:                 return (1);
      90: #ifndef PI0
      91:             if (c2 == TINT && divflg == FALSE && t != TR_NIL ) {
      92:                 divchk= TRUE;
      93:                 c1 = classify(rvalue(t, NLNIL , RREQ ));
      94:                 divchk = FALSE;
      95:                 if (c1 == TINT) {
      96:                     error("Type clash: real is incompatible with integer");
      97:                     cerror("This resulted because you used '/' which always returns real rather");
      98:                     cerror("than 'div' which divides integers and returns integers");
      99:                     divflg = TRUE;
     100:                     return (NIL);
     101:                 }
     102:             }
     103: #endif
     104:             break;
     105:         case TSCAL:
     106:             if (c2 != TSCAL)
     107:                 break;
     108:             if (scalar(p1) != scalar(p2)) {
     109:                 derror("Type clash: non-identical scalar types");
     110:                 return (NIL);
     111:             }
     112:             return (1);
     113:         case TSTR:
     114:             if (c2 != TSTR)
     115:                 break;
     116:             if (width(p1) != width(p2)) {
     117:                 derror("Type clash: unequal length strings");
     118:                 return (NIL);
     119:             }
     120:             return (1);
     121:         case TNIL:
     122:             if (c2 != TPTR)
     123:                 break;
     124:             return (1);
     125:         case TFILE:
     126:             if (c1 != c2)
     127:                 break;
     128:             derror("Type clash: files not allowed in this context");
     129:             return (NIL);
     130:         default:
     131:             if (c1 != c2)
     132:                 break;
     133:             if (p1 != p2) {
     134:                 derror("Type clash: non-identical %s types", clnames[c1]);
     135:                 return (NIL);
     136:             }
     137:             if (p1->nl_flags & NFILES) {
     138:                 derror("Type clash: %ss with file components not allowed in this context", clnames[c1]);
     139:                 return (NIL);
     140:             }
     141:             return (1);
     142:     }
     143:     derror("Type clash: %s is incompatible with %s", clnames[c1], clnames[c2]);
     144:     return (NIL);
     145: }
     146:
     147: #ifndef PI0
     148: #ifndef PC
     149: /*
     150:  * Rangechk generates code to
     151:  * check if the type p on top
     152:  * of the stack is in range for
     153:  * assignment to a variable
     154:  * of type q.
     155:  */
     156: rangechk(p, q)
     157:     struct nl *p, *q;
     158: {
     159:     register struct nl *rp;
     160: #ifdef OBJ
     161:     register op;
     162:     int wq, wrp;
     163: #endif
     164:
     165:     if (opt('t') == 0)
     166:         return;
     167:     rp = p;
     168:     if (rp == NIL)
     169:         return;
     170:     if (q == NIL)
     171:         return;
     172: #	ifdef OBJ
     173:         /*
     174: 	     * When op is 1 we are checking length
     175: 	     * 4 numbers against length 2 bounds,
     176: 	     * and adding it to the opcode forces
     177: 	     * generation of appropriate tests.
     178: 	     */
     179:         op = 0;
     180:         wq = width(q);
     181:         wrp = width(rp);
     182:         op = wq != wrp && (wq == 4 || wrp == 4);
     183:         if (rp->class == TYPE || rp->class == CRANGE)
     184:             rp = rp->type;
     185:         switch (rp->class) {
     186:         case RANGE:
     187:             if (rp->range[0] != 0) {
     188: #    		    ifndef DEBUG
     189:                 if (wrp <= 2)
     190:                     (void) put(3, O_RANG2+op, ( short ) rp->range[0],
     191:                              ( short ) rp->range[1]);
     192:                 else if (rp != nl+T4INT)
     193:                     (void) put(3, O_RANG4+op, rp->range[0], rp->range[1] );
     194: #    		    else
     195:                 if (!hp21mx) {
     196:                     if (wrp <= 2)
     197:                         (void) put(3, O_RANG2+op,( short ) rp->range[0],
     198:                                 ( short ) rp->range[1]);
     199:                     else if (rp != nl+T4INT)
     200:                         (void) put(3, O_RANG4+op,rp->range[0],
     201:                                  rp->range[1]);
     202:                 } else
     203:                     if (rp != nl+T2INT && rp != nl+T4INT)
     204:                         (void) put(3, O_RANG2+op,( short ) rp->range[0],
     205:                                 ( short ) rp->range[1]);
     206: #    		    endif
     207:             break;
     208:             }
     209:             /*
     210: 		     * Range whose lower bounds are
     211: 		     * zero can be treated as scalars.
     212: 		     */
     213:         case SCAL:
     214:             if (wrp <= 2)
     215:                 (void) put(2, O_RSNG2+op, ( short ) rp->range[1]);
     216:             else
     217:                 (void) put( 2 , O_RSNG4+op, rp->range[1]);
     218:             break;
     219:         default:
     220:             panic("rangechk");
     221:         }
     222: #	endif OBJ
     223: #	ifdef PC
     224:         /*
     225: 		 *	pc uses precheck() and postcheck().
     226: 		 */
     227:         panic("rangechk()");
     228: #	endif PC
     229: }
     230: #endif
     231: #endif
     232: #endif
     233:
     234: #ifdef PC
     235:     /*
     236:      *	if type p requires a range check,
     237:      *	    then put out the name of the checking function
     238:      *	for the beginning of a function call which is completed by postcheck.
     239:      *  (name1 is for a full check; name2 assumes a lower bound of zero)
     240:      */
     241: precheck( p , name1 , name2 )
     242:     struct nl   *p;
     243:     char    *name1 , *name2;
     244:     {
     245:
     246:     if ( opt( 't' ) == 0 ) {
     247:         return;
     248:     }
     249:     if ( p == NIL ) {
     250:         return;
     251:     }
     252:     if ( p -> class == TYPE ) {
     253:         p = p -> type;
     254:     }
     255:     switch ( p -> class ) {
     256:         case CRANGE:
     257:         putleaf( PCC_ICON , 0 , 0 , PCCM_ADDTYPE( PCCTM_FTN | PCCT_INT , PCCTM_PTR )
     258:                 , name1);
     259:         break;
     260:         case RANGE:
     261:         if ( p != nl + T4INT ) {
     262:             putleaf( PCC_ICON , 0 , 0 ,
     263:                 PCCM_ADDTYPE( PCCTM_FTN | PCCT_INT , PCCTM_PTR ),
     264:                 p -> range[0] != 0 ? name1 : name2 );
     265:         }
     266:         break;
     267:         case SCAL:
     268:             /*
     269: 		     *	how could a scalar ever be out of range?
     270: 		     */
     271:         break;
     272:         default:
     273:         panic( "precheck" );
     274:         break;
     275:     }
     276:     }
     277:
     278:     /*
     279:      *	if type p requires a range check,
     280:      *	    then put out the rest of the arguments of to the checking function
     281:      *	a call to which was started by precheck.
     282:      *	the first argument is what is being rangechecked (put out by rvalue),
     283:      *	the second argument is the lower bound of the range,
     284:      *	the third argument is the upper bound of the range.
     285:      */
     286: postcheck(need, have)
     287:     struct nl   *need;
     288:     struct nl   *have;
     289: {
     290:     struct nl   *p;
     291:
     292:     if ( opt( 't' ) == 0 ) {
     293:     return;
     294:     }
     295:     if ( need == NIL ) {
     296:     return;
     297:     }
     298:     if ( need -> class == TYPE ) {
     299:     need = need -> type;
     300:     }
     301:     switch ( need -> class ) {
     302:     case RANGE:
     303:         if ( need != nl + T4INT ) {
     304:         sconv(p2type(have), PCCT_INT);
     305:         if (need -> range[0] != 0 ) {
     306:             putleaf( PCC_ICON , (int) need -> range[0] , 0 , PCCT_INT ,
     307:                             (char *) 0 );
     308:             putop( PCC_CM , PCCT_INT );
     309:         }
     310:         putleaf( PCC_ICON , (int) need -> range[1] , 0 , PCCT_INT ,
     311:                 (char *) 0 );
     312:         putop( PCC_CM , PCCT_INT );
     313:         putop( PCC_CALL , PCCT_INT );
     314:         sconv(PCCT_INT, p2type(have));
     315:         }
     316:         break;
     317:     case CRANGE:
     318:         sconv(p2type(have), PCCT_INT);
     319:         p = need->nptr[0];
     320:         putRV(p->symbol, (p->nl_block & 037), p->value[0],
     321:             p->extra_flags, p2type( p ) );
     322:         putop( PCC_CM , PCCT_INT );
     323:         p = need->nptr[1];
     324:         putRV(p->symbol, (p->nl_block & 037), p->value[0],
     325:             p->extra_flags, p2type( p ) );
     326:         putop( PCC_CM , PCCT_INT );
     327:         putop( PCC_CALL , PCCT_INT );
     328:         sconv(PCCT_INT, p2type(have));
     329:         break;
     330:     case SCAL:
     331:         break;
     332:     default:
     333:         panic( "postcheck" );
     334:         break;
     335:     }
     336: }
     337: #endif PC
     338:
     339: #ifdef DEBUG
     340: conv(dub)
     341:     int *dub;
     342: {
     343:     int newfp[2];
     344:     double *dp = ((double *) dub);
     345:     long *lp = ((long *) dub);
     346:     register int exp;
     347:     long mant;
     348:
     349:     newfp[0] = dub[0] & 0100000;
     350:     newfp[1] = 0;
     351:     if (*dp == 0.0)
     352:         goto ret;
     353:     exp = ((dub[0] >> 7) & 0377) - 0200;
     354:     if (exp < 0) {
     355:         newfp[1] = 1;
     356:         exp = -exp;
     357:     }
     358:     if (exp > 63)
     359:         exp = 63;
     360:     dub[0] &= ~0177600;
     361:     dub[0] |= 0200;
     362:     mant = *lp;
     363:     mant <<= 8;
     364:     if (newfp[0])
     365:         mant = -mant;
     366:     newfp[0] |= (mant >> 17) & 077777;
     367:     newfp[1] |= (((int) (mant >> 1)) & 0177400) | (exp << 1);
     368: ret:
     369:     dub[0] = newfp[0];
     370:     dub[1] = newfp[1];
     371: }
     372: #endif

#### Defined functions

compat defined in line 66; never used
conv defined in line 340; used 2 times

- in /usr/src/ucb/PORT/pascal/src/rval.c line 282
- in /usr/src/ucb/PORT/pascal/src/stkrval.c line 212

convert defined in line 27; used 11 times

- in /usr/src/ucb/PORT/pascal/src/call.c line 384
- in /usr/src/ucb/PORT/pascal/src/func.c line 142
- in /usr/src/ucb/PORT/pascal/src/proc.c line 345, 413, 420, 523, 559, 580, 629, 762, 768

postcheck defined in line 286; used 8 times

- in /usr/src/ucb/PORT/pascal/src/call.c line 357
- in /usr/src/ucb/PORT/pascal/src/forop.c line 258, 271
- in /usr/src/ucb/PORT/pascal/src/lval.c line 410
- in /usr/src/ucb/PORT/pascal/src/pcproc.c line 407, 1036, 1122
- in /usr/src/ucb/PORT/pascal/src/stat.c line 484

precheck defined in line 241; used 8 times

- in /usr/src/ucb/PORT/pascal/src/call.c line 354
- in /usr/src/ucb/PORT/pascal/src/forop.c line 255, 268
- in /usr/src/ucb/PORT/pascal/src/lval.c line 403
- in /usr/src/ucb/PORT/pascal/src/pcproc.c line 386, 1005, 1083
- in /usr/src/ucb/PORT/pascal/src/stat.c line 426

rangechk defined in line 156; used 6 times

- in /usr/src/ucb/PORT/pascal/src/call.c line 382
- in /usr/src/ucb/PORT/pascal/src/forop.c line 314, 323
- in /usr/src/ucb/PORT/pascal/src/proc.c line 763, 798
- in /usr/src/ucb/PORT/pascal/src/stat.c line 449

#### Defined variables

sccsid defined in line 8; never used

Last modified: 1985-11-14 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 1233 |