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