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