prdecl.c

来自「<B>Digital的Unix操作系统VAX 4.2源码</B>」· C语言 代码 · 共 1,179 行 · 第 1/2 页

	else
	    {
	    tokenahead = 1;
	    strcpy(scandata.si_name,holdname);
	    st->st_tipe = USERTYPE;
	    if (st->st_dstruct == NOSTRUCT)
		st->st_dstruct = UDEFS;
	    st->st_uptr = findany(scandata.si_name);
	    /*
	     * If ptr is to an object that is not defined yet, then create
	     * a dummy stentry to store the objects name.
	     */
	    if (st->st_uptr == NULL)
		{
		if (st->st_dstruct == PTRS)
		    {
		    st->st_uptr = getstentry();
		    st->st_uptr->st_name = getname(scandata.si_idlen);
		    strcpy(st->st_uptr->st_name, scandata.si_name);
		    fprintf(stderr, "\"%s\", line %d: Warning: Pointer to an object that is not defined yet.\n", currfile, linecounter);
		    fprintf(stderr, "     This is illegal in C.\n");

		    }
		else
		    myexit(1,scandata.si_name);
		}
	    }
	break;
    case LEFTPAREN:		/* Enumerated type */
	st->st_dstruct = UDEFS;
	st->st_tipe = ENUMTY;
	scanner(0);		/* get id */
	if (nexttoken != IDENT)
	    myexit(2,"identifier");
	i = 1;
	hold = st;
	st = getstentry();
	st->st_name = getname(scandata.si_idlen);
	strcpy(st->st_name, scandata.si_name);
	st->st_class = CONSTC;
	st->st_tipe = ENUMTY;
	st->st_cval = i-1;
	st->st_enumptr = hold;	/* pt back to enum type */
	hold->st_uptr = st;	/* pt enum type to 1st const */
	addsymbol(st);
	scanner(0);
	for (; nexttoken == COMMA ;)
	    {
	    scanner(0);			/* get id */
	    if (nexttoken != IDENT)
		myexit(2,"identifier");
	    i++;
	    st = getstentry();
	    st->st_name = getname(scandata.si_idlen);
	    strcpy(st->st_name, scandata.si_name);
	    st->st_class = CONSTC;
	    st->st_tipe = ENUMTY;
	    st->st_cval = i-1;
	    st->st_enumptr = hold;
	    addsymbol(st);
	    scanner(0);			/* comma or left paren */
	    }
	if (nexttoken != RIGHTPAREN)
	    myexit(2,")");
	hold->st_numdims = i;
	break;
    case NUMCONST:		/* SUBRANGE */
    case CHARCONST:
	st->st_dstruct = SUBRANGES;
	getrange(st,1);		/* 1=lower bound */
	scanner(0);		/* get .. */
	scanner(0);		/* get next const */
	if (nexttoken == MINUS || nexttoken == PLUS)
	    scanner(1);
	getrange(st,0);		/* 0=upper bound */
	break;
    default:
	return(0);
    }
    return(1);
}


/*
 * <array_type> ::= 
 *       [ packed ] array [ <simple_type> {,<simple_type> *} ] of <simple_type>
 *                        ^                                  ^       ^
 *                                                                   |
 *					          should really be "datatype"
 *
 * RESTRICTIONS:
 *   1. We only deal with the upper bound since all C arrays start at 0 and go
 *	up.  Thus if negative Pascal Bounds are used, they are ignored!
 *   2. We only handle arrays of simple types.
 */

arraytype(st)
    struct stentry *st;
{
    struct pairs *pr, *newpr;
    struct stentry *stptr;
    int numdims = 1;

    if ((nexttoken != ARRAYT) && (nexttoken != VARYING))
	return(0);
    else {
	scanner(0); 	/* get [ */
	if (nexttoken != LEFTBRACKET)
	    myexit(2,"[");
	else {
	    st->st_dstruct = ARRS;
	    for (;;)
		{
		scanner(1);	/* 1st bound (1 for no reals, despite '.') */
		if (nexttoken == MINUS)
		    scanner(1);
		holdtoken = nexttoken;
		scanner(0);	/* .. or , or ] */
		switch (nexttoken) {
		    case DOTDOT:
			scanner(0);	/* upper bound */
			if (nexttoken == MINUS)
			    scanner(1);
			holdtoken = nexttoken;
			scanner(0);	/* , or ] */
			/* fall into */
		    case COMMA:
		    case RIGHTBRACKET:
			newpr = getpairs();
			if (numdims == 1)
			    st->st_bounds = newpr;
			else
			    pr->pr_next = newpr;
			pr = newpr;
			switch (holdtoken) {
			    case IDENT:
				if ((stptr = findany(scandata.si_name)) == NULL)
				    myexit(1,scandata.si_name);
				pr->pr_uuser = stptr;
				if (stptr->st_class == CONSTC)
				    pr->pr_upper = -1;  /* flag to use const name */
				else if (stptr->st_bounds != NULL)
					 {
				         if (stptr->st_bounds->pr_uuser != NULL && 
					     stptr->st_bounds->pr_uuser->st_class == CONSTC)
					     {
					     pr->pr_upper = -1;  /* flag to use const name */
					     pr->pr_uuser = stptr->st_bounds->pr_uuser;
					     }
					 else
					     pr->pr_upper = stptr->st_bounds->pr_upper + 1;
					 }
				else if (stptr->st_dstruct == UDEFS &&
				         stptr->st_tipe == ENUMTY)
					 pr->pr_upper = stptr->st_numdims;
				break;
			    case CHARCONST:
				pr->pr_upper = scandata.si_name[0] + 1;
				break;
			    case NUMCONST:
				pr->pr_upper = scandata.si_cvalue + 1;
				break;
			    case BOOLEANT:
				pr->pr_upper = 2;
				break;
			    default:
				myexit(3,"bad array dimension");
			    }	/* switch 2 */
			break;
		    default:
			myexit(3,"bad array dimension");
		    }	/* switch 1 */
		if (nexttoken == RIGHTBRACKET)
		    break;
		numdims++;
		}   /* for */
	    st->st_numdims = numdims;
	    scanner(0);
	    if (nexttoken != OFT)
		myexit(2,"of");
	    scanner(0);	/* type */
	    if (!simpletype(st))
		{
		st->st_tipe = INTTY;
		fprintf(stderr, "\"%s\", line %d: Warning: Array of complex type not supported, using integer\n", currfile, linecounter);
		while (nexttoken != SEMICOLON)
		    scanner(0);
		tokenahead = 1;
		}
	    }	/* nexttoken == LEFTBRACKET */
	}   /* nexttoken == ARRAYT */
}


/*
 * Getrange.  Get subrange bounds.
 * Call with st = the stentry for the type id.  The pairs record will
 *   be set up here.
 */

getrange(st, lower)
    struct stentry *st;
    char lower;			/* 1 = getting lower, else upper */
{
    struct pairs *pr;

    if (lower)
	{
	pr = getpairs();
	st->st_bounds = pr;
	}
    else
	pr = st->st_bounds;
    switch (nexttoken) {
	case NUMCONST:
	    if (lower)
		{
		st->st_tipe = INTTY;		/* Base type of subrange */
		pr->pr_lower = scandata.si_cvalue;
		pr->pr_bound = INTTY;
		}
	    else
		pr->pr_upper = scandata.si_cvalue;
	    break;
	case CHARCONST:
	    if (lower)
		{
		st->st_tipe = CHARTY;		/* Base type of subrange */
		pr->pr_lower = scandata.si_name[0];
		pr->pr_bound = CHARTY;
		}
	    else
		pr->pr_upper = scandata.si_name[0];
	    break;
	case IDENT:
	    if (lower)
		{
		pr->pr_luser = findany(scandata.si_name);
		if (pr->pr_luser == NULL)
		    myexit(1,scandata.si_name);
		if (pr->pr_luser->st_tipe == ENUMTY &&
		    pr->pr_luser->st_class == CONSTC)
		    {
		    st->st_tipe = USERTYPE;
		    st->st_uptr = pr->pr_luser->st_enumptr;
		    }
		else
		    st->st_tipe = pr->pr_luser->st_tipe; /* Base type of subrange */
		pr->pr_bound = USERTYPE;
		}
	    else
		{
		pr->pr_uuser = findany(scandata.si_name);
		if (pr->pr_uuser == NULL)
		    myexit(1,scandata.si_name);
		pr->pr_upper = pr->pr_uuser->st_cval;	/* so value can be
							   obtained for
							   array bound*/
		}
	    break;
	default:
	    myexit(3,"bad subrange bound");
    };
}

fieldlist(st,varec)
    struct stentry *st;
    int varec;			/* true if in varient record */
{
    int numdims = 0;		/* syntactically legal to have no fields */
    struct stentry *rechead;	/* hold ptr to fill in # of fields */
    struct stentry *secthead;	/* head of a sect of fields: f1,f2: type; */
    struct stentry *sect;	/* to build up this "section" */
    struct stentry *save_st;	/* save ptr to prior field & fill in "st_next" */
    struct stentry *dupst;	/* to fill out dupvar st_entryies */
    int undims = 0;		/* number of fields in varient record (union) */
    struct stentry *unhead;	/* hold ptr to union field */
    char holdname[LINELENGTH];	/* hold last symbol name for 'look-ahead' */
    char lookahead = 0;		/* set true for varient record look ahead */
    char union_name[LINELENGTH]; /* name of union to pass to 'dodefines' */

    rechead = st;
    scanner(0);			/* get 1st field id */
    do
	{
	secthead = NULL;
	do
	    {
	    if (nexttoken != IDENT)
		if ((nexttoken == ENDT) || (varec && nexttoken == RIGHTPAREN))
		    {
		    rechead->st_numdims = numdims;
		    return(1);
		    }
		else
		    if (nexttoken == CASET)
			goto docase;
		    else
			myexit(2,"end");
	    numdims++;
	    save_st = st;
	    st = getstentry();
	    inittvf(st);

	    addsymbol(st);	/* ASDEP did this in-line here */

	    /*
	     * If this is the first field name of a given field stmt,
	     *   then set up "secthead" and link "st_next".
	     * Else,
	     *   string together constructs like f1, f2, f3: type;
	     *   with "st_dupvar".  We don't want the "st_next" link
	     *   between "dupvar's" (because "st_next" is the way to
	     *   get from a section head to a nested record).
	     */
	    if (secthead == NULL)
		{
		secthead = st;
		sect = st;
		if (save_st->st_next == NULL)
		    save_st->st_next = st;
		}
	    else
		{
		sect->st_dupvar = st;
		sect = st;
		}

	    st->st_name = getname(scandata.si_idlen+1);	/* +1 for "u" in unions */
	    if (varec)
		strcpy(st->st_name, "u");
	    else
		strcpy(st->st_name, "");
	    strcat(st->st_name, scandata.si_name);
	    st->st_class = FIELDC;
	    savecmt = 0;
	    /*
	     * If we were a token ahead from varient record look-ahead (below)
	     * then we've already scanned the ":" so just set nexttoken.
	     */
	    if (lookahead)
		{
		nexttoken = COLON;
		lookahead = 0;
		}
	    else
		scanner(0);		/* get next token */
	    if (nexttoken == COMMA)
		scanner(0);
	    }
	while (nexttoken != COLON);
	
	scanner(0);
	/*
	 * Fill in data type for "head" variable in this `section':
	 *    eg. f1, f2, f3: data-type;
	 */
	if (!datatype(secthead))
	    myexit(3,"data type not recognized");
	/* 
	 * Make dupvar's "st_next" field's point to same place as
	 * the secthead's st_next.  Needed to find subfields under the
	 * dupvar, if the dupvar is of type record and get used in a
	 * "with" stmt.
	 *
	 * Also save other "type" fields for help in processing "with"
	 * statements.
	 */
	for (dupst = secthead->st_dupvar; dupst != NULL; dupst = dupst->st_dupvar)
	    {
	    dupst->st_next = secthead->st_next;
	    dupst->st_lexlev = secthead->st_lexlev;
	    dupst->st_dstruct = secthead->st_dstruct;
	    dupst->st_tipe = secthead->st_tipe;
	    dupst->st_class = secthead->st_class;
	    dupst->st_uptr = secthead->st_uptr;
	    dupst->st_numdims = secthead->st_numdims;
	    dupst->st_bounds = secthead->st_bounds;
	    }

	scanner(0);		/* get SEMI (or "end" or ")" ) */
	if (nexttoken == SEMICOLON)
	    {
	    savecmt = 1;
	    scanner(0);		/* get next token (IDENT or END) */
	    savecmt = 0;
	    if (nexttoken == COMMENT)
		{
		secthead->st_cmt = scandata.si_cmtptr;
		savecmt = 0;
		scanner(0);
		}
	    }
docase:
	if (nexttoken == CASET)
	    {	/* handle varient field of record */
	    scanner(0);
	    /*
	     * Verify type of case variable
	     */
	    switch (nexttoken) {
	    case BOOLEANT:
	    case CHART:
	    case INTEGERT:
	    case IDENT:
		 break;
	    default:
		 myexit(2,"scaler type");
		 break;
	    }
	    /*
	     * Look ahead to distinguish between the 2 legal formats:
	     *     case var: type of
	     *     case scaler-type of
	     */
	    strcpy(holdname,scandata.si_name);
	    scanner(0);			/* look ahead */
	    if (nexttoken != OFT)
		if (nexttoken == COLON)
		    {
		    nexttoken = IDENT;
		    strcpy(scandata.si_name,holdname);
		    lookahead = 1;
		    }
		else
		    myexit(2,":");
	    }
	}
    while (nexttoken == IDENT);

    /*
     * Handle fields within varient part of a record.
     * In C we will have a union with each Pascal "tag" section
     * making a struct within the union.
     */
    if (nexttoken == OFT)
	{
	numdims++;
	save_st = st;
	/*
	 * Create C union, named "un"
	 */
	st = getstentry();
	inittvf(st);
	if (save_st->st_next == NULL)
	    save_st->st_next = st;
	st->st_name = getname(5);
	strcpy(st->st_name, "un_");
	itoa(varec,scandata.si_name);
	strcat(st->st_name, scandata.si_name);
	st->st_class = FIELDC;
	st->st_dstruct = RECORDS;
	st->st_tipe = UNIONTY;
	addsymbol(st);
	unhead = st;
	undims = 0;
	lexlev++;
	scanner(0);
	varec++;
	/*
	 * Loop until end of Pascal varient record.
	 * Each Pascal tag field section, will be a struct in C.
	 * These structs get dummy names: un1, un2, un3, etc.
	 */
	while ((nexttoken != ENDT) && (!(varec && nexttoken == RIGHTPAREN)))
	    {
	    while (nexttoken != LEFTPAREN)
		scanner(0);
	    undims++;
	    st = getstentry();
	    inittvf(st);
	    if (unhead->st_next == NULL)
		unhead->st_next = st;
	    st->st_name = getname(6);
	    strcpy(st->st_name, "un");
	    itoa(undims,scandata.si_name);
	    strcat(st->st_name, scandata.si_name);
	    st->st_class = FIELDC;
	    st->st_dstruct = RECORDS;
	    addsymbol(st);
	    lexlev++;
	    /*
	     * Recursive call to fieldlist to get the fields under
	     * this varient tag section.
	     */
	    fieldlist(st,varec);
	    stindex[lexlev] = NULL;	/* terminate inner level */
	    lexlev--;
	    scanner(0);		/* get ";" or "end" */
	    if (nexttoken == SEMICOLON)
		{
		savecmt = 1;
		scanner(0);
		savecmt = 0;
		if (nexttoken == COMMENT)
		    {
		    st->st_cmt = scandata.si_cmtptr;
		    scanner(0);
		    }
		}
	    }	/* end while nexttoken != ENDT */
	unhead->st_numdims = undims;
	stindex[lexlev] = NULL;  /* terminate union level */
	lexlev--;
	/*
	 * If we finished the highest lexic level varient (varec == 1)
	 * then make stentries for "defines".  This way the added C union &
	 * inner struct levels will be transparent to the program code.
	 */
	if (varec == 1)
	    {
	    for (st = rechead->st_next; st->st_tipe != UNIONTY; st = st->st_link)
		if (st == NULL)
		    myexit(3,"internal error in dodefines");
	    strcpy(union_name,"");
	    lexlev--;
	    dodefines(st,union_name);
	    lexlev++;
	    }
	varec--;
	}   /* end if nexttoken == OFT */

    if (nexttoken != ENDT && nexttoken != RIGHTPAREN)
	myexit(2,"end or )");
    rechead->st_numdims = numdims;
}

/*
 * Make st entries for "defines".  This way the added C union &
 * inner struct levels will be transparent to the program code.
 */

dodefines(unionptr,union_name)
    struct stentry *unionptr;
    char *union_name;
{
    register struct stentry *st, *dst, *subrecst;
    register int j, subrec_num, i, union_num;
    char definestr[LINELENGTH];

    /*
     * Get the union name
     */
    strcat(union_name, unionptr->st_name);
    strcat(union_name, ".");
    union_num = unionptr->st_numdims;
    st = unionptr->st_next;

    /*
     * Get ptr to inner record
     */
    subrecst = st;

    for (i = 0; i < union_num; i++, subrecst = subrecst->st_link)
	{
	subrec_num = subrecst->st_numdims;
	if (subrec_num == 0)
	    continue;
	/*
	 * Get the inner record name
	 */
	strcpy(definestr, union_name);
	strcat(definestr, subrecst->st_name);
	strcat(definestr, ".");
	st = subrecst->st_next;
	for (j = 0; j < subrec_num; j++)
	    {
	    if (st->st_tipe == UNIONTY)
		{
		dodefines(st, definestr);
		continue;
		}
	    dst = getstentry();
	    inittvf(dst);
	    dst->st_class = DEFINEC;
	    dst->st_name = getname(strlen(st->st_name));
	    strcpy(dst->st_name, st->st_name+1);	/* skip over "u" */
	    dst->st_cmt = getcmtinfo();
	    dst->st_cmt->cmt = getname(strlen(definestr)+strlen(st->st_name));
	    strcpy(dst->st_cmt->cmt, definestr);
	    strcat(dst->st_cmt->cmt, st->st_name);
	    addsymbol(dst);

	    st = st->st_link;
	    /* skip over enum constants */
	    }
	}
}