home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Professional
/
OS2PRO194.ISO
/
os2
/
prgramer
/
adaptor
/
src
/
adaptf90.c
< prev
next >
Wrap
Text File
|
1994-01-02
|
20KB
|
948 lines
# include "F90.h"
# include "yyAF90.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 24 "AdaptF90.puma"
# include <stdio.h>
# include "Idents.h"
# include "StringMe.h"
# include "protocol.h"
# include "Types.h"
# include "Shapes.h"
# include "Expressi.h"
# undef DEBUG
static FILE * yyf = stdout;
static void yyAbort
# ifdef __cplusplus
(char * yyFunction)
# else
(yyFunction) char * yyFunction;
# endif
{
(void) fprintf (stderr, "Error: module AdaptF90, routine %s failed\n", yyFunction);
exit (1);
}
tTree MakeArrayAssignment ARGS((tTree t));
static void VectorizeMovement ARGS((tTree body, tTree id, tTree slice, bool * yyP1));
static void FindLoopVar ARGS((tTree var, tTree id, bool * yyP4, int * yyP3, int * yyP2));
static void FindLoopVarIndex ARGS((tTree var, tTree id, bool * yyP7, int * yyP6, int * yyP5));
static void Substitute ARGS((tTree var, tTree id, int val, tTree slice));
static tTree Replace ARGS((tTree exp, tTree id, tTree newexp));
static bool IsNewVectorLegal ARGS((tTree var, int pos, tTree slice));
static void SwitchIndex ARGS((tTree indexes, int n, tTree new, tTree * old));
tTree MakeArrayAssignment
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
if (t->Kind == kACF_FORALL) {
# line 62 "AdaptF90.puma"
{
tTree result;
bool done;
{
# line 64 "AdaptF90.puma"
# line 64 "AdaptF90.puma"
# line 66 "AdaptF90.puma"
t->ACF_FORALL.FORALL_BODY = MakeArrayAssignment (t->ACF_FORALL.FORALL_BODY);
#ifdef DEBUG
printf ("MakeArrayAssignment: body is \n");
FileUnparse (stdout, t->ACF_FORALL.FORALL_BODY);
#endif
VectorizeMovement (t->ACF_FORALL.FORALL_BODY, t->ACF_FORALL.FORALL_ID, t->ACF_FORALL.FORALL_RANGE, &done);
#ifdef DEBUG
if (done)
printf ("MakeArrayAssignment: vectorization has been done \n");
else
printf ("MakeArrayAssignment: vectorization has not been done \n");
FileUnparse (stdout, t->ACF_FORALL.FORALL_BODY);
#endif
if (done)
result = t->ACF_FORALL.FORALL_BODY->ACF_LIST.Elem;
else
result = t;
}
{
return result;
}
}
}
if (t->Kind == kACF_LIST) {
if (t->ACF_LIST.Next->Kind == kACF_EMPTY) {
# line 95 "AdaptF90.puma"
{
# line 97 "AdaptF90.puma"
t->ACF_LIST.Elem = MakeArrayAssignment (t->ACF_LIST.Elem);
}
return t;
}
# line 101 "AdaptF90.puma"
{
# line 103 "AdaptF90.puma"
error_protocol ("Only one assignment in FORALL for MakeArrayAssignment");
}
return t;
}
if (t->Kind == kACF_BASIC) {
if (t->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
if (t->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->Kind == kVAR_EXP) {
# line 107 "AdaptF90.puma"
return t;
}
}
}
# line 111 "AdaptF90.puma"
{
# line 112 "AdaptF90.puma"
error_protocol ("Unknown Statement in FORALL");
}
return t;
}
static void VectorizeMovement
# if defined __STDC__ | defined __cplusplus
(register tTree body, register tTree id, register tTree slice, register bool * yyP1)
# else
(body, id, slice, yyP1)
register tTree body;
register tTree id;
register tTree slice;
register bool * yyP1;
# endif
{
if (body == NoTree) return;
if (id == NoTree) return;
if (slice == NoTree) return;
if (body->Kind == kACF_LIST) {
if (body->ACF_LIST.Next->Kind == kACF_EMPTY) {
# line 132 "AdaptF90.puma"
{
bool yyV1;
{
# line 134 "AdaptF90.puma"
VectorizeMovement (body->ACF_LIST.Elem, id, slice, & yyV1);
}
* yyP1 = yyV1;
return;
}
}
}
if (body->Kind == kACF_FORALL) {
if (body->ACF_FORALL.FORALL_ID->Kind == kLOOP_VAR) {
if (id->Kind == kLOOP_VAR) {
# line 137 "AdaptF90.puma"
{
bool yyV1;
{
# line 143 "AdaptF90.puma"
if (! (IsVarInExp (id->LOOP_VAR.LOOP_VARNAME->VAR_OBJ.Ident, body->ACF_FORALL.FORALL_RANGE) == 0)) goto yyL2;
{
# line 147 "AdaptF90.puma"
VectorizeMovement (body->ACF_FORALL.FORALL_BODY, id, slice, & yyV1);
}
}
* yyP1 = yyV1;
return;
}
yyL2:;
}
}
}
if (body->Kind == kACF_BASIC) {
if (body->ACF_BASIC.BASIC_STMT->Kind == kASSIGN_STMT) {
if (body->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->Kind == kVAR_EXP) {
# line 150 "AdaptF90.puma"
{
bool done;
bool yyV1;
int yyV2;
int yyV3;
bool yyV4;
int yyV5;
int yyV6;
{
# line 152 "AdaptF90.puma"
# line 154 "AdaptF90.puma"
if (! (TreeRank (body->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR) == TreeRank (body->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V))) goto yyL3;
{
# line 156 "AdaptF90.puma"
FindLoopVar (body->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, id, & yyV1, & yyV2, & yyV3);
# line 157 "AdaptF90.puma"
FindLoopVar (body->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V, id, & yyV4, & yyV5, & yyV6);
# line 159 "AdaptF90.puma"
if (! (yyV1 && yyV4)) goto yyL3;
{
# line 160 "AdaptF90.puma"
if (! (yyV3 != 0)) goto yyL3;
{
# line 161 "AdaptF90.puma"
if (! (yyV6 != 0)) goto yyL3;
{
# line 162 "AdaptF90.puma"
if (! (yyV2 == yyV5)) goto yyL3;
{
# line 166 "AdaptF90.puma"
if (! (IsNewVectorLegal (body->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, yyV2, slice))) goto yyL3;
{
# line 168 "AdaptF90.puma"
#ifdef DEBUG
printf ("Movement will be vectorized\n");
FileUnparse (stdout, body);
printf ("Left val = %d, right val = %d\n", yyV3, yyV6);
printf ("Variable is "); FileUnparse (stdout, id); printf ("\n");
printf ("Slice is "); FileUnparse (stdout, slice); printf ("\n");
#endif
Substitute (body->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_VAR, id, yyV3, slice);
Substitute (body->ACF_BASIC.BASIC_STMT->ASSIGN_STMT.ASSIGN_EXP->VAR_EXP.V, id, yyV6, slice);
# line 181 "AdaptF90.puma"
done = true;
}
}
}
}
}
}
}
* yyP1 = done;
return;
}
yyL3:;
}
}
}
# line 184 "AdaptF90.puma"
* yyP1 = false;
return;
;
}
static void FindLoopVar
# if defined __STDC__ | defined __cplusplus
(register tTree var, register tTree id, register bool * yyP4, register int * yyP3, register int * yyP2)
# else
(var, id, yyP4, yyP3, yyP2)
register tTree var;
register tTree id;
register bool * yyP4;
register int * yyP3;
register int * yyP2;
# endif
{
if (var == NoTree) return;
if (id == NoTree) return;
if (var->Kind == kINDEXED_VAR) {
# line 203 "AdaptF90.puma"
{
bool yyV1;
int yyV2;
int yyV3;
{
# line 204 "AdaptF90.puma"
FindLoopVarIndex (var->INDEXED_VAR.IND_EXPS, id, & yyV1, & yyV2, & yyV3);
}
* yyP4 = yyV1;
* yyP3 = yyV2;
* yyP2 = yyV3;
return;
}
}
;
}
static void FindLoopVarIndex
# if defined __STDC__ | defined __cplusplus
(register tTree var, register tTree id, register bool * yyP7, register int * yyP6, register int * yyP5)
# else
(var, id, yyP7, yyP6, yyP5)
register tTree var;
register tTree id;
register bool * yyP7;
register int * yyP6;
register int * yyP5;
# endif
{
if (var == NoTree) return;
if (id == NoTree) return;
# line 212 "AdaptF90.puma"
{
bool found;
int val;
{
# line 214 "AdaptF90.puma"
# line 214 "AdaptF90.puma"
# line 216 "AdaptF90.puma"
GetIntConstValue (var, & found, & val);
# line 217 "AdaptF90.puma"
if (! (found)) goto yyL1;
}
* yyP7 = true;
* yyP6 = 0;
* yyP5 = 0;
return;
}
yyL1:;
switch (var->Kind) {
case kLOOP_VAR:
if (id->Kind == kLOOP_VAR) {
# line 220 "AdaptF90.puma"
{
# line 222 "AdaptF90.puma"
if (! (var->LOOP_VAR.LOOP_VARNAME->VAR_OBJ.Ident == id->LOOP_VAR.LOOP_VARNAME->VAR_OBJ.Ident)) goto yyL2;
}
* yyP7 = true;
* yyP6 = 0;
* yyP5 = 1;
return;
yyL2:;
# line 225 "AdaptF90.puma"
* yyP7 = true;
* yyP6 = 0;
* yyP5 = 0;
return;
}
break;
case kUSED_VAR:
if (id->Kind == kLOOP_VAR) {
# line 229 "AdaptF90.puma"
{
# line 231 "AdaptF90.puma"
if (! (var->USED_VAR.VARNAME->VAR_OBJ.Ident == id->LOOP_VAR.LOOP_VARNAME->VAR_OBJ.Ident)) goto yyL4;
}
* yyP7 = true;
* yyP6 = 0;
* yyP5 = 1;
return;
yyL4:;
# line 234 "AdaptF90.puma"
* yyP7 = true;
* yyP6 = 0;
* yyP5 = 0;
return;
}
break;
case kINDEXED_VAR:
# line 238 "AdaptF90.puma"
* yyP7 = false;
* yyP6 = 0;
* yyP5 = 0;
return;
case kBTE_LIST:
if (var->BTE_LIST.Elem->Kind == kSLICE_EXP) {
if (id->Kind == kLOOP_VAR) {
# line 241 "AdaptF90.puma"
{
# line 243 "AdaptF90.puma"
if (! (IsVarInExp (id->LOOP_VAR.LOOP_VARNAME->VAR_OBJ.Ident, var->BTE_LIST.Elem) > 0)) goto yyL7;
}
* yyP7 = false;
* yyP6 = 0;
* yyP5 = 0;
return;
yyL7:;
}
# line 246 "AdaptF90.puma"
{
bool yyV1;
int yyV2;
int yyV3;
{
# line 247 "AdaptF90.puma"
FindLoopVarIndex (var->BTE_LIST.Next, id, & yyV1, & yyV2, & yyV3);
}
* yyP7 = yyV1;
* yyP6 = yyV2 + 1;
* yyP5 = yyV3;
return;
}
}
# line 250 "AdaptF90.puma"
{
bool yyV1;
int yyV2;
int yyV3;
bool yyV4;
int yyV5;
int yyV6;
{
# line 252 "AdaptF90.puma"
FindLoopVarIndex (var->BTE_LIST.Elem, id, & yyV1, & yyV2, & yyV3);
# line 253 "AdaptF90.puma"
FindLoopVarIndex (var->BTE_LIST.Next, id, & yyV4, & yyV5, & yyV6);
# line 255 "AdaptF90.puma"
yyV1 = (yyV1 && yyV4);
if ((yyV3 != 0) && (yyV6 != 0))
yyV1 = false;
if (yyV6 != 0)
{ yyV2 = yyV5;
yyV3 = yyV6;
}
}
* yyP7 = yyV1;
* yyP6 = yyV2;
* yyP5 = yyV3;
return;
}
case kBTE_EMPTY:
# line 265 "AdaptF90.puma"
* yyP7 = true;
* yyP6 = 0;
* yyP5 = 0;
return;
case kVAR_EXP:
# line 268 "AdaptF90.puma"
{
bool yyV1;
int yyV2;
int yyV3;
{
# line 269 "AdaptF90.puma"
FindLoopVarIndex (var->VAR_EXP.V, id, & yyV1, & yyV2, & yyV3);
}
* yyP7 = yyV1;
* yyP6 = yyV2;
* yyP5 = yyV3;
return;
}
case kOP_EXP:
if (var->OP_EXP.EXP_OP->Kind == kOP_PLUS) {
# line 272 "AdaptF90.puma"
{
bool yyV1;
int yyV2;
int yyV3;
bool yyV4;
int yyV5;
int yyV6;
{
# line 274 "AdaptF90.puma"
FindLoopVarIndex (var->OP_EXP.OPND1, id, & yyV1, & yyV2, & yyV3);
# line 275 "AdaptF90.puma"
FindLoopVarIndex (var->OP_EXP.OPND2, id, & yyV4, & yyV5, & yyV6);
# line 277 "AdaptF90.puma"
yyV1 = (yyV1 && yyV4);
if ((yyV3 != 0) && (yyV6 != 0))
{
yyV1 = (yyV2 == yyV5);
}
if (yyV6 != 0)
yyV2 = yyV5;
yyV3 += yyV6;
}
* yyP7 = yyV1;
* yyP6 = yyV2;
* yyP5 = yyV3;
return;
}
}
if (var->OP_EXP.EXP_OP->Kind == kOP_MINUS) {
# line 288 "AdaptF90.puma"
{
bool yyV1;
int yyV2;
int yyV3;
bool yyV4;
int yyV5;
int yyV6;
{
# line 290 "AdaptF90.puma"
FindLoopVarIndex (var->OP_EXP.OPND1, id, & yyV1, & yyV2, & yyV3);
# line 291 "AdaptF90.puma"
FindLoopVarIndex (var->OP_EXP.OPND2, id, & yyV4, & yyV5, & yyV6);
# line 293 "AdaptF90.puma"
yyV1 = (yyV1 && yyV4);
if ((yyV3 != 0) && (yyV6 != 0))
{
yyV1 = (yyV2 == yyV5);
}
if (yyV6 != 0)
yyV2 = yyV5;
yyV3 -= yyV6;
}
* yyP7 = yyV1;
* yyP6 = yyV2;
* yyP5 = yyV3;
return;
}
}
if (var->OP_EXP.EXP_OP->Kind == kOP_TIMES) {
# line 304 "AdaptF90.puma"
{
bool yyV1;
int yyV2;
int yyV3;
bool yyV4;
int yyV5;
int yyV6;
{
# line 307 "AdaptF90.puma"
FindLoopVarIndex (var->OP_EXP.OPND1, id, & yyV1, & yyV2, & yyV3);
# line 308 "AdaptF90.puma"
FindLoopVarIndex (var->OP_EXP.OPND2, id, & yyV4, & yyV5, & yyV6);
# line 310 "AdaptF90.puma"
yyV1 = (yyV1 && yyV4);
if ((yyV3 != 0) && (yyV6 != 0))
yyV1 = false;
if (yyV6 != 0)
{ yyV2 = yyV5;
yyV3 = yyV6;
}
}
* yyP7 = yyV1;
* yyP6 = yyV2;
* yyP5 = yyV3;
return;
}
}
break;
case kOP1_EXP:
if (var->OP1_EXP.EXP_OP1->Kind == kOP1_SIGN) {
# line 320 "AdaptF90.puma"
{
bool yyV1;
int yyV2;
int yyV3;
{
# line 321 "AdaptF90.puma"
FindLoopVarIndex (var->OP1_EXP.OPND, id, & yyV1, & yyV2, & yyV3);
}
* yyP7 = yyV1;
* yyP6 = yyV2;
* yyP5 = - yyV3;
return;
}
}
break;
case kFUNC_CALL_EXP:
# line 324 "AdaptF90.puma"
* yyP7 = false;
* yyP6 = 0;
* yyP5 = 0;
return;
}
# line 327 "AdaptF90.puma"
{
# line 328 "AdaptF90.puma"
printf ("FindLoopVarIndex failed\n");
# line 329 "AdaptF90.puma"
FileUnparse (stdout, var);
# line 330 "AdaptF90.puma"
WriteTree (stdout, var);
}
* yyP7 = false;
* yyP6 = 0;
* yyP5 = 0;
return;
;
}
static void Substitute
# if defined __STDC__ | defined __cplusplus
(register tTree var, register tTree id, register int val, register tTree slice)
# else
(var, id, val, slice)
register tTree var;
register tTree id;
register int val;
register tTree slice;
# endif
{
if (var == NoTree) return;
if (id == NoTree) return;
if (slice == NoTree) return;
if (var->Kind == kINDEXED_VAR) {
# line 347 "AdaptF90.puma"
{
# line 348 "AdaptF90.puma"
Substitute (var->INDEXED_VAR.IND_EXPS, id, val, slice);
}
return;
}
if (var->Kind == kBTE_LIST) {
if (id->Kind == kLOOP_VAR) {
if (slice->Kind == kSLICE_EXP) {
# line 351 "AdaptF90.puma"
{
int m;
tTree nstart;
tTree nstop;
tTree ninc;
{
# line 354 "AdaptF90.puma"
# line 356 "AdaptF90.puma"
m = IsVarInExp (id->LOOP_VAR.LOOP_VARNAME->VAR_OBJ.Ident, var->BTE_LIST.Elem);
# line 358 "AdaptF90.puma"
#ifdef DEBUG
printf ("Substitute in Index, index = "); FileUnparse (stdout, var->BTE_LIST.Elem);
printf ("\n");
printf ("Index "); FileUnparse (stdout, id); printf (" appears %d\n", m);
#endif
# line 366 "AdaptF90.puma"
if (! (m > 0)) goto yyL2;
{
# line 368 "AdaptF90.puma"
# line 368 "AdaptF90.puma"
# line 368 "AdaptF90.puma"
# line 370 "AdaptF90.puma"
nstop = CopyTree (var->BTE_LIST.Elem);
nstart = Replace (var->BTE_LIST.Elem, id, slice->SLICE_EXP.START);
nstop = Replace (nstop, id, slice->SLICE_EXP.STOP);
if (val > 0)
ninc = CopyTree (slice->SLICE_EXP.INC);
else
{
if (slice->SLICE_EXP.INC == NoTree)
ninc = mCONST_EXP (mINT_CONSTANT (-1));
else if (slice->SLICE_EXP.INC->Kind == kDUMMY_EXP)
ninc = mCONST_EXP (mINT_CONSTANT (-1));
else ninc = mOP1_EXP (mOP1_SIGN(), CopyTree (slice->SLICE_EXP.INC));
}
var->BTE_LIST.Elem = mSLICE_EXP (nstart, nstop, ninc);
}
}
return;
}
yyL2:;
}
}
# line 387 "AdaptF90.puma"
{
# line 388 "AdaptF90.puma"
Substitute (var->BTE_LIST.Next, id, val, slice);
}
return;
}
if (var->Kind == kBTE_EMPTY) {
# line 391 "AdaptF90.puma"
{
# line 392 "AdaptF90.puma"
printf ("FATAL ERROR: Substitute failed\n");
# line 393 "AdaptF90.puma"
kill_in_protocol ();
}
return;
}
;
}
static tTree Replace
# if defined __STDC__ | defined __cplusplus
(register tTree exp, register tTree id, register tTree newexp)
# else
(exp, id, newexp)
register tTree exp;
register tTree id;
register tTree newexp;
# endif
{
if (exp->Kind == kVAR_EXP) {
if (exp->VAR_EXP.V->Kind == kLOOP_VAR) {
if (id->Kind == kLOOP_VAR) {
# line 404 "AdaptF90.puma"
{
# line 406 "AdaptF90.puma"
if (! (exp->VAR_EXP.V->LOOP_VAR.LOOP_VARNAME->VAR_OBJ.Ident == id->LOOP_VAR.LOOP_VARNAME->VAR_OBJ.Ident)) goto yyL1;
}
return CopyTree (newexp);
yyL1:;
}
}
if (exp->VAR_EXP.V->Kind == kINDEXED_VAR) {
# line 411 "AdaptF90.puma"
return Replace (exp->VAR_EXP.V->INDEXED_VAR.IND_EXPS, id, newexp);
}
# line 415 "AdaptF90.puma"
return exp;
}
if (exp->Kind == kBTE_LIST) {
# line 419 "AdaptF90.puma"
{
# line 420 "AdaptF90.puma"
exp->BTE_LIST.Elem = Replace (exp->BTE_LIST.Elem, id, newexp);
exp->BTE_LIST.Next = Replace (exp->BTE_LIST.Next, id, newexp);
}
return exp;
}
if (exp->Kind == kBTE_EMPTY) {
# line 426 "AdaptF90.puma"
return exp;
}
if (exp->Kind == kOP_EXP) {
# line 430 "AdaptF90.puma"
{
# line 431 "AdaptF90.puma"
exp->OP_EXP.OPND1 = Replace (exp->OP_EXP.OPND1, id, newexp);
exp->OP_EXP.OPND2 = Replace (exp->OP_EXP.OPND2, id, newexp);
}
return exp;
}
if (exp->Kind == kOP1_EXP) {
# line 438 "AdaptF90.puma"
{
# line 439 "AdaptF90.puma"
exp->OP1_EXP.OPND = Replace (exp->OP1_EXP.OPND, id, newexp);
}
return exp;
}
if (exp->Kind == kCONST_EXP) {
# line 444 "AdaptF90.puma"
return exp;
}
# line 448 "AdaptF90.puma"
{
# line 449 "AdaptF90.puma"
printf ("Internal Error: Replace failed\n");
# line 450 "AdaptF90.puma"
FileUnparse (stdout, exp);
# line 451 "AdaptF90.puma"
kill_in_protocol ();
}
return exp;
}
static bool IsNewVectorLegal
# if defined __STDC__ | defined __cplusplus
(register tTree var, register int pos, register tTree slice)
# else
(var, pos, slice)
register tTree var;
register int pos;
register tTree slice;
# endif
{
# line 458 "AdaptF90.puma"
bool ok;
tTree save, dummy;
if (var == NoTree) return false;
if (slice == NoTree) return false;
# line 463 "AdaptF90.puma"
{
# line 464 "AdaptF90.puma"
if (! (TreeDistribution (var) == 1)) goto yyL1;
}
return true;
yyL1:;
if (var->Kind == kINDEXED_VAR) {
if (slice->Kind == kSLICE_EXP) {
# line 467 "AdaptF90.puma"
{
# line 469 "AdaptF90.puma"
SwitchIndex (var->INDEXED_VAR.IND_EXPS, pos, slice, &save);
ok = IsContiguousSection (var);
SwitchIndex (var->INDEXED_VAR.IND_EXPS, pos, save, &dummy);
return (ok);
}
return true;
}
}
# line 478 "AdaptF90.puma"
{
# line 479 "AdaptF90.puma"
printf ("Illegal call of IsNewVectorLegal\n");
# line 480 "AdaptF90.puma"
WriteTree (stdout, var);
# line 481 "AdaptF90.puma"
WriteTree (stdout, slice);
# line 482 "AdaptF90.puma"
FileUnparse (stdout, var);
# line 482 "AdaptF90.puma"
printf (" is the variable\n");
# line 483 "AdaptF90.puma"
FileUnparse (stdout, slice);
# line 483 "AdaptF90.puma"
printf (" is the slice\n");
# line 484 "AdaptF90.puma"
kill_in_protocol ();
}
return true;
}
static void SwitchIndex
# if defined __STDC__ | defined __cplusplus
(register tTree indexes, register int n, register tTree new, register tTree * old)
# else
(indexes, n, new, old)
register tTree indexes;
register int n;
register tTree new;
register tTree * old;
# endif
{
if (indexes == NoTree) return;
if (new == NoTree) return;
if (indexes->Kind == kBTE_LIST) {
{
tTree save;
if (equalint (n, 0)) {
# line 489 "AdaptF90.puma"
{
# line 491 "AdaptF90.puma"
# line 493 "AdaptF90.puma"
save = indexes->BTE_LIST.Elem;
indexes->BTE_LIST.Elem = new;
}
* old = save;
return;
}
}
# line 498 "AdaptF90.puma"
{
tTree yyV1;
{
# line 499 "AdaptF90.puma"
SwitchIndex (indexes->BTE_LIST.Next, n - 1, new, & yyV1);
}
* old = yyV1;
return;
}
}
if (indexes->Kind == kBTE_EMPTY) {
# line 502 "AdaptF90.puma"
{
# line 503 "AdaptF90.puma"
printf ("Illegal call of SwitchIndex in AdaptF90\n");
# line 504 "AdaptF90.puma"
kill_in_protocol ();
}
* old = NoTree;
return;
}
;
}
void BeginAdaptF90 ()
{
}
void CloseAdaptF90 ()
{
}