1 /* $Id: symspace.c,v 1.6 2001/11/03 00:55:37 moniot Rel $
2 
3   Routines to allocate various symbol table-related items.
4 
5 Copyright (c) 2001 by Robert K. Moniot.
6 
7 Permission is hereby granted, free of charge, to any person
8 obtaining a copy of this software and associated documentation
9 files (the "Software"), to deal in the Software without
10 restriction, including without limitation the rights to use,
11 copy, modify, merge, publish, distribute, sublicense, and/or
12 sell copies of the Software, and to permit persons to whom the
13 Software is furnished to do so, subject to the following
14 conditions:
15 
16 The above copyright notice and this permission notice shall be
17 included in all copies or substantial portions of the
18 Software.
19 
20 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY
21 KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE
22 WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
23 PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
24 COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
25 LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
26 OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
27 SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
28 
29 Acknowledgement: the above permission notice is what is known
30 as the "MIT License."
31 */
32 
33 #include <stdio.h>
34 #include <string.h>
35 
36 #include "ftnchek.h"
37 #include "symtab.h"
38 #include "symspace.h"
39 #include "symutils.h"
40 
41 PROTO(PRIVATE TokenListHeader * new_tokhead,( void ));
42 
43 
44 PRIVATE StrSpace *
45 curr_loc_strspace;		/* Ptr to current local string space struct */
46 
47 PRIVATE StrSpace *
48 curr_srctextspace;		/* Ptr to current token string space struct */
49 
50 PRIVATE ParamInfoSpace *
51 curr_paraminfospace;		/* Ptr to current param info space struct */
52 
53 PRIVATE TokHeadSpace *
54 curr_tokheadspace;		/* Ptr to current TokHeadSpace struct */
55 
56 PRIVATE TokenSpace *
57 curr_tokspace;			/* Ptr to current TokenSpace struct */
58 
59 PRIVATE PtrSpace *
60 curr_ptrspace;			/* Ptr to current PtrSpace struct */
61 
62 void
init_globals(VOID)63 init_globals(VOID)                	/* Clears the global symbol table */
64 {
65   glob_symtab_top = 0;	/* Neither of these stmts is really needed. */
66   glob_strings_used = 0;
67 
68 				/* local strings are now permanently stored */
69   curr_loc_strspace = &lstrspace;
70   loc_str_top = 0;
71   extra_locstrspace = 0;
72 }/*init_globals*/
73 
74 
75 
76 void
init_symtab(VOID)77 init_symtab(VOID)                     /* Clears the local symbol table */
78 {
79 	int i,h;
80 
81 		/* Define factor equal to ratio of time to clear hashtable
82 		   entry by looking up in symbol table to time to clear it
83 		   directly.  This factor is used to choose the method
84 		   of clearing out the hashtab.
85 		 */
86 #ifndef HINITFACTOR
87 #define HINITFACTOR 20
88 #endif
89 		      /* Clear the hash table of local symbol refs */
90 	if( loc_symtab_top < HASHSZ/HINITFACTOR ) {
91 			/* few local symbols: look them up in symtab */
92 	  for(i=0; i<loc_symtab_top; i++) {
93 	      h=hash_lookup(loc_symtab[i].name);
94 	      hashtab[h].loc_symtab = NULL;
95 	      hashtab[h].com_loc_symtab = NULL;
96 	  }
97 	}
98 	else {
99 			/* many local symbols: skip lookup, sweep hashtable */
100 	  for(h=0;h<HASHSZ;h++) {
101 	    hashtab[h].loc_symtab = NULL;
102 	    hashtab[h].com_loc_symtab = NULL;
103 	  }
104 	}
105 
106 	loc_symtab_top = 0;	/* Clear local symtab */
107 
108 
109 	curr_srctextspace = &srctextspace;
110 	srctextspace_top = 0;	/* Reset storage area for token text */
111 	extra_srctextspace = 0;
112 
113 	curr_tokspace = &tokspace;
114 	token_space_top = 0;	/* Reset storage for tokens in lists & trees */
115 	extra_tokspace = 0;
116 
117 	curr_paraminfospace = &paraminfospace;
118  	param_info_space_top = 0;/* Reset storage for parameter info structs */
119 	extra_paraminfospace = 0;
120 
121 	curr_tokheadspace = &tokheadspace;
122  	token_head_space_top = 0;/* Reset storage for tokenlist headers */
123 	extra_tokheadspace = 0;
124 
125 	curr_ptrspace = &ptrspace;
126 	ptrspace_top = 0;	/* Reset storage for array dim textvecs */
127 	extra_ptrspace = 0;
128 
129 	parameter_count = 0;
130 
131 		      /* Restores implicit typing to default values.
132 		         Note: 27 is '$', 28 is '_' which are default REAL */
133 	{
134 		int c;
135 		for( c=0; c<=('Z'-'A'+2); c++ ) {
136 	    	    implicit_type[c] = type_REAL;
137 		    implicit_size[c] = size_DEFAULT;
138 		    implicit_len_text[c] = NULL;
139 		}
140 		for( c='I'-'A'; c <= 'N'-'A'; c++ )
141 		    implicit_type[c] = type_INTEGER;
142 	}
143 
144 	init_labtable();		/* Clear out label table */
145 
146 }/*init_symtab*/
147 
148 TokenListHeader *	/* Initializes a tokenlist header */
149 #if HAVE_STDC
make_TL_head(Token * t)150 make_TL_head(Token *t)
151 #else /* K&R style */
152 make_TL_head(t)
153      Token *t;
154 #endif /* HAVE_STDC */
155 {
156 	TokenListHeader *TH_ptr;
157 	TH_ptr = new_tokhead();
158 	TH_ptr->line_num = t->line_num;
159 	TH_ptr->top_line_num = (current_filename == top_filename?
160 				t->line_num: top_file_line_num);
161   	TH_ptr->filename = current_filename;
162 				/* Clear all the flags */
163 	TH_ptr->external_decl = FALSE;
164 	TH_ptr->actual_arg = FALSE;
165 	TH_ptr->tokenlist = NULL;
166 	TH_ptr->next = NULL;
167 
168   return TH_ptr;
169 }
170 
171 PRIVATE TokenListHeader *
new_tokhead(VOID)172 new_tokhead(VOID)
173 {
174   if(token_head_space_top == TOKHEADSPACESZ) {
175     if(curr_tokheadspace->next == (TokHeadSpace *)NULL) {
176       TokHeadSpace *new_tokheadspace;
177       if( (new_tokheadspace = (TokHeadSpace *)malloc(sizeof(TokHeadSpace)))
178 	 == (TokHeadSpace *)NULL) {
179 	oops_message(OOPS_FATAL,line_num,NO_COL_NUM,
180 		     "Cannot alloc space for token list header");
181 	return (TokenListHeader *)NULL;	/*NOTREACHED*/
182       }
183       else {
184 	new_tokheadspace->next =  (TokHeadSpace *)NULL;
185 	curr_tokheadspace->next = new_tokheadspace;
186       }
187     }
188     curr_tokheadspace = curr_tokheadspace->next;
189     extra_tokheadspace += TOKHEADSPACESZ;
190     token_head_space_top = 0;
191   }
192   return curr_tokheadspace->tokheadspace + token_head_space_top++;
193 }
194 
195 		/* this routine allocates room in global stringspace
196 		   (top down) for string s, and copies it there. */
197 char *
198 #if HAVE_STDC
new_global_string(char * s)199 new_global_string(char *s)
200 #else /* K&R style */
201 new_global_string(s)
202 	char *s;
203 #endif /* HAVE_STDC */
204 {
205   static unsigned long glob_str_bot = 0;
206   static char *glob_strspace;
207 
208   unsigned count = strlen(s) + 1;/* no. of chars needed including final nul */
209 
210   glob_strings_used += count;	/* keep track for -resource */
211 
212   if(glob_str_bot < count) {
213     unsigned long numalloc = (count > STRSPACESZ? count: STRSPACESZ);
214     glob_strspace = (char *)calloc(numalloc,sizeof(char));
215     if(glob_strspace == (char *)NULL) {
216       oops_message(OOPS_FATAL,line_num,NO_COL_NUM,
217 		   "Cannot alloc space for global strings");
218       return (char *)NULL; /*NOTREACHED*/
219     }
220     glob_str_bot = numalloc;
221   }
222 
223   glob_str_bot -= count;    /*pre-decrement*/
224   return strcpy(glob_strspace+glob_str_bot,s);
225 }/*new_global_string*/
226 
227 		/* Allocate space for string s in local string space
228 		   (bottom up), and copy it there. */
229 char *
230 #if HAVE_STDC
new_local_string(char * s)231 new_local_string(char *s)
232 #else /* K&R style */
233 new_local_string(s)
234 	char *s;
235 #endif /* HAVE_STDC */
236 {
237   int count = strlen(s) + 1;	/* No. of chars needed including final nul */
238   int orig_top = loc_str_top;
239   loc_str_top += count;
240   if(loc_str_top > STRSPACESZ) {
241     StrSpace *new_loc_strspace;
242     new_loc_strspace = (StrSpace *)malloc(sizeof(StrSpace));
243     if(new_loc_strspace == (StrSpace *)NULL) {
244       oops_message(OOPS_FATAL,line_num,NO_COL_NUM,
245 		   "Cannot alloc space for local strings");
246       return (char *)NULL; /*NOTREACHED*/
247     }
248     else {
249       new_loc_strspace->next = (StrSpace *)NULL;
250       curr_loc_strspace->next = new_loc_strspace;
251     }
252     curr_loc_strspace = curr_loc_strspace->next;
253     extra_locstrspace += orig_top; /* Remember amount used so far */
254     orig_top = 0;
255     loc_str_top = count;
256   }
257   return strcpy(curr_loc_strspace->strspace+orig_top,s);
258 }/* new_local_string */
259 
260 ParamInfo *
new_param_info(VOID)261 new_param_info(VOID)		/* Allocates space for parameter info field */
262 {
263   if(param_info_space_top == PARAMINFOSPACESZ) {
264     if(curr_paraminfospace->next == (ParamInfoSpace *)NULL) {
265       ParamInfoSpace *new_paraminfospace;
266       if( (new_paraminfospace = (ParamInfoSpace *)malloc(sizeof(ParamInfoSpace)))
267 	 == (ParamInfoSpace *)NULL) {
268 	oops_message(OOPS_FATAL,line_num,NO_COL_NUM,
269 		     "Cannot alloc space for parameter info");
270 	return (ParamInfo *)NULL;	/*NOTREACHED*/
271       }
272       else {
273 	new_paraminfospace->next =  (ParamInfoSpace *)NULL;
274 	curr_paraminfospace->next = new_paraminfospace;
275       }
276     }
277     curr_paraminfospace = curr_paraminfospace->next;
278     extra_paraminfospace += PARAMINFOSPACESZ;
279     param_info_space_top = 0;
280   }
281   return curr_paraminfospace->paraminfospace + param_info_space_top++;
282 
283 }
284 
285 
286 
287 void
288 #if HAVE_STDC
free_textvec(char ** p)289 free_textvec(char **p)		/*ARGSUSED0*/
290 #else /* K&R style */
291 free_textvec(p)		/*ARGSUSED0*/
292      char **p;
293 #endif /* HAVE_STDC */
294 {
295 	/* No action necessary since all the space is freed in
296 	   a lump at end of processing module */
297 }
298 
299 char **
300 #if HAVE_STDC
new_textvec(int n)301 new_textvec(int n)		/* Allocates space for array of n char ptrs */
302 #else /* K&R style */
303 new_textvec(n)		/* Allocates space for array of n char ptrs */
304      int n;
305 #endif /* HAVE_STDC */
306 {
307   int orig_top = ptrspace_top;
308   ptrspace_top += n;
309 
310   if( ptrspace_top > PTRSPACESZ) {
311     if(curr_ptrspace->next == (PtrSpace *)NULL) {
312       PtrSpace *new_ptrspace;
313       if( (new_ptrspace = (PtrSpace *)malloc(sizeof(PtrSpace)))
314 	 == (PtrSpace *)NULL) {
315 	oops_message(OOPS_FATAL,line_num,NO_COL_NUM,
316 		     "Cannot alloc space for pointers to text");
317 	return (char **)NULL; /*NOTREACHED*/
318       }
319       else {
320 	new_ptrspace->next = (PtrSpace *)NULL;
321 	curr_ptrspace->next = new_ptrspace;
322       }
323     }
324     curr_ptrspace = curr_ptrspace->next;
325     extra_ptrspace += orig_top;
326     orig_top = 0;
327     ptrspace_top = n;
328   }
329   return curr_ptrspace->ptrspace + orig_top;
330 }
331 
332 				/* Routine to allocate space for
333 				   a string containing source text
334 				   of a token. */
335 
336 char *
337 #if HAVE_STDC
new_src_text_alloc(int size)338 new_src_text_alloc(int size)
339               			/* length counting nul */
340 #else /* K&R style */
341 new_src_text_alloc(size)
342      int size;			/* length counting nul */
343 #endif /* HAVE_STDC */
344 {
345   int orig_top = srctextspace_top;
346   srctextspace_top += size;
347 
348   if(srctextspace_top > STRSPACESZ) {
349     StrSpace *new_srctextspace;
350     new_srctextspace = (StrSpace *)malloc(sizeof(StrSpace));
351     if(new_srctextspace == (StrSpace *)NULL) {
352       oops_message(OOPS_FATAL,line_num,col_num,
353 		   "Cannot alloc space for token text");
354       return (char *)NULL; /*NOTREACHED*/
355     }
356     else {
357       new_srctextspace->next = (StrSpace *)NULL;
358       curr_srctextspace->next = new_srctextspace;
359     }
360     curr_srctextspace = curr_srctextspace->next;
361     extra_srctextspace += orig_top; /* Remember amount used so far */
362     orig_top = 0;
363     srctextspace_top = size;
364   }
365 
366   return curr_srctextspace->strspace + orig_top;
367 }
368 
369 				/* Tokens that are 1 char long have their
370 				   src_text stored in this array, indexed
371 				   by their codes.  Avoids duplication of
372 				   strings, wasting space.
373 				 */
374 PRIVATE char onechar_text[2*(MAX_CHAR_CODE+1)];
375 
376 				/* Routine to get space for string
377 				   containing source text of token
378 				   and copy it to there.
379 				 */
380 
381 char *
382 #if HAVE_STDC
new_src_text(const char * s,int len)383 new_src_text(const char *s, int len)
384              			/* string (final nul not needed) */
385              			/* length not counting nul */
386 #else /* K&R style */
387 new_src_text(s,len)
388      char *s;			/* string (final nul not needed) */
389      int len;			/* length not counting nul */
390 #endif /* HAVE_STDC */
391 {
392   int i;
393   char *new_s;
394 				/* If it is a single char, it goes
395 				   into the special array.  Otherwise
396 				   allocate space for it. */
397   if(len <= 1)
398     new_s = &onechar_text[s[0]*2];
399   else
400     new_s = new_src_text_alloc(len+1);
401 
402   for(i=0; i<len; i++)		/* copy string to new space */
403     new_s[i] = s[i];
404   new_s[i] = '\0';
405 
406   return new_s;
407 }
408 
409 		/* Copy expr token src text into local stringspace. */
410 
411 #define MAXTREETEXT (20*72+1)	/* Enough space for any f77 expression. */
412 PRIVATE char tree_text_space[MAXTREETEXT];
413 
414 char *
415 #if HAVE_STDC
new_tree_text(Token * t)416 new_tree_text(Token *t)
417 #else /* K&R style */
418 new_tree_text(t)
419      Token *t;
420 #endif /* HAVE_STDC */
421 {
422   (void) cp_tree_src_text(tree_text_space, t, MAXTREETEXT-1);
423   return new_local_string(tree_text_space);
424 }
425 
426 
427 
428 Token *
new_token(VOID)429 new_token(VOID)			/* Returns pointer to space for a token */
430 {
431   if(token_space_top == TOKENSPACESZ) {
432 	/* When token space is used up, go to the next.  If none, then
433 	   allocate a new one.  The memory is never deallocated, since
434 	   it will likely be needed again later.  So token space structs
435 	   are linked into a list. */
436     if(curr_tokspace->next == (TokenSpace *)NULL) {
437       TokenSpace *new_tokspace;
438       if( (new_tokspace = (TokenSpace *)malloc(sizeof(TokenSpace)))
439 	 == (TokenSpace *)NULL) {
440 	oops_message(OOPS_FATAL,line_num,NO_COL_NUM,
441 		     "Cannot alloc space for tokens");
442 	return (Token *)NULL; /*NOTREACHED*/
443       }
444       else {
445 	new_tokspace->next =  (TokenSpace *)NULL;
446 	curr_tokspace->next = new_tokspace;
447       }
448     }
449     curr_tokspace = curr_tokspace->next;
450     extra_tokspace += TOKENSPACESZ; /* Keep track of how much for -resource */
451     token_space_top = 0;
452   }
453   return curr_tokspace->tokenspace + token_space_top++;
454 }
455 
456