From: tecodev Date: Thu, 30 Nov 2006 13:51:34 +0000 (+0000) Subject: * src/pic/device.c (create_pic,ram_map): add memRange entries to PIC X-Git-Url: https://git.gag.com/?a=commitdiff_plain;h=47c9147ac257a687afd30f488531482ded6a7805;p=fw%2Fsdcc * src/pic/device.c (create_pic,ram_map): add memRange entries to PIC (pic14_getSharebankSize, pic14_getSharebankAddress): replaced with (pic14_hasSharebank,pic14_isShared,pic14_allRAMShared, pic14_getSharedStack): NEW, evaluate the memRange entries to locate a sharebank, use a non-shared bank for the stack if none available * src/pic/device.h (struct memRange): added linked list next field, added prototypes for above functions * src/pic/ralloc.c (initStack): handle shared and banked stacks, (typeRegWithIdx): accept fixed and unfixed stack registers * src/pic/pcode.c (pCodeInitRegisters): use new functions to create the stack, handle shared and banked stack (except for WSAVE), (insertBankSel): removed useless optimization (will never fire), (FixRegisterBanking): added optimization for devices with only one possibly aliased bank of memory, like 16f84 * src/pic/glue.c (pic14_constructAbsMap): back to udata_ovr, as some devices have no SHAREBANK in the linker script * device/include/pic/pic14devices.txt: documented memmap * device/lib/pic/libdev/Makefile.in: removed --stack-loc again git-svn-id: https://sdcc.svn.sourceforge.net/svnroot/sdcc/trunk/sdcc@4494 4a8a32a2-be11-0410-ad9d-d568d2c75423 --- diff --git a/ChangeLog b/ChangeLog index 7b325ee1..c2b6dffa 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,24 @@ +2006-11-30 Raphael Neider + + * src/pic/device.c (create_pic,ram_map): add memRange entries to PIC + (pic14_getSharebankSize, pic14_getSharebankAddress): replaced with + (pic14_hasSharebank,pic14_isShared,pic14_allRAMShared, + pic14_getSharedStack): NEW, evaluate the memRange entries to locate + a sharebank, use a non-shared bank for the stack if none available + * src/pic/device.h (struct memRange): added linked list next field, + added prototypes for above functions + * src/pic/ralloc.c (initStack): handle shared and banked stacks, + (typeRegWithIdx): accept fixed and unfixed stack registers + * src/pic/pcode.c (pCodeInitRegisters): use new functions to create + the stack, handle shared and banked stack (except for WSAVE), + (insertBankSel): removed useless optimization (will never fire), + (FixRegisterBanking): added optimization for devices with only one + possibly aliased bank of memory, like 16f84 + * src/pic/glue.c (pic14_constructAbsMap): back to udata_ovr, as some + devices have no SHAREBANK in the linker script + * device/include/pic/pic14devices.txt: documented memmap + * device/lib/pic/libdev/Makefile.in: removed --stack-loc again + 2006-11-30 Erik Petrich * src/hc08/gen.c (transferRegReg, loadRegFromAop, forceStackedAop, @@ -10,7 +31,6 @@ a volatile result (SF Open Discussion forum thread #1616749). Single byte case is not yet optimized. - 2006-11-28 Maarten Brock * device/include/asm/mcs51/features.h, diff --git a/device/include/pic/pic14devices.txt b/device/include/pic/pic14devices.txt index e4ae134c..c76c5a81 100644 --- a/device/include/pic/pic14devices.txt +++ b/device/include/pic/pic14devices.txt @@ -16,6 +16,9 @@ # confsiz = 1: config at 0x2007, 2: has an extra config register at 0x2008 # regmap = registers duplicated in multiple banks. First value is a bank bitmask, # following values are register addresses +# memmap +# - mirrored in all banks set in +# is a bitmask of bank bits (0x80, 0x100, 0x180) # # diff --git a/device/lib/pic/libdev/Makefile.in b/device/lib/pic/libdev/Makefile.in index 288edf93..cf9bc296 100644 --- a/device/lib/pic/libdev/Makefile.in +++ b/device/lib/pic/libdev/Makefile.in @@ -27,7 +27,7 @@ pic%.c : $(GPUTILS)/header/p%.inc endif pic%.o : pic%.c - -$(CC) $(CPPFLAGS) $(CFLAGS) -mpic14 -p$* --stack-loc 0x4f -o "$@" -c "$<" + -$(CC) $(CPPFLAGS) $(CFLAGS) -mpic14 -p$* -o "$@" -c "$<" $(INSTALL_DIR)/%.lib : %.o -$(LIB) -c "$@" "$<"; diff --git a/src/pic/device.c b/src/pic/device.c index d6b49392..e26ed9fd 100644 --- a/src/pic/device.c +++ b/src/pic/device.c @@ -62,6 +62,7 @@ AssignedMemory *finalMapping=NULL; static unsigned int config_word = DEFAULT_CONFIG_WORD; static unsigned int config2_word = DEFAULT_CONFIG2_WORD; +static memRange *rangeRAM = NULL; extern int pic14_is_shared (regs *reg); extern void emitSymbolToFile (FILE *of, const char *name, const char *section_type, int size, int addr, int useEQU, int globalize); @@ -141,6 +142,8 @@ static PIC_device *create_pic(char *pic_name, int maxram, int bankmsk, int confs new_pic->dataMemSize = data; new_pic->eepromMemSize = eeprom; new_pic->ioPins = io; + + new_pic->ram = rangeRAM; Pics[num_of_supported_PICS] = new_pic; num_of_supported_PICS++; @@ -176,19 +179,26 @@ static void register_map(int num_words, char word[SPLIT_WORDS_MAX][PIC14_STRING_ /* define ram areas - may be duplicated across banks */ static void ram_map(int num_words, char word[SPLIT_WORDS_MAX][PIC14_STRING_LEN]) { - memRange r; + memRange *r; if (num_words < 4) { fprintf(stderr, "WARNING: not enough values in %s memmap directive\n", DEVICE_FILE_NAME); return; } + + r = Safe_calloc(1, sizeof(memRange)); + //fprintf (stderr, "%s: %s %s %s\n", __FUNCTION__, word[1], word[2], word[3]); - r.start_address = parse_config_value(word[1]); - r.end_address = parse_config_value(word[2]); - r.alias = parse_config_value(word[3]); - r.bank = (r.start_address >> 7) & 3; + r->start_address = parse_config_value(word[1]); + r->end_address = parse_config_value(word[2]); + r->alias = parse_config_value(word[3]); + r->bank = (r->start_address >> 7) & 3; - addMemRange(&r, 0); + addMemRange(r, 0); + + // add memRange to device entry for future lookup (sharebanks) + r->next = rangeRAM; + rangeRAM = r; } extern set *includeDirsSet; @@ -404,6 +414,8 @@ void addMemRange(memRange *r, int type) { int i; int alias = r->alias; + + //fprintf (stderr, "%s: range %x..%x, alias %x, bank %x\n", __FUNCTION__, r->start_address, r->end_address, r->alias, r->bank); if (maxRAMaddress < 0) { fprintf(stderr, "missing maxram setting in %s\n", DEVICE_FILE_NAME); @@ -710,7 +722,7 @@ void list_valid_pics(int ncols) /*-----------------------------------------------------------------* * *-----------------------------------------------------------------*/ -void init_pic(char *pic_type) +PIC_device *init_pic(char *pic_type) { char long_name[PIC14_STRING_LEN]; @@ -730,6 +742,7 @@ void init_pic(char *pic_type) exit(1); } } + return pic; } /*-----------------------------------------------------------------* @@ -1021,45 +1034,110 @@ int pic14_getHasSecondConfigReg(void) } /*-----------------------------------------------------------------* - * Query the size of the sharebank of the selected device. - * FIXME: Currently always returns 16. + * True iff the device has memory aliased in every bank. + * If true, low and high will be set to the low and high address + * occupied by the (last) sharebank found. *-----------------------------------------------------------------*/ -int pic14_getSharebankSize(void) +int pic14_hasSharebank(int *low, int *high, int *size) { - if (options.stack_size <= 0) { - // default size: 16 bytes - return 16; - } else { - return options.stack_size; - } + memRange *r; + + assert(pic); + r = pic->ram; + + while (r) { + //fprintf (stderr, "%s: region %x..%x, bank %x, alias %x, pic->bankmask %x\n", __FUNCTION__, r->start_address, r->end_address, r->bank, r->alias, pic->bankMask); + if (r->alias == pic->bankMask) { + if (low) *low = r->start_address; + if (high) *high = r->end_address; + if (size) *size = r->end_address - r->start_address + 1; + return 1; + } // if + r = r->next; + } // while + + if (low) *low = 0x0; + if (high) *high = 0x0; + if (size) *size = 0x0; + //fprintf (stderr, "%s: no shared bank found\n", __FUNCTION__); + return 0; } -/*-----------------------------------------------------------------* - * Query the highest byte address occupied by the sharebank of the - * selected device. - * THINK: Might not be needed, if we assign all shareable objects to - * a `udata_shr' section and let the linker do the rest... - * Tried it, but yields `no target memory available' for pic16f877... - *-----------------------------------------------------------------*/ -int pic14_getSharebankAddress(void) +/* + * True iff the memory region [low, high] is aliased in all banks. + */ +int pic14_isShared(int low, int high) { - int sharebankAddress = 0x7f; - if (options.stack_loc != 0) { - // permanent (?) workaround for pic16f84a-like devices with hardly - // any memory: - // 0x00-0x0B SFR - // 0x0C-0x4F memory, - // 0x50-0x7F unimplemented (reads as 0), - // 0x80-0x8B SFRs (partly mapped to 0x0?) - // 0x8c-0xCF mapped to 0x0C-0x4F - sharebankAddress = options.stack_loc + pic14_getSharebankSize() - 1; - } else { - /* If total RAM is less than 0x7f as with 16f84 then reduce - * sharebankAddress to fit */ - if ((unsigned)sharebankAddress > pic14_getMaxRam()) - sharebankAddress = (int)pic14_getMaxRam(); - } - return sharebankAddress; + memRange *r; + + assert(pic); + r = pic->ram; + + while (r) { + //fprintf (stderr, "%s: region %x..%x, bank %x, alias %x, pic->bankmask %x\n", __FUNCTION__, r->start_address, r->end_address, r->bank, r->alias, pic->bankMask); + if ((r->alias == pic->bankMask) && (r->start_address <= low) && (r->end_address >= high)) { + return 1; + } // if + r = r->next; + } // while + + return 0; +} + +/* + * True iff all RAM is aliased in all banks (no BANKSELs required except for + * SFRs). + */ +int pic14_allRAMShared(void) +{ + memRange *r; + + assert(pic); + r = pic->ram; + + while (r) { + if (r->alias != pic->bankMask) return 0; + r = r->next; + } // while + + return 1; +} + +/* + * True iff the pseudo stack is a sharebank --> let linker place it. + * [low, high] denotes a size byte long block of (shared or banked) + * memory to be used. + */ +int pic14_getSharedStack(int *low, int *high, int *size) +{ + int haveShared; + int l, h, s; + + haveShared = pic14_hasSharebank(&l, &h, &s); + if ((options.stack_loc != 0) || !haveShared) + { + // sharebank not available or not to be used + s = options.stack_size ? options.stack_size : 0x10; + l = options.stack_loc ? options.stack_loc : 0x20; + h = (options.stack_loc ? options.stack_loc : 0x20) + s - 1; + if (low) *low = l; + if (high) *high = h; + if (size) *size = s; + // return 1 iff [low, high] is present in all banks + //fprintf(stderr, "%s: low %x, high %x, size %x, shared %d\n", __FUNCTION__, l, h, s, pic14_isShared(l, h)); + return (pic14_isShared(l, h)); + } else { + // sharebanks available for use by the stack + if (options.stack_size) s = options.stack_size; + else if (!s || s > 16) s = 16; // limit stack to 16 bytes in SHAREBANK + + // provide addresses for sharebank + if (low) *low = l; + if (high) *high = l + s - 1; + if (size) *size = s; + //fprintf(stderr, "%s: low %x, high %x, size %x, shared 1\n", __FUNCTION__, l, h, s); + return 1; + } } PIC_device * pic14_getPIC(void) diff --git a/src/pic/device.h b/src/pic/device.h index ad8a890d..e2b118d9 100644 --- a/src/pic/device.h +++ b/src/pic/device.h @@ -44,6 +44,7 @@ typedef struct memRange { * e.g. alias = 0x80 means start_address is identical * to the memory location at (0x80 | start_address) */ int bank; /* PIC memory bank this range occupies */ + struct memRange *next; /* linked list */ } memRange; @@ -110,10 +111,12 @@ void setDefMaxRam(void); void pic14_assignConfigWordValue(int address, int value); int pic14_emitConfigWord (FILE * vFile); int pic14_getConfigWord(int address); + unsigned pic14_getMaxRam(void); int pic14_getHasSecondConfigReg(void); -int pic14_getSharebankSize(void); -int pic14_getSharebankAddress(void); +int pic14_allRAMShared(void); +int pic14_hasSharebank(int *low, int *high, int *size); +int pic14_getSharedStack(int *low, int *high, int *size); PIC_device * pic14_getPIC(void); #endif /* __DEVICE_H__ */ diff --git a/src/pic/glue.c b/src/pic/glue.c index 15f11811..2267da2e 100644 --- a/src/pic/glue.c +++ b/src/pic/glue.c @@ -73,8 +73,6 @@ extern void printChar (FILE * ofile, char *s, int plen); void pCodeInitRegisters(void); int getConfigWord(int address); int getHasSecondConfigReg(void); -int pic14_getSharebankSize(void); -int pic14_getSharebankAddress(void); char *udata_section_name=0; // FIXME Temporary fix to change udata section name -- VR int pic14_hasInterrupt = 0; // Indicates whether to emit interrupt handler or not @@ -238,6 +236,8 @@ pic14_constructAbsMap (FILE *ofile) set *aliases; int addr, min=-1, max=-1; int size; + PIC_device *pic; + int low, high, shared; for (i=0; maps[i] != NULL; i++) { @@ -314,20 +314,32 @@ pic14_constructAbsMap (FILE *ofile) * required by larger devices but only up to STK03 might * be defined using smaller devices. */ fprintf (ofile, "\n"); + shared = pic14_getSharedStack(&low, &high, &size); if (!pic14_options.isLibrarySource) { + pic = pic14_getPIC(); + fprintf (ofile, "\tglobal PSAVE\n"); fprintf (ofile, "\tglobal SSAVE\n"); fprintf (ofile, "\tglobal WSAVE\n"); - for (i=pic14_getSharebankSize()-4; i >= 0; i--) { + for (i = size - 4; i >= 0; i--) { fprintf (ofile, "\tglobal STK%02d\n", i); } // for i - fprintf (ofile, "sharebank udata_shr\n");//pic14_getSharebankAddress() - pic14_getSharebankSize()); + + // 16f84 has no SHAREBANK (in linkerscript) but memory aliased in two + // banks, sigh... + if (1 || !shared) { + // for single banked devices: use normal, "banked" RAM + fprintf (ofile, "sharebank udata_ovr 0x%04X\n", low); + } else { + // for devices with at least two banks, require a sharebank section + fprintf (ofile, "sharebank udata_shr\n"); + } fprintf (ofile, "PSAVE\tres 1\n"); fprintf (ofile, "SSAVE\tres 1\n"); fprintf (ofile, "WSAVE\tres 1\n"); // WSAVE *must* be in sharebank (IRQ handlers) /* fill rest of sharebank with stack STKxx .. STK00 */ - for (i=pic14_getSharebankSize()-4; i >= 0; i--) { + for (i = size - 4; i >= 0; i--) { fprintf (ofile, "STK%02d\tres 1\n", i); } // for i } else { @@ -336,7 +348,7 @@ pic14_constructAbsMap (FILE *ofile) fprintf (ofile, "\textern PSAVE\n"); fprintf (ofile, "\textern SSAVE\n"); fprintf (ofile, "\textern WSAVE\n"); - for (i=pic14_getSharebankSize()-4; i >= 0; i--) { + for (i = size - 4; i >= 0; i--) { char buffer[128]; SNPRINTF(&buffer[0], 127, "STK%02d", i); fprintf (ofile, "\textern %s\n", &buffer[0]); diff --git a/src/pic/pcode.c b/src/pic/pcode.c index 9f395b10..100a5f76 100644 --- a/src/pic/pcode.c +++ b/src/pic/pcode.c @@ -1335,34 +1335,32 @@ void SAFE_snprintf(char **str, size_t *size, const char *format, ...) #endif // HAVE_VSNPRINTF -extern void initStack(int base_address, int size); +extern void initStack(int base_address, int size, int shared); extern regs *allocProcessorRegister(int rIdx, char * name, short po_type, int alias); extern regs *allocInternalRegister(int rIdx, char * name, PIC_OPTYPE po_type, int alias); -extern void init_pic(char *); +extern PIC_device *init_pic(char *); void pCodeInitRegisters(void) { static int initialized=0; - int shareBankAddress,stkSize; + int shareBankAddress, stkSize, haveShared; + PIC_device *pic; if(initialized) return; initialized = 1; - init_pic(port->processor); - /* FIXME - some PIC ICs like 16C7X which do not have a shared bank - * need a different approach. - * The fixed address might not be needed anyway, possibly the - * linker will assign udata_shr sections correctly... */ - shareBankAddress = pic14_getSharebankAddress(); + pic = init_pic(port->processor); + haveShared = pic14_getSharedStack(NULL, &shareBankAddress, &stkSize); /* Set pseudo stack size to SHAREBANKSIZE - 3. * On multi memory bank ICs this leaves room for WSAVE/SSAVE/PSAVE * (used for interrupts) to fit into the shared portion of the - * memory bank */ - stkSize = pic14_getSharebankSize()-3; - /* Putting the pseudo stack in shared memory so all modules use the same register when passing fn parameters */ - initStack(shareBankAddress, stkSize); + * memory bank. */ + stkSize = stkSize - 3; + assert(stkSize >= 0); + initStack(shareBankAddress, stkSize, haveShared); + /* TODO: Read aliases for SFRs from regmap lines in device description. */ pc_status.r = allocProcessorRegister(IDX_STATUS,"STATUS", PO_STATUS, 0x180); pc_pcl.r = allocProcessorRegister(IDX_PCL,"PCL", PO_PCL, 0x80); pc_pclath.r = allocProcessorRegister(IDX_PCLATH,"PCLATH", PO_PCLATH, 0x180); @@ -1377,9 +1375,12 @@ void pCodeInitRegisters(void) pc_pcl.rIdx = IDX_PCL; pc_pclath.rIdx = IDX_PCLATH; - pc_wsave.r = allocInternalRegister(IDX_WSAVE,pc_wsave.pcop.name,pc_wsave.pcop.type, 0x180); /* Interrupt storage for working register - must be same address in all banks ie section SHAREBANK. */ - pc_ssave.r = allocInternalRegister(IDX_SSAVE,pc_ssave.pcop.name,pc_ssave.pcop.type, 0); /* Interrupt storage for status register. */ - pc_psave.r = allocInternalRegister(IDX_PSAVE,pc_psave.pcop.name,pc_psave.pcop.type, 0); /* Interrupt storage for pclath register. */ + /* Interrupt storage for working register - must be same address in all banks ie section SHAREBANK. */ + pc_wsave.r = allocInternalRegister(IDX_WSAVE,pc_wsave.pcop.name,pc_wsave.pcop.type, pic ? pic->bankMask : 0x180); + /* Interrupt storage for status register. */ + pc_ssave.r = allocInternalRegister(IDX_SSAVE,pc_ssave.pcop.name,pc_ssave.pcop.type, (pic && haveShared) ? pic->bankMask : 0); + /* Interrupt storage for pclath register. */ + pc_psave.r = allocInternalRegister(IDX_PSAVE,pc_psave.pcop.name,pc_psave.pcop.type, (pic && haveShared) ? pic->bankMask : 0); pc_wsave.rIdx = pc_wsave.r->rIdx; pc_ssave.rIdx = pc_ssave.r->rIdx; @@ -4608,8 +4609,6 @@ static void insertBankSel(pCodeInstruction *pci, const char *name) pCodeOp *pcop; - // This is a NOP for single-banked devices. - if (pic14_getMaxRam() < 0x80) return; // Never BANKSEL STATUS, this breaks all kinds of code (e.g., interrupt handlers). if (!strcmp("STATUS", name) || !strcmp("_STATUS", name)) return; @@ -4648,6 +4647,7 @@ void FixRegisterBanking(pBlock *pb) regs *reg; const char *cur_bank, *new_bank; unsigned cur_mask, new_mask, max_mask; + int allRAMmshared; if (!pb) return; @@ -4655,6 +4655,8 @@ void FixRegisterBanking(pBlock *pb) cur_mask = max_mask; cur_bank = NULL; + allRAMmshared = pic14_allRAMShared(); + for (pc = pb->pcHead; pc; pc = pc->next) { // this one has a label---might check bank at all jumps here... @@ -4702,6 +4704,16 @@ void FixRegisterBanking(pBlock *pb) continue; } + // only one bank of memory and no SFR accessed? + // XXX: We can do better with fixed registers. + if (allRAMmshared && reg && (reg->type != REG_SFR) && (!reg->isFixed)) { + // no BANKSEL required + addpCodeComment(pc->prev, "BANKOPT1b BANKSEL dropped; %s present in all of %s's banks", new_bank, cur_bank); + continue; + } + + // restrict cur_mask to cover only the banks this register + // is in (as well as the previous registers) cur_mask &= new_mask; if (sameBank(reg, new_bank, cur_bank)) { diff --git a/src/pic/ralloc.c b/src/pic/ralloc.c index cf27a623..eae51ef0 100644 --- a/src/pic/ralloc.c +++ b/src/pic/ralloc.c @@ -26,6 +26,7 @@ #include "common.h" #include "ralloc.h" +#include "device.h" #include "pcode.h" #include "gen.h" @@ -487,11 +488,13 @@ regFindFree (set *dRegs) /*-----------------------------------------------------------------*/ /* initStack - allocate registers for a pseudo stack */ /*-----------------------------------------------------------------*/ -void initStack(int base_address, int size) +void initStack(int base_address, int size, int shared) { int i; - + PIC_device *pic; + + pic = pic14_getPIC(); Gstack_base_addr = base_address; Gstack_size = size; //fprintf(stderr,"initStack [base:0x%02x, size:%d]\n", base_address, size); @@ -500,9 +503,9 @@ void initStack(int base_address, int size) char buffer[16]; regs *r; SNPRINTF(&buffer[0], 16, "STK%02d", i); - // Trying to use shared memory for pseudo stack - r = newReg(REG_STK, PO_GPR_TEMP, base_address--, buffer, 1, 0x180); - r->isFixed = 0; // fixed location no longer required + // multi-bank device, sharebank prohibited by user + r = newReg(REG_STK, PO_GPR_TEMP, base_address--, buffer, 1, shared ? (pic ? pic->bankMask : 0x180) : 0x0); + r->isFixed = 1; r->isPublic = 1; r->isEmitted = 1; //r->name[0] = 's'; @@ -898,6 +901,10 @@ typeRegWithIdx (int idx, int type, int fixed) if( (dReg = regWithIdx ( dynStackRegs, idx, 0)) != NULL ) { debugLog ("Found a Stack Register!\n"); return dReg; + } else + if( (dReg = regWithIdx ( dynStackRegs, idx, 1)) != NULL ) { + debugLog ("Found a Stack Register!\n"); + return dReg; } else { werror (E_STACK_OUT, "Register");