home *** CD-ROM | disk | FTP | other *** search
/ GEMini Atari / GEMini_Atari_CD-ROM_Walnut_Creek_December_1993.iso / files / language / sozobon2 / md.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-10-23  |  7.8 KB  |  458 lines
  1. /* Copyright (c) 1988 by Sozobon, Limited.  Author: Johann Ruegg
  2.  *
  3.  * Permission is granted to anyone to use this software for any purpose
  4.  * on any computer system, and to redistribute it freely, with the
  5.  * following restrictions:
  6.  * 1) No charge may be made other than reasonable charges for reproduction.
  7.  * 2) Modified versions must be clearly marked as such.
  8.  * 3) The authors are not responsible for any harmful consequences
  9.  *    of using this software, even if they result from defects in it.
  10.  *
  11.  *    md.c
  12.  *
  13.  *    Machine dependant parts of first pass (parse)
  14.  *    Also type checking subroutines.
  15.  */
  16.  
  17. #include <stdio.h>
  18. #include "param.h"
  19. #include "tok.h"
  20. #include "nodes.h"
  21. #include "cookie.h"
  22.  
  23. NODEP bas_type();
  24.  
  25. int adjtab[] = {
  26.     K_INT,        /* none */
  27.     K_SHORT,    /* short */
  28.     K_LONG,        /* long */
  29.     0,        /* short long */
  30.     K_UNSIGNED,    /* unsigned */
  31.     K_UNSIGNED,    /* unsigned short */
  32.     T_ULONG,    /* unsigned long */
  33.     0,        /* unsigned short long */
  34. };
  35.  
  36. adj_type(old, adj)
  37. {
  38.     int rv;
  39.  
  40.     switch (old) {
  41.     case K_CHAR:
  42.         if (adj & SAW_UNS)
  43.             return T_UCHAR;
  44.         break;
  45.     case K_INT:
  46.         rv = adjtab[adj];
  47.         if (rv == 0) {
  48.             error("bad type spec");
  49.             return K_INT;
  50.         }
  51.         return rv;
  52.     case K_FLOAT:
  53.         if (adj & SAW_LONG)
  54.             return K_DOUBLE;
  55.         break;
  56.     }
  57.     return old;
  58. }
  59.  
  60. /* given ICON value, and flags SEE_L,SEE_U
  61.     determine final type */
  62. icon_ty(tp)
  63. NODE *tp;
  64. {
  65.     int flags;
  66.     long val;
  67.     int islong, isuns;
  68.  
  69.     flags = tp->e_flags;
  70.     val = tp->e_ival;
  71.  
  72.     islong = (flags & SEE_L);
  73.     isuns = (flags & SEE_U);
  74.  
  75.     if (islong && isuns)
  76.         return T_ULONG;
  77.     if (islong || islongv(val))
  78.         return K_LONG;
  79.     if (isuns)
  80.         return K_UNSIGNED;
  81.     return isintv((int)val) ? K_INT : K_CHAR;
  82. }
  83.  
  84. isintv(i)
  85. {
  86.     if (i > 0x7f || i < -0x80)
  87.         return 1;
  88.     return 0;
  89. }
  90.  
  91. islongv(l)
  92. long l;
  93. {
  94. #ifndef NOLONGS
  95. #define    HIBITS    0xffff0000L
  96.  
  97.     if ((l & HIBITS) == 0)        /* upper 16 bits zero */
  98.         return 0;
  99.  
  100.     if ((l & HIBITS) == HIBITS) {    /* upper bits all on */
  101.         if (l & 0x8000L)
  102.             return 0;    /* upper bits aren't significant */
  103.         else
  104.             return 1;
  105.     }
  106.     return 1;
  107. #else
  108.     return 0;
  109. #endif
  110. }
  111.  
  112. mkint(l)
  113. long l;
  114. {
  115.     return l;
  116. }
  117.  
  118. lc_reg(rp, xp)
  119. int *rp;
  120. NODE *xp;
  121. {
  122.     switch (xp->n_tptr->t_token) {
  123.     case STAR:
  124.         return al_areg(rp,xp);
  125.     case K_CHAR:
  126.     case T_UCHAR:
  127.     case T_ULONG:
  128.     case K_INT:
  129.     case K_UNSIGNED:
  130.     case K_LONG:
  131.         return al_dreg(rp,xp);
  132.     default:
  133.         return 0;
  134.     }
  135. }
  136.  
  137. al_areg(rp,xp)
  138. int *rp;
  139. NODEP xp;
  140. {
  141.     register rmask, n;
  142.  
  143.     rmask = *rp;
  144.     for (n=ARV_START; n<=ARV_END; n++)
  145.         if ((rmask & (1<<n)) == 0) {
  146.             xp->e_rno = n;
  147.             *rp |= (1<<n);
  148.             return 1;
  149.         }
  150.     return 0;
  151. }
  152.  
  153. al_dreg(rp,xp)
  154. int *rp;
  155. NODEP xp;
  156. {
  157.     register rmask, n;
  158.  
  159.     rmask = *rp;
  160.     for (n=DRV_START; n<=DRV_END; n++)
  161.         if ((rmask & (1<<n)) == 0) {
  162.             xp->e_rno = n;
  163.             *rp |= (1<<n);
  164.             return 1;
  165.         }
  166.     return 0;
  167. }
  168.  
  169. long
  170. arg_size(sz,np)
  171. long sz;
  172. NODEP np;
  173. {
  174.     np->e_offs = 0;
  175.  
  176.     switch (np->n_tptr->t_token) {
  177.     case '[':
  178.         printf("GAK! array arg ");
  179.         return SIZE_P;
  180.     case K_CHAR:
  181.     case T_UCHAR:
  182.         np->e_offs = SIZE_I - SIZE_C;
  183.         return SIZE_I;
  184. #if SIZE_I != SIZE_S
  185.     case K_SHORT:
  186.         np->e_offs = SIZE_I - SIZE_S;
  187.         return SIZE_I;
  188. #endif
  189.     default:
  190.         if (sz & 1)
  191.             sz++;
  192.         return sz;
  193.     }
  194. }
  195.  
  196. mustlval(np)
  197. NODEP np;
  198. {
  199.     switch (np->e_token) {
  200.     case ID:
  201.     case STAR:
  202.     case '.':
  203.         break;
  204.     default:
  205.         errorn("not lvalue", np);
  206.         return 1;
  207.     }
  208.     return 0;
  209. }
  210.  
  211. mustty(np, flags)
  212. NODEP np;
  213. {
  214.     switch (np->n_tptr->t_token) {
  215.     case STAR:
  216.         if (flags & R_POINTER)
  217.             return 0;
  218.         error("pointer not allowed");
  219.         return 1;
  220.     case K_STRUCT:
  221.     case K_UNION:
  222.         if (flags & R_STRUCT)
  223.             return 0;
  224.         error("struct/union not allowed");
  225.         return 1;
  226.     case K_CHAR:
  227.     case K_SHORT:
  228.     case K_INT:
  229.     case K_UNSIGNED:
  230.     case K_LONG:
  231.     case T_UCHAR:
  232.     case T_ULONG:
  233.         if (flags & R_INTEGRAL)
  234.             return 0;
  235.         error("integral not allowed");
  236.         return 1;
  237.     case K_FLOAT:
  238.     case K_DOUBLE:
  239.         if (flags & R_FLOATING)
  240.             return 0;
  241.         error("floating not allowed");
  242.         return 1;
  243.     default:
  244.         error("bad type");
  245.         return 1;
  246.     }
  247.     return 0;
  248. }
  249.  
  250. NODEP
  251. functy(np)
  252. NODEP np;
  253. {
  254.     int lt;
  255.  
  256.     lt = np->n_tptr->t_token;
  257.     if (lt != K_VOID)
  258.         mustty(np, R_ASSN);
  259.     switch (lt) {
  260.     case STAR:
  261.     case K_STRUCT:
  262.     case K_UNION:
  263.         return np->n_tptr;
  264.     }
  265.     lt = widen(lt);
  266.     return bas_type(lt);
  267. }
  268.  
  269. NODEP
  270. normalty(lp, rp)
  271. NODEP lp, rp;
  272. {
  273.     /* already checked types are R_ARITH */
  274.     /* rp may be NULL */
  275.     int lt, rt, rett;
  276.  
  277.     lt = lp->n_tptr->t_token;
  278.     if (rp)
  279.         rt = rp->n_tptr->t_token;
  280.     else
  281.         rt = K_INT;
  282.     rett = maxt(widen(lt), widen(rt));
  283.     return bas_type(rett);
  284. }
  285.  
  286. asn_chk(ltp, rp)
  287. NODEP ltp, rp;
  288. {
  289.  
  290.     switch (ltp->t_token) {
  291.     case K_STRUCT:
  292.     case K_UNION:
  293.         if (same_type(ltp, rp->n_tptr) == 0)
  294.             error("bad struct assign");
  295.         return;
  296.     case STAR:
  297.         if (mayzero(rp))
  298.             return;
  299.         if (mustty(rp, R_POINTER))
  300.             return;
  301.         if (same_type(ltp->n_tptr, rp->n_tptr->n_tptr)
  302.             == 0)
  303.             warn("pointer types mismatch");
  304.         return;
  305.     default:
  306.         if (mustty(rp, R_ARITH))
  307.             return;
  308.     }
  309. }
  310.  
  311. chkcmp(np)
  312. NODEP np;
  313. {
  314.     /* already checked types are R_SCALAR */
  315.     int lt, rt;
  316.     NODEP lp = np->n_left, rp = np->n_right;
  317.  
  318.     lt = lp->n_tptr->t_token;
  319.     lt = (lt == STAR);
  320.     rt = rp->n_tptr->t_token;
  321.     rt = (rt == STAR);
  322.     if (lt && rt) {        /* ptr cmp ptr */
  323.         if (same_type(lp->n_tptr, rp->n_tptr) == 0) {
  324.             warn("cmp of diff ptrs");
  325.         }
  326.     } else if (lt) {    /* ptr cmp intg */
  327.         mustzero(rp);
  328.     } else if (rt) {    /* intg +-[ ptr */
  329.         mustzero(lp);
  330.     } /* else both ARITH */
  331. }
  332.  
  333. NODEP
  334. colonty(np)
  335. NODEP np;
  336. {
  337.     /* already checked types are R_SCALAR */
  338.     int lt, rt;
  339.     NODEP lp = np->n_left, rp = np->n_right;
  340.  
  341.     lt = lp->n_tptr->t_token;
  342.     lt = (lt == STAR);
  343.     rt = rp->n_tptr->t_token;
  344.     rt = (rt == STAR);
  345.     if (lt && rt) {        /* ptr : ptr */
  346.         warn(": diff ptrs");
  347.         return lp->n_tptr;
  348.     } else if (lt) {    /* ptr : intg */
  349.         mustzero(rp);
  350.         return lp->n_tptr;
  351.     } else if (rt) {
  352.         mustzero(lp);
  353.         return rp->n_tptr;
  354.     } else
  355.         return normalty(lp, rp);
  356. }
  357.  
  358. NODEP
  359. addty(np)
  360. NODEP np;
  361. {
  362.     /* already checked types are R_SCALAR */
  363.     /* op is '+' or '-' or '+=' or '-=' or '[' */
  364.     int oop = np->e_token;
  365.     int op;
  366.     int lt, rt;
  367.     NODEP lp = np->n_left, rp = np->n_right;
  368.  
  369.     op = oop;
  370.     if (isassign(op))
  371.         op -= ASSIGN 0;
  372.     lt = lp->n_tptr->t_token;
  373.     lt = (lt == STAR);
  374.     rt = rp->n_tptr->t_token;
  375.     rt = (rt == STAR);
  376.     if (lt && rt) {        /* ptr - ptr */
  377.         if (oop != '-' || same_type(lp->n_tptr, rp->n_tptr) == 0) {
  378.             error("bad +/-");
  379.             return lp->n_tptr;
  380.         }
  381.         np->e_token = PTRDIFF;
  382.         np->e_offs = lp->n_tptr->n_tptr->t_size;
  383.         return bas_type(K_INT);
  384.     } else if (lt) {    /* ptr +-[ intg */
  385. pandi:
  386.         mustty(rp, R_INTEGRAL);
  387.         np->e_offs = lp->n_tptr->n_tptr->t_size;
  388.         if (op == '+')
  389.             np->e_token += PTRADD-'+';
  390.         else if (op == '-')
  391.             np->e_token += PTRSUB-'-';
  392.         return lp->n_tptr;
  393.     } else if (rt) {    /* intg +-[ ptr */
  394.         if (isassign(oop) || op == '-') {
  395.             error("illegal int op ptr");
  396.             return bas_type(K_INT);
  397.         }
  398.         /* switch sides so intg is on right */
  399.         np->n_left = rp;
  400.         np->n_right = lp;
  401.         lp = rp;
  402.         rp = np->n_right;
  403.         goto pandi;        
  404.     } else {        /* intg +- intg */
  405.         return normalty(lp, rp);
  406.     }
  407. }
  408.  
  409. mustzero(np)
  410. NODEP np;
  411. {
  412.     if (np->e_token == ICON && np->e_ival == 0) {
  413.         return;
  414.     }
  415.     error("bad ':' combination");
  416. }
  417.  
  418. mayzero(np)
  419. NODEP np;
  420. {
  421.     if (np->e_token == ICON && np->e_ival == 0) {
  422.         return 1;
  423.     }
  424.     return 0;
  425. }
  426.  
  427. widen(ty)
  428. {
  429.     switch (ty) {
  430.     case K_CHAR:
  431.     case T_UCHAR:
  432.         return K_INT;
  433.     case K_SHORT:
  434.         return K_INT;
  435.     case K_FLOAT:
  436.         return K_DOUBLE;
  437.     default:
  438.         return ty;
  439.     }
  440. }
  441.  
  442. int pri_t[] = {
  443.     1, 6,        /* uchar, ulong */
  444.     5,2,4,3,0,    /* long, short, uns, int, char */
  445.     7,8,9       /* float, double, void */
  446. };
  447.  
  448. maxt(t1, t2)
  449. {
  450.     extern nmerrors;
  451.  
  452.     if (nmerrors)
  453.         return K_INT;
  454.     if (pri_t[t1-FIRST_BAS] > pri_t[t2-FIRST_BAS])
  455.         return t1;
  456.     return t2;
  457. }
  458.