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