[unix-history] / usr / src / usr.bin / pascal / src / sconv.c

/*-
 * Copyright (c) 1980 The Regents of the University of California.
 * All rights reserved.
 *
 * %sccs.include.redist.c%
 */

#ifndef lint
static char sccsid[] = "@(#)sconv.c	5.3 (Berkeley) %G%";
#endif /* not lint */

    /*
     *	functions to help pi put out
     *	polish postfix binary portable c compiler intermediate code
     *	thereby becoming the portable pascal compiler
     */

#include	"whoami.h"
#ifdef PC
#include	"0.h"
#include	<pcc.h>

    /*
     *	this routine enforces ``the usual arithmetic conversions''
     *	all integral operands are converted to ints.
     *	if either operand is a double, both are made to be double.
     *	this routine takes struct nl *'s for the types,
     *	and returns both the struct nl * and the p2type for the result.
     */
tuac(thistype, thattype, resulttypep, resultp2typep)
    struct nl	*thistype;
    struct nl	*thattype;
    struct nl	**resulttypep;
    int		*resultp2typep;
{
    int		thisp2type = p2type(thistype);
    int		thatp2type = p2type(thattype);

    *resulttypep = thistype;
    *resultp2typep = thisp2type;
	/*
	 *	should only be passed scalars
	 */
    if (isnta(thistype,"sbcid") || isnta(thattype,"sbcid")) {
	return;
    }
    if (thisp2type == PCCT_CHAR || thisp2type == PCCT_SHORT) {
	*resultp2typep = PCCT_INT;
	*resulttypep = nl + T4INT;
    }
    if (*resultp2typep == PCCT_INT && thatp2type == PCCT_DOUBLE) {
	*resultp2typep = PCCT_DOUBLE;
	*resulttypep = nl + TDOUBLE;
    }
    sconv(thisp2type, *resultp2typep);
}
    
    /*
     *	this routine will emit sconv operators when it thinks they are needed.
     *	this is code generator specific, rather than machine-specific.
     *	this routine takes p2types for arguments, not struct nl *'s.
     */
#if defined(vax) || defined(tahoe)
    /*
     *	the vax code genrator is very good, this routine is extremely boring.
     */
sconv(fromp2type, top2type)
    int	fromp2type;
    int	top2type;
{

    switch (top2type) {
	case PCCT_CHAR:
	case PCCT_SHORT:
	case PCCT_INT:
	    switch (fromp2type) {
		case PCCT_CHAR:
		case PCCT_SHORT:
		case PCCT_INT:
		case PCCT_DOUBLE:
			return;	/* pass1 knows how to do these */
		default:
			return;
	    }
	case PCCT_DOUBLE:
	    switch (fromp2type) {
		case PCCT_CHAR:
		case PCCT_SHORT:
		case PCCT_INT:
			putop(PCC_SCONV, PCCT_DOUBLE);
			return;
		case PCCT_DOUBLE:
			return;
		default:
			return;
	    }
	default:
		return;
    }
}
#endif vax || tahoe
#ifdef mc68000
    /*
     *	i don't know how much to trust the mc68000 compiler,
     *	so this routine is full.
     */
sconv(fromp2type, top2type)
    int	fromp2type;
    int	top2type;
{

    switch (top2type) {
	case PCCT_CHAR:
	    switch (fromp2type) {
		case PCCT_CHAR:
			return;
		case PCCT_SHORT:
		case PCCT_INT:
		case PCCT_DOUBLE:
			putop(PCC_SCONV, PCCT_CHAR);
			return;
		default:
			return;
	    }
	case PCCT_SHORT:
	    switch (fromp2type) {
		case PCCT_SHORT:
			return;
		case PCCT_CHAR:
		case PCCT_INT:
		case PCCT_DOUBLE:
			putop(PCC_SCONV, PCCT_SHORT);
			return;
		default:
			return;
	    }
	case PCCT_INT:
	    switch (fromp2type) {
		case PCCT_INT:
			return;
		case PCCT_CHAR:
		case PCCT_SHORT:
		case PCCT_DOUBLE:
			putop(PCC_SCONV, PCCT_INT);
			return;
		default:
			return;
	    }
	case PCCT_DOUBLE:
	    switch (fromp2type) {
		case PCCT_DOUBLE:
			return;
		case PCCT_CHAR:
		case PCCT_SHORT:
		case PCCT_INT:
			putop(PCC_SCONV, PCCT_DOUBLE);
			return;
		default:
			return;
	    }
	default:
		return;
    }
}
#endif mc68000
#endif PC
Commit	Line	Data
0fc6e47b KB	1	/*-
	2	* Copyright (c) 1980 The Regents of the University of California.
	3	* All rights reserved.
	4	*
	5	* %sccs.include.redist.c%
252367af	6	*/
93009ed7	7
72fbef68	8	#ifndef lint
0fc6e47b KB	9	static char sccsid[] = "@(#)sconv.c 5.3 (Berkeley) %G%";
0fc6e47b KB	10	#endif /* not lint */
93009ed7 KM	11
	12	/*
	13	* functions to help pi put out
	14	* polish postfix binary portable c compiler intermediate code
	15	* thereby becoming the portable pascal compiler
	16	*/
	17
	18	#include "whoami.h"
	19	#ifdef PC
	20	#include "0.h"
c60bfb0d	21	#include <pcc.h>
93009ed7 KM	22
	23	/*
	24	* this routine enforces ``the usual arithmetic conversions''
	25	* all integral operands are converted to ints.
	26	* if either operand is a double, both are made to be double.
	27	* this routine takes struct nl *'s for the types,
	28	* and returns both the struct nl * and the p2type for the result.
	29	*/
	30	tuac(thistype, thattype, resulttypep, resultp2typep)
	31	struct nl *thistype;
	32	struct nl *thattype;
	33	struct nl **resulttypep;
	34	int *resultp2typep;
	35	{
	36	int thisp2type = p2type(thistype);
	37	int thatp2type = p2type(thattype);
	38
	39	*resulttypep = thistype;
	40	*resultp2typep = thisp2type;
	41	/*
	42	* should only be passed scalars
	43	*/
	44	if (isnta(thistype,"sbcid") \|\| isnta(thattype,"sbcid")) {
	45	return;
	46	}
c60bfb0d RC	47	if (thisp2type == PCCT_CHAR \|\| thisp2type == PCCT_SHORT) {
c60bfb0d RC	48	*resultp2typep = PCCT_INT;
93009ed7 KM	49	*resulttypep = nl + T4INT;
93009ed7 KM	50	}
c60bfb0d RC	51	if (*resultp2typep == PCCT_INT && thatp2type == PCCT_DOUBLE) {
c60bfb0d RC	52	*resultp2typep = PCCT_DOUBLE;
93009ed7 KM	53	*resulttypep = nl + TDOUBLE;
	54	}
	55	sconv(thisp2type, *resultp2typep);
	56	}
	57
	58	/*
	59	* this routine will emit sconv operators when it thinks they are needed.
	60	* this is code generator specific, rather than machine-specific.
	61	* this routine takes p2types for arguments, not struct nl *'s.
	62	*/
fe8ff1f7	63	#if defined(vax) \|\| defined(tahoe)
93009ed7 KM	64	/*
	65	* the vax code genrator is very good, this routine is extremely boring.
	66	*/
	67	sconv(fromp2type, top2type)
	68	int fromp2type;
	69	int top2type;
	70	{
	71
	72	switch (top2type) {
c60bfb0d RC	73	case PCCT_CHAR:
	74	case PCCT_SHORT:
	75	case PCCT_INT:
93009ed7	76	switch (fromp2type) {
c60bfb0d RC	77	case PCCT_CHAR:
	78	case PCCT_SHORT:
	79	case PCCT_INT:
	80	case PCCT_DOUBLE:
93009ed7 KM	81	return; /* pass1 knows how to do these */
	82	default:
	83	return;
	84	}
c60bfb0d	85	case PCCT_DOUBLE:
93009ed7	86	switch (fromp2type) {
c60bfb0d RC	87	case PCCT_CHAR:
	88	case PCCT_SHORT:
	89	case PCCT_INT:
	90	putop(PCC_SCONV, PCCT_DOUBLE);
93009ed7	91	return;
c60bfb0d	92	case PCCT_DOUBLE:
93009ed7 KM	93	return;
	94	default:
	95	return;
	96	}
	97	default:
	98	return;
	99	}
	100	}
fe8ff1f7	101	#endif vax \|\| tahoe
93009ed7 KM	102	#ifdef mc68000
	103	/*
	104	* i don't know how much to trust the mc68000 compiler,
	105	* so this routine is full.
	106	*/
	107	sconv(fromp2type, top2type)
	108	int fromp2type;
	109	int top2type;
	110	{
	111
	112	switch (top2type) {
c60bfb0d	113	case PCCT_CHAR:
93009ed7	114	switch (fromp2type) {
c60bfb0d	115	case PCCT_CHAR:
93009ed7	116	return;
c60bfb0d RC	117	case PCCT_SHORT:
	118	case PCCT_INT:
	119	case PCCT_DOUBLE:
	120	putop(PCC_SCONV, PCCT_CHAR);
93009ed7 KM	121	return;
	122	default:
	123	return;
	124	}
c60bfb0d	125	case PCCT_SHORT:
93009ed7	126	switch (fromp2type) {
c60bfb0d	127	case PCCT_SHORT:
93009ed7	128	return;
c60bfb0d RC	129	case PCCT_CHAR:
	130	case PCCT_INT:
	131	case PCCT_DOUBLE:
	132	putop(PCC_SCONV, PCCT_SHORT);
93009ed7 KM	133	return;
	134	default:
	135	return;
	136	}
c60bfb0d	137	case PCCT_INT:
93009ed7	138	switch (fromp2type) {
c60bfb0d	139	case PCCT_INT:
93009ed7	140	return;
c60bfb0d RC	141	case PCCT_CHAR:
	142	case PCCT_SHORT:
	143	case PCCT_DOUBLE:
	144	putop(PCC_SCONV, PCCT_INT);
93009ed7 KM	145	return;
	146	default:
	147	return;
	148	}
c60bfb0d	149	case PCCT_DOUBLE:
93009ed7	150	switch (fromp2type) {
c60bfb0d	151	case PCCT_DOUBLE:
93009ed7	152	return;
c60bfb0d RC	153	case PCCT_CHAR:
	154	case PCCT_SHORT:
	155	case PCCT_INT:
	156	putop(PCC_SCONV, PCCT_DOUBLE);
93009ed7 KM	157	return;
	158	default:
	159	return;
	160	}
	161	default:
	162	return;
	163	}
	164	}
	165	#endif mc68000
	166	#endif PC