/* EPC Imp to C Translation Release 4 Version Apr 95 */ #include "imptoc.h" /* *********************************** */ /* * * */ /* * ELF PUT INTERFACE * */ /* * * */ /* * Produces to UNIX5ABI * */ /* * Object Compatibility Standard * */ /* * Release 1.0 Jan 90 * */ /* * * */ /* *********************************** */ /* */ /* elfput17.6*/ /* Added changes for DGUXrevendian hiiden behind #ifdef DGUXRE */ /* which may be set by -D at compile time or in the elf.p6.h include */ /* elfput17.4*/ /* Checks added that dictstart initialised and also some F90 changes */ /* from AndyK have been merged in */ /* Added psetfiles2 which returns the file descriptor */ /* Used eprocs external Pic and dropped our own static int */ /* elfput17.3*/ /* 31May96 Extra test in PPproc for case when dict has not been initialised */ /* Added routine Psettargetflags */ /* elfput17.2*/ /* 21Jan96 Saved Lastca when pushing and popping files to avoid unwanted */ /* overwriting of line nos */ /* Used unaligned fix for line number tables. Sparc linker */ /* objects in the table is not aligned and word fix used(pds) */ /* elfput17.1*/ /* 17Jan96 Reset lastline to -1 in Ppushfile. (AHi) */ /* 17Jan96 Remove code to word align individual line number tables in */ /* Ppushfile. This did not seem to be required and was upsetting */ /* dump utilities. (AHi) */ /* elfput17 */ /* 25Oct95 Added code to deal with tags section for PPC by amending 88k */ /* Tdesc section. Relaxed restrictions on fixing initialised */ /* common area. Added Pcdataarea in place on unused PCcommon */ /* elfput16.2*/ /* 11Aug95 Added the swopping routines and call of Eswapmode so put */ /* will work correctly when compiling in cross Endian mode */ /* elfput16.1*/ /* 27Jly95 Correction to the new line no tables */ /* elfput16 */ /* 21Jly95 Substantial changes to line no tables. Newrts Ppushfile */ /* & ppopfile added. Also Pgivecurrentsize. These are to */ /* support debugging of source in included textfiles(pds) */ /* elfput15 */ /* 26Jun95 Added Tdesc sections for M88k which need relocation(pds) */ /* elfput14.9*/ /* 22Jun95 C++/Pascal/Imp merger. (mcb) */ /* 24Apr95 Close object file at end Pgenerateobject */ /* elfput14.8 */ /* 17Apr95 Template repository (CDM) */ /* PReinitialise */ /* Area tables zeroed when freed */ /* Remaining area tables freed and zeroed at Pgenerate exit */ /* Rels malloced space remembered and freed at Pgenerate exit */ /* Fix to 'expand area' for zeroth area. */ /* Psetfiles creates necessary path components */ /* elfput14.7*/ /* 21Mar95 Added 5 additional symbols for m88k which does not deal */ /* with offsets correctly in PIC mode */ /* elfput14.6*/ /* 24Feb95 Added very hairy optimisation of local calls on MIPS. */ /* see commentary when processing relocations circa line 3890 */ /* elfput14.5*/ /* 13Feb95 Additions to allow an optional underscore to be appended */ /* to Fortran common names. The char appended is in the elf */ /* include file to permit local variations */ /* elfput14.4*/ /* 14Jan95 Changes to facilitate translation to C */ /* elfput14.3*/ /* 30//1//94 Change to Mips Got16-Low16 pairs to a local function so */ /* that pyramids loader will work on then. Need to change */ /* so that it is relative to the EPC text symbol */ /* elfput14.2*/ /* 07/09/94 Change to use debugtabfix in linenotable on 88K (legend insists!)*/ /* elfput14.1*/ /* 06/06/94 50 years after Dday */ /* Removed ancient error from look up in pxname */ /* Restricted externalintegerspec Debugptr to DwarfProducer=Backend*/ /* Reset lastline lin plinestart for F90 internal routines which */ /* come after the end of the enclosing routine */ /* elfput14.i*/ /* Changed MIPgot16 to shift down the addend. needed for */ /* local data. External data the addend SHOULD always be 0 */ /* Added no reorder bits for MIPS */ /* Added code to deal with the case of allocated are being defined*/ /* in Eterminate bigger than the buffer space allocated */ /* 10/01/94 Changes to improve IMP dwarf information */ /* elfput13.5*/ /* 29/12/93 Change to deal with zero code area size which */ /* can happen in block data subprogs(pds) */ /* elfput13.4*/ /* 28/10/93 Changes for PIC on Mips. Also use debugtabfix */ /* For foxes to debug area */ /* elfput13.3*/ /* 06/07/93 Changes to pfiller to allow balance of area to be */ /* be filled if data already given */ /* elfput13.2*/ /* 28/06/92 Incorporated changes from the BSD Put for Fortran90: */ /* */ /* :- In Pdbytes, return if the data size is zero (else */ /* later if GST is otherwise empty, Pterminate will */ /* complain that the area has incorrect length). */ /* */ /* :- In Pfiller, perform a no-op if the area is Bss and */ /* correct if the area is a Common. Also call Pd for */ /* any Common area which is currently uninitialised, */ /* otherwise Common areas which have no initialisations */ /* will not be filled with the defined pattern. */ /* */ /* :- In Pentry2, redefine the first argument to be the */ /* ENTRY's properties rather than its Index (Index is */ /* never used and Fortran90 ENTRYs may be private). */ /* - compatible with sprocs21.7 onwards */ /* */ /* 26/06/93 :- Removed DwarfProducer decln back into dwarf.inc */ /* elfput13 */ /* 26/04/93 :- Substantial amendment to incorporate INIT & FINI */ /* area and their relocations for C++. Also a general */ /* revision of space managemnt which has become untidy(pds) */ /* elfput12.2 */ /* 23/04/93 :- Addition to Dwarf for procedure heading to assist EDB */ /* in finding the end of the prologue(pds for AH) */ /* elfput12.i */ /* 16/04/93 :- Minor corrections to output correct dwarf */ /* when running on byte swopped hosts(pds) */ /* elfput12.i */ /* 09/03/93 :- Merge 88k and Sparc (sl) with Mips (pds) */ /*gm*/ /* elfput11.3.i*/ /* 4/02/93 :- Sparc support for PIC */ /* elfput11.2.i*/ /* 26/01/93 :- Add ATprogram for MAIN SUB DIE */ /* 22/01/93 :- Add vtype masks to psdbvar to make more readable */ /* - Modify vtype meanings for records */ /* elfput11.1.i*/ /* 21/01/93 :- Fix problem where volatile characters were being */ /* treated as arrays instead of tagstringtype */ /* - Handle pointer based vars by negating their vtype */ /* so we get half meaningful dwarf. This needs to */ /* be handled better so the user can see its a ptr, */ /* ie by using mod_ptr_to */ /* - PSDBVAR allow record parameters */ /* 18/01/93 :- Generate Stack Loc add sparc code for location */ /* of Fortran automatic variables */ /* - Check blank common dwarf name is "" for blank */ /* common on non-88k too */ /* - Pproc and Tagentry strip traling underscore for */ /* routine names */ /* - Generate Stack Loc use PARAMBASE, which is constant */ /* on SPARC code gens, to get offset from %FP of */ /* each parameter for dwarf gen */ /* - Remove add loc code to pick 1st six sparc args up */ /* from %I0-%I5 */ /* */ /* (simon) elfput11.i */ /* 12/01/93 :- Merge in Fortran -CS option changes for Case */ /* Sensitivity */ /* :- Allow displacement in pdpattern and pdbyte to be */ /* x'7fffff' instead of 4M bytes (b187) */ /* 24Sep92 Dwarf support for IMp added (brought from beetle)(pds) elfput11.i*/ /* 16Jan92 Minor changes to PIC code following definition of elfput10.9*/ /* of the relevant bits in Psetoptions. One change to */ /* Sparc relocations in PIC mode */ /* elfput10.8f.6.i*/ /* 12/01/93 :- In Pterminate change 'DwarfProducer=fortran' test */ /* to 'DwarfProducer=PUT' */ /* 08/01/93 :- Comment out initdataad as it already exists in */ /* eprocs */ /* elfput10.8f.5.i*/ /* 17/12/92 :- In PDataEntry, only avoid PSymbol if the PUT is the dwarf */ /* producer. (si) */ /* elfput10.8f.4.i*/ /* 15/12/92 :- When creating the .debug, .rela.debug, .line and .rela.line */ /* section headers, use SHT_null for empty sections, do not place */ /* the names in the symbol tables if empty. Also do not attempt to*/ /* align the .debug section at all. */ /* Also replace the "SourceLang = Fortran" idea with the */ /* 'DwarfProducer' constant. (si) */ /* elfput10.8f.3.i*/ /* 11/12/92 :- Placed all Dwarf production under "SourceLang = Fortran" */ /* flag. It is now assumed that all other languages generate */ /* Dwarf independently of the PUT module. The line number table */ /* is still generated by the PUT module. The integer DebugPtr needs*/ /* to be changed to an extern in the fortran compiler (si) */ /* elfput10.8f.2.i*/ /* 11/12/92 :- commented out line in pfix2 for dwarf to work */ /* elfput10.8f.1.i*/ /* 13/11/92 :- Altereations to get SI put to compile with our compiler - */ /* set nusoption to be owninteger, value 1. */ /* elfput10.8f*/ /* 02Mar92 Further Enhancements for mxdb and ENTRY stmts */ /* Fix assummed size array last high bound */ /* elfput10.8e*/ /* 18Feb92 Support for Volatile type description FTvolatile */ /* 17Feb92 Changes to generate dwarf for Entry Statements */ /* elfput10.8d*/ /* 06Feb92 Changes for Fortran Dwarf made at DG RTP */ /* byte->Ftsingedchar,log1->Ftunsignedchar */ /* log2->Ftunsignedshort */ /* Fix char arg bug where chars were output */ /* as Tag_local_variables */ /* Blank common name given as "" fo mxdb */ /* New Entry Point Info routine to set up dwarf */ /* function return info in PPROC */ /* Add mxdb case info to TAGcompileunit via ATlouser */ /* Make MAIN_ -> main for mxdb TAGglobalsubname */ /* New Fortran Tagstring routine to generate */ /* TAGstringtype for all fortran character vars */ /* in normal case,function returns and record fields */ /* */ /* 15Jan92 Changes for Dwarf generation a la Data General elfput10.8c*/ /* New elf.inc which specifies frame reg as stack */ /* pointer, as 88k uses sp. Framsize is offset */ /* for params and autos given by eprocend. */ /* This version of put is no longer compatible */ /* with sdb as it adheres to the dwarf standard! */ /* */ /* 18Dec91 Set type on 4 debug sections as 'nobits, if unused elfput10.8b*/ /* rather than 'null' and fill in rest of entry. */ /* 12Dec91 Change fixup type in word 2 of .line section to elfput10.8a*/ /* Debugtabfix since dtl translator objects. */ /* Don't set SHF_ALLOC on .rela.line */ /* Don't set "section" in section's symbol entry */ /* Don't set _addr field in .data and .bss sects */ /* Make pentry2 create local symbol if offset < 0 */ /* 12Dec91 More care with area alignments elfput10.8*/ /* 03Oct91 Modifications to SDB code and alias names elfput10.7*/ /* Also removal of comreg refs since this method of setting */ /* options has gone with EMAS. */ /* 01Oct91 Merge in of Lindas extensions to SDB code */ /* 25Sep91 Correction to expand area to zero all the extra space */ /* previously last 8 bytes were not cleared */ /* 11Dec90 added procedure Pgetbytes which, if possible, elfput10.1*/ /* returns the address at which the initialisation */ /* of a specified data location has been stored */ /* - required by eprocs24.9 onwards */ /* 08Oct90 Elfput10 with first shot at extended SDB interface as per SDBblurb*/ /* 18Sep90 Elfput9.4 Fixes problem in files with no globals also in Checkcodesize*/ /* 30Aug90 Elfput9.3 More fixes in PFIX2 to allow code scheduler */ /* to separate hi-lo fixups */ /* 21Aug90 Elfput9.1&.2 Changes to SDB code to make it swop proof */ /* 07Aug90 Elfput9 Changes from Linda for byteswopping on 486 */ /* 01Aug90 Elfput8.2 Changes to Pinit to initialise symtab to avoid */ /* problems with C programs with no symbols */ /* 20June90 Elfput8 Changes for 386 version which include */ /* some rearrangement of include files */ /* 13Jun90 Elfput7.4. Changes to sort out confusions */ /* between strings and arrays of characters in SDB */ /* Also to remove empty debugsection from objects compiled */ /* without debugging since this appears to confuse utilities */ /* 28Mar90 elfput7 Major extensions to incorporate .debug section */ /* being the SDB information as per a doc from ICL */ /* 14Mar90 elfput6.6&6.7 Fixes to common ares */ /* 28Feb90 elfput6.5 Adds Pentry2 enhanced vsn of Pentry */ /* 15Feb90 elfput6 pds adds other adhoc changes to try to */ /* avoid load problems on unicorn. Local proc are patched in*/ /* instead of done by relocation */ /* 13Feb90 elfput5 pds adds code to put all locals before globals */ /* in the symbol table */ /* 29jan90 elfput3 pds incorporating GB changes (elfput2) */ /* Cmpcstring corrected */ /* external symbol prefix (often sub"_") now in include file */ /* Pproc enters the name if necessary */ /* Original version based on m88kput8.i */ /* */ /* all the COFF sdb code is untouched except that call of psymbol are */ /* commented out. However the ELF symbol table is smaller than the COFF */ /* one and any use of the SDB code will tramp over the symbol table */ /* Data to work out what to do is not available as yet. */ /* */ /* Tracing control */ /* Trace all significant calls on interface if: */ /* comreg(26)&1#0 */ /* Seldom required info controlled by bits of comreg(26) as follows: */ /* 4 - switch on sdb */ /* 16 - File use monitoring */ /* 32 - Dump output in HEX on writing */ /* 128 - Requests for more space by Malloc, Expand Area etc. */ #define trusted 0 /* 0 = check inputs */ /** */ static int sdb=0; /** */ #define imp 1 #define fortran 2 #define ccomp 11 #define pascal 14 /** */ static int procstartline=-1; /*=> undefined*/ static int lastline=-1; static int lastca=-1; static char objectname [255+1]; /*For PASCAL to delete object file if required*/ /** */ /** */ /* %EXTERNALINTEGERFNSPEC GetSDBfntype */ /* C specific */ /* System or C library routines used */ /*%EXTERNAL %INTEGER %FN %SPEC TIME(%INTEGER zero) */ extern int creat( int ,int ); extern void unlink( int ); extern int close( int ); #define filewrite write extern int filewrite( int ,int ,int ); extern int lseek( int ,int ,int ); /*byte ad*/ extern int access( int ,int ); extern int mkdir( int ,int ); /* IMP library routines used */ static int unasscheck=1; /*%EXTERNAL %INTEGER %MAP %SPEC Comreg(%INTEGER n) */ extern char * itos( int ); /**~np1 %alias "s_itos"*/ #define fill s_fill extern void fill( int ,int ,int ); /**~np1*/ extern void bytemove( int ,int ,int ); extern char * htos( int ,int ); extern int eswapmode( void ); /** */ void psymbol( char * ,int ,int ,int ,int ,int ); static void fix( int ,int ,int ,int ,int ); /********************************************************************************/ #define defaultareasize (4096-8) /*8 added by malloc for red tape */ #define initialsymboltablesize defaultareasize #define onemegabyte (1048576) #define twomegabyte (2097152) #define infinity (0xFFFFFE) #define mode 436 /* mode of object creat, read/write for all */ #define dirmode 508 /* dircetory mode R+W+X self and group */ /*fortran triad mode to size conversions*/ static const unsigned char modetobytes [17+1] = { 2, 4,8,4,8,16,8,16, 32,1,2,4,8,1,0,1, 0,1}; static int dictindex=0; /* offset into dictionary of latest item */ static int objid; /* File descriptor ID of object file */ static int impp=0; static int faulty=1; static char srcfile [255]="source unknown"; static char objname [33]="object Unknown"; static int curlexlev=0; static int endpending=0; static int debuglevel=0; static int mon=0; /* Put call monitoring control */ static int mainentrypoint=0; static int line=0; /* Current Line number as set by Plinestart*/ static int sourcelang; static int sourcelangvariant; static int targetvariant; static int casesense=0; #include "elf.h" /*<--- PIC VARIABLES --->*/ #include "elf6.p5.h" #include "vers.h" #include "dwarf4.h" /*<--- PIC VARIABLES --->*/ #define unshared 0 #define smallmodel 1 #define largemodel 2 /* Unshared - the default, absolute addresses generated in code */ /* Small Model - allows a restricted number of external refs from code */ /* Large Model - allows for unlimited different references from code */ extern int Pic; #ifdef DGUXRE extern char *ecsnameprefix; /* to allow funny prefixes in RE mode */ #endif static int gotsym=0; /* The symbol table for our GOT entry */ #if(DwarfProducer==PUT) static int debugptr=0; /* Current address of debug area */ /* %if DwarfProducer = Backend */ #else extern int debugptr; #endif; #if(target==elfsparc) #define parambase (0x44) /* offset from %FP where sparc codegen dumps args */ #endif; /*<-- SYMBOL VARIABLES -->*/ #define symsize 255 /* max name length in string table */ #define symboltableentrysize 16 struct auxblockfm{ int spare1; int lnno; int spare2; int spare3; int endindex; }; struct auxtagfm{ int spare1; int spare2; int size; int spare3; int endindex; }; static Elf32_Sym *syms; static int maxsyms; /*<--- Section index field --->*/ #define reginfosect 1 #define textsect 2 #define datasect 3 #define datagptabsect 4 #define bsssect 5 #define bssgptabsect 6 #define symsect 7 #define textrelsect 8 #define datarelsect 9 #define mdebugsect 10 #define stringsect 11 #define shstringsect 12 #define rodatasect 13 #define linenosect 14 #define linerelsect 15 #define debugsect 16 #define debugrelsect 17 #define initsect 18 #define initrelsect 19 #define finisect 20 #define finirelsect 21 #define tdescsect 22 #define tdescrelsect 23 #define maxsect 23 /* Must be next in sequence to datasect */ /* Must be next in sequence to bsssect */ #if(target==elfmips) #define regsectsize 24 #else #define regsectsize 0 #endif; /* */ /* tdesc section doubles as tags section for PPC */ /* define any consts here that are needed to enable common code */ /* to be used */ /* */ #if(target==elfppc) #define tdescname (".tags") #define tdesctype (shtordered) #define tdescprops (((4<<24)|(8<<16))|SHF_ALLOC) #else #define tdescname (".tdesc") #define tdesctype SHT_PROGBITS #define tdescprops ((4<<24)|SHF_ALLOC) #endif; static int nsects=1; static char * sectnametext [maxsect+1] = { "",".reginfo", ".text",".data", ".gptab.data",".bss",".gptab.bss",".symtab", ".rela.text",".rela.data",".mdebug",".strtab", ".shstrtab",".rodata",".line",".rela.line", ".debug",".rela.debug",".init",".rela.init", ".fini",".rela.fini",".tdesc",".rela.tdesc" }; static int maxloc; /* The last local in the shuffled symbol table*/ static int regsectdata [5+1] = { 0,0,0,0,0,0}; static int sectionposition [maxsect+1]; /* Hold file offsets*/ static int sectionsizes [maxsect+1]; static int sectionentryno [maxsect+1]; /* Position in table */ /* */ /* Declarations and formats for SDB */ /* */ /*<--- TYPE FIELD --->*/ #define tnull 0 /* Type not assigned */ #define tchar 1 /* character */ #define tschar 2 /* byte in fortran*/ #define tuchar 3 /* unsigned character */ #define tshort 4 /* short integer */ #define tushort 6 /* unsigned short */ #define tint 7 /* integer */ #define tsint 8 /*signed integer*/ #define tuint 9 /* unsigned integer */ #define tlong 10 /* long integer */ #define tfloat 14 /* floating point */ #define tdouble 15 /* double word */ #define tulong 12 /* unsigned long */ #define tcomplex 17 /*complex ie 2 floats*/ #define tdcomplex 18 /*Dcomplex ie 2 doubles*/ #define tbool (0x15) /*any boolean*/ /* - Auxiliary entry formats - */ struct debugf{ int len; short int tag; unsigned char data [255+1]; }; struct locf{ int dis; int offset; int area; int dref; int offset2; }; #define epcf77structtypes 25 /*starting number for dbx ATuserdeftypes*/ #define lrecsize 10 /* bytes for each line number record */ /*<-- RELOCATION VARIABLES -->*/ /* This format for internal storage of reloc details */ struct rfm{ short int hostarea; short int tgtarea; int hostdisp; int tgtdisp; }; #define maxrels (defaultareasize/sizeof(struct rfm)) static int relsmalloc; static struct rfm *rels; static struct rfm *startrels; static int crel=0; /* current relocation pointer */ /*<-- CODE AREA VARIABLES -->*/ static int *codearea; #define maxlexlev 20 /* Maximum Lexical Level - assured */ /* IMP cannot go deeper than this. */ struct blockfm{ int ad; int ca; int sym; int highpcoffset; int postploffset; int siblink [10+1]; }; static struct blockfm blocks [maxlexlev+2]; static struct blockfm *parentblock; /*descriptor of surrounding procedure*/ static struct /*descriptor of current procedure */ blockfm *curblock; /*<--- OBJECT AREAS --->*/ #define code 1 #define gla 2 #define plt 3 #define sst 4 #define gst 5 #define diags 6 #define scalar 7 #define iotab 8 #define zgst 9 #define cnst 10 #define init 11 #define fini 12 #define auxbss 13 #define tdesc 14 #define debugtab 16 #define linetab 17 #define dicttab 18 #define symtab 19 /* Negative area hold relocations after processing */ #define coderels (-1) #define datarels (-2) #define initrels (-3) #define finirels (-4) #define debugrels (-5) #define linenorels (-6) #define tdescrels (-7) #define lineworkarea (-8) #define lowestarea (-8) /* The following array translates epc areas to elf areas as defined by the */ /* symbol table. Code is symtable entry 2, data=3, bss=4, debug=5, line=6, rodata=7, GOTsym=8*/ /* these could be parameterised! */ #if(target==elf88k) static const unsigned char epcareatoelfsym [symtab+1] = { 0, 2,3,13,9,10,3 /*7*/,11, 12,4,8,0,0,0,0,0, 5,6,0}; #else static const unsigned char epcareatoelfsym [symtab+1] = { 0, 2,3,13,3 /*7*/,3,3 /*7*/,3, 3,4,3 /*7*/,0,0,0,0,0, 5,6,0}; #endif; /* remove RO area to data cos of suspecet OS bug; Changes in lien above too */ static const unsigned char epcareatosectndx [symtab+1] = { 0, textsect,datasect,datasect, /*RO*/datasect,datasect, /*RO*/datasect,datasect,datasect, bsssect, /*RO*/ datasect,0,0,0,tdescsect,0,debugsect,linenosect, 0}; /* the next two arrays are to help with relocations. The first is the correspondence*/ /* between the EPC area holdint the data & the EPCarea holding the relocation.*/ /* A zero means relocations to this area are barred */ /* Nrels count the relocations encountered for each */ static const int epcareatorelarea [symtab+1] = { 0, coderels,datarels,datarels,0,datarels,0,datarels,datarels,0, 0,initrels,finirels,0,0,0,debugrels,linenorels, 0}; static int nrels [symtab+1] = { 0}; #define setareas 20 static int maxarea=0; /* Number of areas there is */ /* space for in the current slot */ static int toparea=21; /* Highest area number used */ struct areafm{ int base; int max; int length; int sym; int type; int linkdisp; int align; int highuse; }; static struct areafm *areas; struct linehdrform{ int backlink; int offset; int last; int prevlastca; int length; int codeaddr; }; static int linehdroffset=-1; #define linehdrsize 24 static int filemon=0; static int swapmode; static int dictad=0; /* symbol table dictionary pointer */ static int maxdictad=0; /* current ad of dictionary end */ static int dictstart; static int malmon=0; static int maxdata=0; static int level [255]; static int lev=0; #define stfixedentries 13 static int nextsym=stfixedentries-1; /* Index to symbol table. +1 for each entry */ static unsigned char shnames [255+1]; static int shptr=1; static int lastdiagsrec=-1; struct diagsrecfm{ int doffset; int endline; }; #define maxdiagsrec 64 static struct diagsrecfm diagsrecs [maxdiagsrec+1]; static void addtype( struct debugf *,int *,int ,int ,int ); static int privatehdrflags; static void addname( struct debugf *,int *,char * ); static void addloc( struct debugf *,int *,int ,int ,int ,int ); static void addstringlen( struct debugf *,int *,int ,int ); static void writedbr( struct debugf *); static void fillsiblink( int ,int ); static void addsiblink( struct debugf *,int *,int ,int ); void psdbvar( int ,int ,int ,int ,int ,int ,int ,int ,int ); static void impsdb( int ); static int impinnerblk( int ); static void doimpsdbblock( int ); static void completeend( void ); static void expandarea( int ); static void insertfilename( int ); static char * checkblankcommon( char * ); void pd4( int ,int ,int ); void pd2( int ,int ,int ); void pdbytes( int ,int ,int ,int ); /* two dummies for testing on np only */ /*%externalinteger initdataad*/ #if(target==elf88k) static int nusoption=1; /*returns 1 if -nus used, 0 if -us*/ static int framesize; /* as 88k uses sp instead of fp need size from eprocend*/ #endif; #if(target==elfmips) static int framesize; /* as mips uses sp instead of fp need size from eprocend*/ #endif #ifdef DGUXRE extern int commonus; /* allows underscores on commons */ #endif static short int funcrettype; /* function result type set by Entry Point Info*/ static short int funcretsize; /* size of function result */ static int parenthighpc; /* HIGHPC of ENTRY stmt parent routine */ /************************/ /** SERVICE ROUTINES **/ /************************/ static void puterror(char * s) { /*************************************************************************/ /** Compilation ends in disarray. Message and stop tidily **/ /*************************************************************************/ extern int errno; printf("** PUT error **\n"); errno=0; /* if not zero perror adds text !*/ perror( s); ; imp_stop(); } /*PutError*/ static void outsymbol(int symno) { /*************************************************************************/ /** print a symbol table entry for diags purposes **/ /*************************************************************************/ int ad,x; Elf32_Sym *sym; sym=&syms [symno]; if (ELF32_ST_BIND(sym->st_info)==STB_LOCAL) printf("L "); else printf("G "); printf("%08x ",(unsigned)sym->st_value); ad=dictstart+sym->st_name; printf(" "); do { x=(*(unsigned char *)(ad)); if (x==0) break ; printf("%c",x); ad++; } while (1) /* FOR EVER */; } /*************************************************************************/ /** Swapping Routines **/ /** These are only used in cross Endian compilations when Eswapmode **/ /** returns a non zero value **/ /*************************************************************************/ static int wordswap(int x) { return (((x<<24)|((x<<8)&0xFF0000))|(((unsigned)x>>8)&0xFF00))|((unsigned)x>>24); } static int halfswap(int x) { return (((x&255)<<8)|(((unsigned)x>>8)&255)); } static void areaswap(int basead,int len) { int i; i=0; while (ist_value=wordswap(st->st_value); st->st_name=wordswap(st->st_name); st->st_size=wordswap(st->st_size); st->st_shndx=halfswap(st->st_shndx); } static void elfhdrswap(Elf32_Ehdr *e) { /********************************************************************************/ /** Swaps the File header **/ /********************************************************************************/ e->e_version=wordswap(e->e_version); e->e_entry=wordswap(e->e_entry); e->e_phoff=wordswap(e->e_phoff); e->e_shoff=wordswap(e->e_shoff); e->e_flags=wordswap(e->e_flags); e->e_type=halfswap(e->e_type); e->e_machine=halfswap(e->e_machine); e->e_ehsize=halfswap(e->e_ehsize); e->e_phentsize=halfswap(e->e_phentsize); e->e_phnum=halfswap(e->e_phnum); e->e_shentsize=halfswap(e->e_shentsize); e->e_shnum=halfswap(e->e_shnum); e->e_shstrndx=halfswap(e->e_shstrndx); } /********************************************************************************/ /* PINITIALISE - CODE GENERATION BEGINS WITH THIS CALL */ /********************************************************************************/ void pinitialise(int version,int release,int language) { char lang [33] ; static struct areafm zeroarea; int i; faulty=0; /* Always faulty unless initialised properly */ swapmode=eswapmode(); sourcelang=language&0xFFFF; sourcelangvariant=((unsigned)language>>16)&255; targetvariant=(unsigned)language>>24; /* Defined in cgtarget & passed on*/ if (sourcelang==imp) { strcpy(lang,"IMP80"); impp=1; } else if (sourcelang==fortran) strcpy(lang,"FORTRAN77") ; else if (sourcelang==ccomp) strcpy(lang,"CC"); else if (sourcelang==pascal) strcpy(lang,"Pascal"); curblock=&blocks [0+1]; /* Set pointer to dummy outer level */ relsmalloc=(int )malloc(defaultareasize); rels=(struct rfm *)(relsmalloc); /* grab an area for reloc table */ startrels=rels; /* Note reloc table sections are not */ /* contiguous so dont need to be 'areas' */ areas=(struct areafm *)((int)&zeroarea+(lowestarea*sizeof(struct areafm))); /* Start of area table */ expandarea(0); areas [zgst-lowestarea].sym=epcareatoelfsym [zgst]; /* .bss */ /* Initialise symtab in case psymbol never called */ expandarea(symtab); syms=(Elf32_Sym*)((areas [symtab-lowestarea].base)); maxsyms=areas [symtab-lowestarea].max/symboltableentrysize; for (i=0; i<=symtab; i++) nrels [i]=0; /*Incase put ever reusable */ #if (DwarfProducer==PUT) if (sdb!=0) { insertfilename(sourcelang); /*sets up dwarf compile_unit DIE */ } #endif /* For position independent code set up a symbol for the GOT */ if (((target==elfsparc)||(target==elfmips)||(target==elf386))&&(Pic!=0)) { psymbol(gotnametext,0,0,STT_OBJECT,STB_GLOBAL,0); gotsym=nextsym; if (gotsym!=epcareatoelfsym [plt]) puterror("Put not set for sharing"); } } /*Pinitialise*/ /** */ void preinitialise() { /*************************************************************************/ /** Reinitialise **/ /*************************************************************************/ static struct areafm zeroarea; int i; if (mon!=0) printf("Preinitialise\n"); /* first reinitialise the owns */ unasscheck=1; dictindex=0; impp=0; curlexlev=0; endpending=0; debuglevel=0; mainentrypoint=0; line=0; gotsym=0; #if(DwarfProducer==PUT) debugptr=0; #endif; maxsyms=0; nsects=1; maxloc=0; for (i=0; i<=5; i++) { regsectdata [i]=0; } for (i=0; i<=maxsect; i++) { sectionposition [i]=0; sectionsizes [i]=0; sectionentryno [i]=0; } crel=0; maxarea=0; toparea=21; dictad=0; maxdictad=0; dictstart=0; maxdata=0; lev=0; shptr=1; lastdiagsrec=-1; linehdroffset=-1; /* no line number entries yet */ /* */ faulty=0; /* Always faulty unless initialised properly */ curblock=&blocks [0+1]; /* Set pointer to dummy outer level */ relsmalloc=(int )malloc(defaultareasize); rels=(struct rfm *)relsmalloc; /* grab an area for reloc table */ startrels=rels; /* Note reloc table sections are not */ /* contiguous so dont need to be 'areas' */ areas=(struct areafm *)((int)&zeroarea+(lowestarea*sizeof(struct areafm))); /* Start of area table */ expandarea(0); areas [zgst-lowestarea].sym=epcareatoelfsym [zgst]; /* .bss */ /* Initialise symtab in case psymbol never called */ expandarea(symtab); syms=(Elf32_Sym*)((areas [symtab-lowestarea].base)); maxsyms=areas [symtab-lowestarea].max/symboltableentrysize; for (i=0; i<=symtab; i++) nrels [i]=0; /*Incase put ever reusable */ /* Source lang still set from Pinitialise */ #if (DwarfProducer==PUT) if (sdb!=0) { insertfilename(sourcelang); /*sets up dwarf compile_unit DIE */ } #endif /* For position independent code set up a symbol for the GOT */ nextsym=stfixedentries-1; if (((target==elfsparc)||(target==elfmips)||(target==elf386))&&(Pic!=0)) { psymbol(gotnametext,0,0,STT_OBJECT,STB_GLOBAL,0); gotsym=nextsym; if (gotsym!=epcareatoelfsym [plt]) puterror("Put not set for sharing"); } procstartline=-1; /*=undefined*/ lastline=-1; nextsym=stfixedentries-1; lastca=-1; } /*PReinitialise*/ void psettargetflags(int flags){ /*************************************************************************/ /** allows special seting of flags in elf header **/ /*************************************************************************/ privatehdrflags=flags; } void freespace(int ad) { /*************************************************************************/ /** This is EPCs interface to FREE **/ /** Enables monitoring or checking to take place **/ /*************************************************************************/ if (malmon!=0) printf(" FREE %2d\n",ad); free((char *)ad); } /* Free space */ /** */ int getspace(int size/*bytes*/) { /*************************************************************************/ /** This is EPC's interface to MALLOC **/ /** Enables monitoring or checking to take place **/ /*************************************************************************/ int flag; size=(size+7)&(-8); /* keep everything d-w aligned */ if (malmon!=0) { printf(" MALLOC %d",size); flag=(int )malloc(size); printf(" flag = %x\n",flag); if ((flag+size)>maxdata) maxdata=flag+size; } else flag=(int )malloc(size); if (flag==0) puterror(" MALLOC out of space "); return flag; } static void writetofile(int objid,int bytead,int len,char * sname) { /*************************************************************************/ /** Outputs the object file. Really just an interface to **/ /** the Unix write routine. Useful for monitoring on when on a **/ /** non unix system **/ /*************************************************************************/ int i,j,sym; if (mon!=0) { printf("File Write of %s %d %d %d\n",sname,objid,bytead,len); i=0; while (i20)) filler=0; else filler=(unsigned)type>>24; if (malmon!=0) printf("EXPAND AREA %d from, oldsize %x %x\n",id,from,oldsize); if (oldsize==0) /* First use of this area */{ newsize=defaultareasize; ad=getspace(newsize); if (ad==0) puterror("Get Space fails"); fill(newsize,ad,filler); if ((0areas [code-lowestarea].max) { expandarea(code); codearea=((int *)(areas [code-lowestarea].base)); } } /*CheckCodeSize*/ void pcword(int offset,int n) { /*******************************************************************/ /* Put 32 bits into code stream */ /*******************************************************************/ if (mon!=0) printf(" PcWord: offset = %d word = %x\n",offset,n); if (faulty!=0) return ; checkcodesize(offset,4); codearea [(unsigned)offset>>2]=n; } /*PcWord*/ void pcbytes(int offset,int len,int ad) { /*******************************************************************/ /* Put 'Len' bytes of code into code stream */ /*******************************************************************/ int i,from,to; if (mon!=0) { printf(" Pcbytes len = %d Disp = %d",len,offset); if (len==1) printf("%02x",(*(unsigned char *)(ad))); else { for (i=ad; i<=(ad+len)-1; i++) { if (((i-ad)&0x3F)==0) printf("\n"); printf("%02x",(*(unsigned char *)(i))); } } printf("\n"); } checkcodesize(offset,len); from=ad; to=areas [code-lowestarea].base+offset; for (i=1; i<=len; i++) { (*(unsigned char *)(to))=(*(unsigned char *)(from)); to++; from++; } if (areas [code-lowestarea].highuse<(offset+len)) areas [code-lowestarea].highuse=offset+len; } /*---------------------------------------------------------------------------*/ /*------------------------ LINE NUMBER TABLE --------------------------------*/ /*---------------------------------------------------------------------------*/ int pgivecurrentsize(int area) { /*************************************************************************/ /** Returns the current size of area 'area' if it exists **/ /*************************************************************************/ if (!(((1<=area)&&(area<=toparea))&&(areas [area-lowestarea].base!=0))) return -1; return areas [area-lowestarea].highuse; } /*Pgivecurrentsize*/ /** */ /* Line No tables are built in the Line Work Area under headers the */ /* current header is the atthe global offset LineHdrOffset. */ /* */ /* If a pushfile is encountered a new header is built at the current */ /* end of the work area and linked back to the current one. New line */ /* numbers then go under the new current header. If a popfile is */ /* encountered the fragment under the current header is completed with */ /* a terminator and written into the line number area. The current */ /* header reverts to that active before the previous pushfile. */ /* */ static void setlineheader(int offset) { /*************************************************************************/ /** Build a new header in the Line Work area at offset. Pdbytes **/ /** is used since this takes care of creating or expanding the line **/ /** work Area as required **/ /*************************************************************************/ struct linehdrform newhdr; offset=(offset+3)&(-4); /* Word Align*/ memset(&newhdr,0,sizeof( struct linehdrform)); newhdr.backlink=linehdroffset; newhdr.offset=16+offset; newhdr.length=8; /* Size of empty fragment*/ newhdr.codeaddr=0; /* Needs a fixup after moving to Line sect */ newhdr.last=lastline; newhdr.prevlastca=lastca; pdbytes(lineworkarea,offset,linehdrsize,(int)&newhdr); linehdroffset=offset; lastline=-1; /* New file must reset */ if (mon!=0) printf("hew hdr set up at %d [%x %x %x %x %x]\n", offset,newhdr.backlink,newhdr.offset,newhdr.last, newhdr.prevlastca,newhdr.length); } /* set line header*/ /*zzzzz*/ static void remline(int lineno,int codead /*create line map*/) { /*************************************************************************/ /** Format of map is length **/ /** addr =0 text section (via relocation) **/ /** and then repeated 10 byte entries:- **/ /** 4 bytes : line number **/ /** 2 bytes statement no Xffff indicates not known **/ /** 4 bytes : ad of code for this line **/ /*************************************************************************/ int pos; struct linehdrform *linehdr; if (mon!=0) printf("REMline %d %x\n",lineno,codead); if (((impp==1)&&(lineno>9998))) return ; /*ignore IMP epilogue lines*/ linehdr=(struct linehdrform*)(areas [lineworkarea-lowestarea].base+linehdroffset); pos=linehdr->offset+linehdr->length; linehdr->length=linehdr->length+lrecsize; pd4(lineworkarea,pos,lineno); pd2(lineworkarea,pos+4,-1); pd4(lineworkarea,pos+6,codead); } /*remline*/ /** */ void ppushfile() { /*************************************************************************/ /** Set up a header for a new block of line nos **/ /*************************************************************************/ struct linehdrform *linehdr; if (mon!=0) printf("Ppushfile \n"); if (linehdroffset<0) setlineheader(0); linehdr=(struct linehdrform*)(areas [lineworkarea-lowestarea].base+linehdroffset); setlineheader(linehdr->offset+linehdr->length); } /*Ppushfile*/ /** */ int ppopfile() { /*************************************************************************/ /** Terminate a block of line nos for an included file **/ /** Write the completed block to the .line sectio **/ /** returns its position relative to section start **/ /** Reverts so that further lines are added to the enclosing block **/ /*************************************************************************/ int posn,ftype; struct linehdrform *linehdr; if (mon!=0) printf("Ppopfile \n"); remline(0,areas [code-lowestarea].highuse); linehdr=(struct linehdrform*)(areas [lineworkarea-lowestarea].base+linehdroffset); /* upsets utilities LineHdr_length=(LineHdr_length+3)&(-4) */ posn=areas [linetab-lowestarea].highuse; pdbytes(linetab,posn,linehdr->length,(int)&linehdr->length); ftype=fullwordfix; #if(target==elf88k) ftype=debugtabfix #endif; fix(ftype,linetab,posn+4,code,0) /* To head of code */; linehdroffset=linehdr->backlink; if (linehdroffset>=0) { linehdr=(struct linehdrform*)(areas [lineworkarea-lowestarea].base+linehdroffset); lastline=linehdr->last; lastca=linehdr->prevlastca; } return posn; } /*Ppopfile*/ /** */ void plinestart(int lineno,int codead) { /*************************************************************************/ /** Note the start of a new line **/ /*************************************************************************/ struct linehdrform *linehdr; if (faulty!=0) return ; if (mon!=0) printf("\nLINE:%4d at %x\n",lineno,codead); if (linehdroffset<0) setlineheader(0); if (codead>areas [code-lowestarea].highuse) areas [code-lowestarea].highuse=codead; if (lineno==0) { if (procstartline>=0) return ; } else { if (procstartline<0) { if ((sdb!=0)&&(curblock->postploffset!=0)) { fix(debugtabfix,debugtab,curblock->postploffset,code,codead); curblock->postploffset=0; /* marks the point where EDB set Proc brak point*/ } codead=curblock->ca; procstartline=lineno-1; if (lastline>=procstartline) lastline=procstartline-1; } } line=lineno; if (sdb!=0) { /* sdb gets confused by repeated line numbers */ if ((lineno>lastline)||(procstartline<0)) { linehdr=(struct linehdrform*)(areas [lineworkarea-lowestarea].base+linehdroffset); if ((codead<=lastca)&&((linehdr->length-lrecsize)>=8)) linehdr->length=linehdr->length-lrecsize; /* Overwrite previous one */ remline(lineno,codead); lastline=lineno; } lastca=codead; } } /*PLineStart*/ static int codeforline(int line) { /*************************************************************************/ /** Return codeaddress for 'line' from line number map **/ /*************************************************************************/ int i,base,codead,lineno; struct linehdrform *linehdr; linehdr=(struct linehdrform*)(areas [lineworkarea-lowestarea].base+linehdroffset); base=areas [linetab-lowestarea].base+linehdr->offset; i=base+linehdr->length; while (base=line) { bytemove(4,base+6,(int)&codead); return codead; } base+=lrecsize; } return 0; } /************************************ */ /** * */ /** Put Interface Passing of Data * */ /** * */ /************************************ */ struct rdfm{ int disp; int len; int copies; }; #define rdsize 12 /********************************************************************************/ int pgetbytes(int curarea,int disp,int len) { /* */ /*returns the address of the initialisation for area CurArea at */ /*offset Disp covering Len bytes - returns ZERO if either the */ /*location has not been initialised or if Put is unwilling to */ /*delve into murky corners. */ /* */ /*---as currently implemented, this Put will only accept queries */ /* on Gla initialisations */ int ad,bad,i; if (faulty!=0) return 0; if (mon!=0) printf(" Pgetbytes ( %1d Len = %1d Disp= %1d",curarea,len,disp); if ((curarea==gla)&&(areas [gla-lowestarea].max>=(disp+len))) ad=areas [gla-lowestarea].base+disp ; else ad=0; if (mon!=0) { if (ad!=0) { printf(" "); bad=ad; if (len==1) printf("%02x",(*(unsigned char *)(bad))); else { for (i=bad; i<=(bad+len)-1; i++) { printf("%02x",(*(unsigned char *)(i))); } } } printf("\n"); } return ad; } /*of Pgetbytes */ /********************************************************************************/ void pdbytes(int curarea,int disp,int len,int ad) { struct areafm *a; int i,bad,to,encoded,from; struct rdfm *r; if (faulty!=0) return ; if (mon!=0) { printf(" PDBytes ( %d len = %d Disp=%d ",curarea,len,disp); bad=ad; if (len==1) printf("%02x",(*(unsigned char *)(bad))); else { for (i=bad; i<=(bad+len)-1; i++) { printf("%02x",(*(unsigned char *)(i))); } } printf("\n"); } if (len==0) return ; if ((sourcelang==imp)&&(curarea==diags)&&(len>=24)&&(lastdiagsrec20)) encoded=1; else encoded=0; if (curarea>20) curarea=syms [curarea-20].st_value; /* common */ a=&areas [curarea-lowestarea]; #if(trusted==0) if ((disp<0)||(disp>0x7FFFFF)) puterror("bad displacement "); #endif; from=ad; /* copy to byte boundaries */ if (encoded!=0) /* encoded area */{ if (a->max==0) { expandarea(curarea); a->linkdisp=0; } /*first use */ r=(struct rdfm*)(a->base+a->linkdisp); while (((((((a->linkdisp+rdsize)+rdsize)+r->len)+len)+6))>a->max) { /*@of last fragment + hdr of last frag */ /* + hdr for new frag + (len of last frag+rounding) */ /* + (len of new frag+rounding) */ expandarea(curarea); r=(struct rdfm*)(a->base+a->linkdisp); } if ((disp==(r->disp+r->len))&&(r->copies<=1)) /*adjacent areas */{ to=((a->base+a->linkdisp)+rdsize)+r->len; r->len=r->len+len; /* new start required */ } else { to=((((a->base+a->linkdisp)+rdsize)+r->len)+3)&(-4); /*4b bnd*/ r=(struct rdfm*)(to); a->linkdisp=to-a->base; r->disp=disp; r->len=len; r->copies=1; to+=rdsize; } /* normal mapped area */ } else { while ((disp+len)>=a->max) expandarea(curarea); /* suspicion that byte swopped m-cs go 1 byte too far */ to=a->base+disp; } bytemove(len,from,to); /* */ /* The next line is needed for C++ who does its own thing. The final */ /* size of the debug area is not passed into PTERMINATE so put */ /* has to work it out. Write DBR must be careful to ensure debugptr */ /* is advanced before a call of pdbytes. */ /* */ if (a->highuse<(disp+len)) a->highuse=disp+len; } /*PDBytes*/ /********************************************************************************/ void pd(int area,int disp,int databyte) { int ad; if (faulty!=0) return ; if ((databyte==0)&&(unasscheck==0)) return ; ad=(int)&databyte; if (((targetdata==elfdatamsb)&&(swapmode==0))||((targetdata==elfdatalsb)&&(swapmode!=0))) ad+=3; pdbytes(area,disp,1,ad); } /*PD*/ /********************************************************************************/ void pd2(int area,int disp,int datadoublebyte) { int ad; if (faulty!=0) return ; if ((datadoublebyte==0)&&(unasscheck==0)) return ; ad=(int)&datadoublebyte; if (((targetdata==elfdatamsb)&&(swapmode==0))||((targetdata==elfdatalsb)&&(swapmode!=0))) ad+=2; pdbytes(area,disp,2,ad); } /*PD2*/ /********************************************************************************/ void pd4(int area,int disp,int dataquadbyte) { if (faulty!=0) return ; if ((dataquadbyte==0)&&(unasscheck==0)) return ; pdbytes(area,disp,4,(int)&dataquadbyte); } /*PD4*/ /********************************************************************************/ void pdpattern(int area,int disp,int ncopies,int len,int ad) { int i,bad; struct areafm *a; int to,encoded,from; struct rdfm *r; if (faulty!=0) return ; if (mon!=0) { printf(" PDPattern( area = %2d, disp = %2d, ncopies = %2d, length = %2d ", area,disp,ncopies,len); bad=ad; for (i=bad; i<=(bad+len)-1; i++) { printf("%02x",(*(unsigned char *)(i))); } printf("\n"); } if ((area==5)||(area>20)) encoded=1; else encoded=0; if (area>20) area=syms [area-20].st_value; /* common */ a=&areas [area-lowestarea]; if ((len==4)&&((*(int *)(ad))==0)&&(((unsigned)a->type>>24)==0)&&(unasscheck==0)) return ; if (ncopies==0) ncopies=1; #if(trusted==0) if ((disp<0)||(disp>0x7FFFFF)) puterror("bad displacement "); #endif; from=ad; /* copy to byte boundaries */ if (encoded!=0) /* encoded area */{ if (a->max==0) { expandarea(area); a->linkdisp=0; } /*first use */ r=(struct rdfm*)(a->base+a->linkdisp); while (((((((a->linkdisp+rdsize)+rdsize)+r->len)+len)+6))>a->max) expandarea(area); to=((((a->base+a->linkdisp)+rdsize)+r->len)+3)&(-4); /*4b bnd*/ r=(struct rdfm*)(to); a->linkdisp=to-a->base; r->disp=disp; r->len=len; r->copies=ncopies; bytemove(len,from,to+rdsize); /* normal mapped area */ } else { for (i=1; i<=ncopies; i++) { while ((disp+len)>=a->max) expandarea(area); /*again byte swopped mcs as pdbytes*/ bytemove(len,from,a->base+disp); disp+=len; } } } /*PDPattern*/ /*******************************************************************************/ void pfiller(int area,int filler) { int id,encoded; struct areafm *areafill; id=area; if ((area==5)||(area>20)) encoded=1; else encoded=0; if (id!=zgst) { if (id>=20) id=syms [id-20].st_value; /*common*/ areafill=&areas [id-lowestarea]; if (((unsigned)areafill->type>>24)==filler) return ; /*Already filled */ areafill->type=filler<<24; if ((encoded!=0)&&(areafill->max==0)) { pd(area,0,filler) /* make sure area is initialised */; } if ((encoded==0)&&(areafill->max>0)) /* Data present */{ fill(areafill->max-areafill->highuse,areafill->base+areafill->highuse,filler); } } } /*PFiller*/ static void placeinshdict(char * name,Elf32_Word *place) { /*************************************************************************/ /** As place in dict but contains only section names **/ /*************************************************************************/ int l; l=strlen(name)+1; *place=shptr; strcpy((char *)&shnames [shptr],name); shptr+=l; } /*************************************************************** */ static void placeindict(char * name,Elf32_Word *place) { /*************************************************************************/ /** Put new name into dictionary (String table) **/ /*************************************************************************/ int l,first; l=strlen(name)+1; /* adding 1 for terminating zero */ if ((dictad+l)>maxdictad) /* have to make dict bigger */{ first=maxdictad; /* 0 on first entry */ expandarea(dicttab); dictstart=areas [dicttab-lowestarea].base; /* the new dict base after expansion */ dictad=dictstart+dictindex; /* go to end of previous dict in new area*/ maxdictad=dictstart+areas [dicttab-lowestarea].max; /* Leave 1 bytes at front of dict for null string (ELF standard) */ if (first==0) { dictstart=dictad; dictad++; dictindex++; } } *place=dictad-dictstart; /*= ptr from sym tab to dict */ strcpy((char *)dictad,name); dictad+=l; /* address of item added in dictionary*/ dictindex+=l; /* current offset into dictionary */ } /*place in dict*/ /*********************************************** */ /** * */ /** Put Interface RELOCATION and REFERENCES * */ /** * */ /*********************************************** */ #define lbrac (0xCA) int pputbrac(int key,int level,int ca) { struct auxblockfm auxblock; int at; if (key==lbrac) { /* Psymbol(".bb",ca,Textsect,Tnull,Cblock,0,1) */ } else { /* Psymbol(".eb",ca,Textsect,Tnull,Cblock,0,1) */ } at=nextsym; memset(&auxblock,0,sizeof( struct auxblockfm)); /* Paux(addr(AuxBlock)) */ return at; } /*PPutBrac*/ void psetopenblock(int id,int ca) { Elf32_Sym *sym; struct auxblockfm *auxblock; lev++; level [lev-1]=id; /* remember block start records' posn. */ sym=&syms [id]; sym->st_value=ca; auxblock=(struct auxblockfm*)&syms [id+1]; auxblock->lnno=line; } /*PsetOpenBlock*/ void psetcloseblock(int id,int ca) { Elf32_Sym *sym; struct auxblockfm *auxblock; sym=&syms [id]; sym->st_value=ca; auxblock=(struct auxblockfm*)&syms [id+1]; auxblock->lnno=line; /* */ /* Now set in the Block start records the index of the first record */ /* past the block. */ /* */ auxblock=(struct auxblockfm*)&syms [level [lev-1]+1]; auxblock->endindex=id+2; lev--; } /*PsetCloseBlock*/ void psymbol(char * name,int value,int size,int type,int class,int area) { /*************************************************************************/ /** remember a name and its properties for inclusion in the **/ /** object file symbol tables **/ /** Undefined symbols (references) have are=0 and value=0 **/ /*************************************************************************/ Elf32_Sym *sym; if (mon!=0) printf("PSYMBOL for %s at %d \n",name,nextsym+1); nextsym++; if ((nextsym+1)>=maxsyms) /*+1 to always leave room for an aux symbol */{ expandarea(symtab); syms=(Elf32_Sym*)((areas [symtab-lowestarea].base)); maxsyms=areas [symtab-lowestarea].max/symboltableentrysize; } sym=&syms [nextsym]; memset(sym,0,sizeof( Elf32_Sym)); placeindict(name,&sym->st_name /* remember name. */); sym->st_value=value; sym->st_size=size; sym->st_info=ELF32_ST_INFO(class,type); sym->st_shndx=area; } /*PSymbol*/ int preplynextsymbol() { if (mon!=0) printf("PreplyNextSymbol\n"); return nextsym+1; } /*PReplyNextsymbol*/ void pbackup(int ad) { Elf32_Sym *r; if (mon!=0) printf("PbackupSymbol\n"); r=(Elf32_Sym*)(ad); *r=syms [nextsym]; nextsym--; } /*PBackup*/ void psetendindex(int id,int index) { struct auxtagfm *auxtag; auxtag=(struct auxtagfm*)&syms [id]; auxtag->endindex=index; } /*PsetEndIndex*/ /********************************************************************************/ /* PXNAME - EXTERNAL PROCEDURE SPEC */ /********************************************************************************/ int pxname(int type,char * s) { /**********************************************************************/ /* Xrefs are used many times so establish mapping to integer ID early */ /* and save on holding/passing of strings */ /**********************************************************************/ char name [256] ; char temp [256] ; int i,k,elftype; Elf32_Sym *sym; if (faulty!=0) return 0; strcpy(name,symbolprefix); if ((s[0]=='s') && (s[1]=='#')) { strcpy(temp,s); temp[1]='_'; strcat(name,temp); } else { strcat(name,s); } /* look to see if this is a repeated reference */ k=stfixedentries; for (i=k; i<=nextsym; i++) { sym=&syms [i]; if (ELF32_ST_BIND(sym->st_info)==STB_GLOBAL && dictstart!=NULL && strcmp(name,(char *)(dictstart+sym->st_name))==0) /*name already in place*/{ if (mon!=0) printf(" PXname:(rep) %s symID = %d\n",s,i+20); return i+20; } } elftype=(type&2)?STT_OBJECT: STT_FUNC; psymbol(name,0,0,elftype,STB_GLOBAL,0) /* first occurrence of name */; if (mon!=0) printf(" PXname: %s symID = %d\n",s,nextsym+20); return nextsym+20; } /*PXname*/ /********************************************************************************/ static void fix(int type,int area,int disp,int tgt,int tgtdisp /* Remember a reloc. request */) { struct rfm *r; int ad; if (mon!=0) printf("FIX: type=%d ,area=%d ,disp=%d ,tgt=%d ,tgtdisp=%d\n", type,area,disp,tgt,tgtdisp); #if(trusted==0) if (area!=255 && area!=254) { if (area<1 || area>(nextsym+20) || tgt<1 || tgt>(nextsym+20) || (area>1 && areas [area-lowestarea].base==0)) puterror("Fix - Bad relocation request"); /* Unitialised area */ } #endif; do { crel++; r=&rels [crel-1]; if ((crel+1)>maxrels) /* start next block of relocations */{ if (malmon!=0) printf(" Space for relocation tables\n"); ad=getspace(defaultareasize); /* marker in type field that this is not a reloc*/ /* , but contains addr of next block */ r->hostdisp=0xFF000000; r->tgtdisp=ad; crel=0; rels=(struct rfm*)((struct rfm *)(ad)); } else break ; } while (1) /* FOR EVER */; if (type<200) /* if it is a genuine reloc request , count it */{ if (area<=symtab) nrels [area]=nrels [area]+1; else nrels [gla]=nrels [gla]+1; ; } r->tgtarea=tgt; r->tgtdisp=tgtdisp; r->hostarea=area; r->hostdisp=(type<<24)|disp; } /********************************************************************************/ /* PFIX - REQUEST A RELOCATION */ /********************************************************************************/ void pfix(int hostarea,int disp,int tgtarea,int tgtdisp) { /*************************************************************************/ /*A relocation request: set word in Hostarea */ /* displacement = disp bytes */ /* to the address of area tgtarea */ /* displacement = tgtdisp bytes */ /*************************************************************************/ int type; if (faulty!=0) return ; if (mon!=0) printf(" PFIX(Fixup %d/%d ->%d/%d type=%d)\n",hostarea,disp,tgtarea,tgtdisp,type); #if(trusted==0) if ((disp<0)||(disp>0xFFFFFF)) puterror("Pfix - bad displacement "); #endif; if (!(hostarea==code)) { while ((disp+4)>areas [hostarea-lowestarea].max) expandarea(hostarea); } type=fullwordfix; #if(target==elfsparc) if ((hostarea==code)&&(tgtarea>setareas)) type=R_SPARC_WDISP30; /* Orrible frig */ #endif; fix(type,hostarea,disp,tgtarea,tgtdisp); } /*Pfix*/ void pfix2(int hostarea,int disp,int tgtarea,int tgtdisp,int type) { /*************************************************************************/ /** PFIX2 - REQUEST A RELOCATION of a given type **/ /** A relocation request: type= 0 =>a normal fixup - 32 bit **/ /** type= 1 => a hi/LO22 fixup **/ /** type= 2 => a 32bit code to code fixup **/ /** type= 3 => a call fixup - PC rel 30 bit **/ /** type= 4 => a fix up in the GOT (offset only)*/ /** type= 5 => a fix up to the GOT(maybe hi-lo)**/ /** type= 6 => a (truncated) fix to GOT **/ /** suitable for small PIC only **/ /** type= 7 => a relative fix to GOT **/ /** suitable for finding GOT only **/ /** type=8&9 is type 1 as 2 separate fixups **/ /** type=10&11 is type 4 as 2 separate fixups **/ /** type=12&13 is type 5 as 2 separate fixups **/ /** Type 4 may be HI-LOW (Large PIC model) and result in the offset **/ /** in the GOT of the symbols reference being loaded. A fix **/ /** is needed as the GOT is built by the linker not the compiler **/ /** Type 5 is used to find the GOT only and produces a relative addr**/ /** the entry sequence has to do a BALR 0 to find out where it has **/ /** been loaded and add this to the relative offset provided by this**/ /** fixup in order to set a pointer to the GOT **/ /*************************************************************************/ int mainfix,subfix; if (faulty!=0) return ; if (mon!=0) printf(" Pfix2(Fixup %d/%d -> %d/%d ---type=%d\n",hostarea,disp,tgtarea,disp,type); #if(trusted==0) if ((disp<0)||(disp>0xFFFFFF)) puterror("Pfix2 - bad displacement"); /**PutError("Pfix2 - bad reloc type") %IF type<0 %OR type>13**/ #endif; if (!(hostarea==code)) { while ((disp+4)>areas [hostarea-lowestarea].max) expandarea(hostarea); } if (type<0) { mainfix=-type; subfix=0; } else { mainfix=fixuprel [type]; subfix=fixupauxrel [type]; } if ((hostarea==debugtab)&&(mainfix==fullwordfix)) mainfix=debugtabfix; fix(mainfix,hostarea,disp,tgtarea,tgtdisp); #if(target==elfsparc) if (type==5) tgtdisp+=4; /*Special for sparc hi-lo relative */ #endif; if (subfix!=0) fix(subfix,hostarea,disp+4,tgtarea,tgtdisp); } /*Pfix2*/ /********************************************************************************/ void pdxref(int area,int disp,int id) { if (faulty!=0) return ; if (mon!=0) printf(" PDXREF( Fixup %d/%d -> %d/)\n",area,disp,id); fix(fullwordfix,area,disp,id,0) /* I expect a Pname to have been done earlier */; } /*PDxref*/ int pcdataarea(int visibility,EPC_offset length,int align,char * name) { /*************************************************************************/ /** Add a C initialised data area that can be rlocated. It is exactly **/ /** like an initialised common without the common property. It will go **/ /** into the data section but be accessed thro its own symbol and not **/ /** as GLAREG+offset. This is needed for PIC to work on Intel and **/ /** perhaps other machines. Initially sym_Value has the area no and **/ /** sym_shdx is zero. The correct values are added in Pgenearteobject **/ /*************************************************************************/ int symtype; char s [256] ; if (faulty!=0) return 0; if (mon!=0) printf("PCDataarea - %s vis=%d al=%d len=%d\n",name, visibility,align,length); strcpy(s,symbolprefix); strcat(s,name); toparea++; if (toparea>maxarea) expandarea(0); symtype=STB_GLOBAL; if (visibility!=0) symtype=STB_LOCAL; psymbol(s,toparea,length,STT_OBJECT,symtype,0); areas [toparea-lowestarea].sym=nextsym+20; areas [toparea-lowestarea].align=align; pd(toparea,0,0); /* Force initialisation */ return nextsym+20; } /*PCcommon*/ void pdataentry(char * name,int area,EPC_offset maxlen,EPC_offset disp) { /********************************************************************************/ /* Defines point at offset in area as a visible data symbol of length maxlen */ /********************************************************************************/ char s[256]; if (faulty!=0) return ; if (mon!=0) printf(" PDataEntry( %d/%d len= %d name=%s)\n",area,disp,maxlen,name); #if(DwarfProducer==PUT) if (sdb!=0) return ; /* externs declared at the end */ #endif; strcpy(s,symbolprefix); strcat(s,name); psymbol(s,disp,maxlen,STT_OBJECT,STB_GLOBAL,area); } /*PDataEntry*/ /*****************************************************************************/ /* */ /* The next three routines deal with PROCEDURES */ /* */ /*****************************************************************************/ /********************************************************************************/ /* PNextsymbol - LOCAL PROCEDURE SPEC */ /********************************************************************************/ int pnextsymbol() { if (faulty!=0) return 0; nextsym++; if (nextsym>=maxsyms) { expandarea(symtab); syms=(Elf32_Sym*)((areas [symtab-lowestarea].base)); maxsyms=areas [symtab-lowestarea].max/symboltableentrysize; } if (mon!=0) printf("Symbol reserved: %d \n",nextsym+20); return nextsym+20; } /*PNextsymbol*/ /********************************************************************************/ /* PENTRY - SIDE CODE ENTRY */ /********************************************************************************/ int pentry2(int props,int codedisp,int id,char * name) { /*************************************************************************/ /** Note a side entry. If id>=0 then it has already been define as a **/ /** reference so alter the existing symbol entry **/ /*************************************************************************/ Elf32_Sym *sym; char s [256] ; int scope,type; if (faulty!=0) return 0; if (mon!=0) printf(" Pentry2: %s Codedisp =%x id=%d\n",name,codedisp,id); /* make a local copy of name adding such prefixes as the various options and operatiing systems demand */ #ifdef DGUXRE if (ecsnameprefix==NULL) s[0]=0; else strcpy(s,ecsnameprefix); strcat(s,symbolprefix); #else strcpy(s,symbolprefix); #endif strcat(s,name); if (codedisp<0) { scope=STB_LOCAL; type=STT_NOTYPE; codedisp=-codedisp; } else { if ((props&1)==0) scope=STB_LOCAL; else scope=STB_GLOBAL; ; type=STT_FUNC; } if (id>0) { sym=&syms [id-20]; sym->st_value=codedisp; sym->st_info=ELF32_ST_INFO(scope,type); sym->st_shndx=code; if (dictstart!=NULL && (*(unsigned char *)(dictstart+sym->st_name))==0) placeindict(s,&sym->st_name); } else { psymbol(s,codedisp,0,type,scope,code) /* make symbol table entry */; id=nextsym+20; } if (mon!=0) printf(" Pentry2_ID= %d\n",id); return id; } /*Pentry2*/ int pentry(int index,int codedisp,char * name) { /*************************************************************************/ /** Old version no prvision for providing ID **/ /*************************************************************************/ return pentry2(index,codedisp,-1,name); } /*Pentry*/ static void addbytesize( struct debugf *,int *,int ); static int fortrantagstring( int ,int ); void pproc(char * name,int props,int codead,int *id) { /*************************************************************************/ /** PPROC - START A NEW PROCEDURE **/ /** PROPS&1 = external **/ /** PROPS&2 = Main entry **/ /** PPROPS>>31 treated as PPROPS&2 for Historic reasons **/ /*************************************************************************/ int scope,ptr,i,k,ttype,btype,sl; short int Short; char s [256] ; char truncate [256] ; Elf32_Sym *sym; struct debugf debug; #ifdef DGUXRE char rest[256]; #endif if (faulty!=0) { *id=1; return ; } if (endpending==1) completeend(); if (mon!=0) { printf(" PProc: %s ID = %d address = %x props = %x\n",name, *id,codead,props); } parentblock=curblock; /* COPE WITH NESTED PROCEDURES */ curlexlev++; curblock=&blocks [curlexlev+1]; memset(curblock,0,sizeof( struct blockfm)); debuglevel=0; if ((props&1)!=0) scope=STB_GLOBAL; else scope=STB_LOCAL; if ((name[0]=='s')&&(name[1]=='#')) { strcpy(s,symbolprefix); strcpy(truncate,name); truncate[1]='_'; strcat(s,truncate); } else { #ifdef DGUXRE if (ecsnameprefix==NULL) s[0]=0; else strcpy(s,ecsnameprefix); strcat(s,symbolprefix); #else strcpy(s,symbolprefix); #endif strcat(s,name); } /* If this procedure has been declared as a spec previously then */ /* a PNextsymbol will have reserved the symbol table entry 'ID' */ /* for it. If there was no spec then ID will = -1 */ if ((impp==0)&&(*id==-1)) { /* Fortran may well have placed a reference to this entry earlier */ /* Search backwards and overwrite (first case only) */ k=stfixedentries; for (i=nextsym; i>=k; i--) { sym=&syms [i]; if ((sym->st_value==0)&&((ELF32_ST_BIND(sym->st_info))==STB_GLOBAL) && dictstart!=NULL && (strcmp(s,(char *)(dictstart+sym->st_name))==0)) *id=i+20; } } if ((props&0x80000002)!=0 || strcmp(s,imp_concat(symbolprefix,"s_go"))==0) { if (sourcelang==ccomp) strcpy(s,centryname); else { #ifdef DGUXRE if (ecsnameprefix==NULL) s[0]=0; else strcpy(s,ecsnameprefix); strcat(s,ftentryname); #else strcpy(s,ftentryname); /*s = "main"*/ #endif } } if (*id==-1) { psymbol(s,0,0,0,0,0); *id=nextsym+20; } if (((props&0x80000002)!=0)||(strcmp(s,imp_concat(symbolprefix,"s_go"))==0)) { mainentrypoint=*id-20; /* remember symno till procend */ /*gm*/ } curblock->sym=*id-20; curblock->ca=codead; procstartline=-1; /*ensure this ca is used in linemap */ sym=&syms [*id-20]; sym->st_value=codead; sym->st_info=ELF32_ST_INFO(scope,STT_FUNC); sym->st_shndx=code; if (dictstart!=NULL && (*(unsigned char *)(dictstart+sym->st_name))==0) placeindict(s,&sym->st_name); #if (DwarfProducer==PUT) if (sdb!=0) { memset(&debug,0,sizeof( struct debugf)); ptr=0; debug.tag=TAGsubroutine; if ((props&1)!=0) debug.tag=TAGglobalsubroutine; addsiblink(&debug,&ptr,curlexlev-1,debuglevel); sl=strlen(name); while (name[strlen(name)-1]=='_') name[strlen(name)-1]=0; /*strip trailing underscore for dwarf*/ if ((props&0x80000002)!=0) strcpy(s,"MAIN"); else { #ifdef DGUXRE if (ecsnameprefix!=NULL && strlen(ecsnameprefix)>0 && s[0]!=0) { if (strncmp(s,ecsnameprefix,strlen(ecsnameprefix))==0) { strcpy(rest,&s[strlen(ecsnameprefix)]); strcpy(s,rest); } } #endif } addname(&debug,&ptr,s); if (strcmp(s,"MAIN")==0 || strcmp(s,"fmain")==0) { Short=ATprogram; bytemove(2,(int)&Short,(int)&debug.data [ptr]); ptr+=2; debug.data [ptr]=0; ptr++; } Short=ATlowpc; bytemove(2,(int)&Short,(int)&debug.data [ptr]); fix(debugtabfix,debugtab,(debugptr+ptr)+8,code,codead); ptr+=6; Short=AThighpc; bytemove(2,(int)&Short,(int)&debug.data [ptr]); curblock->highpcoffset=(debugptr+ptr)+8; ptr+=6; Short=ATEPCPrologue; bytemove(2,(int)&Short,(int)&debug.data [ptr]); curblock->postploffset=(debugptr+ptr)+8; ptr+=6; if (funcrettype!=0) { /* Function,gen return type */ if (funcrettype==tchar) { btype=((debugptr+ptr)+4)+8; /* TAGstring placed after TAGsub */ ttype=ATuserdeftype; } else { ttype=ATfundtype; btype=funcrettype; } addtype(&debug,&ptr,ttype,btype,0); } debug.len=ptr+6; writedbr(&debug); if (funcrettype==tchar) { /*if funcretsize 0 we have char* (*) function*/ /*but don't know where length is use ATstringlen=0*/ if (funcretsize==0) { btype=fortrantagstring(funcretsize,2); } else { btype=fortrantagstring(funcretsize,0); } } } #endif if (mon!=0) printf(" symID = %d\n",*id); } /*PProc*/ #if(target==elfmips) void preginfo(int iregs,int fregs) { /*************************************************************************/ /** Mips requires register usage data to be collated **/ /*************************************************************************/ if (mon!=0) printf("preginfo %x %x\n",iregs,fregs); regsectdata [0]=regsectdata [0]|iregs; regsectdata [2]=regsectdata [2]|fregs; } #endif; /************************************************************************** */ void pprocend(int codead,int framelength) { /*************************************************************************/ /** The end of a procedure. Fill in size param in ST **/ /** Also the end address in SDB info where relevant **/ /** and framesize from eprocend for sdb **/ /*************************************************************************/ Elf32_Sym *sym; if (mon!=0) { printf(" PProcEnd: %x framelength= %d \n",codead,framelength); } if (endpending!=0) completeend(); /* nested propcs*/ if ((trusted==0)&&(curlexlev==0)) puterror("PProcEnd - too many proc ends "); sym=&syms [curblock->sym]; sym->st_size=codead-curblock->ca; #if (DwarfProducer==PUT) if (sdb!=0) { fix(debugtabfix,debugtab,curblock->highpcoffset,code,codead); if ((lastdiagsrec>=0)&&(sourcelang==imp)) impsdb(lastdiagsrec); #if(target==elf88k) || (target==elfmips) framesize=framelength; #endif; parenthighpc=codead; /*save for any ENTRY statements*/ } #endif endpending=1; } static void completeend() { /*************************************************************************/ /** Since pproc & pprocend are called together fron Eprocend **/ /** the lexical links of debug info are screwed. This routine is **/ /** an attempt to hold off completing an end till the pproc **/ /*************************************************************************/ struct debugf dbr; if (mon!=0) printf("Complete end\n"); endpending=0; #if DwarfProducer==PUT if (sdb!=0) { fillsiblink(curlexlev,debuglevel); dbr.len=4; writedbr(&dbr); /* dummy record */ } #endif curblock=parentblock; curlexlev--; parentblock=&blocks [curlexlev-1+1]; debuglevel=0; } /*PProcEnd*/ #if(DwarfProducer!=frontend) /*********************************** */ /** Put Interface - Miscellaneous * */ /*********************************** */ /* */ /*First some service routines for SDB records */ /* */ static void addtype(struct debugf *dbr,int *ptr,int typeattr,int data,int modifier) { /*************************************************************************/ /** Adds the type attribute&value to the debug record **/ /** Basically two cases Fundamental types data=short const **/ /** User defined types data =offset to debug area **/ /** modifier is the type modifier, this changes the type attribute **/ /** at present only volatile is supported for fortran **/ /*************************************************************************/ int i,len; short int Short; unsigned char mod; i=*ptr; if (typeattr==5) typeattr=ATfundtype; if (typeattr==7) typeattr=ATuserdeftype; if (modifier!=0) { if (typeattr==ATfundtype) { typeattr=ATmodfundtype; } else { typeattr=ATmodudtype; } } Short=typeattr; bytemove(2,(int)&Short,(int)&dbr->data [i]); if ((typeattr==ATmodfundtype)||(typeattr==ATmodudtype)) { if (typeattr==ATmodfundtype) { Short=3; /* length- only 1 modifier at present! */ len=Short+2; } else { Short=5; /* user def type is a 4 byte ref */ len=Short; } bytemove(2,(int)&Short,(int)&dbr->data [i+2]); mod=modifier; bytemove(1,(int)&mod,(int)&dbr->data [i+4]); } else { len=2; } if ((typeattr==ATfundtype)||(typeattr==ATmodfundtype)) { Short=data; bytemove(2,(int)&Short,(int)&dbr->data [i+len]); *ptr=(*ptr+2)+len; return ; } if ((typeattr==ATuserdeftype)||(typeattr==ATmodudtype)) { fix(debugtabfix,debugtab,((debugptr+*ptr)+6)+len,debugtab,data); *ptr=(*ptr+4)+len; return ; } puterror("Bad debug type info"); } /*add type*/ /** */ static void addname(struct debugf *dbr,int *ptr,char * name) { /************************************************************************* */ /** Adds the attribute&value for the text of a variable name **/ /** The coding assumes dbr has been zeroed! **/ /************************************************************************* */ int i,j,l; short int Short; i=*ptr; Short=ATname; bytemove(2,(int)&Short,(int)&dbr->data [i]); l=strlen(name); for (j=1; j<=l; j++) dbr->data [(i+j)+1]=name[j-1]; *ptr=(*ptr+l)+3; } /* add name*/ static void fillsiblink(int lexl,int dbl) { /*************************************************************************/ /** Sibling record are linked together for SDB **/ /*************************************************************************/ struct blockfm *block; block=&blocks [lexl+1]; if (block->siblink [dbl]!=0) fix(debugtabfix,debugtab,block->siblink [dbl],debugtab,debugptr); block->siblink [dbl]=0; } static void addsiblink(struct debugf *dbr,int *ptr,int lexl,int dbl) { /*************************************************************************/ /** Add the sibling link to the record. The last link goes to a dummy**/ /** since at this stage we do not know if this is the last SDB entry **/ /*************************************************************************/ short int Short; fillsiblink(lexl,dbl); Short=ATsibling; bytemove(2,(int)&Short,(int)&dbr->data [*ptr]); blocks [lexl+1].siblink [dbl]=(debugptr+*ptr)+8; *ptr+=6; } static void generatestackloc(struct debugf *dbr,int *ptr,int offset,int params) { /*************************************************************************/ /** generates the loc atoms required to locate an item at an offset from**/ /** the sp(88k) or fp(others). offset is the stack offset, updates the **/ /** callers block ptr. **/ /** if params is non 0 then loc is for a parameter **/ /** For 88K parameters,(fortran area7),the offset is the offset into **/ /** the parameter save area (parameters are saved on stack if -g). This **/ /** is added to the dynamic framesize (from eprocend) which is the **/ /** amount of stack space required to hold any automatics and the **/ /** stacked parameters eg: **/ /** sp on entry -> ... ----- **/ /** arg n : **/ /** arg n-1 :---------- **/ /** arg 1 : arg1 off **/ /** auto 1 :---------- **/ /** auto n-1 : framesize **/ /** auto n : /|\ **/ /** 64 bytes of red tape(?) : | **/ /** sp after subu -> -------------- **/ /** **/ /** For SPARC the code generator dumps arg 1 at %FP+PARAMBASE and **/ /** arg n at %FP+PARAMBASE+sizeof(arg n) **/ /** PARAMBASE is a constant with value x'44' and is the same as the one **/ /** defined in sparc13.8.inc **/ /*************************************************************************/ int i,x; i=*ptr; dbr->data [i]=OPBASEREG; x=sdblnbreg; /* frame pointer reg from include file */ bytemove(4,(int)&x,(int)&dbr->data [i+1]); dbr->data [i+5]=OPCONST; #if(target==elf88k) /*88k uses sp,not fp */ if (params==1) { offset+=framesize; /*autos on stack*/ } else { offset=framesize-offset; } #else #if(target==elfsparc) if (params==1) { offset+=parambase; /*autos on stack*/ } else { } /*unknown target*/ #else #if(Target==elfmips) offset+=framesize #else if (params==1) { offset+=param1offset; /*autos on stack*/ } else { } #endif #endif #endif; bytemove(4,(int)&offset,(int)&dbr->data [i+6]); dbr->data [i+10]=OPADD; *ptr=i+11; } /*Generate Stack Loc */ static void addloc(struct debugf *dbr,int *ptr,int area,int offset,int ref,int offset2) { /*************************************************************************/ /** add the attribute & value pair to define variable location **/ /** if area is static a fixup is used. Otherwise a computation **/ /** must be included in the data **/ /*************************************************************************/ int i,j,x,k; short int Short; i=*ptr; j=i+4; Short=ATlocation; bytemove(2,(int)&Short,(int)&dbr->data [i]); if ((target==elf88k)&&((area==7)||(area==0))) /*params*/ /*stack*/{ if (offset<0) offset=-offset; /* sp-off->sp+off as debuggers treat */ /* all addresses as unsigned */ /* 88k codegen dumps arg regs to */ /* stack unlike sparc */ } if (area==7) /*params*/{ k=j; generatestackloc(dbr,&k,offset,1); j=k; /*stack*/ } else if (area==0) { /* compute from fp,(sp if 88k) */ k=j; generatestackloc(dbr,&k,offset,0); j=k; } else { if (area>0) { if (ref==-1) x=4; else x=3; ; dbr->data [i+4]=x; /*fixed up const or address follows */ fix(debugtabfix,debugtab,(debugptr+*ptr)+11,area,offset); j=i+9; } }; if (ref>0) { dbr->data [j]=6; j++; } /*deref*/ if ((offset2!=0)||(area<0)) { dbr->data [j]=OPCONST; bytemove(4,(int)&offset2,(int)&dbr->data [j+1]); dbr->data [j+5]=OPADD; j+=6; } *ptr=j; Short=(j-i)-4; /* fill in length */ bytemove(2,(int)&Short,(int)&dbr->data [i+2]); } /*add loc*/ static void addstringlen(struct debugf *dbr,int *ptr,int len,int param) { /*************************************************************************/ /** add the attribute varable pair for a (const) string length **/ /** if param is 1 then len is an offset into the param save area **/ /** which contains the character's length **/ /** if param is 2 then we are writing out a zero stringlen for a **/ /** character*(*) function or entry, which is represented with an **/ /** ATstringlen of 0 **/ /*************************************************************************/ int i,j; short int Short; i=*ptr; Short=ATstringlength; bytemove(2,(int)&Short,(int)&dbr->data [i]); if (param==0) /*string len known at compile time-fortran uses bsize*/{ Short=5; /* 5 bytes follow (length of block) */ bytemove(2,(int)&Short,(int)&dbr->data [i+2]); dbr->data [i+4]=OPCONST; bytemove(4,(int)&len,(int)&dbr->data [i+5]); *ptr=i+9; } else if (param==1) { j=i+4; generatestackloc(dbr,&j,len,1); dbr->data [j]=OPDEREF4; j++; *ptr=j; Short=(j-i)-4; /* fill in length */ bytemove(2,(int)&Short,(int)&dbr->data [i+2]); /*char *(*) function return length*/ } else if (param==2) { bytemove(2,(int)&Short,(int)&dbr->data [i+2]); }; } /*add stringlen*/ static void addbytesize(struct debugf *dbr,int *dptr,int size) { int i; short int Short; i=*dptr; Short=ATbytesize; bytemove(2,(int)&Short,(int)&dbr->data [i]); bytemove(4,(int)&size,(int)&dbr->data [i+2]); *dptr+=6; } static void insertfilename(int lang) { /*************************************************************************/ /** Put the source file name as first entry in debug data **/ /** Sets up most of the compile_unit DIE **/ /** Certain elements of this entry must be completed in Pterminate **/ /** as the info is not yet available **/ /** lang is the EPC language code **/ /*************************************************************************/ struct debugf dbr; int ptr,ptr1,len; int atlang; /*dwarf language encoding*/ short int Short; static char cname [60+1]; static const int elflang [20] = { 0x8000 /*Imp*/,7 /*Fort*/,0,0 /*C*/,0,0, 0,0, 0,0,1,0,0,9,0 }; memset(&dbr,0,sizeof( struct debugf)); dbr.tag=TAGcompileunit; Short=ATlowpc; bytemove(2,(int)&Short,(int)&dbr.data [0]); fix(debugtabfix,debugtab,8,code,0); /* fix Low PC to code start */ Short=AThighpc; bytemove(2,(int)&Short,(int)&dbr.data [6]); /* 8-11 will be fixed in Pterminate */ Short=ATsibling; bytemove(2,(int)&Short,(int)&dbr.data [12]); /* 14-17 will be fixed to end of debug data */ Short=ATlanguage; bytemove(2,(int)&Short,(int)&dbr.data [18]); atlang=elflang [lang-1]; bytemove(4,(int)&atlang,(int)&dbr.data [20]); Short=ATstmtlist; bytemove(2,(int)&Short,(int)&dbr.data [24]); fix(debugtabfix,debugtab,32,linetab,0); /* 26-29 point to linetab */ ptr=30; addname(&dbr,&ptr,srcfile); Short=ATproducer; bytemove(2,(int)&Short,(int)&dbr.data [ptr]); strcpy(cname,dwarfversion); len=strlen((char *)cname ); bytemove(len,(int)&cname [0],(int)&dbr.data [ptr+2]); ptr=(ptr+3)+len; ptr1=(int )getcwd(NULL,512); if (ptr1!=0) { Short=ATcompdir; bytemove(2,(int)&Short,(int)&dbr.data [ptr]); len=strlen((char *)ptr1); bytemove(len,ptr1,(int)&dbr.data [ptr+2]); ptr=(ptr+3)+len; } else { puterror("getcwd"); } Short=ATlouser|FORMDATA2; /* DG dwarf extension for mxdb to indicate */ /* the compiler maps ident case */ bytemove(2,(int)&Short,(int)&dbr.data [ptr]); if (casesense==0) /*-CS option*/{ Short=3; /* DG dwarf extension 3 says compiler gives low case idents */ } else { Short=1; /* leaves as mixed case */ } bytemove(2,(int)&Short,(int)&dbr.data [ptr+2]); ptr+=4; dbr.len=ptr+6; pdbytes(debugtab,0,dbr.len,(int)&dbr); debugptr=dbr.len; } /*insert filename*/ static void writedbr(struct debugf *dbr) { /*************************************************************************/ /** Outputs a debug record **/ /*************************************************************************/ int l,offset; l=dbr->len; offset=debugptr; debugptr+=l; /* So pdbytes does not interefere qv */ pdbytes(debugtab,offset,l,(int)dbr); } /*write DBR*/ /********************************************************************************/ static void addloc2(struct debugf *dbr,int *ptr,struct locf *loc) { short int Short; int i,j,x; i=*ptr; Short=ATlocation; bytemove(2,(int)&Short,(int)&dbr->data [i]); switch (loc->dis){ case 0: case 1: dbr->data [i+4]=4+loc->dis; bytemove(4,(int)&loc->offset,(int)&dbr->data [i+5]); j=i+9; break; case 2: dbr->data [i+4]=1+loc->dref; dbr->data [i+8]=loc->offset; /* >255 registers wont work */ j=i+9; break; case 3: if (loc->area==0) { /*compute from fp */ dbr->data [i+4]=OPREG; x=sdblnbreg; /* frame pointer reg from include file */ bytemove(4,(int)&x,(int)&dbr->data [i+5]); dbr->data [i+9]=OPCONST; bytemove(4,(int)&loc->offset,(int)&dbr->data [i+10]); dbr->data [i+14]=OPADD; j=i+15; } else { dbr->data [i+4]=OPADDR; fix(debugtabfix,debugtab,(debugptr+*ptr)+11,loc->area,loc->offset); j=i+9; } if (loc->dref>0) { dbr->data [j]=6; j++; } /*deref*/ break; default: puterror("Bad diagnostic data in addloc2"); } *ptr=j; Short=(j-i)-4; /* fill in length */ bytemove(2,(int)&Short,(int)&dbr->data [i+2]); } /*add loc2*/ static void addbitsizeoff(struct debugf *dbr,int *ptr,int size,int offset) { short int Short; int i; i=*ptr; Short=ATbitoffset; bytemove(2,(int)&Short,(int)&dbr->data [i]); Short=offset; bytemove(2,(int)&Short,(int)&dbr->data [i+2]); Short=ATbitsize; bytemove(2,(int)&Short,(int)&dbr->data [i+4]); bytemove(4,(int)&size,(int)&dbr->data [i+6]); *ptr+=10; } /*add bit sizeof*/ int psdbbitentry(int tag,char * name,int type1,int type2,int bytes,int bitoffset,int bitsize,struct locf *loc) { /******************************************************************** */ /** add an entry for a bit field * */ /******************************************************************** */ short int Short; struct debugf dbr; int dptr,result; if (mon!=0) printf("PSDBbitENTRY %s type=%d %d\n",name,type1,type2); memset(&dbr,0,sizeof( struct debugf)); dptr=0; result=0; if (((strcmp(name,".end")==0)||(strcmp(name,".END")==0))&&(debuglevel>0)) { dbr.len=4; fillsiblink(curlexlev,debuglevel); writedbr(&dbr); /*dummy to terminate chain */ debuglevel--; return 0; } dbr.tag=tag; addsiblink(&dbr,&dptr,curlexlev,debuglevel); addname(&dbr,&dptr,name); if (tag==4) { /* enumeration type */ addbytesize(&dbr,&dptr,bytes); Short=0xF3; /* shouldn't this be x'f0'!FORMBLOCK4?? */ bytemove(2,(int)&Short,(int)&dbr.data [dptr]); Short=loc->dis; /* bytes following */ bytemove(2,(int)&Short,(int)&dbr.data [dptr+2]); bytemove(loc->dis,(int)&loc->offset,(int)&dbr.data [dptr+4]); dptr=(dptr+loc->dis)+4; return 0; } if (bitsize!=-1) addbitsizeoff(&dbr,&dptr,bitsize,bitoffset); addtype(&dbr,&dptr,type1,type2,0); if (type2==0) result=(debugptr+dptr)+4; addloc2(&dbr,&dptr,loc); return result; } /*PSDB Bitentry */ int psdbentry(int tag,char * name,int type1,int type2,int bytes,struct locf *loc) { return psdbbitentry(tag,name,type1,type2,bytes,-1,-1,loc); } static int fortrantagstring(int bytes,int tagmode) { /*****************************************************************************/ /** Generates Fortran Tagstringtype for character items */ /** Fortran character variables are treated as user def types with either */ /** at_bytesize if size known or at_stringlen if they are params */ /** returns pointer to TAGstring die for use as userdefined type */ /** mode=0, size known, mode=1 size is passed as an argument at runtime */ /** and add stringlen generates location atoms */ /** if mode is 2 then add stringlen generates a 0 size at_stringlen to */ /** indicate the return from a char* (*) function */ /*****************************************************************************/ struct debugf dbr; int j,dptr; memset(&dbr,0,sizeof( struct debugf)); dbr.tag=TAGstringtype; dptr=0; addsiblink(&dbr,&dptr,curlexlev,debuglevel); if (tagmode==0) { /*length known at compile time */ addbytesize(&dbr,&dptr,bytes); } else if (tagmode==1) { addstringlen(&dbr,&dptr,bytes,tagmode); /* length is param */ /*char *(*) function return*/ } else if (tagmode==2) { addstringlen(&dbr,&dptr,bytes,tagmode); /* length is 0 */ }; dbr.len=dptr+6; j=debugptr; writedbr(&dbr); return j; } /** */ void gencommoninclusiondie(int cmnptr) { /*****************************************************************************/ /** generates a common_inclusion_die in the current subroutine die **/ /** cmnptr points to the aprropriate common_block_die **/ /*****************************************************************************/ struct debugf dbr; static int dptr=0; static short int Short=0; memset(&dbr,0,sizeof( struct debugf)); dbr.tag=TAGcommoninclusion; addsiblink(&dbr,&dptr,curlexlev,debuglevel); Short=ATcommonreference; bytemove(2,(int)&Short,(int)&dbr.data [dptr]); bytemove(4,(int)&cmnptr,(int)&dbr.data [dptr+2]); dbr.len=dptr+12; writedbr(&dbr); } /* Gen Common Inclusion DIE */ static const int tconv [17+1] = { tshort,tint,tnull, tfloat,tdouble,tnull,tcomplex,tdcomplex, tnull,tuchar,tushort,tbool,tnull,tchar,tchar,tschar, tint,tnull}; /** */ /** */ /** */ int psdbarrctype(char * name,int type1,int type2,int bytes,int ndims,int order,int adbounds #ifdef DGUXRE ,int vtype #endif ) { /*************************************************************************/ /** Define an array in a record field with Known bounds **/ /** record field types are modes,normal scalar or array types are **/ /** classes straight out of the dict and are handled in psdbvar! **/ /** hence this code can use the Tconv array to convert to dwarf types **/ /** without having to check sizes. PSDB Struct Member is similar **/ /** For DGUX Kevin has added an extra parameter may well cause problems **/ /*************************************************************************/ short int Short; int i,j,ftype,aptr,atptr,modifier; struct debugf adbr; if ((mon!=0)&&(bytes!=0)) { printf(" PSDBarrc: %s type1,type2 = %d %d\n",name,type1,type2); } atptr=debugptr; memset(&adbr,0,sizeof( struct debugf)); /* Clear record for array type info */ adbr.tag=TAGarraytype; aptr=0; if (ndims>1) { /* Multi dimension needs ordering */ Short=ATordering; bytemove(2,(int)&Short,(int)&adbr.data [aptr]) /*ordering*/; Short=order; bytemove(2,(int)&Short,(int)&adbr.data [aptr+2]); aptr+=4; } i=aptr; Short=ATsubscrdata; bytemove(2,(int)&Short,(int)&adbr.data [aptr]); Short=11*ndims; /* 11 bytes per dimension */ bytemove(2,(int)&Short,(int)&adbr.data [aptr+2]); aptr+=4; for (j=0; j<=ndims-1; j++) { adbr.data [aptr]=FMTFTCC; Short=tint; /* Bound aresigned integers */ bytemove(2,(int)&Short,(int)&adbr.data [aptr+1]); bytemove(8,adbounds+(8*j),(int)&adbr.data [aptr+3]); /* two consts */ aptr+=11; } adbr.data [aptr]=8; /*element type defn next */ aptr++; ftype=type2; if (type1<0) { type2=tconv [type2]; type1=ATfundtype; } if (type2==tchar) { atptr=debugptr+18; /* TAGstring comes first so adjust */ type2=fortrantagstring(bytes,0); type1=ATuserdeftype; } #ifdef DGUXRE if ((vtype&0x01000000)!=0) modifier=MODEPCrep88k; #else modifier=0; #endif addtype(&adbr,&aptr,type1,type2,modifier); Short=(aptr-i)-4; bytemove(2,(int)&Short,(int)&adbr.data [i+2]); addsiblink(&adbr,&aptr,curlexlev,debuglevel); if (strcmp(name,"")!=0) addname(&adbr,&aptr,name); adbr.len=aptr+6; writedbr(&adbr); return atptr; } /* PSDBarrctype */ int psdbstructtype(char * name,int csu,int bytes) { struct debugf dbr; int dptr,j; if (mon!=0) printf(" PSDB Struct Type:%s size=%d\n",name,bytes); memset(&dbr,0,sizeof( struct debugf)); dbr.tag=TAGstructuretype; dptr=0; addsiblink(&dbr,&dptr,curlexlev,debuglevel); if (!(strcmp(name,"")==0)) addname(&dbr,&dptr,name); addbytesize(&dbr,&dptr,bytes); j=debugptr; dbr.len=dptr+6; writedbr(&dbr); debuglevel++; return j; } /** */ void psdbendstruct() { struct debugf dbr; struct blockfm *block; dbr.len=4; fillsiblink(curlexlev,debuglevel); writedbr(&dbr); block=&blocks [curlexlev+1]; block->siblink [debuglevel]=0; debuglevel--; return ; } /** */ int psdbptrtype(char * name,int type1,int type2) { struct debugf dbr; int dptr,j; memset(&dbr,0,sizeof( struct debugf)); dbr.tag=TAGpointertype; dptr=0; if (!(strcmp(name,"")==0)) addname(&dbr,&dptr,name); addsiblink(&dbr,&dptr,curlexlev,debuglevel); addtype(&dbr,&dptr,type1,type2,0); j=debugptr; writedbr(&dbr); return j; } void psdbfref(int marker,int key) { bytemove(4,(int)&key,areas [debugtab-lowestarea].base+marker); } /** */ int psdbcmnstart(char * s,int id) { /*************************************************************************/ /** Create dwarf common block DIE **/ /** returns common block DIE ref so it can be referenced in any routine **/ /** which includes the common **/ /** S is the common name,Id is its area **/ /*************************************************************************/ struct debugf dbr; int dptr,typeref; char str [64] ; if (mon!=0) printf("Psdbcmnstart %s %d\n",s,id); memset(&dbr,0,sizeof( struct debugf)); dptr=0; dbr.tag=TAGcommonblock; addsiblink(&dbr,&dptr,curlexlev,debuglevel); strcpy(str,checkblankcommon(s)); if (((strcmp(str,"_BLNK__")==0)||(strcmp(str,"_blank")==0))||(strcmp(str,"BLNK__")==0)) { strcpy(str,""); /* Mxdb expects null for blank common */ } addname(&dbr,&dptr,str); addloc(&dbr,&dptr,id,0,-1,0); dbr.len=dptr+6; typeref=debugptr; writedbr(&dbr); debuglevel++; /* common members are children */ return typeref; /* for later refs to common */ } /** */ void psdbcmnend(char * s,int id) { struct debugf dbr; if (mon!=0) printf("Psdbcmnend %s id=%d\n",s,id); dbr.len=4; fillsiblink(curlexlev,debuglevel); writedbr(&dbr); debuglevel--; return ; } /** */ void psdbstructmember(char * name,int type1,int type2,int disp,int size,int nels #ifdef DGUXRE ,int vtype #endif ) { /*********************************************************************************/ /** Set up a new dbx type for a structure. Called once for each structure member*/ /** name - field name */ /** type1 - <0 if item is scalar else 0 */ /** type2 - mode type of field */ /** disp - byte offset of field in struct */ /** size - size in bytes of field type */ /** nels - no. of elements (if array field) */ /*********************************************************************************/ struct debugf dbr; int dptr; int type,ttype,ftype,modifier; if (faulty!=0) return ; if (mon!=0) { printf(" PSDB Struct Member: %s type1=%x type2=%x",name,type1,type2); printf("disp =%d size=%d nels=%d\n",disp,size,nels); } if (type1<0) /*not array or record*/{ ftype=ATfundtype; ttype=type2; type=tconv [ttype]; if (type==tchar) { ftype=ATuserdeftype; type=fortrantagstring(size,0); } } else { ftype=ATuserdeftype; type=type2; } memset(&dbr,0,sizeof( struct debugf)); dbr.tag=TAGmember; dptr=0; addsiblink(&dbr,&dptr,curlexlev,debuglevel); if (!(strcmp(name,"")==0)) addname(&dbr,&dptr,name); #ifdef DGUXRE if ((vtype&0x01000000)!=0) modifier=MODEPCrep88k; #else modifier=0; #endif addtype(&dbr,&dptr,ftype,type,modifier); addloc(&dbr,&dptr,-1,0,0,disp); dbr.len=dptr+6; writedbr(&dbr); return ; } /*of PSDB Struct Member */ /** */ /** */ #define iinteger 1 #define real 2 #define complex 3 #define logical 4 #define character 5 /*Fortran dictionary types*/ static int gettype(int ttype,int size) { /*************************************************************************/ /** Convert Fortran dictionary class and size into dwarf basic type **/ /** ftnend should really pass in mode like we do for records etc above **/ /** ttype is Fortran Dict type,size is size of basic type **/ /*************************************************************************/ int type; if (ttype==iinteger) { if (size==4) type=tint; if (size==2) type=tshort; if (size==1) type=tschar; } else { if (ttype==real) { if (size==8) type=tdouble; else type=tfloat; ; } else { if (ttype==character) { type=tchar; } else { if (ttype==complex) { if (size==4) type=tcomplex; else type=tdcomplex; ; } else { if (ttype==logical) { if (size==4) type=tbool; if (size==2) type=tushort; /*kluge for dwarf as it*/ if (size==1) type=tuchar; /*only has Tbool*/ } } } } } return type; } /* Get Type (mxdb) */ void entrypointinfo(int type,int bytesize) { /*************************************************************************/ /** called from ftnend before eprocend an subsequent pproc calls to put */ /** which generate TAGglobalsubroutine dies */ /** if type is non-zero then info is function return type */ /** Sets up the return type of subroutine or function */ /*************************************************************************/ int ttype; if (mon!=0) printf("Entry Point Info: type=%d, bytesize=%d\n",type,bytesize); if (type==0) { funcrettype=0; /* subroutine */ funcretsize=0; } else { ttype=gettype(type&7,bytesize); funcrettype=ttype; /* used by PPROC for function result */ funcretsize=bytesize; } } /* Entry Point Info */ void GenerateEntryDIE(char * name,int labad,int codead) { /*************************************************************************/ /* Generates a TAG_ENTRY_POINT die for given entry point */ /** Called from ftnend via mprocs output dbx entrys routine */ /** labad is the address of the label in the parent routine which is */ /** jumped to AFTER the prolog ie the 1st exec stmt after the ENTRY stmt */ /** codead is the entry prolog start address */ /*************************************************************************/ short int Short; int ttype,ptr,btype; struct debugf debug; /* Mxdb user defined AT's for Entry Points */ /* AT_low_pc is offset to 1st executable after ENTRY stmt */ /* ATprologstart the start of an entry points prolog for breakpoint */ /* setting, ATprologend allows the debugger to detect if it is still */ /* in the ENTRY prolog, it holds the code offset to the instr after */ /* the parents code including all the prologs */ static const int ATprologstart=((ATlouser+0x10)|FORMADDR); static const int ATprologend=((ATlouser+0x20)|FORMADDR); if (mon!=0) printf("Generate Entry DIE: name=%s,ladad=%d,codead=%x\n", name,labad,codead); memset(&debug,0,sizeof( struct debugf)); ptr=0; debug.tag=TAGentrypoint; addsiblink(&debug,&ptr,curlexlev,debuglevel); while (name[strlen(name)-1]=='_') name[strlen(name)-1]=0; /*strip trailing underscore for dwarf*/ addname(&debug,&ptr,name); Short=ATlowpc; bytemove(2,(int)&Short,(int)&debug.data [ptr]); bytemove(4,(int)&labad,(int)&debug.data [ptr+2]); ptr+=6; Short=ATprologstart; bytemove(2,(int)&Short,(int)&debug.data [ptr]); bytemove(4,(int)&codead,(int)&debug.data [ptr+2]); ptr+=6; Short=ATprologend; bytemove(2,(int)&Short,(int)&debug.data [ptr]); bytemove(4,(int)&parenthighpc,(int)&debug.data [ptr+2]); ptr+=6; if (funcrettype!=0) { /* Function,gen return type */ if (funcrettype==tchar) { btype=((debugptr+ptr)+4)+8; /* TAGstring placed after TAGsub */ ttype=ATuserdeftype; } else { ttype=ATfundtype; btype=funcrettype; } addtype(&debug,&ptr,ttype,btype,0); } debug.len=ptr+6; writedbr(&debug); if (funcrettype==tchar) { if (funcretsize==0) /*char *(*) entry,use ATstringlen=0*/{ btype=fortrantagstring(funcretsize,2); } else { btype=fortrantagstring(funcretsize,0); } } debuglevel++; /*for any params*/ } /* output DBX ENTRYS */ void endentryparams() { /*************************************************************************/ /** changes debuglevel back to subroutine child when entry params are */ /** completed */ /*************************************************************************/ struct debugf dbr; if (mon!=0) printf("End Entry Params\n"); dbr.len=4; fillsiblink(curlexlev,debuglevel); writedbr(&dbr); debuglevel--; return ; } /* End Entry Params */ void psdbvar(int swad,int vtype,int area,int disp,int bytesize,int nels,int ndims,int boundsarray,int boundtypearray ) { /*************************************************************************/ /** Take details of variables and encode for SDB **/ /** boundsarray and boundtypearray describe array dimensions **/ /** For each dimension there is a pair of elements in these arrays **/ /** In the bounds array, the first of each pair is the low bound, and **/ /** the 2nd the high bound. The boundtype array describes where each **/ /** dimension is to be found, again lowbound first,hibound second. The **/ /** possible values in this array are 0 - bound is known at compile time**/ /** 2 - bound is a an offset on the stack as it is a parameter, 3 - **/ /** parameter array is assumed size **/ /** A swad of 0 indicates a function result type is being passed for **/ /** the current function **/ /** **/ /** vtype - bits 0-7 encode basic type **/ /** 8 parameter **/ /** 28 volatile **/ /** 29 Record **/ /** 30 Record Parameter **/ /** 31 Pointer Based Variable (-vtype) **/ /** **/ /** Record variables come thru here. For them the vtype contains the **/ /** number of the DIE which defines their structure type. This will have**/ /** been set up previously by Psdb Struct Type. This means that it can **/ /** interfe with with 'normal' info which is contained in the ls byte of**/ /** vtype. To differentiate records we therefoe use bits 29 and 30. **/ /** (of course if we ever have >2^29 dies this will fail!! **/ /*************************************************************************/ static const int ptr=1; /*sdb type modifiers*/ /*vtype masks*/ static const int ischaracter=5; static const int isparam=0x80; static const int isvolatile=0x10000000; static const int isrecord=0x20000000; static const int isrecordparam=0x40000000; static const int ispbv=0x80000000; char *s; short int Short; int i,j,k,type,ttype,ref,dptr,aptr,tag,ftype,start,fspec,lenmark; int ischar; /* 1 if item is character */ short int subscrlen; /* length of array subscript info in dwarf */ short int len,len1; struct debugf dbr,adbr; static struct debugf lastadbr; static int lastdebugptr=0; int *bounds,*boundtype; int modifier,vtype2; if (faulty!=0) return ; if (swad==0) return ; s=((char *)swad); if (ndims>0) { bounds=((int *)(boundsarray)); boundtype=((int *)(boundtypearray)); } if (mon!=0) { printf(" PSDBVAR: %s type =%d ",s,vtype); if (vtype<0) printf(" Pointer Based Variable"); printf("\n area= %d disp=%d bytesiz=%d ",area,disp,bytesize); if (bytesize>0) { printf("/nels/ndims= %d %d\n",nels,ndims); if (ndims!=0) { printf("bounds:"); for (i=1; i<=ndims*2; i++) { if ((i&1)!=0) { printf("%2d :%2d,",bounds [i],bounds [i+1]); } } printf("\n"); printf("boundtype:"); for (i=1; i<=ndims*2; i++) { if ((i&1)!=0) { printf(",%2d :%2d",boundtype [i],boundtype [i+1]); } } printf("\n"); } printf("\n"); } else { printf("\n"); } } ref=0; dptr=0; memset(&dbr,0,sizeof( struct debugf)); tag=TAGlocalvariable; if ((vtype&ispbv)!=0) { vtype=-vtype; /*quick and dirty way of handling Pointers*/ ref=ptr; /*to at least get correct value*/ } if ((vtype&(isrecord|isrecordparam))==0) { ftype=ATfundtype; ttype=vtype&7; type=gettype(ttype,bytesize); vtype2=vtype&0x00ffffff; /* removing swopped bit */ if (vtype2==ischaracter || vtype2==(isvolatile|ischaracter) || vtype2==(isparam|ischaracter)) { if (boundtype [2]==2) { /* char length not known yet (param) */ type=fortrantagstring(bounds [2],1); /*plants AT_string_len */ } else { type=fortrantagstring(bounds [2],0); /* 1st dim upper bound is len */ } ftype=ATuserdeftype; ischar=1; } else { ischar=0; } if ((vtype&isparam)!=0) { ref=ptr; /* item is a parameter*/ tag=TAGformalparameter; } /*we have a record variable*/ } else { ftype=ATuserdeftype; type=vtype&0x9FFFFFFF; /* strip record info */ if ((vtype&isrecordparam)!=0) { ref=ptr; /* item is a parameter */ tag=TAGformalparameter; } ischar=0; } if ((nels>1)&&!(((ischar==1)&&(ndims==1)))) { /* array */ memset(&adbr,0,sizeof( struct debugf)); /* Clear record for array type info */ adbr.tag=TAGarraytype; aptr=0; if (ndims>1) { /* Multi dimension needs ordering */ Short=ATordering; bytemove(2,(int)&Short,(int)&adbr.data [aptr]) /*ordering*/; if (sourcelang==fortran) { Short=ORDcolmajor; } else { Short=ORDrowmajor; } bytemove(2,(int)&Short,(int)&adbr.data [aptr+2]); aptr+=4; } i=aptr; Short=ATsubscrdata; bytemove(2,(int)&Short,(int)&adbr.data [aptr]); lenmark=aptr+2; aptr+=4; if (ischar==1) { start=3; /* skip length dim for chars */ } else { start=1; } subscrlen=0; for (j=start; j<=((ndims*2)-1); j+=2) { if (boundtype [j]==0) { if (boundtype [j+1]==0) fspec=FMTFTCC; else fspec=FMTFTCX; ; } else { if (boundtype [j+1]==0) fspec=FMTFTXC; else fspec=FMTFTXX; ; } if (boundtype [j+1]==3) /*assummed sized dimension*/{ fspec=FMTFTCX; /*eg integer a(1,8,*)always last dim*/ } adbr.data [aptr]=fspec; /* Format Specifier */ Short=tint; /* Bound are signed integers */ bytemove(2,(int)&Short,(int)&adbr.data [aptr+1]); if (fspec==FMTFTCC) { bytemove(8,(int)&bounds [j],(int)&adbr.data [aptr+3]); /* two consts */ aptr+=11; subscrlen=11+subscrlen; } else if (fspec==FMTFTCX) { bytemove(4,(int)&bounds [j],(int)&adbr.data [aptr+3]); /* one const */ k=(aptr+7)+2; if (boundtype [j+1]==3) /*assummed sized dimension*/{ len=0; /* mxdb expects 0 sized high bound loc */ } else { generatestackloc(&adbr,&k,bounds [j+1],1); /* one location descr */ adbr.data [k]=OPDEREF4; adbr.data [k+1]=OPDEREF4; k+=2; len=k-(aptr+9); } bytemove(2,(int)&len,(int)&adbr.data [aptr+7]); /*loc block len */ subscrlen=len+subscrlen; aptr=k; } else if (fspec==FMTFTXC) { k=(aptr+3)+2; generatestackloc(&adbr,&k,bounds [j],1); /* one location descr */ adbr.data [k]=OPDEREF4; adbr.data [k+1]=OPDEREF4; k+=2; len=k-(aptr+5); bytemove(2,(int)&len,(int)&adbr.data [aptr+3]); /*block len */ aptr=k; bytemove(4,(int)&bounds [j+1],(int)&adbr.data [aptr]); aptr+=4; subscrlen=(len+4)+subscrlen; } else if (fspec==FMTFTXX) { k=(aptr+3)+2; generatestackloc(&adbr,&k,bounds [j],1); /* one location descr */ adbr.data [k]=OPDEREF4; adbr.data [k+1]=OPDEREF4; k+=2; len=k-(aptr+5); bytemove(2,(int)&len,(int)&adbr.data [aptr+3]); /*block len */ aptr=k; k+=2; /* skip upper bound loc info len */ generatestackloc(&adbr,&k,bounds [j+1],1); /* one location descr */ adbr.data [k]=OPDEREF4; adbr.data [k+1]=OPDEREF4; k+=2; len1=(k-aptr)-2; bytemove(2,(int)&len1,(int)&adbr.data [aptr]); /*loc block len */ subscrlen=(len+len1)+subscrlen; aptr=k; }; } bytemove(2,(int)&subscrlen,(int)&adbr.data [lenmark]); /*len of subs inf */ adbr.data [aptr]=FTsignedinteger; aptr++; #ifdef DGUXRE if ((vtype&0x01000000)!=0) modifier=MODEPCrep88k; #else modifier=0; #endif addtype(&adbr,&aptr,ftype,type,modifier); ftype=ATuserdeftype; type=debugptr; /* redefine as ATuserdeftype */ Short=(aptr-i)-4; bytemove(2,(int)&Short,(int)&adbr.data [i+2]); adbr.len=aptr+12; k=0; j=(int)&adbr; for (i=0; i<=adbr.len-1; i++) { if ((*(unsigned char *)(j+i))!=(*(unsigned char *)((int)&lastadbr+i))) { k=1; break ; } } if ((lastdebugptr==0)||(k==1)||(ref==ptr)||(ftype==ATuserdeftype)) { /*this array type is not same as previous one*/ lastdebugptr=debugptr; lastadbr=adbr; addsiblink(&adbr,&aptr,curlexlev,debuglevel); writedbr(&adbr); } else { type=lastdebugptr; } } dbr.tag=tag; /* set up dwarf etry for current variable */ addsiblink(&dbr,&dptr,curlexlev,debuglevel); addname(&dbr,&dptr,s); if (sourcelang==fortran && (vtype&isvolatile)!=0) { modifier=MODvolatile; } else { modifier=0; } if (nels>1 && !(ischar==1 && ndims==1)) { addtype(&dbr,&dptr,ftype,type,0); } else { #ifdef DGUXRE if ((vtype&0x01000000)!=0) modifier=MODEPCrep88k; #endif addtype(&dbr,&dptr,ftype,type,modifier); } addloc(&dbr,&dptr,area,disp,ref,0); dbr.len=dptr+6; writedbr(&dbr); } /*PSDBVAR*/ /** */ /* LAYOUT OF DIAGNOSTIC TABLES */ /* THIS INFO EX_EMAS AND VERY OLD */ /******* ** ********* ****** */ /* THE BOUND FIELD OF PLT DESCRIPTOR STORED AT (LNB+3 & LNB+4) IF */ /* USED TO CONTAIN A DISPLACEMENT RELATIVE TO THE START OF SST OF THE */ /* DIAGNOSTIC TABLES FOR THE BLOCK OR ROUTINE BEING EXECUTED. */ /* A ZERO BOUND MEANS NO DIAGNOSTIC REQUESTED.(NB THIS MAY MEAN A DUMMY */ /* FIRST WORD IN THE SST). */ /* THE ABSOLUTE ADDRESS OF THE SST FOR THE CURRENT CODE SEGMENT WILL */ /* ALWAYS BE FOUND IN THE STANDARD 10 WORDS OF THE GLA/PLT */ /* FORM OF THE TABLES:- */ /* WORD 0 = LINE OF RT IN SOURCE PROG <<16 ! LINE NO POSN(FROM LNB) */ /* WORD 1 = (12 LANG DEPENDENT BITS)<<20 ! ENVIRONMENT */ /* (TOP 2 BITS FOR ROUTINE TYPE.B'01'==SYSTEM ROUTINE) */ /* (NEXT BIT SET FOR EBCDIC CHARS&STRINGS(ALGOLE ONLY)) */ /* WORD 2 = DISPLAY POSN (FROM LNB)<<16 ! RT TYPE INFO */ /* WORD 3 = ZERO FOR BLKS OR STRING(<=11BYTES) BEING THE */ /* RT NAME. THIS WILL TAKE WORDS 4 AND 5 IF NEEDED */ /* WORD 6 = LANGUAGE DEPENDENT INFO . IMP ON CONDITIONS ETC */ /* THE REST IS MADE UP OF VARIABLE ENTRIES AND THE SECTION IS TERMINATED BY */ /* A WORD OF X'FFFFFFFF' */ /* EACH VARIABLE ENTRY CONSISTS OF THE VARIABLE WORD FOLLOWED BY */ /* THE VARIABLE NAME AS A STRING. THE WORD CONSISTS OF */ /* BITS 2**31 TO 2**20 TYPE INFORMATION (MAY BE LANGUAGE DEPENDENT */ /* BIT 2**19 =0 UNDER LNB =1 IN GLA */ /* BITS 2**18 TO 2**0 DISPLACEMENT FROM LNB(GLA) IN BYTES */ /* THE ENVIRONMENT IS A POINTER (RELATIVE TO SST) OF THE NEXT OUTERMOST */ /* BLOCK OR A POINTER TO GLOBAL OWNS, EXTERNAL OR COMMON AREAS */ /* A ZERO MEANS NO ENCLOSING BLOCK. WORD1=WORD3=0 IS AN */ /* IMP MAIN PROGRAM AND WILL TERMINATE THE DIAGNOSTICS. */ /*! */ /*! NOTE: ALL DISPLACEMENTS ARE BYTE WITHIN THE DIAGNOSTIC TABLES. */ /*! */ static void impsdb(int ptr) { int tstart,i; tstart=diagsrecs [ptr].doffset+areas [diags-lowestarea].base; if (mon!=0) { printf(" IMPSDB: %d\n",ptr); for (i=0; i<=28; i+=4) { printf("%x ",(*(int *)(tstart+i))); } } doimpsdbblock(tstart); ptr--; while (ptr>=0) { ptr-=impinnerblk(ptr); } lastdiagsrec=-1; } static int impinnerblk(int ptr) { /*************************************************************************/ /** Process an imp begin-end and any previous begins totally enclosed **/ /*************************************************************************/ int tstart,firstline,lastline,dptr,codead,result; short int Short; struct debugf debug; struct rtheadf{ short int rtline; short int linenopos; short int rtflags; short int env; short int display; short int rttype; union { short int idhead; char rtname[12]; } u0; }; struct rtheadf *rthead; tstart=diagsrecs [ptr].doffset+areas [diags-lowestarea].base; rthead=(struct rtheadf*)(tstart); result=1; if ((*(int *)(tstart+20))==-1) return 1; /* Block with no locals skip it*/ memset(&debug,0,sizeof( struct debugf)); dptr=0; debug.tag=TAGlexicalblock; addsiblink(&debug,&dptr,curlexlev,debuglevel); Short=ATlowpc; bytemove(2,(int)&Short,(int)&debug.data [dptr]); firstline=rthead->rtline; codead=codeforline(firstline); fix(debugtabfix,debugtab,(debugptr+dptr)+8,code,codead); dptr+=6; Short=AThighpc; bytemove(2,(int)&Short,(int)&debug.data [dptr]); lastline=line; codead=codeforline(lastline); fix(debugtabfix,debugtab,(debugptr+dptr)+8,code,codead); dptr+=6; debug.len=dptr+6; writedbr(&debug); debuglevel++; doimpsdbblock(tstart); while ((ptr-result)>=0) { tstart=diagsrecs [ptr-result].doffset+areas [diags-lowestarea].base; rthead=(struct rtheadf*)(tstart); if (!((firstline<=rthead->rtline)&&(rthead->rtline<=lastline))) break ; result+=impinnerblk(ptr-result); } memset(&debug,0,sizeof( struct debugf)); debug.len=4; fillsiblink(curlexlev,debuglevel); writedbr(&debug); debuglevel--; return result; } struct varf{ short int flags; short int disp; char vname[12]; }; struct rtheadf{ short int rtline; short int linenopos; short int rtflags; short int env; short int display; short int rttype; union { short int idhead; char rtname[12]; } u0; }; static void pvar(int type,int prec,int nam,int arr,int area,int offset,char * lname) { struct debugf dbr; int dptr,elftype,k,j,ftype; short int Short; if (mon!=0) { printf("PVAR: %s %d %d %d %d\n",lname,type,prec,area,offset); } memset(&dbr,0,sizeof( struct debugf)); dptr=0; elftype=-1; ftype=5; if (type==3) elftype=0xD000; /*record as integers all we can do */ if (type==1) elftype=(3*prec)-8; if (type==2) elftype=9+prec; if (type==5) elftype=0x12; if (elftype<=0) return ; if (elftype==0x12) { /* */ /* define a sting type for the string */ /* */ dbr.tag=elftype; /*user defined*/ ftype=7; dptr=0; addsiblink(&dbr,&dptr,curlexlev,debuglevel); Short=0x193; k=dptr; addloc(&dbr,&dptr,area,offset,0,0); bytemove(2,(int)&Short,(int)&dbr.data [k]) /* over location with stringlen*/; Short=0xB6; /* byte size entry follows*/ bytemove(2,(int)&Short,(int)&dbr.data [dptr]); dptr+=2; j=1; bytemove(4,(int)&j,(int)&dbr.data [dptr]) /* string length is 1 byte*/; dptr+=4; elftype=debugptr; dbr.len=dptr+6; writedbr(&dbr); offset++; memset(&dbr,0,sizeof( struct debugf)); dptr=0; } if (area==7) dbr.tag=5; else dbr.tag=12; ; /* elfspeak for local variable*/ addsiblink(&dbr,&dptr,curlexlev,debuglevel); addname(&dbr,&dptr,lname); addtype(&dbr,&dptr,ftype,elftype,0) /*fundamental type*/; if (arr!=0) { addloc(&dbr,&dptr,area,offset,0,0); Short=0x8500|FORMSTRING; bytemove(2,(int)&Short,(int)&dbr.data [dptr]); dptr+=3; } else addloc(&dbr,&dptr,area,offset,nam,0); ; dbr.len=dptr+6; writedbr(&dbr); } static void pscalar(struct varf *var,struct rtheadf *rthead) { /*************************************************************************/ /** OUTPUT THE NEXT VARIABLE IN THE CURRENT BLOCK. **/ /** A VARIABLE ENTRY IN THE TABLES IS:- **/ /** FLAG<<20!VBREG<<18!DISP **/ /** WHERE:- **/ /** VBREG IS VARIABLE'S BASE REGISTER, DISP IS IT'S OFFSET **/ /** AND FLAGS=NAM<<6!PREC<<3!TYPE **/ /*************************************************************************/ int vaddr; int i,k,area,type,prec,arr,nam; char lname [12] ; i=var->flags; /* printstring(" var_flags = "); !phex(var_flags); !newline */ k=(unsigned)i>>4; type=k&7; prec=((unsigned)k>>4)&7; arr=((unsigned)k>>8)&3; nam=((unsigned)k>>10)&1; imp_strjam(lname,var->vname,11); if ((i&4)==0) /* For non Owns */{ if (var->dispdisplay) { vaddr=var->disp; area=7; } else { area=0; vaddr=rthead->display-var->disp; /* diag tables point at rhs of var - */ /* we need the LHS so adjust by var size */ if ((nam!=0)||(arr!=0)) vaddr-=4; else { if ((1<=type)&&(type<=2)) vaddr-=(1<disp; area=2; }; ; pvar(type,prec,nam,arr,area,vaddr,lname); printf("\n"); } static void plocals(int adata,struct rtheadf *rthead) { /*************************************************************************/ /** ADATA POINTS TO THE FIRST ENTRY FOR LOCALS IN THE SYMBOL TABLES**/ /*************************************************************************/ struct varf *var; while ((*(int *)(adata))>0) { var=(struct varf*)(adata); pscalar(var,rthead); adata+=(8+strlen(var->vname))&0xFFFFFFFC; } } static void doimpsdbblock(int tstart) { /*************************************************************************/ /** THE DIAGNOSTIC ROUTINE FOR IMP **/ /*************************************************************************/ struct rtheadf *rthead; int rlen; rthead=(struct rtheadf*)(tstart); if (rthead->u0.idhead==0) rlen=20; else rlen=(20+strlen(rthead->u0.rtname))&0xFFFFFFFC; ; plocals(tstart+rlen,rthead); return ; } /*DwarfProducer#FrontEnd*/ #endif; static char * checkblankcommon(char * s) { /*************************************************************************/ /** Special Action for Blank Common Names which on 88k are dependent **/ /** on the -us flag. **/ /*************************************************************************/ static char namecopy[256]; #ifdef DGUXRE static char work [256] ; #endif strcpy(namecopy,s); #if(target==elf88k) if (nusoption==0) /*-us*/{ if ((strcmp(namecopy,"_BLNK__")==0) || (strcmp(namecopy,"f#blcm")==0)) { strcpy(namecopy,symbolprefix); strcat(namecopy,"_BLNK__"); } else { strcpy(namecopy,symbolprefix); strcat(namecopy,s); strcat(namecopy,"_"); } } else { /*-nus default*/ if ((strcmp(namecopy,"_BLNK__")==0) || (strcmp(namecopy,"f#blcm")==0)) { strcpy(namecopy,symbolprefix); strcat(namecopy,"BLNK__"); } else { strcpy(namecopy,symbolprefix); strcat(namecopy,s); } } #else if ((strcmp(namecopy,"F#BLCM")==0) || (strcmp(namecopy,"f#blcm")==0) || (strcmp(namecopy,"BLNK__")==0) || (strcmp(namecopy,"_BLNK__")==0)) { strcpy(namecopy,symbolprefix); strcat(namecopy,"BLNK__"); } else { #ifdef DGUXRE if (ecsnameprefix==NULL) work[0]=0; else strcpy(work,ecsnameprefix); strcat(work,namecopy); if (commonus!=0) strcat(work,"_"); strcpy(namecopy,work); #else if (sourcelang==fortran) strcat(namecopy,commonnamesuffix); #endif } #endif; return namecopy; } /* Check Blank Common */ int pcommon(char * name) { /*************************************************************************/ /* Define a common area now superceeded by pcommon2 */ /*************************************************************************/ char namecopy [256] ; if (faulty!=0) return 0; if (mon!=0) printf(" PCommon - %s\n",name); strcpy(namecopy,checkblankcommon(name)); toparea++; if (toparea>maxarea) expandarea(0); psymbol(namecopy,toparea,0,STT_OBJECT,STB_GLOBAL,SHN_COMMON) /*put area table index in _value pro tem*/; areas [toparea-lowestarea].sym=nextsym+20; areas [toparea-lowestarea].align=commonalign; /*default */ return nextsym+20; } /*PCommon*/ void pendcommon(int id,int length) { /*************************************************************************/ /* End of common area with 'standard' properties. Pendcommon2 is better */ /*************************************************************************/ if (faulty!=0) return ; if (mon!=0) printf(" PEndCommon %d length = %d\n",id,length); areas [syms [id-20].st_value-lowestarea].length=length; /* _value field has index to area table */ syms [id-20].st_size=length; } /*PEndCommon*/ int pcommon2(int visibility,char * name) { /*************************************************************************/ /** Commons are global unless visibility # 0 **/ /*************************************************************************/ char namecopy [256] ; int symtype; if (faulty!=0) return 0; if (mon!=0) printf(" PCommon2 - %s Visibility =%d\n",name,visibility); strcpy(namecopy,checkblankcommon(name)); toparea++; if (toparea>maxarea) expandarea(0); symtype=STB_GLOBAL; if (visibility!=0) symtype=STB_LOCAL; psymbol(namecopy,toparea,0,STT_OBJECT,symtype,SHN_COMMON) /*put area table index in _value pro tem*/; areas [toparea-lowestarea].sym=nextsym+20; areas [toparea-lowestarea].align=commonalign; /*default */ return nextsym+20; } /*PCommon*/ void pendcommon2(int id,int length,int props,int align) { /*************************************************************************/ /* End of common area so finalise size & properties */ /*************************************************************************/ int ix; if (faulty!=0) return ; if (mon!=0) printf(" PEndCommon2 %d length = %d Align to%d\n",id,length,align); /* _value field has index to area table */ ix=syms [id-20].st_value; areas [ix-lowestarea].length=length; areas [ix-lowestarea].align=align; syms [id-20].st_size=length; } /*PEndCommon*/ void paligncommon(int id,int align) { /*************************************************************************/ /** for C++ the default arrangemets for Fortran are not good **/ /** enough. C++ must be able to define common alignments **/ /*************************************************************************/ if (!(((1<=0)) { if (objectname [i]=='/') { /* the rightmost '/' */ /* now test each component from left for existence */ /* and create if necessary */ if (objectname [0]=='/') j=1; else j=0; ; while ((j<=i)) { if (objectname [j]!='/') j++; else { objectname [j]=0; /* terminator for a moment */ if (access((int)&objectname [0],0)!=0) { /* this one does not exist */ if (mkdir((int)&objectname [0],dirmode)!=0) { /* code folded from here */ /* create failed */ tryagain=0; break ; /* unfolding */ } /* so created it OK. continue */ tryagain++; if (mon!=0) { /* code folded from here */ printf("Directory created - %s\n",objectname); /* unfolding */ } } objectname [j]='/'; /* put it back */ j++; continue ; } } break ; } else i--; ; } if (tryagain!=0) objid=creat((int)&objectname [0],mode); } if (objid==-1) puterror(" Failed to creat/open object "); } } /*Psetfiles*/ int psetfiles2(char * srcname,char * objfilename,int syntaxcheck) { /*******************************************************************************/ /* Psetfiles - Pass object file name in to be opened */ /*******************************************************************************/ int i,j,tryagain; char s [256] ; if (mon!=0) printf("Psetfiles2 : %s:%s\n",srcname,objfilename); imp_strjam(s,srcname,32); if (strcmp(objfilename,"include")==0) /*remember the file name for sdb*/{ return 0; } else { strcpy(srcfile,s); imp_strjam(objname,objfilename,32); strcpy(objectname,objfilename); if (syntaxcheck==1) return 0; objid=creat((int)&objectname [0],mode); if (objid==-1) { /* maybe a path name with a component missing */ i=strlen(objfilename)-1; tryagain=0; while ((i>=0)) { if (objectname [i]=='/') { /* the rightmost '/' */ /* now test each component from left for existence */ /* and create if necessary */ if (objectname [0]=='/') j=1; else j=0; ; while ((j<=i)) { if (objectname [j]!='/') j++; else { objectname [j]=0; /* terminator for a moment */ if (access((int)&objectname [0],0)!=0) { /* this one does not exist */ if (mkdir((int)&objectname [0],dirmode)!=0) { /* code folded from here */ /* create failed */ tryagain=0; break ; /* unfolding */ } /* so created it OK. continue */ tryagain++; if (mon!=0) { /* code folded from here */ printf("Directory created - %s\n",objectname); /* unfolding */ } } objectname [j]='/'; /* put it back */ j++; continue ; } } break ; } else i--; ; } if (tryagain!=0) objid=creat((int)&objectname [0],mode); } } return objid; } /*Psetfiles2*/ void removeobjectfile() { /********************************************************************************/ /** RemoveObjectFile put in by tkr for PASCAL */ /********************************************************************************/ unlink((int)&objectname [0]); } /*RemoveObjectFile*/ /*******************************************************************************/ /* Psetoptions - Perform Options Processing */ /*******************************************************************************/ void psetoptions(int options) { /***************************************************************************/ /** called by compilation outer control routine **/ /** options have bit value significance **/ /** x'00000001' enable code memory tracing **/ /** x'00000002' generate assembly listing for each frag **/ /** x'00000004' enable rescheduler tracing **/ /** x'00010000' profiling **/ /** x'00020000' enable DBX/SDB information generation **/ /** x'00040000' minimum diags preparation **/ /** x'00080000' dynamic line number updating **/ /** x'00100000' prepare static line no table (later) **/ /** x'00200000' support overflow checking **/ /** x'00400000' allow compiler allocation of registers (FORTRAN only) **/ /** x'00800000' set FPU traps if compiling a main program **/ /** x'01000000' enable instruction scheduling **/ /** x'02000000' prepare for FORTRAN parameter checking **/ /** x'04000000' generate assembly listing without addresses **/ /** x'08000000' Now only used for PPC private options **/ /** x'10000000' Now only used for PPC private options **/ /** x'20000000' line profiling **/ /***************************************************************************/ int i; i=options; /*!comreg(26)*/ if ((i&0x80)!=0) malmon=1; if ((i&0x10)!=0) filemon=1; if ((options&0x20000)!=0) sdb=1; if ((options&0x20000000)!=0) casesense=1; } /*of Psetoptions */ void pterminate(int adareasizes) { /*************************************************************************/ /** CODE GENERATOR CLOSES WITH THIS CALL TO ESTABLISH AREA LENGTHS **/ /*************************************************************************/ int i,ad,l; struct debugf dbr; if (faulty!=0) { removeobjectfile(); return ; } if (endpending==1) completeend(); if (mon!=0) { printf("\n Arealengths from Pterminate are:\n"); for (i=0; i<=9; i++) { printf("%2d",(*(int *)(adareasizes+(i*4)))); } printf("\n"); } ad=adareasizes; for (i=1; i<=10; i++) { l=(*(int *)(ad)); ad+=4; l=(l+7)&(-8); /* Keep areas tidy on 8 byte boundaries */ if ((trusted==0)&&(i!=1)&&(l==0)&&(areas [i-lowestarea].max!=0)) puterror(imp_concat(imp_concat("Pterminate - Area ",itos(i))," has incorrect length ")); areas [i-lowestarea].length=l; } /* if sdb is on then complete some debug information here */ if (sdb!=0) { #if (DwarfProducer==PUT) if (debugptr>0) { if ((sourcelang==imp)&&(lastdiagsrec>=0)) {/* add imp externals*/ doimpsdbblock(areas [diags-lowestarea].base+diagsrecs [lastdiagsrec].doffset); } fillsiblink(curlexlev,debuglevel); dbr.len=4+((debugptr+3)&(-4)); writedbr(&dbr); /*dummy record to terminate */ dbr.len=((debugptr+3)&(-4))-debugptr; writedbr(&dbr); /* align end of debug section */ l=areas [1-lowestarea].length; /* code size */ fix(debugtabfix,debugtab,14,code,l); /* Fill high pC for file */ fix(debugtabfix,debugtab,20,debugtab,debugptr); /*sibling file = next file */ } #endif /* if an empty file is compiled with -g there is no line no table but there */ /* will still be a relocation from the dwarf to it. Must ensure an empty */ /* table is output */ if (linehdroffset<0) setlineheader(0); while (linehdroffset>=0) { i=ppopfile(); } } } /*Pterminate*/ static void pattern(int fileid,int ncopies,int l,int bad) { /***************************************************************/ /* This routine is for the efficient patterning of a data area */ /* eg. If the area is to be filled with the unassigned byte */ /* or a data i*n statement is taking effect */ /***************************************************************/ unsigned char b [511+1]; int i,left,ad,blen,bufsize; ad=(int)&b [0]; /* if l > 512 ? */ /* First fill the buffer with the pattern */ if (l==1) /* single byte pattern */{ fill(512,ad,bad) /* bad contains filler byte if l=1 */; bufsize=512; /* multiple byte pattern */ } else { bufsize=0; for (i=1; i<=ncopies; i++) { bytemove(l,bad,ad+bufsize); bufsize+=l; if ((bufsize+l)>511) break ; } } left=ncopies*l; /* And then write it out */ do { if (left>bufsize) blen=bufsize; else blen=left; left-=blen; writetofile(fileid,ad,blen,""); } while (!(left<=0)) ; } /*PATTERN*/ static void addshentry(Elf32_Shdr *shdrs,int sect) { /*************************************************************************/ /** Takes the next available section table entry and sets **/ /** it up for the nominated section id **/ /*************************************************************************/ static const int sectiondata [(3*maxsect)+2+1] = { /* section id type addralign<<24!entsize<<16!flags Related sect */ /* Necessary empty section */ 0, 0, 0, /* Reginfosect = 1*/ SHT_REGINFO, ((4<<24)|(24<<16))|SHF_ALLOC, 0, /*TEXTsect = 2*/ SHT_PROGBITS, ((16<<24)|SHF_ALLOC)|SHF_EXECINSTR,0, /*DATAsect = 3*/ SHT_PROGBITS, ((16<<24)|SHF_ALLOC)|SHF_WRITE, 0, /*datagptabsect= 4*/ SHT_GPTAB, 8<<16, 0, /*BSSsect = 5*/ SHT_NOBITS, ((16<<24)|SHF_ALLOC)|SHF_WRITE, 0, /*bssgptabsect = 6*/ SHT_GPTAB, 8<<16, 0, /*symsect = 7*/ SHT_SYMTAB, symboltableentrysize<<16, 0, /*TEXTrelsect = 8*/ reltype, sizeof(relaf)<<16, textsect, /*DATArelsect = 9*/ reltype, sizeof(relaf)<<16, datasect, /*mdebugsect =10*/ 0x70000005, 0, 0, /*stringsect =11*/ SHT_STRTAB, 0, 0, /*shstringsect =12*/ SHT_STRTAB, 0, 0, /*RODATAsect =13*/ SHT_PROGBITS, (16<<24)|SHF_ALLOC, 0, /*linenosect =14*/ SHT_PROGBITS, 0, 0, /*linerelsect =15*/ reltype, sizeof(relaf)<<16, linenosect, /*debugsect =16*/ SHT_PROGBITS, 0, 0, /*debugrelsect =17*/ reltype, sizeof(relaf)<<16, debugsect, /*INITsect =18*/ SHT_PROGBITS, ((4<<24)|SHF_ALLOC)|SHF_EXECINSTR,0, /*initrelsect =19*/ reltype, sizeof(relaf)<<16, initsect, /*FINIsect =20*/ SHT_PROGBITS, ((4<<24)|SHF_ALLOC)|SHF_EXECINSTR,0, /*finirelsect =21*/ reltype, sizeof(relaf)<<16, finisect, /*TDESCsect =22*/ tdesctype, tdescprops, 0, /*Tdescrelsect =23*/ reltype, sizeof(relaf)<<16, tdescsect}; Elf32_Shdr *sh; char name [256] ; int i; sh=&shdrs [nsects]; /* Next free */ memset(sh,0,sizeof( Elf32_Shdr)); sectionentryno [sect]=nsects; /* remember mapping */ nsects++; strcpy(name,sectnametext [sect]); placeinshdict(name,&sh->sh_name); sh->sh_offset=sectionposition [sect]; sh->sh_size=sectionsizes [sect]; sh->sh_type=sectiondata [3*sect]; i=sectiondata [(3*sect)+1]; sh->sh_addralign=(unsigned)i>>24; sh->sh_entsize=((unsigned)i>>16)&255; sh->sh_flags=i&0xFFFF; if (sh->sh_type==SHT_SYMTAB) { sh->sh_info=maxloc+1; /* first global */ sh->sh_link=nsects; /* string table must be updated */ } if (sh->sh_type==reltype) { sh->sh_link=sectionentryno [symsect]; sh->sh_info=sectionentryno [sectiondata [(3*sect)+2]]; } /* */ /* Mips gptab sections have additional links Sh_info of gptab has the */ /* data section no. The datsection_info field has the gptab section */ /* THis can be done provided the sections arrive in order */ /* */ #if(target==elfmips) if (sh->sh_type==SHT_GPTAB) sh->sh_info=nsects-1; /* preceding section is referenced */ if ((sh->sh_flags&SHF_WRITE)!=0) sh->sh_link=nsects; #endif; } void pgenerateobject(char * objfilename) { /*************************************************************************/ /** PGenerateObject **/ /** FINAL PHASE OF COMPILATION IS CREATE OBJECT FILE **/ /*************************************************************************/ static const int fhdrsize=(((sizeof(Elf32_Ehdr)+(sizeof(Elf32_Phdr)*prghdrentries))+15)&(-16)); /* size of file header */ int textlen,rodatalen,datalen,ad,ndrels; int filler,i,j,l; int bsslen,linkdisp,areabase,kad; int *areastart; struct rdfm *rd; /* all these disp's are from start of file */ int textptr; /* disp in bytes to code */ int rodataptr,dataptr /* disp in bytes to data areas*/; int textrelptr; /* disp in bytes to relocs for code area */ Elf32_Ehdr hdr; Elf32_Shdr shdrs [maxsect+1]; static const unsigned char order [10-1] = { 2,8,10, 7,4,5,6,3, 9 }; l=getspace((4*toparea)+4); areastart=((int *)(l)); memset(&shdrs [0],0,sizeof( Elf32_Shdr)); ndrels=nrels [gla]+nrels [iotab]; if (!(faulty==0)) return ; if (malmon!=0) printf("\nmax data before object generation = %d\n",maxdata); for (i=1; i<=toparea; i++) areastart [i]=0; /*---- WORK OUT SIZE OF MAJOR PARTS OF OBJECT FILE ---*/ if (areas [code-lowestarea].length==0) { pcword(0,0); areas [code-lowestarea].length=4; } textlen=areas [code-lowestarea].length; bsslen=areas [zgst-lowestarea].length; /* Only the Zero-Gst area goes directly */ /* into BSS. The linker will look after */ /* the uninit. commons which also */ /* belong in BSS. */ datalen=0; rodatalen=0; for (i=1; i<=toparea; i++) /* If it is not in */{ if ((i==zgst)||(i==code)) continue ; /* code or Bss */ if ((i>setareas)&&(areas [i-lowestarea].max==0)) continue ; /* or uninit. common */ if ((i*/ /*<----------- Start filling in front of Object file now --------------->*/ /*<--------------------------------------------------------------------->*/ /*----------- FILL IN THE OBJECT FILE HEADER ---------------------*/ memset(&hdr,0,sizeof( Elf32_Ehdr)); hdr.e_ident[EI_MAG0]=ELFMAG0; hdr.e_ident[EI_MAG1]=ELFMAG1; hdr.e_ident[EI_MAG2]=ELFMAG2; hdr.e_ident[EI_MAG3]=ELFMAG3; hdr.e_ident[EI_CLASS]=ELFCLASS32; hdr.e_ident[EI_VERSION]=elfversion; hdr.e_ident[EI_DATA]=targetdata; /* IBM or VAX type bytes */ hdr.e_type=elftyperel; /* Relocate object file */ hdr.e_machine=target; hdr.e_version=elfversion; hdr.e_ehsize=sizeof(Elf32_Ehdr); hdr.e_shentsize=sizeof( Elf32_Shdr); hdr.e_shnum=maxsect+1; hdr.e_shstrndx=shstringsect; #if(prghdrentries>0) hdr.e_phoff=sizeof(Elf32_Ehdr) #endif; /*gm*/ hdr.e_phentsize=sizeof(Elf32_Phdr); hdr.e_phnum=prghdrentries; if ((target==elf88k)&&(targetvariant==4)) { hdr.e_flags=4; /* Uses 110 features */ } #if(target==elfmips) hdr.e_flags=1; /* No reorder */ if (Pic==largemodel) hdr.e_flags=hdr.e_flags|2; if (Pic==smallmodel) hedr.e_flags=hedr.e_flags|4; #endif; hdr.e_flags=hdr.e_flags|privatehdrflags; if (mainentrypoint!=0) { hdr.e_entry=syms [mainentrypoint].st_value; #if(target==elfmips) hdr.e_entry=0x10000000 #endif; /*Hdr_entry+*/ } /* Areas are to be assembled in DATA in the following order */ /* First areas being relocated: GLA */ /* IOTAB */ /* Next areas initialised, but */ /* not relocated. CNST */ /* SCALAR */ /* SST */ /* GST */ /* DIAGS */ /* INITIALISED COMMONS */ /* Work out start position of ERCC sub-areas in 'DATA' and 'RODATA' */ areastart [sst]=areas [cnst-lowestarea].length; areastart [diags]=areastart [sst]+areas [sst-lowestarea].length; ad=0; /*DataStart*/ for (j=2; j<=toparea; j++) { if (j<11) i=order [j-2]; else i=j; /*strict order on data areas */ l=areas [i-lowestarea].length; if ((l==0)||((i==zgst)&&(bsslen!=0))) continue ; if ((isetareas) /* common */{ if (impp!=0) break ; if (areas [i-lowestarea].max==0) continue ; /* uninitialised cmn */ i=areas [i-lowestarea].sym-20; syms [i].st_shndx=gla; /*gm*/ /* Gla instead of common once initialised */ } else { areastart [i]=ad; /*- datastart*/ /* remember for sdb records */ i=areas [i-lowestarea].sym; } syms [i].st_value=ad; /*- DataStart*/ ad+=l; } /*-----------------------------------------------------------*/ /*------------- SORT OUT RELOCATION ------------------------*/ /*-----------------------------------------------------------*/ /* Relocs. pass a symbol table index in their rel. field */ { relaf rrec; struct rfm *r; Elf32_Sym *sym; int i,j,k,vad,type,tgtsym,curfileptr; int hostdisp,orgcontents; int relarea,tgtdisp,firstglob,got16low16sym; int *symindex,*midindex; Elf32_Sym tempsym; int done; Elf32_Sym *s; int area,l; char name [33] ; /* */ /* map the shuffle arrays */ /* */ l=getspace((4*nextsym)+8); symindex=((int *)(l)); l=getspace((4*nextsym)+8); midindex=((int *)(l)); /* */ /* Shuffle the symbol table so globals areat the back. The early items are */ /* all local anyway. Symindex indirects so that old references can find */ /*their shuffled entry */ /* */ got16low16sym=-1; /* no got16low16pair seen yet */ for (i=0; i<=nextsym; i++) { symindex [i]=i; midindex [i]=i; } j=stfixedentries; /* */ if (mon!=0) { printf("Before ordering\n"); for (i=j; i<=nextsym; i++) { printf("%5d ",i); outsymbol(i); printf("\n"); } } firstglob=nextsym+1; /*in case there areno globals */ for (i=j; i<=nextsym; i++) { if (ELF32_ST_BIND(syms [i].st_info)==STB_GLOBAL) { firstglob=i; break ; } } for (i=firstglob+1; i<=nextsym; i++) { if (ELF32_ST_BIND(syms [i].st_info)==STB_LOCAL) { /*Local out of posn */ tempsym=syms [i]; syms [i]=syms [firstglob]; syms [firstglob]=tempsym; k=midindex [i]; midindex [i]=midindex [firstglob]; midindex [firstglob]=k; k=symindex [midindex [i]]; symindex [midindex [i]]=symindex [midindex [firstglob]]; symindex [midindex [firstglob]]=k; firstglob++; } } maxloc=firstglob-1; if (mon!=0) { printf("after ordering\n"); for (i=j; i<=nextsym; i++) { printf("%3d %5d ",i,symindex [i]); outsymbol(symindex [i]); printf("\n"); } } fix(254,2,2,2,2) /* Put an end marker on the relocations */; /* Rels == Startrels once compiler generates ordered relocations */ /* until then this statement must inside cycle below */ rels=startrels; /* Relocations have to be in order */ i=1; do /* Through list of Relocation requests */{ r=&rels [i-1]; i++; type=(unsigned)r->hostdisp>>24; hostdisp=r->hostdisp&0xFFFFFF; tgtsym=r->tgtarea; tgtdisp=r->tgtdisp; if (type==254) break ; /* end of relocs */ if (type==255) { rels=(struct rfm*)((struct rfm *)(tgtdisp)); i=1; continue ; } /* next block */ if (tgtsym>20) /* Proc, data ref or common may be shuffled */{ tgtsym=symindex [tgtsym-20]; sym=&syms [tgtsym]; if ((sym->st_shndx&0xFFFF)==SHN_COMMON) { /* Un-initialised Common */ /* tgtdisp=tgtdisp+sym_value */ /* Reloc will be common length */ /* in front for unknown reason */ /* so compensate. */ /* Defined data probably Initialised Common */ } else if (((sym->st_info&15)==STT_OBJECT)&&(sym->st_shndx!=SHN_UNDEF)) { /* tgtdisp=tgtdisp+sym_value */ }; /* */ /* Look for relative calls to local procedures. These can be resolved here */ /* and the relocation deleted. The actual patching of the instruction would */ /* seem to need target dependent code in all case. There could also be */ /* alignment problems on some architectures. */ /* NB MIPS calls are absolute not relative so skip this section */ /* */ #if(target!=elfmips) if ((sym->st_info==(ELF32_ST_INFO(STB_LOCAL,STT_FUNC)))&&(r->hostarea==code)&&(type==fixuprel [3])) { done=0; k=(sym->st_value+tgtdisp)-hostdisp; j=areas [code-lowestarea].base+hostdisp; #if(target==elf88k) { (*(int *)(j))=((*(int *)(j))&0xFC000000)|((unsigned)k>>2); done=1; } #endif; #if(target==elfsparc) { (*(int *)(j))=((*(int *)(j))&0xC0000000)|((unsigned)k>>2); done=1; } #endif; #if(target==elf386) { (*(int *)(j))=((*(int *)(j))&0x80000000)|k; done=1; } #endif; #if(target==elfppc) { (*(int *)(j))=((*(int *)(j))&0xFC000003)|(k&0x3FFFFFC); done=1; } #endif; if (done==0) puterror("Code missing for target"); nrels [code]=nrels [code]-1; continue ; } #endif; #if(target==elfmips) if ((sym->st_info==(ELF32_ST_INFO(STB_LOCAL,STT_FUNC)))&&(r->hostarea==code)&&((type==R_MIPS_GOT16)||((type==R_MIPS_LO)16)&&(tgtsym ==got16low16sym)))) { if (type==R_MIPS_GOT16) got16low16sym=tgtsym; else got16low16sym=-1; ; tgtdisp=sym->st_value; /* Offset from code start */ tgtsym=epcareatoelfsym [code]; } /* */ /* This is a hairy optimisation for mips internal calls. jals can be changed */ /* into bgezal which are relative but have limited reach. One can also arrange*/ /* to enter after $gp set up for local calls but that means checking there is a $gp*/ /* set up sequence. This section is dependemt on the code generator producing the*/ /* expected (abi) sequence but is fail safe if the sequence changes */ /* */ if (((sym->st_info==(ELF32_ST_INFO(STB_LOCAL,STT_FUNC)))||((sym->st_info==ELF32_ST_BIND(STB_GLOBAL,STT_FUNC))&&(sym->st_value>0)))&&(r->hostarea==code)&&(type ==fixuprel [3])) { k=(sym->st_value+tgtdisp)-hostdisp; j=areas [code-lowestarea].base+hostdisp; if ((abs(k)<0x7FF0)&&(((unsigned)(*(int *)(j))>>26)==3)) /*jal*/{ (*(int *)(j))=0x4110000|(((k-4)/4)&0xFFFF); /* relative bgezal on $r0 */ if (mon!=0) { printf("Internal call optimised %x\n",hostdisp); } nrels [code]=nrels [code]-1; continue ; } } #endif; /* Mapped area not shuffled except for GOT sym*/ } else { k=tgtsym; tgtsym=symindex [epcareatoelfsym [tgtsym]]; /*gm*/ if ((tgtsym==epcareatoelfsym [code])||(tgtsym==epcareatoelfsym [gla])) tgtdisp+=areastart [k]; /* If area has not a sym of its own %then add offset */ if (tgtsym==0) tgtsym=3; /* tie spurious to DATA to be legal*/ } /*-- work out where the relocation entry is and where it points --*/ /* map onto a reloc table entry */ if ((r->hostarea==code)||(r->hostarea==init)||(r->hostarea==fini)) { #if(target==elfsparc) if ((Pic!=0)&&(type==fixuprel [3])) type=R_SPARC_WPLT30; #endif; #if(target==elf386) if ((Pic!=0)&&(type==fixuprel [3])) type=R_386_PLT32; #endif vad=hostdisp; relarea=epcareatorelarea [r->hostarea]; } else if (r->hostarea==debugtab) { vad=hostdisp; relarea=debugrels; } else if (r->hostarea==linetab) { vad=hostdisp; relarea=linenorels; } else if (r->hostarea==tdesc) { vad=hostdisp; relarea=tdescrels; /* Data relocations */ } else { vad=areastart [r->hostarea]+hostdisp; relarea=datarels; }; /*-- fill in relocation entry --*/ rrec.r_offset=vad; rrec.r_info=(tgtsym<<8)|type; if ((tgtsym<0)||(tgtsym>(nextsym+1))) puterror("Bad symref"); /* */ /* If there is no addend field in the relocation the addend must go into the */ /* relocation. ? What about small fields with big addends? There are alignment*/ /* and byteswopping problems. Why does 386 not support addend? */ /* */ #if(reltype==SHT_RELA) rrec.r_addend=tgtdisp; #else j=areas [r->hostarea-lowestarea].base+hostdisp; if (((targetdata==elfdatamsb)&&(swapmode==0))||((targetdata==elfdatalsb)&&(swapmode!=0))) { /* IBM bytes */ orgcontents=((((*(unsigned char *)(j))<<24)|((*(unsigned char *)(j+1))<<16))|((*(unsigned char *)(j +2))<<8))|(*(unsigned char *)(j+3)); /* tgtdisp=tgtdisp+orgcontents */ #if(target==elfmips) if (type==R_MIPS_26) tgtdisp/=4; if ((type==R_MIPS_HI16)||(type==R_MIPS_GOTt16)) tgtdisp=((unsigned)tgtdisp>>16)+(((unsigned)tgtdisp >>15)&1); tgtdisp&=fixupmasks [type]; tgtdisp|=orgcontents&(~fixupmasks [type]); #endif; (*(unsigned char *)(j))=(unsigned)tgtdisp>>24; (*(unsigned char *)(j+1))=(unsigned)tgtdisp>>16; (*(unsigned char *)(j+2))=(unsigned)tgtdisp>>8; (*(unsigned char *)(j+3))=tgtdisp; } else { orgcontents=((((*(unsigned char *)(j+3))<<24)|((*(unsigned char *)(j+2))<<16))|((*(unsigned char *)(j +1))<<8))|(*(unsigned char *)(j)); /* tgtdisp=tgtdisp+orgcontents */ (*(unsigned char *)(j))=tgtdisp; (*(unsigned char *)(j+1))=(unsigned)tgtdisp>>8; (*(unsigned char *)(j+2))=(unsigned)tgtdisp>>16; (*(unsigned char *)(j+3))=(unsigned)tgtdisp>>24; } if ((target!=elfmips)&&(orgcontents!=0)) puterror("garbage in reloc target"); #endif; pdbytes(relarea,areas [relarea-lowestarea].highuse,sizeof(relaf),(int)&rrec); } while (1) /* FOR EVER */; /* Write out the file now apart from put defined symbol table & string */ /* tables which are not constructed yet */ writetofile(objid,(int)&hdr,fhdrsize,"Header"); curfileptr=fhdrsize; #if(regsectsize>0) sectionposition [reginfosect]=curfileptr; sectionsizes [reginfosect]=regsectsize; if (swapmode!=0) areaswap((int)®sectdata [0],regsectsize); writetofile(objid,(int)®sectdata [0],regsectsize,"Regsect") /*gm*/; curfileptr+=regsectsize; #endif; curfileptr=(curfileptr+15)&(-16); fileposition(objid,curfileptr,0); sectionposition [textsect]=curfileptr; sectionsizes [textsect]=areas [code-lowestarea].length; if (swapmode!=0) areaswap(areas [code-lowestarea].base,sectionsizes [textsect]); writetofile(objid,areas [code-lowestarea].base,sectionsizes [textsect],"Textsect"); curfileptr+=sectionsizes [textsect]; j=areas [init-lowestarea].base; if (j>0) /* There is an INIT section */{ curfileptr=(curfileptr+15)&(-16); sectionposition [initsect]=curfileptr; sectionsizes [initsect]=areas [init-lowestarea].highuse; fileposition(objid,curfileptr,0); if (swapmode!=0) areaswap(areas [init-lowestarea].base,sectionsizes [initsect]); writetofile(objid,areas [init-lowestarea].base,sectionsizes [initsect],"Initsect"); curfileptr+=sectionsizes [initsect]; } j=areas [fini-lowestarea].base; if (j>0) /* There is an FINI section */{ curfileptr=(curfileptr+15)&(-16); sectionposition [finisect]=curfileptr; sectionsizes [finisect]=areas [fini-lowestarea].highuse; fileposition(objid,curfileptr,0); if (swapmode!=0) areaswap(areas [fini-lowestarea].base,sectionsizes [finisect]); writetofile(objid,areas [fini-lowestarea].base,sectionsizes [finisect],"Finisect"); curfileptr+=sectionsizes [finisect]; } curfileptr=(curfileptr+15)&(-16); /*------------------------------------------------------*/ /*------------- MOVE AREAS INTO POSITION ---------------*/ /*------------------------------------------------------*/ /* ----- PLACE INITIALISED DATA AREAS IN 'DATA' %and 'RODATA' ----- */ if (rodatalen>0) /*gm*/{ fileposition(objid,curfileptr,0); for (j=2; j<=10; j++) { i=order [j-2]; if (epcareatosectndx [i]==rodatasect) { l=areas [i-lowestarea].length; if (l>0) { writetofile(objid,areas [i-lowestarea].base,l,"ROdata"); freespace(areas [i-lowestarea].base); memset(&areas [i-lowestarea],0,sizeof( struct areafm)); } } } } sectionposition [rodatasect]=curfileptr; sectionsizes [rodatasect]=rodatalen; curfileptr+=rodatalen; curfileptr=(curfileptr+15)&(-16); fileposition(objid,curfileptr,0); for (j=2; j<=toparea; j++) { if (j<11) i=order [j-2]; else i=j; /*strict order on data areas */ l=areas [i-lowestarea].length; if ((l==0)||((i==zgst)&&(bsslen!=0))) continue ; if ((isetareas)) /* encoded area */{ areabase=lseek(objid,0,1) /*where am I?*/; filler=(unsigned)areas [i-lowestarea].type>>24; if (filler!=0) /* to be pre-patterned */{ pattern(objid,l,1,filler); fileposition(objid,areabase,0) /* put file back to start of area */; } if (areas [i-lowestarea].base==0) { if (i>setareas) continue ; else goto empty; ; } linkdisp=0; do /* Through area frags.*/{ rd=(struct rdfm*)(areas [i-lowestarea].base+linkdisp); fileposition(objid,rd->disp+areabase,0); kad=(areas [i-lowestarea].base+linkdisp)+rdsize; if (rd->copies>1) { if (rd->len==1) kad=(*(unsigned char *)(kad)); pattern(objid,rd->copies,rd->len,kad); } else writetofile(objid,kad,rd->len,"Datasect"); ; linkdisp+=((rd->len+rdsize)+3)&(-4); } while (!(((int)rd-areas [i-lowestarea].base)==areas [i-lowestarea].linkdisp)) ; empty: fileposition(objid,areabase+l,0); /* mapped area */ } else { if (areas [i-lowestarea].base!=0) /* has any initialisation been recvd? */{ /* */ /* if the area size is larger than the buffer area allocated then care is needed */ /* not to output junk in the unallocated space. Fileposition should do this but*/ /* care mak be needed here if the UNIX is non standard */ /* */ if (areas [i-lowestarea].length>areas [i-lowestarea].max) { writetofile(objid,areas [i-lowestarea].base,areas [i-lowestarea].max, "Datasectinit"); fileposition(objid,areas [i-lowestarea].length-areas [i-lowestarea].max, 1); } else { writetofile(objid,areas [i-lowestarea].base,l,"Datasect"); } freespace(areas [i-lowestarea].base); memset(&areas [i-lowestarea],0,sizeof( struct areafm)); } else fileposition(objid,l,1); ; } } sectionposition [datasect]=curfileptr; sectionsizes [datasect]=datalen; curfileptr+=datalen; /* */ /* Make entry for BSS but it is not in the file */ /* */ if (bsslen>0) { sectionposition [bsssect]=curfileptr; sectionsizes [bsssect]=bsslen; } /*<-------- Write out relocation tables ---------->*/ j=areas [coderels-lowestarea].base; if (j!=0) /* there are coderels */{ curfileptr=(curfileptr+3)&(-4); sectionposition [textrelsect]=curfileptr; sectionsizes [textrelsect]=areas [coderels-lowestarea].highuse; fileposition(objid,curfileptr,0); if (swapmode!=0) areaswap(j,sectionsizes [textrelsect]); writetofile(objid,j,sectionsizes [textrelsect],"Textrels"); curfileptr+=sectionsizes [textrelsect]; freespace(j); memset(&areas [coderels-lowestarea],0,sizeof( struct areafm)); } j=areas [datarels-lowestarea].base; if (j!=0) /* there are Datarels */{ curfileptr=(curfileptr+3)&(-4); sectionposition [datarelsect]=curfileptr; sectionsizes [datarelsect]=areas [datarels-lowestarea].highuse; fileposition(objid,curfileptr,0); if (swapmode!=0) areaswap(j,sectionsizes [datarelsect]); writetofile(objid,j,sectionsizes [datarelsect],"DATArels"); curfileptr+=sectionsizes [datarelsect]; freespace(j); memset(&areas [datarels-lowestarea],0,sizeof( struct areafm)); } j=areas [initrels-lowestarea].base; if (j!=0) /* there are INITrels */{ curfileptr=(curfileptr+3)&(-4); sectionposition [initrelsect]=curfileptr; sectionsizes [initrelsect]=areas [initrels-lowestarea].highuse; fileposition(objid,curfileptr,0); if (swapmode!=0) areaswap(j,sectionsizes [initrelsect]); writetofile(objid,j,sectionsizes [initrelsect],"INITrels"); curfileptr+=sectionsizes [initrelsect]; freespace(j); memset(&areas [initrels-lowestarea],0,sizeof( struct areafm)); } j=areas [finirels-lowestarea].base; if (j!=0) /* there are FINIrels */{ curfileptr=(curfileptr+3)&(-4); sectionposition [finirelsect]=curfileptr; sectionsizes [finirelsect]=areas [finirels-lowestarea].highuse; fileposition(objid,curfileptr,0); if (swapmode!=0) areaswap(j,sectionsizes [finirelsect]); writetofile(objid,j,sectionsizes [finirelsect],"FINIrels"); curfileptr+=sectionsizes [finirelsect]; freespace(j); memset(&areas [finirels-lowestarea],0,sizeof( struct areafm)); } /* */ /* If sdb mode then add the four relevant sections */ /* */ if (sdb!=0) { j=areas [linetab-lowestarea].base; if (j!=0) { curfileptr=(curfileptr+3)&(-4); sectionposition [linenosect]=curfileptr; sectionsizes [linenosect]=areas [linetab-lowestarea].highuse; fileposition(objid,curfileptr,0); if (swapmode!=0) { /* Difficult to swap this section leave for now */ } writetofile(objid,j,sectionsizes [linenosect],"LINENOsect"); curfileptr+=sectionsizes [linenosect]; } j=areas [linenorels-lowestarea].base; if (j!=0) /* there are LINENOrels */{ curfileptr=(curfileptr+3)&(-4); sectionposition [linerelsect]=curfileptr; sectionsizes [linerelsect]=areas [linenorels-lowestarea].highuse; fileposition(objid,curfileptr,0); if (swapmode!=0) areaswap(j,sectionsizes [linerelsect]); writetofile(objid,j,sectionsizes [linerelsect],"LINENORELS"); curfileptr+=sectionsizes [linerelsect]; freespace(j); memset(&areas [linenorels-lowestarea],0,sizeof( struct areafm)); } curfileptr=(curfileptr+3)&(-4); sectionposition [debugsect]=curfileptr; sectionsizes [debugsect]=areas [debugtab-lowestarea].highuse; fileposition(objid,curfileptr,0); writetofile(objid,areas [debugtab-lowestarea].base,sectionsizes [debugsect],"DEBUG"); curfileptr+=sectionsizes [debugsect]; j=areas [debugrels-lowestarea].base; if (j!=0) /* there are DBrels */{ curfileptr=(curfileptr+3)&(-4); sectionposition [debugrelsect]=curfileptr; sectionsizes [debugrelsect]=areas [debugrels-lowestarea].highuse; fileposition(objid,curfileptr,0); if (swapmode!=0) areaswap(areas [debugrels-lowestarea].base,sectionsizes [debugrelsect]); writetofile(objid,areas [debugrels-lowestarea].base,sectionsizes [debugrelsect],"DEBUGrels"); curfileptr+=sectionsizes [debugrelsect]; } /* %if sdb#0*/ } #if(target==elfmips) /*************************************************************************/ /** Mips has 3 extra mandatory sections. The register section **/ /** defines the registers used by the chip and up to 4 co- **/ /** processors. The next two gptab sections reflect the workings **/ /** of the mips compilers. They enable the linker to indicate **/ /** the benefits or otherwise of changing the storeage allocation **/ /** of small global items between the gp table and other areas **/ /** EPC compiler allocate differently and the best we can do is **/ /** frig up a hopefully harmless dummy **/ /*************************************************************************/ { static int dummygptab [5+1] = { 0,0, /* Nothing allocated to gp */4,0x10000, /*If 4 byte items allocated 64k reqd */8,0x20000 }; /* If 8 byte 128k reqd */ static const int gptabsize=24; static int dummydebugtab [7+1] = { 0x70090300,0 }; static const int debugtabsize=32; curfileptr=(curfileptr+3)&(-4); sectionposition [datagptabsect]=curfileptr; sectionsizes [datagptabsect]=gptabsize; fileposition(objid,curfileptr,0); writetofile(objid,(int)&dummygptab [0],gptabsize,"gptab"); curfileptr+=gptabsize; if (bsslen>0) { sectionposition [bssgptabsect]=curfileptr; sectionsizes [bssgptabsect]=gptabsize; writetofile(objid,(int)&dummygptab [0],gptabsize,"gptab"); curfileptr+=gptabsize; } } /*Mips extra mandatory sections */ #endif; #if((target==elf88k)||(target==elfppc)) /******************************************************************* */ /** M88k has Tdesc sections & their relocations. Not all compilers * */ /** will generate these but it present must be dealt with * */ /* PPC tags section are the same apart form detailed contents * */ /******************************************************************* */ j=areas [tdesc-lowestarea].base; if (j!=0) { curfileptr=(curfileptr+3)&(-4); sectionposition [tdescsect]=curfileptr; sectionsizes [tdescsect]=areas [tdesc-lowestarea].highuse; fileposition(objid,curfileptr,0); writetofile(objid,j,sectionsizes [tdescsect],"TDESCS"); curfileptr+=sectionsizes [tdescsect]; freespace(j); memset(&areas [tdesc-lowestarea],0,sizeof( struct areafm)); } j=areas [tdescrels-lowestarea].base; if (j!=0) { curfileptr=(curfileptr+3)&(-4); sectionposition [tdescrelsect]=curfileptr; sectionsizes [tdescrelsect]=areas [tdescrels-lowestarea].highuse; fileposition(objid,curfileptr,0); writetofile(objid,j,sectionsizes [tdescrelsect],"TDESCrels"); curfileptr+=sectionsizes [tdescrelsect]; freespace(j); memset(&areas [tdescrels-lowestarea],0,sizeof( struct areafm)); } #endif; /* */ /* We are now in a deadly embrace. The next 3 sections are not complete */ /* but we cannot complete them without the section table. The section table */ /* can not be built till the las 3 sections are complete! */ /* However we Know the seze of the symboltable */ /* */ curfileptr=(curfileptr+3)&(-4); sectionposition [symsect]=curfileptr; sectionsizes [symsect]=(nextsym+1)*symboltableentrysize; /* */ /* now build all bar the last 2 section of section header table */ /* */ for (i=0; i<=maxsect; i++) { if (sectionsizes [i]!=0) addshentry(&shdrs[0] ,i); } /* */ /* now complete the symbol table */ /* */ /* ------- Fill in fixed entries at start of table ------- */ s=&syms [0]; /* empty entry */ memset(s,0,sizeof( Elf32_Sym)); s=&syms [1]; /* .file entry */ memset(s,0,sizeof( Elf32_Sym)); placeindict(srcfile,&s->st_name); s->st_info=STT_FILE; s->st_shndx=SHN_ABS; s=&syms [2]; /* epctext entry */ memset(s,0,sizeof( Elf32_Sym)); strcpy(name,"epctext"); placeindict(name,&s->st_name); s->st_size=textlen; s->st_info=ELF32_ST_INFO(STB_LOCAL,STT_SECTION); s->st_shndx=sectionentryno [textsect]; s=&syms [3]; /* epcdata entry */ memset(s,0,sizeof( Elf32_Sym)); strcpy(name,"epcdata"); placeindict(name,&s->st_name); s->st_size=datalen; #if(target==elf88k) s->st_info=STB_LOCAL<<4; /*!Section*/ /* BREAKS PIC on DG 5.4 and 5.4.1 */ /* if you comment out section you get NOTYP */ /* for section desc which is bad elf,but PIC */ /* works */ #else s->st_info=ELF32_ST_INFO(STB_LOCAL,STT_SECTION); #endif; s->st_shndx=sectionentryno [datasect]; s=&syms [4]; /* epcbss entry */ memset(s,0,sizeof( Elf32_Sym)); strcpy(name,"epcbss"); placeindict(name,&s->st_name); s->st_size=bsslen; s->st_info=ELF32_ST_INFO(STB_LOCAL,STT_SECTION); s->st_shndx=sectionentryno [bsssect]; s=&syms [5]; /*epcdebug entry */ memset(s,0,sizeof( Elf32_Sym)); strcpy(name,"epcdebug"); placeindict(name,&s->st_name); s->st_size=debugptr; s->st_info=ELF32_ST_INFO(STB_LOCAL,STT_SECTION); s->st_shndx=sectionentryno [debugsect]; /* epcline entry */ s=&syms [6]; memset(s,0,sizeof( Elf32_Sym)); strcpy(name,"epclines"); placeindict(name,&s->st_name); s->st_info=ELF32_ST_INFO(STB_LOCAL,STT_SECTION); s->st_shndx=sectionentryno [linenosect]; /* epcrodata entry */ s=&syms [7]; memset(s,0,sizeof( Elf32_Sym)); strcpy(name,"epcrodata"); placeindict(name,&s->st_name); s->st_info=ELF32_ST_INFO(STB_LOCAL,STT_SECTION); s->st_shndx=sectionentryno [rodatasect]; s->st_size=rodatalen; s=&syms [8]; memset(s,0,sizeof( Elf32_Sym)); strcpy(name,"epcconst"); placeindict(name,&s->st_name); s->st_info=ELF32_ST_INFO(STB_LOCAL,STT_OBJECT); s->st_shndx=sectionentryno [epcareatosectndx [cnst]]; s->st_value=areastart [cnst]; s->st_size=areas [cnst-lowestarea].length; s=&syms [9]; memset(s,0,sizeof( Elf32_Sym)); strcpy(name,"epcsst"); placeindict(name,&s->st_name); s->st_info=ELF32_ST_INFO(STB_LOCAL,STT_OBJECT); s->st_shndx=sectionentryno [epcareatosectndx [sst]]; s->st_value=areastart [sst]; s->st_size=areas [sst-lowestarea].length; s=&syms [10]; memset(s,0,sizeof( Elf32_Sym)); strcpy(name,"epcgst"); placeindict(name,&s->st_name); s->st_info=ELF32_ST_INFO(STB_LOCAL,STT_OBJECT); s->st_shndx=sectionentryno [epcareatosectndx [gst]]; s->st_value=areastart [gst]; s->st_size=areas [gst-lowestarea].length; s=&syms [11]; memset(s,0,sizeof( Elf32_Sym)); strcpy(name,"epcscalar"); placeindict(name,&s->st_name); s->st_info=ELF32_ST_INFO(STB_LOCAL,STT_OBJECT); s->st_shndx=sectionentryno [epcareatosectndx [scalar]]; s->st_value=areastart [scalar]; s->st_size=areas [scalar-lowestarea].length; s=&syms [12]; memset(s,0,sizeof( Elf32_Sym)); strcpy(name,"epciotab"); placeindict(name,&s->st_name); s->st_info=ELF32_ST_INFO(STB_LOCAL,STT_OBJECT); s->st_shndx=sectionentryno [epcareatosectndx [iotab]]; s->st_value=areastart [iotab]; s->st_size=areas [iotab-lowestarea].length; /* */ /* IN extreme cases sections may not exist */ /* */ for (i=2; i<=stfixedentries-1; i++) { s=&syms [i]; if (s->st_shndx==0) { s->st_shndx=SHN_ABS; s->st_info=ELF32_ST_INFO(STB_LOCAL,STT_NOTYPE); } } /*----- write out the symbol table -----*/ for (i=stfixedentries; i<=nextsym; i++) { if ((i>maxloc)&&(ELF32_ST_BIND(syms [i].st_info)==STB_LOCAL)) puterror("sym table badly shuffled"); area=syms [i].st_shndx&0xFFFF; /*sign bit propagates on commons! */ if (area==SHN_COMMON) { syms [i].st_value=areas [syms [i].st_value-lowestarea].align; continue ; } if ((00) { Elf32_Phdr *ph; ph=&hdr.prghdr [0]; sh=&shdrs [reginfosect]; /* reginfosect described thus */ ph->p_type=0x70000000; ph->p_offset=sh->sh_offset; ph->p_vaddr=sh->sh_offset+0x10000000; ph->p_paddr=ph->p_vaddr; ph->p_filesz=sh->sh_size; ph->p_memsz=ph->p_filesz; ph->p_flags=PF_R; /* reg data read only */ ph->p_align=4; /* word align */ ph=&hdr.prghdr [1]; sh=&shdrs [textsect]; ph->p_type=PT_LOAD; ph->p_offset=sh->sh_offset; ph->p_vaddr=0x10000000; ph->p_paddr=ph->p_vaddr; ph->p_filesz=sh->sh_size; ph->p_memsz=ph->p_filesz; ph->p_flags=PF_R!PF_X; /* text read exec */ ph->p_align=4096; ph=&hdr.prghdr [2]; sh=&shdrs [datasect]; ph->p_type=PT_LOAD; ph->p_offset=sh->sh_offset; ph->p_vaddr=shdrs [textsect].size+0x10000000; ph->p_paddr=ph->p_vaddr; ph->p_filesz=sh->sh_size; ph->p_memsz=ph->p_filesz; ph->p_flags=PF_R!PF_X!PF_W; /* data read writeexec */ ph->p_align=16*4096; } #endif; fileposition(objid,0,0); if (swapmode!=0) elfhdrswap(&hdr); writetofile(objid,(int)&hdr,fhdrsize,"Revised HDR"); } i=close(objid); if (mon!=0) printf("Close object file %s - %x\n",objname,i); if (malmon!=0) printf("\nmax data after object generation = %d\n",maxdata); for (i=lowestarea; i<=toparea; i++) { if (i==0) continue ; if (areas [i-lowestarea].base!=0) { if (mon!=0) { printf("Area table entry freed at Pgenerate exit:- %d %x %x\n", i,areas [i-lowestarea].base,areas [i-lowestarea].max); } freespace(areas [i-lowestarea].base); memset(&areas [i-lowestarea],0,sizeof( struct areafm)); } } if (mon!=0) { i=0; printf("Area base table freed at Pgenerate exit:- %x %x\n", areas [i-lowestarea].base,areas [i-lowestarea].max); } freespace(areas [0-lowestarea].base); memset(&areas [0-lowestarea],0,sizeof( struct areafm)); freespace(relsmalloc); } /*PGenerateObject*/ void pmonon() { /* comreg(59)=comreg(59)!4 */ mon=1; malmon=1; } /*PMonOn*/ void pmonoff() { /* comreg(59)=comreg(59)&X'FFFFFFFB' */ mon=0; } /*PMonOff*/ /* end of automatic translation */