home *** CD-ROM | disk | FTP | other *** search
- # include "IndexSha.h"
- # include "yyIShape.w"
- # include <stdio.h>
- # if defined __STDC__ | defined __cplusplus
- # include <stdlib.h>
- # else
- extern void exit ();
- # endif
- # include "Tree.h"
- # include "Definiti.h"
-
- # ifndef NULL
- # define NULL 0L
- # endif
- # ifndef false
- # define false 0
- # endif
- # ifndef true
- # define true 1
- # endif
-
- # ifdef yyInline
- # define yyALLOC(tree, free, max, alloc, nodesize, make, ptr, kind) \
- if ((ptr = (tree) free) >= (tree) max) ptr = alloc (); \
- free += nodesize [kind]; \
- ptr->yyHead.yyMark = 0; \
- ptr->Kind = kind;
- # else
- # define yyALLOC(tree, free, max, alloc, nodesize, make, ptr, kind) ptr = make (kind);
- # endif
-
- # define yyWrite(s) (void) fputs (s, yyf)
- # define yyWriteNl (void) fputc ('\n', yyf)
-
- # line 48 "IndexShapes.puma"
-
- # include <stdio.h>
- # include "Idents.h"
- # include "StringMe.h"
- # include "protocol.h"
-
- # include "Expressi.h" /* AddConstant */
-
- # include "Shapes.h"
-
-
- static FILE * yyf = stdout;
-
- static void yyAbort
- # ifdef __cplusplus
- (char * yyFunction)
- # else
- (yyFunction) char * yyFunction;
- # endif
- {
- (void) fprintf (stderr, "Error: module IndexShapes, routine %s failed\n", yyFunction);
- exit (1);
- }
-
- tTree FindShapeExp ARGS((tTree actual, tTree fstart, tTree fstop, tTree finc, tTree exp));
- static tTree IndexSub ARGS((tTree exp, tTree sub));
- static tTree IndexAdd ARGS((tTree exp, tTree add));
- static tTree IndexDivMult ARGS((tTree exp, tTree divisor, tTree mult));
- static tTree ConstIndexDivMult ARGS((tTree exp, int divisor, int mult));
- static tTree MultConstant ARGS((tTree exp, int c));
- static tTree DivConstant ARGS((tTree exp, int c));
- static tTree MinusExpression ARGS((tTree exp));
- static void GetIncrement ARGS((tTree inc, bool * found, int * val));
- static bool IsOneIncrement ARGS((tTree t));
- tTree NormalArrayIndexes ARGS((tTree t));
-
- tTree FindShapeExp
- # if defined __STDC__ | defined __cplusplus
- (register tTree actual, register tTree fstart, register tTree fstop, register tTree finc, register tTree exp)
- # else
- (actual, fstart, fstop, finc, exp)
- register tTree actual;
- register tTree fstart;
- register tTree fstop;
- register tTree finc;
- register tTree exp;
- # endif
- {
- if (actual->Kind == kSLICE_EXP) {
- # line 94 "IndexShapes.puma"
- {
- tTree newexp;
- {
- # line 96 "IndexShapes.puma"
-
- # line 98 "IndexShapes.puma"
-
-
- newexp = exp;
-
- newexp = IndexSub (newexp, fstart);
-
- newexp = IndexDivMult (newexp, finc, actual->SLICE_EXP.INC);
-
- newexp = IndexAdd (newexp, actual->SLICE_EXP.START);
-
-
- }
- {
- return newexp;
- }
- }
-
- }
- yyAbort ("FindShapeExp");
- }
-
- static tTree IndexSub
- # if defined __STDC__ | defined __cplusplus
- (register tTree exp, register tTree sub)
- # else
- (exp, sub)
- register tTree exp;
- register tTree sub;
- # endif
- {
- # line 121 "IndexShapes.puma"
-
- bool found;
- int val;
-
- # line 126 "IndexShapes.puma"
- {
- # line 127 "IndexShapes.puma"
- GetIntConstValue (sub, & found, & val);
- # line 128 "IndexShapes.puma"
- if (! ((found == true))) goto yyL1;
- }
- return AddConstant (exp, - val);
- yyL1:;
-
- # line 132 "IndexShapes.puma"
- return mOP_EXP (mOP_MINUS (), exp, sub);
-
- }
-
- static tTree IndexAdd
- # if defined __STDC__ | defined __cplusplus
- (register tTree exp, register tTree add)
- # else
- (exp, add)
- register tTree exp;
- register tTree add;
- # endif
- {
- # line 157 "IndexShapes.puma"
-
- bool found;
- int val;
-
- # line 162 "IndexShapes.puma"
- {
- # line 163 "IndexShapes.puma"
- GetIntConstValue (add, & found, & val);
- # line 164 "IndexShapes.puma"
- if (! ((found == true))) goto yyL1;
- }
- return AddConstant (exp, val);
- yyL1:;
-
- if (exp->Kind == kOP_EXP) {
- if (exp->OP_EXP.EXP_OP->Kind == kOP_MINUS) {
- # line 168 "IndexShapes.puma"
- {
- # line 169 "IndexShapes.puma"
- GetConstDifference (add, exp->OP_EXP.OPND2, & found, & val);
- # line 170 "IndexShapes.puma"
- if (! ((found == true))) goto yyL2;
- }
- return AddConstant (exp->OP_EXP.OPND1, val);
- yyL2:;
-
- # line 174 "IndexShapes.puma"
- {
- # line 175 "IndexShapes.puma"
- GetIntConstValue (exp->OP_EXP.OPND2, & found, & val);
- # line 176 "IndexShapes.puma"
- if (! ((found == true))) goto yyL3;
- }
- return IndexAdd (exp->OP_EXP.OPND1, AddConstant (add, - val));
- yyL3:;
-
- }
- if (exp->OP_EXP.EXP_OP->Kind == kOP_PLUS) {
- # line 180 "IndexShapes.puma"
- {
- # line 181 "IndexShapes.puma"
- GetIntConstValue (exp->OP_EXP.OPND2, & found, & val);
- # line 182 "IndexShapes.puma"
- if (! ((found == true))) goto yyL4;
- }
- return IndexAdd (exp->OP_EXP.OPND1, AddConstant (add, val));
- yyL4:;
-
- }
- }
- # line 186 "IndexShapes.puma"
- return mOP_EXP (mOP_PLUS (), exp, add);
-
- }
-
- static tTree IndexDivMult
- # if defined __STDC__ | defined __cplusplus
- (register tTree exp, register tTree divisor, register tTree mult)
- # else
- (exp, divisor, mult)
- register tTree exp;
- register tTree divisor;
- register tTree mult;
- # endif
- {
- # line 202 "IndexShapes.puma"
- {
- bool yyV1;
- int yyV2;
- bool yyV3;
- int yyV4;
- {
- # line 203 "IndexShapes.puma"
- GetIncrement (divisor, & yyV1, & yyV2);
- # line 204 "IndexShapes.puma"
- if (! ((yyV1 == true))) goto yyL1;
- {
- # line 205 "IndexShapes.puma"
- GetIncrement (mult, & yyV3, & yyV4);
- # line 206 "IndexShapes.puma"
- if (! ((yyV3 == true))) goto yyL1;
- }
- }
- {
- return ConstIndexDivMult (exp, yyV2, yyV4);
- }
- }
- yyL1:;
-
- # line 212 "IndexShapes.puma"
- {
- # line 213 "IndexShapes.puma"
- if (! ((EqualExpression (divisor, mult) == true))) goto yyL2;
- }
- return exp;
- yyL2:;
-
- # line 220 "IndexShapes.puma"
- {
- bool yyV1;
- int yyV2;
- {
- # line 221 "IndexShapes.puma"
- GetIncrement (divisor, & yyV1, & yyV2);
- # line 222 "IndexShapes.puma"
- if (! ((yyV1 == true))) goto yyL3;
- {
- # line 223 "IndexShapes.puma"
- if (! ((yyV2 == 1))) goto yyL3;
- }
- }
- {
- return mOP_EXP (mOP_TIMES (), exp, mult);
- }
- }
- yyL3:;
-
- # line 227 "IndexShapes.puma"
- {
- bool yyV1;
- int yyV2;
- {
- # line 228 "IndexShapes.puma"
- GetIncrement (mult, & yyV1, & yyV2);
- # line 229 "IndexShapes.puma"
- if (! ((yyV1 == true))) goto yyL4;
- {
- # line 230 "IndexShapes.puma"
- if (! ((yyV2 == 1))) goto yyL4;
- }
- }
- {
- return mOP_EXP (mOP_DIVIDE (), exp, divisor);
- }
- }
- yyL4:;
-
- # line 234 "IndexShapes.puma"
- return mOP_EXP (mOP_TIMES (), mOP_EXP (mOP_DIVIDE (), exp, divisor), mult);
-
- }
-
- static tTree ConstIndexDivMult
- # if defined __STDC__ | defined __cplusplus
- (register tTree exp, register int divisor, register int mult)
- # else
- (exp, divisor, mult)
- register tTree exp;
- register int divisor;
- register int mult;
- # endif
- {
- # line 242 "IndexShapes.puma"
- {
- # line 243 "IndexShapes.puma"
- if (! (((mult % divisor) == 0))) goto yyL1;
- }
- return MultConstant (exp, mult / divisor);
- yyL1:;
-
- # line 247 "IndexShapes.puma"
- {
- # line 248 "IndexShapes.puma"
- if (! (((divisor % mult) == 0))) goto yyL2;
- }
- return DivConstant (exp, divisor / mult);
- yyL2:;
-
- # line 254 "IndexShapes.puma"
- return MultConstant (DivConstant (exp, divisor), mult);
-
- }
-
- static tTree MultConstant
- # if defined __STDC__ | defined __cplusplus
- (register tTree exp, register int c)
- # else
- (exp, c)
- register tTree exp;
- register int c;
- # endif
- {
- # line 266 "IndexShapes.puma"
-
- bool found;
- int val;
-
- if (equalint (c, 0)) {
- # line 271 "IndexShapes.puma"
- return MakeConstant (0);
-
- }
- if (equalint (c, 1)) {
- # line 275 "IndexShapes.puma"
- return exp;
-
- }
- # line 279 "IndexShapes.puma"
- {
- # line 280 "IndexShapes.puma"
- if (! ((c < 0))) goto yyL3;
- }
- return MinusExpression (MultConstant (exp, - c));
- yyL3:;
-
- # line 284 "IndexShapes.puma"
- {
- # line 285 "IndexShapes.puma"
- GetIntConstValue (exp, & found, & val);
- # line 286 "IndexShapes.puma"
- if (! (found == true)) goto yyL4;
- }
- return MakeConstant (c * val);
- yyL4:;
-
- if (exp->Kind == kOP_EXP) {
- if (exp->OP_EXP.EXP_OP->Kind == kOP_PLUS) {
- # line 290 "IndexShapes.puma"
- {
- # line 291 "IndexShapes.puma"
- exp->OP_EXP.OPND1 = MultConstant (exp->OP_EXP.OPND1, c);
- exp->OP_EXP.OPND2 = MultConstant (exp->OP_EXP.OPND2, c);
-
- }
- return exp;
-
- }
- if (exp->OP_EXP.EXP_OP->Kind == kOP_MINUS) {
- # line 297 "IndexShapes.puma"
- {
- # line 298 "IndexShapes.puma"
- exp->OP_EXP.OPND1 = MultConstant (exp->OP_EXP.OPND1, c);
- exp->OP_EXP.OPND2 = MultConstant (exp->OP_EXP.OPND2, c);
-
- }
- return exp;
-
- }
- if (exp->OP_EXP.EXP_OP->Kind == kOP_TIMES) {
- # line 304 "IndexShapes.puma"
- {
- # line 305 "IndexShapes.puma"
- GetIntConstValue (exp->OP_EXP.OPND1, & found, & val);
- # line 306 "IndexShapes.puma"
- if (! (found == true)) goto yyL7;
- {
- # line 307 "IndexShapes.puma"
- exp->OP_EXP.OPND1 = MakeConstant (c * val);
- }
- }
- return exp;
- yyL7:;
-
- # line 311 "IndexShapes.puma"
- {
- # line 312 "IndexShapes.puma"
- GetIntConstValue (exp->OP_EXP.OPND2, & found, & val);
- # line 313 "IndexShapes.puma"
- if (! (found == true)) goto yyL8;
- {
- # line 314 "IndexShapes.puma"
- exp->OP_EXP.OPND2 = MakeConstant (c * val);
- }
- }
- return exp;
- yyL8:;
-
- }
- }
- # line 318 "IndexShapes.puma"
- return mOP_EXP (mOP_TIMES (), exp, MakeConstant (c));
-
- }
-
- static tTree DivConstant
- # if defined __STDC__ | defined __cplusplus
- (register tTree exp, register int c)
- # else
- (exp, c)
- register tTree exp;
- register int c;
- # endif
- {
- # line 337 "IndexShapes.puma"
-
- bool found;
- int val;
-
- if (equalint (c, 0)) {
- # line 342 "IndexShapes.puma"
- return MakeConstant (0);
-
- }
- if (equalint (c, 1)) {
- # line 346 "IndexShapes.puma"
- return exp;
-
- }
- # line 350 "IndexShapes.puma"
- {
- # line 351 "IndexShapes.puma"
- if (! ((c < 0))) goto yyL3;
- }
- return MinusExpression (DivConstant (exp, - c));
- yyL3:;
-
- if (exp->Kind == kOP_EXP) {
- if (exp->OP_EXP.EXP_OP->Kind == kOP_PLUS) {
- # line 355 "IndexShapes.puma"
- {
- # line 356 "IndexShapes.puma"
- GetIntConstValue (exp->OP_EXP.OPND2, & found, & val);
- # line 357 "IndexShapes.puma"
- if (! ((val % c == 0))) goto yyL4;
- {
- # line 358 "IndexShapes.puma"
- exp->OP_EXP.OPND1 = DivConstant (exp->OP_EXP.OPND1, c);
- exp->OP_EXP.OPND2 = MakeConstant (val / c);
-
- }
- }
- return exp;
- yyL4:;
-
- }
- if (exp->OP_EXP.EXP_OP->Kind == kOP_MINUS) {
- # line 364 "IndexShapes.puma"
- {
- # line 365 "IndexShapes.puma"
- GetIntConstValue (exp->OP_EXP.OPND2, & found, & val);
- # line 366 "IndexShapes.puma"
- if (! ((val % c == 0))) goto yyL5;
- {
- # line 367 "IndexShapes.puma"
- exp->OP_EXP.OPND1 = DivConstant (exp->OP_EXP.OPND1, c);
- exp->OP_EXP.OPND2 = MakeConstant (val / c);
-
- }
- }
- return exp;
- yyL5:;
-
- }
- }
- # line 373 "IndexShapes.puma"
- return mOP_EXP (mOP_DIVIDE (), exp, MakeConstant (c));
-
- }
-
- static tTree MinusExpression
- # if defined __STDC__ | defined __cplusplus
- (register tTree exp)
- # else
- (exp)
- register tTree exp;
- # endif
- {
- # line 387 "IndexShapes.puma"
-
- bool found;
- int val;
- tTree he;
-
- if (exp->Kind == kOP_EXP) {
- if (exp->OP_EXP.EXP_OP->Kind == kOP_MINUS) {
- # line 393 "IndexShapes.puma"
- {
- # line 394 "IndexShapes.puma"
- he = exp->OP_EXP.OPND1;
- exp->OP_EXP.OPND1 = exp->OP_EXP.OPND2;
- exp->OP_EXP.OPND2 = he;
-
- }
- return exp;
-
- }
- }
- if (exp->Kind == kOP1_EXP) {
- if (exp->OP1_EXP.EXP_OP1->Kind == kOP1_SIGN) {
- # line 401 "IndexShapes.puma"
- return exp->OP1_EXP.OPND;
-
- }
- }
- # line 405 "IndexShapes.puma"
- return mOP1_EXP (mOP1_SIGN (), exp);
-
- }
-
- static void GetIncrement
- # if defined __STDC__ | defined __cplusplus
- (register tTree inc, register bool * found, register int * val)
- # else
- (inc, found, val)
- register tTree inc;
- register bool * found;
- register int * val;
- # endif
- {
- # line 417 "IndexShapes.puma"
- {
- # line 418 "IndexShapes.puma"
- if (! (IsOneIncrement (inc))) goto yyL1;
- }
- * found = true;
- * val = 1;
- return;
- yyL1:;
-
- # line 421 "IndexShapes.puma"
- {
- bool found1;
- int val1;
- {
- # line 423 "IndexShapes.puma"
-
- # line 424 "IndexShapes.puma"
-
- # line 426 "IndexShapes.puma"
- GetIntConstValue (inc, & found1, & val1);
- }
- * found = found1;
- * val = val1;
- return;
- }
-
- ;
- }
-
- static bool IsOneIncrement
- # if defined __STDC__ | defined __cplusplus
- (register tTree t)
- # else
- (t)
- register tTree t;
- # endif
- {
- # line 437 "IndexShapes.puma"
- {
- # line 438 "IndexShapes.puma"
- if (! ((t == NoTree))) goto yyL1;
- }
- return true;
- yyL1:;
-
- if (t->Kind == kDUMMY_EXP) {
- # line 441 "IndexShapes.puma"
- return true;
-
- }
- if (t->Kind == kCONST_EXP) {
- if (t->CONST_EXP.C->Kind == kINT_CONSTANT) {
- if (equalint (t->CONST_EXP.C->INT_CONSTANT.value, 1)) {
- # line 444 "IndexShapes.puma"
- return true;
-
- }
- }
- }
- return false;
- }
-
- tTree NormalArrayIndexes
- # if defined __STDC__ | defined __cplusplus
- (register tTree t)
- # else
- (t)
- register tTree t;
- # endif
- {
-
- switch (t->Kind) {
- case kADDR:
- # line 461 "IndexShapes.puma"
- {
- # line 462 "IndexShapes.puma"
- t->ADDR.E = NormalArrayIndexes (t->ADDR.E);
- }
- return t;
-
- case kDUMMY_EXP:
- # line 466 "IndexShapes.puma"
- return t;
-
- case kCONST_EXP:
- # line 470 "IndexShapes.puma"
- return t;
-
- case kARRAY_EXP:
- # line 474 "IndexShapes.puma"
- {
- # line 475 "IndexShapes.puma"
- t->ARRAY_EXP.ELEMENTS = NormalArrayIndexes (t->ARRAY_EXP.ELEMENTS);
- }
- return t;
-
- case kBTE_LIST:
- # line 479 "IndexShapes.puma"
- {
- # line 480 "IndexShapes.puma"
- t->BTE_LIST.Elem = NormalArrayIndexes (t->BTE_LIST.Elem);
- t->BTE_LIST.Next = NormalArrayIndexes (t->BTE_LIST.Next);
-
- }
- return t;
-
- case kBTE_EMPTY:
- # line 486 "IndexShapes.puma"
- return t;
-
- case kSLICE_EXP:
- # line 490 "IndexShapes.puma"
- {
- # line 491 "IndexShapes.puma"
- t->SLICE_EXP.START = NormalArrayIndexes (t->SLICE_EXP.START);
- t->SLICE_EXP.STOP = NormalArrayIndexes (t->SLICE_EXP.STOP );
- t->SLICE_EXP.INC = NormalArrayIndexes (t->SLICE_EXP.INC );
-
- }
- return t;
-
- case kOP_EXP:
- # line 498 "IndexShapes.puma"
- {
- # line 499 "IndexShapes.puma"
- t->OP_EXP.OPND1 = NormalArrayIndexes (t->OP_EXP.OPND1);
- t->OP_EXP.OPND2 = NormalArrayIndexes (t->OP_EXP.OPND2);
-
- }
- return t;
-
- case kOP1_EXP:
- # line 505 "IndexShapes.puma"
- {
- # line 506 "IndexShapes.puma"
- t->OP1_EXP.OPND = NormalArrayIndexes (t->OP1_EXP.OPND);
- }
- return t;
-
- case kVAR_EXP:
- # line 510 "IndexShapes.puma"
- {
- # line 511 "IndexShapes.puma"
- t->VAR_EXP.V = NormalArrayIndexes (t->VAR_EXP.V);
- }
- return t;
-
- case kFUNC_CALL_EXP:
- # line 515 "IndexShapes.puma"
- {
- # line 516 "IndexShapes.puma"
- if (! ((IsIntrFunc (t->FUNC_CALL_EXP.FUNC_ID) == true))) goto yyL11;
- {
- # line 517 "IndexShapes.puma"
- t->FUNC_CALL_EXP.FUNC_PARAMS = NormalArrayIndexes (t->FUNC_CALL_EXP.FUNC_PARAMS);
- }
- }
- return t;
- yyL11:;
-
- # line 521 "IndexShapes.puma"
- {
- # line 523 "IndexShapes.puma"
- t->FUNC_CALL_EXP.FUNC_PARAMS = NormalArrayIndexes (t->FUNC_CALL_EXP.FUNC_PARAMS);
- }
- return t;
-
- case kBTP_LIST:
- # line 527 "IndexShapes.puma"
- {
- # line 528 "IndexShapes.puma"
- t->BTP_LIST.Elem = NormalArrayIndexes (t->BTP_LIST.Elem);
- t->BTP_LIST.Next = NormalArrayIndexes (t->BTP_LIST.Next);
-
- }
- return t;
-
- case kBTP_EMPTY:
- # line 534 "IndexShapes.puma"
- return t;
-
- case kVAR_PARAM:
- if (t->VAR_PARAM.V->Kind == kUSED_VAR) {
- # line 540 "IndexShapes.puma"
- return t;
-
- }
- # line 544 "IndexShapes.puma"
- {
- # line 545 "IndexShapes.puma"
- t->VAR_PARAM.V = NormalArrayIndexes (t->VAR_PARAM.V);
- }
- return t;
-
- case kUSED_VAR:
- # line 549 "IndexShapes.puma"
- {
- # line 550 "IndexShapes.puma"
- if (! ((TreeRank (t) > 0))) goto yyL17;
- }
- return MakeFullShape (t);
- yyL17:;
-
- # line 554 "IndexShapes.puma"
- return t;
-
- case kLOOP_VAR:
- # line 558 "IndexShapes.puma"
- return t;
-
- case kSUBSTRING_VAR:
- # line 562 "IndexShapes.puma"
- {
- # line 563 "IndexShapes.puma"
- t->SUBSTRING_VAR.IND_EXP = NormalArrayIndexes (t->SUBSTRING_VAR.IND_EXP);
- }
- return t;
-
- case kINDEXED_VAR:
- # line 567 "IndexShapes.puma"
- {
- # line 568 "IndexShapes.puma"
- t->INDEXED_VAR.IND_EXPS = NormalArrayIndexes (t->INDEXED_VAR.IND_EXPS);
- }
- return MakeFullShape (t);
-
- }
-
- # line 572 "IndexShapes.puma"
- {
- # line 573 "IndexShapes.puma"
- failure_protocol ("IndexShapes", "NormalArrayIndexes", t);
- }
- return t;
-
- }
-
- void BeginIndexShapes ()
- {
- }
-
- void CloseIndexShapes ()
- {
- }