prexpr.c

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

		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))
		    strcat(buf,"0");
		else
		    if ((strcmp(scandata.si_name,"x") == 0) ||
			(strcmp(scandata.si_name,"X") == 0))
			strcat(buf,"0x");
		    else
			myexit(3,"bad constant");
		/*
		 * Call scanner to get octal or hex const within apostrophes.
		 */
		scanner(0);
		if (nexttoken != CHARCONST)
		    myexit(3,"bad constant");
		strcat(buf,scandata.si_name);
		break;
	    case PLUS:
		if (!inarray && cond != 2)
		    mathop = 1;
		strcat(buf," + ");
		varindex = strlen(buf);
		break;
	    case RELATIONAL:
		switch(scandata.si_rel)
		    {
		    case eqrel:
			strcat(buf," == ");
			break;
		    case nerel:
			strcat(buf," != ");
			break;
		    case gtrel:
			strcat(buf," > ");
			break;
		    case gerel:
			strcat(buf," >= ");
			break;
		    case ltrel:
			strcat(buf," < ");
			break;
		    case lerel:
			strcat(buf," <= ");
			break;
		    }
		varindex = strlen(buf);
		mathop = 1;
		break;
	    case RIGHTPAREN:
		if (inparen)
		    {
		    strcat(buf,")");
		    inparen--;
		    if (cond == 2 && inparen == 0)
			cond = 0;
		    }
		else
		    return;	/* proc call & ?? */
		break;
	    case RIGHTBRACKET:
		if (inset)
		    {
		    strcat(buf,setvar);
		    if (inset == 2)
			strcat(buf, " <= ");
		    else
			strcat(buf, " == ");
		    strcat(buf, setelement);
		    strcat(buf, ")");
		    inset = 0;
		    }
		else
		    {
		    strcat(buf,"]");
		    inarray--;
		    varindex = strlen(buf);
		    /* if end of "with" array id, return */
		    if (cond == 1 && inarray == 0)
			return;
		    }
		break;
	    case TRUET:
		strcat(buf,"1");
		break;
	    case UPARROW:
		gotptr = 1;
		break;
	    default:
		return;
		break;
	    }   /* end switch nexttoken */
	if (inset)
	    scanner(1);		/* no "real" numbers allowed */
	else
	    scanner(0);
	}   /* end for */
    /*
     * skip over rest of expr > EXPRLEN
     */
    for (; nexttoken != ASSIGNOP && nexttoken != SEMICOLON;)
	scanner(0);
}


struct treenode *
writestmt(parent, prev, ln)
    struct treenode *parent;
    struct treenode *prev;
    char ln;			/* true if its writeLN */
{
    struct stentry *st;
    struct treenode *tn;
    char filevar[WORDLENGTH];
    char lit[EXPRLEN];
    char buf[EXPRLEN];
    int bi, ei;			/* beginning & ending buf index */
    char getfields;		/* set when getting record fields */
    char gotptr;		/* set when "->" found */
    char inrec;			/* set when record struct found */
    int ti;			/* temp buf index */
    int wi;			/* "with" var index */

    savecmt = 0;
    tn = gettn();
    tn->type = WRITENODE;
    if (parent->firstc == NULL)
	parent->firstc = tn;
    parent->lastc = tn;
    if (prev != NULL)
	prev->next = tn;
    filevar[0] = '\0';
    lit[0] = '\0';
    buf[0] = '\0';
    scanner();
    if (nexttoken == LEFTPAREN)
	{
	scanner();
	for (;;)
	    {
	    switch (nexttoken)
		{
		case CHARCONST:
		    strcat(lit, scandata.si_name);
		    scanner();		/* get nexttoken after char const */
		    break;
		default:
		    if (strcmp(buf,""))
			strcat(buf,", ");
		    bi = strlen(buf);
		    getexpr(buf,4);
		    if (mathop)
			{
			strcat(lit,"%d");
			/*
			 * Format spec could be after expr.
			 * If so, Remove it from buf
			 */
			ti = (int)strchr(buf + bi,':') - (int)buf;
			if (ti > bi)
			    buf[ti] = '\0';
			}
		    else
			{
			/*
			 * Special code to handle Pascal records (C structs).
			 * We need to find the proper field to get the
			 * correct type to format the output.
			 */
			inrec = 0;
			getfields = 0;
			do
			    {
			    gotptr = 0;
			    ei = (int)strchr(buf + bi,'-') - (int)buf;
			    ti = (int)strchr(buf + bi,'>') - (int)buf;
			    if (ei > bi && ei == ti-1)	/* found a '->' */
				{
				getfields = 1;
				ti = (int)strchr(buf + bi,'[') - (int)buf;
				if (ti > bi)
				    {	/* array of ptrs: "a[n]^." */
				    strncpy(scandata.si_name, buf + bi, ti-bi);
				    scandata.si_name[ti-bi] = '\0';
				    }
				else
				    {
				    strncpy(scandata.si_name, buf + bi, ei-bi);
				    scandata.si_name[ei-bi] = '\0';
				    }
				gotptr = 1;
				}
			    else
				{
				ei = (int)strchr(buf + bi,'.') - (int)buf;
				if (ei > bi)	/* found a '.' */
				    {
				    getfields = 1;
				    ti = (int)strchr(buf + bi,'[') - (int)buf;
				    if (ti > bi)
					{	/* array of recs: "a[n]." */
					strncpy(scandata.si_name, buf + bi, ti-bi);
					scandata.si_name[ti-bi] = '\0';
					}
				    else
					{
					strncpy(scandata.si_name, buf + bi, ei-bi);
					scandata.si_name[ei-bi] = '\0';
					}
				    }
				else
				    {
				    getfields = 0;
				    ti = (int)strchr(buf + bi,'[') - (int)buf;
				    if (ti > bi)
					{
					strncpy(scandata.si_name, buf + bi, ti-bi);
					scandata.si_name[ti-bi] = '\0';
					/*
					 * Format spec could be after array.
					 * If so, Remove it from buf
					 */
					ti = (int)strchr(buf + bi,':') - (int)buf;
					if (ti > bi)
					    buf[ti] = '\0';
					}
				    else
					{
					ti = (int)strchr(buf + bi,'(') - (int)buf;
					if (ti > bi)
					    { /* function name */
					    strncpy(scandata.si_name, buf + bi, ti-bi);
					    scandata.si_name[ti-bi] = '\0';
					    /*
					     * Format spec could be after array.
					     * If so, Remove it from buf
					     */
					    ti = (int)strchr(buf + bi,':') - (int)buf;
					    if (ti > bi)
						buf[ti] = '\0';
					    }
					else
					    {
					    ti = (int)strchr(buf + bi,':') - (int)buf;
					    if (ti > bi)
						{ /* format spec on an otherwise
						     plain var, Rem from buf */
						strncpy(scandata.si_name, buf + bi, ti-bi);
						scandata.si_name[ti-bi] = '\0';
						buf[ti] = '\0';
						}
					    else /* plain variable */
						strcpy(scandata.si_name, buf + bi);
					    ti = (int)strchr(buf + bi,'*') - (int)buf;
					    if (ti >= bi)
						{ /* ptr var pas:p^  C:*p */
						strcpy(scandata.si_name, buf + bi +1);
						}
					    }   /* : */
					}   /* ( */
				    }   /* . */
				}   /* - */
			    if (!inrec)
				{
				st = findany(scandata.si_name);
				if (st == NULL)
				    myexit(1,scandata.si_name);
				}
			    else
				{
				for (st = st->st_next; st != NULL; st = st->st_link)
				    if (!strcmp(scandata.si_name, st->st_name))
					break;
				if (st == NULL)
				    myexit(4,scandata.si_name);
				}
			    /*
			     * Chase user pointers to the real type
			     */
			    while (st->st_dstruct == UDEFS)
				st = st->st_uptr;
			    while ((st->st_dstruct == PTRS || 
				    st->st_dstruct == ARRS) &&
				    st->st_tipe == USERTYPE)
				st = st->st_uptr;
			    if (st->st_dstruct == RECORDS)
				inrec = 1;
			    if (ei > bi)
				if (gotptr)
				    bi = ei + 2;
				else
				    bi = ei + 1;
			    }
			while (getfields);

			switch (st->st_dstruct)
			    {
			    case FILESTR:
				strcpy(filevar, scandata.si_name);
				buf[0] = '\0';
				break;
			    case ARRS:
				while (st->st_tipe == USERTYPE)
				    st = st->st_uptr;
				switch (st->st_tipe)
				    {
				    case CHARTY:
					/* NOTE: string type */
					strcat(lit, "%s");
					break;
				    case REALTY:
					strcat(lit, "%f");
					break;
				    default:
					strcat(lit, "%d");
					break;
				    }   /* end switch st_tipe */
				break;
			    default:
				switch (st->st_tipe)
				    {
				    case CHARTY:
					strcat(lit, "%c");
					break;
				    case STRINGTY:
					strcat(lit, "%s");
					break;
				    case REALTY:
					strcat(lit, "%f");
					break;
				    case OCTALTY:
					strcat(lit, "0%o");
					break;
				    case HEXTY:
					strcat(lit, "0x%x");
					break;
				    default:
					strcat(lit, "%d");
					break;
				    }   /* end switch st_tipe */
			    }  /* end switch st_dstruct */
			}   /* end else */
		}  /* end switch nexttoken */
	    if (nexttoken == RIGHTPAREN)
		break;
	    scanner();
	    }  /* end for */
	}   /* end if (nexttoken == LEFTPAREN) */
    if (ln)
	strcat(lit, "\\n");
    strcat(lit, "\"");
    tn->expression = malloc(strlen(buf) + strlen(lit) + strlen(filevar) + 16);
    if (tn->expression == NULL)
	myexit(-1,"");
    tn->expression[0] = '\0';
    if (strcmp(filevar, ""))
	{
	strcat(tn->expression, "fprintf(");	    /* + 8 */
	strcat(tn->expression, filevar);
	strcat(tn->expression, ", ");		    /* + 2 */
	}
    else
	strcat(tn->expression, "printf(");
    strcat(tn->expression, "\"");		    /* + 1 */
    strcat(tn->expression, lit);
    if (strcmp(buf,""))
	strcat(tn->expression, ", ");		    /* + 2 */
    strcat(tn->expression, buf);
    strcat(tn->expression,");");		    /* + 2 */
    scanner();
    if (nexttoken == SEMICOLON)
	{
	savecmt = 1;
	scanner();
	}
    return(tn);
}


mainstmts(parent)
    struct treenode *parent;
{
    struct stentry *st;
    struct treenode *tn, *holdfc;

    /*
     * Insert "main" proc before the first procedure
     */

    holdfc = parent->firstc;
    tn = gettn();
    parent->firstc = tn;
    tn->next = holdfc;

    tn->type = PDECLNODE;
    if (parent->lastc == NULL)
	parent->lastc = tn;
    st = getstentry();
    st->st_class = PROCC;
    st->st_nparams = 0;
    st->st_name = getname(4);
    strcpy(st->st_name, "main");
    tn->stdecl = st;
    addsymbol(st);
    blkentry(tn);
    lexlev++;
    savecmt = 1;
    scanner(0);		/* skip over "begin" */
    (void) statelist(tn->firstc->next->next->next, FUNCLEVEL);
    return;
}



/*
 * Error exit.  Due to a compiler internal error or encountering illegal
 * Pascal syntax.
 */

myexit(n,s)
    int n;		/* error number */
    char *s;		/* possible string to go with error */
{
    if (n == -1)
	fprintf(stderr, "\n\"%s\", line %d: Malloc failed.  Too many Pascal symbols  \n", currfile, linecounter);
    else
	fprintf(stderr, "\"%s\", line %d: Illegal Pascal Syntax: ",
		currfile, linecounter);
    switch(n) {
    case 1:
	fprintf(stderr, "Undefined symbol: '%s'.\n", s);
	break;
    case 2:
	fprintf(stderr, "'%s' expected.\n", s);
	break;
    case 3:
	fprintf(stderr, "%s.\n", s);
	break;
    case 4:
	fprintf(stderr, "Undefined field: '%s'.\n", s);
	break;
    case 5:
	fprintf(stderr, "Can't open file: '%s'.\n", s);
	break;
    case 6:
	fprintf(stderr, "Line too long (over 132 chars).\n", s);
	break;
    default:
	break;
    }
    fprintf(stderr, "Exiting Pascal to C translator.\n");
    sleep(1);			/* Give messages time before exit */
    exit();
}