prsubr.c

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

	     * 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;
		}
nextparam:
	    /*
	     * Now that we have the func/proc parameter type go back
	     * and fill in the dummy func/proc decl type.
	     */
	    if (funcpar)
		{
		secthead->st_funcpar = funcpar;
		prevsub->stdecl->st_dstruct = secthead->st_dstruct;
		prevsub->stdecl->st_tipe = secthead->st_tipe;
		prevsub->stdecl->st_uptr = secthead->st_uptr;
		prevsub->stdecl->st_funcpar = funcpar;

		if (funcpar == 1)
		    {	/* function so fill in type entry */
		    prevsub->ftype->st_dstruct = secthead->st_dstruct;
		    prevsub->ftype->st_tipe = secthead->st_tipe;
		    prevsub->ftype->st_uptr = secthead->st_uptr;
		    prevsub->ftype->st_funcpar = 1;
		    prevsub->ftype->st_class = FUNCC;  /* need for emit */
		    }
		else	/* proc so use type int for the type in C */
		    secthead->st_tipe = INTTY;
		}
	    if (funcpar != 2)
		scanner(0);		/* get SEMI or ")" */
	    if (nexttoken != SEMICOLON && nexttoken != RIGHTPAREN)
		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,"; or )");
	    scanner(0);		/* get next token */
	    }
	while (nexttoken == IDENT || nexttoken == VART || nexttoken == PERCENT
	    || nexttoken == FUNCTIONT || nexttoken == PROCEDURET);
	funcst->st_nparams = num;
	return(1);
	}
    else
	return(0);
}


/*
 * labelseg:  Get a label segment.  Just scan it and ignore it, since
 * its unnecessary in C.
 */

labelseg()
{
    if (nexttoken == LABELT)
	{
#	ifdef PRDEBUG
	printd(stderr,"labelseg: got label token\n");
#	endif
	savecmt = 0;
	scanner(0);		/* get label */
	do
	    {
	    if (nexttoken != NUMCONST)
		myexit(2, "numeric constant");
	    scanner(0);		/* get next token */
	    if (nexttoken == COMMA)
		scanner(0);		/* get next token */
	    }
	while (nexttoken != SEMICOLON);
	savecmt = 1;
	scanner(0);		/* get next token */
	savecmt = 0;
	return(1);
	}
    else
	return(0);
}

/*
 * commentseg:  Get a comment.
 */

commentseg(tn)
    struct treenode *tn;		/* ptr to decl begin block */
{
    struct stentry *st;			/* symbol table entry for comment */

    if (nexttoken == COMMENT)
	{
#	ifdef PRDEBUG
	printd(stderr,"commentseg: got COMMENT token\n");
#	endif
	st = getstentry();
	st->st_class = COMTC;
	st->st_cmt = scandata.si_cmtptr;
	addsymbol(st);
	if (tn->firstsym == NULL)
	    tn->firstsym = st;
	tn->lastsym = st;
	savecmt = 0;
	scanner(0);		/* next token after comment */
	return(1);
	}
    else
	return(0);
}


/*
 * Look for a subroutine segment (procedures & functions)
 * If getting func/proc parameter we will just set up a function decl.
 *
 * NOTE: uses global "prevsub".  This is needed to handle nested Pascal
 *	procedures, and get them un-nested in C.
 */

subseg(parent, funcpar)
    struct treenode *parent;
    char funcpar;		/* 1 if getting func parameter */
    				/* 2 if getting proc parameter */
{
    struct stentry *st;
    struct treenode *tn;
    char proc;
    char fwd;			/* true if proc/funct found to be a fwd */
    struct fwdstmt *fptr;	/* ptr to forward list */
    char ext;

    /*
     * Check for VMS format of:  "[attributes] procedure/function name..."
     */
    if (nexttoken == LEFTBRACKET)
	{
	while (nexttoken != RIGHTBRACKET)
	    scanner(0);
	scanner(0);
	}
    for (; nexttoken == PROCEDURET || nexttoken == FUNCTIONT; )
	{
	if (nexttoken == PROCEDURET)
	    proc = 1;
	else
	    proc = 0;
	savecmt = 0;
	scanner(0);			/* get proc name */
	if (nexttoken != IDENT)
	    myexit(2,"identifier");
	/*
	 * See if the proc/funct was already declared with a forward
	 * statement.  If so point to the tree structure already built
	 * for the declaration.
	 */

	fwd = 0;
	if (funcpar == 0)
	    for (fptr = fwdhead->next; fptr != NULL; fptr = fptr->next)
		{
		if (strcmp(fptr->tree->stdecl->st_name, scandata.si_name) == 0)
		    {
		    fwd = 1;
		    break;
		    }
		}
	if (fwd)
	    tn = fptr->tree;
	else
	    {
	    tn = gettn();
	    if (proc)
		tn->type = PDECLNODE;
	    else
		tn->type = FDECLNODE;
	    }
	if (fwd)
	    {
	    for (;nexttoken != SEMICOLON;)
		scanner(0);
	    lexlev++;
	    /*
	     * Turn on "st_emit" flag in parameter entries that go
	     *    with the forward or external function.
	     * Also stuff a pointer to the parameters into the active
	     *    symbol table for this lexic level.
	     */
	    addsymbol(tn->firstc->firstsym);
	    for (st = tn->firstc->firstsym; st != NULL; st = st->st_link)
		{
		st->st_emit = 1;
		if (st == tn->firstc->lastsym)
		    break;
		}
	    }
	else
	    {
	    st = getstentry();
	    if (proc)
		st->st_class = PROCC;
	    else
		st->st_class = FUNCC;
	    st->st_nparams = 0;
	    st->st_name = getname(scandata.si_idlen);
	    strcpy(st->st_name, scandata.si_name);
	    tn->stdecl = st;
	    st->st_dstruct = NOSTRUCT;
	    st->st_tipe = INTTY;
	    addsymbol(st);
	    blkentry(tn);
	    lexlev++;
	    scanner(0);		/* get '(' or ';'  or ':' */
	    (void) paramseg(tn->firstc, st, parent);
	    if (!proc)
		{
		if (funcpar)
		    {
		    if (funcpar == 1)
			{
			st = getstentry();
			tn->ftype = st;
			/*
			 * We will fill in the function type back in
			 *   paramseg by using the prevsub pointer.
			 */
			 }
		    }
		else
		    {
		    if (nexttoken != COLON)
			myexit(2,":");
		    /*
		     * Get the function type.
		     * Also save the type info in the funct class stentry
		     * for use in forward/external function type decls, and
		     * for print formats from Pascal write stmts. 
		     */
		    scanner(0);		/* get funct type */
		    st = getstentry();
		    tn->ftype = st;
		    if (!datatype(st))
			myexit(3,"data type not recognized");
		    tn->stdecl->st_dstruct = st->st_dstruct;
		    tn->stdecl->st_tipe = st->st_tipe;
		    tn->stdecl->st_uptr = st->st_uptr;
		    scanner(0);		/* get ';' */
		    }
		}
	    }
	if (funcpar == 0)
	    {
	    savecmt = 1;
	    scanner(0);		/* get nexttoken AFTER ';' */
	    savecmt = 0;
		(void) commentseg(tn->firstc->next);
	    }
	/*
	 * Handle external declaration exactly as a forward declaration.
	 * This will create a function type declaration in C.
	 * Syntax: "function name (params): type; external;"
	 *   The reserved word table in sc.c returns the token EXTERNALT
	 *   for "extern" and "fortran" also.
	 */
	if (nexttoken == EXTERNALT || nexttoken == FORWARDT)
	    {
	    fwdcurr->next = getfwd();
	    fwdcurr = fwdcurr->next;
	    fwdcurr->tree = tn;
	    /*
	     * We want the "decl-begin" node (parent->prev->firstsym)
	     * to point to the proc id in the symbol table, so that
	     * a type definition will be produced for the proc id.
	     */
	    if (parent->prev->firstsym == NULL)
		parent->prev->firstsym = tn->stdecl;
	    parent->prev->lastsym = tn->stdecl;
	    scanner(0);
	    if (nexttoken == SEMICOLON)
		{
		savecmt = 1;
		scanner(0);
		savecmt = 0;
		(void) commentseg(tn->firstc->next);
		}
	    }
	else
	    {
	    if (parent->firstc == NULL)
		parent->firstc = tn;
	    parent->lastc = tn;
	    if (prevsub != NULL)
		prevsub->next = tn;
	    prevsub = tn;
	    /*
	     * If getting func/proc parameter, then we are done
	     * so return here.
	     */
	    if (funcpar)
		return;
	    (void) labelseg();
		(void) commentseg(tn->firstc->next);
	    (void) constseg(tn->firstc->next);
		(void) commentseg(tn->firstc->next);
	    (void) typeseg(tn->firstc->next);
		(void) commentseg(tn->firstc->next);
	    (void) varseg(tn->firstc->next,tn);
		(void) commentseg(tn->firstc->next);
	    /*
	     * Here's the clever part for un-nesting Pascal procedures.
	     * We want procs at same level, no nesting.  Global "prevsub"
	     * takes care of holding a pointer to the current proc tree
	     * node, so that it can be the next proc's prev.
	     */
	    (void) subseg(parent, 0);
	    savecmt = 1;
	    scanner(0);		/* skip over "begin" */
	    savecmt = 0;
	    (void) statelist(tn->lastc, FUNCLEVEL);
	    }
	stindex[lexlev] = NULL;
	lexlev--;
	/*
	 * Check for VMS format of:  "[attributes] procedure/function name..."
	 */
	if (nexttoken == LEFTBRACKET)
	    {
	    while (nexttoken != RIGHTBRACKET)
		scanner(0);
	    scanner(0);
	    }
	}
}

/*
 * Look for a forward segment.  If forward keyword is found, make tree
 * structure entry for the func/proc now.  Get its params and save the
 * func/proc st entry & param info under this tree node in the special
 * forward list.  Then this special tree entry can be retrieved later
 * when the function body is encountered.
 *
 * syntax: "forward procedure (params);"
 */

fwdseg(parent)
    struct treenode *parent;		/* ptr to decl begin block */
{
    struct treenode *prev = NULL;
    struct stentry *st;			/* for saving fwd info */
    struct treenode *tn2;		/* for saving fwd info */
    char proc;

    for (; nexttoken == FORWARDT; )
	{
	savecmt = 0;
	scanner(0);
	fwdcurr->next = getfwd();
	fwdcurr = fwdcurr->next;
	tn2 = gettn();
	fwdcurr->tree = tn2;
	if (nexttoken == PROCEDURET)
	    {
	    proc = 1;
	    tn2->type = PDECLNODE;
	    }
	else if (nexttoken == FUNCTIONT)
	    {
	    proc = 0;
	    tn2->type = FDECLNODE;
	    }
	else myexit(2,"procedure or function");
	st = getstentry();
	scanner(0);			/* get proc name */
	if (nexttoken != IDENT)
	    myexit(2,"identifier");
	if (proc)
	    st->st_class = PROCC;
	else
	    st->st_class = FUNCC;
	st->st_nparams = 0;
	st->st_name = getname(scandata.si_idlen);
	strcpy(st->st_name, scandata.si_name);
	tn2->stdecl = st;
	st->st_dstruct = NOSTRUCT;
	st->st_tipe = INTTY;
/*
	if (parent->firstsym == NULL)
	    parent->firstsym = st;
	parent->lastsym = st;
*/
	/*
	 * We want the "decl-begin" node (parent->prev->firstsym)
	 * to point to the proc id in the symbol table, so that
	 * a type definition will be produced for the proc id.
	 */
	if (parent->prev->firstsym == NULL)
	    parent->prev->firstsym = tn2->stdecl;
	parent->prev->lastsym = tn2->stdecl;

	addsymbol(st);
	blkentry(tn2);
	lexlev++;
	scanner(0);		/* get '(' or ';'  or ':' */
	(void) paramseg(tn2->firstc, st, parent);
	if (!proc)
	    {
	    if (nexttoken != COLON)
		myexit(2,":");
	    /*
	     * Get the function type.
	     * Also save the type info in the funct class stentry
	     * for use in forward/external function type decls, and
	     * for print formats from Pascal write stmts. 
	     */
	    scanner(0);
	    st = getstentry();
	    tn2->ftype = st;
	    if (!datatype(st))
		myexit(3,"data type not recognized");
	    tn2->stdecl->st_dstruct = st->st_dstruct;
	    tn2->stdecl->st_tipe = st->st_tipe;
	    tn2->stdecl->st_uptr = st->st_uptr;
	    scanner(0);		/* get ';' */
	    }
	savecmt = 1;
	scanner(0);		/* get nexttoken AFTER ';' */
	savecmt = 0;
	(void) commentseg(tn2->firstc->next);
	lexlev--;
	}
}