home *** CD-ROM | disk | FTP | other *** search
- # include "NormalLo.h"
- # include "yyNLoop.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 17 "NormalLoop.puma"
-
-
- # include "Idents.h"
- # include "StringMe.h"
-
- # include "protocol.h"
-
- # include "Expressi.h" /* AddConstant */
-
-
-
- static FILE * yyf = stdout;
-
- static void yyAbort
- # ifdef __cplusplus
- (char * yyFunction)
- # else
- (yyFunction) char * yyFunction;
- # endif
- {
- (void) fprintf (stderr, "Error: module NormalLoop, routine %s failed\n", yyFunction);
- exit (1);
- }
-
- void NormalLoop ARGS((tTree loop, int inc));
- static void DoReplace ARGS((tTree t, tTree id, int inc));
- static tTree ReplaceExp ARGS((tTree exp, tTree id, int inc));
-
- void NormalLoop
- # if defined __STDC__ | defined __cplusplus
- (register tTree loop, register int inc)
- # else
- (loop, inc)
- register tTree loop;
- register int inc;
- # endif
- {
- if (loop == NoTree) return;
- if (loop->Kind == kACF_FORALL) {
- # line 40 "NormalLoop.puma"
- {
- # line 41 "NormalLoop.puma"
- loop->ACF_FORALL.FORALL_RANGE->SLICE_EXP.START = AddConstant (loop->ACF_FORALL.FORALL_RANGE->SLICE_EXP.START, inc);
- loop->ACF_FORALL.FORALL_RANGE->SLICE_EXP.STOP = AddConstant (loop->ACF_FORALL.FORALL_RANGE->SLICE_EXP.STOP, inc);
- DoReplace (loop->ACF_FORALL.FORALL_BODY, loop->ACF_FORALL.FORALL_ID, -inc);
-
- }
- return;
-
- }
- if (loop->Kind == kACF_DO) {
- # line 47 "NormalLoop.puma"
- {
- # line 48 "NormalLoop.puma"
- loop->ACF_DO.DO_RANGE->SLICE_EXP.START = AddConstant (loop->ACF_DO.DO_RANGE->SLICE_EXP.START, inc);
- loop->ACF_DO.DO_RANGE->SLICE_EXP.STOP = AddConstant (loop->ACF_DO.DO_RANGE->SLICE_EXP.STOP, inc);
- DoReplace (loop->ACF_DO.DO_BODY, loop->ACF_DO.DO_ID, -inc);
-
- }
- return;
-
- }
- if (loop->Kind == kACF_DOLOCAL) {
- # line 54 "NormalLoop.puma"
- {
- # line 55 "NormalLoop.puma"
- loop->ACF_DOLOCAL.DOLOCAL_RANGE->SLICE_EXP.START = AddConstant (loop->ACF_DOLOCAL.DOLOCAL_RANGE->SLICE_EXP.START, inc);
- loop->ACF_DOLOCAL.DOLOCAL_RANGE->SLICE_EXP.STOP = AddConstant (loop->ACF_DOLOCAL.DOLOCAL_RANGE->SLICE_EXP.STOP, inc);
- DoReplace (loop->ACF_DOLOCAL.DOLOCAL_BODY, loop->ACF_DOLOCAL.DOLOCAL_ID, -inc);
-
- }
- return;
-
- }
- ;
- }
-
- static void DoReplace
- # if defined __STDC__ | defined __cplusplus
- (register tTree t, register tTree id, register int inc)
- # else
- (t, id, inc)
- register tTree t;
- register tTree id;
- register int inc;
- # endif
- {
- if (t == NoTree) return;
- if (id == NoTree) return;
-
- switch (t->Kind) {
- case kACF_LIST:
- # line 73 "NormalLoop.puma"
- {
- # line 74 "NormalLoop.puma"
- DoReplace (t->ACF_LIST.Elem, id, inc);
- # line 75 "NormalLoop.puma"
- DoReplace (t->ACF_LIST.Next, id, inc);
- }
- return;
-
- case kACF_EMPTY:
- # line 78 "NormalLoop.puma"
- return;
-
- case kACF_DUMMY:
- # line 81 "NormalLoop.puma"
- return;
-
- case kACF_BASIC:
- # line 84 "NormalLoop.puma"
- {
- # line 85 "NormalLoop.puma"
- DoReplace (t->ACF_BASIC.BASIC_STMT, id, inc);
- }
- return;
-
- case kACF_IF:
- # line 88 "NormalLoop.puma"
- {
- # line 89 "NormalLoop.puma"
- t->ACF_IF.IF_EXP = ReplaceExp (t->ACF_IF.IF_EXP, id, inc);
- # line 90 "NormalLoop.puma"
- DoReplace (t->ACF_IF.THEN_PART, id, inc);
- # line 91 "NormalLoop.puma"
- DoReplace (t->ACF_IF.ELSE_PART, id, inc);
- }
- return;
-
- case kACF_WHERE:
- # line 94 "NormalLoop.puma"
- {
- # line 96 "NormalLoop.puma"
- t->ACF_WHERE.WHERE_EXP = ReplaceExp (t->ACF_WHERE.WHERE_EXP, id, inc);
- # line 97 "NormalLoop.puma"
- DoReplace (t->ACF_WHERE.TRUE_PART, id, inc);
- # line 98 "NormalLoop.puma"
- DoReplace (t->ACF_WHERE.FALSE_PART, id, inc);
- }
- return;
-
- case kACF_CASE:
- # line 101 "NormalLoop.puma"
- {
- # line 102 "NormalLoop.puma"
- t->ACF_CASE.CASE_EXP = ReplaceExp (t->ACF_CASE.CASE_EXP, id, inc);
- # line 103 "NormalLoop.puma"
- DoReplace (t->ACF_CASE.CASE_ALTS, id, inc);
- # line 104 "NormalLoop.puma"
- DoReplace (t->ACF_CASE.CASE_OTHERWISE, id, inc);
- }
- return;
-
- case kSELECTED_ACF_LIST:
- # line 107 "NormalLoop.puma"
- {
- # line 108 "NormalLoop.puma"
- DoReplace (t->SELECTED_ACF_LIST.Elem, id, inc);
- # line 109 "NormalLoop.puma"
- DoReplace (t->SELECTED_ACF_LIST.Next, id, inc);
- }
- return;
-
- case kSELECTED_ACF_EMPTY:
- # line 112 "NormalLoop.puma"
- return;
-
- case kSELECTED_ACF_NODE:
- # line 115 "NormalLoop.puma"
- {
- # line 116 "NormalLoop.puma"
- DoReplace (t->SELECTED_ACF_NODE.SELECT_LIST, id, inc);
- # line 117 "NormalLoop.puma"
- DoReplace (t->SELECTED_ACF_NODE.SELECT_ACFS, id, inc);
- }
- return;
-
- case kACF_WHILE:
- # line 120 "NormalLoop.puma"
- {
- # line 121 "NormalLoop.puma"
- t->ACF_WHILE.WHILE_EXP = ReplaceExp (t->ACF_WHILE.WHILE_EXP, id, inc);
- # line 122 "NormalLoop.puma"
- DoReplace (t->ACF_WHILE.WHILE_BODY, id, inc);
- }
- return;
-
- case kACF_FORALL:
- # line 125 "NormalLoop.puma"
- {
- # line 126 "NormalLoop.puma"
- t->ACF_FORALL.FORALL_RANGE = ReplaceExp (t->ACF_FORALL.FORALL_RANGE, id, inc);
- # line 127 "NormalLoop.puma"
- DoReplace (t->ACF_FORALL.FORALL_BODY, id, inc);
- }
- return;
-
- case kACF_DOLOCAL:
- # line 130 "NormalLoop.puma"
- {
- # line 131 "NormalLoop.puma"
- t->ACF_DOLOCAL.DOLOCAL_RANGE = ReplaceExp (t->ACF_DOLOCAL.DOLOCAL_RANGE, id, inc);
- # line 132 "NormalLoop.puma"
- DoReplace (t->ACF_DOLOCAL.DOLOCAL_BODY, id, inc);
- }
- return;
-
- case kACF_DO:
- # line 135 "NormalLoop.puma"
- {
- # line 136 "NormalLoop.puma"
- t->ACF_DO.DO_RANGE = ReplaceExp (t->ACF_DO.DO_RANGE, id, inc);
- # line 137 "NormalLoop.puma"
- DoReplace (t->ACF_DO.DO_BODY, id, inc);
- }
- return;
-
- case kASSIGN_STMT:
- # line 146 "NormalLoop.puma"
- {
- # line 147 "NormalLoop.puma"
- DoReplace (t->ASSIGN_STMT.ASSIGN_VAR, id, inc);
- # line 148 "NormalLoop.puma"
- t->ASSIGN_STMT.ASSIGN_EXP = ReplaceExp (t->ASSIGN_STMT.ASSIGN_EXP, id, inc);
- }
- return;
-
- case kFORMAT_STMT:
- # line 151 "NormalLoop.puma"
- return;
-
- case kIO_STMT:
- # line 155 "NormalLoop.puma"
- {
- # line 156 "NormalLoop.puma"
- DoReplace (t->IO_STMT.IO_ITEMS, id, inc);
- }
- return;
-
- case kCALL_STMT:
- # line 159 "NormalLoop.puma"
- {
- # line 160 "NormalLoop.puma"
- DoReplace (t->CALL_STMT.CALL_PARAMS, id, inc);
- }
- return;
-
- case kREDUCE_STMT:
- # line 163 "NormalLoop.puma"
- {
- # line 164 "NormalLoop.puma"
- DoReplace (t->REDUCE_STMT.RED_PARAMS, id, inc);
- }
- return;
-
- case kALLOCATE_STMT:
- # line 167 "NormalLoop.puma"
- {
- # line 168 "NormalLoop.puma"
- DoReplace (t->ALLOCATE_STMT.PARAMS, id, inc);
- # line 169 "NormalLoop.puma"
- t->ALLOCATE_STMT.STAT = ReplaceExp (t->ALLOCATE_STMT.STAT, id, inc);
- }
- return;
-
- case kDEALLOCATE_STMT:
- # line 172 "NormalLoop.puma"
- {
- # line 173 "NormalLoop.puma"
- DoReplace (t->DEALLOCATE_STMT.PARAMS, id, inc);
- # line 174 "NormalLoop.puma"
- t->DEALLOCATE_STMT.STAT = ReplaceExp (t->DEALLOCATE_STMT.STAT, id, inc);
- }
- return;
-
- case kGOTO_STMT:
- # line 177 "NormalLoop.puma"
- return;
-
- case kCOMP_IF_STMT:
- # line 180 "NormalLoop.puma"
- {
- # line 181 "NormalLoop.puma"
- t->COMP_IF_STMT.IF_EXP = ReplaceExp (t->COMP_IF_STMT.IF_EXP, id, inc);
- # line 182 "NormalLoop.puma"
- if (! (ReplaceExp (t->COMP_IF_STMT.IF_EXP, id, inc))) goto yyL23;
- }
- return;
- yyL23:;
-
- break;
- case kSTOP_STMT:
- # line 185 "NormalLoop.puma"
- {
- # line 186 "NormalLoop.puma"
- t->STOP_STMT.STOP_CONST = ReplaceExp (t->STOP_STMT.STOP_CONST, id, inc);
- }
- return;
-
- case kRETURN_STMT:
- # line 189 "NormalLoop.puma"
- {
- # line 190 "NormalLoop.puma"
- t->RETURN_STMT.RETURN_EXP = ReplaceExp (t->RETURN_STMT.RETURN_EXP, id, inc);
- }
- return;
-
- case kBTP_LIST:
- # line 199 "NormalLoop.puma"
- {
- # line 200 "NormalLoop.puma"
- DoReplace (t->BTP_LIST.Elem, id, inc);
- # line 201 "NormalLoop.puma"
- DoReplace (t->BTP_LIST.Next, id, inc);
- }
- return;
-
- case kBTP_EMPTY:
- # line 204 "NormalLoop.puma"
- return;
-
- case kBTE_LIST:
- # line 207 "NormalLoop.puma"
- {
- # line 208 "NormalLoop.puma"
- t->BTE_LIST.Elem = ReplaceExp (t->BTE_LIST.Elem, id, inc);
- # line 209 "NormalLoop.puma"
- DoReplace (t->BTE_LIST.Next, id, inc);
- }
- return;
-
- case kBTE_EMPTY:
- # line 212 "NormalLoop.puma"
- return;
-
- case kVAR_PARAM:
- if (t->VAR_PARAM.V->Kind == kLOOP_VAR) {
- if (id->Kind == kLOOP_VAR) {
- # line 223 "NormalLoop.puma"
- {
- # line 225 "NormalLoop.puma"
- t->VAR_PARAM.V = mADDR (AddConstant (mVAR_EXP (t->VAR_PARAM.V), inc));
- }
- return;
-
- }
- }
- if (t->VAR_PARAM.V->Kind == kADDR) {
- # line 228 "NormalLoop.puma"
- {
- # line 229 "NormalLoop.puma"
- t->VAR_PARAM.V->ADDR.E = ReplaceExp (t->VAR_PARAM.V->ADDR.E, id, inc);
- }
- return;
-
- }
- # line 232 "NormalLoop.puma"
- {
- # line 233 "NormalLoop.puma"
- DoReplace (t->VAR_PARAM.V, id, inc);
- }
- return;
-
- case kFUNC_PARAM:
- # line 236 "NormalLoop.puma"
- return;
-
- case kUSED_VAR:
- # line 245 "NormalLoop.puma"
- return;
-
- case kSUBSTRING_VAR:
- # line 248 "NormalLoop.puma"
- {
- # line 249 "NormalLoop.puma"
- DoReplace (t->SUBSTRING_VAR.IND_VAR, id, inc);
- # line 250 "NormalLoop.puma"
- t->SUBSTRING_VAR.IND_EXP = ReplaceExp (t->SUBSTRING_VAR.IND_EXP, id, inc);
- }
- return;
-
- case kINDEXED_VAR:
- # line 253 "NormalLoop.puma"
- {
- # line 254 "NormalLoop.puma"
- DoReplace (t->INDEXED_VAR.IND_VAR, id, inc);
- # line 255 "NormalLoop.puma"
- DoReplace (t->INDEXED_VAR.IND_EXPS, id, inc);
- }
- return;
-
- }
-
- # line 258 "NormalLoop.puma"
- {
- # line 259 "NormalLoop.puma"
- error_protocol ("unknown tree node in DoReplace");
- # line 260 "NormalLoop.puma"
- printf ("Unknow Tree Node");
- # line 261 "NormalLoop.puma"
- WriteTree (stdout, t);
- # line 262 "NormalLoop.puma"
- kill_in_protocol ();
- }
- return;
-
- ;
- }
-
- static tTree ReplaceExp
- # if defined __STDC__ | defined __cplusplus
- (register tTree exp, register tTree id, register int inc)
- # else
- (exp, id, inc)
- register tTree exp;
- register tTree id;
- register int inc;
- # endif
- {
- # line 273 "NormalLoop.puma"
- {
- # line 274 "NormalLoop.puma"
- if (! (IsVarInExp (TreeVarName (id), exp) == false)) goto yyL1;
- }
- return exp;
- yyL1:;
-
- # line 278 "NormalLoop.puma"
- {
- int a;
- int b;
- bool found;
- tTree var;
- {
- # line 280 "NormalLoop.puma"
-
- # line 281 "NormalLoop.puma"
-
- # line 282 "NormalLoop.puma"
-
- # line 283 "NormalLoop.puma"
-
- # line 285 "NormalLoop.puma"
- ResolveExpression (exp, &found, &a, &b, &var);
-
- if (found)
- found = ( (a == 1) && (TreeVarName (id) == TreeVarName (var)) );
-
- # line 290 "NormalLoop.puma"
- if (! ((found == true))) goto yyL2;
- }
- {
- return AddConstant (exp, inc);
- }
- }
- yyL2:;
-
-
- switch (exp->Kind) {
- case kVAR_EXP:
- if (exp->VAR_EXP.V->Kind == kLOOP_VAR) {
- if (id->Kind == kLOOP_VAR) {
- # line 294 "NormalLoop.puma"
- {
- # line 295 "NormalLoop.puma"
- if (! (TreeVarName (exp->VAR_EXP.V) == TreeVarName (id))) goto yyL3;
- }
- return AddConstant (exp, inc);
- yyL3:;
-
- }
- }
- # line 299 "NormalLoop.puma"
- {
- # line 300 "NormalLoop.puma"
- DoReplace (exp->VAR_EXP.V, id, inc);
- }
- return exp;
-
- case kADDR:
- # line 304 "NormalLoop.puma"
- {
- # line 305 "NormalLoop.puma"
- DoReplace (exp->ADDR.E, id, inc);
- }
- return exp;
-
- case kARRAY_EXP:
- # line 309 "NormalLoop.puma"
- {
- # line 310 "NormalLoop.puma"
- DoReplace (exp->ARRAY_EXP.ELEMENTS, id, inc);
- }
- return exp;
-
- case kSLICE_EXP:
- # line 314 "NormalLoop.puma"
- {
- # line 315 "NormalLoop.puma"
- exp->SLICE_EXP.START = ReplaceExp (exp->SLICE_EXP.START, id, inc);
- exp->SLICE_EXP.STOP = ReplaceExp (exp->SLICE_EXP.STOP, id, inc);
- exp->SLICE_EXP.INC = ReplaceExp (exp->SLICE_EXP.INC, id, inc);
-
- }
- return exp;
-
- case kOP_EXP:
- # line 322 "NormalLoop.puma"
- {
- # line 323 "NormalLoop.puma"
- exp->OP_EXP.OPND1 = ReplaceExp (exp->OP_EXP.OPND1, id, inc);
- exp->OP_EXP.OPND2 = ReplaceExp (exp->OP_EXP.OPND2, id, inc);
-
- }
- return exp;
-
- case kOP1_EXP:
- # line 329 "NormalLoop.puma"
- {
- # line 330 "NormalLoop.puma"
- exp->OP1_EXP.OPND = ReplaceExp (exp->OP1_EXP.OPND, id, inc);
- }
- return exp;
-
- case kFUNC_CALL_EXP:
- # line 334 "NormalLoop.puma"
- {
- # line 335 "NormalLoop.puma"
- DoReplace (exp->FUNC_CALL_EXP.FUNC_PARAMS, id, inc);
- }
- return exp;
-
- case kDO_EXP:
- # line 339 "NormalLoop.puma"
- {
- # line 340 "NormalLoop.puma"
- exp->DO_EXP.RANGE = ReplaceExp (exp->DO_EXP.RANGE, id, inc);
- DoReplace (exp->DO_EXP.BODY, id, inc);
-
- }
- return exp;
-
- }
-
- # line 346 "NormalLoop.puma"
- {
- # line 347 "NormalLoop.puma"
- printf ("ReplaceExp failed\n");
- # line 348 "NormalLoop.puma"
- WriteTree (stdout, exp);
- # line 349 "NormalLoop.puma"
- kill_in_protocol ();
- }
- return NoTree;
-
- }
-
- void BeginNormalLoop ()
- {
- }
-
- void CloseNormalLoop ()
- {
- }