home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
OS/2 Shareware BBS: 10 Tools
/
10-Tools.zip
/
adaptor.zip
/
adapt.zip
/
adaptor
/
src
/
calling.c
< prev
next >
Wrap
Text File
|
1994-01-03
|
15KB
|
696 lines
# 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 ()
{
}