BSD 4_3_Net_2 release

[unix-history] / usr / src / usr.bin / pascal / src / const.c

diff --git a/usr/src/usr.bin/pascal/src/const.c b/usr/src/usr.bin/pascal/src/const.c
index 5440c36..d58b8c3 100644 (file)
--- a/usr/src/usr.bin/pascal/src/const.c
+++ b/usr/src/usr.bin/pascal/src/const.c
@@ -1,10 +1,44 @@
-/* Copyright (c) 1979 Regents of the University of California */
+/*-
+ * Copyright (c) 1980 The Regents of the University of California.
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in the
+ *    documentation and/or other materials provided with the distribution.
+ * 3. All advertising materials mentioning features or use of this software
+ *    must display the following acknowledgement:
+ *     This product includes software developed by the University of
+ *     California, Berkeley and its contributors.
+ * 4. Neither the name of the University nor the names of its contributors
+ *    may be used to endorse or promote products derived from this software
+ *    without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
+ * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+ * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+ * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */

 
 

-static char sccsid[] = "@(#)const.c 1.1 %G%";
+#ifndef lint
+static char sccsid[] = "@(#)const.c    5.5 (Berkeley) 4/16/91";
+#endif /* not lint */

 
 #include "whoami.h"
 #include "0.h"
 #include "tree.h"
 
 #include "whoami.h"
 #include "0.h"
 #include "tree.h"

+#include "tree_ty.h"

 
 /*
  * Const enters the definitions
 
 /*
  * Const enters the definitions


@@ -12,11 +46,14 @@ static      char sccsid[] = "@(#)const.c 1.1 %G%";
  * part into the namelist.
  */
 #ifndef PI1
  * part into the namelist.
  */
 #ifndef PI1

-constbeg()
+constbeg( lineofyconst , linenum )
+    int        lineofyconst, linenum;

 {
 {

+    static bool        const_order = FALSE;
+    static bool        const_seen = FALSE;

 
 /*
 
 /*

- * PC allows for multiple declaration
+ * this allows for multiple declaration

  * parts, unless the "standard" option
  * has been specified.
  * If a routine segment is being compiled,
  * parts, unless the "standard" option
  * has been specified.
  * If a routine segment is being compiled,


@@ -25,32 +62,39 @@ constbeg()
 
        if (!progseen)
                level1();
 
        if (!progseen)
                level1();

-#    ifdef PC
-       if (opt('s')) {
-               if (parts & (TPRT|VPRT)) {
-                       standard();
-                       error("Constant declarations must precede type and variable declarations");
+       line = lineofyconst;
+       if (parts[ cbn ] & (TPRT|VPRT|RPRT)) {
+           if ( opt( 's' ) ) {
+               standard();
+               error("Constant declarations should precede type, var and routine declarations");
+           } else {
+               if ( !const_order ) {
+                   const_order = TRUE;
+                   warning();
+                   error("Constant declarations should precede type, var and routine declarations");

                }
                }

-               if (parts & CPRT) {
-                       standard();
-                       error("All constants must be declared in one const part");
+           }
+       }
+       if (parts[ cbn ] & CPRT) {
+           if ( opt( 's' ) ) {
+               standard();
+               error("All constants should be declared in one const part");
+           } else {
+               if ( !const_seen ) {
+                   const_seen = TRUE;
+                   warning();
+                   error("All constants should be declared in one const part");

                }
                }

-        }
-#    endif PC
-#    ifdef OBJ
-       if (parts & (TPRT|VPRT))
-               error("Constant declarations must precede type and variable declarations");
-       if (parts & CPRT)
-               error("All constants must be declared in one const part");
-#    endif OBJ
-       parts |= CPRT;
+           }
+       }
+       parts[ cbn ] |= CPRT;

 }
 #endif PI1
 
 }
 #endif PI1
 

-const(cline, cid, cdecl)
+constant(cline, cid, cdecl)

        int cline;
        register char *cid;
        int cline;
        register char *cid;

-       register int *cdecl;
+       register struct tnode *cdecl;

 {
        register struct nl *np;
 
 {
        register struct nl *np;
 


@@ -65,8 +109,9 @@ const(cline, cid, cdecl)
 #endif
 
 #ifdef PC
 #endif
 
 #ifdef PC

-       if (cbn == 1)
-               stabcname( cid );
+       if (cbn == 1) {
+           stabgconst( cid , line );
+       }

 #endif PC
 
 #      ifdef PTREE
 #endif PC
 
 #      ifdef PTREE


@@ -83,11 +128,16 @@ const(cline, cid, cdecl)
        if (con.ctype == NIL)
                return;
        if ( con.ctype == nl + TSTR )
        if (con.ctype == NIL)
                return;
        if ( con.ctype == nl + TSTR )

-               np->ptr[0] = con.cpval;
+               np->ptr[0] = (struct nl *) con.cpval;

        if (isa(con.ctype, "i"))
                np->range[0] = con.crval;
        else if (isa(con.ctype, "d"))
                np->real = con.crval;
        if (isa(con.ctype, "i"))
                np->range[0] = con.crval;
        else if (isa(con.ctype, "d"))
                np->real = con.crval;

+#       ifdef PC
+           if (cbn == 1 && con.ctype != NIL) {
+                   stabconst(np);
+           }
+#       endif

 }
 
 #ifndef PI0
 }
 
 #ifndef PI0


@@ -108,36 +158,36 @@ constend()
  * and scalars, the first two
  * being possibly signed.
  */
  * and scalars, the first two
  * being possibly signed.
  */

-gconst(r)
-       int *r;
+gconst(c_node)
+       struct tnode *c_node;

 {
        register struct nl *np;
 {
        register struct nl *np;

-       register *cn;
+       register struct tnode *cn;

        char *cp;
        int negd, sgnd;
        long ci;
 
        con.ctype = NIL;
        char *cp;
        int negd, sgnd;
        long ci;
 
        con.ctype = NIL;

-       cn = r;
+       cn = c_node;

        negd = sgnd = 0;
 loop:
        negd = sgnd = 0;
 loop:

-       if (cn == NIL || cn[1] == NIL)
-               return (NIL);
-       switch (cn[0]) {
+       if (cn == TR_NIL || cn->sign_const.number == TR_NIL)
+               return;
+       switch (cn->tag) {

                default:
                        panic("gconst");
                case T_MINUSC:
                        negd = 1 - negd;
                case T_PLUSC:
                        sgnd++;
                default:
                        panic("gconst");
                case T_MINUSC:
                        negd = 1 - negd;
                case T_PLUSC:
                        sgnd++;

-                       cn = cn[1];
+                       cn = cn->sign_const.number;

                        goto loop;
                case T_ID:
                        goto loop;
                case T_ID:

-                       np = lookup(cn[1]);
-                       if (np == NIL)
+                       np = lookup(cn->char_const.cptr);
+                       if (np == NLNIL)

                                return;
                        if (np->class != CONST) {
                                return;
                        if (np->class != CONST) {

-                               derror("%s is a %s, not a constant as required", cn[1], classes[np->class]);
+                               derror("%s is a %s, not a constant as required", cn->char_const.cptr, classes[np->class]);

                                return;
                        }
                        con.ctype = np->type;
                                return;
                        }
                        con.ctype = np->type;


@@ -155,7 +205,7 @@ loop:
                                        con.crval = con.cival;
                                        break;
                                case TSTR:
                                        con.crval = con.cival;
                                        break;
                                case TSTR:

-                                       con.cpval = np->ptr[0];
+                                       con.cpval = (char *) np->ptr[0];

                                        break;
                                case NIL:
                                        con.ctype = NIL;
                                        break;
                                case NIL:
                                        con.ctype = NIL;


@@ -165,10 +215,10 @@ loop:
                        }
                        break;
                case T_CBINT:
                        }
                        break;
                case T_CBINT:

-                       con.crval = a8tol(cn[1]);
+                       con.crval = a8tol(cn->char_const.cptr);

                        goto restcon;
                case T_CINT:
                        goto restcon;
                case T_CINT:

-                       con.crval = atof(cn[1]);
+                       con.crval = atof(cn->char_const.cptr);

                        if (con.crval > MAXINT || con.crval < MININT) {
                                derror("Constant too large for this implementation");
                                con.crval = 0;
                        if (con.crval > MAXINT || con.crval < MININT) {
                                derror("Constant too large for this implementation");
                                con.crval = 0;


@@ -184,10 +234,10 @@ restcon:
                        break;
                case T_CFINT:
                        con.ctype = nl+TDOUBLE;
                        break;
                case T_CFINT:
                        con.ctype = nl+TDOUBLE;

-                       con.crval = atof(cn[1]);
+                       con.crval = atof(cn->char_const.cptr);

                        break;
                case T_CSTRNG:
                        break;
                case T_CSTRNG:

-                       cp = cn[1];
+                       cp = cn->char_const.cptr;

                        if (cp[1] == 0) {
                                con.ctype = nl+T1CHAR;
                                con.cival = cp[0];
                        if (cp[1] == 0) {
                                con.ctype = nl+T1CHAR;
                                con.cival = cp[0];


@@ -199,8 +249,9 @@ restcon:
                        break;
        }
        if (sgnd) {
                        break;
        }
        if (sgnd) {

-               if (isnta(con.ctype, "id"))
-                       derror("%s constants cannot be signed", nameof(con.ctype));
+               if (isnta((struct nl *) con.ctype, "id"))
+                       derror("%s constants cannot be signed",
+                               nameof((struct nl *) con.ctype));

                else {
                        if (negd)
                                con.crval = -con.crval;
                else {
                        if (negd)
                                con.crval = -con.crval;


@@ -210,42 +261,49 @@ restcon:
 }
 
 #ifndef PI0
 }
 
 #ifndef PI0

-isconst(r)
-       register int *r;
+isconst(cn)
+       register struct tnode *cn;

 {
 
 {
 

-       if (r == NIL)
+       if (cn == TR_NIL)

                return (1);
                return (1);

-       switch (r[0]) {
+       switch (cn->tag) {

                case T_MINUS:
                case T_MINUS:

-                       r[0] = T_MINUSC;
-                       r[1] = r[2];
-                       return (isconst(r[1]));
+                       cn->tag = T_MINUSC;
+                       cn->sign_const.number = 
+                                        cn->un_expr.expr;
+                       return (isconst(cn->sign_const.number));

                case T_PLUS:
                case T_PLUS:

-                       r[0] = T_PLUSC;
-                       r[1] = r[2];
-                       return (isconst(r[1]));
+                       cn->tag = T_PLUSC;
+                       cn->sign_const.number = 
+                                        cn->un_expr.expr;
+                       return (isconst(cn->sign_const.number));

                case T_VAR:
                case T_VAR:

-                       if (r[3] != NIL)
+                       if (cn->var_node.qual != TR_NIL)

                                return (0);
                                return (0);

-                       r[0] = T_ID;
-                       r[1] = r[2];
+                       cn->tag = T_ID;
+                       cn->char_const.cptr = 
+                                       cn->var_node.cptr;

                        return (1);
                case T_BINT:
                        return (1);
                case T_BINT:

-                       r[0] = T_CBINT;
-                       r[1] = r[2];
+                       cn->tag = T_CBINT;
+                       cn->char_const.cptr = 
+                               cn->const_node.cptr;

                        return (1);
                case T_INT:
                        return (1);
                case T_INT:

-                       r[0] = T_CINT;
-                       r[1] = r[2];
+                       cn->tag = T_CINT;
+                       cn->char_const.cptr = 
+                               cn->const_node.cptr;

                        return (1);
                case T_FINT:
                        return (1);
                case T_FINT:

-                       r[0] = T_CFINT;
-                       r[1] = r[2];
+                       cn->tag = T_CFINT;
+                       cn->char_const.cptr = 
+                               cn->const_node.cptr;

                        return (1);
                case T_STRNG:
                        return (1);
                case T_STRNG:

-                       r[0] = T_CSTRNG;
-                       r[1] = r[2];
+                       cn->tag = T_CSTRNG;
+                       cn->char_const.cptr = 
+                               cn->const_node.cptr;

                        return (1);
        }
        return (0);
                        return (1);
        }
        return (0);