# 2.11BSD#431 - /usr/src/ucb/pascal/pi/const.c

##### Functions

    constbeg          X
    constend          X
    gconst            X
    isconst           X

##### Variables

    cdecl             X
    cid               X
    cline             X

       1: /*	@(#)const.c	2.3	SCCS id keyword	*/
       2: /* Copyright (c) 1979 Regents of the University of California */
       3: #
       4: /*
       5:  * pi - Pascal interpreter code translator
       6:  *
       7:  * Charles Haley, Bill Joy UCB
       8:  * Version 1.2 November 1978
       9:  */
      10:
      11: #include "whoami"
      12: #include "0.h"
      13: #include "tree.h"
      14:
      15: /*
      16:  * Const enters the definitions
      17:  * of the constant declaration
      18:  * part into the namelist.
      19:  */
      20: #ifndef PI1
      21: constbeg()
      22: {
      23:
      24:     if (parts & (TPRT|VPRT))
      25:         error("Constant declarations must precede type and variable declarations");
      26:     if (parts & CPRT)
      27:         error("All constants must be declared in one const part");
      28:     parts |= CPRT;
      29: }
      30: #endif
      31:
      32: const(cline, cid, cdecl)
      33:     int cline;
      34:     register char *cid;
      35:     register int *cdecl;
      36: {
      37:     register struct nl *np;
      38:
      39: #ifdef PI0
      40:     send(REVCNST, cline, cid, cdecl);
      41: #endif
      42:     line = cline;
      43:     gconst(cdecl);
      44:     np = enter(defnl(cid, CONST, con.ctype, con.cival));
      45: #ifndef PI0
      46:     np->nl_flags |= NMOD;
      47: #endif
      48:     if (con.ctype == NIL)
      49:         return;
      50:     if ( con.ctype == nl + TSTR )
      51:         np->ptr[0] = con.cpval;
      52:     if (isa(con.ctype, "i"))
      53:         np->range[0] = con.crval;
      54:     else if (isa(con.ctype, "d"))
      55:         np->real = con.crval;
      56: }
      57:
      58: #ifndef PI0
      59: #ifndef PI1
      60: constend()
      61: {
      62:
      63: }
      64: #endif
      65: #endif
      66:
      67: /*
      68:  * Gconst extracts
      69:  * a constant declaration
      70:  * from the tree for it.
      71:  * only types of constants
      72:  * are integer, reals, strings
      73:  * and scalars, the first two
      74:  * being possibly signed.
      75:  */
      76: gconst(r)
      77:     int *r;
      78: {
      79:     register struct nl *np;
      80:     register *cn;
      81:     char *cp;
      82:     int negd, sgnd;
      83:     long ci;
      84:
      85:     con.ctype = NIL;
      86:     cn = r;
      87:     negd = sgnd = 0;
      88: loop:
      89:     if (cn == NIL || cn[1] == NIL)
      90:         return (NIL);
      91:     switch (cn[0]) {
      92:         default:
      93:             panic("gconst");
      94:         case T_MINUSC:
      95:             negd = 1 - negd;
      96:         case T_PLUSC:
      97:             sgnd++;
      98:             cn = cn[1];
      99:             goto loop;
     100:         case T_ID:
     101:             np = lookup(cn[1]);
     102:             if (np == NIL)
     103:                 return;
     104:             if (np->class != CONST) {
     105:                 derror("%s is a %s, not a constant as required", cn[1], classes[np->class]);
     106:                 return;
     107:             }
     108:             con.ctype = np->type;
     109:             switch (classify(np->type)) {
     110:                 case TINT:
     111:                     con.crval = np->range[0];
     112:                     break;
     113:                 case TDOUBLE:
     114:                     con.crval = np->real;
     115:                     break;
     116:                 case TBOOL:
     117:                 case TCHAR:
     118:                 case TSCAL:
     119:                     con.cival = np->value[0];
     120:                     con.crval = con.cival;
     121:                     break;
     122:                 case TSTR:
     123:                     con.cpval = np->ptr[0];
     124:                     break;
     125:                 case NIL:
     126:                     con.ctype = NIL;
     127:                     return;
     128:                 default:
     129:                     panic("gconst2");
     130:             }
     131:             break;
     132:         case T_CBINT:
     133:             con.crval = a8tol(cn[1]);
     134:             goto restcon;
     135:         case T_CINT:
     136:             con.crval = atof(cn[1]);
     137:             if (con.crval > MAXINT || con.crval < MININT) {
     138:                 derror("Constant too large for this implementation");
     139:                 con.crval = 0;
     140:             }
     141: restcon:
     142:             ci = con.crval;
     143: #ifndef PI0
     144:             if (bytes(ci, ci) <= 2)
     145:                 con.ctype = nl+T2INT;
     146:             else
     147: #endif
     148:                 con.ctype = nl+T4INT;
     149:             break;
     150:         case T_CFINT:
     151:             con.ctype = nl+TDOUBLE;
     152:             con.crval = atof(cn[1]);
     153:             break;
     154:         case T_CSTRNG:
     155:             cp = cn[1];
     156:             if (cp[1] == 0) {
     157:                 con.ctype = nl+T1CHAR;
     158:                 con.cival = cp[0];
     159:                 con.crval = con.cival;
     160:                 break;
     161:             }
     162:             con.ctype = nl+TSTR;
     163:             con.cpval = savestr(cp);
     164:             break;
     165:     }
     166:     if (sgnd) {
     167:         if (isnta(con.ctype, "id"))
     168:             derror("%s constants cannot be signed", nameof(con.ctype));
     169:         else {
     170:             if (negd)
     171:                 con.crval = -con.crval;
     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

#### Defined functions

constbeg defined in line 21; used 2 times

- in /usr/src/ucb/pascal/pi/pas.y line 213, 220

constend defined in line 60; used 2 times

- in /usr/src/ucb/pascal/pi/pas.y line 170, 182

gconst defined in line 76; used 6 times

- in line 43
- in /usr/src/ucb/pascal/pi/case.c line 105
- in /usr/src/ucb/pascal/pi/proc.c line 578
- in /usr/src/ucb/pascal/pi/rec.c line 195
- in /usr/src/ucb/pascal/pi/type.c line 199-202(2)

isconst defined in line 177; used 3 times

- in line 187-191(2)
- in /usr/src/ucb/pascal/pi/proc.c line 574

#### Defined variables

cdecl defined in line 35; used 3 times

- in line 32, 40-43(2)

cid defined in line 34; used 3 times

- in line 32, 40-44(2)

cline defined in line 33; used 3 times

- in line 32, 40-42(2)

Last modified: 1981-07-10 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 657 |