home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / bsd_srcs / usr.bin / pascal / src / sconv.c < prev    next >
Encoding:
C/C++ Source or Header  |  1991-04-16  |  5.1 KB  |  193 lines

  1. /*-
  2.  * Copyright (c) 1980 The Regents of the University of California.
  3.  * All rights reserved.
  4.  *
  5.  * Redistribution and use in source and binary forms, with or without
  6.  * modification, are permitted provided that the following conditions
  7.  * are met:
  8.  * 1. Redistributions of source code must retain the above copyright
  9.  *    notice, this list of conditions and the following disclaimer.
  10.  * 2. Redistributions in binary form must reproduce the above copyright
  11.  *    notice, this list of conditions and the following disclaimer in the
  12.  *    documentation and/or other materials provided with the distribution.
  13.  * 3. All advertising materials mentioning features or use of this software
  14.  *    must display the following acknowledgement:
  15.  *    This product includes software developed by the University of
  16.  *    California, Berkeley and its contributors.
  17.  * 4. Neither the name of the University nor the names of its contributors
  18.  *    may be used to endorse or promote products derived from this software
  19.  *    without specific prior written permission.
  20.  *
  21.  * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
  22.  * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  23.  * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  24.  * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  25.  * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  26.  * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  27.  * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  28.  * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  29.  * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  30.  * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  31.  * SUCH DAMAGE.
  32.  */
  33.  
  34. #ifndef lint
  35. static char sccsid[] = "@(#)sconv.c    5.3 (Berkeley) 4/16/91";
  36. #endif /* not lint */
  37.  
  38.     /*
  39.      *    functions to help pi put out
  40.      *    polish postfix binary portable c compiler intermediate code
  41.      *    thereby becoming the portable pascal compiler
  42.      */
  43.  
  44. #include    "whoami.h"
  45. #ifdef PC
  46. #include    "0.h"
  47. #include    <pcc.h>
  48.  
  49.     /*
  50.      *    this routine enforces ``the usual arithmetic conversions''
  51.      *    all integral operands are converted to ints.
  52.      *    if either operand is a double, both are made to be double.
  53.      *    this routine takes struct nl *'s for the types,
  54.      *    and returns both the struct nl * and the p2type for the result.
  55.      */
  56. tuac(thistype, thattype, resulttypep, resultp2typep)
  57.     struct nl    *thistype;
  58.     struct nl    *thattype;
  59.     struct nl    **resulttypep;
  60.     int        *resultp2typep;
  61. {
  62.     int        thisp2type = p2type(thistype);
  63.     int        thatp2type = p2type(thattype);
  64.  
  65.     *resulttypep = thistype;
  66.     *resultp2typep = thisp2type;
  67.     /*
  68.      *    should only be passed scalars
  69.      */
  70.     if (isnta(thistype,"sbcid") || isnta(thattype,"sbcid")) {
  71.     return;
  72.     }
  73.     if (thisp2type == PCCT_CHAR || thisp2type == PCCT_SHORT) {
  74.     *resultp2typep = PCCT_INT;
  75.     *resulttypep = nl + T4INT;
  76.     }
  77.     if (*resultp2typep == PCCT_INT && thatp2type == PCCT_DOUBLE) {
  78.     *resultp2typep = PCCT_DOUBLE;
  79.     *resulttypep = nl + TDOUBLE;
  80.     }
  81.     sconv(thisp2type, *resultp2typep);
  82. }
  83.     
  84.     /*
  85.      *    this routine will emit sconv operators when it thinks they are needed.
  86.      *    this is code generator specific, rather than machine-specific.
  87.      *    this routine takes p2types for arguments, not struct nl *'s.
  88.      */
  89. #if defined(vax) || defined(tahoe)
  90.     /*
  91.      *    the vax code genrator is very good, this routine is extremely boring.
  92.      */
  93. sconv(fromp2type, top2type)
  94.     int    fromp2type;
  95.     int    top2type;
  96. {
  97.  
  98.     switch (top2type) {
  99.     case PCCT_CHAR:
  100.     case PCCT_SHORT:
  101.     case PCCT_INT:
  102.         switch (fromp2type) {
  103.         case PCCT_CHAR:
  104.         case PCCT_SHORT:
  105.         case PCCT_INT:
  106.         case PCCT_DOUBLE:
  107.             return;    /* pass1 knows how to do these */
  108.         default:
  109.             return;
  110.         }
  111.     case PCCT_DOUBLE:
  112.         switch (fromp2type) {
  113.         case PCCT_CHAR:
  114.         case PCCT_SHORT:
  115.         case PCCT_INT:
  116.             putop(PCC_SCONV, PCCT_DOUBLE);
  117.             return;
  118.         case PCCT_DOUBLE:
  119.             return;
  120.         default:
  121.             return;
  122.         }
  123.     default:
  124.         return;
  125.     }
  126. }
  127. #endif vax || tahoe
  128. #ifdef mc68000
  129.     /*
  130.      *    i don't know how much to trust the mc68000 compiler,
  131.      *    so this routine is full.
  132.      */
  133. sconv(fromp2type, top2type)
  134.     int    fromp2type;
  135.     int    top2type;
  136. {
  137.  
  138.     switch (top2type) {
  139.     case PCCT_CHAR:
  140.         switch (fromp2type) {
  141.         case PCCT_CHAR:
  142.             return;
  143.         case PCCT_SHORT:
  144.         case PCCT_INT:
  145.         case PCCT_DOUBLE:
  146.             putop(PCC_SCONV, PCCT_CHAR);
  147.             return;
  148.         default:
  149.             return;
  150.         }
  151.     case PCCT_SHORT:
  152.         switch (fromp2type) {
  153.         case PCCT_SHORT:
  154.             return;
  155.         case PCCT_CHAR:
  156.         case PCCT_INT:
  157.         case PCCT_DOUBLE:
  158.             putop(PCC_SCONV, PCCT_SHORT);
  159.             return;
  160.         default:
  161.             return;
  162.         }
  163.     case PCCT_INT:
  164.         switch (fromp2type) {
  165.         case PCCT_INT:
  166.             return;
  167.         case PCCT_CHAR:
  168.         case PCCT_SHORT:
  169.         case PCCT_DOUBLE:
  170.             putop(PCC_SCONV, PCCT_INT);
  171.             return;
  172.         default:
  173.             return;
  174.         }
  175.     case PCCT_DOUBLE:
  176.         switch (fromp2type) {
  177.         case PCCT_DOUBLE:
  178.             return;
  179.         case PCCT_CHAR:
  180.         case PCCT_SHORT:
  181.         case PCCT_INT:
  182.             putop(PCC_SCONV, PCCT_DOUBLE);
  183.             return;
  184.         default:
  185.             return;
  186.         }
  187.     default:
  188.         return;
  189.     }
  190. }
  191. #endif mc68000
  192. #endif PC
  193.