home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Professional
/
OS2PRO194.ISO
/
os2
/
prgramer
/
adaptor
/
src
/
changede.c
< prev
next >
Wrap
Text File
|
1994-01-02
|
43KB
|
1,832 lines
# include "ChangeDe.h"
# include "yyCDefs.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 43 "ChangeDefs.puma"
# include "Idents.h"
# include "StringMe.h"
# include "Types.h"
# include "protocol.h"
# include "Transfor.h" /* AppendDECLS */
tTree stmtfuncs; /* list of statement functions */
static FILE * yyf = stdout;
static void yyAbort
# ifdef __cplusplus
(char * yyFunction)
# else
(yyFunction) char * yyFunction;
# endif
{
(void) fprintf (stderr, "Error: module ChangeDefs, routine %s failed\n", yyFunction);
exit (1);
}
void MakeObjType ARGS((tTree decl, tDefinitions obj));
static bool SetDeclType ARGS((tTree decl, tTree type));
void MakeObjParameter ARGS((tTree decl, tDefinitions obj));
void MakeObjDimension ARGS((tTree indexes, tDefinitions obj));
static void SetDeclDimension ARGS((tTree decl, tTree indexes));
void MakeObjIntent ARGS((tDefinitions obj, int intent));
void MakeObjOptional ARGS((tDefinitions obj));
void MakeObjCommon ARGS((tTree decl, tDefinitions obj));
static tTree TreeTypeCombine ARGS((tTree d1, tTree d2));
void MakeObjSequential ARGS((tTree t, tDefinitions v));
void MakeObjNoSequential ARGS((tTree t, tDefinitions v));
void MakeObjSave ARGS((tTree t, tDefinitions v));
void MakeObjDistribution ARGS((tTree layout, tDefinitions obj));
static void CheckDistributionSpecification ARGS((tTree layout, int rank));
static tDefinitions GetDistribution ARGS((tTree t));
static bool IsSerialDistribution ARGS((tTree t));
static DistributedDimensions GetDistributedDimensions ARGS((tTree t, int n));
void MakeObjAlignment ARGS((tTree align, tDefinitions obj));
static tDefinitions GetAlignDistribution ARGS((tTree align, int rank));
static tDefinitions MakeAlignDistribution ARGS((tTree template, tTree source));
static void GenFullAlignSource ARGS((tTree align, int rank));
static void GenFullAlignSpec ARGS((tTree align));
static bool CorrectAlignSpec ARGS((tTree align));
static int FillAlignSpec ARGS((tTree t, int n));
static DistributedDimensions FindAllSourceDimensions ARGS((tTree spec, tTree source, int n));
static int FindSourceDimension ARGS((tTree spec, tTree source, int n));
static tDefinitions GetExtFuncEntry ARGS((tIdent name, tTree type));
void MakeObjExternal ARGS((tTree decl, tDefinitions oldobj));
void StatementFunctions ARGS((tTree body));
static tTree ExtractStatementFunctions ARGS((tTree t));
static bool IsStatementFunction ARGS((tTree t));
static tTree MakeStmtFuncDecl ARGS((tTree var, tTree exp));
static tTree MakeStmtFuncFormals ARGS((tTree Parameters));
void MakeObjType
# if defined __STDC__ | defined __cplusplus
(register tTree decl, register tDefinitions obj)
# else
(decl, obj)
register tTree decl;
register tDefinitions obj;
# endif
{
if (decl == NoTree) return;
if (obj == NoDefinitions) return;
if (decl->Kind == kVAR_DECL) {
if (decl->VAR_DECL.VAL->Kind == kARRAY_TYPE) {
# line 71 "ChangeDefs.puma"
{
# line 72 "ChangeDefs.puma"
MakeObjDimension (decl->VAR_DECL.VAL->ARRAY_TYPE.ARRAY_INDEX_TYPES, obj);
# line 73 "ChangeDefs.puma"
MakeObjType (decl->VAR_DECL.VAL->ARRAY_TYPE.ARRAY_COMP_TYPE, obj);
}
return;
}
# line 76 "ChangeDefs.puma"
{
# line 77 "ChangeDefs.puma"
MakeObjType (decl->VAR_DECL.VAL, obj);
}
return;
}
if (decl->Kind == kARRAY_TYPE) {
# line 80 "ChangeDefs.puma"
{
# line 81 "ChangeDefs.puma"
MakeObjDimension (decl->ARRAY_TYPE.ARRAY_INDEX_TYPES, obj);
# line 82 "ChangeDefs.puma"
MakeObjType (decl->ARRAY_TYPE.ARRAY_COMP_TYPE, obj);
}
return;
}
if (obj->Kind == kVarObject) {
if (obj->VarObject.Kind->Kind == kVarConstant) {
# line 85 "ChangeDefs.puma"
{
# line 86 "ChangeDefs.puma"
obj->VarObject.Kind->VarConstant.Type = decl;
}
return;
}
# line 89 "ChangeDefs.puma"
{
bool okay;
{
# line 90 "ChangeDefs.puma"
# line 91 "ChangeDefs.puma"
okay = SetDeclType (obj->VarObject.decl, decl);
# line 92 "ChangeDefs.puma"
if (!okay)
{ obj_error_protocol ("var_object has already a type", obj);
tree_protocol ("new type was : ", decl);
}
}
return;
}
}
if (obj->Kind == kFuncObject) {
if (obj->FuncObject.decl->Kind == kFUNC_DECL) {
# line 100 "ChangeDefs.puma"
{
tTree newtype;
{
# line 106 "ChangeDefs.puma"
# line 107 "ChangeDefs.puma"
newtype = TreeTypeCombine (obj->FuncObject.decl->FUNC_DECL.RESULT_TYPE, decl);
# line 109 "ChangeDefs.puma"
if (newtype == NoTree)
{ obj_error_protocol ("illegal retyping of function", obj);
tree_error_protocol ("new type should be", decl);
}
else
obj->FuncObject.decl->FUNC_DECL.RESULT_TYPE = newtype;
}
return;
}
}
if (obj->FuncObject.decl->Kind == kFUNC_PARAM_DECL) {
# line 118 "ChangeDefs.puma"
{
tTree newtype;
{
# line 122 "ChangeDefs.puma"
# line 123 "ChangeDefs.puma"
newtype = TreeTypeCombine (obj->FuncObject.decl->FUNC_PARAM_DECL.RESULT_TYPE, decl);
# line 125 "ChangeDefs.puma"
if (newtype == NoTree)
{ obj_error_protocol ("illegal retyping of function parameter", obj);
tree_protocol ("type specification is", decl);
}
else
obj->FuncObject.decl->FUNC_PARAM_DECL.RESULT_TYPE = newtype;
}
return;
}
}
}
# line 134 "ChangeDefs.puma"
{
# line 135 "ChangeDefs.puma"
obj_error_protocol ("this objection must not have a type", obj);
# line 136 "ChangeDefs.puma"
tree_protocol ("type specification is", decl);
}
return;
;
}
static bool SetDeclType
# if defined __STDC__ | defined __cplusplus
(register tTree decl, register tTree type)
# else
(decl, type)
register tTree decl;
register tTree type;
# endif
{
# line 141 "ChangeDefs.puma"
tTree newtype; bool ok;
if (decl->Kind == kVAR_DECL) {
# line 143 "ChangeDefs.puma"
{
# line 144 "ChangeDefs.puma"
newtype = TreeTypeCombine (decl->VAR_DECL.VAL, type);
ok = (newtype != NoTree);
if (ok) decl->VAR_DECL.VAL = newtype;
}
return ok;
}
if (decl->Kind == kVAR_PARAM_DECL) {
# line 151 "ChangeDefs.puma"
{
# line 152 "ChangeDefs.puma"
newtype = TreeTypeCombine (decl->VAR_PARAM_DECL.VAL, type);
ok = (newtype != NoTree);
if (ok) decl->VAR_PARAM_DECL.VAL = newtype;
}
return ok;
}
# line 159 "ChangeDefs.puma"
{
# line 160 "ChangeDefs.puma"
failure_protocol ("ChangeDefs", "SetDeclType", decl);
}
return false;
}
void MakeObjParameter
# if defined __STDC__ | defined __cplusplus
(register tTree decl, register tDefinitions obj)
# else
(decl, obj)
register tTree decl;
register tDefinitions obj;
# endif
{
if (decl == NoTree) return;
if (obj == NoDefinitions) return;
if (decl->Kind == kPARAMETER_DECL) {
if (obj->Kind == kVarObject) {
if (obj->VarObject.decl->Kind == kVAR_DECL) {
if (obj->VarObject.Kind->Kind == kVarLocal) {
# line 172 "ChangeDefs.puma"
{
# line 174 "ChangeDefs.puma"
obj->VarObject.Kind = mVarConstant (decl->PARAMETER_DECL.VAL, obj->VarObject.decl->VAR_DECL.VAL);
# line 175 "ChangeDefs.puma"
obj->VarObject.decl = decl;
}
return;
}
}
if (obj->VarObject.Kind->Kind == kVarDummy) {
# line 178 "ChangeDefs.puma"
{
# line 180 "ChangeDefs.puma"
obj_error_protocol ("PARAMETER not for dummy variable : ", obj);
# line 181 "ChangeDefs.puma"
tree_protocol ("parameter attribute is : ", decl);
}
return;
}
if (obj->VarObject.Kind->Kind == kVarCommon) {
# line 184 "ChangeDefs.puma"
{
# line 186 "ChangeDefs.puma"
obj_error_protocol ("PARAMETER not for common variable : ", obj);
# line 187 "ChangeDefs.puma"
tree_protocol ("parameter attribute is : ", decl);
}
return;
}
if (obj->VarObject.Kind->Kind == kVarConstant) {
# line 190 "ChangeDefs.puma"
{
# line 192 "ChangeDefs.puma"
obj_error_protocol ("PARAMETER is twice : ", obj);
# line 193 "ChangeDefs.puma"
tree_protocol ("parameter attribute is : ", decl);
}
return;
}
}
}
# line 196 "ChangeDefs.puma"
{
# line 197 "ChangeDefs.puma"
obj_error_protocol ("PARAMETER not allowed here", obj);
# line 198 "ChangeDefs.puma"
tree_protocol ("parameter attribute is : ", decl);
}
return;
;
}
void MakeObjDimension
# if defined __STDC__ | defined __cplusplus
(register tTree indexes, register tDefinitions obj)
# else
(indexes, obj)
register tTree indexes;
register tDefinitions obj;
# endif
{
if (indexes == NoTree) return;
if (obj == NoDefinitions) return;
if (obj->Kind == kVarObject) {
if (obj->VarObject.decl->Kind == kVAR_DECL) {
if (obj->VarObject.decl->VAR_DECL.VAL->Kind == kARRAY_TYPE) {
# line 209 "ChangeDefs.puma"
{
# line 210 "ChangeDefs.puma"
obj_error_protocol ("Object has already DIMENSION attribute", obj);
}
return;
}
}
if (obj->VarObject.decl->Kind == kVAR_PARAM_DECL) {
if (obj->VarObject.decl->VAR_PARAM_DECL.VAL->Kind == kARRAY_TYPE) {
# line 213 "ChangeDefs.puma"
{
# line 214 "ChangeDefs.puma"
obj_error_protocol ("Object has already DIMENSION attribute", obj);
}
return;
}
}
# line 217 "ChangeDefs.puma"
{
# line 218 "ChangeDefs.puma"
SetDeclDimension (obj->VarObject.decl, indexes);
}
return;
}
# line 222 "ChangeDefs.puma"
{
# line 223 "ChangeDefs.puma"
obj_error_protocol ("this object must not have DIMENSION", obj);
# line 224 "ChangeDefs.puma"
tree_protocol ("Dimension Indexes are : ", indexes);
}
return;
;
}
static void SetDeclDimension
# if defined __STDC__ | defined __cplusplus
(register tTree decl, register tTree indexes)
# else
(decl, indexes)
register tTree decl;
register tTree indexes;
# endif
{
if (decl == NoTree) return;
if (indexes == NoTree) return;
if (indexes->Kind == kDIMENSION_DECL) {
# line 229 "ChangeDefs.puma"
{
# line 230 "ChangeDefs.puma"
SetDeclDimension (decl, indexes->DIMENSION_DECL.INDEXES);
}
return;
}
if (decl->Kind == kVAR_DECL) {
# line 233 "ChangeDefs.puma"
{
# line 234 "ChangeDefs.puma"
decl->VAR_DECL.VAL = mARRAY_TYPE (indexes, decl->VAR_DECL.VAL);
}
return;
}
if (decl->Kind == kVAR_PARAM_DECL) {
# line 237 "ChangeDefs.puma"
{
# line 238 "ChangeDefs.puma"
decl->VAR_PARAM_DECL.VAL = mARRAY_TYPE (indexes, decl->VAR_PARAM_DECL.VAL);
}
return;
}
# line 241 "ChangeDefs.puma"
{
# line 242 "ChangeDefs.puma"
printf ("Internal Error: SetDeclDimension fails\n");
}
return;
;
}
void MakeObjIntent
# if defined __STDC__ | defined __cplusplus
(register tDefinitions obj, register int intent)
# else
(obj, intent)
register tDefinitions obj;
register int intent;
# endif
{
if (obj == NoDefinitions) return;
if (obj->Kind == kVarObject) {
if (obj->VarObject.Kind->Kind == kVarDummy) {
# line 253 "ChangeDefs.puma"
{
# line 254 "ChangeDefs.puma"
if (obj->VarObject.Kind->VarDummy.Intent != -1)
obj_error_protocol ("Object has already INTENT attribute", obj);
obj->VarObject.Kind->VarDummy.Intent = intent;
}
return;
}
}
# line 259 "ChangeDefs.puma"
{
# line 260 "ChangeDefs.puma"
obj_error_protocol ("this object can not have INTENT attribute", obj);
}
return;
;
}
void MakeObjOptional
# if defined __STDC__ | defined __cplusplus
(register tDefinitions obj)
# else
(obj)
register tDefinitions obj;
# endif
{
if (obj == NoDefinitions) return;
if (obj->Kind == kVarObject) {
if (obj->VarObject.Kind->Kind == kVarDummy) {
# line 271 "ChangeDefs.puma"
{
# line 272 "ChangeDefs.puma"
obj_error_protocol ("Object has already OPTIONAL attribute", obj);
}
return;
}
}
# line 279 "ChangeDefs.puma"
{
# line 280 "ChangeDefs.puma"
obj_error_protocol ("this object can not be optional", obj);
}
return;
;
}
void MakeObjCommon
# if defined __STDC__ | defined __cplusplus
(register tTree decl, register tDefinitions obj)
# else
(decl, obj)
register tTree decl;
register tDefinitions obj;
# endif
{
# line 291 "ChangeDefs.puma"
char string [100], msg[150];
if (decl == NoTree) return;
if (obj == NoDefinitions) return;
if (decl->Kind == kCOMMON_DECL) {
if (obj->Kind == kVarObject) {
if (obj->VarObject.Kind->Kind == kVarLocal) {
# line 293 "ChangeDefs.puma"
{
# line 295 "ChangeDefs.puma"
GetString (obj->VarObject.ident, string);
# line 296 "ChangeDefs.puma"
if (obj->VarObject.Kind->VarLocal.IsSave != 0)
{ obj_error_protocol ("Save Variabe not in COMMON : ", obj);
tree_protocol ("Declaration is : ", decl);
}
if (obj->VarObject.Kind->VarLocal.dynamic != 0)
{ obj_error_protocol ("Dynamic Variabe not in COMMON : ", obj);
tree_protocol ("Declaration is : ", decl);
}
# line 305 "ChangeDefs.puma"
obj->VarObject.Kind = mVarCommon (decl->COMMON_DECL.Name);
}
return;
}
if (obj->VarObject.Kind->Kind == kVarDummy) {
# line 308 "ChangeDefs.puma"
{
# line 310 "ChangeDefs.puma"
obj_error_protocol ("Dummy variable must not be in COMMON: ", obj);
# line 311 "ChangeDefs.puma"
tree_protocol ("COMMON is : ", decl);
}
return;
}
if (obj->VarObject.Kind->Kind == kVarCommon) {
# line 314 "ChangeDefs.puma"
{
# line 316 "ChangeDefs.puma"
GetString (obj->VarObject.Kind->VarCommon.Block, string);
# line 317 "ChangeDefs.puma"
sprintf (msg, "Variable is already in COMMON %s : ", string);
# line 318 "ChangeDefs.puma"
tree_error_protocol (msg, obj->VarObject.decl);
# line 319 "ChangeDefs.puma"
tree_protocol ("New COMMON is : ", decl);
}
return;
}
if (obj->VarObject.Kind->Kind == kVarConstant) {
# line 322 "ChangeDefs.puma"
{
# line 324 "ChangeDefs.puma"
tree_error_protocol ("Constant must not be in COMMON: ", obj->VarObject.decl);
# line 325 "ChangeDefs.puma"
tree_protocol ("COMMON is : ", decl);
}
return;
}
}
}
# line 328 "ChangeDefs.puma"
{
# line 329 "ChangeDefs.puma"
obj_error_protocol ("Object", obj);
# line 330 "ChangeDefs.puma"
tree_protocol ("object must not be in this COMMON", decl);
}
return;
;
}
static tTree TreeTypeCombine
# if defined __STDC__ | defined __cplusplus
(register tTree d1, register tTree d2)
# else
(d1, d2)
register tTree d1;
register tTree d2;
# endif
{
# line 344 "ChangeDefs.puma"
tTree newtype;
if (d1->Kind == kDUMMY_TYPE) {
# line 348 "ChangeDefs.puma"
return d2;
}
if (d2->Kind == kDUMMY_TYPE) {
# line 352 "ChangeDefs.puma"
return d1;
}
if (d1->Kind == kARRAY_TYPE) {
if (d2->Kind == kARRAY_TYPE) {
# line 356 "ChangeDefs.puma"
{
# line 357 "ChangeDefs.puma"
printf ("**Error** : two array definitions\n");
}
return NoTree;
}
if (d1->ARRAY_TYPE.ARRAY_COMP_TYPE->Kind == kDUMMY_TYPE) {
# line 366 "ChangeDefs.puma"
{
# line 367 "ChangeDefs.puma"
newtype = mARRAY_TYPE (d1->ARRAY_TYPE.ARRAY_INDEX_TYPES, d2);
}
return newtype;
}
}
if (d2->Kind == kARRAY_TYPE) {
if (d2->ARRAY_TYPE.ARRAY_COMP_TYPE->Kind == kDUMMY_TYPE) {
# line 361 "ChangeDefs.puma"
{
# line 362 "ChangeDefs.puma"
newtype = mARRAY_TYPE (d2->ARRAY_TYPE.ARRAY_INDEX_TYPES, d1);
}
return newtype;
}
}
# line 371 "ChangeDefs.puma"
return NoTree;
}
void MakeObjSequential
# if defined __STDC__ | defined __cplusplus
(register tTree t, register tDefinitions v)
# else
(t, v)
register tTree t;
register tDefinitions v;
# endif
{
if (t == NoTree) return;
if (v == NoDefinitions) return;
if (v->Kind == kCommonObject) {
# line 383 "ChangeDefs.puma"
{
# line 384 "ChangeDefs.puma"
if (! ((v->CommonObject.sequence == 2))) goto yyL1;
{
# line 385 "ChangeDefs.puma"
tree_error_protocol ("COMMON has already NO SEQUENCE association", t);
}
}
return;
yyL1:;
# line 388 "ChangeDefs.puma"
{
# line 389 "ChangeDefs.puma"
if (! ((v->CommonObject.distributed_vars > 0))) goto yyL2;
{
# line 391 "ChangeDefs.puma"
tree_error_protocol ("COMMON with distributed arrays must not have SEQUENCE association", t);
}
}
return;
yyL2:;
# line 394 "ChangeDefs.puma"
{
# line 395 "ChangeDefs.puma"
v->CommonObject.sequence = 1;
}
return;
}
;
}
void MakeObjNoSequential
# if defined __STDC__ | defined __cplusplus
(register tTree t, register tDefinitions v)
# else
(t, v)
register tTree t;
register tDefinitions v;
# endif
{
if (t == NoTree) return;
if (v == NoDefinitions) return;
if (v->Kind == kCommonObject) {
# line 406 "ChangeDefs.puma"
{
# line 407 "ChangeDefs.puma"
if (! ((v->CommonObject.sequence == 1))) goto yyL1;
{
# line 408 "ChangeDefs.puma"
tree_error_protocol ("COMMON has already SEQUENCE association", t);
}
}
return;
yyL1:;
# line 411 "ChangeDefs.puma"
{
# line 412 "ChangeDefs.puma"
v->CommonObject.sequence = 2;
}
return;
}
;
}
void MakeObjSave
# if defined __STDC__ | defined __cplusplus
(register tTree t, register tDefinitions v)
# else
(t, v)
register tTree t;
register tDefinitions v;
# endif
{
if (t == NoTree) return;
if (v == NoDefinitions) return;
if (v->Kind == kVarObject) {
if (v->VarObject.Kind->Kind == kVarLocal) {
# line 423 "ChangeDefs.puma"
{
# line 424 "ChangeDefs.puma"
if (v->VarObject.Kind->VarLocal.IsSave)
tree_error_protocol ("Local Variable is already save", t);
v->VarObject.Kind->VarLocal.IsSave = true;
}
return;
}
if (v->VarObject.Kind->Kind == kVarDummy) {
# line 430 "ChangeDefs.puma"
{
# line 431 "ChangeDefs.puma"
tree_error_protocol ("Dummy variable can not be save", t);
}
return;
}
if (v->VarObject.Kind->Kind == kVarConstant) {
# line 434 "ChangeDefs.puma"
{
# line 435 "ChangeDefs.puma"
tree_error_protocol ("Constant can not be save", t);
}
return;
}
if (v->VarObject.Kind->Kind == kVarCommon) {
# line 438 "ChangeDefs.puma"
{
# line 439 "ChangeDefs.puma"
tree_error_protocol ("only a whole common block can be save", t);
}
return;
}
}
# line 442 "ChangeDefs.puma"
{
# line 443 "ChangeDefs.puma"
tree_error_protocol ("subroutine/function/blockdata cannot be save", t);
}
return;
;
}
void MakeObjDistribution
# if defined __STDC__ | defined __cplusplus
(register tTree layout, register tDefinitions obj)
# else
(layout, obj)
register tTree layout;
register tDefinitions obj;
# endif
{
if (layout == NoTree) return;
if (obj == NoDefinitions) return;
if (layout->Kind == kDISTRIBUTE_DECL) {
if (obj->Kind == kVarObject) {
if (obj->VarObject.Dist->Kind == kDefaultDistribution) {
# line 456 "ChangeDefs.puma"
{
# line 459 "ChangeDefs.puma"
CheckDistributionSpecification (layout, VarRank (obj));
# line 460 "ChangeDefs.puma"
obj->VarObject.Dist = GetDistribution (layout->DISTRIBUTE_DECL.DISTRIBUTION);
}
return;
}
}
if (obj->Kind == kTemplateObject) {
if (obj->TemplateObject.Dist->Kind == kDefaultDistribution) {
# line 468 "ChangeDefs.puma"
{
# line 471 "ChangeDefs.puma"
CheckDistributionSpecification (layout, VarRank (obj));
# line 473 "ChangeDefs.puma"
obj->TemplateObject.Dist = GetDistribution (layout->DISTRIBUTE_DECL.DISTRIBUTION);
}
return;
}
}
}
if (obj->Kind == kVarObject) {
# line 463 "ChangeDefs.puma"
{
# line 464 "ChangeDefs.puma"
obj_error_protocol ("this variable object is already distributed", obj);
# line 465 "ChangeDefs.puma"
tree_protocol ("new distribution is : ", layout);
}
return;
}
if (obj->Kind == kTemplateObject) {
# line 476 "ChangeDefs.puma"
{
# line 477 "ChangeDefs.puma"
obj_error_protocol ("this template object is already distributed", obj);
# line 478 "ChangeDefs.puma"
tree_protocol ("new distribution is : ", layout);
}
return;
}
# line 481 "ChangeDefs.puma"
{
# line 482 "ChangeDefs.puma"
obj_error_protocol ("this object cannot be distributed", obj);
# line 483 "ChangeDefs.puma"
tree_protocol ("layout/distribution is : ", layout);
}
return;
;
}
static void CheckDistributionSpecification
# if defined __STDC__ | defined __cplusplus
(register tTree layout, register int rank)
# else
(layout, rank)
register tTree layout;
register int rank;
# endif
{
if (layout == NoTree) return;
if (layout->Kind == kDISTRIBUTE_DECL) {
if (layout->DISTRIBUTE_DECL.DISTRIBUTION->Kind == kNODE_DISTRIBUTION) {
# line 494 "ChangeDefs.puma"
{
# line 495 "ChangeDefs.puma"
if (TreeListLength (layout->DISTRIBUTE_DECL.DISTRIBUTION->NODE_DISTRIBUTION.MAPPING) != rank)
tree_error_protocol ("illegal distribution (rank!)", layout);
if (rank == 0)
tree_error_protocol ("distribution of a scalar not allowed", layout);
}
return;
}
}
# line 502 "ChangeDefs.puma"
{
# line 503 "ChangeDefs.puma"
if (rank == 0)
tree_error_protocol ("distribution of a scalar not allowed", layout);
}
return;
;
}
static tDefinitions GetDistribution
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
if (t->Kind == kHOST_DISTRIBUTION) {
# line 516 "ChangeDefs.puma"
return mHostDistribution (0, 0, DefaultId ());
}
if (t->Kind == kREPL_DISTRIBUTION) {
# line 520 "ChangeDefs.puma"
return mSerialDistribution (0, 0);
}
if (t->Kind == kNODE_DISTRIBUTION) {
# line 524 "ChangeDefs.puma"
{
# line 525 "ChangeDefs.puma"
if (! ((target_model == UNI_PROC))) goto yyL3;
}
return mSerialDistribution (0, 0);
yyL3:;
# line 529 "ChangeDefs.puma"
{
# line 530 "ChangeDefs.puma"
if (! (IsSerialDistribution (t->NODE_DISTRIBUTION.MAPPING) == true)) goto yyL4;
}
return mSerialDistribution (0, 0);
yyL4:;
# line 534 "ChangeDefs.puma"
return mNodeDistribution (0, 0, DefaultId (), GetDistributedDimensions (t->NODE_DISTRIBUTION.MAPPING, 0));
}
# line 539 "ChangeDefs.puma"
{
# line 540 "ChangeDefs.puma"
tree_error_protocol ("Illegal distribution specification", t);
}
return 0;
}
static bool IsSerialDistribution
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
if (t == NoTree) return false;
if (t->Kind == kDIST_EMPTY) {
# line 554 "ChangeDefs.puma"
return true;
}
if (t->Kind == kDIST_LIST) {
if (t->DIST_LIST.Elem->Kind == kSERIAL_DISTRIBUTION) {
# line 557 "ChangeDefs.puma"
{
# line 558 "ChangeDefs.puma"
if (! (IsSerialDistribution (t->DIST_LIST.Next))) goto yyL2;
}
return true;
yyL2:;
}
}
return false;
}
static DistributedDimensions GetDistributedDimensions
# if defined __STDC__ | defined __cplusplus
(register tTree t, register int n)
# else
(t, n)
register tTree t;
register int n;
# endif
{
# line 574 "ChangeDefs.puma"
DistributedDimensions dims;
if (t->Kind == kDIST_EMPTY) {
# line 578 "ChangeDefs.puma"
{
# line 579 "ChangeDefs.puma"
dims.no_dims = n;
}
return dims;
}
if (t->Kind == kDIST_LIST) {
if (t->DIST_LIST.Elem->Kind == kSERIAL_DISTRIBUTION) {
# line 583 "ChangeDefs.puma"
{
# line 584 "ChangeDefs.puma"
dims = GetDistributedDimensions (t->DIST_LIST.Next, n+1);
dims.DimsArray[n] = 0;
}
return dims;
}
if (t->DIST_LIST.Elem->Kind == kBLOCK_DISTRIBUTION) {
# line 590 "ChangeDefs.puma"
{
# line 591 "ChangeDefs.puma"
dims = GetDistributedDimensions (t->DIST_LIST.Next, n+1);
dims.DimsArray[n] = 1;
}
return dims;
}
if (t->DIST_LIST.Elem->Kind == kCYCLIC_DISTRIBUTION) {
# line 597 "ChangeDefs.puma"
{
# line 598 "ChangeDefs.puma"
dims = GetDistributedDimensions (t->DIST_LIST.Next, n+1);
dims.DimsArray[n] = 2;
}
return dims;
}
}
yyAbort ("GetDistributedDimensions");
}
void MakeObjAlignment
# if defined __STDC__ | defined __cplusplus
(register tTree align, register tDefinitions obj)
# else
(align, obj)
register tTree align;
register tDefinitions obj;
# endif
{
if (align == NoTree) return;
if (obj == NoDefinitions) return;
if (align->Kind == kALIGN_DECL) {
if (obj->Kind == kVarObject) {
if (obj->VarObject.Dist->Kind == kDefaultDistribution) {
# line 612 "ChangeDefs.puma"
{
# line 615 "ChangeDefs.puma"
if (VarRank(obj) == 0)
obj_error_protocol ("alignment for scalars not allowed", obj);
obj->VarObject.Dist = GetAlignDistribution (align, VarRank(obj));
}
return;
}
}
}
if (obj->Kind == kVarObject) {
# line 621 "ChangeDefs.puma"
{
# line 622 "ChangeDefs.puma"
obj_error_protocol ("this variable object is already distributed", obj);
}
return;
}
# line 625 "ChangeDefs.puma"
{
# line 626 "ChangeDefs.puma"
obj_error_protocol ("this object cannot be distributed", obj);
}
return;
;
}
static tDefinitions GetAlignDistribution
# if defined __STDC__ | defined __cplusplus
(register tTree align, register int rank)
# else
(align, rank)
register tTree align;
register int rank;
# endif
{
if (align->Kind == kALIGN_DECL) {
# line 641 "ChangeDefs.puma"
{
int n1;
int n2;
{
# line 643 "ChangeDefs.puma"
GenFullAlignSource (align, rank);
# line 644 "ChangeDefs.puma"
GenFullAlignSpec (align);
# line 646 "ChangeDefs.puma"
# line 647 "ChangeDefs.puma"
# line 649 "ChangeDefs.puma"
n1 = FillAlignSpec (align->ALIGN_DECL.ALIGN_SOURCE,0);
n2 = FillAlignSpec (align->ALIGN_DECL.ALIGN_SPEC,0);
if (n1 != n2)
tree_error_protocol ("align: mismatch of source and spec", align);
}
{
return MakeAlignDistribution (align->ALIGN_DECL.ALIGN_SPEC, align->ALIGN_DECL.ALIGN_SOURCE);
}
}
}
yyAbort ("GetAlignDistribution");
}
static tDefinitions MakeAlignDistribution
# if defined __STDC__ | defined __cplusplus
(register tTree template, register tTree source)
# else
(template, source)
register tTree template;
register tTree source;
# endif
{
if (template->Kind == kINDEXED_VAR) {
if (template->INDEXED_VAR.IND_VAR->Kind == kUSED_VAR) {
# line 670 "ChangeDefs.puma"
return mAlignDistribution (0, 0, template->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Object, FindAllSourceDimensions (template->INDEXED_VAR.IND_EXPS, source, 0));
}
}
yyAbort ("MakeAlignDistribution");
}
static void GenFullAlignSource
# if defined __STDC__ | defined __cplusplus
(register tTree align, register int rank)
# else
(align, rank)
register tTree align;
register int rank;
# endif
{
# line 686 "ChangeDefs.puma"
int i;
tTree hs, slice;
if (align == NoTree) return;
if (align->Kind == kALIGN_DECL) {
if (align->ALIGN_DECL.ALIGN_SOURCE->Kind == kBTE_EMPTY) {
# line 691 "ChangeDefs.puma"
{
# line 692 "ChangeDefs.puma"
hs = align->ALIGN_DECL.ALIGN_SOURCE;
slice = mSLICE_EXP (mDUMMY_EXP(), mDUMMY_EXP(), mDUMMY_EXP());
for (i=1; i<= rank; i++)
hs = mBTE_LIST (slice, hs);
align->ALIGN_DECL.ALIGN_SOURCE = hs;
}
return;
}
# line 700 "ChangeDefs.puma"
{
# line 701 "ChangeDefs.puma"
if (TreeListLength (align->ALIGN_DECL.ALIGN_SOURCE) != rank)
tree_error_protocol ("illegal align source list, rank ! ", align);
}
return;
}
;
}
static void GenFullAlignSpec
# if defined __STDC__ | defined __cplusplus
(register tTree align)
# else
(align)
register tTree align;
# endif
{
# line 716 "ChangeDefs.puma"
int i, rank;
tTree list, slice;
if (align == NoTree) return;
if (align->Kind == kALIGN_DECL) {
if (align->ALIGN_DECL.ALIGN_SPEC->Kind == kUSED_VAR) {
# line 721 "ChangeDefs.puma"
{
# line 722 "ChangeDefs.puma"
if (!CorrectAlignSpec (align->ALIGN_DECL.ALIGN_SPEC))
{ tree_protocol ("alignment is : ", align);
rank = 0;
}
else
rank = TreeRank (align->ALIGN_DECL.ALIGN_SPEC);
list = mBTE_EMPTY ();
slice = mSLICE_EXP (mDUMMY_EXP(), mDUMMY_EXP(), mDUMMY_EXP());
for (i=1; i<=rank; i++)
list = mBTE_LIST (slice, list);
align->ALIGN_DECL.ALIGN_SPEC = mINDEXED_VAR (align->ALIGN_DECL.ALIGN_SPEC, list);
}
return;
}
if (align->ALIGN_DECL.ALIGN_SPEC->Kind == kINDEXED_VAR) {
# line 736 "ChangeDefs.puma"
{
# line 737 "ChangeDefs.puma"
if (!CorrectAlignSpec (align->ALIGN_DECL.ALIGN_SPEC))
tree_protocol ("alignment is : ", align);
else if (TreeListLength (align->ALIGN_DECL.ALIGN_SPEC->INDEXED_VAR.IND_EXPS) != TreeRank (align->ALIGN_DECL.ALIGN_SPEC->INDEXED_VAR.IND_VAR))
tree_error_protocol ("illegal spec in alignment (rank!)", align);
}
return;
}
}
# line 744 "ChangeDefs.puma"
{
# line 745 "ChangeDefs.puma"
fprintf (stderr, "ChangeDefs: GenFullAlignSpec fails\n");
# line 746 "ChangeDefs.puma"
WriteTree (stderr, align);
# line 747 "ChangeDefs.puma"
kill_in_protocol ();
}
return;
;
}
static bool CorrectAlignSpec
# if defined __STDC__ | defined __cplusplus
(register tTree align)
# else
(align)
register tTree align;
# endif
{
if (align->Kind == kUSED_VAR) {
# line 760 "ChangeDefs.puma"
{
tDefinitions Obj;
bool ok;
{
# line 762 "ChangeDefs.puma"
# line 763 "ChangeDefs.puma"
# line 765 "ChangeDefs.puma"
Obj = GetLocalDecl (align->USED_VAR.VARNAME->VAR_OBJ.Ident);
# line 767 "ChangeDefs.puma"
ok = false;
if (Obj == NoObject)
simple_error_protocol ("align: spec name not defined");
else if (Obj->Kind != kTemplateObject)
simple_error_protocol ("align: spec not a template");
else
{ align->USED_VAR.VARNAME->VAR_OBJ.Object = Obj;
ok = true;
}
}
{
return ok;
}
}
}
if (align->Kind == kINDEXED_VAR) {
# line 780 "ChangeDefs.puma"
return CorrectAlignSpec (align->INDEXED_VAR.IND_VAR);
}
yyAbort ("CorrectAlignSpec");
}
static int FillAlignSpec
# if defined __STDC__ | defined __cplusplus
(register tTree t, register int n)
# else
(t, n)
register tTree t;
register int n;
# endif
{
# line 799 "ChangeDefs.puma"
char name [20];
if (t->Kind == kINDEXED_VAR) {
# line 803 "ChangeDefs.puma"
return FillAlignSpec (t->INDEXED_VAR.IND_EXPS, n);
}
if (t->Kind == kBTE_EMPTY) {
# line 807 "ChangeDefs.puma"
return n;
}
if (t->Kind == kBTE_LIST) {
if (t->BTE_LIST.Elem->Kind == kSLICE_EXP) {
if (t->BTE_LIST.Elem->SLICE_EXP.START->Kind == kDUMMY_EXP) {
if (t->BTE_LIST.Elem->SLICE_EXP.STOP->Kind == kDUMMY_EXP) {
if (t->BTE_LIST.Elem->SLICE_EXP.INC->Kind == kDUMMY_EXP) {
# line 811 "ChangeDefs.puma"
{
tTree e;
{
# line 813 "ChangeDefs.puma"
# line 815 "ChangeDefs.puma"
sprintf (name, "I_%d", n+1);
e = mVAR_OBJ (0, MakeIdent (name, strlen (name)));
e = mVAR_EXP (mUSED_VAR (e));
t->BTE_LIST.Elem = e;
}
{
return FillAlignSpec (t->BTE_LIST.Next, n + 1);
}
}
}
}
}
}
# line 823 "ChangeDefs.puma"
return FillAlignSpec (t->BTE_LIST.Next, n);
}
# line 827 "ChangeDefs.puma"
{
# line 828 "ChangeDefs.puma"
printf ("FillAlignSpec in ChangeDefs failed\n");
# line 829 "ChangeDefs.puma"
WriteTree (stdout, t);
# line 830 "ChangeDefs.puma"
kill_in_protocol ();
}
return n;
}
static DistributedDimensions FindAllSourceDimensions
# if defined __STDC__ | defined __cplusplus
(register tTree spec, register tTree source, register int n)
# else
(spec, source, n)
register tTree spec;
register tTree source;
register int n;
# endif
{
# line 846 "ChangeDefs.puma"
DistributedDimensions dims;
if (spec->Kind == kBTE_EMPTY) {
# line 850 "ChangeDefs.puma"
{
# line 851 "ChangeDefs.puma"
dims.no_dims = n;
}
return dims;
}
if (spec->Kind == kBTE_LIST) {
# line 855 "ChangeDefs.puma"
{
# line 856 "ChangeDefs.puma"
dims = FindAllSourceDimensions (spec->BTE_LIST.Next, source, n+1);
dims.DimsArray[n] = FindSourceDimension (spec->BTE_LIST.Elem, source, 1);
}
return dims;
}
yyAbort ("FindAllSourceDimensions");
}
static int FindSourceDimension
# if defined __STDC__ | defined __cplusplus
(register tTree spec, register tTree source, register int n)
# else
(spec, source, n)
register tTree spec;
register tTree source;
register int n;
# endif
{
if (spec->Kind == kDUMMY_EXP) {
# line 878 "ChangeDefs.puma"
return 0;
}
if (source->Kind == kBTE_EMPTY) {
# line 882 "ChangeDefs.puma"
return - 1;
}
if (spec->Kind == kVAR_EXP) {
if (spec->VAR_EXP.V->Kind == kUSED_VAR) {
if (source->Kind == kBTE_LIST) {
if (source->BTE_LIST.Elem->Kind == kVAR_EXP) {
if (source->BTE_LIST.Elem->VAR_EXP.V->Kind == kUSED_VAR) {
# line 886 "ChangeDefs.puma"
{
# line 888 "ChangeDefs.puma"
if (! (spec->VAR_EXP.V->USED_VAR.VARNAME->VAR_OBJ.Ident == source->BTE_LIST.Elem->VAR_EXP.V->USED_VAR.VARNAME->VAR_OBJ.Ident)) goto yyL3;
}
return n;
yyL3:;
}
}
}
}
}
if (source->Kind == kBTE_LIST) {
# line 892 "ChangeDefs.puma"
return FindSourceDimension (spec, source->BTE_LIST.Next, n + 1);
}
yyAbort ("FindSourceDimension");
}
static tDefinitions GetExtFuncEntry
# if defined __STDC__ | defined __cplusplus
(register tIdent name, register tTree type)
# else
(name, type)
register tIdent name;
register tTree type;
# endif
{
# line 904 "ChangeDefs.puma"
tObject obj;
tTree Decl;
int calls;
# line 910 "ChangeDefs.puma"
{
# line 911 "ChangeDefs.puma"
obj = GetDeclEntry (name, GetUnitEntries ());
if (obj == NoObject)
obj = GetDeclEntry (name, GetExternalEntries ());
if (obj == NoObject)
{
Decl = mEXT_FUNC_DECL (name, 0, mDECL_EMPTY(), type);
calls = 0;
obj = mFuncObject (name, Decl, calls, mENTRY_EMPTY ());
InsertExternalEntry (obj);
}
else
{
}
}
return obj;
}
void MakeObjExternal
# if defined __STDC__ | defined __cplusplus
(register tTree decl, register tDefinitions oldobj)
# else
(decl, oldobj)
register tTree decl;
register tDefinitions oldobj;
# endif
{
if (decl == NoTree) return;
if (oldobj == NoDefinitions) return;
if (oldobj->Kind == kVarObject) {
if (oldobj->VarObject.decl->Kind == kVAR_DECL) {
if (oldobj->VarObject.Kind->Kind == kVarLocal) {
# line 938 "ChangeDefs.puma"
{
tDefinitions Obj;
{
# line 940 "ChangeDefs.puma"
# line 942 "ChangeDefs.puma"
Obj = GetExtFuncEntry (oldobj->VarObject.ident, oldobj->VarObject.decl->VAR_DECL.VAL);
# line 946 "ChangeDefs.puma"
ChangeEntry (oldobj->VarObject.ident, Obj);
}
return;
}
}
}
if (oldobj->VarObject.decl->Kind == kVAR_PARAM_DECL) {
if (oldobj->VarObject.decl->VAR_PARAM_DECL.VAL->Kind == kDUMMY_TYPE) {
# line 956 "ChangeDefs.puma"
{
tDefinitions Obj;
tTree ndecl;
int calls;
{
# line 958 "ChangeDefs.puma"
# line 959 "ChangeDefs.puma"
# line 960 "ChangeDefs.puma"
# line 962 "ChangeDefs.puma"
ndecl = mPROC_PARAM_DECL (oldobj->VarObject.ident, oldobj->VarObject.decl->VAR_PARAM_DECL.Pos, mBTP_EMPTY());
calls = 0;
Obj = mProcObject (oldobj->VarObject.ident, ndecl, calls, mENTRY_EMPTY ());
# line 967 "ChangeDefs.puma"
ChangeEntry (oldobj->VarObject.ident, Obj);
}
return;
}
}
# line 978 "ChangeDefs.puma"
{
tDefinitions Obj;
tTree ndecl;
int calls;
{
# line 980 "ChangeDefs.puma"
# line 981 "ChangeDefs.puma"
# line 982 "ChangeDefs.puma"
# line 984 "ChangeDefs.puma"
ndecl = mFUNC_PARAM_DECL (oldobj->VarObject.ident, oldobj->VarObject.decl->VAR_PARAM_DECL.Pos, mBTP_EMPTY(), oldobj->VarObject.decl->VAR_PARAM_DECL.VAL);
calls = 0;
Obj = mFuncObject (oldobj->VarObject.ident, ndecl, calls, mENTRY_EMPTY ());
# line 989 "ChangeDefs.puma"
ChangeEntry (oldobj->VarObject.ident, Obj);
}
return;
}
}
# line 992 "ChangeDefs.puma"
{
# line 993 "ChangeDefs.puma"
tree_error_protocol ("could not make var to external", oldobj->VarObject.decl);
}
return;
}
if (oldobj->Kind == kProcObject) {
# line 996 "ChangeDefs.puma"
{
# line 997 "ChangeDefs.puma"
tree_error_protocol ("could not make proc to external", oldobj->ProcObject.decl);
}
return;
}
if (oldobj->Kind == kFuncObject) {
# line 1000 "ChangeDefs.puma"
{
# line 1001 "ChangeDefs.puma"
tree_error_protocol ("could not make func to external", oldobj->FuncObject.decl);
}
return;
}
if (oldobj->Kind == kBlockObject) {
# line 1004 "ChangeDefs.puma"
{
# line 1005 "ChangeDefs.puma"
tree_error_protocol ("could not make block to external", oldobj->BlockObject.decl);
}
return;
}
;
}
void StatementFunctions
# if defined __STDC__ | defined __cplusplus
(register tTree body)
# else
(body)
register tTree body;
# endif
{
if (body == NoTree) return;
if (body->Kind == kBODY_NODE) {
# line 1016 "ChangeDefs.puma"
{
# line 1018 "ChangeDefs.puma"
stmtfuncs = mDECL_EMPTY ();
body->BODY_NODE.STATS = ExtractStatementFunctions (body->BODY_NODE.STATS);
body->BODY_NODE.DECLS = AppendDECLS (body->BODY_NODE.DECLS, stmtfuncs);
}
return;
}
;
}
static tTree ExtractStatementFunctions
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
# line 1040 "ChangeDefs.puma"
tTree StmtFuncDecl;
tTree NextList;
if (t->Kind == kACF_LIST) {
if (t->ACF_LIST.Elem->Kind == kACF_BASIC) {
if (t->ACF_LIST.Elem->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
# line 1045 "ChangeDefs.puma"
{
# line 1047 "ChangeDefs.puma"
if (! (IsStatementFunction (t->ACF_LIST.Elem->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR))) goto yyL1;
{
# line 1049 "ChangeDefs.puma"
set_protocol_stmt (t->ACF_LIST.Elem);
# line 1051 "ChangeDefs.puma"
stmt_protocol ("The following is a statement function");
# line 1057 "ChangeDefs.puma"
StmtFuncDecl = MakeStmtFuncDecl (t->ACF_LIST.Elem->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, t->ACF_LIST.Elem->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP);
NextList = ExtractStatementFunctions (t->ACF_LIST.Next);
stmtfuncs = mDECL_LIST (StmtFuncDecl, stmtfuncs);
}
}
return NextList;
yyL1:;
}
}
# line 1065 "ChangeDefs.puma"
return t;
}
if (t->Kind == kACF_EMPTY) {
# line 1070 "ChangeDefs.puma"
return t;
}
yyAbort ("ExtractStatementFunctions");
}
static bool IsStatementFunction
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
if (t == NoTree) return false;
if (t->Kind == kINDEXED_VAR) {
if (t->INDEXED_VAR.IND_VAR->Kind == kUSED_VAR) {
# line 1082 "ChangeDefs.puma"
{
bool Is;
tDefinitions Obj;
{
# line 1087 "ChangeDefs.puma"
# line 1088 "ChangeDefs.puma"
# line 1090 "ChangeDefs.puma"
Obj = GetLocalDecl (t->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Ident);
# line 1092 "ChangeDefs.puma"
Is = (Obj == NoObject);
if (!Is)
{ Is = (Obj->Kind == kVarObject);
if (Is)
Is = (Obj->VarObject.Kind->Kind == kVarLocal);
if (Is)
Is = (VarRank (Obj) == 0);
}
# line 1101 "ChangeDefs.puma"
if (! (Is)) goto yyL1;
}
return true;
}
yyL1:;
}
}
return false;
}
static tTree MakeStmtFuncDecl
# if defined __STDC__ | defined __cplusplus
(register tTree var, register tTree exp)
# else
(var, exp)
register tTree var;
register tTree exp;
# endif
{
# line 1113 "ChangeDefs.puma"
tObject OldObj, NewObj;
tTree ResType, Decl, Formals;
if (var->Kind == kINDEXED_VAR) {
if (var->INDEXED_VAR.IND_VAR->Kind == kUSED_VAR) {
# line 1118 "ChangeDefs.puma"
{
# line 1120 "ChangeDefs.puma"
Formals = MakeStmtFuncFormals (var->INDEXED_VAR.IND_EXPS);
OldObj = GetLocalDecl (var->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Ident);
if (OldObj == NoObject)
ResType = mDUMMY_TYPE ();
else
{ if (OldObj->Object.decl->Kind != kVAR_DECL)
printf ("Error in MakeStmtFuncDecl\n");
ResType = CopyTree(OldObj->Object.decl->VAR_DECL.VAL);
}
Decl = mSTMT_FUNC_DECL (var->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Ident, var->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Pos, Formals, ResType, exp);
NewObj = mFuncObject (var->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Ident, Decl, 0, mENTRY_EMPTY ());
if (OldObj != NoObject)
ChangeEntry (var->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Ident, NewObj);
else
InsertEntry (NewObj);
}
return Decl;
}
}
yyAbort ("MakeStmtFuncDecl");
}
static tTree MakeStmtFuncFormals
# if defined __STDC__ | defined __cplusplus
(register tTree Parameters)
# else
(Parameters)
register tTree Parameters;
# endif
{
if (Parameters->Kind == kBTE_LIST) {
if (Parameters->BTE_LIST.Elem->Kind == kVAR_EXP) {
if (Parameters->BTE_LIST.Elem->VAR_EXP.V->Kind == kUSED_VAR) {
# line 1153 "ChangeDefs.puma"
{
tTree P;
{
# line 1155 "ChangeDefs.puma"
# line 1157 "ChangeDefs.puma"
P = mVAR_PARAM_DECL (Parameters->BTE_LIST.Elem->VAR_EXP.V->USED_VAR.VARNAME->VAR_OBJ.Ident, Parameters->BTE_LIST.Elem->VAR_EXP.V->USED_VAR.VARNAME->VAR_OBJ.Pos, mDUMMY_TYPE ());
}
{
return mDECL_LIST (P, MakeStmtFuncFormals (Parameters->BTE_LIST.Next));
}
}
}
}
# line 1162 "ChangeDefs.puma"
{
# line 1163 "ChangeDefs.puma"
error_protocol ("Illegal Statement Function");
# line 1164 "ChangeDefs.puma"
tree_protocol ("Not a legal parameter : ", Parameters->BTE_LIST.Elem);
}
return MakeStmtFuncFormals (Parameters->BTE_LIST.Next);
}
if (Parameters->Kind == kBTE_EMPTY) {
# line 1168 "ChangeDefs.puma"
return mDECL_EMPTY ();
}
yyAbort ("MakeStmtFuncFormals");
}
void BeginChangeDefs ()
{
}
void CloseChangeDefs ()
{
}