home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
adaptor.zip
/
adapt.zip
/
adaptor
/
src
/
dalib.c
< prev
next >
Wrap
Text File
|
1994-01-03
|
20KB
|
888 lines
# include "Dalib.h"
# include "yyDalib.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 67 "Dalib.puma"
# include <stdio.h>
# include "Idents.h"
# include "StringMe.h"
# include "Expressi.h" /* MakeSliceExp */
# include "Types.h" /* ArrayFormals */
# include "Transfor.h" /* ExpToVarParam */
static FILE * yyf = stdout;
static void yyAbort
# ifdef __cplusplus
(char * yyFunction)
# else
(yyFunction) char * yyFunction;
# endif
{
(void) fprintf (stderr, "Error: module Dalib, routine %s failed\n", yyFunction);
exit (1);
}
tIdent MakeDalibId ARGS((String name));
tIdent MakeDalibId1 ARGS((String name, int n));
tTree MakeVarDeclA ARGS((tIdent id, String n, tTree val));
tTree MakeUsedVarA ARGS((tIdent id, String n));
tTree MakeVarParamDeclA ARGS((tIdent id, String n));
tTree FirstArrayElement ARGS((tTree t));
tTree MakeSizeExp ARGS((tTree t));
tTree MakeElemsExp ARGS((tTree t));
static tTree MakeIndexSizeExp ARGS((tTree t));
tTree DoSingleNode ARGS((tTree stmt));
tTree MaskNodeStmt ARGS((tTree stmt, tTree var));
static tTree MakeMask ARGS((tTree var));
tTree DalibLastFormalParam ARGS((tTree t, tTree params));
tTree DalibLastActualParam ARGS((tTree t, tTree params));
tTree DalibTreeSizeParam ARGS((tTree t, tTree params));
tTree DalibRangeParams ARGS((tTree t, tTree params));
static tTree DalibRangeParamsFA ARGS((tTree formals, tTree actuals, tTree params));
static tTree DalibRangeParamsA ARGS((tTree actual, tTree params));
static tTree DalibRangeParamsF ARGS((tTree formal, tTree params));
tTree DalibFormalSize ARGS((tTree t, tTree params));
tTree DalibLocalSize ARGS((tTree t, tTree params));
static tTree DalibLocalSizeExp ARGS((tIdent name, tTree t, int dist));
tIdent MakeDalibId
# if defined __STDC__ | defined __cplusplus
(String name)
# else
(name)
String name;
# endif
{
# line 88 "Dalib.puma"
char s [100];
# line 92 "Dalib.puma"
{
# line 93 "Dalib.puma"
if (target_machine == SUPRENUM)
sprintf (s, "_dalib_%s", name);
else if (target_machine == RIOS_PVM)
sprintf (s, "dalib_%s_", name);
else
sprintf (s, "dalib_%s", name);
}
return MakeIdent (s, strlen (s));
}
tIdent MakeDalibId1
# if defined __STDC__ | defined __cplusplus
(String name, register int n)
# else
(name, n)
String name;
register int n;
# endif
{
# line 105 "Dalib.puma"
char s [100];
# line 109 "Dalib.puma"
{
# line 110 "Dalib.puma"
if (target_machine == SUPRENUM)
sprintf (s, "_dalib_%s%d", name, n);
else if (target_machine == RIOS_PVM)
sprintf (s, "dalib_%s%d_", name, n);
else
sprintf (s, "dalib_%s%d", name, n);
}
return MakeIdent (s, strlen (s));
}
tTree MakeVarDeclA
# if defined __STDC__ | defined __cplusplus
(register tIdent id, String n, register tTree val)
# else
(id, n, val)
register tIdent id;
String n;
register tTree val;
# endif
{
# line 130 "Dalib.puma"
char hstring[250];
tIdent hid;
# line 135 "Dalib.puma"
{
# line 136 "Dalib.puma"
GetString (id, hstring);
strcat (hstring, n);
hid = MakeIdent (hstring, strlen (hstring));
}
return (mVAR_DECL (hid, 0, val));
}
tTree MakeUsedVarA
# if defined __STDC__ | defined __cplusplus
(register tIdent id, String n)
# else
(id, n)
register tIdent id;
String n;
# endif
{
# line 153 "Dalib.puma"
char hstring[250];
tIdent hid;
# line 158 "Dalib.puma"
{
# line 159 "Dalib.puma"
GetString (id, hstring);
strcat (hstring, n);
hid = MakeIdent (hstring, strlen (hstring));
}
return (mUSED_VAR (mVAR_OBJ (0, hid)));
}
tTree MakeVarParamDeclA
# if defined __STDC__ | defined __cplusplus
(register tIdent id, String n)
# else
(id, n)
register tIdent id;
String n;
# endif
{
# line 176 "Dalib.puma"
char hstring[250];
tIdent hid;
# line 181 "Dalib.puma"
{
# line 182 "Dalib.puma"
GetString (id, hstring);
strcat (hstring, n);
hid = MakeIdent (hstring, strlen (hstring));
}
return (mVAR_PARAM_DECL (hid, 0, mDUMMY_TYPE ()));
}
tTree FirstArrayElement
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
if (t->Kind == kUSED_VAR) {
# line 199 "Dalib.puma"
return t;
}
if (t->Kind == kINDEXED_VAR) {
# line 203 "Dalib.puma"
return mINDEXED_VAR (t->INDEXED_VAR.IND_VAR, FirstArrayElement (t->INDEXED_VAR.IND_EXPS));
}
if (t->Kind == kBTE_LIST) {
if (t->BTE_LIST.Elem->Kind == kSLICE_EXP) {
# line 207 "Dalib.puma"
return mBTE_LIST (t->BTE_LIST.Elem->SLICE_EXP.START, FirstArrayElement (t->BTE_LIST.Next));
}
# line 211 "Dalib.puma"
return mBTE_LIST (t->BTE_LIST.Elem, FirstArrayElement (t->BTE_LIST.Next));
}
if (t->Kind == kBTE_EMPTY) {
# line 215 "Dalib.puma"
return t;
}
# line 219 "Dalib.puma"
{
# line 220 "Dalib.puma"
printf ("Illegal Call of FirstArrayElement\n");
# line 221 "Dalib.puma"
FileUnparse (stdout, t);
# line 222 "Dalib.puma"
WriteTree (stdout, t);
# line 223 "Dalib.puma"
kill_in_protocol ();
}
return NoTree;
}
tTree MakeSizeExp
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
# line 243 "Dalib.puma"
tTree size_exp, index_exp;
if (t->Kind == kUSED_VAR) {
# line 247 "Dalib.puma"
return MakeConstant (TreeSize (t));
}
if (t->Kind == kINDEXED_VAR) {
if (t->INDEXED_VAR.IND_VAR->Kind == kUSED_VAR) {
# line 251 "Dalib.puma"
{
# line 252 "Dalib.puma"
size_exp = MakeConstant (TreeSize (t));
index_exp = MakeIndexSizeExp (t->INDEXED_VAR.IND_EXPS);
if (index_exp != NoTree)
size_exp = mOP_EXP (mOP_TIMES (), index_exp, size_exp);
}
return size_exp;
}
}
# line 260 "Dalib.puma"
{
# line 261 "Dalib.puma"
failure_protocol ("Dalib", "MakeSizeExp", t);
}
return NoTree;
}
tTree MakeElemsExp
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
# line 267 "Dalib.puma"
tTree index_exp;
if (t->Kind == kUSED_VAR) {
# line 271 "Dalib.puma"
return MakeConstant (1);
}
if (t->Kind == kINDEXED_VAR) {
if (t->INDEXED_VAR.IND_VAR->Kind == kUSED_VAR) {
# line 275 "Dalib.puma"
{
# line 276 "Dalib.puma"
index_exp = MakeIndexSizeExp (t->INDEXED_VAR.IND_EXPS);
if (index_exp == NoTree)
index_exp = MakeConstant(1);
}
return index_exp;
}
}
# line 283 "Dalib.puma"
{
# line 284 "Dalib.puma"
failure_protocol ("Dalib", "MakeElemsExp", t);
}
return NoTree;
}
static tTree MakeIndexSizeExp
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
# line 290 "Dalib.puma"
tTree size_exp, index_exp;
if (t->Kind == kBTE_LIST) {
if (t->BTE_LIST.Elem->Kind == kSLICE_EXP) {
# line 294 "Dalib.puma"
{
# line 298 "Dalib.puma"
index_exp = MakeIndexSizeExp (t->BTE_LIST.Next);
size_exp = MakeSliceExp (t->BTE_LIST.Elem->SLICE_EXP.START, t->BTE_LIST.Elem->SLICE_EXP.STOP);
if (index_exp != NoTree)
size_exp = mOP_EXP (mOP_TIMES (), index_exp, size_exp);
}
return size_exp;
}
# line 306 "Dalib.puma"
return MakeIndexSizeExp (t->BTE_LIST.Next);
}
if (t->Kind == kBTE_EMPTY) {
# line 310 "Dalib.puma"
return NoTree;
}
# line 314 "Dalib.puma"
{
# line 315 "Dalib.puma"
failure_protocol ("Dalib", "MakeIndexSizeExp", t);
}
return NoTree;
}
tTree DoSingleNode
# if defined __STDC__ | defined __cplusplus
(register tTree stmt)
# else
(stmt)
register tTree stmt;
# endif
{
# line 333 "Dalib.puma"
{
# line 334 "Dalib.puma"
if (! (target_model == UNI_PROC)) goto yyL1;
}
return stmt;
yyL1:;
# line 338 "Dalib.puma"
{
# line 339 "Dalib.puma"
if (! (target_model == HOST_NODE)) goto yyL2;
{
# line 340 "Dalib.puma"
if (! ((IsHost != 0))) goto yyL2;
}
}
return stmt;
yyL2:;
# line 344 "Dalib.puma"
{
# line 345 "Dalib.puma"
if (! (target_model == HOST_NODE)) goto yyL3;
{
# line 346 "Dalib.puma"
if (! ((IsHost == 0))) goto yyL3;
}
}
return NoTree;
yyL3:;
# line 350 "Dalib.puma"
{
tTree ht;
{
# line 352 "Dalib.puma"
# line 353 "Dalib.puma"
ht = mPROC_OBJ (MakeDalibId ("pid"));
ht = mFUNC_CALL_EXP (ht, mBTP_EMPTY());
ht = mOP_EXP (mOP_EQ(), ht, mCONST_EXP (mINT_CONSTANT (1)));
ht = mACF_IF (ht, mACF_LIST (stmt, mACF_EMPTY()), mACF_EMPTY());
}
{
return ht;
}
}
}
tTree MaskNodeStmt
# if defined __STDC__ | defined __cplusplus
(register tTree stmt, register tTree var)
# else
(stmt, var)
register tTree stmt;
register tTree var;
# endif
{
if (var->Kind == kINDEXED_VAR) {
# line 374 "Dalib.puma"
{
# line 375 "Dalib.puma"
if (! ((TreeDistribution (var->INDEXED_VAR.IND_VAR) != 1))) goto yyL1;
{
# line 376 "Dalib.puma"
printf ("MaskNodeStmt, var is not distributed");
# line 377 "Dalib.puma"
WriteTree (stdout, var);
# line 378 "Dalib.puma"
kill_in_protocol ();
}
}
return NoTree;
yyL1:;
# line 382 "Dalib.puma"
{
# line 383 "Dalib.puma"
if (! ((TreeRank (LastIndex (var->INDEXED_VAR.IND_EXPS)) != 0))) goto yyL2;
{
# line 384 "Dalib.puma"
printf ("MaskNodeStmt, var not for single node");
# line 385 "Dalib.puma"
WriteTree (stdout, var);
# line 386 "Dalib.puma"
kill_in_protocol ();
}
}
return NoTree;
yyL2:;
# line 390 "Dalib.puma"
return mACF_IF (MakeMask (var), mACF_LIST (stmt, mACF_EMPTY ()), mACF_EMPTY ());
}
# line 395 "Dalib.puma"
{
# line 396 "Dalib.puma"
printf ("MaskNodeStmt failed");
# line 397 "Dalib.puma"
WriteTree (stdout, var);
# line 398 "Dalib.puma"
kill_in_protocol ();
}
return NoTree;
}
static tTree MakeMask
# if defined __STDC__ | defined __cplusplus
(register tTree var)
# else
(var)
register tTree var;
# endif
{
if (var->Kind == kINDEXED_VAR) {
if (var->INDEXED_VAR.IND_VAR->Kind == kUSED_VAR) {
# line 410 "Dalib.puma"
{
tTree func;
tTree params;
{
# line 412 "Dalib.puma"
# line 413 "Dalib.puma"
# line 415 "Dalib.puma"
params = DalibLastActualParam (var, mBTP_EMPTY());
params = DalibLastFormalParam (var, params);
func = mPROC_OBJ (MakeDalibId ("have_i"));
func = mFUNC_CALL_EXP (func, params);
}
{
return func;
}
}
}
}
# line 424 "Dalib.puma"
{
# line 425 "Dalib.puma"
failure_protocol ("Dalib", "MakeMask", var);
}
return NoTree;
}
tTree DalibLastFormalParam
# if defined __STDC__ | defined __cplusplus
(register tTree t, register tTree params)
# else
(t, params)
register tTree t;
register tTree params;
# endif
{
if (t->Kind == kINDEXED_VAR) {
# line 441 "Dalib.puma"
return DalibLastFormalParam (t->INDEXED_VAR.IND_VAR, params);
}
if (t->Kind == kUSED_VAR) {
# line 445 "Dalib.puma"
return DalibLastFormalParam (ArrayFormals (t->USED_VAR.VARNAME->VAR_OBJ.Object), params);
}
if (t->Kind == kTYPE_LIST) {
# line 449 "Dalib.puma"
return DalibLastFormalParam (LastIndex (t), params);
}
if (t->Kind == kINDEX_TYPE) {
# line 453 "Dalib.puma"
return mBTP_LIST (ExpToVarParam (MakeSliceExp (t->INDEX_TYPE.LOWER, t->INDEX_TYPE.UPPER)), params);
}
if (t->Kind == kDYNAMIC) {
if (t->DYNAMIC.Shape->Kind == kSLICE_EXP) {
# line 457 "Dalib.puma"
return mBTP_LIST (ExpToVarParam (MakeSliceExp (t->DYNAMIC.Shape->SLICE_EXP.START, t->DYNAMIC.Shape->SLICE_EXP.STOP)), params);
}
}
# line 461 "Dalib.puma"
{
# line 462 "Dalib.puma"
failure_protocol ("Dalib", "DalibLastFormalParam", t);
}
return NoTree;
}
tTree DalibLastActualParam
# if defined __STDC__ | defined __cplusplus
(register tTree t, register tTree params)
# else
(t, params)
register tTree t;
register tTree params;
# endif
{
if (t->Kind == kINDEXED_VAR) {
# line 478 "Dalib.puma"
return mBTP_LIST (ExpToVarParam (LastIndex (t->INDEXED_VAR.IND_EXPS)), params);
}
# line 482 "Dalib.puma"
{
# line 483 "Dalib.puma"
failure_protocol ("Dalib", "DalibLastActualParam", t);
}
return NoTree;
}
tTree DalibTreeSizeParam
# if defined __STDC__ | defined __cplusplus
(register tTree t, register tTree params)
# else
(t, params)
register tTree t;
register tTree params;
# endif
{
if (t->Kind == kINDEXED_VAR) {
# line 495 "Dalib.puma"
return DalibTreeSizeParam (t->INDEXED_VAR.IND_VAR, params);
}
if (t->Kind == kUSED_VAR) {
# line 499 "Dalib.puma"
return mBTP_LIST (ExpToVarParam (MakeConstant (TreeSize (t))), params);
}
# line 503 "Dalib.puma"
{
# line 504 "Dalib.puma"
failure_protocol ("Dalib", "DalibTreeSizeParam", t);
}
return NoTree;
}
tTree DalibRangeParams
# if defined __STDC__ | defined __cplusplus
(register tTree t, register tTree params)
# else
(t, params)
register tTree t;
register tTree params;
# endif
{
if (t->Kind == kINDEXED_VAR) {
if (t->INDEXED_VAR.IND_VAR->Kind == kUSED_VAR) {
# line 520 "Dalib.puma"
{
tTree new;
{
# line 522 "Dalib.puma"
# line 524 "Dalib.puma"
new = DalibRangeParamsFA (ArrayFormals (t->INDEXED_VAR.IND_VAR->USED_VAR.VARNAME->VAR_OBJ.Object), t->INDEXED_VAR.IND_EXPS, params);
new = DalibTreeSizeParam (t, new);
}
{
return new;
}
}
}
}
# line 530 "Dalib.puma"
{
# line 531 "Dalib.puma"
failure_protocol ("Dalib", "DalibRangeParams", t);
}
return NoTree;
}
static tTree DalibRangeParamsFA
# if defined __STDC__ | defined __cplusplus
(register tTree formals, register tTree actuals, register tTree params)
# else
(formals, actuals, params)
register tTree formals;
register tTree actuals;
register tTree params;
# endif
{
if (formals->Kind == kTYPE_EMPTY) {
if (actuals->Kind == kBTE_EMPTY) {
# line 537 "Dalib.puma"
return params;
}
}
if (formals->Kind == kTYPE_LIST) {
if (actuals->Kind == kBTE_LIST) {
# line 541 "Dalib.puma"
{
tTree new;
{
# line 543 "Dalib.puma"
# line 545 "Dalib.puma"
new = DalibRangeParamsFA (formals->TYPE_LIST.Next, actuals->BTE_LIST.Next, params);
new = DalibRangeParamsA (actuals->BTE_LIST.Elem, new);
new = DalibRangeParamsF (formals->TYPE_LIST.Elem, new);
}
{
return new;
}
}
}
}
yyAbort ("DalibRangeParamsFA");
}
static tTree DalibRangeParamsA
# if defined __STDC__ | defined __cplusplus
(register tTree actual, register tTree params)
# else
(actual, params)
register tTree actual;
register tTree params;
# endif
{
if (actual->Kind == kSLICE_EXP) {
# line 554 "Dalib.puma"
return mBTP_LIST (ExpToVarParam (actual->SLICE_EXP.START), mBTP_LIST (ExpToVarParam (actual->SLICE_EXP.STOP), params));
}
# line 559 "Dalib.puma"
return mBTP_LIST (ExpToVarParam (actual), mBTP_LIST (ExpToVarParam (actual), params));
}
static tTree DalibRangeParamsF
# if defined __STDC__ | defined __cplusplus
(register tTree formal, register tTree params)
# else
(formal, params)
register tTree formal;
register tTree params;
# endif
{
if (formal->Kind == kINDEX_TYPE) {
# line 566 "Dalib.puma"
return mBTP_LIST (ExpToVarParam (MakeSliceExp (formal->INDEX_TYPE.LOWER, formal->INDEX_TYPE.UPPER)), params);
}
if (formal->Kind == kDYNAMIC) {
if (formal->DYNAMIC.Shape->Kind == kSLICE_EXP) {
# line 570 "Dalib.puma"
return mBTP_LIST (ExpToVarParam (MakeSliceExp (formal->DYNAMIC.Shape->SLICE_EXP.START, formal->DYNAMIC.Shape->SLICE_EXP.STOP)), params);
}
}
yyAbort ("DalibRangeParamsF");
}
tTree DalibFormalSize
# if defined __STDC__ | defined __cplusplus
(register tTree t, register tTree params)
# else
(t, params)
register tTree t;
register tTree params;
# endif
{
if (t->Kind == kUSED_VAR) {
# line 586 "Dalib.puma"
return DalibFormalSize (ArrayFormals (t->USED_VAR.VARNAME->VAR_OBJ.Object), params);
}
if (t->Kind == kTYPE_EMPTY) {
# line 590 "Dalib.puma"
return params;
}
if (t->Kind == kTYPE_LIST) {
if (t->TYPE_LIST.Elem->Kind == kINDEX_TYPE) {
# line 594 "Dalib.puma"
return mBTP_LIST (ExpToVarParam (MakeSliceExp (t->TYPE_LIST.Elem->INDEX_TYPE.LOWER, t->TYPE_LIST.Elem->INDEX_TYPE.UPPER)), DalibFormalSize (t->TYPE_LIST.Next, params));
}
if (t->TYPE_LIST.Elem->Kind == kDYNAMIC) {
if (t->TYPE_LIST.Elem->DYNAMIC.Shape->Kind == kSLICE_EXP) {
# line 599 "Dalib.puma"
return mBTP_LIST (ExpToVarParam (MakeSliceExp (t->TYPE_LIST.Elem->DYNAMIC.Shape->SLICE_EXP.START, t->TYPE_LIST.Elem->DYNAMIC.Shape->SLICE_EXP.STOP)), DalibFormalSize (t->TYPE_LIST.Next, params));
}
}
}
# line 604 "Dalib.puma"
{
# line 605 "Dalib.puma"
failure_protocol ("Dalib", "DalibFormalSize", t);
}
return NoTree;
}
tTree DalibLocalSize
# if defined __STDC__ | defined __cplusplus
(register tTree t, register tTree params)
# else
(t, params)
register tTree t;
register tTree params;
# endif
{
if (t->Kind == kUSED_VAR) {
# line 622 "Dalib.puma"
return mBTP_LIST (ExpToVarParam (DalibLocalSizeExp (t->USED_VAR.VARNAME->VAR_OBJ.Ident, ArrayFormals (t->USED_VAR.VARNAME->VAR_OBJ.Object), VarDistribution (t->USED_VAR.VARNAME->VAR_OBJ.Object))), params);
}
# line 629 "Dalib.puma"
{
# line 630 "Dalib.puma"
failure_protocol ("Dalib", "DalibLocalSize", t);
}
return NoTree;
}
static tTree DalibLocalSizeExp
# if defined __STDC__ | defined __cplusplus
(register tIdent name, register tTree t, register int dist)
# else
(name, t, dist)
register tIdent name;
register tTree t;
register int dist;
# endif
{
if (t->Kind == kTYPE_LIST) {
if (t->TYPE_LIST.Next->Kind == kTYPE_EMPTY) {
if (equalint (dist, 1)) {
# line 636 "Dalib.puma"
return MakeSliceExp (mVAR_EXP (MakeUsedVarA (name, "_LOW")), mVAR_EXP (MakeUsedVarA (name, "_HIGH")));
}
# line 641 "Dalib.puma"
return DalibLocalSizeExp (name, t->TYPE_LIST.Elem, dist);
}
# line 645 "Dalib.puma"
return mOP_EXP (mOP_TIMES (), DalibLocalSizeExp (name, t->TYPE_LIST.Elem, dist), DalibLocalSizeExp (name, t->TYPE_LIST.Next, dist));
}
if (t->Kind == kINDEX_TYPE) {
# line 651 "Dalib.puma"
return MakeSliceExp (t->INDEX_TYPE.LOWER, t->INDEX_TYPE.UPPER);
}
if (t->Kind == kDYNAMIC) {
if (t->DYNAMIC.Shape->Kind == kSLICE_EXP) {
# line 655 "Dalib.puma"
return MakeSliceExp (t->DYNAMIC.Shape->SLICE_EXP.START, t->DYNAMIC.Shape->SLICE_EXP.STOP);
}
}
# line 659 "Dalib.puma"
{
# line 660 "Dalib.puma"
failure_protocol ("Dalib", "DalibLocalSizeExp", t);
}
return NoTree;
}
void BeginDalib ()
{
}
void CloseDalib ()
{
}