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