home *** CD-ROM | disk | FTP | other *** search
/ minnie.tuhs.org / unixen.tar / unixen / PDP-11 / Distributions / ucb / spencer_2bsd.tar.gz / 2bsd.tar / src / pi / const.c < prev    next >
Encoding:
C/C++ Source or Header  |  1980-02-17  |  3.7 KB  |  218 lines
  1. /* Copyright (c) 1979 Regents of the University of California */
  2. #
  3. /*
  4.  * pi - Pascal interpreter code translator
  5.  *
  6.  * Charles Haley, Bill Joy UCB
  7.  * Version 1.2 January 1979
  8.  */
  9.  
  10. #include "0.h"
  11. #include "tree.h"
  12.  
  13. /*
  14.  * Const enters the definitions
  15.  * of the constant declaration
  16.  * part into the namelist.
  17.  */
  18. #ifndef PI1
  19. constbeg()
  20. {
  21.  
  22.     if (parts & (TPRT|VPRT))
  23.         error("Constant declarations must precede type and variable declarations");
  24.     if (parts & CPRT)
  25.         error("All constants must be declared in one const part");
  26.     parts =| CPRT;
  27. }
  28. #endif
  29.  
  30. const(cline, cid, cdecl)
  31.     int cline;
  32.     register char *cid;
  33.     register int *cdecl;
  34. {
  35.     register struct nl *np;
  36.  
  37. #ifdef PI0
  38.     send(REVCNST, cline, cid, cdecl);
  39. #endif
  40.     line = cline;
  41.     gconst(cdecl);
  42.     np = enter(defnl(cid, CONST, con.ctype, con.cival));
  43. #ifndef PI0
  44.     np->nl_flags =| NMOD;
  45. #endif
  46.     if (con.ctype == NIL)
  47.         return;
  48.     if (isa(con.ctype, "i"))
  49.         np->range[0] = con.crval;
  50.     else if (isa(con.ctype, "d"))
  51.         np->real = con.crval;
  52. }
  53.  
  54. #ifndef PI0
  55. #ifndef PI1
  56. constend()
  57. {
  58.  
  59. }
  60. #endif
  61. #endif
  62.  
  63. /*
  64.  * Gconst extracts
  65.  * a constant declaration
  66.  * from the tree for it.
  67.  * only types of constants
  68.  * are integer, reals, strings
  69.  * and scalars, the first two
  70.  * being possibly signed.
  71.  */
  72. gconst(r)
  73.     int *r;
  74. {
  75.     register struct nl *np;
  76.     register *cn;
  77.     char *cp;
  78.     int negd, sgnd;
  79.     long ci;
  80.  
  81.     con.ctype = NIL;
  82.     cn = r;
  83.     negd = sgnd = 0;
  84. loop:
  85.     if (cn == NIL || cn[1] == NIL)
  86.         return (NIL);
  87.     switch (cn[0]) {
  88.         default:
  89.             panic("gconst");
  90.         case T_MINUSC:
  91.             negd = 1 - negd;
  92.         case T_PLUSC:
  93.             sgnd++;
  94.             cn = cn[1];
  95.             goto loop;
  96.         case T_ID:
  97.             np = lookup(cn[1]);
  98.             if (np == NIL)
  99.                 return;
  100.             if (np->class != CONST) {
  101.                 derror("%s is a %s, not a constant as required", cn[1], classes[np->class]);
  102.                 return;
  103.             }
  104.             con.ctype = np->type;
  105.             switch (classify(np->type)) {
  106.                 case TINT:
  107.                     con.crval = np->range[0];
  108.                     break;
  109.                 case TDOUBLE:
  110.                     con.crval = np->real;
  111.                     break;
  112.                 case TBOOL:
  113.                 case TCHAR:
  114.                 case TSTR:
  115.                 case TSCAL:
  116.                     con.cival = np->value[0];
  117.                     con.crval = con.cival;
  118.                     break;
  119.                 case NIL:
  120.                     con.ctype = NIL;
  121.                     return;
  122.                 default:
  123.                     panic("gconst2");
  124.             }
  125.             break;
  126.         case T_CBINT:
  127.             con.crval = a8tol(cn[1]);
  128.             goto restcon;
  129.         case T_CINT:
  130.             con.crval = atof(cn[1]);
  131.             if (con.crval > MAXINT || con.crval < MININT) {
  132.                 derror("Constant too large for this implementation");
  133.                 con.crval = 0;
  134.             }
  135. restcon:
  136.             ci = con.crval;
  137. #ifndef PI0
  138.             if (bytes(ci, ci) <= 2)
  139.                 con.ctype = nl+T2INT;
  140.             else    
  141. #endif
  142.                 con.ctype = nl+T4INT;
  143.             break;
  144.         case T_CFINT:
  145.             con.ctype = nl+TDOUBLE;
  146.             con.crval = atof(cn[1]);
  147.             break;
  148.         case T_CSTRNG:
  149.             cp = cn[1];
  150.             if (cp[1] == 0) {
  151.                 con.ctype = nl+T1CHAR;
  152.                 con.cival = cp[0];
  153.                 con.crval = con.cival;
  154.                 break;
  155.             }
  156.             con.ctype = nl+TSTR;
  157.             con.cival = savestr(cp);
  158.             con.crval = con.cival;
  159.             break;
  160.     }
  161.     if (sgnd) {
  162.         if (isnta(con.ctype, "id"))
  163.             derror("%s constants cannot be signed", nameof(con.ctype));
  164.         else {
  165.             if (negd)
  166.                 con.crval = -con.crval;
  167.             ci = con.crval;
  168. #ifndef PI0
  169.             if (bytes(ci, ci) <= 2)
  170.                 con.ctype = nl+T2INT;
  171. #endif
  172.         }
  173.     }
  174. }
  175.  
  176. #ifndef PI0
  177. isconst(r)
  178.     register int *r;
  179. {
  180.  
  181.     if (r == NIL)
  182.         return (1);
  183.     switch (r[0]) {
  184.         case T_MINUS:
  185.             r[0] = T_MINUSC;
  186.             r[1] = r[2];
  187.             return (isconst(r[1]));
  188.         case T_PLUS:
  189.             r[0] = T_PLUSC;
  190.             r[1] = r[2];
  191.             return (isconst(r[1]));
  192.         case T_VAR:
  193.             if (r[3] != NIL)
  194.                 return (0);
  195.             r[0] = T_ID;
  196.             r[1] = r[2];
  197.             return (1);
  198.         case T_BINT:
  199.             r[0] = T_CBINT;
  200.             r[1] = r[2];
  201.             return (1);
  202.         case T_INT:
  203.             r[0] = T_CINT;
  204.             r[1] = r[2];
  205.             return (1);
  206.         case T_FINT:
  207.             r[0] = T_CFINT;
  208.             r[1] = r[2];
  209.             return (1);
  210.         case T_STRNG:
  211.             r[0] = T_CSTRNG;
  212.             r[1] = r[2];
  213.             return (1);
  214.     }
  215.     return (0);
  216. }
  217. #endif
  218.