1 /* Id: exec.c,v 1.14 2008/05/11 15:28:03 ragge Exp */
2 /* $NetBSD: exec.c,v 1.1.1.2 2010/06/03 18:57:46 plunky Exp $ */
3 /*
4 * Copyright(C) Caldera International Inc. 2001-2002. All rights reserved.
5 *
6 * Redistribution and use in source and binary forms, with or without
7 * modification, are permitted provided that the following conditions
8 * are met:
9 *
10 * Redistributions of source code and documentation must retain the above
11 * copyright notice, this list of conditions and the following disclaimer.
12 * Redistributions in binary form must reproduce the above copyright
13 * notice, this list of conditions and the following disclaimer in the
14 * documentation and/or other materials provided with the distribution.
15 * All advertising materials mentioning features or use of this software
16 * must display the following acknowledgement:
17 * This product includes software developed or owned by Caldera
18 * International, Inc.
19 * Neither the name of Caldera International, Inc. nor the names of other
20 * contributors may be used to endorse or promote products derived from
21 * this software without specific prior written permission.
22 *
23 * USE OF THE SOFTWARE PROVIDED FOR UNDER THIS LICENSE BY CALDERA
24 * INTERNATIONAL, INC. AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR
25 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
26 * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
27 * DISCLAIMED. IN NO EVENT SHALL CALDERA INTERNATIONAL, INC. BE LIABLE
28 * FOR ANY DIRECT, INDIRECT INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
29 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
30 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
31 * HOWEVER CAUSED AND ON ANY THEORY OFLIABILITY, WHETHER IN CONTRACT,
32 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
33 * IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
34 * POSSIBILITY OF SUCH DAMAGE.
35 */
36 #include <string.h>
37
38 #include "defines.h"
39 #include "defs.h"
40
41 /* Logical IF codes
42 */
43 LOCAL void exar2(int, bigptr, int, int);
44 LOCAL void pushctl(int code);
45 LOCAL void popctl(void);
46 LOCAL void poplab(void);
47 LOCAL void mkstfunct(struct bigblock *, bigptr);
48
49 void
exif(p)50 exif(p)
51 bigptr p;
52 {
53 pushctl(CTLIF);
54 ctlstack->elselabel = newlabel();
55 putif(p, ctlstack->elselabel);
56 }
57
58
59 void
exelif(p)60 exelif(p)
61 bigptr p;
62 {
63 if(ctlstack->ctltype == CTLIF)
64 {
65 if(ctlstack->endlabel == 0)
66 ctlstack->endlabel = newlabel();
67 putgoto(ctlstack->endlabel);
68 putlabel(ctlstack->elselabel);
69 ctlstack->elselabel = newlabel();
70 putif(p, ctlstack->elselabel);
71 }
72
73 else execerr("elseif out of place", 0);
74 }
75
76
77
78
79 void
exelse()80 exelse()
81 {
82 if(ctlstack->ctltype==CTLIF)
83 {
84 if(ctlstack->endlabel == 0)
85 ctlstack->endlabel = newlabel();
86 putgoto( ctlstack->endlabel );
87 putlabel(ctlstack->elselabel);
88 ctlstack->ctltype = CTLELSE;
89 }
90
91 else execerr("else out of place", 0);
92 }
93
94 void
exendif()95 exendif()
96 {
97 if(ctlstack->ctltype == CTLIF)
98 {
99 putlabel(ctlstack->elselabel);
100 if(ctlstack->endlabel)
101 putlabel(ctlstack->endlabel);
102 popctl();
103 }
104 else if(ctlstack->ctltype == CTLELSE)
105 {
106 putlabel(ctlstack->endlabel);
107 popctl();
108 }
109
110 else execerr("endif out of place", 0);
111 }
112
113
114
115 LOCAL void
pushctl(code)116 pushctl(code)
117 int code;
118 {
119 register int i;
120
121 if(++ctlstack >= lastctl)
122 fatal("nesting too deep");
123 ctlstack->ctltype = code;
124 for(i = 0 ; i < 4 ; ++i)
125 ctlstack->ctlabels[i] = 0;
126 ++blklevel;
127 }
128
129
130 LOCAL void
popctl()131 popctl()
132 {
133 if( ctlstack-- < ctls )
134 fatal("control stack empty");
135 --blklevel;
136 poplab();
137 }
138
139
140
141 LOCAL void
poplab()142 poplab()
143 {
144 register struct labelblock *lp;
145
146 for(lp = labeltab ; lp < highlabtab ; ++lp)
147 if(lp->labdefined)
148 {
149 /* mark all labels in inner blocks unreachable */
150 if(lp->blklevel > blklevel)
151 lp->labinacc = YES;
152 }
153 else if(lp->blklevel > blklevel)
154 {
155 /* move all labels referred to in inner blocks out a level */
156 lp->blklevel = blklevel;
157 }
158 }
159
160
161
162 /* BRANCHING CODE
163 */
164 void
exgoto(lab)165 exgoto(lab)
166 struct labelblock *lab;
167 {
168 putgoto(lab->labelno);
169 }
170
171
172
173
174 /*
175 * Found an assignment expression.
176 */
177 void
exequals(struct bigblock * lp,bigptr rp)178 exequals(struct bigblock *lp, bigptr rp)
179 {
180 if(lp->tag != TPRIM) {
181 err("assignment to a non-variable");
182 frexpr(lp);
183 frexpr(rp);
184 } else if(lp->b_prim.namep->vclass!=CLVAR && lp->b_prim.argsp) {
185 if(parstate >= INEXEC)
186 err("statement function amid executables");
187 else
188 mkstfunct(lp, rp);
189 } else {
190 if(parstate < INDATA)
191 enddcl();
192 puteq(mklhs(lp), rp);
193 }
194 }
195
196 /*
197 * Create a statement function; e.g. like "f(i)=i*i"
198 */
199 void
mkstfunct(struct bigblock * lp,bigptr rp)200 mkstfunct(struct bigblock *lp, bigptr rp)
201 {
202 struct bigblock *p;
203 struct bigblock *np;
204 chainp args;
205
206 np = lp->b_prim.namep;
207 if(np->vclass == CLUNKNOWN)
208 np->vclass = CLPROC;
209 else {
210 dclerr("redeclaration of statement function", np);
211 return;
212 }
213
214 np->b_name.vprocclass = PSTFUNCT;
215 np->vstg = STGSTFUNCT;
216 impldcl(np);
217 args = (lp->b_prim.argsp ? lp->b_prim.argsp->b_list.listp : NULL);
218 np->b_name.vardesc.vstfdesc = mkchain((void *)args, (void *)rp);
219
220 for( ; args ; args = args->chain.nextp)
221 if( (p = args->chain.datap)->tag!=TPRIM ||
222 p->b_prim.argsp || p->b_prim.fcharp || p->b_prim.lcharp)
223 err("non-variable argument in statement function definition");
224 else {
225 vardcl(args->chain.datap = p->b_prim.namep);
226 ckfree(p);
227 }
228 }
229
230
231 void
excall(name,args,nstars,labels)232 excall(name, args, nstars, labels)
233 struct bigblock *name;
234 struct bigblock *args;
235 int nstars;
236 struct labelblock *labels[ ];
237 {
238 register bigptr p;
239
240 settype(name, TYSUBR, 0);
241 p = mkfunct( mkprim(name, args, NULL, NULL) );
242 p->vtype = p->b_expr.leftp->vtype = TYINT;
243 if(nstars > 0)
244 putcmgo(p, nstars, labels);
245 else putexpr(p);
246 }
247
248
249 void
exstop(stop,p)250 exstop(stop, p)
251 int stop;
252 register bigptr p;
253 {
254 char *q;
255 int n;
256
257 if(p)
258 {
259 if( ! ISCONST(p) )
260 {
261 execerr("pause/stop argument must be constant", 0);
262 frexpr(p);
263 p = mkstrcon(0, 0);
264 }
265 else if( ISINT(p->vtype) )
266 {
267 q = convic(p->b_const.fconst.ci);
268 n = strlen(q);
269 if(n > 0)
270 {
271 p->b_const.fconst.ccp = copyn(n, q);
272 p->vtype = TYCHAR;
273 p->vleng = MKICON(n);
274 }
275 else
276 p = mkstrcon(0, 0);
277 }
278 else if(p->vtype != TYCHAR)
279 {
280 execerr("pause/stop argument must be integer or string", 0);
281 p = mkstrcon(0, 0);
282 }
283 }
284 else p = mkstrcon(0, 0);
285
286 putexpr( call1(TYSUBR, (stop ? "s_stop" : "s_paus"), p) );
287 }
288
289 /* DO LOOP CODE */
290
291 #define DOINIT par[0]
292 #define DOLIMIT par[1]
293 #define DOINCR par[2]
294
295 #define VARSTEP 0
296 #define POSSTEP 1
297 #define NEGSTEP 2
298
299 void
exdo(range,spec)300 exdo(range, spec)
301 int range;
302 chainp spec;
303 {
304 register bigptr p, q;
305 bigptr q1;
306 register struct bigblock *np;
307 chainp cp;
308 register int i;
309 int dotype, incsign = 0; /* XXX gcc */
310 struct bigblock *dovarp, *dostgp;
311 bigptr par[3];
312
313 pushctl(CTLDO);
314 dorange = ctlstack->dolabel = range;
315 np = spec->chain.datap;
316 ctlstack->donamep = NULL;
317 if(np->b_name.vdovar)
318 {
319 err1("nested loops with variable %s", varstr(VL,np->b_name.varname));
320 ctlstack->donamep = NULL;
321 return;
322 }
323
324 dovarp = mklhs( mkprim(np, 0,0,0) );
325 if( ! ONEOF(dovarp->vtype, MSKINT|MSKREAL) )
326 {
327 err("bad type on do variable");
328 return;
329 }
330 ctlstack->donamep = np;
331
332 np->b_name.vdovar = YES;
333 if( enregister(np) )
334 {
335 /* stgp points to a storage version, varp to a register version */
336 dostgp = dovarp;
337 dovarp = mklhs( mkprim(np, 0,0,0) );
338 }
339 else
340 dostgp = NULL;
341 dotype = dovarp->vtype;
342
343 for(i=0 , cp = spec->chain.nextp ; cp!=NULL && i<3 ; cp = cp->chain.nextp)
344 {
345 p = par[i++] = fixtype(cp->chain.datap);
346 if( ! ONEOF(p->vtype, MSKINT|MSKREAL) )
347 {
348 err("bad type on DO parameter");
349 return;
350 }
351 }
352
353 frchain(&spec);
354 switch(i)
355 {
356 case 0:
357 case 1:
358 err("too few DO parameters");
359 return;
360
361 default:
362 err("too many DO parameters");
363 return;
364
365 case 2:
366 DOINCR = MKICON(1);
367
368 case 3:
369 break;
370 }
371
372 ctlstack->endlabel = newlabel();
373 ctlstack->dobodylabel = newlabel();
374
375 if( ISCONST(DOLIMIT) )
376 ctlstack->domax = mkconv(dotype, DOLIMIT);
377 else
378 ctlstack->domax = fmktemp(dotype, NULL);
379
380 if( ISCONST(DOINCR) )
381 {
382 ctlstack->dostep = mkconv(dotype, DOINCR);
383 if( (incsign = conssgn(ctlstack->dostep)) == 0)
384 err("zero DO increment");
385 ctlstack->dostepsign = (incsign > 0 ? POSSTEP : NEGSTEP);
386 }
387 else
388 {
389 ctlstack->dostep = fmktemp(dotype, NULL);
390 ctlstack->dostepsign = VARSTEP;
391 ctlstack->doposlabel = newlabel();
392 ctlstack->doneglabel = newlabel();
393 }
394
395 if( ISCONST(ctlstack->domax) && ISCONST(DOINIT) && ctlstack->dostepsign!=VARSTEP)
396 {
397 puteq(cpexpr(dovarp), cpexpr(DOINIT));
398 if( onetripflag )
399 frexpr(DOINIT);
400 else
401 {
402 q = mkexpr(OPPLUS, MKICON(1),
403 mkexpr(OPMINUS, cpexpr(ctlstack->domax), cpexpr(DOINIT)) );
404 if(incsign != conssgn(q))
405 {
406 warn("DO range never executed");
407 putgoto(ctlstack->endlabel);
408 }
409 frexpr(q);
410 }
411 }
412 else if(ctlstack->dostepsign!=VARSTEP && !onetripflag)
413 {
414 if( ISCONST(ctlstack->domax) )
415 q = cpexpr(ctlstack->domax);
416 else
417 q = mkexpr(OPASSIGN, cpexpr(ctlstack->domax), DOLIMIT);
418
419 q1 = mkexpr(OPASSIGN, cpexpr(dovarp), DOINIT);
420 q = mkexpr( (ctlstack->dostepsign==POSSTEP ? OPLE : OPGE), q1, q);
421 putif(q, ctlstack->endlabel);
422 }
423 else
424 {
425 if(! ISCONST(ctlstack->domax) )
426 puteq( cpexpr(ctlstack->domax), DOLIMIT);
427 q = DOINIT;
428 if( ! onetripflag )
429 q = mkexpr(OPMINUS, q,
430 mkexpr(OPASSIGN, cpexpr(ctlstack->dostep), DOINCR) );
431 puteq( cpexpr(dovarp), q);
432 if(onetripflag && ctlstack->dostepsign==VARSTEP)
433 puteq( cpexpr(ctlstack->dostep), DOINCR);
434 }
435
436 if(ctlstack->dostepsign == VARSTEP)
437 {
438 if(onetripflag)
439 putgoto(ctlstack->dobodylabel);
440 else
441 putif( mkexpr(OPGE, cpexpr(ctlstack->dostep), MKICON(0)),
442 ctlstack->doneglabel );
443 putlabel(ctlstack->doposlabel);
444
445 p = cpexpr(dovarp);
446 putif( mkexpr(OPLE, mkexpr(OPASSIGN, p,
447 mkexpr(OPPLUS, cpexpr(dovarp), cpexpr(ctlstack->dostep))),
448 cpexpr(ctlstack->domax)), ctlstack->endlabel);
449 }
450 putlabel(ctlstack->dobodylabel);
451 if(dostgp)
452 puteq(dostgp, cpexpr(dovarp));
453 frexpr(dovarp);
454 }
455
456 /*
457 * Reached the end of a DO statement.
458 */
459 void
enddo(int here)460 enddo(int here)
461 {
462 register struct ctlframe *q;
463 register bigptr t;
464 struct bigblock *np;
465 struct bigblock *ap;
466 register int i;
467
468 while(here == dorange) {
469 if((np = ctlstack->donamep)) {
470
471 t = mklhs(mkprim(ctlstack->donamep, 0,0 ,0));
472 t = mkexpr(OPASSIGN, cpexpr(t),
473 mkexpr(OPPLUS, t, cpexpr(ctlstack->dostep)));
474
475 if(ctlstack->dostepsign == VARSTEP) {
476 putif( mkexpr(OPLE, cpexpr(ctlstack->dostep),
477 MKICON(0)), ctlstack->doposlabel);
478 putlabel(ctlstack->doneglabel);
479 putif( mkexpr(OPLT, t, ctlstack->domax),
480 ctlstack->dobodylabel);
481 } else
482 putif( mkexpr( (ctlstack->dostepsign==POSSTEP ?
483 OPGT : OPLT), t, ctlstack->domax),
484 ctlstack->dobodylabel);
485 putlabel(ctlstack->endlabel);
486 if((ap = memversion(np)))
487 puteq(ap, mklhs( mkprim(np,0,0,0)) );
488 for(i = 0 ; i < 4 ; ++i)
489 ctlstack->ctlabels[i] = 0;
490 deregister(ctlstack->donamep);
491 ctlstack->donamep->b_name.vdovar = NO;
492 frexpr(ctlstack->dostep);
493 }
494
495 popctl();
496 dorange = 0;
497 for(q = ctlstack ; q>=ctls ; --q)
498 if(q->ctltype == CTLDO) {
499 dorange = q->dolabel;
500 break;
501 }
502 }
503 }
504
505 void
exassign(vname,labelval)506 exassign(vname, labelval)
507 struct bigblock *vname;
508 struct labelblock *labelval;
509 {
510 struct bigblock *p;
511
512 p = mklhs(mkprim(vname,0,0,0));
513 if( ! ONEOF(p->vtype, MSKINT|MSKADDR) )
514 err("noninteger assign variable");
515 else
516 puteq(p, mkaddcon(labelval->labelno) );
517 }
518
519
520 void
exarif(expr,neglab,zerlab,poslab)521 exarif(expr, neglab, zerlab, poslab)
522 bigptr expr;
523 struct labelblock *neglab, *zerlab, *poslab;
524 {
525 register int lm, lz, lp;
526
527 lm = neglab->labelno;
528 lz = zerlab->labelno;
529 lp = poslab->labelno;
530 expr = fixtype(expr);
531
532 if( ! ONEOF(expr->vtype, MSKINT|MSKREAL) )
533 {
534 err("invalid type of arithmetic if expression");
535 frexpr(expr);
536 }
537 else
538 {
539 if(lm == lz)
540 exar2(OPLE, expr, lm, lp);
541 else if(lm == lp)
542 exar2(OPNE, expr, lm, lz);
543 else if(lz == lp)
544 exar2(OPGE, expr, lz, lm);
545 else
546 prarif(expr, lm, lz, lp);
547 }
548 }
549
550
551
exar2(op,e,l1,l2)552 LOCAL void exar2(op, e, l1, l2)
553 int op;
554 bigptr e;
555 int l1, l2;
556 {
557 putif( mkexpr(op, e, MKICON(0)), l2);
558 putgoto(l1);
559 }
560
561 void
exreturn(p)562 exreturn(p)
563 register bigptr p;
564 {
565 if(p && (proctype!=TYSUBR || procclass!=CLPROC) )
566 {
567 err("alternate return in nonsubroutine");
568 p = 0;
569 }
570
571 if(p)
572 {
573 putforce(TYINT, p);
574 putgoto(retlabel);
575 }
576 else
577 putgoto(procclass==TYSUBR ? ret0label : retlabel);
578 }
579
580
581 void
exasgoto(labvar)582 exasgoto(labvar)
583 bigptr labvar;
584 {
585 register struct bigblock *p;
586
587 p = mklhs( mkprim(labvar,0,0,0) );
588 if( ! ISINT(p->vtype) )
589 err("assigned goto variable must be integer");
590 else
591 putbranch(p);
592 }
593