prdecl.c

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

#ifndef lint
static	char	*sccsid = "@(#)prdecl.c	4.1	(ULTRIX)	7/17/90";
#endif lint

/************************************************************************
 *									*
 *			Copyright (c) 1986 by				*
 *		Digital Equipment Corporation, Maynard, MA		*
 *			All rights reserved.				*
 *									*
 *   This software is furnished under a license and may be used and	*
 *   copied  only  in accordance with the terms of such license and	*
 *   with the  inclusion  of  the  above  copyright  notice.   This	*
 *   software  or  any  other copies thereof may not be provided or	*
 *   otherwise made available to any other person.  No title to and	*
 *   ownership of the software is hereby transferred.			*
 *									*
 *   The information in this software is subject to change  without	*
 *   notice  and should not be construed as a commitment by Digital	*
 *   Equipment Corporation.						*
 *									*
 *   Digital assumes no responsibility for the use  or  reliability	*
 *   of its software on equipment which is not supplied by Digital.	*
 *									*
 ************************************************************************/

/*
* File: 	prdecl.c
*
* Pascal to C translator - Parser for declarations
*			 - Const, type & variable declarations
*/

/*
 *	TO DO
 *
 *  types of:  array of complex type, array bounds of
 *		enumeration in place: [(red,blue,green)]
 */

/*	Modification History
 *
 * 21-July-87 afd
 *	If a const value is more than 1 char, then call it a string (STRINGTY)
 *
 */

#include <stdio.h>
#include "ptoc.h"

#ifdef PRDEBUG
int prdebug = 1;
#define printd if (prdebug) fprintf
#define printd10 if (prdebug >= 10) fprintf
#endif

extern enum token nexttoken;	/* next Pascal token obtained as input */

extern struct scaninfo scandata;
extern char tokenahead;
extern struct stentry *stindex[MAXLEV];	/* sym table pts by lexic level */
extern int lexlev;			/* current lexical level */
extern int savecmt;			/* True when comment saved */
extern int linecounter;		/* for myexit() */
extern char currfile[LINELENGTH];	/* file name for myexit() */

enum token holdtoken;

char *malloc();
struct stentry *getstentry();
char *getname();
struct pairs *getpairs();
struct stentry *findany();
struct treenode *gettn();
struct cmtinfo *getcmtinfo();

/*
 * constseg:  Get a constant segment.
 */

constseg(tn)
    struct treenode *tn;		/* ptr to decl begin block */
{
    struct stentry *st;			/* current type symbol */
    char negative;

    if (nexttoken == CONSTT)
	{
#	ifdef PRDEBUG
	printd(stderr,"constseg: got CONST token\n");
#	endif
	savecmt = 1;
	scanner(0);		/* get const id */
	savecmt = 0;
	commentseg(tn);
	do
	    {
	    st = getstentry();
	    st->st_name = getname(scandata.si_idlen);
	    strcpy(st->st_name, scandata.si_name);
	    st->st_class = CONSTC;
	    addsymbol(st);
	    if (tn->firstsym == NULL)
		tn->firstsym = st;
	    tn->lastsym = st;

	    savecmt = 0;
	    scanner(0);		/* get = */
	    scanner(0);
	    negative = 0;
	    if (nexttoken == PLUS)
		{
		scanner(0);
		}
	    else
		if (nexttoken == MINUS)
		    {
		    negative = 1;
		    scanner(0);
		    }
	    if (nexttoken != IDENT)
		switch (nexttoken)
		    {
		    case NUMCONST:
			if (scandata.si_dflag == 2)
			    {
			    st->st_fcval = scandata.si_cvalue;
			    if (negative)
				st->st_fcval = -st->st_fcval;
			    st->st_tipe = REALTY;
			    }
			else
			    {
			    st->st_cval = scandata.si_cvalue;
			    if (negative)
				st->st_cval = -st->st_cval;
			    st->st_tipe = INTTY;
			    }
			break;
		    case CHARCONST:
			if (scandata.si_idlen != 1) { /* string */
				st->st_string = getname(scandata.si_idlen);
	    			strcpy(st->st_string, scandata.si_name);
				st->st_tipe = STRINGTY;
			} else {
				st->st_string = NULL;
				st->st_cval = scandata.si_name[0];
				st->st_tipe = CHARTY;
			}
			break;
		    case TRUET:
			st->st_cval = 1;
			st->st_tipe = INTTY;
			break;
		    case FALSET:
			st->st_cval = 0;
			st->st_tipe = INTTY;
			break;
		    case PERCENT:
			scanner(0);
			if (nexttoken != IDENT)
			    myexit(3,"bad constant");
			if ((strcmp(scandata.si_name,"o") == 0) ||
			    (strcmp(scandata.si_name,"O") == 0))
			    st->st_tipe = OCTALTY;
			else
			    if ((strcmp(scandata.si_name,"x") == 0) ||
				(strcmp(scandata.si_name,"X") == 0))
				st->st_tipe = HEXTY;
			    else myexit(3,"bad constant");
			/*
			 * Call scanner to get octal or hex const within
			 * apostrophes.  Use st_uptr to point to the
			 * constant string.
			 */
			scanner(0);
			if (nexttoken != CHARCONST)
			    myexit(3,"bad constant");
	    		st->st_uptr = (struct stentry *) getname(scandata.si_idlen);
	    		strcpy(st->st_uptr, scandata.si_name);
			st->st_cval = 0;
			break;
		    default:
			myexit(3,"bad constant");
		    }
	    else
		{
		st->st_tipe = USERTYPE;
		st->st_uptr = findany(scandata.si_name);
		}
	    scanner(0);		/* get SEMI */
	    if (nexttoken != SEMICOLON)
		myexit(2,";");
	    savecmt = 1;
	    scanner(0);		/* get next token */
	    savecmt = 0;
	    if (nexttoken == COMMENT)
		{
		st->st_cmt = scandata.si_cmtptr;
		/* comment loop here ? to get multiple comments in a row */
		savecmt = 1;
		scanner(0);
		savecmt = 0;
		commentseg(tn);
		}
	    }
	while (nexttoken == IDENT);
	return(1);
	}
    else
	return(0);
}


/*
 * typeseg:  Get a type segment.
 */

typeseg(tn)
    struct treenode *tn;		/* ptr to decl begin block */
{
    struct stentry *st;			/* current type symbol */
    struct stentry *tmpst;		/* temporary stptr */

    if (nexttoken == TYPET)
	{
#	ifdef PRDEBUG
	printd(stderr,"typeseg: got TYPE token\n");
#	endif
	savecmt = 1;
	scanner(0);			/* get type id */
	savecmt = 0;
	commentseg(tn);
	do
	    {
	    st = getstentry();
	    inittvf(st);
	    st->st_name = getname(scandata.si_idlen);
	    strcpy(st->st_name, scandata.si_name);
	    st->st_class = TYPEC;
	    addsymbol(st);
	    if (tn->firstsym == NULL)
		tn->firstsym = st;
	    tn->lastsym = st;
	    savecmt = 0;
	    scanner(0);		/* get = */
	    scanner(0);
	    /*
	     * Check for VMS format of:  "id = [attributes] type;"
	     */
	    if (nexttoken == LEFTBRACKET)
		{
		while (nexttoken != RIGHTBRACKET)
		    scanner(0);
		scanner(0);
		}
	    if (!datatype(st))
		myexit(3,"data type not recognized");
	    /*
	     * If the type was an enumerated type we must update
	     * tn->lastsym to point to the last enumeration constant.
	     */
	    if (st->st_dstruct == UDEFS && st->st_tipe == ENUMTY)
		{
		for (tmpst = st->st_uptr; tmpst->st_link != NULL; tmpst = tmpst->st_link)
		    ;
		tn->lastsym = tmpst;
		}
	    scanner(0);		/* get SEMI */
	    if (nexttoken != SEMICOLON)
		myexit(2,";");
	    savecmt = 1;
	    scanner(0);		/* get next token */
	    savecmt = 0;
	    if (nexttoken == COMMENT)
		{
		st->st_cmt = scandata.si_cmtptr;
		/* comment loop here to get multiple comments in a row */
		savecmt = 1;
		scanner(0);
		savecmt = 0;
		commentseg(tn);
		}
	    }
	while (nexttoken == IDENT);
	return(1);
	}  /* if (nexttoken == TYPET) */
    else
	return(0);
}

/*
 * varseg:  Get a var segment.
 */

varseg(tn, functn)
    struct treenode *tn;		/* ptr to decl begin block */
    struct treenode *functn;		/* ptr to func/proc tree node */
{
    struct stentry *st;			/* current var symbol */
    struct stentry *secthead;		/* head of a section of var decls:
					   eg: v1,v2,v3: data-type */
    struct stentry *sect;		/* ptr to current stentry */
    struct stentry *funcst;		/* ptr to func/proc stentry */
    struct stentry *dupst;		/* to fill out dupvar st_entryies */
    char buf[LINELENGTH];		/* to hold init value */

    /*
     * If function (not proc or main) then set up a dummy var with
     * same name as the function name to take Pascal assignments to the
     * function.
     */
    if (functn->type == FDECLNODE)
	{
	st = getstentry();
	inittvf(st);
	funcst = functn->stdecl;
	st->st_name = getname(strlen(funcst->st_name));
	strcpy(st->st_name, funcst->st_name);
	funcst = functn->ftype;
	st->st_lexlev = lexlev;
	st->st_dstruct = funcst->st_dstruct;
	st->st_tipe = funcst->st_tipe;
	st->st_class = VARC;
	st->st_uptr = funcst->st_uptr;
	st->st_numdims = funcst->st_numdims;
	st->st_bounds = funcst->st_bounds;
	st->st_funcvar = 1;
	addsymbol(st);
	if (tn->firstsym == NULL)
	    tn->firstsym = st;
	tn->lastsym = st;
	}
    if (nexttoken == VART)
	{
#	ifdef PRDEBUG
	printd(stderr,"typeseg: got VAR token\n");
#	endif
	savecmt = 1;
	scanner(0);			/* get var id */
	savecmt = 0;
	commentseg(tn);
	do
	    {
	    secthead = NULL;
	    do
		{
		/*
		 * Check for VMS/Pascal "mechanism-specifier"
		 */
		if (nexttoken == PERCENT)
		    {
		    scanner(0);
		    if (nexttoken == MECHT)
			scanner(0);
		    else
			myexit(2, "mechanism-specifier");
		    }
		st = getstentry();
		inittvf(st);
		/*
		 * String together constructs like v1, v2, v3: type;
		 */
		if (secthead == NULL)
		    {
		    secthead = st;
		    sect = st;
		    }
		else
		    {
		    sect->st_dupvar = st;
		    sect = st;
		    }

		st->st_name = getname(scandata.si_idlen);
		strcpy(st->st_name, scandata.si_name);
		st->st_class = VARC;
		addsymbol(st);
		if (tn->firstsym == NULL)
		    tn->firstsym = st;
		tn->lastsym = st;
		savecmt = 0;
		scanner(0);		/* get next token */
		if (nexttoken == COMMA)
		    scanner(0);
		}
	    while (nexttoken != COLON);
	    scanner(0);

	    /*
	     * Check for VMS format of:  "id: [attributes] type;"
	     */
	    if (nexttoken == LEFTBRACKET)
		{
		while (nexttoken != RIGHTBRACKET)
		    scanner(0);
		scanner(0);
		}
	    /*
	     * Fill in data type for head variable in this `section':
	     *    eg. v1, v2, v3: data-type;
	     */
	    if (!datatype(secthead))
		myexit(3,"data type not recognized");
	    /*
	     * If the type was an enumerated type we must update
	     * tn->lastsym to point to the last enumeration constant.
	     */
	    if (secthead->st_dstruct == UDEFS && secthead->st_tipe == ENUMTY)
		{
		for (dupst = secthead->st_uptr; dupst->st_link != NULL; dupst = dupst->st_link)
		    ;
		tn->lastsym = dupst;
		}
	    /* 
	     * 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 gets 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 */
	    if (nexttoken != SEMICOLON)
		if (nexttoken == ASSIGNOP)
		    {
		    scanner(0);
		    /*
		     * Check for VMS/Pascal "mechanism-specifier"
		     */
		    if (nexttoken == PERCENT)
			{
			scanner(0);
			if (nexttoken == MECHT)
			    scanner(0);
			else
			    myexit(2, "mechanism-specifier");
			}
		    buf[0] = '\0';
		    getexpr(buf,0);
		    secthead->st_value = malloc(strlen(buf) + 1);
		    if (secthead->st_value == NULL)
			myexit(-1,"");
		    if (buf[0] == '(')
			{
			buf[0] = '{';
			if (buf[strlen(buf)-1] == ')')
			    buf[strlen(buf)-1] = '}';
			}
		    strcpy(secthead->st_value,buf);
		    }
		else
		    myexit(2,";");
	    savecmt = 1;
	    scanner(0);		/* get next token */
	    savecmt = 0;
	    if (nexttoken == COMMENT)
		{
		secthead->st_cmt = scandata.si_cmtptr;
		/* comment loop here ? to get multiple comments in a row */
		savecmt = 1;
		scanner(0);
		savecmt = 0;
		commentseg(tn);
		}
	    }
	while (nexttoken == IDENT || nexttoken == PERCENT);
	return(1);
	}
    else
	return(0);
}


/*
 * datatype:  Get a datatype.
 * <data_type> ::= <simple_type> | <array_type> | ^<id> | file of <data_type> |
 *              set of <simple_type> | record <filedlist> end
 */

datatype(st)
    struct stentry *st;
{
    if (nexttoken == PACKED)
	scanner(0);
    if (!simpletype(st))
	if (!arraytype(st))
	    if (nexttoken == UPARROW)
		{
		st->st_dstruct = PTRS;
		scanner(0);		/* get id */
		if (!simpletype(st))
		    myexit(3,"bad pointer type");
		}
	    else
		if (nexttoken == FILET)
		    {
		    scanner(0);		/* get 'of' */
		    scanner(0);
		    if (!datatype(st))
			myexit(3,"data type not recognized");
		    st->st_dstruct = FILESTR;	/* MUST follow call for type
						   to set back struct type */
		    }
		else
		    if (nexttoken == SETT)
			{
			scanner(0);	/* get 'of' */
			if (nexttoken != OFT)
			    myexit(2,"of");
			scanner(0);
			if (!simpletype(st))	/* get type of the set */
			    myexit(3,"bad set type");
			st->st_dstruct = SETS;	/* MUST follow call for type
						   to set back struct type */
			}
		    else
			if (nexttoken == RECORDT)
			    {
			    st->st_dstruct = RECORDS;
			    lexlev++;
			    fieldlist(st,0);
			    stindex[lexlev] = NULL;	/* terminate inner level */
			    lexlev--;
			    }
			else
			    return(0);		/* no datatype */
    return(1);
}

/*
 * <simple_type> ::= integer | boolean | char | real | <id> | ( <id> {,<id>}*) |
 *                  <constant> .. <constant> | <const-id> .. <const-id>
 */

simpletype(st)
    struct stentry *st;
{
    struct stentry *hold;	/* hold a ptr to the enum sym table entry */
    char holdname[LINELENGTH];	/* hold last symbol name for 'look-ahead' */
    int i;			/* number of enum constants */

    if (nexttoken == MINUS || nexttoken == PLUS)
	scanner(1);		/* could be negative subrange */
    switch (nexttoken) {
    case BOOLEANT:
	st->st_tipe = BOOLTY;
	break;
    case DOUBLE:
	st->st_tipe = DOUBLETY;
	break;
    case CHART:
	st->st_tipe = CHARTY;
	break;
    case INTEGERT:
	st->st_tipe = INTTY;
	break;
    case REALT:
	st->st_tipe = REALTY;
	break;
    case UNSIGNT:
	st->st_tipe = UNSIGNEDTY;
	break;
    case IDENT:
	holdtoken = nexttoken;
	strcpy(holdname,scandata.si_name);
	scanner(1);	/* 1 for no reals, despite '.' */
	if (nexttoken == DOTDOT)
	    {
	    st->st_dstruct = SUBRANGES;
	    nexttoken = holdtoken;
	    getrange(st,1);		/* 1=lower bound */
	    scanner(0);			/* get next const */
	    if (nexttoken == MINUS)
		scanner(1);
	    getrange(st,0);		/* 0=upper bound */
	    }