home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Professional
/
OS2PRO194.ISO
/
os2
/
prgramer
/
adaptor
/
src
/
adaptcm.c
next >
Wrap
Text File
|
1994-01-02
|
13KB
|
520 lines
# include "CM.h"
# include "yyACM.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 18 "AdaptCM.puma"
# include <stdio.h>
# include "Idents.h"
# include "StringMe.h"
# include "protocol.h"
# include "Types.h"
# include "Transfor.h" /* ExpToVarParam */
# include "Dalib.h" /* IsHost, MakeVarDecl... */
# include "Broadcas.h" /* MakeParamBroadcast */
# include "Local.h" /* MakeRangeStmt */
# include "Globals.h" /* GenGlobalSend, GenGlobalGet */
static FILE * yyf = stdout;
static void yyAbort
# ifdef __cplusplus
(char * yyFunction)
# else
(yyFunction) char * yyFunction;
# endif
{
(void) fprintf (stderr, "Error: module AdaptCM, routine %s failed\n", yyFunction);
exit (1);
}
bool IsCMIntrinsic ARGS((tTree t));
bool IsCMSubroutine ARGS((tIdent name));
tTree AdaptCMIntrinsic ARGS((tTree t));
static tTree GenRandom ARGS((tTree t));
static tTree GenRandom1 ARGS((tTree t, int dist));
static void MakeRandomProc ARGS((tTree t, tTree type));
static tTree GenRandomize ARGS((tTree t));
bool IsCMIntrinsic
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
if (t == NoTree) return false;
if (t->Kind == kPROC_OBJ) {
# line 39 "AdaptCM.puma"
{
# line 40 "AdaptCM.puma"
IsIntrFunc (t);
# line 41 "AdaptCM.puma"
if (! (IsCMSubroutine (t->PROC_OBJ.Ident))) goto yyL1;
}
return true;
yyL1:;
}
return false;
}
bool IsCMSubroutine
# if defined __STDC__ | defined __cplusplus
(register tIdent name)
# else
(name)
register tIdent name;
# endif
{
if (equaltIdent (name, MakeIdent ("CMF_RANDOM", 10))) {
# line 46 "AdaptCM.puma"
return true;
}
if (equaltIdent (name, MakeIdent ("CMF_RANDOMIZE", 13))) {
# line 47 "AdaptCM.puma"
return true;
}
if (equaltIdent (name, MakeIdent ("WALLTIME", 8))) {
# line 49 "AdaptCM.puma"
return true;
}
if (equaltIdent (name, MakeIdent ("CM_TIMER_CLEAR", 14))) {
# line 50 "AdaptCM.puma"
return true;
}
if (equaltIdent (name, MakeIdent ("CM_TIMER_START", 14))) {
# line 51 "AdaptCM.puma"
return true;
}
if (equaltIdent (name, MakeIdent ("CM_TIMER_STOP", 13))) {
# line 52 "AdaptCM.puma"
return true;
}
if (equaltIdent (name, MakeIdent ("CM_TIMER_PRINT", 14))) {
# line 53 "AdaptCM.puma"
return true;
}
if (equaltIdent (name, MakeIdent ("GLOBAL_GET", 10))) {
# line 54 "AdaptCM.puma"
return true;
}
if (equaltIdent (name, MakeIdent ("GLOBAL_SEND", 11))) {
# line 55 "AdaptCM.puma"
return true;
}
return false;
}
tTree AdaptCMIntrinsic
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
# line 60 "AdaptCM.puma"
tTree newacf;
char string [100];
if (t->Kind == kACF_BASIC) {
if (t->ACF_BASIC.BASIC_STMT->Kind == kCALL_STMT) {
if (Definitions_IsType (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Object, kObject)) {
# line 65 "AdaptCM.puma"
{
# line 67 "AdaptCM.puma"
stmt_protocol ("Transform Intrinscic Subroutine");
# line 68 "AdaptCM.puma"
if (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident == MakeIdent ("CMF_RANDOM",10) )
{
newacf = GenRandom (t);
}
else if (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident == MakeIdent ("CMF_RANDOMIZE",13) )
{
newacf = GenRandomize (t);
}
else if (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident == MakeIdent ("WALLTIME",8) )
{
t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident = MakeDalibId ("walltime");
newacf = t;
}
else if (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident == MakeIdent ("CM_TIMER_CLEAR",14) )
{
t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident = MakeDalibId ("clear_timer");
newacf = t;
}
else if (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident == MakeIdent ("CM_TIMER_STOP",13) )
{
t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident = MakeDalibId ("stop_timer");
newacf = t;
}
else if (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident == MakeIdent ("CM_TIMER_PRINT",14) )
{
t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident = MakeDalibId ("print_timer");
newacf = t;
}
else if (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident == MakeIdent ("CM_TIMER_START",14) )
{
t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident = MakeDalibId ("start_timer");
newacf = t;
}
else if (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident == MakeIdent ("GLOBAL_SEND",11) )
{
if (IsHost)
newacf = NoTree;
else
newacf = GenGlobalSend (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS);
}
else if (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident == MakeIdent ("GLOBAL_GET",10) )
{
if (IsHost)
newacf = NoTree;
else
newacf = GenGlobalGet (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS);
}
else
{ GetString (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID->PROC_OBJ.Ident, string);
printf ("Adaption of CM intrinsic %s failed\n", string);
exit (-1);
}
# line 121 "AdaptCM.puma"
tree_protocol ("New Call is \n", newacf);
}
return newacf;
}
}
if (t->ACF_BASIC.BASIC_STMT->Kind == kGLOBAL_STMT) {
# line 125 "AdaptCM.puma"
{
# line 126 "AdaptCM.puma"
stmt_protocol ("Transform Global Statement");
tree_protocol ("New Call is \n", newacf);
}
return newacf;
}
}
yyAbort ("AdaptCMIntrinsic");
}
static tTree GenRandom
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
if (t->Kind == kACF_BASIC) {
if (t->ACF_BASIC.BASIC_STMT->Kind == kCALL_STMT) {
if (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS->Kind == kBTP_LIST) {
if (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->Kind == kVAR_PARAM) {
# line 141 "AdaptCM.puma"
return GenRandom1 (t, TreeDistribution (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V));
}
}
}
}
yyAbort ("GenRandom");
}
static tTree GenRandom1
# if defined __STDC__ | defined __cplusplus
(register tTree t, register int dist)
# else
(t, dist)
register tTree t;
register int dist;
# endif
{
if (t->Kind == kACF_BASIC) {
if (t->ACF_BASIC.BASIC_STMT->Kind == kCALL_STMT) {
if (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS->Kind == kBTP_LIST) {
if (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->Kind == kVAR_PARAM) {
if (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V->Kind == kINDEXED_VAR) {
{
tTree stmt;
tTree new;
if (equalint (dist, 0)) {
# line 148 "AdaptCM.puma"
{
# line 152 "AdaptCM.puma"
# line 153 "AdaptCM.puma"
# line 155 "AdaptCM.puma"
new = MakeParamBroadcast (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem);
MakeRandomProc (t->ACF_BASIC.BASIC_STMT, TreeType (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V->INDEXED_VAR.IND_VAR));
stmt = DoSingleNode (t);
if (stmt != NoTree)
new = mACF_LIST (stmt, new);
}
{
return new;
}
}
}
if (equalint (dist, - 1)) {
# line 165 "AdaptCM.puma"
{
# line 169 "AdaptCM.puma"
if (! ((IsHost == true))) goto yyL2;
{
# line 170 "AdaptCM.puma"
MakeRandomProc (t->ACF_BASIC.BASIC_STMT, TreeType (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V->INDEXED_VAR.IND_VAR));
}
}
return t;
yyL2:;
}
if (equalint (dist, 1)) {
# line 178 "AdaptCM.puma"
{
# line 182 "AdaptCM.puma"
if (! ((IsHost == true))) goto yyL4;
}
return NoTree;
yyL4:;
}
{
tTree new;
if (equalint (dist, 1)) {
# line 186 "AdaptCM.puma"
{
# line 190 "AdaptCM.puma"
if (! ((TreeRank (LastIndex (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V->INDEXED_VAR.IND_EXPS)) == 0))) goto yyL5;
{
# line 192 "AdaptCM.puma"
# line 194 "AdaptCM.puma"
new = MaskNodeStmt (t, t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V);
MakeRandomProc (t->ACF_BASIC.BASIC_STMT, TreeType (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V->INDEXED_VAR.IND_VAR));
}
}
{
return new;
}
yyL5:;
}
}
{
tTree new;
if (equalint (dist, 1)) {
# line 201 "AdaptCM.puma"
{
# line 205 "AdaptCM.puma"
# line 207 "AdaptCM.puma"
new = MakeRangeStmt (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V->INDEXED_VAR.IND_VAR, LastIndex (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V->INDEXED_VAR.IND_EXPS));
MakeRandomProc (t->ACF_BASIC.BASIC_STMT, TreeType (t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V->INDEXED_VAR.IND_VAR));
if (new != NoTree)
new = mACF_LIST (new, mACF_LIST (t, NoTree));
else
new = t;
}
{
return new;
}
}
}
}
}
}
}
}
if (equalint (dist, - 1)) {
# line 174 "AdaptCM.puma"
return NoTree;
}
# line 217 "AdaptCM.puma"
{
# line 218 "AdaptCM.puma"
failure_protocol ("AdaptCM", "GenRandom1", t);
}
return NoTree;
}
static void MakeRandomProc
# if defined __STDC__ | defined __cplusplus
(register tTree t, register tTree type)
# else
(t, type)
register tTree t;
register tTree type;
# endif
{
# line 224 "AdaptCM.puma"
tTree size;
if (t == NoTree) return;
if (type == NoTree) return;
if (t->Kind == kCALL_STMT) {
if (t->CALL_STMT.CALL_PARAMS->Kind == kBTP_LIST) {
if (t->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->Kind == kVAR_PARAM) {
if (type->Kind == kINTEGER_TYPE) {
if (equalint (type->INTEGER_TYPE.size, 4)) {
# line 228 "AdaptCM.puma"
{
# line 230 "AdaptCM.puma"
t->CALL_STMT.CALL_ID = mPROC_OBJ (MakeDalibId ("get_int_randoms"));
size = ExpToVarParam (MakeElemsExp (t->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V));
t->CALL_STMT.CALL_PARAMS->BTP_LIST.Next = mBTP_LIST (size, t->CALL_STMT.CALL_PARAMS->BTP_LIST.Next);
t->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V = FirstArrayElement (t->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V);
}
return;
}
}
if (type->Kind == kREAL_TYPE) {
if (equalint (type->REAL_TYPE.size, 4)) {
# line 237 "AdaptCM.puma"
{
# line 239 "AdaptCM.puma"
t->CALL_STMT.CALL_ID = mPROC_OBJ (MakeDalibId ("get_real_randoms"));
size = ExpToVarParam (MakeElemsExp (t->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V));
t->CALL_STMT.CALL_PARAMS->BTP_LIST.Next = mBTP_LIST (size, t->CALL_STMT.CALL_PARAMS->BTP_LIST.Next);
t->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V = FirstArrayElement (t->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V);
}
return;
}
if (equalint (type->REAL_TYPE.size, 8)) {
# line 246 "AdaptCM.puma"
{
# line 248 "AdaptCM.puma"
t->CALL_STMT.CALL_ID = mPROC_OBJ (MakeDalibId ("get_double_randoms"));
size = ExpToVarParam (MakeElemsExp (t->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V));
t->CALL_STMT.CALL_PARAMS->BTP_LIST.Next = mBTP_LIST (size, t->CALL_STMT.CALL_PARAMS->BTP_LIST.Next);
t->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V = FirstArrayElement (t->CALL_STMT.CALL_PARAMS->BTP_LIST.Elem->VAR_PARAM.V);
}
return;
}
}
}
}
}
# line 255 "AdaptCM.puma"
{
# line 256 "AdaptCM.puma"
printf ("MakeRandomProc failed, illegal type");
# line 257 "AdaptCM.puma"
WriteTree (stdout, t);
# line 258 "AdaptCM.puma"
kill_in_protocol ();
}
return;
;
}
static tTree GenRandomize
# if defined __STDC__ | defined __cplusplus
(register tTree t)
# else
(t)
register tTree t;
# endif
{
# line 263 "AdaptCM.puma"
tTree new;
tIdent pname;
if (t->Kind == kACF_BASIC) {
if (t->ACF_BASIC.BASIC_STMT->Kind == kCALL_STMT) {
# line 268 "AdaptCM.puma"
{
# line 270 "AdaptCM.puma"
if (IsHost)
new = NoTree;
else
{ pname = MakeDalibId ("random_init");
t->ACF_BASIC.BASIC_STMT->CALL_STMT.CALL_ID = mPROC_OBJ (pname);
new = t;
}
}
return new;
}
}
yyAbort ("GenRandomize");
}
void BeginAdaptCM ()
{
}
void CloseAdaptCM ()
{
}