code-browser/F90Mapper/F90db.c

/*

  Library of routines for recording information on
  F77/F90 code.

*/
#include <stdio.h>
#include <string.h>
#include <ctype.h>
#include "TOKTAB.h"
#include "GLOBALS.h"
#include "DD.h"

/* We build a list of symbol names on each physcial line of text */
/* This list has a max. size of 200, but can be increased here.  */
#define MAX_NO_NAMES_PER_LINE 200
static char *nameBuffer[MAX_NO_NAMES_PER_LINE];
static int  lNameBuffer = 0;

F90symerror(s)
char *s;
{
  printf("Error: %s. Line no. %d\n",s,Lno);
}

/* Record a procedure start */
noteProcDef( name, lnumber, fname)
char *name; int  lnumber; char *fname;
{
   symTab *theSym, *prevEntry; char *upperCaseName;
   char *tmpNam;
   int i; int l;

   /* Free up the external list                                     */
   /* Think this is done because we have just entered a new routine */
   /* so we start afresh with the external list.                    */
   theSym=extTabHead;
   while ( theSym != NULL ) {
    free(theSym->symName); free(theSym->ucName);
    prevEntry=theSym;
    theSym=theSym->next;
    free(prevEntry);
   }
   extTabHead = NULL;

   /* Add name to procedure list */
   upperCaseName = strdup(name); l=strlen(upperCaseName);
   for (i=0;i<l;++i) { upperCaseName[i]=toupper(upperCaseName[i]); }

   printf("%s %s PROCEDURE <%s,%d>\n", upperCaseName, name, fname, lnumber );

   theSym = procTabHead; prevEntry = procTabHead;
   while ( theSym != NULL ) {
     if ( strcmp(theSym->ucName,upperCaseName) == 0 ) break;
     prevEntry = theSym;
     theSym = theSym->next;
   }
   if ( theSym == NULL ) {
    /* printf("No symbol table entry for %s\n",name); */
    ++procCount;
    theSym = (symTab *)malloc(sizeof(symTab));
    if ( theSym != NULL ) {
     theSym->symName  = strdup(name);
     theSym->ucName   = upperCaseName;
     theSym->useCount = 0;
     theSym->next     = NULL;
    }
    if ( prevEntry != NULL ) {
     prevEntry->next = theSym;
    } else {
     procTabHead = theSym;
    }
   } else {
    ++theSym->useCount;
    /* printf("Symbol %s used %d\n",name,theSym->useCount); */
   }
   currentProcedure = theSym->ucName;
   currentProcedureLine0 = lnumber;

   /* Now record name in general symbols list */
   tmpNam = strdup(currentProcedure);
   assertNameIsProcName();
   noteVariable(tmpNam, lnumber, fname);
   clearNameIsProcName();


   return;
}

/* Record a procedure call */
noteProcCall( name, lnumber, fname)
char *name; int  lnumber; char *fname;
{
   symTab *theSym, *prevEntry; char *upperCaseName;
   char *tmpNam;
   int i; int l;

   upperCaseName = strdup(name); l=strlen(upperCaseName);
   for (i=0;i<l;++i) { upperCaseName[i]=toupper(upperCaseName[i]); }

   printf("%s %s CALL <%s,%6.6d> \"%s\"\n", upperCaseName, name, fname, 
          lnumber, currentLineText+1);

   theSym = procTabHead; prevEntry = procTabHead;
   while ( theSym != NULL ) {
     if ( strcmp(theSym->ucName,upperCaseName) == 0 ) break;
     prevEntry = theSym;
     theSym = theSym->next;
   }
   if ( theSym == NULL ) {
    /* printf("No symbol table entry for %s\n",name); */
    ++procCount;
    theSym = (symTab *)malloc(sizeof(symTab));
    if ( theSym != NULL ) {
     theSym->symName  = strdup(name);
     theSym->ucName   = upperCaseName;
     theSym->useCount = 1;
     theSym->next     = NULL;
    }
    if ( prevEntry != NULL ) {
     prevEntry->next = theSym;
    } else {
     procTabHead = theSym;
    }
   } else {
    ++theSym->useCount;
    /* printf("Symbol %s used %d\n",name,theSym->useCount); */
   }

   /* Now record name in general symbols list */
   tmpNam = strdup(upperCaseName);
   noteVariable(tmpNam, lnumber, fname);

   return;
}

/* Record an external definition              */
/* Add it both to the procedure table and the */
/* active externals table.                    */
noteExtDef( name, lnumber, fname)
char *name; int  lnumber; char *fname;
{
   symTab *theSym, *prevEntry; char *upperCaseName;
   int i; int l;

   upperCaseName = strdup(name); l=strlen(upperCaseName);
   for (i=0;i<l;++i) { upperCaseName[i]=toupper(upperCaseName[i]); }

   printf("%s %s EXTERNAL <%s,%d>\n", upperCaseName, name, fname, lnumber );

   theSym = procTabHead; prevEntry = procTabHead;
   while ( theSym != NULL ) {
     if ( strcmp(theSym->ucName,upperCaseName) == 0 ) break;
     prevEntry = theSym;
     theSym = theSym->next;
   }
   if ( theSym == NULL ) {
    /* printf("No symbol table entry for %s\n",name); */
    ++procCount;
    theSym = (symTab *)malloc(sizeof(symTab));
    if ( theSym != NULL ) {
     theSym->symName  = strdup(name);
     theSym->ucName   = upperCaseName;
     theSym->useCount = 0;
     theSym->next     = NULL;
    }
    if ( prevEntry != NULL ) {
     prevEntry->next = theSym;
    } else {
     procTabHead = theSym;
    }
   } else {
    /* printf("Symbol %s used %d\n",name,theSym->useCount); */
   }

   theSym = extTabHead; prevEntry = extTabHead;
   while ( theSym != NULL ) {
     if ( strcmp(theSym->ucName,upperCaseName) == 0 ) break;
     prevEntry = theSym;
     theSym = theSym->next;
   }
   if ( theSym == NULL ) {
    /* printf("No symbol table entry for %s\n",name); */
    theSym = (symTab *)malloc(sizeof(symTab));
    if ( theSym != NULL ) {
     theSym->symName  = strdup(name);
     theSym->ucName   = strdup(upperCaseName);  /* dup because we free this later */
     theSym->useCount = 0;
     theSym->next     = NULL;
    }
    if ( prevEntry != NULL ) {
     prevEntry->next = theSym;
    } else {
     extTabHead = theSym;
    }
   } else {
    /* printf("Symbol %s used %d\n",name,theSym->useCount); */
   }
   return;
}

/* Record a variable name */
noteVariable(name, lnumber, fname)
const char *name; int lnumber; char *fname;
{
   char *upperCaseName;
   int i; int l;
   ddRecord *searchResult; ddRecord rec;

   /* int lStr;
   lStr = strlen(name);
   upperCaseName = (char *)malloc( lStr );
   upperCaseName = strncpy( upperCaseName, name, lStr); */

   upperCaseName = strdup(name);

   rec.name = upperCaseName;
   rec.hrefEntry      = NULL;
   rec.textEntry      = NULL;
   rec.unitsEntry     = NULL;
   rec.footNotesEntry = NULL;
   rec.active         = 1;
   
   searchResult = ddFind(&rec);

  if ( searchResult == NULL ) {
    searchResult = ddAdd(&rec);
    if ( inNameList == 1 ) { ddSetIsInNamelist(searchResult); }
    if ( inIfdef == 1 )    { ddSetIsInIfdef(searchResult);    }
    if ( nameIsProcName == 1 ) { ddSetIsProcName(searchResult);}
  } else {
    ++(searchResult->active);
    if ( inNameList == 1 ) { ddSetIsInNamelist(searchResult);  }
    if ( inIfdef == 1 )    { ddSetIsInIfdef(searchResult);     }
    if ( nameIsProcName == 1 ) { ddSetIsProcName(searchResult);}
  }
  
  /* Write to HTML buffer with appropriate HREF */
  strcat(currentLineHtml,"<A HREF=\"../");
  strcat(currentLineHtml,VARSUF);
  strcat(currentLineHtml,"/");
  strcat(currentLineHtml,searchResult->key);
  strcat(currentLineHtml,HTMLSUF);
  strcat(currentLineHtml,"\">");
  strcat(currentLineHtml,name);
  strcat(currentLineHtml,"</A>");
  /* Write table entry for this occurence of the variable */
  nameBuffer[lNameBuffer] = name;
  ++lNameBuffer;
  if ( lNameBuffer == MAX_NO_NAMES_PER_LINE ) {
   fprintf(stderr,"More than %d names on a single line. Increase MAX_NO_NAMES_PER_LINE.\n",
    MAX_NO_NAMES_PER_LINE);
   exit(0);
  }

}

void F90db_Newline()
{
  int i;
  /* Write out HTML buffer */
  fprintf (srcfd,"%s\n",currentLineHtml);

  /* Write variables table records */
  for (i=0;i<lNameBuffer;++i ){
   fprintf(tmpfd,"%s",nameBuffer[i]);
   fprintf(tmpfd,",<A HREF=../code/%s#%d_L>%d</A>",sHtmlName,Lno,Lno);
   fprintf(tmpfd,",<A HREF=../code/%s>%s</A>",sHtmlName,currentFile);
   /* fprintf(tmpfd,",<A HREF=%s>%s</A>",currentProcedure,currentProcedure); */
   fprintf(tmpfd,",<A HREF=../code/%s#%d_L>%s</A>",sHtmlName,
     currentProcedureLine0,currentProcedure);
   fprintf(tmpfd,",%s",currentLineHtml);
   /*printf("%s,%8.8d,%s,%s,%s\n", nameBuffer[i],
    Lno, currentFile, currentProcedure, currentLineHtml);*/
   fprintf(tmpfd,"\n");
  }

  /* Free name storage */
  for (i=0;i<lNameBuffer;++i ){
   free(nameBuffer[i]);
  }
  lNameBuffer=0;
  /* Clear HTML buffer */
  currentLineHtml[0] = (char)NULL;
}

/* Note when we are in/not in certain states */
/* NAMELIST */
void noteInNameList(name, lnumber, fname)
char *name; int  lnumber; char *fname;
{ char *tmpNam;
  inNameList = 1; 
  tmpNam = strdup(name);
  noteVariable(tmpNam, lnumber, fname);
}

/* #ifdef   */
void noteInIfdef()
{ inIfdef    = 1; }

/* Flag for saying name is/is not procedure name */
assertNameIsProcName()
{ nameIsProcName = 1; }
clearNameIsProcName()
{ nameIsProcName = 0; }

void newStatementNotify()
{ 
  inNameList = 0; 
  inIfdef    = 0;
}

void newLineNotify()
{ 
  inIfdef    = 0;
}
1	adcroft	1.1	/*
2
3			Library of routines for recording information on
4			F77/F90 code.
5
6			*/
7			#include <stdio.h>
8			#include <string.h>
9			#include <ctype.h>
10			#include "TOKTAB.h"
11			#include "GLOBALS.h"
12			#include "DD.h"
13
14			/* We build a list of symbol names on each physcial line of text */
15			/* This list has a max. size of 200, but can be increased here. */
16			#define MAX_NO_NAMES_PER_LINE 200
17			static char *nameBuffer[MAX_NO_NAMES_PER_LINE];
18			static int lNameBuffer = 0;
19
20			F90symerror(s)
21			char *s;
22			{
23			printf("Error: %s. Line no. %d\n",s,Lno);
24			}
25
26			/* Record a procedure start */
27			noteProcDef( name, lnumber, fname)
28			char name; int lnumber; char fname;
29			{
30			symTab theSym, prevEntry; char *upperCaseName;
31			char *tmpNam;
32			int i; int l;
33
34			/* Free up the external list */
35			/* Think this is done because we have just entered a new routine */
36			/* so we start afresh with the external list. */
37			theSym=extTabHead;
38			while ( theSym != NULL ) {
39			free(theSym->symName); free(theSym->ucName);
40			prevEntry=theSym;
41			theSym=theSym->next;
42			free(prevEntry);
43			}
44			extTabHead = NULL;
45
46			/* Add name to procedure list */
47			upperCaseName = strdup(name); l=strlen(upperCaseName);
48			for (i=0;i<l;++i) { upperCaseName[i]=toupper(upperCaseName[i]); }
49
50			printf("%s %s PROCEDURE <%s,%d>\n", upperCaseName, name, fname, lnumber );
51
52			theSym = procTabHead; prevEntry = procTabHead;
53			while ( theSym != NULL ) {
54			if ( strcmp(theSym->ucName,upperCaseName) == 0 ) break;
55			prevEntry = theSym;
56			theSym = theSym->next;
57			}
58			if ( theSym == NULL ) {
59			/* printf("No symbol table entry for %s\n",name); */
60			++procCount;
61			theSym = (symTab *)malloc(sizeof(symTab));
62			if ( theSym != NULL ) {
63			theSym->symName = strdup(name);
64			theSym->ucName = upperCaseName;
65			theSym->useCount = 0;
66			theSym->next = NULL;
67			}
68			if ( prevEntry != NULL ) {
69			prevEntry->next = theSym;
70			} else {
71			procTabHead = theSym;
72			}
73			} else {
74			++theSym->useCount;
75			/* printf("Symbol %s used %d\n",name,theSym->useCount); */
76			}
77			currentProcedure = theSym->ucName;
78			currentProcedureLine0 = lnumber;
79
80			/* Now record name in general symbols list */
81			tmpNam = strdup(currentProcedure);
82			assertNameIsProcName();
83			noteVariable(tmpNam, lnumber, fname);
84			clearNameIsProcName();
85
86
87			return;
88			}
89
90			/* Record a procedure call */
91			noteProcCall( name, lnumber, fname)
92			char name; int lnumber; char fname;
93			{
94			symTab theSym, prevEntry; char *upperCaseName;
95			char *tmpNam;
96			int i; int l;
97
98			upperCaseName = strdup(name); l=strlen(upperCaseName);
99			for (i=0;i<l;++i) { upperCaseName[i]=toupper(upperCaseName[i]); }
100
101			printf("%s %s CALL <%s,%6.6d> \"%s\"\n", upperCaseName, name, fname,
102			lnumber, currentLineText+1);
103
104			theSym = procTabHead; prevEntry = procTabHead;
105			while ( theSym != NULL ) {
106			if ( strcmp(theSym->ucName,upperCaseName) == 0 ) break;
107			prevEntry = theSym;
108			theSym = theSym->next;
109			}
110			if ( theSym == NULL ) {
111			/* printf("No symbol table entry for %s\n",name); */
112			++procCount;
113			theSym = (symTab *)malloc(sizeof(symTab));
114			if ( theSym != NULL ) {
115			theSym->symName = strdup(name);
116			theSym->ucName = upperCaseName;
117			theSym->useCount = 1;
118			theSym->next = NULL;
119			}
120			if ( prevEntry != NULL ) {
121			prevEntry->next = theSym;
122			} else {
123			procTabHead = theSym;
124			}
125			} else {
126			++theSym->useCount;
127			/* printf("Symbol %s used %d\n",name,theSym->useCount); */
128			}
129
130			/* Now record name in general symbols list */
131			tmpNam = strdup(upperCaseName);
132			noteVariable(tmpNam, lnumber, fname);
133
134			return;
135			}
136
137			/* Record an external definition */
138			/* Add it both to the procedure table and the */
139			/* active externals table. */
140			noteExtDef( name, lnumber, fname)
141			char name; int lnumber; char fname;
142			{
143			symTab theSym, prevEntry; char *upperCaseName;
144			int i; int l;
145
146			upperCaseName = strdup(name); l=strlen(upperCaseName);
147			for (i=0;i<l;++i) { upperCaseName[i]=toupper(upperCaseName[i]); }
148
149			printf("%s %s EXTERNAL <%s,%d>\n", upperCaseName, name, fname, lnumber );
150
151			theSym = procTabHead; prevEntry = procTabHead;
152			while ( theSym != NULL ) {
153			if ( strcmp(theSym->ucName,upperCaseName) == 0 ) break;
154			prevEntry = theSym;
155			theSym = theSym->next;
156			}
157			if ( theSym == NULL ) {
158			/* printf("No symbol table entry for %s\n",name); */
159			++procCount;
160			theSym = (symTab *)malloc(sizeof(symTab));
161			if ( theSym != NULL ) {
162			theSym->symName = strdup(name);
163			theSym->ucName = upperCaseName;
164			theSym->useCount = 0;
165			theSym->next = NULL;
166			}
167			if ( prevEntry != NULL ) {
168			prevEntry->next = theSym;
169			} else {
170			procTabHead = theSym;
171			}
172			} else {
173			/* printf("Symbol %s used %d\n",name,theSym->useCount); */
174			}
175
176			theSym = extTabHead; prevEntry = extTabHead;
177			while ( theSym != NULL ) {
178			if ( strcmp(theSym->ucName,upperCaseName) == 0 ) break;
179			prevEntry = theSym;
180			theSym = theSym->next;
181			}
182			if ( theSym == NULL ) {
183			/* printf("No symbol table entry for %s\n",name); */
184			theSym = (symTab *)malloc(sizeof(symTab));
185			if ( theSym != NULL ) {
186			theSym->symName = strdup(name);
187			theSym->ucName = strdup(upperCaseName); /* dup because we free this later */
188			theSym->useCount = 0;
189			theSym->next = NULL;
190			}
191			if ( prevEntry != NULL ) {
192			prevEntry->next = theSym;
193			} else {
194			extTabHead = theSym;
195			}
196			} else {
197			/* printf("Symbol %s used %d\n",name,theSym->useCount); */
198			}
199			return;
200			}
201
202			/* Record a variable name */
203			noteVariable(name, lnumber, fname)
204			const char name; int lnumber; char fname;
205			{
206			char *upperCaseName;
207			int i; int l;
208			ddRecord *searchResult; ddRecord rec;
209
210			/* int lStr;
211			lStr = strlen(name);
212			upperCaseName = (char *)malloc( lStr );
213			upperCaseName = strncpy( upperCaseName, name, lStr); */
214
215			upperCaseName = strdup(name);
216
217			rec.name = upperCaseName;
218			rec.hrefEntry = NULL;
219			rec.textEntry = NULL;
220			rec.unitsEntry = NULL;
221			rec.footNotesEntry = NULL;
222			rec.active = 1;
223
224			searchResult = ddFind(&rec);
225
226			if ( searchResult == NULL ) {
227			searchResult = ddAdd(&rec);
228			if ( inNameList == 1 ) { ddSetIsInNamelist(searchResult); }
229			if ( inIfdef == 1 ) { ddSetIsInIfdef(searchResult); }
230			if ( nameIsProcName == 1 ) { ddSetIsProcName(searchResult);}
231			} else {
232			++(searchResult->active);
233			if ( inNameList == 1 ) { ddSetIsInNamelist(searchResult); }
234			if ( inIfdef == 1 ) { ddSetIsInIfdef(searchResult); }
235			if ( nameIsProcName == 1 ) { ddSetIsProcName(searchResult);}
236			}
237
238			/* Write to HTML buffer with appropriate HREF */
239			strcat(currentLineHtml,"<A HREF=\"../");
240			strcat(currentLineHtml,VARSUF);
241			strcat(currentLineHtml,"/");
242			strcat(currentLineHtml,searchResult->key);
243			strcat(currentLineHtml,HTMLSUF);
244			strcat(currentLineHtml,"\">");
245			strcat(currentLineHtml,name);
246			strcat(currentLineHtml,"</A>");
247			/* Write table entry for this occurence of the variable */
248			nameBuffer[lNameBuffer] = name;
249			++lNameBuffer;
250			if ( lNameBuffer == MAX_NO_NAMES_PER_LINE ) {
251			fprintf(stderr,"More than %d names on a single line. Increase MAX_NO_NAMES_PER_LINE.\n",
252			MAX_NO_NAMES_PER_LINE);
253			exit(0);
254			}
255
256			}
257
258			void F90db_Newline()
259			{
260			int i;
261			/* Write out HTML buffer */
262			fprintf (srcfd,"%s\n",currentLineHtml);
263
264			/* Write variables table records */
265			for (i=0;i<lNameBuffer;++i ){
266			fprintf(tmpfd,"%s",nameBuffer[i]);
267			fprintf(tmpfd,",<A HREF=../code/%s#%d_L>%d</A>",sHtmlName,Lno,Lno);
268			fprintf(tmpfd,",<A HREF=../code/%s>%s</A>",sHtmlName,currentFile);
269			/* fprintf(tmpfd,",<A HREF=%s>%s</A>",currentProcedure,currentProcedure); */
270			fprintf(tmpfd,",<A HREF=../code/%s#%d_L>%s</A>",sHtmlName,
271			currentProcedureLine0,currentProcedure);
272			fprintf(tmpfd,",%s",currentLineHtml);
273			/*printf("%s,%8.8d,%s,%s,%s\n", nameBuffer[i],
274			Lno, currentFile, currentProcedure, currentLineHtml);*/
275			fprintf(tmpfd,"\n");
276			}
277
278			/* Free name storage */
279			for (i=0;i<lNameBuffer;++i ){
280			free(nameBuffer[i]);
281			}
282			lNameBuffer=0;
283			/* Clear HTML buffer */
284			currentLineHtml[0] = (char)NULL;
285			}
286
287			/* Note when we are in/not in certain states */
288			/* NAMELIST */
289			void noteInNameList(name, lnumber, fname)
290			char name; int lnumber; char fname;
291			{ char *tmpNam;
292			inNameList = 1;
293			tmpNam = strdup(name);
294			noteVariable(tmpNam, lnumber, fname);
295			}
296
297			/* #ifdef */
298			void noteInIfdef()
299			{ inIfdef = 1; }
300
301			/* Flag for saying name is/is not procedure name */
302			assertNameIsProcName()
303			{ nameIsProcName = 1; }
304			clearNameIsProcName()
305			{ nameIsProcName = 0; }
306
307			void newStatementNotify()
308			{
309			inNameList = 0;
310			inIfdef = 0;
311			}
312
313			void newLineNotify()
314			{
315			inIfdef = 0;
316			}