home *** CD-ROM | disk | FTP | other *** search
- # include "Calling.h"
- # include "yyCallin.w"
- # include <stdio.h>
- # if defined __STDC__ | defined __cplusplus
- # include <stdlib.h>
- # else
- extern void exit ();
- # endif
- # include "Tree.h"
- # include "Definiti.h"
- # include "CallGrap.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 16 "Calling.puma"
-
- #include "Tree.h"
- #include "Definiti.h"
- #include "CallGraf.h"
-
- static tCallGraph CurrentUnit; /* globally used for a unit */
-
- FILE *CGFile;
-
-
- static FILE * yyf = stdout;
-
- static void yyAbort
- # ifdef __cplusplus
- (char * yyFunction)
- # else
- (yyFunction) char * yyFunction;
- # endif
- {
- (void) fprintf (stderr, "Error: module Calling, routine %s failed\n", yyFunction);
- exit (1);
- }
-
- void Calling ARGS((tTree t));
- void OutCallGraph ARGS((tCallGraph c));
- static void OutCallEdges ARGS((tCallGraph c));
- static int UnitKind ARGS((tDefinitions o));
-
- void Calling
- # if defined __STDC__ | defined __cplusplus
- (register tTree t)
- # else
- (t)
- register tTree t;
- # endif
- {
- # line 59 "Calling.puma"
-
- unsigned char string[256];
- tCallGraph CN;
- int kind;
- tObject Obj;
-
- if (t == NoTree) return;
-
- switch (t->Kind) {
- case kCOMP_UNIT:
- # line 72 "Calling.puma"
- {
- # line 73 "Calling.puma"
- Calling (t->COMP_UNIT.COMP_ELEMENTS);
- }
- return;
-
- case kDECL_LIST:
- # line 76 "Calling.puma"
- {
- # line 77 "Calling.puma"
- Calling (t->DECL_LIST.Elem);
- # line 78 "Calling.puma"
- Calling (t->DECL_LIST.Next);
- }
- return;
-
- case kPROGRAM_DECL:
- # line 81 "Calling.puma"
- {
- # line 82 "Calling.puma"
- GetString (t->PROGRAM_DECL.Name, string);
- # line 83 "Calling.puma"
- Obj = GetDeclEntry (t->PROGRAM_DECL.Name, GetUnitEntries ());
- # line 84 "Calling.puma"
- if (Obj == NoObject)
- printf ("Unit %s no found in UnitEntries-Table\n", string);
- # line 86 "Calling.puma"
- CurrentUnit = CallGraphSearchNode (Obj, 0);
- # line 87 "Calling.puma"
- Calling (t->PROGRAM_DECL.PROGRAM_BODY);
- }
- return;
-
- case kPROC_DECL:
- # line 90 "Calling.puma"
- {
- # line 91 "Calling.puma"
- GetString (t->PROC_DECL.Name, string);
- # line 92 "Calling.puma"
- Obj = GetDeclEntry (t->PROC_DECL.Name, GetUnitEntries ());
- # line 93 "Calling.puma"
- if (Obj == NoObject)
- printf ("Unit %s no found in UnitEntries-Table\n", string);
- # line 95 "Calling.puma"
- CurrentUnit = CallGraphSearchNode (Obj, 0);
- # line 96 "Calling.puma"
- Calling (t->PROC_DECL.PROC_BODY);
- }
- return;
-
- case kFUNC_DECL:
- # line 99 "Calling.puma"
- {
- # line 100 "Calling.puma"
- GetString (t->FUNC_DECL.Name, string);
- # line 101 "Calling.puma"
- Obj = GetDeclEntry (t->FUNC_DECL.Name, GetUnitEntries ());
- # line 102 "Calling.puma"
- CurrentUnit = CallGraphSearchNode (Obj, 0);
- # line 103 "Calling.puma"
- if (Obj == NoObject)
- printf ("Unit %s no found in UnitEntries-Table\n", string);
- # line 105 "Calling.puma"
- Calling (t->FUNC_DECL.FUNC_BODY);
- }
- return;
-
- case kBODY_NODE:
- # line 108 "Calling.puma"
- {
- # line 109 "Calling.puma"
- Calling (t->BODY_NODE.STATS);
- }
- return;
-
- case kVAR_DECL:
- # line 118 "Calling.puma"
- return;
-
- case kPARAMETER_DECL:
- # line 121 "Calling.puma"
- return;
-
- case kCOMMON_DECL:
- # line 124 "Calling.puma"
- {
- # line 126 "Calling.puma"
- Calling (t->COMMON_DECL.IDS);
- }
- return;
-
- case kEQV_DECL:
- # line 129 "Calling.puma"
- {
- # line 131 "Calling.puma"
- Calling (t->EQV_DECL.VARS);
- }
- return;
-
- case kDATA_DECL:
- # line 134 "Calling.puma"
- {
- # line 135 "Calling.puma"
- Calling (t->DATA_DECL.VARS);
- # line 136 "Calling.puma"
- Calling (t->DATA_DECL.VALS);
- }
- return;
-
- case kTYPE_LIST:
- # line 154 "Calling.puma"
- {
- # line 155 "Calling.puma"
- Calling (t->TYPE_LIST.Elem);
- # line 156 "Calling.puma"
- Calling (t->TYPE_LIST.Next);
- }
- return;
-
- case kINDEX_TYPE:
- # line 159 "Calling.puma"
- {
- # line 160 "Calling.puma"
- Calling (t->INDEX_TYPE.LOWER);
- # line 161 "Calling.puma"
- Calling (t->INDEX_TYPE.UPPER);
- }
- return;
-
- case kACF_LIST:
- # line 170 "Calling.puma"
- {
- # line 171 "Calling.puma"
- Calling (t->ACF_LIST.Elem);
- # line 172 "Calling.puma"
- Calling (t->ACF_LIST.Next);
- }
- return;
-
- case kACF_BASIC:
- # line 175 "Calling.puma"
- {
- # line 176 "Calling.puma"
- Calling (t->ACF_BASIC.BASIC_STMT);
- }
- return;
-
- case kACF_IF:
- # line 179 "Calling.puma"
- {
- # line 180 "Calling.puma"
- Calling (t->ACF_IF.IF_EXP);
- # line 181 "Calling.puma"
- Calling (t->ACF_IF.THEN_PART);
- # line 182 "Calling.puma"
- Calling (t->ACF_IF.ELSE_PART);
- }
- return;
-
- case kACF_WHERE:
- # line 185 "Calling.puma"
- {
- # line 186 "Calling.puma"
- Calling (t->ACF_WHERE.WHERE_EXP);
- # line 187 "Calling.puma"
- Calling (t->ACF_WHERE.TRUE_PART);
- # line 188 "Calling.puma"
- Calling (t->ACF_WHERE.FALSE_PART);
- }
- return;
-
- case kACF_CASE:
- # line 191 "Calling.puma"
- {
- # line 192 "Calling.puma"
- Calling (t->ACF_CASE.CASE_EXP);
- # line 193 "Calling.puma"
- Calling (t->ACF_CASE.CASE_ALTS);
- # line 194 "Calling.puma"
- Calling (t->ACF_CASE.CASE_OTHERWISE);
- }
- return;
-
- case kACF_WHILE:
- # line 197 "Calling.puma"
- {
- # line 198 "Calling.puma"
- Calling (t->ACF_WHILE.WHILE_EXP);
- # line 199 "Calling.puma"
- Calling (t->ACF_WHILE.WHILE_BODY);
- }
- return;
-
- case kACF_DO:
- # line 202 "Calling.puma"
- {
- # line 203 "Calling.puma"
- Calling (t->ACF_DO.DO_RANGE);
- # line 204 "Calling.puma"
- Calling (t->ACF_DO.DO_BODY);
- }
- return;
-
- case kASSIGN_STMT:
- # line 207 "Calling.puma"
- {
- # line 208 "Calling.puma"
- Calling (t->ASSIGN_STMT.ASSIGN_VAR);
- # line 209 "Calling.puma"
- Calling (t->ASSIGN_STMT.ASSIGN_EXP);
- }
- return;
-
- case kCALL_STMT:
- # line 212 "Calling.puma"
- {
- # line 213 "Calling.puma"
- GetString (t->CALL_STMT.CALL_ID->PROC_OBJ.Ident, string);
- # line 214 "Calling.puma"
- Calling (t->CALL_STMT.CALL_PARAMS);
- # line 215 "Calling.puma"
- kind = UnitKind (t->CALL_STMT.CALL_ID->PROC_OBJ.Object);
- # line 216 "Calling.puma"
- if (kind != 3)
- { CN = CallGraphSearchNode (t->CALL_STMT.CALL_ID->PROC_OBJ.Object, kind);
- CallGraphInsertEdge (CurrentUnit, CN);
- }
-
-
- }
- return;
-
- case kBTP_LIST:
- # line 230 "Calling.puma"
- {
- # line 231 "Calling.puma"
- Calling (t->BTP_LIST.Elem);
- # line 232 "Calling.puma"
- Calling (t->BTP_LIST.Next);
- }
- return;
-
- case kVAR_PARAM:
- # line 235 "Calling.puma"
- {
- # line 236 "Calling.puma"
- Calling (t->VAR_PARAM.V);
- }
- return;
-
- case kVALUE_PARAM:
- # line 239 "Calling.puma"
- {
- # line 240 "Calling.puma"
- printf ("There shouldn't be any value params in FORTRAN\n");
- }
- return;
-
- case kBTE_LIST:
- # line 243 "Calling.puma"
- {
- # line 244 "Calling.puma"
- Calling (t->BTE_LIST.Elem);
- # line 245 "Calling.puma"
- Calling (t->BTE_LIST.Next);
- }
- return;
-
- case kVAR_EXP:
- # line 254 "Calling.puma"
- {
- # line 255 "Calling.puma"
- Calling (t->VAR_EXP.V);
- }
- return;
-
- case kUSED_VAR:
- # line 258 "Calling.puma"
- return;
-
- case kLOOP_VAR:
- # line 261 "Calling.puma"
- return;
-
- case kINDEXED_VAR:
- # line 264 "Calling.puma"
- {
- # line 265 "Calling.puma"
- Calling (t->INDEXED_VAR.IND_EXPS);
- # line 266 "Calling.puma"
- Calling (t->INDEXED_VAR.IND_VAR);
- }
- return;
-
- case kDUMMY_EXP:
- # line 275 "Calling.puma"
- return;
-
- case kCONST_EXP:
- # line 278 "Calling.puma"
- return;
-
- case kARRAY_EXP:
- # line 281 "Calling.puma"
- {
- # line 282 "Calling.puma"
- Calling (t->ARRAY_EXP.ELEMENTS);
- }
- return;
-
- case kSLICE_EXP:
- # line 285 "Calling.puma"
- {
- # line 286 "Calling.puma"
- Calling (t->SLICE_EXP.START);
- # line 287 "Calling.puma"
- Calling (t->SLICE_EXP.STOP);
- # line 288 "Calling.puma"
- Calling (t->SLICE_EXP.INC);
- }
- return;
-
- case kOP_EXP:
- # line 291 "Calling.puma"
- {
- # line 292 "Calling.puma"
- Calling (t->OP_EXP.OPND1);
- # line 293 "Calling.puma"
- Calling (t->OP_EXP.OPND2);
- }
- return;
-
- case kOP1_EXP:
- # line 296 "Calling.puma"
- {
- # line 297 "Calling.puma"
- Calling (t->OP1_EXP.OPND);
- }
- return;
-
- case kFUNC_CALL_EXP:
- # line 300 "Calling.puma"
- {
- # line 301 "Calling.puma"
- GetString (t->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Ident, string);
- # line 302 "Calling.puma"
- Calling (t->FUNC_CALL_EXP.FUNC_PARAMS);
- # line 303 "Calling.puma"
- kind = UnitKind (t->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Object);
- # line 304 "Calling.puma"
- if (kind != 3)
- { CN = CallGraphSearchNode (t->FUNC_CALL_EXP.FUNC_ID->PROC_OBJ.Object, kind);
- CallGraphInsertEdge (CurrentUnit, CN);
- }
-
-
- }
- return;
-
- }
-
- ;
- }
-
- void OutCallGraph
- # if defined __STDC__ | defined __cplusplus
- (register tCallGraph c)
- # else
- (c)
- register tCallGraph c;
- # endif
- {
- # line 320 "Calling.puma"
-
- unsigned char string[256];
-
- if (c == NoCallGraph) return;
- if (c->Kind == kCallGraph) {
- # line 324 "Calling.puma"
- {
- # line 325 "Calling.puma"
- fprintf (CGFile, "UserNodes : \n");
- # line 326 "Calling.puma"
- fprintf (CGFile, "=========== \n\n");
- # line 327 "Calling.puma"
- if (c->CallGraph.UserNodes != NoCallGraph) OutCallGraph (c->CallGraph.UserNodes);
- # line 328 "Calling.puma"
- fprintf (CGFile, "\n");
- # line 329 "Calling.puma"
- fprintf (CGFile, "Called Intrinsics : \n");
- # line 330 "Calling.puma"
- fprintf (CGFile, "=================== \n\n");
- # line 331 "Calling.puma"
- if (c->CallGraph.IntrinsicNodes != NoCallGraph)
- OutCallGraph (c->CallGraph.IntrinsicNodes);
- # line 333 "Calling.puma"
- fprintf (CGFile, "\n");
- # line 334 "Calling.puma"
- fprintf (CGFile, "Called Externals : \n");
- # line 335 "Calling.puma"
- fprintf (CGFile, "================== \n\n");
- # line 336 "Calling.puma"
- if (c->CallGraph.ExternalNodes != NoCallGraph)
- OutCallGraph (c->CallGraph.ExternalNodes);
- # line 338 "Calling.puma"
- fprintf (CGFile, "\n");
- }
- return;
-
- }
- if (c->Kind == kCallNodeList) {
- # line 341 "Calling.puma"
- {
- # line 342 "Calling.puma"
- OutCallGraph (c->CallNodeList.Elem);
- # line 343 "Calling.puma"
- if (c->CallNodeList.Next != NoCallGraph)
- OutCallGraph (c->CallNodeList.Next);
- }
- return;
-
- }
- if (c->Kind == kCallNode) {
- if (c->CallNode.val->Kind == kProcObject) {
- if (c->CallNode.val->ProcObject.decl->Kind == kPROGRAM_DECL) {
- # line 347 "Calling.puma"
- {
- # line 349 "Calling.puma"
- GetString (c->CallNode.val->ProcObject.ident, string);
- # line 350 "Calling.puma"
- fprintf (CGFile, "PROGRAM %s -- \n", string);
- # line 351 "Calling.puma"
- if (c->CallNode.calling != NoCallGraph)
- { fprintf (CGFile, " %s : calls ", string);
- OutCallEdges (c->CallNode.calling);
- fprintf (CGFile, "\n"); }
-
- # line 356 "Calling.puma"
- if (c->CallNode.called_by != NoCallGraph)
- { fprintf (CGFile, " %s : called by ", string);
- OutCallEdges (c->CallNode.called_by);
- fprintf (CGFile, "\n"); }
-
- }
- return;
-
- }
- # line 363 "Calling.puma"
- {
- # line 364 "Calling.puma"
- GetString (c->CallNode.val->ProcObject.ident, string);
- # line 365 "Calling.puma"
- fprintf (CGFile, "SUBROUTINE %s -- \n", string);
- # line 366 "Calling.puma"
- if (c->CallNode.calling != NoCallGraph)
- { fprintf (CGFile, " %s : calls ", string);
- OutCallEdges (c->CallNode.calling);
- fprintf (CGFile, "\n"); }
-
- # line 371 "Calling.puma"
- if (c->CallNode.called_by != NoCallGraph)
- { fprintf (CGFile, " %s : called by ", string);
- OutCallEdges (c->CallNode.called_by);
- fprintf (CGFile, "\n"); }
-
- }
- return;
-
- }
- if (c->CallNode.val->Kind == kFuncObject) {
- # line 378 "Calling.puma"
- {
- # line 379 "Calling.puma"
- GetString (c->CallNode.val->FuncObject.ident, string);
- # line 380 "Calling.puma"
- fprintf (CGFile, "FUNCTION %s -- \n", string);
- # line 381 "Calling.puma"
- if (c->CallNode.calling != NoCallGraph)
- { fprintf (CGFile, " %s : calls ", string);
- OutCallEdges (c->CallNode.calling);
- fprintf (CGFile, "\n"); }
-
- # line 386 "Calling.puma"
- if (c->CallNode.called_by != NoCallGraph)
- { fprintf (CGFile, " %s : called by ", string);
- OutCallEdges (c->CallNode.called_by);
- fprintf (CGFile, "\n"); }
-
- }
- return;
-
- }
- }
- ;
- }
-
- static void OutCallEdges
- # if defined __STDC__ | defined __cplusplus
- (register tCallGraph c)
- # else
- (c)
- register tCallGraph c;
- # endif
- {
- # line 396 "Calling.puma"
-
- unsigned char string[256];
-
- if (c == NoCallGraph) return;
- if (c->Kind == kCallEdgeList) {
- # line 400 "Calling.puma"
- {
- # line 401 "Calling.puma"
- OutCallEdges (c->CallEdgeList.Node);
- # line 402 "Calling.puma"
- if (c->CallEdgeList.count > 1)
- fprintf (CGFile,"(%d)", c->CallEdgeList.count);
- # line 404 "Calling.puma"
- if (c->CallEdgeList.Next != NoCallGraph)
- { fprintf (CGFile,",");
- OutCallEdges (c->CallEdgeList.Next); }
-
- }
- return;
-
- }
- if (c->Kind == kCallNode) {
- if (c->CallNode.val->Kind == kProcObject) {
- # line 410 "Calling.puma"
- {
- # line 411 "Calling.puma"
- GetString (c->CallNode.val->ProcObject.ident, string);
- # line 412 "Calling.puma"
- fprintf (CGFile, "%s", string);
- }
- return;
-
- }
- if (c->CallNode.val->Kind == kFuncObject) {
- # line 415 "Calling.puma"
- {
- # line 416 "Calling.puma"
- GetString (c->CallNode.val->FuncObject.ident, string);
- # line 417 "Calling.puma"
- fprintf (CGFile, "%s", string);
- }
- return;
-
- }
- }
- ;
- }
-
- static int UnitKind
- # if defined __STDC__ | defined __cplusplus
- (register tDefinitions o)
- # else
- (o)
- register tDefinitions o;
- # endif
- {
- if (o->Kind == kProcObject) {
- if (o->ProcObject.decl->Kind == kPROC_DECL) {
- # line 422 "Calling.puma"
- return 0;
-
- }
- if (o->ProcObject.decl->Kind == kINTRINSIC_DECL) {
- # line 430 "Calling.puma"
- return 1;
-
- }
- if (o->ProcObject.decl->Kind == kEXT_PROC_DECL) {
- # line 438 "Calling.puma"
- return 2;
-
- }
- }
- if (o->Kind == kFuncObject) {
- if (o->FuncObject.decl->Kind == kFUNC_DECL) {
- # line 426 "Calling.puma"
- return 0;
-
- }
- if (o->FuncObject.decl->Kind == kINTRINSIC_DECL) {
- # line 434 "Calling.puma"
- return 1;
-
- }
- if (o->FuncObject.decl->Kind == kEXT_FUNC_DECL) {
- # line 442 "Calling.puma"
- return 2;
-
- }
- }
- # line 446 "Calling.puma"
- return 3;
-
- }
-
- void BeginCalling ()
- {
- # line 47 "Calling.puma"
-
- BeginCallGraphFns ();
-
- }
-
- void CloseCalling ()
- {
- }