fixed the recent bug that disabled the local structure initialisation.
[fw/sdcc] / src / SDCCglue.c
1 /*-------------------------------------------------------------------------
2
3   SDCCglue.c - glues everything we have done together into one file.
4                 Written By -  Sandeep Dutta . sandeep.dutta@usa.net (1998)
5
6    This program is free software; you can redistribute it and/or modify it
7    under the terms of the GNU General Public License as published by the
8    Free Software Foundation; either version 2, or (at your option) any
9    later version.
10
11    This program is distributed in the hope that it will be useful,
12    but WITHOUT ANY WARRANTY; without even the implied warranty of
13    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14    GNU General Public License for more details.
15
16    You should have received a copy of the GNU General Public License
17    along with this program; if not, write to the Free Software
18    Foundation, 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
19
20    In other words, you are welcome to use, share and improve this program.
21    You are forbidden to forbid anyone else to use, share and improve
22    what you give them.   Help stamp out software-hoarding!
23 -------------------------------------------------------------------------*/
24
25 #include "common.h"
26 #include "asm.h"
27 #include <time.h>
28 #include "newalloc.h"
29
30 #if !defined(__BORLANDC__) && !defined(_MSC_VER)
31 #include <unistd.h>
32 #endif
33
34 symbol *interrupts[256];
35
36 void printIval (symbol *, sym_link *, initList *, FILE *);
37 set *publics = NULL;            /* public variables */
38 set *externs = NULL;            /* Varibles that are declared as extern */
39
40 /* TODO: this should be configurable (DS803C90 uses more than 6) */
41 unsigned maxInterrupts = 6;
42 int allocInfo = 1;
43 symbol *mainf;
44 extern char *VersionString;
45 set *tmpfileSet = NULL;         /* set of tmp file created by the compiler */
46 set *tmpfileNameSet = NULL;     /* All are unlinked at close. */
47
48 /*-----------------------------------------------------------------*/
49 /* closeTmpFiles - closes all tmp files created by the compiler    */
50 /*                 because of BRAIN DEAD MS/DOS & CYGNUS Libraries */
51 /*-----------------------------------------------------------------*/
52 DEFSETFUNC (closeTmpFiles)
53 {
54   FILE *tfile = item;
55
56   if (tfile)
57     fclose (tfile);
58
59   return 0;
60 }
61
62 /*-----------------------------------------------------------------*/
63 /* rmTmpFiles - closes all tmp files created by the compiler    */
64 /*                 because of BRAIN DEAD MS/DOS & CYGNUS Libraries */
65 /*-----------------------------------------------------------------*/
66 DEFSETFUNC (rmTmpFiles)
67 {
68   char *name = item;
69
70   if (name)
71     {
72       unlink (name);
73       free (name);
74     }
75   return 0;
76 }
77
78 /*-----------------------------------------------------------------*/
79 /* copyFile - copies source file to destination file               */
80 /*-----------------------------------------------------------------*/
81 void 
82 copyFile (FILE * dest, FILE * src)
83 {
84   int ch;
85
86   rewind (src);
87   while (!feof (src))
88     if ((ch = fgetc (src)) != EOF)
89       fputc (ch, dest);
90 }
91
92 char *
93 aopLiteralLong (value * val, int offset, int size)
94 {
95         char *rs;
96         union {
97                 float f;
98                 unsigned char c[4];
99         }
100         fl;
101
102         if (!val) {
103           // assuming we have been warned before
104           val=constVal("0");
105         }
106
107         /* if it is a float then it gets tricky */
108         /* otherwise it is fairly simple */
109         if (!IS_FLOAT (val->type)) {
110                 unsigned long v = (unsigned long) floatFromVal (val);
111
112                 v >>= (offset * 8);
113                 switch (size) {
114                 case 1:
115                         tsprintf (buffer, "!immedbyte", (unsigned int) v & 0xff);
116                         break;
117                 case 2:
118                         tsprintf (buffer, "!immedword", (unsigned int) v & 0xffff);
119                         break;
120                 default:
121                         /* Hmm.  Too big for now. */
122                         assert (0);
123                 }
124                 rs = Safe_calloc (1, strlen (buffer) + 1);
125                 return strcpy (rs, buffer);
126         }
127
128         /* PENDING: For now size must be 1 */
129         assert (size == 1);
130
131         /* it is type float */
132         fl.f = (float) floatFromVal (val);
133 #ifdef _BIG_ENDIAN
134         tsprintf (buffer, "!immedbyte", fl.c[3 - offset]);
135 #else
136         tsprintf (buffer, "!immedbyte", fl.c[offset]);
137 #endif
138         rs = Safe_calloc (1, strlen (buffer) + 1);
139         return strcpy (rs, buffer);
140 }
141
142 /*-----------------------------------------------------------------*/
143 /* aopLiteral - string from a literal value                        */
144 /*-----------------------------------------------------------------*/
145 char *
146 aopLiteral (value * val, int offset)
147 {
148         return aopLiteralLong (val, offset, 1);
149 }
150
151 /*-----------------------------------------------------------------*/
152 /* emitRegularMap - emit code for maps with no special cases       */
153 /*-----------------------------------------------------------------*/
154 static void 
155 emitRegularMap (memmap * map, bool addPublics, bool arFlag)
156 {
157   symbol *sym, *symIval;
158   ast *ival = NULL;
159   memmap *segment;
160
161   if (addPublics)
162     {
163       /* PENDING: special case here - should remove */
164       if (!strcmp (map->sname, CODE_NAME))
165         tfprintf (map->oFile, "\t!areacode\n", map->sname);
166       else if (!strcmp (map->sname, DATA_NAME))
167         tfprintf (map->oFile, "\t!areadata\n", map->sname);
168       else if (!strcmp (map->sname, HOME_NAME))
169         tfprintf (map->oFile, "\t!areahome\n", map->sname);
170       else
171         tfprintf (map->oFile, "\t!area\n", map->sname);
172     }
173
174   /* print the area name */
175   for (sym = setFirstItem (map->syms); sym;
176        sym = setNextItem (map->syms))
177     {
178
179       /* if extern then add it into the extern list */
180       if (IS_EXTERN (sym->etype))
181         {
182           addSetHead (&externs, sym);
183           continue;
184         }
185
186       /* if allocation required check is needed
187          then check if the symbol really requires
188          allocation only for local variables */
189       if (arFlag && !IS_AGGREGATE (sym->type) &&
190           !(sym->_isparm && !IS_REGPARM (sym->etype)) &&
191           !sym->allocreq && sym->level)
192         continue;
193
194       /* if global variable & not static or extern
195          and addPublics allowed then add it to the public set */
196       if ((sym->level == 0 ||
197            (sym->_isparm && !IS_REGPARM (sym->etype))) &&
198           addPublics &&
199           !IS_STATIC (sym->etype) &&
200           (IS_FUNC(sym->type) ? (sym->used || sym->fbody) : 1))
201         {
202           addSetHead (&publics, sym);
203         }
204
205       /* if extern then do nothing or is a function
206          then do nothing */
207       if (IS_FUNC (sym->type))
208         continue;
209
210       /* print extra debug info if required */
211       if (options.debug) {
212         cdbSymbol (sym, cdbFile, FALSE, FALSE);
213         if (!sym->level) /* global */
214           if (IS_STATIC (sym->etype))
215             fprintf (map->oFile, "F%s$", moduleName); /* scope is file */
216           else
217             fprintf (map->oFile, "G$"); /* scope is global */
218         else
219           /* symbol is local */
220           fprintf (map->oFile, "L%s$", (sym->localof ? sym->localof->name : "-null-"));
221         fprintf (map->oFile, "%s$%d$%d", sym->name, sym->level, sym->block);
222       }
223       
224       /* if is has an absolute address then generate
225          an equate for this no need to allocate space */
226       if (SPEC_ABSA (sym->etype))
227         {
228           if (options.debug) {
229             fprintf (map->oFile, " == 0x%04x\n", SPEC_ADDR (sym->etype));
230           }
231           fprintf (map->oFile, "%s\t=\t0x%04x\n",
232                    sym->rname,
233                    SPEC_ADDR (sym->etype));
234         }
235       else
236         {
237           /* allocate space */
238           if (options.debug) {
239             fprintf (map->oFile, "==.\n");
240           }
241           if (IS_STATIC (sym->etype))
242             tfprintf (map->oFile, "!slabeldef\n", sym->rname);
243           else
244             tfprintf (map->oFile, "!labeldef\n", sym->rname);
245           tfprintf (map->oFile, "\t!ds\n", 
246                     (unsigned int) getSize (sym->type) & 0xffff);
247         }
248
249       /* if it has an initial value then do it only if
250          it is a global variable */
251       if (sym->ival && sym->level == 0)
252         {
253           if (IS_AGGREGATE (sym->type)) {
254             ival = initAggregates (sym, sym->ival, NULL);
255           } else {
256             ival = newNode ('=', newAst_VALUE (symbolVal (sym)),
257                      decorateType (resolveSymbols (list2expr (sym->ival))));
258           }
259           codeOutFile = statsg->oFile;
260           allocInfo = 0;
261
262           // set ival's lineno to where the symbol was defined
263           if (ival) ival->lineno=sym->lineDef;
264           eBBlockFromiCode (iCodeFromAst (ival));
265           allocInfo = 1;
266
267           /* if the ival is a symbol assigned to an aggregate,
268              (bug #458099 -> #462479)
269              we don't need it anymore, so delete it from its segment */
270           if (IS_AST_SYM_VALUE(sym->ival->init.node) &&
271               IS_AGGREGATE (sym->type) ) {
272             symIval=AST_SYMBOL(sym->ival->init.node);
273             segment = SPEC_OCLS (symIval->etype);
274             deleteSetItem (&segment->syms, symIval);
275           }
276
277           sym->ival = NULL;
278         }
279     }
280 }
281
282 /*-----------------------------------------------------------------*/
283 /* initPointer - pointer initialization code massaging             */
284 /*-----------------------------------------------------------------*/
285 value *
286 initPointer (initList * ilist)
287 {
288         value *val;
289         ast *expr = list2expr (ilist);
290         
291         if (!expr)
292                 goto wrong;
293         
294         /* try it the oldway first */
295         if ((val = constExprValue (expr, FALSE)))
296                 return val;
297         
298         /* no then we have to do these cludgy checks */
299         /* pointers can be initialized with address of
300            a variable or address of an array element */
301         if (IS_AST_OP (expr) && expr->opval.op == '&') {
302                 /* address of symbol */
303                 if (IS_AST_SYM_VALUE (expr->left)) {
304                         val = copyValue (AST_VALUE (expr->left));
305                         val->type = newLink ();
306                         if (SPEC_SCLS (expr->left->etype) == S_CODE) {
307                                 DCL_TYPE (val->type) = CPOINTER;
308                                 DCL_PTR_CONST (val->type) = port->mem.code_ro;
309                         }
310                         else if (SPEC_SCLS (expr->left->etype) == S_XDATA)
311                                 DCL_TYPE (val->type) = FPOINTER;
312                         else if (SPEC_SCLS (expr->left->etype) == S_XSTACK)
313                                 DCL_TYPE (val->type) = PPOINTER;
314                         else if (SPEC_SCLS (expr->left->etype) == S_IDATA)
315                                 DCL_TYPE (val->type) = IPOINTER;
316                         else if (SPEC_SCLS (expr->left->etype) == S_EEPROM)
317                                 DCL_TYPE (val->type) = EEPPOINTER;
318                         else
319                                 DCL_TYPE (val->type) = POINTER;
320                         val->type->next = expr->left->ftype;
321                         val->etype = getSpec (val->type);
322                         return val;
323                 }
324
325                 /* if address of indexed array */
326                 if (IS_AST_OP (expr->left) && expr->left->opval.op == '[')
327                         return valForArray (expr->left);
328
329                 /* if address of structure element then
330                    case 1. a.b ; */
331                 if (IS_AST_OP (expr->left) &&
332                     expr->left->opval.op == '.') {
333                         return valForStructElem (expr->left->left,
334                                                  expr->left->right);
335                 }
336
337                 /* case 2. (&a)->b ;
338                    (&some_struct)->element */
339                 if (IS_AST_OP (expr->left) &&
340                     expr->left->opval.op == PTR_OP &&
341                     IS_ADDRESS_OF_OP (expr->left->left))
342                         return valForStructElem (expr->left->left->left,
343                                                  expr->left->right);
344
345         }
346         /* case 3. (((char *) &a) +/- constant) */
347         if (IS_AST_OP (expr) &&
348             (expr->opval.op == '+' || expr->opval.op == '-') &&
349             IS_AST_OP (expr->left) && expr->left->opval.op == CAST &&
350             IS_AST_OP (expr->left->right) &&
351             expr->left->right->opval.op == '&' &&
352             IS_AST_LIT_VALUE (expr->right)) {
353
354                 return valForCastAggr (expr->left->right->left,
355                                        expr->left->left->opval.lnk,
356                                        expr->right, expr->opval.op);
357
358         }
359         
360         /* case 4. (char *)(array type) */
361         if (IS_CAST_OP(expr) && IS_AST_SYM_VALUE (expr->right) &&
362             IS_ARRAY(expr->right->ftype)) {
363
364                 val = copyValue (AST_VALUE (expr->right));
365                 val->type = newLink ();
366                 if (SPEC_SCLS (expr->right->etype) == S_CODE) {
367                         DCL_TYPE (val->type) = CPOINTER;
368                         DCL_PTR_CONST (val->type) = port->mem.code_ro;
369                 }
370                 else if (SPEC_SCLS (expr->right->etype) == S_XDATA)
371                         DCL_TYPE (val->type) = FPOINTER;
372                 else if (SPEC_SCLS (expr->right->etype) == S_XSTACK)
373                         DCL_TYPE (val->type) = PPOINTER;
374                 else if (SPEC_SCLS (expr->right->etype) == S_IDATA)
375                         DCL_TYPE (val->type) = IPOINTER;
376                 else if (SPEC_SCLS (expr->right->etype) == S_EEPROM)
377                         DCL_TYPE (val->type) = EEPPOINTER;
378                 else
379                         DCL_TYPE (val->type) = POINTER;
380                 val->type->next = expr->right->ftype->next;
381                 val->etype = getSpec (val->type);
382                 return val;
383         }
384  wrong:
385         werror (W_INIT_WRONG);
386         return NULL;
387
388 }
389
390 /*-----------------------------------------------------------------*/
391 /* printChar - formats and prints a characater string with DB      */
392 /*-----------------------------------------------------------------*/
393 void 
394 printChar (FILE * ofile, char *s, int plen)
395 {
396   int i;
397   int len = strlen (s);
398   int pplen = 0;
399   char buf[100];
400   char *p = buf;
401
402   while (len && pplen < plen)
403     {
404       i = 60;
405       while (i && *s && pplen < plen)
406         {
407           if (*s < ' ' || *s == '\"' || *s=='\\')
408             {
409               *p = '\0';
410               if (p != buf)
411                 tfprintf (ofile, "\t!ascii\n", buf);
412               tfprintf (ofile, "\t!db !constbyte\n", (unsigned char)*s);
413               p = buf;
414             }
415           else
416             {
417               *p = *s;
418               p++;
419             }
420           s++;
421           pplen++;
422           i--;
423         }
424       if (p != buf)
425         {
426           *p = '\0';
427           tfprintf (ofile, "\t!ascii\n", buf);
428           p = buf;
429         }
430
431       if (len > 60)
432         len -= 60;
433       else
434         len = 0;
435     }
436   tfprintf (ofile, "\t!db !constbyte\n", 0);
437 }
438
439 /*-----------------------------------------------------------------*/
440 /* return the generic pointer high byte for a given pointer type.  */
441 /*-----------------------------------------------------------------*/
442 int 
443 pointerTypeToGPByte (const int p_type, const char *iname, const char *oname)
444 {
445   switch (p_type)
446     {
447     case IPOINTER:
448     case POINTER:
449       return 0;
450     case GPOINTER:
451       /* hack - if we get a generic pointer, we just assume
452        * it's an FPOINTER (i.e. in XDATA space).
453        */
454       werror (E_CANNOT_USE_GENERIC_POINTER, iname, oname);
455       exit (1);
456       // fall through
457     case FPOINTER:
458       return 1;
459     case CPOINTER:
460       return 2;
461     case PPOINTER:
462       return 3;
463     default:
464       fprintf (stderr, "*** internal error: unknown pointer type %d in GPByte.\n",
465                p_type);
466       break;
467     }
468   return -1;
469 }
470
471
472 /*-----------------------------------------------------------------*/
473 /* printPointerType - generates ival for pointer type              */
474 /*-----------------------------------------------------------------*/
475 void 
476 _printPointerType (FILE * oFile, const char *name)
477 {
478   /* if (TARGET_IS_DS390) */
479   if (options.model == MODEL_FLAT24)
480     {
481       fprintf (oFile, "\t.byte %s,(%s >> 8),(%s >> 16)", name, name, name);
482     }
483   else
484     {
485       fprintf (oFile, "\t.byte %s,(%s >> 8)", name, name);
486     }
487 }
488
489 /*-----------------------------------------------------------------*/
490 /* printPointerType - generates ival for pointer type              */
491 /*-----------------------------------------------------------------*/
492 void 
493 printPointerType (FILE * oFile, const char *name)
494 {
495   _printPointerType (oFile, name);
496   fprintf (oFile, "\n");
497 }
498
499 /*-----------------------------------------------------------------*/
500 /* printGPointerType - generates ival for generic pointer type     */
501 /*-----------------------------------------------------------------*/
502 void 
503 printGPointerType (FILE * oFile, const char *iname, const char *oname,
504                    const unsigned int type)
505 {
506   _printPointerType (oFile, iname);
507   fprintf (oFile, ",#0x%02x\n", pointerTypeToGPByte (type, iname, oname));
508 }
509
510 /*-----------------------------------------------------------------*/
511 /* printIvalType - generates ival for int/char                     */
512 /*-----------------------------------------------------------------*/
513 void 
514 printIvalType (sym_link * type, initList * ilist, FILE * oFile)
515 {
516         value *val;
517
518         /* if initList is deep */
519         if (ilist->type == INIT_DEEP)
520                 ilist = ilist->init.deep;
521
522         val = list2val (ilist);
523         switch (getSize (type)) {
524         case 1:
525                 if (!val)
526                         tfprintf (oFile, "\t!db !constbyte\n", 0);
527                 else
528                         tfprintf (oFile, "\t!dbs\n",
529                                   aopLiteral (val, 0));
530                 break;
531
532         case 2:
533                 if (port->use_dw_for_init)
534                         tfprintf (oFile, "\t!dws\n", aopLiteralLong (val, 0, 2));
535                 else
536                         fprintf (oFile, "\t.byte %s,%s\n", aopLiteral (val, 0), aopLiteral (val, 1));
537                 break;
538         case 4:
539                 if (!val) {
540                         tfprintf (oFile, "\t!dw !constword\n", 0);
541                         tfprintf (oFile, "\t!dw !constword\n", 0);
542                 }
543                 else {
544                         fprintf (oFile, "\t.byte %s,%s,%s,%s\n",
545                                  aopLiteral (val, 0), aopLiteral (val, 1),
546                                  aopLiteral (val, 2), aopLiteral (val, 3));
547                 }
548                 break;
549         }
550 }
551
552 /*-----------------------------------------------------------------*/
553 /* printIvalBitFields - generate initializer for bitfields         */
554 /*-----------------------------------------------------------------*/
555 void printIvalBitFields(symbol **sym, initList **ilist, FILE * oFile)
556 {
557         value *val ;
558         symbol *lsym = *sym;
559         initList *lilist = *ilist ;
560         unsigned long ival = 0;
561         int size =0;
562
563         
564         do {
565                 unsigned long i;
566                 val = list2val(lilist);
567                 if (size) {
568                         if (SPEC_BLEN(lsym->etype) > 8) {
569                                 size += ((SPEC_BLEN (lsym->etype) / 8) + 
570                                          (SPEC_BLEN (lsym->etype) % 8 ? 1 : 0));
571                         }
572                 } else {
573                         size = ((SPEC_BLEN (lsym->etype) / 8) + 
574                                  (SPEC_BLEN (lsym->etype) % 8 ? 1 : 0));
575                 }
576                 i = (unsigned long)floatFromVal(val);
577                 i <<= SPEC_BSTR (lsym->etype);
578                 ival |= i;
579                 if (! ( lsym->next &&
580                         (IS_BITFIELD(lsym->next->type)) &&
581                         (SPEC_BSTR(lsym->next->etype)))) break;
582                 lsym = lsym->next;
583                 lilist = lilist->next;
584         } while (1);
585         switch (size) {
586         case 1:
587                 tfprintf (oFile, "\t!db !constbyte\n",ival);
588                 break;
589
590         case 2:
591                 tfprintf (oFile, "\t!dw !constword\n",ival);
592                 break;
593         case 4:
594                 tfprintf (oFile, "\t!db  !constword,!constword\n",
595                          (ival >> 8) & 0xffff, (ival & 0xffff));
596                 break;
597         }
598         *sym = lsym;
599         *ilist = lilist;
600 }
601
602 /*-----------------------------------------------------------------*/
603 /* printIvalStruct - generates initial value for structures        */
604 /*-----------------------------------------------------------------*/
605 void 
606 printIvalStruct (symbol * sym, sym_link * type,
607                  initList * ilist, FILE * oFile)
608 {
609         symbol *sflds;
610         initList *iloop;
611
612         sflds = SPEC_STRUCT (type)->fields;
613         if (ilist->type != INIT_DEEP) {
614                 werror (E_INIT_STRUCT, sym->name);
615                 return;
616         }
617
618         iloop = ilist->init.deep;
619
620         for (; sflds; sflds = sflds->next, iloop = (iloop ? iloop->next : NULL)) {
621                 if (IS_BITFIELD(sflds->type)) {
622                         printIvalBitFields(&sflds,&iloop,oFile);
623                 } else {
624                         printIval (sflds, sflds->type, iloop, oFile);
625                 }
626         }
627         return;
628 }
629
630 /*-----------------------------------------------------------------*/
631 /* printIvalChar - generates initital value for character array    */
632 /*-----------------------------------------------------------------*/
633 int 
634 printIvalChar (sym_link * type, initList * ilist, FILE * oFile, char *s)
635 {
636   value *val;
637   int remain;
638
639   if (!s)
640     {
641
642       val = list2val (ilist);
643       /* if the value is a character string  */
644       if (IS_ARRAY (val->type) && IS_CHAR (val->etype))
645         {
646           if (!DCL_ELEM (type))
647             DCL_ELEM (type) = strlen (SPEC_CVAL (val->etype).v_char) + 1;
648
649           printChar (oFile, SPEC_CVAL (val->etype).v_char, DCL_ELEM (type));
650
651           if ((remain = (DCL_ELEM (type) - strlen (SPEC_CVAL (val->etype).v_char) - 1)) > 0)
652             while (remain--)
653               tfprintf (oFile, "\t!db !constbyte\n", 0);
654
655           return 1;
656         }
657       else
658         return 0;
659     }
660   else
661     printChar (oFile, s, strlen (s) + 1);
662   return 1;
663 }
664
665 /*-----------------------------------------------------------------*/
666 /* printIvalArray - generates code for array initialization        */
667 /*-----------------------------------------------------------------*/
668 void 
669 printIvalArray (symbol * sym, sym_link * type, initList * ilist,
670                 FILE * oFile)
671 {
672   initList *iloop;
673   int lcnt = 0, size = 0;
674
675   /* take care of the special   case  */
676   /* array of characters can be init  */
677   /* by a string                      */
678   if (IS_CHAR (type->next))
679     if (printIvalChar (type,
680                        (ilist->type == INIT_DEEP ? ilist->init.deep : ilist),
681                        oFile, SPEC_CVAL (sym->etype).v_char))
682       return;
683
684   /* not the special case             */
685   if (ilist->type != INIT_DEEP)
686     {
687       werror (E_INIT_STRUCT, sym->name);
688       return;
689     }
690
691   iloop = ilist->init.deep;
692   lcnt = DCL_ELEM (type);
693
694   for (;;)
695     {
696       size++;
697       printIval (sym, type->next, iloop, oFile);
698       iloop = (iloop ? iloop->next : NULL);
699
700
701       /* if not array limits given & we */
702       /* are out of initialisers then   */
703       if (!DCL_ELEM (type) && !iloop)
704         break;
705
706       /* no of elements given and we    */
707       /* have generated for all of them */
708       if (!--lcnt) {
709         /* if initializers left */
710         if (iloop) {
711           werror (W_EXESS_ARRAY_INITIALIZERS, sym->name, sym->lineDef);
712         }
713         break;
714       }
715     }
716
717   /* if we have not been given a size  */
718   if (!DCL_ELEM (type))
719     DCL_ELEM (type) = size;
720
721   return;
722 }
723
724 /*-----------------------------------------------------------------*/
725 /* printIvalFuncPtr - generate initial value for function pointers */
726 /*-----------------------------------------------------------------*/
727 void 
728 printIvalFuncPtr (sym_link * type, initList * ilist, FILE * oFile)
729 {
730   value *val;
731   int dLvl = 0;
732
733   val = list2val (ilist);
734   /* check the types   */
735   if ((dLvl = compareType (val->type, type->next)) <= 0)
736     {
737       tfprintf (oFile, "\t!dw !constword\n", 0);
738       return;
739     }
740
741   /* now generate the name */
742   if (!val->sym)
743     {
744       if (port->use_dw_for_init)
745         {
746           tfprintf (oFile, "\t!dws\n", val->name);
747         }
748       else
749         {
750           printPointerType (oFile, val->name);
751         }
752     }
753   else if (port->use_dw_for_init)
754     {
755       tfprintf (oFile, "\t!dws\n", val->sym->rname);
756     }
757   else
758     {
759       printPointerType (oFile, val->sym->rname);
760     }
761
762   return;
763 }
764
765 /*-----------------------------------------------------------------*/
766 /* printIvalCharPtr - generates initial values for character pointers */
767 /*-----------------------------------------------------------------*/
768 int 
769 printIvalCharPtr (symbol * sym, sym_link * type, value * val, FILE * oFile)
770 {
771   int size = 0;
772
773   /* PENDING: this is _very_ mcs51 specific, including a magic
774      number...
775      It's also endin specific.
776    */
777   size = getSize (type);
778
779   if (val->name && strlen (val->name))
780     {
781       if (size == 1)            /* This appears to be Z80 specific?? */
782         {
783           tfprintf (oFile,
784                     "\t!dbs\n", val->name);
785         }
786       else if (size == FPTRSIZE)
787         {
788           if (port->use_dw_for_init)
789             {
790               tfprintf (oFile, "\t!dws\n", val->name);
791             }
792           else
793             {
794               printPointerType (oFile, val->name);
795             }
796         }
797       else if (size == GPTRSIZE)
798         {
799           int type;
800           if (IS_PTR (val->type)) {
801             type = DCL_TYPE (val->type);
802           } else {
803             type = PTR_TYPE (SPEC_OCLS (val->etype));
804           }
805           if (val->sym && val->sym->isstrlit) {
806             // this is a literal string
807             type=CPOINTER;
808           }
809           printGPointerType (oFile, val->name, sym->name, type);
810         }
811       else
812         {
813           fprintf (stderr, "*** internal error: unknown size in "
814                    "printIvalCharPtr.\n");
815         }
816     }
817   else
818     {
819       /* What is this case? Are these pointers? */
820       switch (size)
821         {
822         case 1:
823           tfprintf (oFile, "\t!dbs\n", aopLiteral (val, 0));
824           break;
825         case 2:
826           if (port->use_dw_for_init)
827             tfprintf (oFile, "\t!dws\n", aopLiteralLong (val, 0, size));
828           else
829             tfprintf (oFile, "\t.byte %s,%s\n",
830                       aopLiteral (val, 0), aopLiteral (val, 1));
831           break;
832         case 3:
833           /* PENDING: 0x02 or 0x%02x, CDATA? */
834           fprintf (oFile, "\t.byte %s,%s,#0x02\n",
835                    aopLiteral (val, 0), aopLiteral (val, 1));
836           break;
837         default:
838           assert (0);
839         }
840     }
841
842   if (val->sym && val->sym->isstrlit && !isinSet(statsg->syms, val->sym)) {
843     addSet (&statsg->syms, val->sym);
844   }
845
846   return 1;
847 }
848
849 /*-----------------------------------------------------------------*/
850 /* printIvalPtr - generates initial value for pointers             */
851 /*-----------------------------------------------------------------*/
852 void 
853 printIvalPtr (symbol * sym, sym_link * type, initList * ilist, FILE * oFile)
854 {
855   value *val;
856   int size;
857
858   /* if deep then   */
859   if (ilist->type == INIT_DEEP)
860     ilist = ilist->init.deep;
861
862   /* function pointer     */
863   if (IS_FUNC (type->next))
864     {
865       printIvalFuncPtr (type, ilist, oFile);
866       return;
867     }
868
869   if (!(val = initPointer (ilist)))
870     return;
871
872   /* if character pointer */
873   if (IS_CHAR (type->next))
874     if (printIvalCharPtr (sym, type, val, oFile))
875       return;
876
877   /* check the type      */
878   if (compareType (type, val->type) == 0)
879     werror (W_INIT_WRONG);
880
881   /* if val is literal */
882   if (IS_LITERAL (val->etype))
883     {
884       switch (getSize (type))
885         {
886         case 1:
887           tfprintf (oFile, "\t!db !constbyte\n", (unsigned int) floatFromVal (val) & 0xff);
888           break;
889         case 2:
890           if (port->use_dw_for_init)
891             tfprintf (oFile, "\t!dws\n", aopLiteralLong (val, 0, 2));
892           else
893             tfprintf (oFile, "\t.byte %s,%s\n", aopLiteral (val, 0), aopLiteral (val, 1));
894           break;
895         case 3:
896           fprintf (oFile, "\t.byte %s,%s,#0x02\n",
897                    aopLiteral (val, 0), aopLiteral (val, 1));
898         }
899       return;
900     }
901
902
903   size = getSize (type);
904
905   if (size == 1)                /* Z80 specific?? */
906     {
907       tfprintf (oFile, "\t!dbs\n", val->name);
908     }
909   else if (size == FPTRSIZE)
910     {
911       if (port->use_dw_for_init) {
912         tfprintf (oFile, "\t!dws\n", val->name);
913       } else {
914         printPointerType (oFile, val->name);
915       }
916     }
917   else if (size == GPTRSIZE)
918     {
919       printGPointerType (oFile, val->name, sym->name,
920                          (IS_PTR (val->type) ? DCL_TYPE (val->type) :
921                           PTR_TYPE (SPEC_OCLS (val->etype))));
922     }
923   return;
924 }
925
926 /*-----------------------------------------------------------------*/
927 /* printIval - generates code for initial value                    */
928 /*-----------------------------------------------------------------*/
929 void 
930 printIval (symbol * sym, sym_link * type, initList * ilist, FILE * oFile)
931 {
932   if (!ilist)
933     return;
934
935   /* if structure then    */
936   if (IS_STRUCT (type))
937     {
938       printIvalStruct (sym, type, ilist, oFile);
939       return;
940     }
941
942   /* if this is a pointer */
943   if (IS_PTR (type))
944     {
945       printIvalPtr (sym, type, ilist, oFile);
946       return;
947     }
948
949   /* if this is an array   */
950   if (IS_ARRAY (type))
951     {
952       printIvalArray (sym, type, ilist, oFile);
953       return;
954     }
955
956   /* if type is SPECIFIER */
957   if (IS_SPEC (type))
958     {
959       printIvalType (type, ilist, oFile);
960       return;
961     }
962 }
963
964 /*-----------------------------------------------------------------*/
965 /* emitStaticSeg - emitcode for the static segment                 */
966 /*-----------------------------------------------------------------*/
967 void 
968 emitStaticSeg (memmap * map, FILE * out)
969 {
970   symbol *sym;
971
972   /*     fprintf(map->oFile,"\t.area\t%s\n",map->sname); */
973   if (!out)
974     out = code->oFile;
975
976   /* for all variables in this segment do */
977   for (sym = setFirstItem (map->syms); sym;
978        sym = setNextItem (map->syms))
979     {
980
981       /* if it is "extern" then do nothing */
982       if (IS_EXTERN (sym->etype))
983         continue;
984
985       /* if it is not static add it to the public
986          table */
987       if (!IS_STATIC (sym->etype))
988         addSetHead (&publics, sym);
989
990       /* print extra debug info if required */
991       if (options.debug) {
992         cdbSymbol (sym, cdbFile, FALSE, FALSE);
993         if (!sym->level)
994           {                     /* global */
995             if (IS_STATIC (sym->etype))
996               fprintf (out, "F%s$", moduleName);        /* scope is file */
997             else
998               fprintf (out, "G$");      /* scope is global */
999           }
1000         else
1001           /* symbol is local */
1002           fprintf (out, "L%s$",
1003                    (sym->localof ? sym->localof->name : "-null-"));
1004         fprintf (out, "%s$%d$%d", sym->name, sym->level, sym->block);
1005       }
1006       
1007       /* if it has an absolute address */
1008       if (SPEC_ABSA (sym->etype))
1009         {
1010           if (options.debug)
1011             fprintf (out, " == 0x%04x\n", SPEC_ADDR (sym->etype));
1012           
1013           fprintf (out, "%s\t=\t0x%04x\n",
1014                    sym->rname,
1015                    SPEC_ADDR (sym->etype));
1016         }
1017       else
1018         {
1019           if (options.debug)
1020             fprintf (out, " == .\n");
1021           
1022           /* if it has an initial value */
1023           if (sym->ival)
1024             {
1025               fprintf (out, "%s:\n", sym->rname);
1026               noAlloc++;
1027               resolveIvalSym (sym->ival);
1028               printIval (sym, sym->type, sym->ival, out);
1029               noAlloc--;
1030             }
1031           else
1032             {
1033               /* allocate space */
1034               fprintf (out, "%s:\n", sym->rname);
1035               /* special case for character strings */
1036               if (IS_ARRAY (sym->type) && IS_CHAR (sym->type->next) &&
1037                   SPEC_CVAL (sym->etype).v_char)
1038                 printChar (out,
1039                            SPEC_CVAL (sym->etype).v_char,
1040                            strlen (SPEC_CVAL (sym->etype).v_char) + 1);
1041               else
1042                 tfprintf (out, "\t!ds\n", (unsigned int) getSize (sym->type) & 0xffff);
1043             }
1044         }
1045     }
1046 }
1047
1048 /*-----------------------------------------------------------------*/
1049 /* emitMaps - emits the code for the data portion the code         */
1050 /*-----------------------------------------------------------------*/
1051 void 
1052 emitMaps ()
1053 {
1054   inInitMode++;
1055   /* no special considerations for the following
1056      data, idata & bit & xdata */
1057   emitRegularMap (data, TRUE, TRUE);
1058   emitRegularMap (idata, TRUE, TRUE);
1059   emitRegularMap (bit, TRUE, FALSE);
1060   emitRegularMap (xdata, TRUE, TRUE);
1061   emitRegularMap (sfr, FALSE, FALSE);
1062   emitRegularMap (sfrbit, FALSE, FALSE);
1063   emitRegularMap (home, TRUE, FALSE);
1064   emitRegularMap (code, TRUE, FALSE);
1065
1066   emitStaticSeg (statsg, code->oFile);
1067   inInitMode--;
1068 }
1069
1070 /*-----------------------------------------------------------------*/
1071 /* flushStatics - flush all currently defined statics out to file  */
1072 /*  and delete.  Temporary function                                */
1073 /*-----------------------------------------------------------------*/
1074 void 
1075 flushStatics (void)
1076 {
1077   emitStaticSeg (statsg, codeOutFile);
1078   statsg->syms = NULL;
1079 }
1080
1081 /*-----------------------------------------------------------------*/
1082 /* createInterruptVect - creates the interrupt vector              */
1083 /*-----------------------------------------------------------------*/
1084 void 
1085 createInterruptVect (FILE * vFile)
1086 {
1087   unsigned i = 0;
1088   mainf = newSymbol ("main", 0);
1089   mainf->block = 0;
1090
1091   /* only if the main function exists */
1092   if (!(mainf = findSymWithLevel (SymbolTab, mainf)))
1093     {
1094       if (!options.cc_only && !noAssemble)
1095         werror (E_NO_MAIN);
1096       return;
1097     }
1098
1099   /* if the main is only a prototype ie. no body then do nothing */
1100   if (!mainf->fbody)
1101     {
1102       /* if ! compile only then main function should be present */
1103       if (!options.cc_only && !noAssemble)
1104         werror (E_NO_MAIN);
1105       return;
1106     }
1107
1108   tfprintf (vFile, "\t!areacode\n", CODE_NAME);
1109   fprintf (vFile, "__interrupt_vect:\n");
1110
1111
1112   if (!port->genIVT || !(port->genIVT (vFile, interrupts, maxInterrupts)))
1113     {
1114       /* "generic" interrupt table header (if port doesn't specify one).
1115
1116        * Look suspiciously like 8051 code to me...
1117        */
1118
1119       fprintf (vFile, "\tljmp\t__sdcc_gsinit_startup\n");
1120
1121
1122       /* now for the other interrupts */
1123       for (; i < maxInterrupts; i++)
1124         {
1125           if (interrupts[i])
1126             fprintf (vFile, "\tljmp\t%s\n\t.ds\t5\n", interrupts[i]->rname);
1127           else
1128             fprintf (vFile, "\treti\n\t.ds\t7\n");
1129         }
1130     }
1131 }
1132
1133 char *iComments1 =
1134 {
1135   ";--------------------------------------------------------\n"
1136   "; File Created by SDCC : FreeWare ANSI-C Compiler\n"};
1137
1138 char *iComments2 =
1139 {
1140   ";--------------------------------------------------------\n"};
1141
1142
1143 /*-----------------------------------------------------------------*/
1144 /* initialComments - puts in some initial comments                 */
1145 /*-----------------------------------------------------------------*/
1146 void 
1147 initialComments (FILE * afile)
1148 {
1149   time_t t;
1150   time (&t);
1151   fprintf (afile, "%s", iComments1);
1152   fprintf (afile, "; Version %s %s\n", VersionString, asctime (localtime (&t)));
1153   fprintf (afile, "%s", iComments2);
1154 }
1155
1156 /*-----------------------------------------------------------------*/
1157 /* printPublics - generates .global for publics                    */
1158 /*-----------------------------------------------------------------*/
1159 void 
1160 printPublics (FILE * afile)
1161 {
1162   symbol *sym;
1163
1164   fprintf (afile, "%s", iComments2);
1165   fprintf (afile, "; Public variables in this module\n");
1166   fprintf (afile, "%s", iComments2);
1167
1168   for (sym = setFirstItem (publics); sym;
1169        sym = setNextItem (publics))
1170     tfprintf (afile, "\t!global\n", sym->rname);
1171 }
1172
1173 /*-----------------------------------------------------------------*/
1174 /* printExterns - generates .global for externs                    */
1175 /*-----------------------------------------------------------------*/
1176 void 
1177 printExterns (FILE * afile)
1178 {
1179   symbol *sym;
1180
1181   fprintf (afile, "%s", iComments2);
1182   fprintf (afile, "; Externals used\n");
1183   fprintf (afile, "%s", iComments2);
1184
1185   for (sym = setFirstItem (externs); sym;
1186        sym = setNextItem (externs))
1187     tfprintf (afile, "\t!global\n", sym->rname);
1188 }
1189
1190 /*-----------------------------------------------------------------*/
1191 /* emitOverlay - will emit code for the overlay stuff              */
1192 /*-----------------------------------------------------------------*/
1193 static void 
1194 emitOverlay (FILE * afile)
1195 {
1196   set *ovrset;
1197
1198   if (!elementsInSet (ovrSetSets))
1199     tfprintf (afile, "\t!area\n", port->mem.overlay_name);
1200
1201   /* for each of the sets in the overlay segment do */
1202   for (ovrset = setFirstItem (ovrSetSets); ovrset;
1203        ovrset = setNextItem (ovrSetSets))
1204     {
1205
1206       symbol *sym;
1207
1208       if (elementsInSet (ovrset))
1209         {
1210           /* this dummy area is used to fool the assembler
1211              otherwise the assembler will append each of these
1212              declarations into one chunk and will not overlay
1213              sad but true */
1214           fprintf (afile, "\t.area _DUMMY\n");
1215           /* output the area informtion */
1216           fprintf (afile, "\t.area\t%s\n", port->mem.overlay_name);     /* MOF */
1217         }
1218
1219       for (sym = setFirstItem (ovrset); sym;
1220            sym = setNextItem (ovrset))
1221         {
1222
1223           /* if extern then add it to the publics tabledo nothing */
1224           if (IS_EXTERN (sym->etype))
1225             continue;
1226
1227           /* if allocation required check is needed
1228              then check if the symbol really requires
1229              allocation only for local variables */
1230           if (!IS_AGGREGATE (sym->type) &&
1231               !(sym->_isparm && !IS_REGPARM (sym->etype))
1232               && !sym->allocreq && sym->level)
1233             continue;
1234
1235           /* if global variable & not static or extern
1236              and addPublics allowed then add it to the public set */
1237           if ((sym->_isparm && !IS_REGPARM (sym->etype))
1238               && !IS_STATIC (sym->etype))
1239             addSetHead (&publics, sym);
1240
1241           /* if extern then do nothing or is a function
1242              then do nothing */
1243           if (IS_FUNC (sym->type))
1244             continue;
1245
1246           /* print extra debug info if required */
1247           if (options.debug)
1248             {
1249               cdbSymbol (sym, cdbFile, FALSE, FALSE);
1250
1251               if (!sym->level)
1252                 {               /* global */
1253                   if (IS_STATIC (sym->etype))
1254                     fprintf (afile, "F%s$", moduleName);        /* scope is file */
1255                   else
1256                     fprintf (afile, "G$");      /* scope is global */
1257                 }
1258               else
1259                 /* symbol is local */
1260                 fprintf (afile, "L%s$",
1261                          (sym->localof ? sym->localof->name : "-null-"));
1262               fprintf (afile, "%s$%d$%d", sym->name, sym->level, sym->block);
1263             }
1264
1265           /* if is has an absolute address then generate
1266              an equate for this no need to allocate space */
1267           if (SPEC_ABSA (sym->etype))
1268             {
1269
1270               if (options.debug)
1271                 fprintf (afile, " == 0x%04x\n", SPEC_ADDR (sym->etype));
1272
1273               fprintf (afile, "%s\t=\t0x%04x\n",
1274                        sym->rname,
1275                        SPEC_ADDR (sym->etype));
1276             }
1277           else
1278             {
1279               if (options.debug)
1280                 fprintf (afile, "==.\n");
1281               
1282               /* allocate space */
1283               tfprintf (afile, "!labeldef\n", sym->rname);
1284               tfprintf (afile, "\t!ds\n", (unsigned int) getSize (sym->type) & 0xffff);
1285             }
1286
1287         }
1288     }
1289 }
1290
1291 /*-----------------------------------------------------------------*/
1292 /* glue - the final glue that hold the whole thing together        */
1293 /*-----------------------------------------------------------------*/
1294 void 
1295 glue ()
1296 {
1297   FILE *vFile;
1298   FILE *asmFile;
1299   FILE *ovrFile = tempfile ();
1300
1301   addSetHead (&tmpfileSet, ovrFile);
1302   /* print the global struct definitions */
1303   if (options.debug)
1304     cdbStructBlock (0, cdbFile);
1305
1306   vFile = tempfile ();
1307   /* PENDING: this isnt the best place but it will do */
1308   if (port->general.glue_up_main)
1309     {
1310       /* create the interrupt vector table */
1311       createInterruptVect (vFile);
1312     }
1313
1314   addSetHead (&tmpfileSet, vFile);
1315
1316   /* emit code for the all the variables declared */
1317   emitMaps ();
1318   /* do the overlay segments */
1319   emitOverlay (ovrFile);
1320
1321   /* now put it all together into the assembler file */
1322   /* create the assembler file name */
1323
1324   if (!options.c1mode)
1325     {
1326       sprintf (scratchFileName, srcFileName);
1327       strcat (scratchFileName, port->assembler.file_ext);
1328     }
1329   else
1330     {
1331       strcpy (scratchFileName, options.out_name);
1332     }
1333
1334   if (!(asmFile = fopen (scratchFileName, "w")))
1335     {
1336       werror (E_FILE_OPEN_ERR, scratchFileName);
1337       exit (1);
1338     }
1339
1340   /* initial comments */
1341   initialComments (asmFile);
1342
1343   /* print module name */
1344   tfprintf (asmFile, "\t!module\n", moduleName);
1345   tfprintf (asmFile, "\t!fileprelude\n");
1346
1347   /* Let the port generate any global directives, etc. */
1348   if (port->genAssemblerPreamble)
1349     {
1350       port->genAssemblerPreamble (asmFile);
1351     }
1352
1353   /* print the global variables in this module */
1354   printPublics (asmFile);
1355   if (port->assembler.externGlobal)
1356     printExterns (asmFile);
1357
1358   /* copy the sfr segment */
1359   fprintf (asmFile, "%s", iComments2);
1360   fprintf (asmFile, "; special function registers\n");
1361   fprintf (asmFile, "%s", iComments2);
1362   copyFile (asmFile, sfr->oFile);
1363
1364   /* copy the sbit segment */
1365   fprintf (asmFile, "%s", iComments2);
1366   fprintf (asmFile, "; special function bits \n");
1367   fprintf (asmFile, "%s", iComments2);
1368   copyFile (asmFile, sfrbit->oFile);
1369
1370   /* copy the data segment */
1371   fprintf (asmFile, "%s", iComments2);
1372   fprintf (asmFile, "; internal ram data\n");
1373   fprintf (asmFile, "%s", iComments2);
1374   copyFile (asmFile, data->oFile);
1375
1376
1377   /* create the overlay segments */
1378   fprintf (asmFile, "%s", iComments2);
1379   fprintf (asmFile, "; overlayable items in internal ram \n");
1380   fprintf (asmFile, "%s", iComments2);
1381   copyFile (asmFile, ovrFile);
1382
1383   /* create the stack segment MOF */
1384   if (mainf && mainf->fbody)
1385     {
1386       fprintf (asmFile, "%s", iComments2);
1387       fprintf (asmFile, "; Stack segment in internal ram \n");
1388       fprintf (asmFile, "%s", iComments2);
1389       fprintf (asmFile, "\t.area\tSSEG\t(DATA)\n"
1390                "__start__stack:\n\t.ds\t1\n\n");
1391     }
1392
1393   /* create the idata segment */
1394   fprintf (asmFile, "%s", iComments2);
1395   fprintf (asmFile, "; indirectly addressable internal ram data\n");
1396   fprintf (asmFile, "%s", iComments2);
1397   copyFile (asmFile, idata->oFile);
1398
1399   /* copy the bit segment */
1400   fprintf (asmFile, "%s", iComments2);
1401   fprintf (asmFile, "; bit data\n");
1402   fprintf (asmFile, "%s", iComments2);
1403   copyFile (asmFile, bit->oFile);
1404
1405   /* if external stack then reserve space of it */
1406   if (mainf && mainf->fbody && options.useXstack)
1407     {
1408       fprintf (asmFile, "%s", iComments2);
1409       fprintf (asmFile, "; external stack \n");
1410       fprintf (asmFile, "%s", iComments2);
1411       fprintf (asmFile, "\t.area XSEG (XDATA)\n");      /* MOF */
1412       fprintf (asmFile, "\t.ds 256\n");
1413     }
1414
1415
1416   /* copy xtern ram data */
1417   fprintf (asmFile, "%s", iComments2);
1418   fprintf (asmFile, "; external ram data\n");
1419   fprintf (asmFile, "%s", iComments2);
1420   copyFile (asmFile, xdata->oFile);
1421
1422   /* copy the interrupt vector table */
1423   if (mainf && mainf->fbody)
1424     {
1425       fprintf (asmFile, "%s", iComments2);
1426       fprintf (asmFile, "; interrupt vector \n");
1427       fprintf (asmFile, "%s", iComments2);
1428       copyFile (asmFile, vFile);
1429     }
1430
1431   /* copy global & static initialisations */
1432   fprintf (asmFile, "%s", iComments2);
1433   fprintf (asmFile, "; global & static initialisations\n");
1434   fprintf (asmFile, "%s", iComments2);
1435
1436   /* Everywhere we generate a reference to the static_name area,
1437    * (which is currently only here), we immediately follow it with a
1438    * definition of the post_static_name area. This guarantees that
1439    * the post_static_name area will immediately follow the static_name
1440    * area.
1441    */
1442   tfprintf (asmFile, "\t!area\n", port->mem.static_name);       /* MOF */
1443   tfprintf (asmFile, "\t!area\n", port->mem.post_static_name);
1444   tfprintf (asmFile, "\t!area\n", port->mem.static_name);
1445
1446   if (mainf && mainf->fbody)
1447     {
1448       fprintf (asmFile, "__sdcc_gsinit_startup:\n");
1449       /* if external stack is specified then the
1450          higher order byte of the xdatalocation is
1451          going into P2 and the lower order going into
1452          spx */
1453       if (options.useXstack)
1454         {
1455           fprintf (asmFile, "\tmov\tP2,#0x%02x\n",
1456                    (((unsigned int) options.xdata_loc) >> 8) & 0xff);
1457           fprintf (asmFile, "\tmov\t_spx,#0x%02x\n",
1458                    (unsigned int) options.xdata_loc & 0xff);
1459         }
1460
1461       /* initialise the stack pointer */
1462       /* if the user specified a value then use it */
1463       if (options.stack_loc)
1464         fprintf (asmFile, "\tmov\tsp,#%d\n", options.stack_loc);
1465       else
1466         /* no: we have to compute it */
1467       if (!options.stackOnData && maxRegBank <= 3)
1468         fprintf (asmFile, "\tmov\tsp,#%d\n", ((maxRegBank + 1) * 8) - 1);
1469       else
1470         fprintf (asmFile, "\tmov\tsp,#__start__stack\n");       /* MOF */
1471
1472       fprintf (asmFile, "\tlcall\t__sdcc_external_startup\n");
1473       fprintf (asmFile, "\tmov\ta,dpl\n");
1474       fprintf (asmFile, "\tjz\t__sdcc_init_data\n");
1475       fprintf (asmFile, "\tljmp\t__sdcc_program_startup\n");
1476       fprintf (asmFile, "__sdcc_init_data:\n");
1477
1478     }
1479   copyFile (asmFile, statsg->oFile);
1480
1481   if (port->general.glue_up_main && mainf && mainf->fbody)
1482     {
1483       /* This code is generated in the post-static area.
1484        * This area is guaranteed to follow the static area
1485        * by the ugly shucking and jiving about 20 lines ago.
1486        */
1487       tfprintf (asmFile, "\t!area\n", port->mem.post_static_name);
1488       fprintf (asmFile, "\tljmp\t__sdcc_program_startup\n");
1489     }
1490
1491   fprintf (asmFile,
1492            "%s"
1493            "; Home\n"
1494            "%s", iComments2, iComments2);
1495   tfprintf (asmFile, "\t!areahome\n", HOME_NAME);
1496   copyFile (asmFile, home->oFile);
1497
1498   /* copy over code */
1499   fprintf (asmFile, "%s", iComments2);
1500   fprintf (asmFile, "; code\n");
1501   fprintf (asmFile, "%s", iComments2);
1502   tfprintf (asmFile, "\t!areacode\n", CODE_NAME);
1503   if (mainf && mainf->fbody)
1504     {
1505
1506       /* entry point @ start of CSEG */
1507       fprintf (asmFile, "__sdcc_program_startup:\n");
1508
1509       /* put in the call to main */
1510       fprintf (asmFile, "\tlcall\t_main\n");
1511       if (options.mainreturn)
1512         {
1513
1514           fprintf (asmFile, ";\treturn from main ; will return to caller\n");
1515           fprintf (asmFile, "\tret\n");
1516
1517         }
1518       else
1519         {
1520
1521           fprintf (asmFile, ";\treturn from main will lock up\n");
1522           fprintf (asmFile, "\tsjmp .\n");
1523         }
1524     }
1525   copyFile (asmFile, code->oFile);
1526
1527   fclose (asmFile);
1528   applyToSet (tmpfileSet, closeTmpFiles);
1529   applyToSet (tmpfileNameSet, rmTmpFiles);
1530 }
1531
1532 #if defined (__MINGW32__) || defined (__CYGWIN__) || defined (_MSC_VER)
1533 void
1534 rm_tmpfiles (void)
1535 {
1536   applyToSet (tmpfileSet, closeTmpFiles);
1537   applyToSet (tmpfileNameSet, rmTmpFiles);
1538 }
1539 #endif
1540
1541 /** Creates a temporary file a'la tmpfile which avoids the bugs
1542     in cygwin wrt c:\tmp.
1543     Scans, in order: TMP, TEMP, TMPDIR, else uses tmpfile().
1544 */
1545 FILE *
1546 tempfile (void)
1547 {
1548 #if !defined(_MSC_VER)
1549   const char *tmpdir = NULL;
1550   if (getenv ("TMP"))
1551     tmpdir = getenv ("TMP");
1552   else if (getenv ("TEMP"))
1553     tmpdir = getenv ("TEMP");
1554   else if (getenv ("TMPDIR"))
1555     tmpdir = getenv ("TMPDIR");
1556   if (tmpdir)
1557     {
1558       char *name = tempnam (tmpdir, "sdcc");
1559       if (name)
1560         {
1561           FILE *fp = fopen (name, "w+b");
1562           if (fp)
1563             {
1564               addSetHead (&tmpfileNameSet, name);
1565             }
1566           return fp;
1567         }
1568       return NULL;
1569     }
1570 #endif
1571   return tmpfile ();
1572 }
1573
1574 char *
1575 gc_strdup (const char *s)
1576 {
1577   char *ret;
1578   ret = Safe_calloc (1, strlen (s) + 1);
1579   strcpy (ret, s);
1580   return ret;
1581 }