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