4.3BSD - /usr/src/ucb/pascal/src/sconv.c

   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[] = "@(#)sconv.c	5.1 (Berkeley) 6/5/85";
   9: #endif not lint
  10: 
  11:     /*
  12:      *	functions to help pi put out
  13:      *	polish postfix binary portable c compiler intermediate code
  14:      *	thereby becoming the portable pascal compiler
  15:      */
  16: 
  17: #include    "whoami.h"
  18: #ifdef PC
  19: #include    "0.h"
  20: #include    <pcc.h>
  21: 
  22:     /*
  23:      *	this routine enforces ``the usual arithmetic conversions''
  24:      *	all integral operands are converted to ints.
  25:      *	if either operand is a double, both are made to be double.
  26:      *	this routine takes struct nl *'s for the types,
  27:      *	and returns both the struct nl * and the p2type for the result.
  28:      */
  29: tuac(thistype, thattype, resulttypep, resultp2typep)
  30:     struct nl   *thistype;
  31:     struct nl   *thattype;
  32:     struct nl   **resulttypep;
  33:     int     *resultp2typep;
  34: {
  35:     int     thisp2type = p2type(thistype);
  36:     int     thatp2type = p2type(thattype);
  37: 
  38:     *resulttypep = thistype;
  39:     *resultp2typep = thisp2type;
  40:     /*
  41: 	 *	should only be passed scalars
  42: 	 */
  43:     if (isnta(thistype,"sbcid") || isnta(thattype,"sbcid")) {
  44:     return;
  45:     }
  46:     if (thisp2type == PCCT_CHAR || thisp2type == PCCT_SHORT) {
  47:     *resultp2typep = PCCT_INT;
  48:     *resulttypep = nl + T4INT;
  49:     }
  50:     if (*resultp2typep == PCCT_INT && thatp2type == PCCT_DOUBLE) {
  51:     *resultp2typep = PCCT_DOUBLE;
  52:     *resulttypep = nl + TDOUBLE;
  53:     }
  54:     sconv(thisp2type, *resultp2typep);
  55: }
  56: 
  57:     /*
  58:      *	this routine will emit sconv operators when it thinks they are needed.
  59:      *	this is code generator specific, rather than machine-specific.
  60:      *	this routine takes p2types for arguments, not struct nl *'s.
  61:      */
  62: #ifdef vax
  63:     /*
  64:      *	the vax code genrator is very good, this routine is extremely boring.
  65:      */
  66: sconv(fromp2type, top2type)
  67:     int fromp2type;
  68:     int top2type;
  69: {
  70: 
  71:     switch (top2type) {
  72:     case PCCT_CHAR:
  73:     case PCCT_SHORT:
  74:     case PCCT_INT:
  75:         switch (fromp2type) {
  76:         case PCCT_CHAR:
  77:         case PCCT_SHORT:
  78:         case PCCT_INT:
  79:         case PCCT_DOUBLE:
  80:             return; /* pass1 knows how to do these */
  81:         default:
  82:             return;
  83:         }
  84:     case PCCT_DOUBLE:
  85:         switch (fromp2type) {
  86:         case PCCT_CHAR:
  87:         case PCCT_SHORT:
  88:         case PCCT_INT:
  89:             putop(PCC_SCONV, PCCT_DOUBLE);
  90:             return;
  91:         case PCCT_DOUBLE:
  92:             return;
  93:         default:
  94:             return;
  95:         }
  96:     default:
  97:         return;
  98:     }
  99: }
 100: #endif vax
 101: #ifdef mc68000
 102:     /*
 103:      *	i don't know how much to trust the mc68000 compiler,
 104:      *	so this routine is full.
 105:      */
 106: sconv(fromp2type, top2type)
 107:     int fromp2type;
 108:     int top2type;
 109: {
 110: 
 111:     switch (top2type) {
 112:     case PCCT_CHAR:
 113:         switch (fromp2type) {
 114:         case PCCT_CHAR:
 115:             return;
 116:         case PCCT_SHORT:
 117:         case PCCT_INT:
 118:         case PCCT_DOUBLE:
 119:             putop(PCC_SCONV, PCCT_CHAR);
 120:             return;
 121:         default:
 122:             return;
 123:         }
 124:     case PCCT_SHORT:
 125:         switch (fromp2type) {
 126:         case PCCT_SHORT:
 127:             return;
 128:         case PCCT_CHAR:
 129:         case PCCT_INT:
 130:         case PCCT_DOUBLE:
 131:             putop(PCC_SCONV, PCCT_SHORT);
 132:             return;
 133:         default:
 134:             return;
 135:         }
 136:     case PCCT_INT:
 137:         switch (fromp2type) {
 138:         case PCCT_INT:
 139:             return;
 140:         case PCCT_CHAR:
 141:         case PCCT_SHORT:
 142:         case PCCT_DOUBLE:
 143:             putop(PCC_SCONV, PCCT_INT);
 144:             return;
 145:         default:
 146:             return;
 147:         }
 148:     case PCCT_DOUBLE:
 149:         switch (fromp2type) {
 150:         case PCCT_DOUBLE:
 151:             return;
 152:         case PCCT_CHAR:
 153:         case PCCT_SHORT:
 154:         case PCCT_INT:
 155:             putop(PCC_SCONV, PCCT_DOUBLE);
 156:             return;
 157:         default:
 158:             return;
 159:         }
 160:     default:
 161:         return;
 162:     }
 163: }
 164: #endif mc68000
 165: #endif PC

Defined functions

Defined variables