1b85afe43Sbostic /*-
2*50877dcaSbostic * Copyright (c) 1980, 1993
3*50877dcaSbostic * The Regents of the University of California. All rights reserved.
4b85afe43Sbostic *
5b85afe43Sbostic * %sccs.include.redist.c%
6022cc7b6Sdist */
75bd37aebSpeter
80ed423eeSmckusick #ifndef lint
9*50877dcaSbostic static char sccsid[] = "@(#)type.c 8.1 (Berkeley) 06/06/93";
10b85afe43Sbostic #endif /* not lint */
115bd37aebSpeter
125bd37aebSpeter #include "whoami.h"
135bd37aebSpeter #include "0.h"
145bd37aebSpeter #include "tree.h"
155bd37aebSpeter #include "objfmt.h"
160ed423eeSmckusick #include "tree_ty.h"
175bd37aebSpeter
185bd37aebSpeter /*
195bd37aebSpeter * Type declaration part
205bd37aebSpeter */
210ed423eeSmckusick /*ARGSUSED*/
typebeg(lineofytype,r)2273314167Speter typebeg( lineofytype , r )
2373314167Speter int lineofytype;
245bd37aebSpeter {
2573314167Speter static bool type_order = FALSE;
2673314167Speter static bool type_seen = FALSE;
275bd37aebSpeter
285bd37aebSpeter /*
29dc3f34e8Speter * this allows for multiple
305bd37aebSpeter * declaration parts unless
315bd37aebSpeter * standard option has been
325bd37aebSpeter * specified.
335bd37aebSpeter * If routine segment is being
345bd37aebSpeter * compiled, do level one processing.
355bd37aebSpeter */
365bd37aebSpeter
375bd37aebSpeter #ifndef PI1
385bd37aebSpeter if (!progseen)
395bd37aebSpeter level1();
4073314167Speter line = lineofytype;
41dc3f34e8Speter if ( parts[ cbn ] & ( VPRT | RPRT ) ) {
425bd37aebSpeter if ( opt( 's' ) ) {
435bd37aebSpeter standard();
44dc3f34e8Speter error("Type declarations should precede var and routine declarations");
4573314167Speter } else {
4673314167Speter if ( !type_order ) {
4773314167Speter type_order = TRUE;
4873314167Speter warning();
4973314167Speter error("Type declarations should precede var and routine declarations");
5073314167Speter }
5173314167Speter }
52dc3f34e8Speter }
53dc3f34e8Speter if (parts[ cbn ] & TPRT) {
54dc3f34e8Speter if ( opt( 's' ) ) {
555bd37aebSpeter standard();
56dc3f34e8Speter error("All types should be declared in one type part");
5773314167Speter } else {
5873314167Speter if ( !type_seen ) {
5973314167Speter type_seen = TRUE;
6073314167Speter warning();
6173314167Speter error("All types should be declared in one type part");
6273314167Speter }
6373314167Speter }
645bd37aebSpeter }
65dc3f34e8Speter parts[ cbn ] |= TPRT;
665bd37aebSpeter #endif
675bd37aebSpeter /*
685bd37aebSpeter * Forechain is the head of a list of types that
695bd37aebSpeter * might be self referential. We chain them up and
705bd37aebSpeter * process them later.
715bd37aebSpeter */
725bd37aebSpeter forechain = NIL;
735bd37aebSpeter #ifdef PI0
745bd37aebSpeter send(REVTBEG);
755bd37aebSpeter #endif
765bd37aebSpeter }
775bd37aebSpeter
type(tline,tid,tdecl)785bd37aebSpeter type(tline, tid, tdecl)
795bd37aebSpeter int tline;
805bd37aebSpeter char *tid;
810ed423eeSmckusick register struct tnode *tdecl;
825bd37aebSpeter {
835bd37aebSpeter register struct nl *np;
849e6c2aeeSmckusick struct nl *tnp;
855bd37aebSpeter
865bd37aebSpeter np = gtype(tdecl);
875bd37aebSpeter line = tline;
889e6c2aeeSmckusick tnp = defnl(tid, TYPE, np, 0);
895bd37aebSpeter #ifndef PI0
900ed423eeSmckusick enter(tnp)->nl_flags |= (char) NMOD;
915bd37aebSpeter #else
920ed423eeSmckusick (void) enter(tnp);
935bd37aebSpeter send(REVTYPE, tline, tid, tdecl);
945bd37aebSpeter #endif
955bd37aebSpeter
965bd37aebSpeter #ifdef PC
97b0d0a504Speter if (cbn == 1) {
989e6c2aeeSmckusick stabgtype(tid, np, line);
999e6c2aeeSmckusick } else {
1009e6c2aeeSmckusick stabltype(tid, np);
101b0d0a504Speter }
1025bd37aebSpeter #endif PC
1035bd37aebSpeter
1045bd37aebSpeter # ifdef PTREE
1055bd37aebSpeter {
1065bd37aebSpeter pPointer Type = TypeDecl( tid , tdecl );
1075bd37aebSpeter pPointer *Types;
1085bd37aebSpeter
1095bd37aebSpeter pSeize( PorFHeader[ nesting ] );
1105bd37aebSpeter Types = &( pDEF( PorFHeader[ nesting ] ).PorFTypes );
1115bd37aebSpeter *Types = ListAppend( *Types , Type );
1125bd37aebSpeter pRelease( PorFHeader[ nesting ] );
1135bd37aebSpeter }
1145bd37aebSpeter # endif
1155bd37aebSpeter }
1165bd37aebSpeter
typeend()1175bd37aebSpeter typeend()
1185bd37aebSpeter {
1195bd37aebSpeter
1205bd37aebSpeter #ifdef PI0
1215bd37aebSpeter send(REVTEND);
1225bd37aebSpeter #endif
1235bd37aebSpeter foredecl();
1245bd37aebSpeter }
1255bd37aebSpeter
1265bd37aebSpeter /*
1275bd37aebSpeter * Return a type pointer (into the namelist)
1285bd37aebSpeter * from a parse tree for a type, building
1295bd37aebSpeter * namelist entries as needed.
1305bd37aebSpeter */
1315bd37aebSpeter struct nl *
gtype(r)1325bd37aebSpeter gtype(r)
1330ed423eeSmckusick register struct tnode *r;
1345bd37aebSpeter {
1355bd37aebSpeter register struct nl *np;
136a8bb44d0Smckusic register int oline;
1370ed423eeSmckusick #ifdef OBJ
138a8bb44d0Smckusic long w;
1390ed423eeSmckusick #endif
1405bd37aebSpeter
1410ed423eeSmckusick if (r == TR_NIL)
1420ed423eeSmckusick return (NLNIL);
1435bd37aebSpeter oline = line;
1440ed423eeSmckusick if (r->tag != T_ID)
1450ed423eeSmckusick oline = line = r->lined.line_no;
1460ed423eeSmckusick switch (r->tag) {
1475bd37aebSpeter default:
1485bd37aebSpeter panic("type");
1495bd37aebSpeter case T_TYID:
1500ed423eeSmckusick r = (struct tnode *) (&(r->tyid_node.line_no));
1515bd37aebSpeter case T_ID:
1520ed423eeSmckusick np = lookup(r->char_const.cptr);
1530ed423eeSmckusick if (np == NLNIL)
1545bd37aebSpeter break;
1555bd37aebSpeter if (np->class != TYPE) {
1565bd37aebSpeter #ifndef PI1
1570ed423eeSmckusick error("%s is a %s, not a type as required", r->char_const.cptr, classes[np->class]);
1585bd37aebSpeter #endif
1590ed423eeSmckusick np = NLNIL;
1605bd37aebSpeter break;
1615bd37aebSpeter }
1625bd37aebSpeter np = np->type;
1635bd37aebSpeter break;
1645bd37aebSpeter case T_TYSCAL:
1655bd37aebSpeter np = tyscal(r);
1665bd37aebSpeter break;
1670ed423eeSmckusick case T_TYCRANG:
1680ed423eeSmckusick np = tycrang(r);
1690ed423eeSmckusick break;
1705bd37aebSpeter case T_TYRANG:
1715bd37aebSpeter np = tyrang(r);
1725bd37aebSpeter break;
1735bd37aebSpeter case T_TYPTR:
1740ed423eeSmckusick np = defnl((char *) 0, PTR, NLNIL, 0 );
1750ed423eeSmckusick np -> ptr[0] = ((struct nl *) r->ptr_ty.id_node);
1765bd37aebSpeter np->nl_next = forechain;
1775bd37aebSpeter forechain = np;
1785bd37aebSpeter break;
1795bd37aebSpeter case T_TYPACK:
1800ed423eeSmckusick np = gtype(r->comp_ty.type);
1815bd37aebSpeter break;
1820ed423eeSmckusick case T_TYCARY:
1835bd37aebSpeter case T_TYARY:
1845bd37aebSpeter np = tyary(r);
1855bd37aebSpeter break;
1865bd37aebSpeter case T_TYREC:
1870ed423eeSmckusick np = tyrec(r->comp_ty.type, 0);
1885bd37aebSpeter # ifdef PTREE
1895bd37aebSpeter /*
1905bd37aebSpeter * mung T_TYREC[3] to point to the record
1915bd37aebSpeter * for RecTCopy
1925bd37aebSpeter */
1930ed423eeSmckusick r->comp_ty.nl_entry = np;
1945bd37aebSpeter # endif
1955bd37aebSpeter break;
1965bd37aebSpeter case T_TYFILE:
1970ed423eeSmckusick np = gtype(r->comp_ty.type);
1980ed423eeSmckusick if (np == NLNIL)
1995bd37aebSpeter break;
2005bd37aebSpeter #ifndef PI1
2015bd37aebSpeter if (np->nl_flags & NFILES)
2025bd37aebSpeter error("Files cannot be members of files");
2035bd37aebSpeter #endif
2040ed423eeSmckusick np = defnl((char *) 0, FILET, np, 0);
2055bd37aebSpeter np->nl_flags |= NFILES;
2065bd37aebSpeter break;
2075bd37aebSpeter case T_TYSET:
2080ed423eeSmckusick np = gtype(r->comp_ty.type);
2090ed423eeSmckusick if (np == NLNIL)
2105bd37aebSpeter break;
2115bd37aebSpeter if (np->type == nl+TDOUBLE) {
2125bd37aebSpeter #ifndef PI1
2135bd37aebSpeter error("Set of real is not allowed");
2145bd37aebSpeter #endif
2150ed423eeSmckusick np = NLNIL;
2165bd37aebSpeter break;
2175bd37aebSpeter }
2185bd37aebSpeter if (np->class != RANGE && np->class != SCAL) {
2195bd37aebSpeter #ifndef PI1
2205bd37aebSpeter error("Set type must be range or scalar, not %s", nameof(np));
2215bd37aebSpeter #endif
2220ed423eeSmckusick np = NLNIL;
2235bd37aebSpeter break;
2245bd37aebSpeter }
2255bd37aebSpeter #ifndef PI1
2265bd37aebSpeter if (width(np) > 2)
2275bd37aebSpeter error("Implementation restriction: sets must be indexed by 16 bit quantities");
2285bd37aebSpeter #endif
2290ed423eeSmckusick np = defnl((char *) 0, SET, np, 0);
2305bd37aebSpeter break;
2315bd37aebSpeter }
2325bd37aebSpeter line = oline;
2339e6c2aeeSmckusick #ifndef PC
2340ed423eeSmckusick w = lwidth(np);
2355bd37aebSpeter if (w >= TOOMUCH) {
236a8bb44d0Smckusic error("Storage requirement of %s exceeds the implementation limit of %D by %D bytes",
2370ed423eeSmckusick nameof(np), (char *) (long)(TOOMUCH-1), (char *) (long)(w-TOOMUCH+1));
2380ed423eeSmckusick np = NLNIL;
2395bd37aebSpeter }
2405be063adSpeter #endif
2415bd37aebSpeter return (np);
2425bd37aebSpeter }
2435bd37aebSpeter
2445bd37aebSpeter /*
2455bd37aebSpeter * Scalar (enumerated) types
2465bd37aebSpeter */
2470ed423eeSmckusick struct nl *
tyscal(r)2485bd37aebSpeter tyscal(r)
2490ed423eeSmckusick struct tnode *r; /* T_TYSCAL */
2505bd37aebSpeter {
2515bd37aebSpeter register struct nl *np, *op, *zp;
2520ed423eeSmckusick register struct tnode *v;
2535bd37aebSpeter int i;
2545bd37aebSpeter
2550ed423eeSmckusick np = defnl((char *) 0, SCAL, NLNIL, 0);
2565bd37aebSpeter np->type = np;
2570ed423eeSmckusick v = r->comp_ty.type;
2580ed423eeSmckusick if (v == TR_NIL)
2590ed423eeSmckusick return (NLNIL);
2605bd37aebSpeter i = -1;
2615bd37aebSpeter zp = np;
2620ed423eeSmckusick for (; v != TR_NIL; v = v->list_node.next) {
2630ed423eeSmckusick op = enter(defnl((char *) v->list_node.list, CONST, np, ++i));
2645bd37aebSpeter #ifndef PI0
2655bd37aebSpeter op->nl_flags |= NMOD;
2665bd37aebSpeter #endif
2675bd37aebSpeter op->value[1] = i;
2685bd37aebSpeter zp->chain = op;
2695bd37aebSpeter zp = op;
2705bd37aebSpeter }
2715bd37aebSpeter np->range[1] = i;
2725bd37aebSpeter return (np);
2735bd37aebSpeter }
2745bd37aebSpeter
2755bd37aebSpeter /*
2760ed423eeSmckusick * Declare a subrange for conformant arrays.
2770ed423eeSmckusick */
2780ed423eeSmckusick struct nl *
tycrang(r)2790ed423eeSmckusick tycrang(r)
2800ed423eeSmckusick register struct tnode *r;
2810ed423eeSmckusick {
2820ed423eeSmckusick register struct nl *p, *op, *tp;
2830ed423eeSmckusick
2840ed423eeSmckusick tp = gtype(r->crang_ty.type);
2850ed423eeSmckusick if ( tp == NLNIL )
2860ed423eeSmckusick return (NLNIL);
2870ed423eeSmckusick /*
2880ed423eeSmckusick * Just make a new type -- the lower and upper bounds must be
2890ed423eeSmckusick * set by params().
2900ed423eeSmckusick */
2910ed423eeSmckusick p = defnl ( 0, CRANGE, tp, 0 );
2920ed423eeSmckusick return(p);
2930ed423eeSmckusick }
2940ed423eeSmckusick
2950ed423eeSmckusick /*
2965bd37aebSpeter * Declare a subrange.
2975bd37aebSpeter */
2980ed423eeSmckusick struct nl *
tyrang(r)2995bd37aebSpeter tyrang(r)
3000ed423eeSmckusick register struct tnode *r; /* T_TYRANG */
3015bd37aebSpeter {
3025bd37aebSpeter register struct nl *lp, *hp;
3035bd37aebSpeter double high;
3045bd37aebSpeter int c, c1;
3055bd37aebSpeter
3060ed423eeSmckusick gconst(r->rang_ty.const2);
3075bd37aebSpeter hp = con.ctype;
3085bd37aebSpeter high = con.crval;
3090ed423eeSmckusick gconst(r->rang_ty.const1);
3105bd37aebSpeter lp = con.ctype;
3110ed423eeSmckusick if (lp == NLNIL || hp == NLNIL)
3120ed423eeSmckusick return (NLNIL);
3135bd37aebSpeter if (norange(lp) || norange(hp))
3140ed423eeSmckusick return (NLNIL);
3155bd37aebSpeter c = classify(lp);
3165bd37aebSpeter c1 = classify(hp);
3175bd37aebSpeter if (c != c1) {
3185bd37aebSpeter #ifndef PI1
3195bd37aebSpeter error("Can't mix %ss and %ss in subranges", nameof(lp), nameof(hp));
3205bd37aebSpeter #endif
3210ed423eeSmckusick return (NLNIL);
3225bd37aebSpeter }
3235bd37aebSpeter if (c == TSCAL && scalar(lp) != scalar(hp)) {
3245bd37aebSpeter #ifndef PI1
3255bd37aebSpeter error("Scalar types must be identical in subranges");
3265bd37aebSpeter #endif
3270ed423eeSmckusick return (NLNIL);
3285bd37aebSpeter }
3295bd37aebSpeter if (con.crval > high) {
3305bd37aebSpeter #ifndef PI1
3315bd37aebSpeter error("Range lower bound exceeds upper bound");
3325bd37aebSpeter #endif
3330ed423eeSmckusick return (NLNIL);
3345bd37aebSpeter }
3350ed423eeSmckusick lp = defnl((char *) 0, RANGE, hp->type, 0);
3365bd37aebSpeter lp->range[0] = con.crval;
3375bd37aebSpeter lp->range[1] = high;
3385bd37aebSpeter return (lp);
3395bd37aebSpeter }
3405bd37aebSpeter
norange(p)3415bd37aebSpeter norange(p)
3425bd37aebSpeter register struct nl *p;
3435bd37aebSpeter {
3445bd37aebSpeter if (isa(p, "d")) {
3455bd37aebSpeter #ifndef PI1
3465bd37aebSpeter error("Subrange of real is not allowed");
3475bd37aebSpeter #endif
3485bd37aebSpeter return (1);
3495bd37aebSpeter }
3505bd37aebSpeter if (isnta(p, "bcsi")) {
3515bd37aebSpeter #ifndef PI1
3525bd37aebSpeter error("Subrange bounds must be Boolean, character, integer or scalar, not %s", nameof(p));
3535bd37aebSpeter #endif
3545bd37aebSpeter return (1);
3555bd37aebSpeter }
3565bd37aebSpeter return (0);
3575bd37aebSpeter }
3585bd37aebSpeter
3595bd37aebSpeter /*
3605bd37aebSpeter * Declare arrays and chain together the dimension specification
3615bd37aebSpeter */
3625bd37aebSpeter struct nl *
tyary(r)3635bd37aebSpeter tyary(r)
3640ed423eeSmckusick struct tnode *r;
3655bd37aebSpeter {
3665bd37aebSpeter struct nl *np;
3670ed423eeSmckusick register struct tnode *tl, *s;
3685bd37aebSpeter register struct nl *tp, *ltp;
3690ed423eeSmckusick int i, n;
3705bd37aebSpeter
3710ed423eeSmckusick s = r;
3720ed423eeSmckusick /* Count the dimensions */
3730ed423eeSmckusick for (n = 0; s->tag == T_TYARY || s->tag == T_TYCARY;
3740ed423eeSmckusick s = s->ary_ty.type, n++)
3750ed423eeSmckusick /* NULL STATEMENT */;
3760ed423eeSmckusick tp = gtype(s);
3770ed423eeSmckusick if (tp == NLNIL)
3780ed423eeSmckusick return (NLNIL);
3790ed423eeSmckusick np = defnl((char *) 0, ARRAY, tp, 0);
3805bd37aebSpeter np->nl_flags |= (tp->nl_flags) & NFILES;
3815bd37aebSpeter ltp = np;
3825bd37aebSpeter i = 0;
3830ed423eeSmckusick for (s = r; s->tag == T_TYARY || s->tag == T_TYCARY;
3840ed423eeSmckusick s = s->ary_ty.type) {
3850ed423eeSmckusick for (tl = s->ary_ty.type_list; tl != TR_NIL; tl=tl->list_node.next){
3860ed423eeSmckusick tp = gtype(tl->list_node.list);
3870ed423eeSmckusick if (tp == NLNIL) {
3880ed423eeSmckusick np = NLNIL;
3895bd37aebSpeter continue;
3905bd37aebSpeter }
3910ed423eeSmckusick if ((tp->class == RANGE || tp->class == CRANGE) &&
3920ed423eeSmckusick tp->type == nl+TDOUBLE) {
3935bd37aebSpeter #ifndef PI1
3945bd37aebSpeter error("Index type for arrays cannot be real");
3955bd37aebSpeter #endif
3960ed423eeSmckusick np = NLNIL;
3975bd37aebSpeter continue;
3985bd37aebSpeter }
3990ed423eeSmckusick if (tp->class != RANGE && tp->class != SCAL && tp->class !=CRANGE){
4005bd37aebSpeter #ifndef PI1
4015bd37aebSpeter error("Array index type is a %s, not a range or scalar as required", classes[tp->class]);
4025bd37aebSpeter #endif
4030ed423eeSmckusick np = NLNIL;
4045bd37aebSpeter continue;
4055bd37aebSpeter }
4065be063adSpeter #ifndef PC
4075bd37aebSpeter if (tp->class == RANGE && bytes(tp->range[0], tp->range[1]) > 2) {
4085bd37aebSpeter #ifndef PI1
4095bd37aebSpeter error("Value of dimension specifier too large or small for this implementation");
4105bd37aebSpeter #endif
4115bd37aebSpeter continue;
4125bd37aebSpeter }
4135be063adSpeter #endif
4140ed423eeSmckusick if (tp->class != CRANGE)
4155bd37aebSpeter tp = nlcopy(tp);
4165bd37aebSpeter i++;
4175bd37aebSpeter ltp->chain = tp;
4185bd37aebSpeter ltp = tp;
4195bd37aebSpeter }
4200ed423eeSmckusick }
4210ed423eeSmckusick if (np != NLNIL)
4225bd37aebSpeter np->value[0] = i;
4235bd37aebSpeter return (np);
4245bd37aebSpeter }
4255bd37aebSpeter
4265bd37aebSpeter /*
4275bd37aebSpeter * Delayed processing for pointers to
4285bd37aebSpeter * allow self-referential and mutually
4295bd37aebSpeter * recursive pointer constructs.
4305bd37aebSpeter */
foredecl()4315bd37aebSpeter foredecl()
4325bd37aebSpeter {
4330ed423eeSmckusick register struct nl *p;
4345bd37aebSpeter
4350ed423eeSmckusick for (p = forechain; p != NLNIL; p = p->nl_next) {
4365bd37aebSpeter if (p->class == PTR && p -> ptr[0] != 0)
4375bd37aebSpeter {
4380ed423eeSmckusick p->type = gtype((struct tnode *) p -> ptr[0]);
4395bd37aebSpeter # ifdef PTREE
4405bd37aebSpeter {
4415bd37aebSpeter if ( pUSE( p -> inTree ).PtrTType == pNIL ) {
4425bd37aebSpeter pPointer PtrTo = tCopy( p -> ptr[0] );
4435bd37aebSpeter
4445bd37aebSpeter pDEF( p -> inTree ).PtrTType = PtrTo;
4455bd37aebSpeter }
4465bd37aebSpeter }
4475bd37aebSpeter # endif
4489e6c2aeeSmckusick # ifdef PC
4499e6c2aeeSmckusick fixfwdtype(p);
4509e6c2aeeSmckusick # endif
4515bd37aebSpeter p -> ptr[0] = 0;
4525bd37aebSpeter }
4535bd37aebSpeter }
4545bd37aebSpeter }
455