X-Git-Url: https://git.subgeniuskitty.com/unix-history/.git/blobdiff_plain/99f6998fe72a5a1a384e1e7810c08750b30050b0..refs/tags/BSD-4_3_Net_2:/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 a91b8d5dea..d58b8c33a8 100644 --- 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.4 %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 "tree_ty.h" /* * Const enters the definitions @@ -12,8 +46,11 @@ static char sccsid[] = "@(#)const.c 1.4 %G%"; * part into the namelist. */ #ifndef PI1 -constbeg() +constbeg( lineofyconst , linenum ) + int lineofyconst, linenum; { + static bool const_order = FALSE; + static bool const_seen = FALSE; /* * this allows for multiple declaration @@ -25,30 +62,39 @@ constbeg() if (!progseen) level1(); + line = lineofyconst; if (parts[ cbn ] & (TPRT|VPRT|RPRT)) { if ( opt( 's' ) ) { standard(); + error("Constant declarations should precede type, var and routine declarations"); } else { - warning(); + if ( !const_order ) { + const_order = TRUE; + warning(); + error("Constant declarations should precede type, var and routine declarations"); + } } - error("Constant declarations should precede type, var and routine declarations"); } if (parts[ cbn ] & CPRT) { if ( opt( 's' ) ) { standard(); + error("All constants should be declared in one const part"); } else { - warning(); + if ( !const_seen ) { + const_seen = TRUE; + warning(); + error("All constants should be declared in one const part"); + } } - error("All constants should be declared in one const part"); } parts[ cbn ] |= CPRT; } #endif PI1 -const(cline, cid, cdecl) +constant(cline, cid, cdecl) int cline; register char *cid; - register int *cdecl; + register struct tnode *cdecl; { register struct nl *np; @@ -82,11 +128,16 @@ const(cline, cid, cdecl) 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; +# ifdef PC + if (cbn == 1 && con.ctype != NIL) { + stabconst(np); + } +# endif } #ifndef PI0 @@ -107,36 +158,36 @@ constend() * and scalars, the first two * being possibly signed. */ -gconst(r) - int *r; +gconst(c_node) + struct tnode *c_node; { register struct nl *np; - register *cn; + register struct tnode *cn; char *cp; int negd, sgnd; long ci; con.ctype = NIL; - cn = r; + cn = c_node; 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++; - cn = cn[1]; + cn = cn->sign_const.number; 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) { - 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; @@ -154,7 +205,7 @@ loop: con.crval = con.cival; break; case TSTR: - con.cpval = np->ptr[0]; + con.cpval = (char *) np->ptr[0]; break; case NIL: con.ctype = NIL; @@ -164,10 +215,10 @@ loop: } break; case T_CBINT: - con.crval = a8tol(cn[1]); + con.crval = a8tol(cn->char_const.cptr); 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; @@ -183,10 +234,10 @@ restcon: break; case T_CFINT: con.ctype = nl+TDOUBLE; - con.crval = atof(cn[1]); + con.crval = atof(cn->char_const.cptr); break; case T_CSTRNG: - cp = cn[1]; + cp = cn->char_const.cptr; if (cp[1] == 0) { con.ctype = nl+T1CHAR; con.cival = cp[0]; @@ -198,8 +249,9 @@ restcon: 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; @@ -209,42 +261,49 @@ restcon: } #ifndef PI0 -isconst(r) - register int *r; +isconst(cn) + register struct tnode *cn; { - if (r == NIL) + if (cn == TR_NIL) return (1); - switch (r[0]) { + switch (cn->tag) { 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: - 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: - if (r[3] != NIL) + if (cn->var_node.qual != TR_NIL) 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: - 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: - 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: - 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: - r[0] = T_CSTRNG; - r[1] = r[2]; + cn->tag = T_CSTRNG; + cn->char_const.cptr = + cn->const_node.cptr; return (1); } return (0);