dattalo - Disabled code dependent on ports that have been disabled. I don't know...
[fw/sdcc] / src / SDCCsymt.h
1 /*-------------------------------------------------------------------------
2   SDCCsymt.h - Header file for Symbols table related structures and MACRO's.              
3               Written By -  Sandeep Dutta . sandeep.dutta@usa.net (1998)
4
5    This program is free software; you can redistribute it and/or modify it
6    under the terms of the GNU General Public License as published by the
7    Free Software Foundation; either version 2, or (at your option) any
8    later version.
9    
10    This program is distributed in the hope that it will be useful,
11    but WITHOUT ANY WARRANTY; without even the implied warranty of
12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13    GNU General Public License for more details.
14    
15    You should have received a copy of the GNU General Public License
16    along with this program; if not, write to the Free Software
17    Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
18    
19    In other words, you are welcome to use, share and improve this program.
20    You are forbidden to forbid anyone else to use, share and improve
21    what you give them.   Help stamp out software-hoarding!  
22 -------------------------------------------------------------------------*/
23
24 #ifndef  SDCCSYMT_H
25 #define  SDCCSYMT_H
26
27 #define MAX_NEST_LEVEL  256
28 #define SDCC_SYMNAME_MAX 64
29 #define SDCC_NAME_MAX  3*SDCC_SYMNAME_MAX // big enough for _<func>_<var>_etc
30 #include "SDCChasht.h"
31
32 enum {
33     TYPEOF_INT=1,
34     TYPEOF_SHORT,
35     TYPEOF_CHAR,
36     TYPEOF_LONG,
37     TYPEOF_FLOAT,
38     TYPEOF_BIT,
39     TYPEOF_SBIT,
40     TYPEOF_SFR,
41     TYPEOF_VOID,
42     TYPEOF_STRUCT,
43     TYPEOF_ARRAY,
44     TYPEOF_FUNCTION,
45     TYPEOF_POINTER,
46     TYPEOF_FPOINTER,
47     TYPEOF_CPOINTER,
48     TYPEOF_GPOINTER,
49     TYPEOF_PPOINTER,
50     TYPEOF_IPOINTER,
51     TYPEOF_EEPPOINTER
52 };
53
54 #define HASHTAB_SIZE 256
55
56 /* hash table bucket */
57 typedef struct bucket
58   {
59     void *sym;                  /* pointer to the object   */
60     char name[SDCC_NAME_MAX + 1];       /* name of this symbol          */
61     int level;                  /* nest level for this symbol   */
62     int block;                  /* belongs to which block */
63     struct bucket *prev;        /* ptr 2 previous bucket   */
64     struct bucket *next;        /* ptr 2 next bucket       */
65   }
66 bucket;
67
68 typedef struct structdef
69   {
70     char tag[SDCC_NAME_MAX + 1];        /* tag part of structure      */
71     unsigned char level;        /* Nesting level         */
72     struct symbol *fields;      /* pointer to fields     */
73     unsigned size;              /* sizeof the table in bytes  */
74   }
75 structdef;
76
77 /* noun definitions */
78 typedef enum
79   {
80     V_INT = 1,
81     V_FLOAT,
82     V_CHAR,
83     V_VOID,
84     V_STRUCT,
85     V_LABEL,
86     V_BIT,
87     V_SBIT,
88     V_DOUBLE
89   }
90 NOUN;
91
92 /* storage class    */
93 typedef enum
94   {
95     S_FIXED = 0,
96     S_AUTO,
97     S_REGISTER,
98     S_SFR,
99     S_SBIT,
100     S_CODE,
101     S_XDATA,
102     S_DATA,
103     S_IDATA,
104     S_PDATA,
105     S_LITERAL,
106     S_STACK,
107     S_XSTACK,
108     S_BIT,
109     S_EEPROM
110   }
111 STORAGE_CLASS;
112
113 /* specifier is the last in the type-chain */
114 typedef struct specifier
115   {
116     NOUN noun;                  /* CHAR INT STRUCTURE LABEL   */
117     STORAGE_CLASS sclass;       /* REGISTER,AUTO,FIX,CONSTANT */
118     struct memmap *oclass;      /* output storage class       */
119     unsigned _long:1;           /* 1=long            */
120     unsigned _short:1;          /* 1=short int    */
121     unsigned _unsigned:1;       /* 1=unsigned, 0=signed       */
122     unsigned _signed:1;         /* just for sanity checks only*/
123     unsigned _static:1;         /* 1=static keyword found     */
124     unsigned _extern:1;         /* 1=extern found             */
125     unsigned _absadr:1;         /* absolute address specfied  */
126     unsigned _volatile:1;       /* is marked as volatile      */
127     unsigned _const:1;          /* is a constant              */
128     unsigned _typedef:1;        /* is typedefed               */
129     unsigned _isregparm:1;      /* is the first parameter     */
130     unsigned _isenum:1;         /* is an enumerated type      */
131     unsigned _addr;             /* address of symbol          */
132     unsigned _stack;            /* stack offset for stacked v */
133     unsigned _bitStart;         /* bit start position         */
134     int _bitLength;             /* bit length                 */
135     int argreg;                 /* reg no for regparm         */
136     union
137       {                         /* Values if constant or enum */
138         short int v_int;                /* int and char values        */
139         char *v_char;           /* character string           */
140         unsigned short v_uint;  /* unsigned int const value   */
141         long v_long;            /* long constant value        */
142         unsigned long v_ulong;  /* unsigned long constant val */
143         double v_float;         /* floating point constant value */
144         struct symbol *v_enum;  /* ptr 2 enum_list if enum==1 */
145       }
146     const_val;
147     struct structdef *v_struct; /* structure pointer      */
148   }
149 specifier;
150
151 /* types of declarators */
152 typedef enum
153   {
154     POINTER = 0,                /* pointer to near data */
155     FPOINTER,                   /* pointer to far data  */
156     CPOINTER,                   /* pointer to code space */
157     GPOINTER,                   /* _generic pointer     */
158     PPOINTER,                   /* paged area pointer   */
159     IPOINTER,                   /* pointer to upper 128 bytes */
160     UPOINTER,                   /* unknown pointer used only when parsing */
161     EEPPOINTER,                 /* pointer to eeprom     */
162     ARRAY,
163     FUNCTION
164   }
165 DECLARATOR_TYPE;
166
167 typedef struct declarator
168   {
169     DECLARATOR_TYPE dcl_type;   /* POINTER,ARRAY or FUNCTION  */
170     unsigned int num_elem;      /* # of elems if type==array  */
171     short ptr_const:1;          /* pointer is constant        */
172     short ptr_volatile:1;       /* pointer is volatile        */
173     struct sym_link *tspec;     /* pointer type specifier     */
174   }
175 declarator;
176
177 #define DECLARATOR   0
178 #define SPECIFIER    1
179
180 typedef struct sym_link
181   {
182     unsigned class:1;           /* DECLARATOR or SPECIFIER    */
183     unsigned tdef:1;            /* current link created by    */
184     /* typedef if this flag is set */
185     union
186       {
187         specifier s;            /* if CLASS == SPECIFIER      */
188         declarator d;           /* if CLASS == DECLARATOR     */
189       } select;
190
191     /* function attributes */
192     struct {
193       struct value *args;       /* the defined arguments      */
194       unsigned hasVargs:1;      /* functions has varargs      */
195       unsigned calleeSaves:1;   /* functions uses callee save */
196       unsigned hasbody:1;       /* function body defined      */
197       //unsigned ret:1;         /* return statement for a function */
198       unsigned hasFcall:1;      /* does it call other functions */
199       unsigned reent:1;         /* function is reentrant      */
200       unsigned naked:1;         /* naked function             */
201
202       unsigned nonbanked:1;     /* function has the nonbanked attribute */
203       unsigned banked:1;        /* function has the banked attribute */
204       unsigned critical:1;      /* critical function          */
205       unsigned intrtn:1;        /* this is an interrupt routin */
206       unsigned rbank:1;         /* seperate register bank     */
207       unsigned intno;           /* 1=Interrupt svc routine    */
208       unsigned regbank;         /* register bank 2b used      */
209       unsigned builtin;         /* is a builtin function      */
210       unsigned javaNative;      /* is a JavaNative Function (TININative ONLY) */
211       unsigned overlay;         /* force parameters & locals into overlay segment */
212       unsigned hasStackParms;   /* function has parameters on stack */
213     } funcAttrs;
214
215     struct sym_link *next;      /* next element on the chain  */
216   }
217 sym_link;
218
219 typedef struct symbol
220   {
221     char name[SDCC_SYMNAME_MAX + 1];    /* Input Variable Name     */
222     char rname[SDCC_NAME_MAX + 1];      /* internal name           */
223
224     short level;                /* declration lev,fld offset */
225     short block;                /* sequential block # of defintion */
226     int key;
227     unsigned implicit:1;        /* implicit flag                     */
228     unsigned undefined:1;       /* undefined variable                */
229     unsigned _isparm:1;         /* is a parameter          */
230     unsigned ismyparm:1;        /* is parameter of the function being generated */
231     unsigned isitmp:1;          /* is an intermediate temp */
232     unsigned islbl:1;           /* is a temporary label */
233     unsigned isref:1;           /* has been referenced  */
234     unsigned isind:1;           /* is a induction variable */
235     unsigned isinvariant:1;     /* is a loop invariant  */
236     unsigned isstrlit:1;        /* is a string literal  */
237     unsigned cdef:1;            /* compiler defined symbol */
238     unsigned addrtaken:1;       /* address of the symbol was taken */
239     unsigned isreqv:1;          /* is the register quivalent of a symbol */
240     unsigned udChked:1;         /* use def checking has been already done */
241
242     /* following flags are used by the backend
243        for code generation and can be changed
244        if a better scheme for backend is thought of */
245     unsigned isLiveFcall:1;     /* is live at or across a function call */
246     unsigned isspilt:1;         /* has to be spilt */
247     unsigned spillA:1;          /* spilt be register allocator */
248     unsigned remat:1;           /* can be remateriazed */
249     unsigned isptr:1;           /* is a pointer */
250     unsigned uptr:1;            /* used as a pointer */
251     unsigned isFree:1;          /* used by register allocator */
252     unsigned islocal:1;         /* is a local variable        */
253     unsigned blockSpil:1;       /* spilt at block level       */
254     unsigned remainSpil:1;      /* spilt because not used in remainder */
255     unsigned stackSpil:1;       /* has been spilt on temp stack location */
256     unsigned onStack:1;         /* this symbol allocated on the stack */
257     unsigned iaccess:1;         /* indirect access      */
258     unsigned ruonly:1;          /* used in return statement only */
259     unsigned spildir:1;         /* spilt in direct space */
260     unsigned ptrreg:1;          /* this symbol assigned to a ptr reg */
261     unsigned noSpilLoc:1;       /* cannot be assigned a spil location */
262     unsigned accuse;            /* can be left in the accumulator
263                                    On the Z80 accuse is devided into
264                                    ACCUSE_A and ACCUSE_HL as the idea
265                                    is quite similar.
266                                  */
267     unsigned dptr;              /* 8051 variants with multiple DPTRS
268                                    currently implemented in DS390 only
269                                 */
270     int allocreq ;              /* allocation is required for this variable */
271     int stack;                  /* offset on stack      */
272     int xstack;                 /* offset on xternal stack */
273     short nRegs;                /* number of registers required */
274     short regType;              /* type of register required    */
275
276     struct regs *regs[4];       /* can have at the most 4 registers */
277     struct asmop *aop;          /* asmoperand for this symbol */
278     struct iCode *fuse;         /* furthest use */
279     struct iCode *rematiCode;   /* rematerialse with which instruction */
280     struct operand *reqv;       /* register equivalent of a local variable */
281     union
282       {
283         struct symbol *spillLoc;        /* register spil location */
284         struct set *itmpStack;  /* symbols spilt @ this stack location */
285       }
286     usl;
287     short bitVar;               /* this is a bit variable    */
288     unsigned offset;            /* offset from top if struct */
289
290     int lineDef;                /* defined line number        */
291     int lastLine;               /* for functions the last line */
292     struct sym_link *type;      /* 1st link to declator chain */
293     struct sym_link *etype;     /* last link to declarator chn */
294     struct symbol *next;        /* crosslink to next symbol   */
295     struct symbol *localof;     /* local variable of which function */
296     struct initList *ival;      /* ptr to initializer if any  */
297     struct bitVect *defs;       /* bit vector for definitions */
298     struct bitVect *uses;       /* bit vector for uses        */
299     struct bitVect *regsUsed;   /* for functions registers used */
300     int liveFrom;               /* live from iCode sequence number */
301     int liveTo;                 /* live to sequence number */
302     int used;                   /* no. of times this was used */
303     int recvSize;               /* size of first argument  */
304     struct bitVect *clashes;    /* overlaps with what other symbols */
305   }
306 symbol;
307
308 /* Easy Access Macros */
309 #define DCL_TYPE(l)  l->select.d.dcl_type
310 #define DCL_ELEM(l)  l->select.d.num_elem
311 #define DCL_PTR_CONST(l) l->select.d.ptr_const
312 #define DCL_PTR_VOLATILE(l) l->select.d.ptr_volatile
313 #define DCL_TSPEC(l) l->select.d.tspec
314
315 #define FUNC_DEBUG //assert(IS_FUNC(x));
316 #define FUNC_HASVARARGS(x) (x->funcAttrs.hasVargs)
317 #define IFFUNC_HASVARARGS(x) (IS_FUNC(x) && FUNC_HASVARARGS(x))
318 #define FUNC_ARGS(x) (x->funcAttrs.args)
319 #define IFFUNC_ARGS(x) (IS_FUNC(x) && FUNC_ARGS(x))
320 #define FUNC_HASFCALL(x) (x->funcAttrs.hasFcall)
321 #define IFFUNC_HASFCALL(x) (IS_FUNC(x) && FUNC_HASFCALL(x))
322 #define FUNC_HASBODY(x) (x->funcAttrs.hasbody)
323 #define IFFUNC_HASBODY(x) (IS_FUNC(x) && FUNC_HASBODY(x))
324 #define FUNC_CALLEESAVES(x) (x->funcAttrs.calleeSaves)
325 #define IFFUNC_CALLEESAVES(x) (IS_FUNC(x) && FUNC_CALLEESAVES(x))
326 #define FUNC_ISISR(x) (x->funcAttrs.intrtn)
327 #define IFFUNC_ISISR(x) (IS_FUNC(x) && FUNC_ISISR(x))
328 #define IFFUNC_RBANK(x) (IS_FUNC(x) && FUNC_RBANK(x))
329 #define FUNC_INTNO(x) (x->funcAttrs.intno)
330 #define FUNC_REGBANK(x) (x->funcAttrs.regbank)
331 #define FUNC_HASSTACKPARM(x) (x->funcAttrs.hasStackParms)
332
333 #define FUNC_ISREENT(x) (x->funcAttrs.reent)
334 #define IFFUNC_ISREENT(x) (IS_FUNC(x) && FUNC_ISREENT(x))
335 #define FUNC_ISNAKED(x) (x->funcAttrs.naked)
336 #define IFFUNC_ISNAKED(x) (IS_FUNC(x) && FUNC_ISNAKED(x))
337 #define FUNC_NONBANKED(x) (x->funcAttrs.nonbanked)
338 #define IFFUNC_NONBANKED(x) (IS_FUNC(x) && FUNC_NONBANKED(x))
339 #define FUNC_BANKED(x) (x->funcAttrs.banked)
340 #define IFFUNC_BANKED(x) (IS_FUNC(x) && FUNC_BANKED(x))
341 #define FUNC_ISCRITICAL(x) (x->funcAttrs.critical)
342 #define IFFUNC_ISCRITICAL(x) (IS_FUNC(x) && FUNC_ISCRITICAL(x))
343 #define FUNC_ISBUILTIN(x) (x->funcAttrs.builtin)
344 #define IFFUNC_ISBUILTIN(x) (IS_FUNC(x) && FUNC_ISBUILTIN(x))
345 #define FUNC_ISJAVANATIVE(x) (x->funcAttrs.javaNative)
346 #define IFFUNC_ISJAVANATIVE(x) (IS_FUNC(x) && FUNC_ISJAVANATIVE(x))
347 #define FUNC_ISOVERLAY(x) (x->funcAttrs.overlay)
348 #define IFFUNC_ISOVERLAY(x) (IS_FUNC(x) && FUNC_ISOVERLAY(x))
349
350
351 // jwk: I am not sure about this
352 #define IFFUNC_ISBANKEDCALL(x) (!IFFUNC_NONBANKED(x) && \
353   (options.model == MODEL_LARGE || \
354    options.model == MODEL_MEDIUM || \
355   IFFUNC_BANKED(x)))
356
357 #define SPEC_NOUN(x) x->select.s.noun
358 #define SPEC_LONG(x) x->select.s._long
359 #define SPEC_USIGN(x) x->select.s._unsigned
360 #define SPEC_SCLS(x) x->select.s.sclass
361 #define SPEC_ENUM(x) x->select.s._isenum
362 #define SPEC_OCLS(x) x->select.s.oclass
363 #define SPEC_STAT(x) x->select.s._static
364 #define SPEC_EXTR(x) x->select.s._extern
365 #define SPEC_CODE(x) x->select.s._codesg
366 #define SPEC_ABSA(x) x->select.s._absadr
367 #define SPEC_BANK(x) x->select.s._regbank
368 #define SPEC_ADDR(x) x->select.s._addr
369 #define SPEC_STAK(x) x->select.s._stack
370 #define SPEC_CVAL(x) x->select.s.const_val
371 #define SPEC_BSTR(x) x->select.s._bitStart
372 #define SPEC_BLEN(x) x->select.s._bitLength
373
374 /* Sleaze: SPEC_ISR_SAVED_BANKS is only used on 
375  * function type symbols, which obviously cannot
376  * be of BIT type. Therefore, we recycle the 
377  * _bitStart field instead of defining a new field.
378  */
379 #define SPEC_ISR_SAVED_BANKS(x) x->select.s._bitStart
380 #define SPEC_VOLATILE(x) x->select.s._volatile
381 #define SPEC_CONST(x) x->select.s._const
382 #define SPEC_STRUCT(x) x->select.s.v_struct
383 #define SPEC_TYPEDEF(x) x->select.s._typedef
384 #define SPEC_REGPARM(x) x->select.s._isregparm
385 #define SPEC_ARGREG(x) x->select.s.argreg
386
387 /* type check macros */
388 #define IS_DECL(x)   ( x && x->class == DECLARATOR      )
389 #define IS_SPEC(x)   ( x && x->class == SPECIFIER  )
390 #define IS_ARRAY(x)  (IS_DECL(x) && DCL_TYPE(x) == ARRAY)
391 #define IS_DATA_PTR(x) (IS_DECL(x) && DCL_TYPE(x) == POINTER)
392 #define IS_PTR(x)    (IS_DECL(x) && (DCL_TYPE(x) == POINTER    ||    \
393                                      DCL_TYPE(x) == FPOINTER   ||    \
394                                      DCL_TYPE(x) == GPOINTER   ||    \
395                                      DCL_TYPE(x) == IPOINTER   ||    \
396                                      DCL_TYPE(x) == PPOINTER   ||    \
397                                      DCL_TYPE(x) == EEPPOINTER ||    \
398                                      DCL_TYPE(x) == CPOINTER   ||    \
399                                      DCL_TYPE(x) == UPOINTER  ))
400 #define IS_PTR_CONST(x) (IS_PTR(x) && DCL_PTR_CONST(x))
401 #define IS_FARPTR(x) (IS_DECL(x) && DCL_TYPE(x) == FPOINTER)
402 #define IS_CODEPTR(x) (IS_DECL(x) && DCL_TYPE(x) == CPOINTER)
403 #define IS_GENPTR(x) (IS_DECL(x) && DCL_TYPE(x) == GPOINTER)
404 #define IS_FUNC(x)   (IS_DECL(x) && DCL_TYPE(x) == FUNCTION)
405 #define IS_LONG(x)   (IS_SPEC(x) && x->select.s._long)
406 #define IS_UNSIGNED(x) (IS_SPEC(x) && x->select.s._unsigned)
407 #define IS_TYPEDEF(x)(IS_SPEC(x) && x->select.s._typedef)
408 #define IS_CONSTANT(x)  (IS_SPEC(x) && ( x->select.s._const == 1))
409 #define IS_STRUCT(x) (IS_SPEC(x) && x->select.s.noun == V_STRUCT)
410 #define IS_ABSOLUTE(x)  (IS_SPEC(x) && x->select.s._absadr )
411 #define IS_REGISTER(x)  (IS_SPEC(x) && SPEC_SCLS(x) == S_REGISTER)
412 #define IS_RENT(x)   (IS_SPEC(x) && x->select.s._reent )
413 #define IS_STATIC(x) (IS_SPEC(x) && SPEC_STAT(x))
414 #define IS_INT(x)    (IS_SPEC(x) && x->select.s.noun == V_INT)
415 #define IS_VOID(x)   (IS_SPEC(x) && x->select.s.noun == V_VOID)
416 #define IS_CHAR(x)   (IS_SPEC(x) && x->select.s.noun == V_CHAR)
417 #define IS_EXTERN(x)    (IS_SPEC(x) && x->select.s._extern)
418 #define IS_VOLATILE(x)  (IS_SPEC(x) && x->select.s._volatile )
419 #define IS_INTEGRAL(x) (IS_SPEC(x) && (x->select.s.noun == V_INT ||  \
420                                        x->select.s.noun == V_CHAR || \
421                                        x->select.s.noun == V_BIT ||  \
422                                        x->select.s.noun == V_SBIT ))
423 #define IS_BITFIELD(x) (IS_SPEC(x) && (x->select.s.noun == V_BIT))
424 #define IS_BITVAR(x) (IS_SPEC(x) && (x->select.s.noun  == V_BIT ||   \
425                                      x->select.s.noun == V_SBIT ))
426 #define IS_FLOAT(x)  (IS_SPEC(x) && x->select.s.noun == V_FLOAT)
427 #define IS_ARITHMETIC(x) (IS_INTEGRAL(x) || IS_FLOAT(x))
428 #define IS_AGGREGATE(x) (IS_ARRAY(x) || IS_STRUCT(x))
429 #define IS_LITERAL(x)   (IS_SPEC(x)  && x->select.s.sclass == S_LITERAL)
430 #define IS_CODE(x)      (IS_SPEC(x)  && SPEC_SCLS(x) == S_CODE)
431 #define IS_REGPARM(x)   (IS_SPEC(x) && SPEC_REGPARM(x))
432
433 /* forward declaration for the global vars */
434 extern bucket *SymbolTab[];
435 extern bucket *StructTab[];
436 extern bucket *TypedefTab[];
437 extern bucket *LabelTab[];
438 extern bucket *enumTab[];
439 extern symbol *__fsadd;
440 extern symbol *__fssub;
441 extern symbol *__fsmul;
442 extern symbol *__fsdiv;
443 extern symbol *__fseq;
444 extern symbol *__fsneq;
445 extern symbol *__fslt;
446 extern symbol *__fslteq;
447 extern symbol *__fsgt;
448 extern symbol *__fsgteq;
449
450 /* Dims: mul/div/mod, BYTE/WORD/DWORD, SIGNED/UNSIGNED */
451 extern symbol *__muldiv[3][3][2];
452 /* Dims: BYTE/WORD/DWORD SIGNED/UNSIGNED */
453 extern sym_link *__multypes[3][2];
454 /* Dims: to/from float, BYTE/WORD/DWORD, SIGNED/USIGNED */
455 extern symbol *__conv[2][3][2];
456 /* Dims: shift left/shift right, BYTE/WORD/DWORD, SIGNED/UNSIGNED */
457 extern symbol *__rlrr[2][3][2];
458
459 #define CHARTYPE        __multypes[0][0]
460 #define UCHARTYPE       __multypes[0][1]
461 #define INTTYPE         __multypes[1][0]
462 #define UINTTYPE        __multypes[1][1]
463 #define LONGTYPE        __multypes[2][0]
464 #define ULONGTYPE       __multypes[2][1]
465
466
467 extern sym_link *floatType;
468
469 #include "SDCCval.h"
470
471 /* forward definitions for the symbol table related functions */
472 void initSymt ();
473 symbol *newSymbol (char *, int);
474 sym_link *newLink ();
475 sym_link *newFloatLink ();
476 structdef *newStruct (char *);
477 void addDecl (symbol *, int, sym_link *);
478 sym_link *mergeSpec (sym_link *, sym_link *, char *name);
479 sym_link *cloneSpec (sym_link *);
480 symbol *reverseSyms (symbol *);
481 sym_link *reverseLink (sym_link *);
482 symbol *copySymbol (symbol *);
483 symbol *copySymbolChain (symbol *);
484 void printSymChain (symbol *, int);
485 void printStruct (structdef *, int);
486 char *genSymName (int);
487 sym_link *getSpec (sym_link *);
488 char *genSymName (int);
489 int compStructSize (int, structdef *);
490 sym_link *copyLinkChain (sym_link *);
491 int checkDecl (symbol *, int);
492 void checkBasic (sym_link *, sym_link *);
493 value *checkPointerIval (sym_link *, value *);
494 value *checkStructIval (symbol *, value *);
495 value *checkArrayIval (sym_link *, value *);
496 value *checkIval (sym_link *, value *);
497 unsigned int getSize (sym_link *);
498 unsigned int bitsForType (sym_link *);
499 sym_link *newIntLink ();
500 sym_link *newCharLink ();
501 sym_link *newLongLink ();
502 int compareType (sym_link *, sym_link *);
503 int checkFunction (symbol *, symbol *);
504 void cleanUpLevel (bucket **, int);
505 void cleanUpBlock (bucket **, int);
506 int funcInChain (sym_link *);
507 void addSymChain (symbol *);
508 sym_link *structElemType (sym_link *, value *);
509 symbol *getStructElement (structdef *, symbol *);
510 sym_link *computeType (sym_link *, sym_link *);
511 void processFuncArgs (symbol *);
512 int isSymbolEqual (symbol *, symbol *);
513 int powof2 (unsigned long);
514 void printTypeChain (sym_link *, FILE *);
515 void initCSupport ();
516 void initBuiltIns ();
517 void pointerTypes (sym_link *, sym_link *);
518 void cdbTypeInfo (sym_link *, FILE *);
519 void cdbSymbol (symbol *, FILE *, int, int);
520 void cdbStructBlock (int, FILE *);
521 void initHashT ();
522 bucket *newBucket ();
523 void addSym (bucket **, void *, char *, int, int, int checkType);
524 void deleteSym (bucket **, void *, char *);
525 void *findSym (bucket **, void *, const char *);
526 void *findSymWithLevel (bucket **, struct symbol *);
527 void *findSymWithBlock (bucket **, struct symbol *, int);
528 void changePointer (symbol * sym);
529 void checkTypeSanity(sym_link *etype, char *name);
530 sym_link *typeFromStr (char *) ;
531
532
533 extern char *nounName(sym_link *); /* noun strings */
534 extern void printFromToType (sym_link *, sym_link *);
535
536 #endif