code-browser/F90Mapper/F90db.c

/*

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

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