1 /****************************************************************
2 Copyright 1990 by AT&T Bell Laboratories and Bellcore.
4 Permission to use, copy, modify, and distribute this software
5 and its documentation for any purpose and without fee is hereby
6 granted, provided that the above copyright notice appear in all
7 copies and that both that the copyright notice and this
8 permission notice and warranty disclaimer appear in supporting
9 documentation, and that the names of AT&T Bell Laboratories or
10 Bellcore or any of their entities not be used in advertising or
11 publicity pertaining to distribution of the software without
12 specific, written prior permission.
14 AT&T and Bellcore disclaim all warranties with regard to this
15 software, including all implied warranties of merchantability
16 and fitness. In no event shall AT&T or Bellcore be liable for
17 any special, indirect or consequential damages or any damages
18 whatsoever resulting from loss of use, data or profits, whether
19 in an action of contract, negligence or other tortious action,
20 arising out of or in connection with the use or performance of
22 ****************************************************************/
31 /* Put out a constant integer */
37 fprintf(fp, "\t%ld\n", n);
42 /* Put out a constant address */
48 fprintf(fp, "\tL%ld\n", a);
59 char cdsbuf0[64], cdsbuf1[64];
67 x0 = cds(dtos(x->Const.cd[0]), cdsbuf0);
68 x1 = cds(dtos(x->Const.cd[1]), cdsbuf1);
70 fprintf(fp, "\t%s %s\n", x0, x1);
73 fprintf(fp, "\t%s\n", x->vstg ? x->Const.cds[0]
74 : cds(dtos(x->Const.cd[0]), cdsbuf0));
78 char *memname(stg, mem)
88 sprintf(s, "_%s", extsymtab[mem].cextname);
93 sprintf(s, "v.%ld", mem);
97 sprintf(s, "L%ld", mem);
101 sprintf(s, "q.%ld", mem+eqvstart);
105 badstg("memname", stg);
110 /* make_int_expr -- takes an arbitrary expression, and replaces all
111 occurrences of arguments with indirection */
113 expptr make_int_expr (e)
119 if (e -> addrblock.vstg == STGARG)
120 e = mkexpr (OPWHATSIN, e, ENULL);
123 e -> exprblock.leftp = make_int_expr (e -> exprblock.leftp);
124 e -> exprblock.rightp = make_int_expr (e -> exprblock.rightp);
131 } /* make_int_expr */
135 /* prune_left_conv -- used in prolog() to strip type cast away from
136 left-hand side of parameter adjustments. This is necessary to avoid
137 error messages from cktype() */
139 expptr prune_left_conv (e)
142 struct Exprblock *leftp;
144 if (e && e -> tag == TEXPR && e -> exprblock.leftp &&
145 e -> exprblock.leftp -> tag == TEXPR) {
146 leftp = &(e -> exprblock.leftp -> exprblock);
147 if (leftp -> opcode == OPCONV) {
148 e -> exprblock.leftp = leftp -> leftp;
149 free ((charptr) leftp);
154 } /* prune_left_conv */
157 static int wrote_comment;
158 static FILE *comment_file;
163 if (!wrote_comment) {
165 nice_printf (comment_file, "/* Parameter adjustments */\n");
174 register struct Entrypoint *ep;
177 ac = (int *)ckalloc(nallargs*sizeof(int));
179 for(ep = entries; ep; ep = ep->entnextp)
180 for(cp = ep->arglist; cp; cp = cp->nextp)
181 if (q = (Namep)cp->datap)
190 int addif, addif0, i, nd, size;
193 register struct Dimblock *dp;
195 if(procclass == CLBLOCK)
198 comment_file = outfile;
201 /* Compute the base addresses and offsets for the array parameters, and
202 assign these values to local variables */
204 addif = addif0 = nentry > 1;
205 for(; p ; p = p->nextp)
207 q = (Namep) p->datap;
208 if(dp = q->vdim) /* if this param is an array ... */
212 /* See whether to protect the following with an if. */
213 /* This only happens when there are multiple entries. */
219 if (ac[q->argno] == nentry)
222 || dp->baseoffset->constblock.Const.ci)
224 else for(addif = i = 0; i <= nd; i++)
225 if (dp->dims[i].dimexpr
226 && (i < nd || !q->vlastdim)) {
232 nice_printf(outfile, "if (%s) {\n", /*}*/
237 for(i = 0 ; i <= nd; ++i)
239 /* Store the variable length of each dimension (which is fixed upon
240 runtime procedure entry) into a local variable */
242 if ((Q = dp->dims[i].dimexpr)
243 && (i < nd || !q->vlastdim)) {
244 expr = (expptr)cpexpr(Q);
246 out_and_free_statement (outfile, mkexpr (OPASSIGN,
247 fixtype(cpexpr(dp->dims[i].dimsize)), expr));
248 } /* if dp -> dims[i].dimexpr */
250 /* size will equal the size of a single element, or -1 if the type is
251 variable length character type */
253 size = typesize[ q->vtype ];
254 if(q->vtype == TYCHAR)
255 if( ISICON(q->vleng) )
256 size *= q->vleng->constblock.Const.ci;
260 /* Fudge the argument pointers for arrays so subscripts
261 * are 0-based. Not done if array bounds are being checked.
265 /* Compute the base offset for this procedure */
268 out_and_free_statement (outfile, mkexpr (OPASSIGN,
269 cpexpr(fixtype(dp->baseoffset)),
270 cpexpr(fixtype(dp->basexpr))));
271 } /* if dp -> basexpr */
277 /* If the base of this array has a variable adjustment ... */
279 tp = (expptr) cpexpr (dp -> baseoffset);
280 if(size < 0 || q -> vtype == TYCHAR)
281 tp = mkexpr (OPSTAR, tp, cpexpr (q -> vleng));
284 tp = mkexpr (OPMINUSEQ,
285 mkconv (TYADDR, (expptr)p->datap),
286 mkconv(TYINT, fixtype
288 /* Avoid type clash by removing the type conversion */
289 tp = prune_left_conv (tp);
290 out_and_free_statement (outfile, tp);
291 } else if(dp->baseoffset->constblock.Const.ci != 0) {
293 /* if the base of this array has a nonzero constant adjustment ... */
298 if(size > 0 && q -> vtype != TYCHAR) {
299 tp = prune_left_conv (mkexpr (OPMINUSEQ,
300 mkconv (TYADDR, (expptr)p->datap),
301 mkconv (TYINT, fixtype
302 (cpexpr (dp->baseoffset)))));
303 out_and_free_statement (outfile, tp);
305 tp = prune_left_conv (mkexpr (OPMINUSEQ,
306 mkconv (TYADDR, (expptr)p->datap),
307 mkconv (TYINT, fixtype
308 (mkexpr (OPSTAR, cpexpr (dp -> baseoffset),
309 cpexpr (q -> vleng))))));
310 out_and_free_statement (outfile, tp);
312 } /* if dp -> baseoffset -> const */
313 } /* if !checksubs */
316 nice_printf(outfile, /*{*/ "}\n");
322 nice_printf (outfile, "\n/* Function Body */\n");