xref: /csrg-svn/usr.bin/pascal/src/sconv.c (revision 10650)
110358Smckusick /* Copyright (c) 1983 Regents of the University of California */
210358Smckusick 
3*10650Speter static	char sccsid[] = "@(#)sconv.c 1.2 02/01/83";
410358Smckusick 
510358Smckusick     /*
610358Smckusick      *	functions to help pi put out
710358Smckusick      *	polish postfix binary portable c compiler intermediate code
810358Smckusick      *	thereby becoming the portable pascal compiler
910358Smckusick      */
1010358Smckusick 
1110358Smckusick #include	"whoami.h"
1210358Smckusick #ifdef PC
1310358Smckusick #include	"0.h"
1410358Smckusick #include	"pcops.h"
1510358Smckusick 
1610358Smckusick     /*
1710358Smckusick      *	this routine enforces ``the usual arithmetic conversions''
1810358Smckusick      *	all integral operands are converted to ints.
1910358Smckusick      *	if either operand is a double, both are made to be double.
2010358Smckusick      *	this routine takes struct nl *'s for the types,
2110358Smckusick      *	and returns both the struct nl * and the p2type for the result.
2210358Smckusick      */
2310358Smckusick tuac(thistype, thattype, resulttypep, resultp2typep)
2410358Smckusick     struct nl	*thistype;
2510358Smckusick     struct nl	*thattype;
2610358Smckusick     struct nl	**resulttypep;
2710358Smckusick     int		*resultp2typep;
2810358Smckusick {
2910358Smckusick     int		thisp2type = p2type(thistype);
3010358Smckusick     int		thatp2type = p2type(thattype);
3110358Smckusick 
3210358Smckusick     *resulttypep = thistype;
3310358Smckusick     *resultp2typep = thisp2type;
3410358Smckusick 	/*
3510358Smckusick 	 *	should only be passed scalars
3610358Smckusick 	 */
3710358Smckusick     if (isnta(thistype,"sbcid") || isnta(thattype,"sbcid")) {
3810358Smckusick 	return;
3910358Smckusick     }
40*10650Speter     if (thisp2type == P2CHAR || thisp2type == P2SHORT) {
4110358Smckusick 	*resultp2typep = P2INT;
4210358Smckusick 	*resulttypep = nl + T4INT;
4310358Smckusick     }
4410358Smckusick     if (*resultp2typep == P2INT && thatp2type == P2DOUBLE) {
4510358Smckusick 	*resultp2typep = P2DOUBLE;
4610358Smckusick 	*resulttypep = nl + TDOUBLE;
4710358Smckusick     }
4810358Smckusick     sconv(thisp2type, *resultp2typep);
4910358Smckusick }
5010358Smckusick 
5110358Smckusick     /*
5210358Smckusick      *	this routine will emit sconv operators when it thinks they are needed.
5310358Smckusick      *	this is code generator specific, rather than machine-specific.
5410358Smckusick      *	this routine takes p2types for arguments, not struct nl *'s.
5510358Smckusick      */
5610358Smckusick #ifdef vax
5710358Smckusick     /*
5810358Smckusick      *	the vax code genrator is very good, this routine is extremely boring.
5910358Smckusick      */
6010358Smckusick sconv(fromp2type, top2type)
6110358Smckusick     int	fromp2type;
6210358Smckusick     int	top2type;
6310358Smckusick {
6410358Smckusick 
6510358Smckusick     switch (top2type) {
6610358Smckusick 	case P2CHAR:
6710358Smckusick 	case P2SHORT:
6810358Smckusick 	case P2INT:
6910358Smckusick 	    switch (fromp2type) {
7010358Smckusick 		case P2CHAR:
7110358Smckusick 		case P2SHORT:
7210358Smckusick 		case P2INT:
7310358Smckusick 		case P2DOUBLE:
7410358Smckusick 			return;	/* pass1 knows how to do these */
7510358Smckusick 		default:
7610358Smckusick 			return;
7710358Smckusick 	    }
7810358Smckusick 	case P2DOUBLE:
7910358Smckusick 	    switch (fromp2type) {
8010358Smckusick 		case P2CHAR:
8110358Smckusick 		case P2SHORT:
8210358Smckusick 		case P2INT:
8310358Smckusick 			putop(P2SCONV, P2DOUBLE);
8410358Smckusick 			return;
8510358Smckusick 		case P2DOUBLE:
8610358Smckusick 			return;
8710358Smckusick 		default:
8810358Smckusick 			return;
8910358Smckusick 	    }
9010358Smckusick 	default:
9110358Smckusick 		return;
9210358Smckusick     }
9310358Smckusick }
9410358Smckusick #endif vax
9510358Smckusick #ifdef mc68000
9610358Smckusick     /*
9710358Smckusick      *	i don't know how much to trust the mc68000 compiler,
9810358Smckusick      *	so this routine is full.
9910358Smckusick      */
10010358Smckusick sconv(fromp2type, top2type)
10110358Smckusick     int	fromp2type;
10210358Smckusick     int	top2type;
10310358Smckusick {
10410358Smckusick 
10510358Smckusick     switch (top2type) {
10610358Smckusick 	case P2CHAR:
10710358Smckusick 	    switch (fromp2type) {
10810358Smckusick 		case P2CHAR:
10910358Smckusick 			return;
11010358Smckusick 		case P2SHORT:
11110358Smckusick 		case P2INT:
11210358Smckusick 		case P2DOUBLE:
11310358Smckusick 			putop(P2SCONV, P2CHAR);
11410358Smckusick 			return;
11510358Smckusick 		default:
11610358Smckusick 			return;
11710358Smckusick 	    }
11810358Smckusick 	case P2SHORT:
11910358Smckusick 	    switch (fromp2type) {
12010358Smckusick 		case P2SHORT:
12110358Smckusick 			return;
12210358Smckusick 		case P2CHAR:
12310358Smckusick 		case P2INT:
12410358Smckusick 		case P2DOUBLE:
12510358Smckusick 			putop(P2SCONV, P2SHORT);
12610358Smckusick 			return;
12710358Smckusick 		default:
12810358Smckusick 			return;
12910358Smckusick 	    }
13010358Smckusick 	case P2INT:
13110358Smckusick 	    switch (fromp2type) {
13210358Smckusick 		case P2INT:
13310358Smckusick 			return;
13410358Smckusick 		case P2CHAR:
13510358Smckusick 		case P2SHORT:
13610358Smckusick 		case P2DOUBLE:
13710358Smckusick 			putop(P2SCONV, P2INT);
13810358Smckusick 			return;
13910358Smckusick 		default:
14010358Smckusick 			return;
14110358Smckusick 	    }
14210358Smckusick 	case P2DOUBLE:
14310358Smckusick 	    switch (fromp2type) {
14410358Smckusick 		case P2DOUBLE:
14510358Smckusick 			return;
14610358Smckusick 		case P2CHAR:
14710358Smckusick 		case P2SHORT:
14810358Smckusick 		case P2INT:
14910358Smckusick 			putop(P2SCONV, P2DOUBLE);
15010358Smckusick 			return;
15110358Smckusick 		default:
15210358Smckusick 			return;
15310358Smckusick 	    }
15410358Smckusick 	default:
15510358Smckusick 		return;
15610358Smckusick     }
15710358Smckusick }
15810358Smckusick #endif mc68000
15910358Smckusick #endif PC
160