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