prsubr.c

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

#ifndef lint
static char *sccsid = "@(#)prsubr.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: 	prsubr.c
 *
 * Pascal to C translator - Parser for:
 *			  - subroutines (procedures/functions)
 *			  - parameters 
 *			  - main program
 *			  - includes
 *			  - label declarations
 *			  - comments
 */

#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 int linecounter;
extern char tokenahead;
extern int linesize;				/* # of chars in inputline */
extern char ahead;				/* got 'nextchar' ahead flag */
extern char endofinput;
extern int charcounter;
extern FILE *fp;			/* file to scan from */
extern currfile[LINELENGTH];
extern char nextchar;
extern line inputline;
extern int doincl;			/* > 1 when processing include file */
extern struct treenode *procindex[MAXLEV];
extern struct stentry *stindex[MAXLEV];	/* sym table pts by lexic level */
extern int lexlev;				/* current lexical level */
extern struct fwdstmt *fwdhead;		/* head of list of fwd decls */
extern struct fwdstmt *fwdcurr;
extern int savecmt;			/* True when comment saved */

char gotprog;				/* True if program token scanned */
enum token holdtoken;
struct treenode *prevsub;		/* ptr to prev subroutine */

char *malloc();
struct stentry *getstentry();
char *getname();
struct pairs *getpairs();
struct stentry *findany();
struct treenode *gettn();
struct fwdstmt *getfwd();

/*
 * prog: Get a program stmt.  Symbol table head and tail are set up here.
 */

prog()
{
    gotprog = 0;
    lexlev = 0;
    stindex[0] = getstentry();	/* dummy header, not filled in */
    /*
     * The builtin symbols get defined before the program node, thus
     * they are not printed during code emiting.
     */
    builtins();
    scanner(0);
    if (nexttoken == PROGRAMT || nexttoken == MODULET)
	{
#       ifdef PRDEBUG
	printd(stderr,"prog: got program token\n");
#       endif
	if (nexttoken == PROGRAMT)
	    gotprog = 1;
	/*
	 * Scan program name, optional (input,output), up thru ";"
	 */
	for (; nexttoken != SEMICOLON ;)
	    scanner(0);
	savecmt = 1;
	scanner(0);
	}
    progseg(0);              /* get program segment */
    return(1);
}


/*
 * progseg:  Get a program segment (body).
 */

progseg(incl)
    char incl;			/* == 1 if processing an include file */
{
    struct treenode *tn;
    struct stentry *st;

    if (incl == 1)
	tn = procindex[0];
    else
	{
	tn = gettn();
	tn->type = PROGNODE;
	procindex[0] = tn;
	blkentry(tn);
	tn->firstc = tn->firstc->next;		/* no begin block for params */
	tn->firstc->next->next = NULL;		/* no begin block for stmts */
	lexlev = 1;
	/*
	 * Setup include of <stdio.h> and maxint symbol
	 */
	st = getstentry();
	st->st_name = getname(9);
	strcpy(st->st_name, "<stdio.h>");
	st->st_class = INCLUDEC;
	addsymbol(st);
	if (tn->firstc->firstsym == NULL)
	   tn->firstc->firstsym = st;
	tn->firstc->lastsym = st;

	st = getstentry();
	st->st_class = CONSTC;
	st->st_name = getname(6);
	strcpy(st->st_name, "maxint");
	st->st_cval = MAXINT;
	st->st_tipe = INTTY;
	addsymbol(st);
	if (tn->firstc->firstsym == NULL)
	   tn->firstc->firstsym = st;
	tn->firstc->lastsym = st;
	}
    /*
     * Pass ptr to decl_begin block
     */
	(void) commentseg(tn->firstc);
    (void) includeseg(tn->firstc);
    (void) labelseg();
	(void) commentseg(tn->firstc);
    (void) includeseg(tn->firstc);
    (void) constseg(tn->firstc);
	(void) commentseg(tn->firstc);
    (void) includeseg(tn->firstc);
    (void) typeseg(tn->firstc);
	(void) commentseg(tn->firstc);
    (void) includeseg(tn->firstc);
    /*
     * Add var "readln_dummy" to use for scanning thru "newline".
     * Needed for Pascal "readln".
     */
	st = getstentry();
	inittvf(st);
	st->st_name = getname(12);
	strcpy(st->st_name, "readln_dummy");
	st->st_lexlev = lexlev;
	st->st_dstruct = ARRS;
	st->st_tipe = CHARTY;
	st->st_class = VARC;
	st->st_numdims = 1;
	st->st_bounds = getpairs();
	st->st_bounds->pr_upper = 10;
	addsymbol(st);
	if (tn->firstc->firstsym == NULL)
	    tn->firstc->firstsym = st;
	tn->firstc->lastsym = st;
    (void) varseg(tn->firstc,tn);
	(void) commentseg(tn->firstc);
    (void) includeseg(tn->firstc);
    (void) fwdseg(tn->firstc->next);
	(void) commentseg(tn->firstc);
    (void) includeseg(tn->firstc);
    /*
     * Pass ptr to proc_begin block
     */
    prevsub = NULL;
    (void) subseg(tn->firstc->next, 0);
    if (incl == 0 && gotprog == 1)
	(void) mainstmts(tn->firstc->next);		/* create "main" proc */
}


/*
 * includeseg:  Get an include segment.
 */

includeseg(tn)
    struct treenode *tn;		/* ptr to decl begin block */
{
    struct stentry *st;			/* current var symbol */
    FILE *sfile;
    int slinesize;
    int slinecounter;
    int scharcounter;
    char sahead;
    char stokenahead;
    char snextchar;
    enum token snexttoken;
    line sinputline;
    char scurrfile[LINELENGTH];
    char unixform;			/* true if unix format include */

    /*
     * Accept Berkeley Pascal include syntax:  #include "file"
     *         and VMS Pascal include syntax:  %include 'file'
     */
    while (nexttoken == POUND || nexttoken == PERCENT)
	{
	if (nexttoken == POUND)
	    unixform = 1;
	else
	    unixform = 0;
	scanner(0);
	if (nexttoken != INCLUDET)
	    myexit(2,"include");
	if (unixform)
	    {
	    scanner(0);
	    if (nexttoken != QUOTE)
		myexit(2,"string");
	    }
	else
	    {
	    scanner(0);
	    if (nexttoken != CHARCONST)
		myexit(2,"string");
	    }
	st = getstentry();
	st->st_name = getname(strlen(scandata.si_name));
	strcpy(st->st_name, scandata.si_name);
	st->st_class = INCLUDEC;
	addsymbol(st);
	if (tn->firstsym == NULL)
	   tn->firstsym = st;
	tn->lastsym = st;
	savecmt = 1;
	scanner(0);
	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);
	    }
	/*
	 * Process include file
	 *
	 * Save scanner variables, to preserve state in present file.
	 */
	slinesize = linesize;
	slinecounter = linecounter;
	scharcounter = charcounter;
	sahead = ahead;
	stokenahead = tokenahead;
	snextchar = nextchar;
	snexttoken = nexttoken;
	strcpy(sinputline, inputline);
	strcpy(scurrfile, currfile);
	sfile = fp;
	/*
	 * See if include file can be opened.
	 */
	fp = fopen(st->st_name, "r");
	if (fp == NULL)
	    myexit(5,st->st_name);
	/*
	 * Re-initilize scanner variables for new file
	 */
	ahead = 0;
	tokenahead = 0;
	endofinput = 0;
	linecounter = 0;
	linesize = 0;
	charcounter = LINELENGTH;
	strcpy(currfile, st->st_name);

	doincl++;
	scanner(0);
	progseg(1);
	doincl--;
	fclose(fp);

	/*
	 * Restore scanner variables, to previous state.
	 */
	linesize = slinesize;
	linecounter = slinecounter;
	charcounter = scharcounter;
	ahead = sahead;
	tokenahead = stokenahead;
	endofinput = 0;
	nextchar = snextchar;
	nexttoken = snexttoken;
	strcpy(inputline, sinputline);
	strcpy(currfile, scurrfile);
	fp = sfile;
	}
}

/*
 * paramseg:  Get a param segment.
 */

paramseg(tn, funcst, parent)
    struct treenode *tn;		/* ptr to param begin block */
    struct stentry *funcst;		/* st entry for proc/func */
    struct treenode *parent;		/* for getting func/proc as param.
					   parent level for func definition */
{
    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 *dupst;		/* to fill out dupvar st_entryies */
    char buf[LINELENGTH];		/* to hold init value */
    int num = 0;			/* nparam counter */
    char var;
    char funcpar;			/* == 1 if getting func param */
    					/* == 2 if getting proc param */

    if (nexttoken == LEFTPAREN)
	{
#	ifdef PRDEBUG
	printd(stderr,"paramseg: got LEFTPAREN token\n");
#	endif
	savecmt = 0;
	scanner(0);			/* get VAR or id */
	do
	    {
	    var = 0;
	    funcpar = 0;
	    if (nexttoken == VART)
		{
		var = 1;
		scanner(0);
		}
	    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;
		    }
		/*
		 * If func/proc as a parameter call subseg to get
		 *   the function decl set up:  Pass funcpar to indicate
		 *   that we're getting a func/proc parameter.
		 * When we return "prevsub" points to the dummy function
		 *   decl that we set up.  So we can fill in the type.
		 */
		if (nexttoken == FUNCTIONT)
		    funcpar = 1;
		if (nexttoken == PROCEDURET)
		    funcpar = 2;
		if (funcpar)
		    {
		    lexlev--;
		    subseg(parent,funcpar);
		    strcpy(scandata.si_name, prevsub->stdecl->st_name);
		    scandata.si_idlen = strlen(prevsub->stdecl->st_name);
		    lexlev++;
		    }
		st->st_name = getname(scandata.si_idlen);
		strcpy(st->st_name, scandata.si_name);
		st->st_class = VARC;
		if (var)
		    st->st_byref = 1;
		addsymbol(st);
		num++;
		if (tn->firstsym == NULL)
		    tn->firstsym = st;
		tn->lastsym =st;
		if (funcst->st_fparam == NULL)
		    funcst->st_fparam = st;
		funcst->st_lparam = st;
		/*
		 * Only get next token if not a proc/func parameter
		 * If it is a procedure parameter skip getting the type
		 *    (nexttoken == ";" or ")"
		 */
		if (funcpar == 0)
		    scanner(0);		/* get next token: , or : */
		else if (funcpar == 2)
			 goto nextparam;	/* forgive me! */
		if (nexttoken == COMMA)
		    scanner(0);
		}
	    while (nexttoken != COLON);
	    scanner(0);		/* get type */

	    /*
	     * 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");
	    /* 
	     * 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"