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