* dwarf branch merged

compiler/aasmbase.pas

@@ -34,49 +34,65 @@ interface
 
     uses
        cutils,cclasses,
-       globtype,globals,systems;
+       globtype,globals,systems,
+       cpuinfo;
 
-  { asm symbol functions }
     type
+       TAsmSection = class;
+       TAsmObjectData = class;
+
        TAsmsymbind=(AB_NONE,AB_EXTERNAL,AB_COMMON,AB_LOCAL,AB_GLOBAL);
 
        TAsmsymtype=(AT_NONE,AT_FUNCTION,AT_DATA,AT_SECTION);
 
        TAsmRelocationType = (RELOC_ABSOLUTE,RELOC_RELATIVE,RELOC_RVA);
 
-       TAsmSectionSizes = array[TSection] of longint;
+       TAsmSectionType=(sec_none,
+         sec_code,sec_data,sec_rodata,sec_bss,
+         sec_common, { used for executable creation }
+         sec_custom, { custom section, no prefix }
+         { stabs }
+         sec_stab,sec_stabstr,
+         { win32 }
+         sec_idata2,sec_idata4,sec_idata5,sec_idata6,sec_idata7,sec_edata,
+         { C++ exception handling unwinding (uses dwarf) }
+         sec_eh_frame,
+         { dwarf }
+         sec_debug_frame
+       );
+
+       TAsmSectionOption = (aso_alloconly,aso_executable);
+       TAsmSectionOptions = set of TAsmSectionOption;
 
        TAsmSymbol = class(TNamedIndexItem)
        private
          { this need to be incremented with every symbol loading into the
            paasmoutput, thus in loadsym/loadref/const_symbol (PFV) }
-         refs    : longint;
+         refs       : longint;
        public
          defbind,
-         currbind  : TAsmsymbind;
-         typ       : TAsmsymtype;
+         currbind   : TAsmsymbind;
+         typ        : TAsmsymtype;
          { the next fields are filled in the binary writer }
-         section : TSection;
+         section    : TAsmSection;
          address,
-         size    : longint;
+         size       : aint;
          { Alternate symbol which can be used for 'renaming' needed for
            inlining }
-         altsymbol : tasmsymbol;
+         altsymbol  : tasmsymbol;
          { pointer to objectdata that is the owner of this symbol }
-         objectdata : pointer;
-         { pointer to the tai that is the owner of this symbol }
-{         taiowner : pointer;}
+         owner      : tasmobjectdata;
          { Is the symbol in the used list }
          inusedlist : boolean;
          { assembler pass label is set, used for detecting multiple labels }
-         pass : byte;
-         ppuidx : longint;
+         pass       : byte;
+         ppuidx     : longint;
          constructor create(const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype);
          procedure reset;
          function  is_used:boolean;
          procedure increfs;
          procedure decrefs;
-         procedure setaddress(_pass:byte;sec:TSection;offset,len:longint);
+         procedure setaddress(_pass:byte;sec:TAsmSection;offset,len:aint);
        end;
 
        TAsmLabel = class(TAsmSymbol)
@@ -94,77 +110,92 @@ interface
 
        TAsmRelocation = class(TLinkedListItem)
           address,
-          orgsize  : longint;  { original size of the symbol to relocate, required for COFF }
-          symbol   : tasmsymbol;
-          section  : TSection; { only used if symbol=nil }
+          orgsize  : aint;  { original size of the symbol to relocate, required for COFF }
+          symbol   : TAsmSymbol;
+          section  : TAsmSection; { only used if symbol=nil }
           typ      : TAsmRelocationType;
-          constructor CreateSymbol(Aaddress:longint;s:Tasmsymbol;Atyp:TAsmRelocationType);
-          constructor CreateSymbolSize(Aaddress:longint;s:Tasmsymbol;Aorgsize:longint;Atyp:TAsmRelocationType);
-          constructor CreateSection(Aaddress:longint;sec:TSection;Atyp:TAsmRelocationType);
+          constructor CreateSymbol(Aaddress:aint;s:Tasmsymbol;Atyp:TAsmRelocationType);
+          constructor CreateSymbolSize(Aaddress:aint;s:Tasmsymbol;Aorgsize:aint;Atyp:TAsmRelocationType);
+          constructor CreateSection(Aaddress:aint;sec:TAsmSection;Atyp:TAsmRelocationType);
        end;
 
-       TAsmSection = class(TLinkedListItem)
-         name      : string[32];
-         secsymidx : longint;   { index for the section in symtab }
-         addralign : longint;   { alignment of the section }
-         flags     : cardinal;  { section flags }
+       TAsmSection = class(TNamedIndexItem)
+         owner      : TAsmObjectData;
+         secoptions : TAsmSectionOptions;
+         sectype    : TAsmSectionType;
+         secsymidx  : longint;   { index for the section in symtab }
+         addralign  : longint;   { alignment of the section }
          { size of the data and in the file }
          dataalignbytes : longint;
          data      : TDynamicArray;
-         datasize  : longint;
-         datapos   : longint;
-         { size and position in memory, set by seTSectionsize }
+         datasize,
+         datapos   : aint;
+         { size and position in memory }
          memsize,
-         mempos    : longint;
+         mempos    : aint;
          { relocation }
          relocations : TLinkedList;
-         constructor create(const Aname:string;Aalign:longint;alloconly:boolean);
+         constructor create(const Aname:string;Atype:TAsmSectionType;Aalign:longint;Aoptions:TAsmSectionOptions);virtual;
          destructor  destroy;override;
-         function  write(var d;l:longint):longint;
-         function  writestr(const s:string):longint;
+         function  write(const d;l:aint):aint;
+         function  writestr(const s:string):aint;
          procedure writealign(l:longint);
-         function  aligneddatasize:longint;
+         function  aligneddatasize:aint;
+         procedure setdatapos(var dpos:aint);
          procedure alignsection;
-         procedure alloc(l:longint);
-         procedure addsymreloc(ofs:longint;p:tasmsymbol;relative:TAsmRelocationType);
-         procedure addsectionreloc(ofs:longint;sec:TSection;relative:TAsmRelocationType);
-       end;
-
-       TAsmObjectAlloc = class
-         currsec : TSection;
-         secsize : TAsmSectionSizes;
-         constructor create;
-         destructor  destroy;override;
-         procedure seTSection(sec:TSection);
-         function  sectionsize:longint;
-         procedure sectionalloc(l:longint);
-         procedure sectionalign(l:longint);
-         procedure staballoc(p:pchar);
-         procedure resetSections;
+         procedure alloc(l:aint);
+         procedure addsymreloc(ofs:aint;p:tasmsymbol;relative:TAsmRelocationType);
+         procedure addsectionreloc(ofs:aint;sec:TAsmSection;relative:TAsmRelocationType);
+         procedure fixuprelocs;virtual;
        end;
+       TAsmSectionClass = class of TAsmSection;
 
        TAsmObjectData = class(TLinkedListItem)
+       private
+         FName      : string[80];
+         FCurrSec   : TAsmSection;
+         FSects     : TDictionary;
+         FCAsmSection : TAsmSectionClass;
+         { Symbols that will be defined in this object file }
+         FSymbols   : TIndexArray;
+         { Special info sections that are written to during object generation }
+         FStabsRecSize : longint;
+         FStabsSec,
+         FStabStrSec : TAsmSection;
+         procedure section_reset(p:tnamedindexitem;arg:pointer);
+         procedure section_fixuprelocs(p:tnamedindexitem;arg:pointer);
+       protected
+         property StabsRecSize:longint read FStabsRecSize write FStabsRecSize;
+         property StabsSec:TAsmSection read FStabsSec write FStabsSec;
+         property StabStrSec:TAsmSection read FStabStrSec write FStabStrSec;
+         property CAsmSection:TAsmSectionClass read FCAsmSection write FCAsmSection;
        public
-         name      : string[80];
-         currsec   : TSection;
-         sects     : array[TSection] of TAsmSection;
-         symbols   : tindexarray; { contains symbols that will be defined in object file }
-         constructor create(const n:string);
+         constructor create(const n:string);virtual;
          destructor  destroy;override;
-         procedure createsection(sec:TSection);virtual;
-         procedure defaulTSection(sec:TSection);
-         function  sectionsize(s:TSection):longint;
-         function  currsectionsize:longint;
-         procedure setsectionsizes(var s:TAsmSectionSizes);virtual;
-         procedure alloc(len:longint);
+         function  sectionname(atype:tasmsectiontype;const aname:string):string;virtual;
+         function  createsection(atype:tasmsectiontype;const aname:string;aalign:longint;aoptions:TAsmSectionOptions):tasmsection;virtual;
+         procedure setsection(asec:tasmsection);
+         procedure alloc(len:aint);
          procedure allocalign(len:longint);
-         procedure writebytes(var data;len:longint);
-         procedure writereloc(data,len:longint;p:tasmsymbol;relative:TAsmRelocationType);virtual;abstract;
+         procedure allocstabs(p:pchar);
+         procedure allocsymbol(currpass:byte;p:tasmsymbol;len:aint);
+         procedure writebytes(var data;len:aint);
+         procedure writereloc(data,len:aint;p:tasmsymbol;relative:TAsmRelocationType);virtual;abstract;
          procedure writesymbol(p:tasmsymbol);virtual;abstract;
-         procedure writestabs(section:TSection;offset:longint;p:pchar;nidx,nother,line:longint;reloc:boolean);virtual;abstract;
-         procedure writesymstabs(section:TSection;offset:longint;p:pchar;ps:tasmsymbol;nidx,nother,line:longint;reloc:boolean);virtual;abstract;
-         procedure fixuprelocs;virtual;
+         procedure writestabs(offset:aint;p:pchar;nidx,nother,line:longint;reloc:boolean);virtual;abstract;
+         procedure writesymstabs(offset:aint;p:pchar;ps:tasmsymbol;nidx,nother,line:longint;reloc:boolean);virtual;abstract;
+         procedure beforealloc;virtual;
+         procedure beforewrite;virtual;
+         procedure afteralloc;virtual;
+         procedure afterwrite;virtual;
+         procedure resetsections;
+         procedure fixuprelocs;
+         property Name:string[80] read FName;
+         property CurrSec:TAsmSection read FCurrSec;
+         property Symbols:TindexArray read FSymbols;
+         property Sects:TDictionary read FSects;
        end;
+       TAsmObjectDataClass = class of TAsmObjectData;
 
 {$ifndef delphi}
        tasmsymbolidxarr = array[0..($7fffffff div sizeof(pointer))] of tasmsymbol;
@@ -253,7 +284,7 @@ implementation
     procedure tasmsymbol.reset;
       begin
         { reset section info }
-        section:=sec_none;
+        section:=nil;
         address:=0;
         size:=0;
         indexnr:=-1;
@@ -284,7 +315,7 @@ implementation
       end;
 
 
-    procedure tasmsymbol.setaddress(_pass:byte;sec:TSection;offset,len:longint);
+    procedure tasmsymbol.setaddress(_pass:byte;sec:TAsmSection;offset,len:aint);
       begin
         if (_pass=pass) then
          begin
@@ -318,20 +349,17 @@ implementation
     constructor tasmlabel.createdata(const modulename:string;nr:longint);
       begin;
         labelnr:=nr;
-        if (cs_create_smart in aktmoduleswitches) or
-           target_asm.labelprefix_only_inside_procedure then
-          inherited create('_$'+modulename+'$_L'+tostr(labelnr),AB_GLOBAL,AT_DATA)
-        else
-          inherited create(target_asm.labelprefix+tostr(labelnr),AB_LOCAL,AT_DATA);
+        inherited create('_$'+modulename+'$_L'+tostr(labelnr),AB_GLOBAL,AT_DATA);
         is_set:=false;
         is_addr := false;
         { write it always }
         increfs;
       end;
 
+
     constructor tasmlabel.createaddr(nr:longint);
       begin;
-        create(nr);
+        self.create(nr);
         is_addr := true;
       end;
 
@@ -343,84 +371,31 @@ implementation
       end;
 
 
-{****************************************************************************
-                                TAsmObjectAlloc
-****************************************************************************}
-
-    constructor TAsmObjectAlloc.create;
-      begin
-      end;
-
-
-    destructor TAsmObjectAlloc.destroy;
-      begin
-      end;
-
-
-    procedure TAsmObjectAlloc.seTSection(sec:TSection);
-      begin
-        currsec:=sec;
-      end;
-
-
-    procedure TAsmObjectAlloc.reseTSections;
-      begin
-        FillChar(secsize,sizeof(secsize),0);
-      end;
-
-
-    procedure TAsmObjectAlloc.sectionalloc(l:longint);
-      begin
-        inc(secsize[currsec],l);
-      end;
-
-
-    procedure TAsmObjectAlloc.sectionalign(l:longint);
-      begin
-        if (secsize[currsec] mod l)<>0 then
-          inc(secsize[currsec],l-(secsize[currsec] mod l));
-      end;
-
-
-    procedure TAsmObjectAlloc.staballoc(p:pchar);
-      begin
-        inc(secsize[sec_stab]);
-        if assigned(p) and (p[0]<>#0) then
-          inc(secsize[sec_stabstr],strlen(p)+1);
-      end;
-
-
-    function TAsmObjectAlloc.sectionsize:longint;
-      begin
-        sectionsize:=secsize[currsec];
-      end;
-
-
 {****************************************************************************
                               TAsmRelocation
 ****************************************************************************}
 
-    constructor TAsmRelocation.CreateSymbol(Aaddress:longint;s:Tasmsymbol;Atyp:TAsmRelocationType);
+    constructor TAsmRelocation.CreateSymbol(Aaddress:aint;s:Tasmsymbol;Atyp:TAsmRelocationType);
       begin
         Address:=Aaddress;
         Symbol:=s;
         OrgSize:=0;
-        Section:=Sec_none;
+        Section:=nil;
         Typ:=Atyp;
       end;
 
 
-    constructor TAsmRelocation.CreateSymbolSize(Aaddress:longint;s:Tasmsymbol;Aorgsize:longint;Atyp:TAsmRelocationType);
+    constructor TAsmRelocation.CreateSymbolSize(Aaddress:aint;s:Tasmsymbol;Aorgsize:aint;Atyp:TAsmRelocationType);
       begin
         Address:=Aaddress;
         Symbol:=s;
         OrgSize:=Aorgsize;
-        Section:=Sec_none;
+        Section:=nil;
         Typ:=Atyp;
       end;
 
 
-    constructor TAsmRelocation.CreateSection(Aaddress:longint;sec:TSection;Atyp:TAsmRelocationType);
+    constructor TAsmRelocation.CreateSection(Aaddress:aint;sec:TAsmSection;Atyp:TAsmRelocationType);
       begin
         Address:=Aaddress;
         Symbol:=nil;
@@ -434,20 +409,22 @@ implementation
                               TAsmSection
 ****************************************************************************}
 
-    constructor TAsmSection.create(const Aname:string;Aalign:longint;alloconly:boolean);
+    constructor TAsmSection.create(const Aname:string;Atype:TAsmSectionType;Aalign:longint;Aoptions:TAsmSectionOptions);
       begin
-        inherited create;
+        inherited createname(Aname);
+        sectype:=Atype;
         name:=Aname;
+        secoptions:=Aoptions;
         secsymidx:=0;
         addralign:=Aalign;
         { data }
         datasize:=0;
         datapos:=0;
-        if alloconly then
+        if (aso_alloconly in aoptions) then
          data:=nil
         else
          Data:=TDynamicArray.Create(8192);
-        { position }
+        { memory }
         mempos:=0;
         memsize:=0;
         { relocation }
@@ -463,22 +440,20 @@ implementation
       end;
 
 
-    function TAsmSection.write(var d;l:longint):longint;
+    function TAsmSection.write(const d;l:aint):aint;
       begin
         write:=datasize;
-        if not assigned(Data) then
-         Internalerror(3334441);
-        Data.write(d,l);
+        if assigned(Data) then
+          Data.write(d,l);
         inc(datasize,l);
       end;
 
 
-    function TAsmSection.writestr(const s:string):longint;
+    function TAsmSection.writestr(const s:string):aint;
       begin
         writestr:=datasize;
-        if not assigned(Data) then
-         Internalerror(3334441);
-        Data.write(s[1],length(s));
+        if assigned(Data) then
+          Data.write(s[1],length(s));
         inc(datasize,length(s));
       end;
 
@@ -504,27 +479,38 @@ implementation
       end;
 
 
-    function TAsmSection.aligneddatasize:longint;
+    function TAsmSection.aligneddatasize:aint;
       begin
         aligneddatasize:=align(datasize,addralign);
       end;
 
 
+    procedure TAsmSection.setdatapos(var dpos:aint);
+      var
+        alignedpos : aint;
+      begin
+        { get aligned datapos }
+        alignedpos:=align(dpos,addralign);
+        dataalignbytes:=alignedpos-dpos;
+        datapos:=alignedpos;
+        { update datapos }
+        dpos:=datapos+aligneddatasize;
+      end;
+
+
     procedure TAsmSection.alignsection;
       begin
         writealign(addralign);
       end;
 
 
-    procedure TAsmSection.alloc(l:longint);
+    procedure TAsmSection.alloc(l:aint);
       begin
-        if assigned(Data) then
-         Internalerror(3334442);
         inc(datasize,l);
       end;
 
 
-    procedure TAsmSection.addsymreloc(ofs:longint;p:tasmsymbol;relative:TAsmRelocationType);
+    procedure TAsmSection.addsymreloc(ofs:aint;p:tasmsymbol;relative:TAsmRelocationType);
       var
         r : TAsmRelocation;
       begin
@@ -532,13 +518,13 @@ implementation
         r.address:=ofs;
         r.orgsize:=0;
         r.symbol:=p;
-        r.section:=sec_none;
+        r.section:=nil;
         r.typ:=relative;
         relocations.concat(r);
       end;
 
 
-    procedure TAsmSection.addsectionreloc(ofs:longint;sec:TSection;relative:TAsmRelocationType);
+    procedure TAsmSection.addsectionreloc(ofs:aint;sec:TAsmSection;relative:TAsmRelocationType);
       var
         r : TAsmRelocation;
       begin
@@ -552,6 +538,11 @@ implementation
       end;
 
 
+    procedure TAsmSection.fixuprelocs;
+      begin
+      end;
+
+
 {****************************************************************************
                                 TAsmObjectData
 ****************************************************************************}
@@ -559,93 +550,162 @@ implementation
     constructor TAsmObjectData.create(const n:string);
       begin
         inherited create;
-        name:=n;
+        FName:=n;
         { sections }
-        FillChar(Sects,sizeof(Sects),0);
+        FSects:=tdictionary.create;
+        FStabsRecSize:=1;
+        FStabsSec:=nil;
+        FStabStrSec:=nil;
         { symbols }
-        symbols:=tindexarray.create(symbolsgrow);
-        symbols.noclear:=true;
+        FSymbols:=tindexarray.create(symbolsgrow);
+        FSymbols.noclear:=true;
+        { section class type for creating of new sections }
+        FCAsmSection:=TAsmSection;
       end;
 
 
     destructor TAsmObjectData.destroy;
+      begin
+        FSects.free;
+        FSymbols.free;
+      end;
+
+
+    function TAsmObjectData.sectionname(atype:tasmsectiontype;const aname:string):string;
+      const
+        secnames : array[tasmsectiontype] of string[12] = ('',
+          'code','data','rodata','bss',
+          'common',
+          'note',
+          'stab','stabstr',
+          'idata2','idata4','idata5','idata6','idata7','edata',
+          'eh_frame',
+          'debug_frame'
+        );
+      begin
+        if aname<>'' then
+          result:=secnames[atype]+'.'+aname
+        else
+          result:=secnames[atype];
+      end;
+
+
+    function TAsmObjectData.createsection(atype:tasmsectiontype;const aname:string;aalign:longint;aoptions:TAsmSectionOptions):TAsmSection;
       var
-        sec : TSection;
+        secname : string;
       begin
-        { free memory }
-        for sec:=low(TSection) to high(TSection) do
-         if assigned(sects[sec]) then
-          sects[sec].free;
-        symbols.free;
+        secname:=sectionname(atype,aname);
+        result:=TasmSection(FSects.search(secname));
+        if not assigned(result) then
+          begin
+{$warning TODO make alloconly configurable}
+            if atype=sec_bss then
+              include(aoptions,aso_alloconly);
+            result:=CAsmSection.create(secname,atype,aalign,aoptions);
+            FSects.Insert(result);
+            result.owner:=self;
+          end;
+        FCurrSec:=result;
       end;
 
 
-    procedure TAsmObjectData.createsection(sec:TSection);
+    procedure TAsmObjectData.setsection(asec:tasmsection);
       begin
-        sects[sec]:=TAsmSection.create(target_asm.secnames[sec],1,(sec=sec_bss));
+        if asec.owner<>self then
+          internalerror(200403041);
+        FCurrSec:=asec;
       end;
 
 
-    function TAsmObjectData.sectionsize(s:TSection):longint;
+    procedure TAsmObjectData.writebytes(var data;len:aint);
       begin
-        if assigned(sects[s]) then
-         sectionsize:=sects[s].datasize
-        else
-         sectionsize:=0;
+        if not assigned(currsec) then
+          internalerror(200402251);
+        currsec.write(data,len);
       end;
 
 
-    function TAsmObjectData.currsectionsize:longint;
+    procedure TAsmObjectData.alloc(len:aint);
       begin
-        if assigned(sects[currsec]) then
-         currsectionsize:=sects[currsec].datasize
-        else
-         currsectionsize:=0;
+        if not assigned(currsec) then
+          internalerror(200402252);
+        currsec.alloc(len);
       end;
 
 
-    procedure TAsmObjectData.seTSectionsizes(var s:TAsmSectionSizes);
+    procedure TAsmObjectData.allocalign(len:longint);
+      var
+        modulo : aint;
       begin
+        if not assigned(currsec) then
+          internalerror(200402253);
+        modulo:=currsec.datasize mod len;
+        if modulo > 0 then
+          currsec.alloc(len-modulo);
       end;
 
 
-    procedure TAsmObjectData.defaulTSection(sec:TSection);
+    procedure TAsmObjectData.allocsymbol(currpass:byte;p:tasmsymbol;len:aint);
       begin
-        currsec:=sec;
+        p.setaddress(currpass,currsec,currsec.datasize,len);
       end;
 
 
-    procedure TAsmObjectData.writebytes(var data;len:longint);
+    procedure TAsmObjectData.allocstabs(p:pchar);
       begin
-        if not assigned(sects[currsec]) then
-         createsection(currsec);
-        sects[currsec].write(data,len);
+        if not(assigned(FStabsSec) and assigned(FStabStrSec)) then
+          internalerror(200402254);
+        FStabsSec.alloc(FStabsRecSize);
+        if assigned(p) and (p[0]<>#0) then
+          FStabStrSec.alloc(strlen(p)+1);
       end;
 
 
-    procedure TAsmObjectData.alloc(len:longint);
+    procedure TAsmObjectData.section_reset(p:tnamedindexitem;arg:pointer);
       begin
-        if not assigned(sects[currsec]) then
-         createsection(currsec);
-        sects[currsec].alloc(len);
+        with tasmsection(p) do
+          begin
+            datasize:=0;
+            datapos:=0;
+          end;
       end;
 
 
-    procedure TAsmObjectData.allocalign(len:longint);
-      var
-        modulo : longint;
+    procedure TAsmObjectData.section_fixuprelocs(p:tnamedindexitem;arg:pointer);
       begin
-        if not assigned(sects[currsec]) then
-         createsection(currsec);
-        modulo:=sects[currsec].datasize mod len;
-        if modulo > 0 then
-          sects[currsec].alloc(len-modulo);
+        tasmsection(p).fixuprelocs;
+      end;
+
+
+    procedure TAsmObjectData.beforealloc;
+      begin
+      end;
+
+
+    procedure TAsmObjectData.beforewrite;
+      begin
+      end;
+
+
+    procedure TAsmObjectData.afteralloc;
+      begin
+      end;
+
+
+    procedure TAsmObjectData.afterwrite;
+      begin
+      end;
+
+
+    procedure TAsmObjectData.resetsections;
+      begin
+        FSects.foreach(@section_reset,nil);
       end;
 
 
     procedure TAsmObjectData.fixuprelocs;
       begin
-        { no relocation support by default }
+        FSects.foreach(@section_fixuprelocs,nil);
       end;
 
 
@@ -693,9 +753,9 @@ implementation
          begin
            if not assigned(asmsymbolidx) then
              internalerror(200208072);
-           if (longint(pointer(s))<1) or (longint(pointer(s))>asmsymbolppuidx) then
+           if (ptrint(pointer(s))<1) or (ptrint(pointer(s))>asmsymbolppuidx) then
              internalerror(200208073);
-           s:=asmsymbolidx^[longint(pointer(s))-1];
+           s:=asmsymbolidx^[ptrint(pointer(s))-1];
          end;
       end;
 
@@ -708,7 +768,9 @@ implementation
         if assigned(hp) then
          begin
            {$IFDEF EXTDEBUG}
-           if (_typ <> AT_NONE) and (hp.typ <> _typ) then
+           if (_typ <> AT_NONE) and
+              (hp.typ <> _typ) and
+              not(cs_compilesystem in aktmoduleswitches) then
              begin
                //Writeln('Error symbol '+hp.name+' type is ',Ord(_typ),', should be ',Ord(hp.typ));
                InternalError(2004031501);
@@ -822,7 +884,7 @@ implementation
            with hp do
             begin
               if is_used and
-                 (section=Sec_none) and
+                 (section=nil) and
                  not(currbind in [AB_EXTERNAL,AB_COMMON]) then
                Message1(asmw_e_undefined_label,name);
             end;
@@ -880,7 +942,22 @@ implementation
 end.
 {
   $Log$
-  Revision 1.17  2004-03-18 11:45:39  olle
+  Revision 1.18  2004-06-16 20:07:06  florian
+    * dwarf branch merged
+
+  Revision 1.17.2.4  2004/05/11 21:04:40  peter
+    * ignore EXTDEBUG check for different asmsymbol type for system unit
+
+  Revision 1.17.2.3  2004/04/26 21:05:09  peter
+    * size of classes is now stored as aint
+
+  Revision 1.17.2.2  2004/04/12 19:34:45  peter
+    * basic framework for dwarf CFI
+
+  Revision 1.17.2.1  2004/04/08 18:33:22  peter
+    * rewrite of TAsmSection
+
+  Revision 1.17  2004/03/18 11:45:39  olle
     + added type similarity check in newasmsymbol
 
   Revision 1.16  2004/03/02 00:36:32  olle

compiler/aasmtai.pas

@@ -53,14 +53,17 @@ interface
           ait_symbol,
           ait_symbol_end, { needed to calc the size of a symbol }
           ait_label,
+          { the const_xx must be below each other so it can be used as
+            array index }
+          ait_const_128bit,
           ait_const_64bit,
           ait_const_32bit,
           ait_const_16bit,
           ait_const_8bit,
-          ait_const_symbol,
-          { the following is only used by the win32 version of the compiler }
-          { and only the GNU AS Win32 is able to write it                   }
-          ait_const_rva,
+          ait_const_sleb128bit,
+          ait_const_uleb128bit,
+          ait_const_rva_symbol, { win32 only }
+          ait_const_indirect_symbol, { darwin only }
           ait_real_32bit,
           ait_real_64bit,
           ait_real_80bit,
@@ -85,17 +88,24 @@ interface
           ait_labeled_instruction,
 {$endif m68k}
           { used to split into tiny assembler files }
-          ait_cut,
+          ait_cutobject,
           ait_regalloc,
           ait_tempalloc,
           { used to mark assembler blocks and inlined functions }
           ait_marker,
-          { special symbols for darwin pic code }
-          ait_indirect_symbol,
+          { special symbol for darwin pic code }
           ait_non_lazy_symbol_pointer
           );
 
     const
+{$ifdef cpu64bit}
+       ait_const_aint = ait_const_64bit;
+       ait_const_ptr  = ait_const_64bit;
+{$else cpu64bit}
+       ait_const_aint = ait_const_32bit;
+       ait_const_ptr  = ait_const_32bit;
+{$endif cpu64bit}
+
        taitypestr : array[taitype] of string[24] = (
           '<none>',
           'align',
@@ -108,12 +118,15 @@ interface
           'symbol',
           'symbol_end',
           'label',
+          'const_128bit',
           'const_64bit',
           'const_32bit',
           'const_16bit',
           'const_8bit',
-          'const_symbol',
-          'const_rva',
+          'const_sleb128bit',
+          'const_uleb128bit',
+          'const_rva_symbol',
+          'const_indirect_symbol',
           'real_32bit',
           'real_64bit',
           'real_80bit',
@@ -141,7 +154,6 @@ interface
           'regalloc',
           'tempalloc',
           'marker',
-          'indirect_symbol',
           'non_lazy_symbol_pointer'
           );
 
@@ -177,7 +189,7 @@ interface
           top_none   : ();
           top_reg    : (reg:tregister);
           top_ref    : (ref:preference);
-          top_const  : (val:aword);
+          top_const  : (val:aint);
           top_bool   : (b:boolean);
           { local varsym that will be inserted in pass_2 }
           top_local  : (localoper:plocaloper);
@@ -209,8 +221,10 @@ interface
 {$ifdef GDB}
                   ait_stabn,ait_stabs,ait_stab_function_name,
 {$endif GDB}
-                  ait_cut,ait_marker,ait_align,ait_section,ait_comment,
-                  ait_const_8bit,ait_const_16bit,ait_const_32bit,ait_const_64bit,
+                  ait_cutobject,ait_marker,ait_align,ait_section,ait_comment,
+                  ait_const_8bit,ait_const_16bit,ait_const_32bit,ait_const_64bit,ait_const_128bit,
+                  ait_const_sleb128bit,ait_const_uleb128bit,
+                  ait_const_rva_symbol,ait_const_indirect_symbol,
                   ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_real_128bit,
                   ait_non_lazy_symbol_pointer
                   ];
@@ -332,8 +346,12 @@ interface
 
        { Generates a section / segment directive }
        tai_section = class(tai)
-          sec : TSection;
-          constructor Create(s : TSection);
+          sectype : TAsmSectionType;
+          secalign : byte;
+          name    : pstring;
+          sec     : TAsmSection; { used in binary writer }
+          constructor Create(Asectype:TAsmSectionType;Aname:string;Aalign:byte);
+          destructor Destroy;override;
           constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
        end;
@@ -354,30 +372,32 @@ interface
 
        { Generates an integer const }
        tai_const = class(tai)
-          value : qword;
-          constructor Create_ptr(_value : TConstPtrUInt);
-          constructor Create_64bit(_value : qword);
-          constructor Create_32bit(_value : cardinal);
+          sym,
+          endsym  : tasmsymbol;
+          value   : int64;
+          { we use for the 128bit int64/qword for now because I can't imagine a
+            case where we need 128 bit now (FK) }
+          constructor Create(_typ:taitype;_value : int64);
+          constructor Create_128bit(_value : int64);
+          constructor Create_64bit(_value : int64);
+          constructor Create_32bit(_value : longint);
           constructor Create_16bit(_value : word);
           constructor Create_8bit(_value : byte);
-          constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
-          procedure ppuwrite(ppufile:tcompilerppufile);override;
-       end;
-
-
-       tai_const_symbol = class(tailineinfo)
-          sym    : tasmsymbol;
-          offset : aint;
-          constructor Create(_sym:tasmsymbol);
-          constructor Create_offset(_sym:tasmsymbol;ofs:aint);
-          constructor Create_rva(_sym:tasmsymbol);
-          constructor Create_indirect(_sym:tasmsymbol);
+          constructor Create_sleb128bit(_value : int64);
+          constructor Create_uleb128bit(_value : qword);
+          constructor Create_aint(_value : aint);
+          constructor Create_sym(_sym:tasmsymbol);
+          constructor Create_sym_offset(_sym:tasmsymbol;ofs:aint);
+          constructor Create_rel_sym(_typ:taitype;_sym,_endsym:tasmsymbol);
+          constructor Create_rva_sym(_sym:tasmsymbol);
+          constructor Create_indirect_sym(_sym:tasmsymbol);
           constructor Createname(const name:string;_symtyp:Tasmsymtype;ofs:aint);
           constructor Createname_rva(const name:string);
           constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           procedure derefimpl;override;
           function getcopy:tlinkedlistitem;override;
+          function size:longint;
        end;
 
        { Generates a single float (32 bit real) }
@@ -433,7 +453,7 @@ interface
        end;
 
        { Insert a cut to split assembler into several smaller files }
-       tai_cut = class(tai)
+       tai_cutobject = class(tai)
           place : tcutplace;
           constructor Create;
           constructor Create_begin;
@@ -485,7 +505,7 @@ interface
 
        { Class template for assembler instructions
        }
-       taicpu_abstract = class(tailineinfo)
+       tai_cpu_abstract = class(tailineinfo)
        protected
           procedure ppuloadoper(ppufile:tcompilerppufile;var o:toper);virtual;abstract;
           procedure ppuwriteoper(ppufile:tcompilerppufile;const o:toper);virtual;abstract;
@@ -507,7 +527,7 @@ interface
 {$endif x86}
           { true if instruction is a jmp }
           is_jmp    : boolean; { is this instruction a jump? (needed for optimizer) }
-          Constructor Create(op : tasmop);
+          Constructor Create(op : tasmop);virtual;
           Destructor Destroy;override;
           function getcopy:TLinkedListItem;override;
           constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
@@ -516,19 +536,18 @@ interface
           procedure derefimpl;override;
           procedure SetCondition(const c:TAsmCond);
           procedure allocate_oper(opers:longint);
-          procedure loadconst(opidx:longint;l:aword);
+          procedure loadconst(opidx:longint;l:aint);
           procedure loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
           procedure loadlocal(opidx:longint;s:pointer;sofs:longint;indexreg:tregister;scale:byte;getoffset:boolean);
           procedure loadref(opidx:longint;const r:treference);
           procedure loadreg(opidx:longint;r:tregister);
           procedure loadoper(opidx:longint;o:toper);
           procedure clearop(opidx:longint);
-          function is_same_reg_move(regtype: Tregistertype):boolean;virtual;abstract;
           { register allocator }
-          function spilling_create_load(const ref:treference;r:tregister): tai;virtual;abstract;
-          function spilling_create_store(r:tregister; const ref:treference): tai;virtual;abstract;
-          function spilling_get_operation_type(opnr: longint): topertype;virtual;abstract;
+          function is_same_reg_move(regtype: Tregistertype):boolean;virtual;
+          function spilling_get_operation_type(opnr: longint): topertype;virtual;
        end;
+       tai_cpu_class = class of tai_cpu_abstract;
 
        { alignment for operator }
        tai_align_abstract = class(tai)
@@ -536,17 +555,19 @@ interface
           fillsize  : byte;   { real size to fill }
           fillop    : byte;   { value to fill with - optional }
           use_op    : boolean;
-          constructor Create(b:byte);
-          constructor Create_op(b: byte; _op: byte);
+          constructor Create(b:byte);virtual;
+          constructor Create_op(b: byte; _op: byte);virtual;
+          constructor Create_zeros(b:byte);
           constructor ppuload(t:taitype;ppufile:tcompilerppufile);override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
           function calculatefillbuf(var buf : tfillbuffer):pchar;virtual;
        end;
+       tai_align_class = class of tai_align_abstract;
 
        taasmoutput = class(tlinkedlist)
           constructor create;
-          function empty:boolean;
-          function getlasttaifilepos : pfileposinfo;
+          function  empty : boolean;
+          function  getlasttaifilepos : pfileposinfo;
           procedure InsertAfter(Item,Loc : TLinkedListItem);override;
        end;
 
@@ -572,10 +593,19 @@ interface
       debuglist,withdebuglist,consts,
       importssection,exportssection,
       resourcesection,rttilist,
+      dwarflist,
       { data used by pic code }
       picdata,
       resourcestringlist         : taasmoutput;
 
+      cai_align : tai_align_class;
+      cai_cpu   : tai_cpu_class;
+
+    function  use_smartlink_section:boolean;
+    function  maybe_smartlink_symbol:boolean;
+    procedure maybe_new_object_file(list:taasmoutput);
+    procedure new_section(list:taasmoutput;Asectype:TAsmSectionType;Aname:string;Aalign:byte);
+
     function ppuloadai(ppufile:tcompilerppufile):tai;
     procedure ppuwriteai(ppufile:tcompilerppufile;n:tai);
 
@@ -640,6 +670,36 @@ implementation
       end;
 
 
+    function use_smartlink_section:boolean;
+      begin
+        result:=(af_smartlink_sections in target_asm.flags) and
+                (tf_smartlink_sections in target_info.flags) and
+                not(cs_debuginfo in aktmoduleswitches);
+      end;
+
+
+    function maybe_smartlink_symbol:boolean;
+      begin
+        result:=(cs_create_smart in aktmoduleswitches) or
+                use_smartlink_section;
+      end;
+
+
+    procedure maybe_new_object_file(list:taasmoutput);
+      begin
+        if (cs_create_smart in aktmoduleswitches) and
+           (not use_smartlink_section) then
+          list.concat(tai_cutobject.create);
+      end;
+
+
+    procedure new_section(list:taasmoutput;Asectype:TAsmSectionType;Aname:string;Aalign:byte);
+      begin
+        list.concat(tai_section.create(Asectype,Aname,Aalign));
+        list.concat(cai_align.create(Aalign));
+      end;
+
+
 {****************************************************************************
                              TAI
  ****************************************************************************}
@@ -718,25 +778,39 @@ implementation
                              TAI_SECTION
  ****************************************************************************}
 
-    constructor tai_section.Create(s : TSection);
+    constructor tai_section.Create(Asectype:TAsmSectionType;Aname:string;Aalign:byte);
       begin
-         inherited Create;
-         typ:=ait_section;
-         sec:=s;
+        inherited Create;
+        typ:=ait_section;
+        sectype:=asectype;
+        secalign:=Aalign;
+        name:=stringdup(Aname);
+        sec:=nil;
       end;
 
 
     constructor tai_section.ppuload(t:taitype;ppufile:tcompilerppufile);
       begin
         inherited ppuload(t,ppufile);
-        sec:=tsection(ppufile.getbyte);
+        sectype:=tasmsectiontype(ppufile.getbyte);
+        secalign:=ppufile.getbyte;
+        name:=stringdup(ppufile.getstring);
+        sec:=nil;
+      end;
+
+
+    destructor tai_section.Destroy;
+      begin
+        stringdispose(name);
       end;
 
 
     procedure tai_section.ppuwrite(ppufile:tcompilerppufile);
       begin
         inherited ppuwrite(ppufile);
-        ppufile.putbyte(byte(sec));
+        ppufile.putbyte(byte(sectype));
+        ppufile.putbyte(secalign);
+        ppufile.putstring(name^);
       end;
 
 
@@ -903,29 +977,43 @@ implementation
                                TAI_CONST
  ****************************************************************************}
 
-    constructor tai_const.Create_ptr(_value : TConstPtrUInt);
+    constructor tai_const.Create(_typ:taitype;_value : int64);
       begin
-{$ifdef cpu64bit}
-        self.create_64bit(_value);
-{$else cpu64bit}
-        self.create_32bit(_value);
-{$endif cpu64bit}
+         inherited Create;
+         typ:=_typ;
+         value:=_value;
+         sym:=nil;
+         endsym:=nil;
       end;
 
 
-    constructor tai_const.Create_64bit(_value : qword);
+    constructor tai_const.Create_128bit(_value : int64);
+      begin
+         inherited Create;
+         typ:=ait_const_128bit;
+         value:=_value;
+         sym:=nil;
+         endsym:=nil;
+      end;
+
+
+    constructor tai_const.Create_64bit(_value : int64);
       begin
          inherited Create;
          typ:=ait_const_64bit;
          value:=_value;
+         sym:=nil;
+         endsym:=nil;
       end;
 
 
-    constructor tai_const.Create_32bit(_value : cardinal);
+    constructor tai_const.Create_32bit(_value : longint);
       begin
          inherited Create;
          typ:=ait_const_32bit;
          value:=_value;
+         sym:=nil;
+         endsym:=nil;
       end;
 
 
@@ -934,6 +1022,8 @@ implementation
          inherited Create;
          typ:=ait_const_16bit;
          value:=_value;
+         sym:=nil;
+         endsym:=nil;
       end;
 
 
@@ -942,118 +1032,180 @@ implementation
          inherited Create;
          typ:=ait_const_8bit;
          value:=_value;
+         sym:=nil;
+         endsym:=nil;
       end;
 
 
-    constructor tai_const.ppuload(t:taitype;ppufile:tcompilerppufile);
+    constructor tai_const.Create_sleb128bit(_value : int64);
       begin
-        inherited ppuload(t,ppufile);
-        value:=ppufile.getlongint;
+         inherited Create;
+         typ:=ait_const_sleb128bit;
+         value:=_value;
+         sym:=nil;
+         endsym:=nil;
       end;
 
 
-    procedure tai_const.ppuwrite(ppufile:tcompilerppufile);
+    constructor tai_const.Create_uleb128bit(_value : qword);
       begin
-        inherited ppuwrite(ppufile);
-        ppufile.putlongint(value);
+         inherited Create;
+         typ:=ait_const_uleb128bit;
+         value:=int64(_value);
+         sym:=nil;
+         endsym:=nil;
       end;
 
 
-{****************************************************************************
-                               TAI_CONST_SYMBOL
- ****************************************************************************}
+    constructor tai_const.Create_aint(_value : aint);
+      begin
+         inherited Create;
+         typ:=ait_const_aint;
+         value:=_value;
+         sym:=nil;
+         endsym:=nil;
+      end;
+
+
+    constructor tai_const.Create_sym(_sym:tasmsymbol);
+      begin
+         inherited Create;
+         typ:=ait_const_ptr;
+         { sym is allowed to be nil, this is used to write nil pointers }
+         sym:=_sym;
+         endsym:=nil;
+         value:=0;
+         { update sym info }
+         if assigned(sym) then
+           sym.increfs;
+      end;
+
 
-    constructor tai_const_symbol.Create(_sym:tasmsymbol);
+    constructor tai_const.Create_sym_offset(_sym:tasmsymbol;ofs:aint);
       begin
          inherited Create;
-         typ:=ait_const_symbol;
+         typ:=ait_const_ptr;
+         if not assigned(_sym) then
+           internalerror(200404121);
          sym:=_sym;
-         offset:=0;
+         endsym:=nil;
+         value:=ofs;
          { update sym info }
          sym.increfs;
       end;
 
-    constructor tai_const_symbol.Create_offset(_sym:tasmsymbol;ofs:aint);
+
+    constructor tai_const.Create_rel_sym(_typ:taitype;_sym,_endsym:tasmsymbol);
       begin
          inherited Create;
-         typ:=ait_const_symbol;
+         typ:=_typ;
          sym:=_sym;
-         offset:=ofs;
+         endsym:=_endsym;
+         value:=0;
          { update sym info }
          sym.increfs;
+         endsym.increfs;
       end;
 
 
-    constructor tai_const_symbol.Create_rva(_sym:tasmsymbol);
+    constructor tai_const.Create_rva_sym(_sym:tasmsymbol);
       begin
          inherited Create;
-         typ:=ait_const_rva;
+         typ:=ait_const_rva_symbol;
          sym:=_sym;
-         offset:=0;
+         endsym:=nil;
+         value:=0;
          { update sym info }
          sym.increfs;
       end;
 
 
-    constructor tai_const_symbol.Create_indirect(_sym:tasmsymbol);
+    constructor tai_const.Create_indirect_sym(_sym:tasmsymbol);
       begin
          inherited Create;
-         typ:=ait_indirect_symbol;
+         typ:=ait_const_indirect_symbol;
          sym:=_sym;
-         offset:=0;
+         endsym:=nil;
+         value:=0;
          { update sym info }
          sym.increfs;
       end;
 
 
-    constructor tai_const_symbol.Createname(const name:string;_symtyp:Tasmsymtype;ofs:aint);
+    constructor tai_const.Createname(const name:string;_symtyp:Tasmsymtype;ofs:aint);
       begin
          inherited Create;
-         typ:=ait_const_symbol;
+         typ:=ait_const_ptr;
          sym:=objectlibrary.newasmsymbol(name,AB_EXTERNAL,_symtyp);
-         offset:=ofs;
+         endsym:=nil;
+         value:=ofs;
          { update sym info }
          sym.increfs;
       end;
 
 
-    constructor tai_const_symbol.Createname_rva(const name:string);
+    constructor tai_const.Createname_rva(const name:string);
       begin
          inherited Create;
-         typ:=ait_const_rva;
+         typ:=ait_const_rva_symbol;
          sym:=objectlibrary.newasmsymbol(name,AB_EXTERNAL,AT_FUNCTION);
-         offset:=0;
+         endsym:=nil;
+         value:=0;
          { update sym info }
          sym.increfs;
       end;
 
-    constructor tai_const_symbol.ppuload(t:taitype;ppufile:tcompilerppufile);
+
+    constructor tai_const.ppuload(t:taitype;ppufile:tcompilerppufile);
       begin
         inherited ppuload(t,ppufile);
         sym:=ppufile.getasmsymbol;
-        offset:=ppufile.getlongint;
+        endsym:=ppufile.getasmsymbol;
+        value:=ppufile.getint64;
       end;
 
 
-    procedure tai_const_symbol.ppuwrite(ppufile:tcompilerppufile);
+    procedure tai_const.ppuwrite(ppufile:tcompilerppufile);
       begin
         inherited ppuwrite(ppufile);
         ppufile.putasmsymbol(sym);
-        ppufile.putlongint(offset);
+        ppufile.putasmsymbol(endsym);
+        ppufile.putint64(value);
       end;
 
 
-    procedure tai_const_symbol.derefimpl;
+    procedure tai_const.derefimpl;
       begin
         objectlibrary.DerefAsmsymbol(sym);
+        objectlibrary.DerefAsmsymbol(endsym);
       end;
 
 
-    function tai_const_symbol.getcopy:tlinkedlistitem;
+    function tai_const.getcopy:tlinkedlistitem;
       begin
         getcopy:=inherited getcopy;
         { we need to increase the reference number }
         sym.increfs;
+        if assigned(endsym) then
+          endsym.increfs;
+      end;
+
+
+    function tai_const.size:longint;
+      begin
+        case typ of
+          ait_const_8bit :
+            result:=1;
+          ait_const_16bit :
+            result:=2;
+          ait_const_32bit :
+            result:=4;
+          ait_const_64bit :
+            result:=8;
+          ait_const_indirect_symbol,
+          ait_const_rva_symbol :
+            result:=sizeof(aint);
+        end;
       end;
 
 
@@ -1423,41 +1575,41 @@ implementation
 
 
 {****************************************************************************
-                              TAI_CUT
+                              TAI_CUTOBJECT
  ****************************************************************************}
 
-     constructor tai_cut.Create;
+     constructor tai_cutobject.Create;
        begin
           inherited Create;
-          typ:=ait_cut;
+          typ:=ait_cutobject;
           place:=cut_normal;
        end;
 
 
-     constructor tai_cut.Create_begin;
+     constructor tai_cutobject.Create_begin;
        begin
           inherited Create;
-          typ:=ait_cut;
+          typ:=ait_cutobject;
           place:=cut_begin;
        end;
 
 
-     constructor tai_cut.Create_end;
+     constructor tai_cutobject.Create_end;
        begin
           inherited Create;
-          typ:=ait_cut;
+          typ:=ait_cutobject;
           place:=cut_end;
        end;
 
 
-    constructor tai_cut.ppuload(t:taitype;ppufile:tcompilerppufile);
+    constructor tai_cutobject.ppuload(t:taitype;ppufile:tcompilerppufile);
       begin
         inherited ppuload(t,ppufile);
         place:=TCutPlace(ppufile.getbyte);
       end;
 
 
-    procedure tai_cut.ppuwrite(ppufile:tcompilerppufile);
+    procedure tai_cutobject.ppuwrite(ppufile:tcompilerppufile);
       begin
         inherited ppuwrite(ppufile);
         ppufile.putbyte(byte(place));
@@ -1614,7 +1766,7 @@ implementation
                                TaiInstruction
 *****************************************************************************}
 
-    constructor taicpu_abstract.Create(op : tasmop);
+    constructor tai_cpu_abstract.Create(op : tasmop);
 
       begin
          inherited create;
@@ -1627,7 +1779,7 @@ implementation
       end;
 
 
-    destructor taicpu_abstract.Destroy;
+    destructor tai_cpu_abstract.Destroy;
       var
         i : integer;
       begin
@@ -1644,7 +1796,7 @@ implementation
     Loading of operands.
   ---------------------------------------------------------------------}
 
-    procedure taicpu_abstract.allocate_oper(opers:longint);
+    procedure tai_cpu_abstract.allocate_oper(opers:longint);
       begin
         while (opers>opercnt) do
           begin
@@ -1655,7 +1807,7 @@ implementation
       end;
 
 
-    procedure taicpu_abstract.loadconst(opidx:longint;l:aword);
+    procedure tai_cpu_abstract.loadconst(opidx:longint;l:aint);
       begin
         allocate_oper(opidx+1);
         with oper[opidx]^ do
@@ -1668,7 +1820,7 @@ implementation
       end;
 
 
-    procedure taicpu_abstract.loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
+    procedure tai_cpu_abstract.loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
       var
         r : treference;
       begin
@@ -1678,7 +1830,7 @@ implementation
       end;
 
 
-    procedure taicpu_abstract.loadlocal(opidx:longint;s:pointer;sofs:longint;indexreg:tregister;scale:byte;getoffset:boolean);
+    procedure tai_cpu_abstract.loadlocal(opidx:longint;s:pointer;sofs:longint;indexreg:tregister;scale:byte;getoffset:boolean);
       begin
         if not assigned(s) then
          internalerror(200204251);
@@ -1703,7 +1855,7 @@ implementation
       end;
 
 
-    procedure taicpu_abstract.loadref(opidx:longint;const r:treference);
+    procedure tai_cpu_abstract.loadref(opidx:longint;const r:treference);
       begin
         allocate_oper(opidx+1);
         with oper[opidx]^ do
@@ -1734,7 +1886,7 @@ implementation
       end;
 
 
-    procedure taicpu_abstract.loadreg(opidx:longint;r:tregister);
+    procedure tai_cpu_abstract.loadreg(opidx:longint;r:tregister);
       begin
         allocate_oper(opidx+1);
         with oper[opidx]^ do
@@ -1757,7 +1909,7 @@ implementation
       end;
 
 
-    procedure taicpu_abstract.loadoper(opidx:longint;o:toper);
+    procedure tai_cpu_abstract.loadoper(opidx:longint;o:toper);
       begin
         allocate_oper(opidx+1);
         clearop(opidx);
@@ -1795,7 +1947,7 @@ implementation
       end;
 
 
-    procedure taicpu_abstract.clearop(opidx:longint);
+    procedure tai_cpu_abstract.clearop(opidx:longint);
       begin
         with oper[opidx]^ do
           begin
@@ -1820,18 +1972,18 @@ implementation
     Miscellaneous methods.
   ---------------------------------------------------------------------}
 
-    procedure taicpu_abstract.SetCondition(const c:TAsmCond);
+    procedure tai_cpu_abstract.SetCondition(const c:TAsmCond);
       begin
          condition:=c;
       end;
 
 
-    Function taicpu_abstract.getcopy:TLinkedListItem;
+    Function tai_cpu_abstract.getcopy:TLinkedListItem;
       var
         i : longint;
-        p : taicpu_abstract;
+        p : tai_cpu_abstract;
       begin
-        p:=taicpu_abstract(inherited getcopy);
+        p:=tai_cpu_abstract(inherited getcopy);
         { make a copy of the references }
         p.opercnt:=0;
         p.allocate_oper(ops);
@@ -1862,7 +2014,22 @@ implementation
       end;
 
 
-    constructor taicpu_abstract.ppuload(t:taitype;ppufile:tcompilerppufile);
+    function tai_cpu_abstract.is_same_reg_move(regtype: Tregistertype):boolean;
+      begin
+        { When the generic RA is used this needs to be overriden, we don't use
+          virtual;abstract; to prevent a lot of warnings of unimplemented abstract methods
+          when tai_cpu is created (PFV) }
+        internalerror(200404091);
+      end;
+
+
+    function tai_cpu_abstract.spilling_get_operation_type(opnr: longint): topertype;
+      begin
+        internalerror(200404091);
+      end;
+
+
+    constructor tai_cpu_abstract.ppuload(t:taitype;ppufile:tcompilerppufile);
       var
         i : integer;
       begin
@@ -1880,7 +2047,7 @@ implementation
       end;
 
 
-    procedure taicpu_abstract.ppuwrite(ppufile:tcompilerppufile);
+    procedure tai_cpu_abstract.ppuwrite(ppufile:tcompilerppufile);
       var
         i : integer;
       begin
@@ -1897,7 +2064,7 @@ implementation
       end;
 
 
-    procedure taicpu_abstract.buildderefimpl;
+    procedure tai_cpu_abstract.buildderefimpl;
       var
         i : integer;
       begin
@@ -1906,7 +2073,7 @@ implementation
       end;
 
 
-    procedure taicpu_abstract.derefimpl;
+    procedure tai_cpu_abstract.derefimpl;
       var
         i : integer;
       begin
@@ -1947,8 +2114,24 @@ implementation
        end;
 
 
+     constructor tai_align_abstract.Create_zeros(b: byte);
+       begin
+          inherited Create;
+          typ:=ait_align;
+          if b in [1,2,4,8,16,32] then
+            aligntype := b
+          else
+            aligntype := 1;
+         use_op:=true;
+         fillsize:=0;
+         fillop:=0;
+       end;
+
+
      function tai_align_abstract.calculatefillbuf(var buf : tfillbuffer):pchar;
        begin
+         if fillsize>sizeof(buf) then
+           internalerror(200404293);
          fillchar(buf,high(buf),fillop);
          calculatefillbuf:=pchar(@buf);
        end;
@@ -1985,14 +2168,11 @@ implementation
       end;
 
 
-    function taasmoutput.empty:boolean;
+    function taasmoutput.empty : boolean;
       begin
-        result:=(count=0) or
-                (
-                 (count=1) and
-                 (tai(first).typ=ait_marker) and
-                 (tai_marker(first).kind=marker_blockstart)
-                );
+        { there is always a marker_blockstart available,
+          see taasmoutput.create }
+        result:=(count<=1);
       end;
 
 
@@ -2031,10 +2211,16 @@ implementation
         inherited InsertAfter(Item,Loc);
       end;
 
+begin
+  cai_cpu:=tai_cpu_abstract;
+  cai_align:=tai_align_abstract;
 end.
 {
   $Log$
-  Revision 1.84  2004-05-23 14:31:05  peter
+  Revision 1.85  2004-06-16 20:07:06  florian
+    * dwarf branch merged
+
+  Revision 1.84  2004/05/23 14:31:05  peter
     * ignore marker block when checking for empty list
 
   Revision 1.83  2004/05/22 23:34:27  peter
@@ -2043,6 +2229,49 @@ end.
   Revision 1.82  2004/04/12 18:59:32  florian
     * small x86_64 fixes
 
+  Revision 1.81.2.14  2004/06/13 10:51:16  florian
+    * fixed several register allocator problems (sparc/arm)
+
+  Revision 1.81.2.13  2004/05/18 20:14:18  peter
+    * no section smartlink when using debuginfo
+
+  Revision 1.81.2.12  2004/05/10 21:28:34  peter
+    * section_smartlink enabled for gas under linux
+
+  Revision 1.81.2.11  2004/05/01 16:02:09  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
+  Revision 1.81.2.10  2004/04/29 23:30:28  peter
+    * fix i386 compiler
+
+  Revision 1.81.2.9  2004/04/29 19:07:22  peter
+    * compile fixes
+
+  Revision 1.81.2.8  2004/04/27 18:18:25  peter
+    * aword -> aint
+
+  Revision 1.81.2.7  2004/04/20 16:35:58  peter
+    * generate dwarf for stackframe entry
+
+  Revision 1.81.2.6  2004/04/12 19:34:45  peter
+    * basic framework for dwarf CFI
+
+  Revision 1.81.2.5  2004/04/12 14:45:10  peter
+    * tai_const_symbol and tai_const merged
+
+  Revision 1.81.2.4  2004/04/10 19:45:07  florian
+    + .*leb128 support to assembler writer added
+
+  Revision 1.81.2.3  2004/04/10 12:36:40  peter
+    * fixed alignment issues
+
+  Revision 1.81.2.2  2004/04/09 14:34:52  peter
+    * fixed compilation for win32
+
+  Revision 1.81.2.1  2004/04/08 18:33:22  peter
+    * rewrite of TAsmSection
+
   Revision 1.81  2004/03/16 22:12:10  florian
     * some alignment issues resolved
     * compiler doesn't generate anymore instructions not supported by the linux fpe
@@ -2082,13 +2311,13 @@ end.
     * tai_const.create_ptr added
 
   Revision 1.71  2004/02/08 23:10:21  jonas
-    * taicpu.is_same_reg_move() now gets a regtype parameter so it only
+    * tai_cpu.is_same_reg_move() now gets a regtype parameter so it only
       removes moves of that particular register type. This is necessary so
       we don't remove the live_start instruction of a register before it
       has been processed
 
   Revision 1.70  2004/02/08 20:15:42  jonas
-    - removed taicpu.is_reg_move because it's not used anymore
+    - removed tai_cpu.is_reg_move because it's not used anymore
     + support tracking fpu register moves by rgobj for the ppc
 
   Revision 1.69  2004/01/31 17:45:16  peter
@@ -2111,7 +2340,7 @@ end.
       register set and shifter op
 
   Revision 1.64  2004/01/12 16:37:59  peter
-    * moved spilling code from taicpu to rg
+    * moved spilling code from tai_cpu to rg
 
   Revision 1.63  2003/12/28 16:20:09  jonas
     - removed unused methods from old generic spilling code
@@ -2189,7 +2418,7 @@ end.
     * write derefdata in a separate ppu entry
 
   Revision 1.45  2003/10/21 15:15:35  peter
-    * taicpu_abstract.oper[] changed to pointers
+    * tai_cpu_abstract.oper[] changed to pointers
 
   Revision 1.44  2003/10/17 14:38:32  peter
     * 64k registers supported

compiler/aggas.pas

@@ -1,6 +1,6 @@
 {
     $Id$
-    Copyright (c) 1998-2002 by the Free Pascal team
+    Copyright (c) 1998-2004 by the Free Pascal team
 
     This unit implements generic GNU assembler (v2.8 or later)
 
@@ -45,15 +45,18 @@ interface
          file.
       }
       TGNUAssembler=class(texternalassembler)
-      public
-        procedure WriteTree(p:TAAsmoutput);override;
-        procedure WriteAsmList;override;
+      protected
+        function sectionname(atype:tasmsectiontype;const aname:string):string;virtual;
+        procedure WriteSection(atype:tasmsectiontype;const aname:string);
         procedure WriteExtraHeader;virtual;
 {$ifdef GDB}
         procedure WriteFileLineInfo(var fileinfo : tfileposinfo);
         procedure WriteFileEndInfo;
 {$endif}
         procedure WriteInstruction(hp: tai);  virtual; abstract;
+      public
+        procedure WriteTree(p:TAAsmoutput);override;
+        procedure WriteAsmList;override;
       end;
 
     const
@@ -65,7 +68,7 @@ implementation
 
     uses
       cutils,globtype,systems,
-      fmodule,finput,verbose,cpubase,
+      fmodule,finput,verbose,
       itcpugas
 {$ifdef GDB}
   {$ifdef delphi}
@@ -88,14 +91,16 @@ var
       funcname     : pchar;
       stabslastfileinfo : tfileposinfo;
 {$endif}
-      lasTSec      : TSection; { last section type written }
+      lasTSecType  : TAsmSectionType; { last section type written }
       lastfileinfo : tfileposinfo;
       infile,
       lastinfile   : tinputfile;
       symendcount  : longint;
 
     type
+{$ifdef cpuextended}
       t80bitarray = array[0..9] of byte;
+{$endif cpuextended}
       t64bitarray = array[0..7] of byte;
       t32bitarray = array[0..3] of byte;
 
@@ -195,25 +200,11 @@ var
 
 
     const
-      ait_const2str : array[ait_const_64bit..ait_const_8bit] of string[8]=
-       (#9'.quad'#9,#9'.long'#9,#9'.short'#9,#9'.byte'#9);
-
-
-    function ait_section2str(s:TSection):string;
-    begin
-       ait_section2str:=target_asm.secnames[s];
-{$ifdef GDB}
-       { this is needed for line info in data }
-       funcname:=nil;
-       case s of
-         sec_code : n_line:=n_textline;
-         sec_data : n_line:=n_dataline;
-         sec_bss  : n_line:=n_bssline;
-         else       n_line:=n_dataline;
-      end;
-{$endif GDB}
-      LasTSec:=s;
-    end;
+      ait_const2str : array[ait_const_128bit..ait_const_indirect_symbol] of string[20]=(
+        #9'.fixme128'#9,#9'.quad'#9,#9'.long'#9,#9'.short'#9,#9'.byte'#9,
+        #9'.sleb128'#9,#9'.uleb128'#9,
+        #9'.rva'#9,#9'.indirect_symbol'#9
+      );
 
 {****************************************************************************}
 {                          GNU Assembler writer                              }
@@ -276,8 +267,7 @@ var
           if not ((cs_debuginfo in aktmoduleswitches) or
              (cs_gdb_lineinfo in aktglobalswitches)) then
            exit;
-          AsmLn;
-          AsmWriteLn(ait_section2str(sec_code));
+          WriteSection(sec_code,'');
           AsmWriteLn(#9'.stabs "",'+tostr(n_sourcefile)+',0,0,'+target_asm.labelprefix+'etext');
           AsmWriteLn(target_asm.labelprefix+'etext:');
         end;
@@ -285,6 +275,64 @@ var
 {$endif GDB}
 
 
+    function TGNUAssembler.sectionname(atype:tasmsectiontype;const aname:string):string;
+      const
+        secnames : array[tasmsectiontype] of string[12] = ('',
+{$warning TODO .rodata not yet working}
+          '.text','.data','.data','.bss',
+          'common',
+          '.note',
+          '.stab','.stabstr',
+          '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
+          '.eh_frame',
+          '.debug_frame'
+        );
+      begin
+        if use_smartlink_section and
+           (atype<>sec_bss) and
+           (aname<>'') then
+          result:='.gnu.linkonce'+copy(secnames[atype],1,2)+'.'+aname
+        else
+          result:=secnames[atype];
+      end;
+
+
+    procedure TGNUAssembler.WriteSection(atype:tasmsectiontype;const aname:string);
+      var
+        s : string;
+      begin
+        AsmLn;
+        AsmWrite('.section ');
+        s:=sectionname(atype,aname);
+        AsmWrite(s);
+        if copy(s,1,4)='.gnu' then
+          begin
+            case atype of
+              sec_data :
+                AsmWrite(',""');
+              sec_code :
+                AsmWrite(',"x"');
+            end;
+          end;
+        AsmLn;
+{$ifdef GDB}
+        { this is needed for line info in data }
+        funcname:=nil;
+        case atype of
+          sec_code :
+            n_line:=n_textline;
+          sec_data :
+            n_line:=n_dataline;
+          sec_bss  :
+            n_line:=n_bssline;
+          else
+            n_line:=n_dataline;
+        end;
+{$endif GDB}
+        LasTSecType:=atype;
+      end;
+
+
     procedure TGNUAssembler.WriteTree(p:TAAsmoutput);
     const
       regallocstr : array[tregalloctype] of string[10]=(' allocated',' released','resized');
@@ -295,7 +343,6 @@ var
       hp1      : tailineinfo;
       consttyp : taitype;
       s        : string;
-      found    : boolean;
       i,pos,l  : longint;
       InlineLevel : longint;
       last_align : longint;
@@ -386,8 +433,19 @@ var
            ait_regalloc :
              begin
                if (cs_asm_regalloc in aktglobalswitches) then
-                 AsmWriteLn(#9+target_asm.comment+'Register '+gas_regname(Tai_regalloc(hp).reg)+
-                            regallocstr[tai_regalloc(hp).ratype]);
+                 begin
+                   AsmWrite(#9+target_asm.comment+'Register ');
+                   repeat
+                     AsmWrite(gas_regname(Tai_regalloc(hp).reg));
+                     if (hp.next=nil) or
+                        (tai(hp.next).typ<>ait_regalloc) or
+                        (tai_regalloc(hp.next).ratype<>tai_regalloc(hp).ratype) then
+                       break;
+                     hp:=tai(hp.next);
+                     AsmWrite(',');
+                   until false;
+                   AsmWriteLn(regallocstr[tai_regalloc(hp).ratype]);
+                 end;
              end;
 
            ait_tempalloc :
@@ -407,29 +465,31 @@ var
 
            ait_align :
              begin
-               if target_info.system <> system_powerpc_darwin then
+               if tai_align(hp).aligntype>1 then
                  begin
-                   AsmWrite(#9'.balign '+tostr(tai_align(hp).aligntype));
-                   if tai_align(hp).use_op then
-                    AsmWrite(','+tostr(tai_align(hp).fillop))
-                 end
-               else
-                 begin
-                   { darwin as only supports .align }
-                   if not ispowerof2(tai_align(hp).aligntype,i) then
-                     internalerror(2003010305);
-                   AsmWrite(#9'.align '+tostr(i));
-                   last_align := i;
+                   if target_info.system <> system_powerpc_darwin then
+                     begin
+                       AsmWrite(#9'.balign '+tostr(tai_align(hp).aligntype));
+                       if tai_align(hp).use_op then
+                        AsmWrite(','+tostr(tai_align(hp).fillop))
+                     end
+                   else
+                     begin
+                       { darwin as only supports .align }
+                       if not ispowerof2(tai_align(hp).aligntype,i) then
+                         internalerror(2003010305);
+                       AsmWrite(#9'.align '+tostr(i));
+                       last_align := i;
+                     end;
+                   AsmLn;
                  end;
-               AsmLn;
              end;
 
            ait_section :
              begin
-               if tai_section(hp).sec<>sec_none then
+               if tai_section(hp).sectype<>sec_none then
                 begin
-                  AsmLn;
-                  AsmWriteLn(ait_section2str(tai_section(hp).sec));
+                  WriteSection(tai_section(hp).sectype,tai_section(hp).name^);
 {$ifdef GDB}
                   lastfileinfo.line:=-1;
 {$endif GDB}
@@ -457,51 +517,73 @@ var
                AsmWriteln('');
              end;
 
+{$ifndef cpu64bit}
+           ait_const_128bit :
+              begin
+                internalerror(200404291);
+              end;
+
+           ait_const_64bit :
+              begin
+                if assigned(tai_const(hp).sym) then
+                  internalerror(200404292);
+                AsmWrite(ait_const2str[ait_const_32bit]);
+                if target_info.endian = endian_little then
+                  begin
+                    AsmWrite(tostr(longint(lo(tai_const(hp).value))));
+                    AsmWrite(',');
+                    AsmWrite(tostr(longint(hi(tai_const(hp).value))));
+                  end
+                else
+                  begin
+                    AsmWrite(tostr(longint(hi(tai_const(hp).value))));
+                    AsmWrite(',');
+                    AsmWrite(tostr(longint(lo(tai_const(hp).value))));
+                  end;
+                AsmLn;
+              end;
+{$endif cpu64bit}
+
+           ait_const_uleb128bit,
+           ait_const_sleb128bit,
+{$ifdef cpu64bit}
+           ait_const_128bit,
            ait_const_64bit,
+{$endif cpu64bit}
            ait_const_32bit,
            ait_const_16bit,
-           ait_const_8bit :
+           ait_const_8bit,
+           ait_const_rva_symbol,
+           ait_const_indirect_symbol :
              begin
-               AsmWrite(ait_const2str[hp.typ]+tostru(tai_const(hp).value));
+               AsmWrite(ait_const2str[hp.typ]);
                consttyp:=hp.typ;
                l:=0;
                repeat
-                 found:=(not (tai(hp.next)=nil)) and (tai(hp.next).typ=consttyp);
-                 if found then
-                  begin
-                    hp:=tai(hp.next);
-                    s:=','+tostru(tai_const(hp).value);
-                    AsmWrite(s);
-                    inc(l,length(s));
-                  end;
-               until (not found) or (l>line_length);
-               AsmLn;
-             end;
-
-           ait_const_symbol :
-             begin
-               AsmWrite(#9'.long'#9);
-               AsmWrite(tai_const_symbol(hp).sym.name);
-               if tai_const_symbol(hp).offset>0 then
-                 AsmWrite('+'+tostr(tai_const_symbol(hp).offset))
-               else if tai_const_symbol(hp).offset<0 then
-                 AsmWrite(tostr(tai_const_symbol(hp).offset));
-               AsmLn;
-             end;
-
-           ait_indirect_symbol :
-             begin
-               AsmWrite(#9'.indirect_symbol'#9);
-               AsmWrite(tai_const_symbol(hp).sym.name);
+                 if assigned(tai_const(hp).sym) then
+                   begin
+                     if assigned(tai_const(hp).endsym) then
+                       s:=tai_const(hp).endsym.name+'-'+tai_const(hp).sym.name
+                     else
+                       s:=tai_const(hp).sym.name;
+                     if tai_const(hp).value<>0 then
+                       s:=s+tostr_with_plus(tai_const(hp).value);
+                   end
+                 else
+                   s:=tostr(tai_const(hp).value);
+                 AsmWrite(s);
+                 inc(l,length(s));
+                 if (LasTSecType<>sec_data) or
+                    (l>line_length) or
+                    (hp.next=nil) or
+                    (tai(hp.next).typ<>consttyp) then
+                   break;
+                 hp:=tai(hp.next);
+                 AsmWrite(',');
+               until false;
                AsmLn;
              end;
 
-           ait_const_rva :
-             begin
-               AsmWrite(#9'.rva'#9);
-               AsmWriteLn(tai_const_symbol(hp).sym.name);
-             end;
-
 {$ifdef cpuextended}
            ait_real_80bit :
              begin
@@ -674,7 +756,7 @@ var
                    AsmWrite(#9'.type'#9);
                    AsmWrite(tai_symbol(hp).sym.name);
                    if assigned(tai(hp.next)) and
-                      (tai(hp.next).typ in [ait_const_symbol,ait_const_rva,
+                      (tai(hp.next).typ in [ait_const_rva_symbol,
                          ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_datablock,
                          ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit]) then
                      begin
@@ -749,7 +831,7 @@ var
              funcname:=tai_stab_function_name(hp).str;
 {$endif GDB}
 
-           ait_cut :
+           ait_cutobject :
              begin
                if SmartAsm then
                 begin
@@ -760,13 +842,13 @@ var
                    begin
                      AsmClose;
                      DoAssemble;
-                     AsmCreate(tai_cut(hp).place);
+                     AsmCreate(tai_cutobject(hp).place);
                    end;
                 { avoid empty files }
-                  while assigned(hp.next) and (tai(hp.next).typ in [ait_cut,ait_section,ait_comment]) do
+                  while assigned(hp.next) and (tai(hp.next).typ in [ait_cutobject,ait_section,ait_comment]) do
                    begin
                      if tai(hp.next).typ=ait_section then
-                       lasTSec:=tai_section(hp.next).sec;
+                       lasTSectype:=tai_section(hp.next).sectype;
                      hp:=tai(hp.next);
                    end;
 {$ifdef GDB}
@@ -776,8 +858,8 @@ var
                   funcname:=nil;
                   WriteFileLineInfo(aktfilepos);
 {$endif GDB}
-                  if lasTSec<>sec_none then
-                    AsmWriteLn(ait_section2str(lasTSec));
+                  if lasTSectype<>sec_none then
+                    WriteSection(lasTSectype,'');
                   AsmStartSize:=AsmSize;
                 end;
              end;
@@ -819,7 +901,7 @@ var
        Comment(V_Debug,'Start writing gas-styled assembler output for '+current_module.mainsource^);
 {$endif}
 
-      LasTSec:=sec_none;
+      LasTSectype:=sec_none;
 {$ifdef GDB}
       FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0);
 {$endif GDB}
@@ -862,9 +944,10 @@ var
       Writetree(importssection);
       { exports are written by DLLTOOL
         if we use it so don't insert it twice (PM) }
-      if not UseDeffileForExport and assigned(exportssection) then
+      if not UseDeffileForExports and assigned(exportssection) then
         Writetree(exportssection);
       Writetree(resourcesection);
+      Writetree(dwarflist);
       {$ifdef GDB}
       WriteFileEndInfo;
       {$ENDIF}
@@ -879,7 +962,10 @@ var
 end.
 {
   $Log$
-  Revision 1.53  2004-05-28 21:13:08  peter
+  Revision 1.54  2004-06-16 20:07:06  florian
+    * dwarf branch merged
+
+  Revision 1.53  2004/05/28 21:13:08  peter
     * fix wrong regalloc comments
 
   Revision 1.52  2004/05/22 23:34:27  peter
@@ -894,6 +980,48 @@ end.
   Revision 1.49  2004/04/12 18:59:32  florian
     * small x86_64 fixes
 
+  Revision 1.48.2.14  2004/05/31 15:24:26  peter
+    * merge ait_regalloc on one line
+
+  Revision 1.48.2.13  2004/05/18 20:14:18  peter
+    * no section smartlink when using debuginfo
+
+  Revision 1.48.2.12  2004/05/10 21:28:34  peter
+    * section_smartlink enabled for gas under linux
+
+  Revision 1.48.2.11  2004/05/03 14:59:57  peter
+    * no dlltool needed for win32 linking executables
+
+  Revision 1.48.2.10  2004/04/29 23:30:28  peter
+    * fix i386 compiler
+
+  Revision 1.48.2.9  2004/04/26 21:01:36  peter
+    * aint fixes
+
+  Revision 1.48.2.8  2004/04/20 16:35:58  peter
+    * generate dwarf for stackframe entry
+
+  Revision 1.48.2.7  2004/04/12 19:34:45  peter
+    * basic framework for dwarf CFI
+
+  Revision 1.48.2.6  2004/04/12 14:45:10  peter
+    * tai_const_symbol and tai_const merged
+
+  Revision 1.48.2.5  2004/04/10 22:08:52  florian
+    + more dwarf infrastructure
+
+  Revision 1.48.2.4  2004/04/10 19:45:07  florian
+    + .*leb128 support to assembler writer added
+
+  Revision 1.48.2.3  2004/04/10 12:36:41  peter
+    * fixed alignment issues
+
+  Revision 1.48.2.2  2004/04/09 14:34:53  peter
+    * fixed compilation for win32
+
+  Revision 1.48.2.1  2004/04/08 18:33:22  peter
+    * rewrite of TAsmSection
+
   Revision 1.48  2004/03/17 22:27:41  florian
     * fixed handling of doubles in a native arm compiler
     * fixed handling of typed double constants on arm

compiler/alpha/cpuinfo.pas

@@ -57,7 +57,7 @@ Const
    { Size of native extended type }
    extended_size = 16;
    {# Size of a pointer                           }
-   pointer_size  = 8;
+   sizeof(aint)  = 8;
    {# Size of a multimedia register               }
    mmreg_size = 8;
 

compiler/arm/aasmcpu.pas

@@ -28,7 +28,7 @@ interface
 
 uses
   cclasses,aasmtai,
-  aasmbase,globals,verbose,
+  aasmbase,globtype,globals,verbose,
   cpubase,cpuinfo,cgbase;
 
     const
@@ -38,7 +38,7 @@ uses
       O_MOV_DEST = 0;
 
     type
-      taicpu = class(taicpu_abstract)
+      taicpu = class(tai_cpu_abstract)
          oppostfix : TOpPostfix;
          roundingmode : troundingmode;
          procedure loadshifterop(opidx:longint;const so:tshifterop);
@@ -72,16 +72,15 @@ uses
 
          function is_same_reg_move(regtype: Tregistertype):boolean; override;
 
-         { register spilling code }
-         function spilling_create_load(const ref:treference;r:tregister): tai;override;
-         function spilling_create_store(r:tregister; const ref:treference): tai;override;
-
          function spilling_get_operation_type(opnr: longint): topertype;override;
       end;
       tai_align = class(tai_align_abstract)
         { nothing to add }
       end;
 
+    function spilling_create_load(const ref:treference;r:tregister): tai;
+    function spilling_create_store(r:tregister; const ref:treference): tai;
+
     function setoppostfix(i : taicpu;pf : toppostfix) : taicpu;
     function setroundingmode(i : taicpu;rm : troundingmode) : taicpu;
     function setcondition(i : taicpu;c : tasmcond) : taicpu;
@@ -319,15 +318,29 @@ implementation
       end;
 
 
-    function taicpu.spilling_create_load(const ref:treference;r:tregister): tai;
+    function spilling_create_load(const ref:treference;r:tregister): tai;
       begin
-        internalerror(200401261);
+        case getregtype(r) of
+          R_INTREGISTER :
+            result:=taicpu.op_reg_ref(A_LDR,r,ref);
+          R_FPUREGISTER :
+            result:=taicpu.op_reg_ref(A_LDF,r,ref);
+          else
+            internalerror(200401041);
+        end;
       end;
 
 
-    function taicpu.spilling_create_store(r:tregister; const ref:treference): tai;
+    function spilling_create_store(r:tregister; const ref:treference): tai;
       begin
-        internalerror(200401262);
+        case getregtype(r) of
+          R_INTREGISTER :
+            result:=taicpu.op_reg_ref(A_STR,r,ref);
+          R_FPUREGISTER :
+            result:=taicpu.op_reg_ref(A_STF,r,ref);
+          else
+            internalerror(200401041);
+        end;
       end;
 
 
@@ -473,7 +486,16 @@ implementation
 end.
 {
   $Log$
-  Revision 1.31  2004-03-29 19:19:35  florian
+  Revision 1.32  2004-06-16 20:07:10  florian
+    * dwarf branch merged
+
+  Revision 1.31.2.2  2004/06/13 10:51:17  florian
+    * fixed several register allocator problems (sparc/arm)
+
+  Revision 1.31.2.1  2004/06/12 17:01:01  florian
+    * fixed compilation of arm compiler
+
+  Revision 1.31  2004/03/29 19:19:35  florian
     + arm floating point register saving implemented
     * hopefully stabs generation for MacOSX fixed
     + some defines for arm added

compiler/arm/agarmgas.pas

@@ -63,16 +63,9 @@ unit agarmgas;
             asmbin : 'as';
             asmcmd : '-o $OBJ $ASM';
             supported_target : system_any;
-            outputbinary: false;
-            allowdirect : true;
-            needar : true;
-            labelprefix_only_inside_procedure : false;
+            flags : [af_allowdirect,af_needar,af_smartlink_sections];
             labelprefix : '.L';
             comment : '# ';
-            secnames : ('',
-              '.text','.data','.text',
-              '','','','','','',
-              '.stab','.stabstr','COMMON')
           );
 
     function getreferencestring(var ref : treference) : string;
@@ -245,7 +238,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.19  2004-03-29 19:19:35  florian
+  Revision 1.20  2004-06-16 20:07:10  florian
+    * dwarf branch merged
+
+  Revision 1.19.2.1  2004/06/12 17:01:01  florian
+    * fixed compilation of arm compiler
+
+  Revision 1.19  2004/03/29 19:19:35  florian
     + arm floating point register saving implemented
     * hopefully stabs generation for MacOSX fixed
     + some defines for arm added

compiler/arm/armreg.dat

@@ -4,95 +4,99 @@
 ; ARM registers
 ;
 ; layout
-; <name>,<type>,<value>,<stdname>,<stabidx>,<ot value>
+; <name>,<type>,<value>,<stdname>,<stab idx>,<dwarf idx>
 ;
-NO,$00,$00,INVALID,-1
+NO,$00,$00,INVALID,-1,-1
 ; Integer registers
-R0,$01,$00,r0,0
-R1,$01,$01,r1,1
-R2,$01,$02,r2,2
-R3,$01,$03,r3,3
-R4,$01,$04,r4,4
-R5,$01,$05,r5,5
-R6,$01,$06,r6,6
-R7,$01,$07,r7,7
-R8,$01,$08,r8,8
-R9,$01,$09,r9,9
-R10,$01,$0a,r10,10
-R11,$01,$0b,r11,11
-R12,$01,$0c,r12,12
-R13,$01,$0d,r13,13
-R14,$01,$0e,r14,14
-R15,$01,$0f,r15,15
+R0,$01,$00,r0,0,0
+R1,$01,$01,r1,1,1
+R2,$01,$02,r2,2,2
+R3,$01,$03,r3,3,3
+R4,$01,$04,r4,4,4
+R5,$01,$05,r5,5,5
+R6,$01,$06,r6,6,6
+R7,$01,$07,r7,7,7
+R8,$01,$08,r8,8,8
+R9,$01,$09,r9,9,9
+R10,$01,$0a,r10,10,10
+R11,$01,$0b,r11,11,11
+R12,$01,$0c,r12,12,12
+R13,$01,$0d,r13,13,13
+R14,$01,$0e,r14,14,14
+R15,$01,$0f,r15,15,15
 
 ; Float registers
-F0,$02,$00,f0,32
-F1,$02,$01,f1,32
-F2,$02,$02,f2,32
-F3,$02,$03,f3,32
-F4,$02,$04,f4,32
-F5,$02,$05,f5,32
-F6,$02,$06,f6,32
-F7,$02,$07,f7,32
+F0,$02,$00,f0,32,16
+F1,$02,$01,f1,32,17
+F2,$02,$02,f2,32,18
+F3,$02,$03,f3,32,19
+F4,$02,$04,f4,32,20
+F5,$02,$05,f5,32,21
+F6,$02,$06,f6,32,22
+F7,$02,$07,f7,32,23
 
 ; MM registers
-S0,$03,$00,s0,0
-S1,$03,$00,s1,0
-D0,$03,$00,d0,0
-S2,$03,$00,s2,0
-S3,$03,$00,s3,0
-D1,$03,$00,d1,0
-S4,$03,$00,s4,0
-S5,$03,$00,s5,0
-D2,$03,$00,d2,0
-S6,$03,$00,s6,0
-S7,$03,$00,s7,0
-D3,$03,$00,d3,0
-S8,$03,$00,s8,0
-S9,$03,$00,s9,0
-D4,$03,$00,d4,0
-S10,$03,$00,s10,0
-S11,$03,$00,s11,0
-D5,$03,$00,d5,0
-S12,$03,$00,s12,0
-S13,$03,$00,s13,0
-D6,$03,$00,d6,0
-S14,$03,$00,s14,0
-S15,$03,$00,s15,0
-D7,$03,$00,d7,0
-S16,$03,$00,s16,0
-S17,$03,$00,s17,0
-D8,$03,$00,d8,0
-S18,$03,$00,s18,0
-S19,$03,$00,s19,0
-D9,$03,$00,d9,0
-S20,$03,$00,s20,0
-S21,$03,$00,s21,0
-D10,$03,$00,d10,0
-S22,$03,$00,s22,0
-S23,$03,$00,s23,0
-D11,$03,$00,d11,0
-S24,$03,$00,s24,0
-S25,$03,$00,s25,0
-D12,$03,$00,d12,0
-S26,$03,$00,s26,0
-S27,$03,$00,s27,0
-D13,$03,$00,d13,0
-S28,$03,$00,s28,0
-S29,$03,$00,s29,0
-D14,$03,$00,d14,0
-S30,$03,$00,s20,0
-S31,$03,$00,s21,0
-D15,$03,$00,d15,0
-
+S0,$03,$00,s0,0,0
+S1,$03,$00,s1,0,0
+D0,$03,$00,d0,0,0
+S2,$03,$00,s2,0,0
+S3,$03,$00,s3,0,0
+D1,$03,$00,d1,0,0
+S4,$03,$00,s4,0,0
+S5,$03,$00,s5,0,0
+D2,$03,$00,d2,0,0
+S6,$03,$00,s6,0,0
+S7,$03,$00,s7,0,0
+D3,$03,$00,d3,0,0
+S8,$03,$00,s8,0,0
+S9,$03,$00,s9,0,0
+D4,$03,$00,d4,0,0
+S10,$03,$00,s10,0,0
+S11,$03,$00,s11,0,0
+D5,$03,$00,d5,0,0
+S12,$03,$00,s12,0,0
+S13,$03,$00,s13,0,0
+D6,$03,$00,d6,0,0
+S14,$03,$00,s14,0,0
+S15,$03,$00,s15,0,0
+D7,$03,$00,d7,0,0
+S16,$03,$00,s16,0,0
+S17,$03,$00,s17,0,0
+D8,$03,$00,d8,0,0
+S18,$03,$00,s18,0,0
+S19,$03,$00,s19,0,0
+D9,$03,$00,d9,0,0
+S20,$03,$00,s20,0,0
+S21,$03,$00,s21,0,0
+D10,$03,$00,d10,0,0
+S22,$03,$00,s22,0,0
+S23,$03,$00,s23,0,0
+D11,$03,$00,d11,0,0
+S24,$03,$00,s24,0,0
+S25,$03,$00,s25,0,0
+D12,$03,$00,d12,0,0
+S26,$03,$00,s26,0,0
+S27,$03,$00,s27,0,0
+D13,$03,$00,d13,0,0
+S28,$03,$00,s28,0,0
+S29,$03,$00,s29,0,0
+D14,$03,$00,d14,0,0
+S30,$03,$00,s20,0,0
+S31,$03,$00,s21,0,0
+D15,$03,$00,d15,0,0
 
 ;
 ; $Log$
-; Revision 1.2  2003-09-09 12:53:39  florian
+; Revision 1.3  2004-06-16 20:07:10  florian
+;   * dwarf branch merged
+;
+; Revision 1.2.2.1  2004/06/12 17:01:01  florian
+;   * fixed compilation of arm compiler
+;
+; Revision 1.2  2003/09/09 12:53:39  florian
 ;   * some assembling problems fixed
 ;   * improved loadaddr_ref_reg
 ;
 ; Revision 1.1  2003/09/04 00:15:29  florian
 ;   * first bunch of adaptions of arm compiler for new register type
 ;
-;

compiler/arm/cgcpu.pas

@@ -29,7 +29,7 @@ unit cgcpu;
   interface
 
     uses
-       symtype,
+       globtype,symtype,
        cgbase,cgobj,
        aasmbase,aasmcpu,aasmtai,
        cpubase,cpuinfo,node,cg64f32,rgcpu;
@@ -42,23 +42,23 @@ unit cgcpu;
         procedure init_register_allocators;override;
         procedure done_register_allocators;override;
 
-        procedure a_param_const(list : taasmoutput;size : tcgsize;a : aword;const locpara : tparalocation);override;
+        procedure a_param_const(list : taasmoutput;size : tcgsize;a : aint;const locpara : tparalocation);override;
         procedure a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const locpara : tparalocation);override;
         procedure a_paramaddr_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);override;
 
         procedure a_call_name(list : taasmoutput;const s : string);override;
         procedure a_call_reg(list : taasmoutput;reg: tregister); override;
 
-        procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; reg: TRegister); override;
+        procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; a: aint; reg: TRegister); override;
         procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister); override;
 
         procedure a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
-          size: tcgsize; a: aword; src, dst: tregister); override;
+          size: tcgsize; a: aint; src, dst: tregister); override;
         procedure a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
           size: tcgsize; src1, src2, dst: tregister); override;
 
         { move instructions }
-        procedure a_load_const_reg(list : taasmoutput; size: tcgsize; a : aword;reg : tregister);override;
+        procedure a_load_const_reg(list : taasmoutput; size: tcgsize; a : aint;reg : tregister);override;
         procedure a_load_reg_ref(list : taasmoutput; fromsize, tosize: tcgsize; reg : tregister;const ref : treference);override;
         procedure a_load_ref_reg(list : taasmoutput; fromsize, tosize : tcgsize;const Ref : treference;reg : tregister);override;
         procedure a_load_reg_reg(list : taasmoutput; fromsize, tosize : tcgsize;reg1,reg2 : tregister);override;
@@ -69,7 +69,7 @@ unit cgcpu;
         procedure a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference); override;
 
         {  comparison operations }
-        procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
+        procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aint;reg : tregister;
           l : tasmlabel);override;
         procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override;
 
@@ -79,14 +79,13 @@ unit cgcpu;
 
         procedure g_flags2reg(list: taasmoutput; size: TCgSize; const f: TResFlags; reg: TRegister); override;
 
-        procedure g_copyvaluepara_openarray(list : taasmoutput;const ref, lenref:treference;elesize:aword);override;
-        procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override;
-        procedure g_return_from_proc(list : taasmoutput;parasize : aword); override;
-        procedure g_restore_frame_pointer(list : taasmoutput);override;
+        procedure g_copyvaluepara_openarray(list : taasmoutput;const ref, lenref:treference;elesize:aint);override;
+        procedure g_proc_entry(list : taasmoutput;localsize : longint;nostackframe:boolean);override;
+        procedure g_proc_exit(list : taasmoutput;parasize : longint;nostackframe:boolean); override;
 
         procedure a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);override;
 
-        procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean);override;
+        procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aint; delsource,loadref : boolean);override;
 
         procedure g_overflowcheck(list: taasmoutput; const l: tlocation; def: tdef); override;
 
@@ -102,8 +101,8 @@ unit cgcpu;
 
       tcg64farm = class(tcg64f32)
         procedure a_op64_reg_reg(list : taasmoutput;op:TOpCG;regsrc,regdst : tregister64);override;
-        procedure a_op64_const_reg(list : taasmoutput;op:TOpCG;value : qword;reg : tregister64);override;
-        procedure a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : qword;regsrc,regdst : tregister64);override;
+        procedure a_op64_const_reg(list : taasmoutput;op:TOpCG;value : int64;reg : tregister64);override;
+        procedure a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : int64;regsrc,regdst : tregister64);override;
         procedure a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;regsrc1,regsrc2,regdst : tregister64);override;
       end;
 
@@ -119,7 +118,7 @@ unit cgcpu;
 
 
     uses
-       globtype,globals,verbose,systems,cutils,
+       globals,verbose,systems,cutils,
        symconst,symdef,symsym,
        tgobj,
        procinfo,cpupi,
@@ -170,7 +169,7 @@ unit cgcpu;
       end;
 
 
-    procedure tcgarm.a_param_const(list : taasmoutput;size : tcgsize;a : aword;const locpara : tparalocation);
+    procedure tcgarm.a_param_const(list : taasmoutput;size : tcgsize;a : aint;const locpara : tparalocation);
       var
         ref: treference;
       begin
@@ -268,7 +267,7 @@ unit cgcpu;
       end;
 
 
-     procedure tcgarm.a_op_const_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; reg: TRegister);
+     procedure tcgarm.a_op_const_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; a: aint; reg: TRegister);
        begin
           a_op_const_reg_reg(list,op,size,a,reg,reg);
        end;
@@ -294,7 +293,7 @@ unit cgcpu;
 
 
      procedure tcgarm.a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
-       size: tcgsize; a: aword; src, dst: tregister);
+       size: tcgsize; a: aint; src, dst: tregister);
        var
          shift : byte;
          tmpreg : tregister;
@@ -468,7 +467,7 @@ unit cgcpu;
        end;
 
 
-     procedure tcgarm.a_load_const_reg(list : taasmoutput; size: tcgsize; a : aword;reg : tregister);
+     procedure tcgarm.a_load_const_reg(list : taasmoutput; size: tcgsize; a : aint;reg : tregister);
        var
           imm_shift : byte;
           l : tasmlabel;
@@ -547,7 +546,7 @@ unit cgcpu;
             tmpref.symboldata:=current_procinfo.aktlocaldata.last;
 
             if assigned(ref.symbol) then
-              current_procinfo.aktlocaldata.concat(tai_const_symbol.Create_offset(ref.symbol,ref.offset))
+              current_procinfo.aktlocaldata.concat(tai_const.create_sym_offset(ref.symbol,ref.offset))
             else
               current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(ref.offset));
 
@@ -777,7 +776,7 @@ unit cgcpu;
 
 
     {  comparison operations }
-    procedure tcgarm.a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
+    procedure tcgarm.a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aint;reg : tregister;
       l : tasmlabel);
       var
         tmpreg : tregister;
@@ -838,12 +837,12 @@ unit cgcpu;
       end;
 
 
-    procedure tcgarm.g_copyvaluepara_openarray(list : taasmoutput;const ref, lenref:treference;elesize:aword);
+    procedure tcgarm.g_copyvaluepara_openarray(list : taasmoutput;const ref, lenref:treference;elesize:aint);
       begin
       end;
 
 
-    procedure tcgarm.g_stackframe_entry(list : taasmoutput;localsize : longint);
+    procedure tcgarm.g_proc_entry(list : taasmoutput;localsize : longint;nostackframe:boolean);
       var
          ref : treference;
          shift : byte;
@@ -900,7 +899,7 @@ unit cgcpu;
       end;
 
 
-    procedure tcgarm.g_return_from_proc(list : taasmoutput;parasize : aword);
+    procedure tcgarm.g_proc_exit(list : taasmoutput;parasize : longint;nostackframe:boolean);
       var
          ref : treference;
          firstfloatreg,lastfloatreg,
@@ -937,12 +936,6 @@ unit cgcpu;
       end;
 
 
-    procedure tcgarm.g_restore_frame_pointer(list : taasmoutput);
-      begin
-         { the frame pointer on the ARM is restored while the ret is executed }
-      end;
-
-
     procedure tcgarm.a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);
       var
         b : byte;
@@ -1022,7 +1015,7 @@ unit cgcpu;
         tmpref.symboldata:=current_procinfo.aktlocaldata.last;
 
         if assigned(ref.symbol) then
-          current_procinfo.aktlocaldata.concat(tai_const_symbol.Create_offset(ref.symbol,ref.offset))
+          current_procinfo.aktlocaldata.concat(tai_const.create_sym_offset(ref.symbol,ref.offset))
         else
           current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(ref.offset));
 
@@ -1055,7 +1048,7 @@ unit cgcpu;
       end;
 
 
-    procedure tcgarm.g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean);
+    procedure tcgarm.g_concatcopy(list : taasmoutput;const source,dest : treference;len : aint; delsource,loadref : boolean);
       var
         srcref,dstref:treference;
         srcreg,destreg,countreg,r:tregister;
@@ -1234,13 +1227,13 @@ unit cgcpu;
       end;
 
 
-    procedure tcg64farm.a_op64_const_reg(list : taasmoutput;op:TOpCG;value : qword;reg : tregister64);
+    procedure tcg64farm.a_op64_const_reg(list : taasmoutput;op:TOpCG;value : int64;reg : tregister64);
       begin
         a_op64_const_reg_reg(list,op,value,reg,reg);
       end;
 
 
-    procedure tcg64farm.a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : qword;regsrc,regdst : tregister64);
+    procedure tcg64farm.a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : int64;regsrc,regdst : tregister64);
       var
         tmpreg : tregister;
         b : byte;
@@ -1331,7 +1324,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.51  2004-03-31 19:13:04  florian
+  Revision 1.52  2004-06-16 20:07:10  florian
+    * dwarf branch merged
+
+  Revision 1.51.2.1  2004/06/12 17:01:01  florian
+    * fixed compilation of arm compiler
+
+  Revision 1.51  2004/03/31 19:13:04  florian
     * concatcopy with len=0 exits now immediatly
 
   Revision 1.50  2004/03/29 19:19:35  florian

compiler/arm/cpubase.pas

@@ -121,6 +121,9 @@ unit cpubase;
         {$i rarmsta.inc}
       );
 
+      regdwarf_table : array[tregisterindex] of shortint = (
+        {$i rarmdwa.inc}
+      );
       { registers which may be destroyed by calls }
       VOLATILE_INTREGISTERS = [RS_R0..RS_R3,RS_R12..RS_R15];
       VOLATILE_FPUREGISTERS = [RS_F0..RS_F3];
@@ -291,7 +294,7 @@ unit cpubase;
                 { lo(valueqword)/hi(valueqword) instead (JM)              }
                 { 2 : (valuelow, valuehigh:AWord);                        }
                 { overlay a complete 64 Bit value }
-                3 : (valueqword : qword);
+                3 : (value64 : qword);
               );
             LOC_CREFERENCE,
             LOC_REFERENCE : (reference : treference);
@@ -435,6 +438,8 @@ unit cpubase;
 
       NR_MM_RESULT_REG  = NR_NO;
 
+      NR_RETURN_ADDRESS_REG = NR_FUNCTION_RETURN_REG;
+
       { Offset where the parent framepointer is pushed }
       PARENT_FRAMEPOINTER_OFFSET = 0;
 
@@ -465,6 +470,8 @@ unit cpubase;
                                   Helpers
 *****************************************************************************}
 
+    { Returns the tcgsize corresponding with the size of reg.}
+    function reg_cgsize(const reg: tregister) : tcgsize;
     function cgsize2subreg(s:Tcgsize):Tsubregister;
     function is_calljmp(o:tasmop):boolean;
     procedure inverse_flags(var f: TResFlags);
@@ -502,6 +509,21 @@ unit cpubase;
       end;
 
 
+    function reg_cgsize(const reg: tregister): tcgsize;
+      const subreg2cgsize:array[Tsubregister] of Tcgsize =
+            (OS_NO,OS_8,OS_8,OS_16,OS_32,OS_64,OS_NO,OS_NO);
+      begin
+        case getregtype(reg) of
+          R_INTREGISTER :
+            reg_cgsize:=OS_32;
+          R_FPUREGISTER :
+            reg_cgsize:=OS_F80;
+          else
+            internalerror(200303181);
+          end;
+        end;
+
+
     function is_calljmp(o:tasmop):boolean;
       begin
         { This isn't 100% perfect because the arm allows jumps also by writing to PC=R15.
@@ -570,7 +592,19 @@ unit cpubase;
 end.
 {
   $Log$
-  Revision 1.29  2004-03-23 21:03:50  florian
+  Revision 1.30  2004-06-16 20:07:10  florian
+    * dwarf branch merged
+
+  Revision 1.29.2.3  2004/06/13 10:51:17  florian
+    * fixed several register allocator problems (sparc/arm)
+
+  Revision 1.29.2.2  2004/06/12 17:01:01  florian
+    * fixed compilation of arm compiler
+
+  Revision 1.29.2.1  2004/05/01 11:12:23  florian
+    * spilling of registers with size<>4 fixed
+
+  Revision 1.29  2004/03/23 21:03:50  florian
     * arm assembler instructions can have 4 operands
     * qword comparisations fixed
 

compiler/arm/cpuinfo.pas

@@ -21,21 +21,6 @@ Interface
     globtype;
 
 Type
-   { Architecture word - Native unsigned type }
-   AWord  = Longword;
-   AInt = longint;
-   PAWord = ^AWord;
-   PAInt = ^AInt;
-
-   { this must be an ordinal type with the same size as a pointer }
-   { to allow some dirty type casts for example when using        }
-   { tconstsym.value                                              }
-   { Note: must be unsigned!! Otherwise, ugly code like           }
-   { pointer(-1) will result in a pointer with the value          }
-   { $fffffffffffffff on a 32bit machine if the compiler uses     }
-   { int64 constants internally (JM)                              }
-   TConstPtrUInt = Longword;
-
    bestreal = double;
    ts32real = single;
    ts64real = double;
@@ -66,8 +51,6 @@ Type
 Const
    {# Size of native extended floating point type }
    extended_size = 8;
-   {# Size of a pointer                           }
-   pointer_size  = 4;
    {# Size of a multimedia register               }
    mmreg_size = 16;
    { target cpu string (used by compiler options) }
@@ -114,9 +97,16 @@ Implementation
 end.
 {
   $Log$
-  Revision 1.7  2004-04-28 15:19:03  florian
+  Revision 1.8  2004-06-16 20:07:10  florian
+    * dwarf branch merged
+
+  Revision 1.7  2004/04/28 15:19:03  florian
     + syscall directive support for MorphOS added
 
+  Revision 1.6.2.1  2004/05/01 16:02:10  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
   Revision 1.6  2004/03/06 20:35:19  florian
     * fixed arm compilation
     * cleaned up code generation for exported linux procedures
@@ -141,4 +131,4 @@ end.
 
   Revision 1.1  2003/07/21 16:35:30  florian
     * very basic stuff for the arm
-}
+}

compiler/arm/cpupara.pas

@@ -40,12 +40,12 @@ unit cpupara;
           function push_addr_param(varspez:tvarspez;def : tdef;calloption : tproccalloption) : boolean;override;
           function getintparaloc(calloption : tproccalloption; nr : longint) : tparalocation;override;
           procedure alloctempparaloc(list: taasmoutput;calloption : tproccalloption;paraitem : tparaitem;var locpara:tparalocation);override;
-          function  create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
+          function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
           function create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargspara):longint;override;
          private
-           procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
-           function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; firstpara: tparaitem;
-               var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword):longint;
+          procedure init_values(var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword);
+          function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; firstpara: tparaitem;
+            var curintreg, curfloatreg, curmmreg: tsuperregister; var cur_stack_offset: aword):longint;
        end;
 
   implementation
@@ -438,7 +438,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.17  2004-03-20 21:11:01  florian
+  Revision 1.18  2004-06-16 20:07:10  florian
+    * dwarf branch merged
+
+  Revision 1.17.2.1  2004/06/13 20:38:38  florian
+    * fixed floating point register spilling on sparc
+
+  Revision 1.17  2004/03/20 21:11:01  florian
     + float parameters can be on the stack now as well
 
   Revision 1.16  2004/03/20 20:55:36  florian

compiler/arm/cpupi.pas

@@ -29,13 +29,12 @@ unit cpupi;
   interface
 
     uses
-       cutils,
+       globtype,cutils,
        procinfo,cpuinfo,psub;
 
     type
        tarmprocinfo = class(tcgprocinfo)
           floatregstart : aword;
-          constructor create(aparent:tprocinfo);override;
           // procedure handle_body_start;override;
           // procedure after_pass1;override;
           procedure set_first_temp_offset;override;
@@ -47,7 +46,7 @@ unit cpupi;
   implementation
 
     uses
-       globtype,globals,systems,
+       globals,systems,
        cpubase,
        aasmtai,
        tgobj,
@@ -55,57 +54,6 @@ unit cpupi;
        cgbase,
        cgobj;
 
-    constructor tarmprocinfo.create(aparent:tprocinfo);
-
-      begin
-         inherited create(aparent);
-         maxpushedparasize:=0;
-      end;
-
-(*
-    procedure tarmprocinfo.handle_body_start;
-      var
-         ofs : aword;
-      begin
-        if not(po_assembler in procdef.procoptions) then
-          begin
-            {!!!!!!!!
-            case target_info.abi of
-              abi_powerpc_aix:
-                ofs:=align(maxpushedparasize+LinkageAreaSizeAIX,16);
-              abi_powerpc_sysv:
-                ofs:=align(maxpushedparasize+LinkageAreaSizeSYSV,16);
-            end;
-            }
-            inc(procdef.parast.address_fixup,ofs);
-            procdef.localst.address_fixup:=procdef.parast.address_fixup+procdef.parast.datasize;
-          end;
-        inherited handle_body_start;
-      end;
-
-    procedure tarmprocinfo.after_pass1;
-      begin
-         if not(po_assembler in procdef.procoptions) then
-           begin
-             if cs_asm_source in aktglobalswitches then
-               aktproccode.insert(Tai_comment.Create(strpnew('Parameter copies start at: r1+'+tostr(procdef.parast.address_fixup))));
-
-             if cs_asm_source in aktglobalswitches then
-               aktproccode.insert(Tai_comment.Create(strpnew('Locals start at: r1+'+tostr(procdef.localst.address_fixup))));
-
-             firsttemp_offset:=align(procdef.localst.address_fixup+procdef.localst.datasize,16);
-             if cs_asm_source in aktglobalswitches then
-               aktproccode.insert(Tai_comment.Create(strpnew('Temp. space start: r1+'+tostr(firsttemp_offset))));
-
-             //!!!! tg.setfirsttemp(firsttemp_offset);
-             tg.firsttemp:=firsttemp_offset;
-             tg.lasttemp:=firsttemp_offset;
-             inherited after_pass1;
-           end;
-      end;
-*)
-
-
     procedure tarmprocinfo.set_first_temp_offset;
       begin
         { We allocate enough space to save all registers because we can't determine
@@ -119,6 +67,7 @@ unit cpupi;
         tg.setfirsttemp(-12-28);
       end;
 
+
     procedure tarmprocinfo.allocate_push_parasize(size:longint);
       begin
         if size>maxpushedparasize then
@@ -157,7 +106,16 @@ begin
 end.
 {
   $Log$
-  Revision 1.7  2004-03-29 19:19:35  florian
+  Revision 1.8  2004-06-16 20:07:10  florian
+    * dwarf branch merged
+
+  Revision 1.7.2.2  2004/06/12 17:01:01  florian
+    * fixed compilation of arm compiler
+
+  Revision 1.7.2.1  2004/04/23 22:12:37  florian
+    * fixed some potential stack corruption reasons
+
+  Revision 1.7  2004/03/29 19:19:35  florian
     + arm floating point register saving implemented
     * hopefully stabs generation for MacOSX fixed
     + some defines for arm added

compiler/arm/rarmdwa.inc

@@ -0,0 +1,74 @@
+{ don't edit, this file is generated from armreg.dat }
+-1,
+0,
+1,
+2,
+3,
+4,
+5,
+6,
+7,
+8,
+9,
+10,
+11,
+12,
+13,
+14,
+15,
+16,
+17,
+18,
+19,
+20,
+21,
+22,
+23,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0,
+0

compiler/arm/rgcpu.pas

@@ -29,7 +29,7 @@ unit rgcpu;
   interface
 
      uses
-       aasmbase,aasmtai,
+       aasmbase,aasmtai,aasmcpu,
        cgbase,
        cpubase,
        rgobj;
@@ -37,11 +37,11 @@ unit rgcpu;
      type
        trgcpu = class(trgobj)
          procedure add_cpu_interferences(p : tai);override;
-         procedure do_spill_read(list : taasmoutput;instr : taicpu_abstract;pos: tai; regidx: word;
+         procedure do_spill_read(list : taasmoutput;instr : taicpu;pos: tai; regidx: word;
           const spilltemplist:Tspill_temp_list;const regs : tspillregsinfo);override;
-         procedure do_spill_written(list : taasmoutput;instr : taicpu_abstract;pos: tai; regidx: word;
+         procedure do_spill_written(list : taasmoutput;instr : taicpu;pos: tai; regidx: word;
           const spilltemplist:Tspill_temp_list;const regs : tspillregsinfo);override;
-         procedure do_spill_readwritten(list : taasmoutput;instr : taicpu_abstract;pos: tai; regidx: word;
+         procedure do_spill_readwritten(list : taasmoutput;instr : taicpu;pos: tai; regidx: word;
           const spilltemplist:Tspill_temp_list;const regs : tspillregsinfo);override;
        end;
 
@@ -50,8 +50,7 @@ unit rgcpu;
     uses
       verbose, cutils,
       cgutils,cgobj,
-      procinfo,
-      aasmcpu;
+      procinfo;
 
 
     procedure trgcpu.add_cpu_interferences(p : tai);
@@ -64,7 +63,7 @@ unit rgcpu;
       end;
 
 
-    procedure trgcpu.do_spill_read(list : taasmoutput;instr : taicpu_abstract;pos: tai; regidx: word;
+    procedure trgcpu.do_spill_read(list : taasmoutput;instr : taicpu;pos: tai; regidx: word;
      const spilltemplist:Tspill_temp_list;const regs : tspillregsinfo);
       var
         helpins: tai;
@@ -86,7 +85,10 @@ unit rgcpu;
             current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(ref.offset));
 
             { load consts entry }
-            getregisterinline(helplist,nil,defaultsub,tmpreg);
+            if getregtype(regs[regidx].tempreg)=R_INTREGISTER then
+              getregisterinline(helplist,pos,defaultsub,tmpreg)
+            else
+              tmpreg:=cg.getintregister(helplist,OS_ADDR);
             tmpref.symbol:=l;
             tmpref.base:=NR_R15;
             helplist.concat(taicpu.op_reg_ref(A_LDR,tmpreg,tmpref));
@@ -96,34 +98,28 @@ unit rgcpu;
             ref.index:=tmpreg;
             ref.offset:=0;
 
-            helpins:=taicpu.op_reg_ref(A_LDR,regs[regidx].tempreg,ref);
+            helpins:=spilling_create_load(ref,regs[regidx].tempreg);
             helplist.concat(helpins);
             if pos=nil then
               list.insertlistafter(list.first,helplist)
             else
               list.insertlistafter(pos.next,helplist);
 
-            ungetregisterinline(helplist,tai(helplist.last),regs[regidx].tempreg);
+            ungetregisterinline(list,helpins,regs[regidx].tempreg);
+
+            if getregtype(regs[regidx].tempreg)=R_INTREGISTER then
+              ungetregisterinline(list,helpins,tmpreg);
 
-            ungetregisterinline(list,instr,regs[regidx].tempreg);
             forward_allocation(tai(helpins.next),instr);
 
             helplist.free;
           end
         else
-          begin
-            helpins:=taicpu.op_reg_ref(A_LDR,regs[regidx].tempreg,ref);
-            if pos=nil then
-              list.insertafter(helpins,list.first)
-            else
-              list.insertafter(helpins,pos.next);
-            ungetregisterinline(list,instr,regs[regidx].tempreg);
-            forward_allocation(tai(helpins.next),instr);
-          end;
+          inherited do_spill_read(list,instr,pos,regidx,spilltemplist,regs);
       end;
 
 
-    procedure trgcpu.do_spill_written(list : taasmoutput;instr : taicpu_abstract;pos: tai; regidx: word;
+    procedure trgcpu.do_spill_written(list : taasmoutput;instr : taicpu;pos: tai; regidx: word;
       const spilltemplist:Tspill_temp_list;const regs : tspillregsinfo);
       var
         helpins: tai;
@@ -145,7 +141,10 @@ unit rgcpu;
             current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(ref.offset));
 
             { load consts entry }
-            getregisterinline(helplist,nil,defaultsub,tmpreg);
+            if getregtype(regs[regidx].tempreg)=R_INTREGISTER then
+              getregisterinline(helplist,pos,defaultsub,tmpreg)
+            else
+              tmpreg:=cg.getintregister(helplist,OS_ADDR);
             tmpref.symbol:=l;
             tmpref.base:=NR_R15;
             helplist.concat(taicpu.op_reg_ref(A_LDR,tmpreg,tmpref));
@@ -155,36 +154,33 @@ unit rgcpu;
             ref.index:=tmpreg;
             ref.offset:=0;
 
-            helplist.concat(taicpu.op_reg_ref(A_STR,regs[regidx].tempreg,ref));
+            helplist.concat(spilling_create_store(regs[regidx].tempreg,ref));
             ungetregisterinline(helplist,tai(helplist.last),regs[regidx].tempreg);
-            ungetregisterinline(helplist,tai(helplist.last),tmpreg);
+            if getregtype(regs[regidx].tempreg)=R_INTREGISTER then
+              ungetregisterinline(helplist,tai(helplist.last),tmpreg);
 
             list.insertlistafter(instr,helplist);
 
             helplist.free;
           end
         else
-          begin
-            helpins:=taicpu.op_reg_ref(A_STR,regs[regidx].tempreg,ref);
-            list.insertafter(helpins,instr);
-            ungetregisterinline(list,helpins,regs[regidx].tempreg);
-          end;
+          inherited do_spill_written(list,instr,pos,regidx,spilltemplist,regs);
       end;
 
 
-    procedure trgcpu.do_spill_readwritten(list : taasmoutput;instr : taicpu_abstract;pos: tai; regidx: word;
+    procedure trgcpu.do_spill_readwritten(list : taasmoutput;instr : taicpu;pos: tai; regidx: word;
       const spilltemplist:Tspill_temp_list;const regs : tspillregsinfo);
       var
         helpins1, helpins2: tai;
         tmpref,ref : treference;
+        helplist : taasmoutput;
+        l : tasmlabel;
         tmpreg : tregister;
-
       begin
         ref:=spilltemplist[regs[regidx].orgreg];
-        internalerror(200403141);
-        {
         if abs(ref.offset)>4095 then
           begin
+            helplist:=taasmoutput.create;
             reference_reset(tmpref);
             { create consts entry }
             objectlibrary.getlabel(l);
@@ -194,35 +190,59 @@ unit rgcpu;
             current_procinfo.aktlocaldata.concat(tai_const.Create_32bit(ref.offset));
 
             { load consts entry }
-            getregisterinline(list,pos,defaultsub,tmpreg);
+            if getregtype(regs[regidx].tempreg)=R_INTREGISTER then
+              getregisterinline(helplist,pos,defaultsub,tmpreg)
+            else
+              tmpreg:=cg.getintregister(helplist,OS_ADDR);
             tmpref.symbol:=l;
             tmpref.base:=NR_R15;
-            list.concat(taicpu.op_reg_ref(A_LDR,tmpreg,tmpref));
+            helplist.concat(taicpu.op_reg_ref(A_LDR,tmpreg,tmpref));
 
             if ref.index<>NR_NO then
               internalerror(200401263);
             ref.index:=tmpreg;
             ref.offset:=0;
-          end;
-        }
-        helpins1:=taicpu.op_reg_ref(A_LDR,regs[regidx].tempreg,ref);
-        if pos=nil then
-          list.insertafter(helpins1,list.first)
+
+            helpins1:=spilling_create_load(ref,regs[regidx].tempreg);
+            helplist.concat(helpins1);
+            if pos=nil then
+              list.insertlistafter(list.first,helplist)
+            else
+              list.insertlistafter(pos.next,helplist);
+
+            helpins2:=spilling_create_store(regs[regidx].tempreg,ref);
+            list.insertafter(helpins2,instr);
+            ungetregisterinline(list,helpins2,regs[regidx].tempreg);
+
+            if getregtype(regs[regidx].tempreg)=R_INTREGISTER then
+              ungetregisterinline(list,helpins2,tmpreg);
+
+            forward_allocation(tai(helpins1.next),instr);
+          end
         else
-          list.insertafter(helpins1,pos.next);
-        ref:=spilltemplist[regs[regidx].orgreg];
-        ref.symboldata:=nil;
-        helpins2:=taicpu.op_reg_ref(A_STR,regs[regidx].tempreg,ref);
-        list.insertafter(helpins2,instr);
-        ungetregisterinline(list,helpins2,regs[regidx].tempreg);
-        forward_allocation(tai(helpins1.next),instr);
+          inherited do_spill_readwritten(list,instr,pos,regidx,spilltemplist,regs);
       end;
 
 end.
 
 {
   $Log$
-  Revision 1.10  2004-03-14 16:15:40  florian
+  Revision 1.11  2004-06-16 20:07:10  florian
+    * dwarf branch merged
+
+  Revision 1.10.2.4  2004/06/13 20:38:38  florian
+    * fixed floating point register spilling on sparc
+
+  Revision 1.10.2.3  2004/06/13 16:02:39  florian
+    * fixed floating point register spilling problems with offsets > 4095
+
+  Revision 1.10.2.2  2004/06/13 10:51:17  florian
+    * fixed several register allocator problems (sparc/arm)
+
+  Revision 1.10.2.1  2004/06/12 17:01:01  florian
+    * fixed compilation of arm compiler
+
+  Revision 1.10  2004/03/14 16:15:40  florian
     * spilling problem fixed
     * handling of floating point memory references fixed
 

compiler/assemble.pas

@@ -1,6 +1,6 @@
 {
     $Id$
-    Copyright (c) 1998-2002 by Peter Vreman
+    Copyright (c) 1998-2004 by Peter Vreman
 
     This unit handles the assemblerfile write and assembler calls of FPC
 
@@ -134,8 +134,6 @@ interface
         destructor  destroy;override;
         procedure MakeObject;override;
       protected
-        { object alloc and output }
-        objectalloc  : TAsmObjectAlloc;
         objectdata   : TAsmObjectData;
         objectoutput : tobjectoutput;
       private
@@ -156,7 +154,7 @@ interface
         procedure emitlineinfostabs(nidx,line : longint);
         procedure emitstabs(s:string);
         procedure WriteFileLineInfo(var fileinfo : tfileposinfo);
-        procedure StartFileLineInfo(sec:tsection);
+        procedure StartFileLineInfo;
         procedure EndFileLineInfo;
 {$endif}
         function  MaybeNextList(var hp:Tai):boolean;
@@ -188,6 +186,7 @@ Implementation
   {$endif}
 {$endif}
       cutils,script,fmodule,verbose,
+      cpuinfo,
 {$ifdef memdebug}
       cclasses,
 {$endif memdebug}
@@ -617,7 +616,6 @@ Implementation
         inherited create(smart);
         objectoutput:=nil;
         objectdata:=nil;
-        objectalloc:=TAsmObjectAlloc.create;
         SmartAsm:=smart;
         currpass:=0;
       end;
@@ -634,7 +632,6 @@ Implementation
 {$endif}
         objectdata.free;
         objectoutput.free;
-        objectalloc.free;
 {$ifdef MEMDEBUG}
         d.free;
 {$endif}
@@ -649,14 +646,12 @@ Implementation
         code : integer;
         hp : pchar;
         reloc : boolean;
-        sec : TSection;
         ps : tasmsymbol;
         s : string;
       begin
         ofs:=0;
         reloc:=true;
         ps:=nil;
-        sec:=sec_none;
         if p[0]='"' then
          begin
            i:=1;
@@ -677,7 +672,7 @@ Implementation
       { When in pass 1 then only alloc and leave }
         if currpass=1 then
          begin
-           objectalloc.staballoc(hp);
+           objectdata.allocstabs(hp);
            if assigned(hp) then
             p[i]:='"';
            exit;
@@ -755,7 +750,6 @@ Implementation
                   internalerror(33006)
                 else
                   begin
-                    sec:=ps.section;
                     ofs:=ofs+ps.address;
                     reloc:=true;
                     objectlibrary.UsedAsmSymbolListInsert(ps);
@@ -777,7 +771,7 @@ Implementation
                       internalerror(33007)
                     else
                       begin
-                        if ps.section<>sec then
+                        if ps.section<>objectdata.currsec then
                           internalerror(33008);
                         ofs:=ofs-ps.address;
                         reloc:=false;
@@ -787,47 +781,35 @@ Implementation
               end;
           end;
         { external bss need speical handling (PM) }
-        if assigned(ps) and (ps.section=sec_none) then
+        if assigned(ps) and (ps.section=nil) then
           begin
             if currpass=2 then
               begin
                 objectdata.writesymbol(ps);
                 objectoutput.exportsymbol(ps);
               end;
-            objectdata.writeSymStabs(sec,ofs,hp,ps,nidx,nother,line,reloc)
+            objectdata.writeSymStabs(ofs,hp,ps,nidx,nother,line,reloc)
           end
         else
-          objectdata.writeStabs(sec,ofs,hp,nidx,nother,line,reloc);
+          objectdata.writeStabs(ofs,hp,nidx,nother,line,reloc);
         if assigned(hp) then
          p[ii]:='"';
       end;
 
 
     procedure TInternalAssembler.emitlineinfostabs(nidx,line : longint);
-      var
-         sec : TSection;
       begin
         if currpass=1 then
           begin
-            objectalloc.staballoc(nil);
+            objectdata.allocstabs(nil);
             exit;
           end;
 
         if (nidx=n_textline) and assigned(funcname) and
            (target_info.use_function_relative_addresses) then
-          objectdata.writeStabs(sec_code,objectdata.sectionsize(sec_code)-funcname.address,
-              nil,nidx,0,line,false)
+          objectdata.writeStabs(objectdata.currsec.datasize-funcname.address,nil,nidx,0,line,false)
         else
-          begin
-            if nidx=n_textline then
-              sec:=sec_code
-            else if nidx=n_dataline then
-              sec:=sec_data
-            else
-              sec:=sec_bss;
-            objectdata.writeStabs(sec,objectdata.sectionsize(sec),
-              nil,nidx,0,line,true);
-          end;
+          objectdata.writeStabs(objectdata.currsec.datasize,nil,nidx,0,line,true);
       end;
 
 
@@ -863,7 +845,7 @@ Implementation
               hp:=objectlibrary.newasmsymbol('Ltext'+ToStr(IncludeCount),AB_LOCAL,AT_FUNCTION);
               if currpass=1 then
                 begin
-                  hp.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,0);
+                  objectdata.allocsymbol(currpass,hp,0);
                   objectlibrary.UsedAsmSymbolListInsert(hp);
                 end
               else
@@ -887,18 +869,12 @@ Implementation
       end;
 
 
-    procedure TInternalAssembler.StartFileLineInfo(sec:tsection);
+    procedure TInternalAssembler.StartFileLineInfo;
       var
         fileinfo : tfileposinfo;
       begin
         FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0);
-        case sec of
-         sec_code : n_line:=n_textline;
-         sec_data : n_line:=n_dataline;
-          sec_bss : n_line:=n_bssline;
-        else
-         n_line:=n_bssline;
-        end;
+        n_line:=n_bssline;
         funcname:=nil;
         linecount:=1;
         includecount:=0;
@@ -911,23 +887,20 @@ Implementation
     procedure TInternalAssembler.EndFileLineInfo;
       var
         hp : tasmsymbol;
-        store_sec : TSection;
       begin
           if not ((cs_debuginfo in aktmoduleswitches) or
              (cs_gdb_lineinfo in aktglobalswitches)) then
            exit;
-        store_sec:=objectalloc.currsec;
-        objectalloc.seTSection(sec_code);
+        objectdata.createsection(sec_code,'',0,[]);
         hp:=objectlibrary.newasmsymbol('Letext',AB_LOCAL,AT_FUNCTION);
         if currpass=1 then
           begin
-            hp.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,0);
+            objectdata.allocsymbol(currpass,hp,0);
             objectlibrary.UsedAsmSymbolListInsert(hp);
           end
         else
           objectdata.writesymbol(hp);
         EmitStabs('"",'+tostr(n_sourcefile)+',0,0,Letext');
-        objectalloc.seTSection(store_sec);
       end;
 {$endif GDB}
 
@@ -965,68 +938,62 @@ Implementation
                  { always use the maximum fillsize in this pass to avoid possible
                    short jumps to become out of range }
                  Tai_align(hp).fillsize:=Tai_align(hp).aligntype;
-                 objectalloc.sectionalloc(Tai_align(hp).fillsize);
+                 objectdata.alloc(Tai_align(hp).fillsize);
                end;
              ait_datablock :
                begin
+                 l:=used_align(size_2_align(Tai_datablock(hp).size),0,objectdata.currsec.addralign);
                  if not SmartAsm then
                   begin
                     if not Tai_datablock(hp).is_global then
                      begin
-                        l:=Tai_datablock(hp).size;
-                        if l>2 then
-                          objectalloc.sectionalign(4)
-                        else if l>1 then
-                          objectalloc.sectionalign(2);
-                        objectalloc.sectionalloc(Tai_datablock(hp).size);
+                        objectdata.allocalign(l);
+                        objectdata.alloc(Tai_datablock(hp).size);
                      end;
                   end
                  else
                   begin
-                    l:=Tai_datablock(hp).size;
-                    if l>2 then
-                      objectalloc.sectionalign(4)
-                    else if l>1 then
-                      objectalloc.sectionalign(2);
-                    objectalloc.sectionalloc(Tai_datablock(hp).size);
+                    objectdata.allocalign(l);
+                    objectdata.alloc(Tai_datablock(hp).size);
                   end;
                end;
-             ait_const_32bit :
-               objectalloc.sectionalloc(4);
-             ait_const_16bit :
-               objectalloc.sectionalloc(2);
-             ait_const_8bit :
-               objectalloc.sectionalloc(1);
              ait_real_80bit :
-               objectalloc.sectionalloc(10);
+               objectdata.alloc(10);
              ait_real_64bit :
-               objectalloc.sectionalloc(8);
+               objectdata.alloc(8);
              ait_real_32bit :
-               objectalloc.sectionalloc(4);
+               objectdata.alloc(4);
              ait_comp_64bit :
-               objectalloc.sectionalloc(8);
-             ait_const_rva,
-             ait_const_symbol :
-               objectalloc.sectionalloc(4);
+               objectdata.alloc(8);
+             ait_const_64bit,
+             ait_const_32bit,
+             ait_const_16bit,
+             ait_const_8bit,
+             ait_const_rva_symbol,
+             ait_const_indirect_symbol :
+               objectdata.alloc(tai_const(hp).size);
              ait_section:
-               objectalloc.seTSection(Tai_section(hp).sec);
+               begin
+                 objectdata.CreateSection(Tai_section(hp).sectype,Tai_section(hp).name^,Tai_section(hp).secalign,[]);
+                 Tai_section(hp).sec:=objectdata.CurrSec;
+               end;
              ait_symbol :
-               Tai_symbol(hp).sym.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,0);
+               objectdata.allocsymbol(currpass,Tai_symbol(hp).sym,0);
              ait_label :
-               Tai_label(hp).l.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,0);
+               objectdata.allocsymbol(currpass,Tai_label(hp).l,0);
              ait_string :
-               objectalloc.sectionalloc(Tai_string(hp).len);
+               objectdata.alloc(Tai_string(hp).len);
              ait_instruction :
                begin
 {$ifdef i386}
 {$ifndef NOAG386BIN}
                  { reset instructions which could change in pass 2 }
                  Taicpu(hp).resetpass2;
-                 objectalloc.sectionalloc(Taicpu(hp).Pass1(objectalloc.sectionsize));
+                 objectdata.alloc(Taicpu(hp).Pass1(objectdata.currsec.datasize));
 {$endif NOAG386BIN}
 {$endif i386}
                end;
-             ait_cut :
+             ait_cutobject :
                if SmartAsm then
                 break;
            end;
@@ -1055,7 +1022,7 @@ Implementation
               ((cs_debuginfo in aktmoduleswitches) or
                (cs_gdb_lineinfo in aktglobalswitches)) then
             begin
-              if (objectalloc.currsec<>sec_none) and
+              if (objectdata.currsec<>nil) and
                  not(hp.typ in SkipLineInfo) then
                WriteFileLineInfo(tailineinfo(hp).fileinfo);
             end;
@@ -1064,77 +1031,74 @@ Implementation
              ait_align :
                begin
                  { here we must determine the fillsize which is used in pass2 }
-                 Tai_align(hp).fillsize:=align(objectalloc.sectionsize,Tai_align(hp).aligntype)-
-                   objectalloc.sectionsize;
-                 objectalloc.sectionalloc(Tai_align(hp).fillsize);
+                 Tai_align(hp).fillsize:=align(objectdata.currsec.datasize,Tai_align(hp).aligntype)-
+                   objectdata.currsec.datasize;
+                 objectdata.alloc(Tai_align(hp).fillsize);
                end;
              ait_datablock :
                begin
-                 if objectalloc.currsec<>sec_bss then
-                  Message(asmw_e_alloc_data_only_in_bss);
+                 if objectdata.currsec.sectype<>sec_bss then
+                   Message(asmw_e_alloc_data_only_in_bss);
+                 l:=used_align(size_2_align(Tai_datablock(hp).size),0,objectdata.currsec.addralign);
                  if not SmartAsm then
                   begin
                     if Tai_datablock(hp).is_global then
                      begin
-                       Tai_datablock(hp).sym.setaddress(currpass,sec_none,Tai_datablock(hp).size,Tai_datablock(hp).size);
+                       objectdata.allocsymbol(currpass,Tai_datablock(hp).sym,Tai_datablock(hp).size);
                        { force to be common/external, must be after setaddress as that would
-                         set it to AS_GLOBAL }
+                         set it to AB_GLOBAL }
                        Tai_datablock(hp).sym.currbind:=AB_COMMON;
                      end
                     else
                      begin
-                       l:=Tai_datablock(hp).size;
-                       if l>2 then
-                         objectalloc.sectionalign(4)
-                       else if l>1 then
-                         objectalloc.sectionalign(2);
-                       Tai_datablock(hp).sym.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,
-                         Tai_datablock(hp).size);
-                       objectalloc.sectionalloc(Tai_datablock(hp).size);
+                       objectdata.allocalign(l);
+                       objectdata.allocsymbol(currpass,Tai_datablock(hp).sym,Tai_datablock(hp).size);
+                       objectdata.alloc(Tai_datablock(hp).size);
                      end;
                    end
                   else
                    begin
-                     l:=Tai_datablock(hp).size;
-                     if l>2 then
-                       objectalloc.sectionalign(4)
-                     else if l>1 then
-                       objectalloc.sectionalign(2);
-                     Tai_datablock(hp).sym.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,Tai_datablock(hp).size);
-                     objectalloc.sectionalloc(Tai_datablock(hp).size);
+                     objectdata.allocalign(l);
+                     objectdata.allocsymbol(currpass,Tai_datablock(hp).sym,Tai_datablock(hp).size);
+                     objectdata.alloc(Tai_datablock(hp).size);
                    end;
                  objectlibrary.UsedAsmSymbolListInsert(Tai_datablock(hp).sym);
                end;
-             ait_const_32bit :
-               objectalloc.sectionalloc(4);
-             ait_const_16bit :
-               objectalloc.sectionalloc(2);
-             ait_const_8bit :
-               objectalloc.sectionalloc(1);
              ait_real_80bit :
-               objectalloc.sectionalloc(10);
+               objectdata.alloc(10);
              ait_real_64bit :
-               objectalloc.sectionalloc(8);
+               objectdata.alloc(8);
              ait_real_32bit :
-               objectalloc.sectionalloc(4);
+               objectdata.alloc(4);
              ait_comp_64bit :
-               objectalloc.sectionalloc(8);
-             ait_const_rva,
-             ait_const_symbol :
+               objectdata.alloc(8);
+             ait_const_64bit,
+             ait_const_32bit,
+             ait_const_16bit,
+             ait_const_8bit,
+             ait_const_rva_symbol,
+             ait_const_indirect_symbol :
                begin
-                 objectalloc.sectionalloc(4);
-                 objectlibrary.UsedAsmSymbolListInsert(Tai_const_symbol(hp).sym);
+                 objectdata.alloc(tai_const(hp).size);
+                 if assigned(Tai_const(hp).sym) then
+                   objectlibrary.UsedAsmSymbolListInsert(Tai_const(hp).sym);
+                 if assigned(Tai_const(hp).endsym) then
+                   objectlibrary.UsedAsmSymbolListInsert(Tai_const(hp).endsym);
                end;
              ait_section:
                begin
-                 objectalloc.seTSection(Tai_section(hp).sec);
+                 { use cached value }
+                 objectdata.setsection(Tai_section(hp).sec);
 {$ifdef GDB}
-                 case Tai_section(hp).sec of
-                  sec_code : n_line:=n_textline;
-                  sec_data : n_line:=n_dataline;
-                   sec_bss : n_line:=n_bssline;
-                 else
-                  n_line:=n_dataline;
+                 case Tai_section(hp).sectype of
+                   sec_code :
+                     n_line:=n_textline;
+                   sec_data :
+                     n_line:=n_dataline;
+                   sec_bss :
+                     n_line:=n_bssline;
+                   else
+                     n_line:=n_dataline;
                  end;
                  stabslastfileinfo.line:=-1;
 {$endif GDB}
@@ -1165,29 +1129,29 @@ Implementation
 {$endif}
              ait_symbol :
                begin
-                 Tai_symbol(hp).sym.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,0);
+                 objectdata.allocsymbol(currpass,Tai_symbol(hp).sym,0);
                  objectlibrary.UsedAsmSymbolListInsert(Tai_symbol(hp).sym);
                end;
              ait_symbol_end :
                begin
                  if target_info.system in [system_i386_linux,system_i386_beos] then
                   begin
-                    Tai_symbol_end(hp).sym.size:=objectalloc.sectionsize-Tai_symbol_end(hp).sym.address;
+                    Tai_symbol_end(hp).sym.size:=objectdata.currsec.datasize-Tai_symbol_end(hp).sym.address;
                     objectlibrary.UsedAsmSymbolListInsert(Tai_symbol_end(hp).sym);
                   end;
                 end;
              ait_label :
                begin
-                 Tai_label(hp).l.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,0);
+                 objectdata.allocsymbol(currpass,Tai_label(hp).l,0);
                  objectlibrary.UsedAsmSymbolListInsert(Tai_label(hp).l);
                end;
              ait_string :
-               objectalloc.sectionalloc(Tai_string(hp).len);
+               objectdata.alloc(Tai_string(hp).len);
              ait_instruction :
                begin
 {$ifdef i386}
 {$ifndef NOAG386BIN}
-                 objectalloc.sectionalloc(Taicpu(hp).Pass1(objectalloc.sectionsize));
+                 objectdata.alloc(Taicpu(hp).Pass1(objectdata.currsec.datasize));
                  { fixup the references }
                  for i:=1 to Taicpu(hp).ops do
                   begin
@@ -1209,7 +1173,7 @@ Implementation
                end;
              ait_direct :
                Message(asmw_f_direct_not_supported);
-             ait_cut :
+             ait_cutobject :
                if SmartAsm then
                 break;
              ait_marker :
@@ -1229,6 +1193,7 @@ Implementation
         fillbuffer : tfillbuffer;
         InlineLevel,
         l  : longint;
+        v  : int64;
 {$ifdef x86}
         co : comp;
 {$endif x86}
@@ -1243,7 +1208,7 @@ Implementation
               ((cs_debuginfo in aktmoduleswitches) or
                (cs_gdb_lineinfo in aktglobalswitches)) then
             begin
-              if (objectdata.currsec<>sec_none) and
+              if (objectdata.currsec<>nil) and
                  not(hp.typ in SkipLineInfo) then
                WriteFileLineInfo(tailineinfo(hp).fileinfo);
             end;
@@ -1251,16 +1216,17 @@ Implementation
            case hp.typ of
              ait_align :
                begin
-                 if objectdata.currsec=sec_bss then
+                 if objectdata.currsec.sectype=sec_bss then
                    objectdata.alloc(Tai_align(hp).fillsize)
                  else
                    objectdata.writebytes(Tai_align(hp).calculatefillbuf(fillbuffer)^,Tai_align(hp).fillsize);
                end;
              ait_section :
                begin
-                 objectdata.defaulTSection(Tai_section(hp).sec);
+                 { use cached value }
+                 objectdata.setsection(Tai_section(hp).sec);
 {$ifdef GDB}
-                 case Tai_section(hp).sec of
+                 case Tai_section(hp).sectype of
                   sec_code : n_line:=n_textline;
                   sec_data : n_line:=n_dataline;
                    sec_bss : n_line:=n_bssline;
@@ -1289,12 +1255,6 @@ Implementation
                      objectdata.alloc(Tai_datablock(hp).size);
                    end;
                end;
-             ait_const_32bit :
-               objectdata.writebytes(Tai_const(hp).value,4);
-             ait_const_16bit :
-               objectdata.writebytes(Tai_const(hp).value,2);
-             ait_const_8bit :
-               objectdata.writebytes(Tai_const(hp).value,1);
              ait_real_80bit :
                objectdata.writebytes(Tai_real_80bit(hp).value,10);
              ait_real_64bit :
@@ -1314,12 +1274,28 @@ Implementation
                end;
              ait_string :
                objectdata.writebytes(Tai_string(hp).str^,Tai_string(hp).len);
-             ait_const_rva :
-               objectdata.writereloc(Tai_const_symbol(hp).offset,4,
-                 Tai_const_symbol(hp).sym,RELOC_RVA);
-             ait_const_symbol :
-               objectdata.writereloc(Tai_const_symbol(hp).offset,4,
-                 Tai_const_symbol(hp).sym,RELOC_ABSOLUTE);
+             ait_const_64bit,
+             ait_const_32bit,
+             ait_const_16bit,
+             ait_const_8bit :
+               begin
+                 if assigned(tai_const(hp).sym) then
+                   begin
+                     if assigned(tai_const(hp).endsym) then
+                       begin
+                         if tai_const(hp).endsym.section<>tai_const(hp).sym.section then
+                           internalerror(200404124);
+                         v:=tai_const(hp).endsym.address-tai_const(hp).sym.address+Tai_const(hp).value;
+                         objectdata.writebytes(v,tai_const(hp).size);
+                       end
+                     else
+                       objectdata.writereloc(Tai_const(hp).value,Tai_const(hp).size,Tai_const(hp).sym,RELOC_ABSOLUTE);
+                   end
+                 else
+                   objectdata.writebytes(Tai_const(hp).value,tai_const(hp).size);
+               end;
+             ait_const_rva_symbol :
+               objectdata.writereloc(Tai_const(hp).value,sizeof(aint),Tai_const(hp).sym,RELOC_RVA);
              ait_label :
                begin
                  objectdata.writesymbol(Tai_label(hp).l);
@@ -1346,7 +1322,7 @@ Implementation
              ait_force_line :
                stabslastfileinfo.line:=0;
 {$endif}
-             ait_cut :
+             ait_cutobject :
                if SmartAsm then
                 break;
              ait_marker :
@@ -1367,17 +1343,14 @@ Implementation
       label
         doexit;
       begin
-        objectalloc.reseTSections;
-        objectalloc.seTSection(sec_code);
-
         objectdata:=objectoutput.newobjectdata(Objfile);
-        objectdata.defaulTSection(sec_code);
         { reset the asmsymbol list }
         objectlibrary.CreateUsedAsmsymbolList;
 
       { Pass 0 }
         currpass:=0;
-        objectalloc.seTSection(sec_code);
+        objectdata.createsection(sec_code,'',0,[]);
+        objectdata.beforealloc;
         { start with list 1 }
         currlistidx:=1;
         currlist:=list[currlistidx];
@@ -1387,16 +1360,18 @@ Implementation
            hp:=TreePass0(hp);
            MaybeNextList(hp);
          end;
+        objectdata.afteralloc;
         { leave if errors have occured }
         if errorcount>0 then
          goto doexit;
 
       { Pass 1 }
         currpass:=1;
-        objectalloc.reseTSections;
-        objectalloc.seTSection(sec_code);
+        objectdata.resetsections;
+        objectdata.beforealloc;
+        objectdata.createsection(sec_code,'',0,[]);
 {$ifdef GDB}
-        StartFileLineInfo(sec_code);
+        StartFileLineInfo;
 {$endif GDB}
         { start with list 1 }
         currlistidx:=1;
@@ -1410,19 +1385,21 @@ Implementation
 {$ifdef GDB}
         EndFileLineInfo;
 {$endif GDB}
+        objectdata.afteralloc;
         { check for undefined labels and reset }
         objectlibrary.UsedAsmSymbolListCheckUndefined;
 
-        { set section sizes }
-        objectdata.seTSectionsizes(objectalloc.secsize);
         { leave if errors have occured }
         if errorcount>0 then
          goto doexit;
 
       { Pass 2 }
         currpass:=2;
+        objectdata.resetsections;
+        objectdata.beforewrite;
+        objectdata.createsection(sec_code,'',0,[]);
 {$ifdef GDB}
-        StartFileLineInfo(sec_code);
+        StartFileLineInfo;
 {$endif GDB}
         { start with list 1 }
         currlistidx:=1;
@@ -1436,6 +1413,7 @@ Implementation
 {$ifdef GDB}
         EndFileLineInfo;
 {$endif GDB}
+        objectdata.afterwrite;
 
         { don't write the .o file if errors have occured }
         if errorcount=0 then
@@ -1458,16 +1436,12 @@ Implementation
     procedure TInternalAssembler.writetreesmart;
       var
         hp : Tai;
-        starTSec : TSection;
+        startsectype : TAsmSectionType;
         place: tcutplace;
       begin
-        objectalloc.reseTSections;
-        objectalloc.seTSection(sec_code);
-
         NextSmartName(cut_normal);
         objectdata:=objectoutput.newobjectdata(Objfile);
-        objectdata.defaulTSection(sec_code);
-        starTSec:=sec_code;
+        startsectype:=sec_code;
 
         { start with list 1 }
         currlistidx:=1;
@@ -1480,29 +1454,31 @@ Implementation
 
          { Pass 0 }
            currpass:=0;
-           objectalloc.reseTSections;
-           objectalloc.seTSection(starTSec);
+           objectdata.resetsections;
+           objectdata.beforealloc;
+           objectdata.createsection(startsectype,'',0,[]);
            TreePass0(hp);
+           objectdata.afteralloc;
            { leave if errors have occured }
            if errorcount>0 then
             exit;
 
          { Pass 1 }
            currpass:=1;
-           objectalloc.reseTSections;
-           objectalloc.seTSection(starTSec);
+           objectdata.resetsections;
+           objectdata.beforealloc;
+           objectdata.createsection(startsectype,'',0,[]);
 {$ifdef GDB}
-           StartFileLineInfo(startsec);
+           StartFileLineInfo;
 {$endif GDB}
            TreePass1(hp);
 {$ifdef GDB}
            EndFileLineInfo;
 {$endif GDB}
+           objectdata.afteralloc;
            { check for undefined labels }
            objectlibrary.UsedAsmSymbolListCheckUndefined;
 
-           { set section sizes }
-           objectdata.seTSectionsizes(objectalloc.secsize);
            { leave if errors have occured }
            if errorcount>0 then
             exit;
@@ -1510,14 +1486,20 @@ Implementation
          { Pass 2 }
            currpass:=2;
            objectoutput.startobjectfile(Objfile);
-           objectdata.defaulTSection(starTSec);
+           objectdata.resetsections;
+           objectdata.beforewrite;
+           objectdata.createsection(startsectype,'',0,[]);
 {$ifdef GDB}
-           StartFileLineInfo(startsec);
+           StartFileLineInfo;
 {$endif GDB}
            hp:=TreePass2(hp);
+           { save section type for next loop, must be done before EndFileLineInfo
+             because that changes the section to sec_code }
+           startsectype:=objectdata.currsec.sectype;
 {$ifdef GDB}
            EndFileLineInfo;
 {$endif GDB}
+           objectdata.afterwrite;
            { leave if errors have occured }
            if errorcount>0 then
             exit;
@@ -1536,28 +1518,27 @@ Implementation
            if not MaybeNextList(hp) then
             break;
 
-           { save section for next loop }
-           { this leads to a problem if starTSec is sec_none !! PM }
-           starTSec:=objectalloc.currsec;
-
            { we will start a new objectfile so reset everything }
            { The place can still change in the next while loop, so don't init }
            { the writer yet (JM)                                              }
-           if (hp.typ=ait_cut) then
-            place := Tai_cut(hp).place
+           if (hp.typ=ait_cutobject) then
+            place := Tai_cutobject(hp).place
            else
             place := cut_normal;
 
            { avoid empty files }
            while assigned(hp) and
-                 (Tai(hp).typ in [ait_marker,ait_comment,ait_section,ait_cut]) do
+                 (Tai(hp).typ in [ait_marker,ait_comment,ait_section,ait_cutobject]) do
             begin
               if Tai(hp).typ=ait_section then
-               starTSec:=Tai_section(hp).sec
-              else if (Tai(hp).typ=ait_cut) then
-               place := Tai_cut(hp).place;
+               startsectype:=Tai_section(hp).sectype
+              else if (Tai(hp).typ=ait_cutobject) then
+               place:=Tai_cutobject(hp).place;
               hp:=Tai(hp.next);
             end;
+           { there is a problem if startsectype is sec_none !! PM }
+           if startsectype=sec_none then
+             startsectype:=sec_code;
 
            if not MaybeNextList(hp) then
              break;
@@ -1565,11 +1546,6 @@ Implementation
            { start next objectfile }
            NextSmartName(place);
            objectdata:=objectoutput.newobjectdata(Objfile);
-
-           { there is a problem if starTSec is sec_none !! PM }
-           if starTSec=sec_none then
-             starTSec:=sec_code;
-
          end;
       end;
 
@@ -1595,10 +1571,13 @@ Implementation
         addlist(bsssegment);
         if assigned(importssection) then
           addlist(importssection);
-        if assigned(exportssection) and not UseDeffileForExport then
+        if assigned(exportssection) and not UseDeffileForExports then
           addlist(exportssection);
         if assigned(resourcesection) then
           addlist(resourcesection);
+{$warning TODO internal writer support for dwarf}
+        {if assigned(dwarflist) then
+          addlist(dwarflist);}
 
         if SmartAsm then
           writetreesmart
@@ -1666,10 +1645,35 @@ Implementation
 end.
 {
   $Log$
-  Revision 1.67  2004-05-21 22:43:36  peter
+  Revision 1.68  2004-06-16 20:07:06  florian
+    * dwarf branch merged
+
+  Revision 1.67  2004/05/21 22:43:36  peter
     * set correct n_line type when starting new .o file by passing
       the current section type
 
+  Revision 1.66.2.7  2004/05/03 14:59:57  peter
+    * no dlltool needed for win32 linking executables
+
+  Revision 1.66.2.6  2004/05/01 16:02:09  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
+  Revision 1.66.2.5  2004/04/29 23:30:28  peter
+    * fix i386 compiler
+
+  Revision 1.66.2.4  2004/04/12 19:34:45  peter
+    * basic framework for dwarf CFI
+
+  Revision 1.66.2.3  2004/04/12 14:45:10  peter
+    * tai_const_symbol and tai_const merged
+
+  Revision 1.66.2.2  2004/04/10 12:36:41  peter
+    * fixed alignment issues
+
+  Revision 1.66.2.1  2004/04/08 18:33:22  peter
+    * rewrite of TAsmSection
+
   Revision 1.66  2004/03/22 09:28:34  michael
   + Patch from peter for stack overflow
 

compiler/browcol.pas

@@ -92,8 +92,8 @@ type
       Items      : PSymbolCollection;
       DType      : PString;
       VType      : PString;
-      TypeID     : longint;
-      RelatedTypeID : longint;
+      TypeID     : Ptrint;
+      RelatedTypeID : Ptrint;
       DebuggerCount : longint;
       Ancestor   : PSymbol;
       Flags      : longint;
@@ -587,8 +587,8 @@ begin
   if S1<S2 then R:=-1 else
   if S1>S2 then R:=1 else
   { make sure that we distinguish between different objects with the same name }
-  if longint(K1^.Symbol)<longint(K2^.Symbol) then R:=-1 else
-  if longint(K1^.Symbol)>longint(K2^.Symbol) then R:= 1 else
+  if Ptrint(K1^.Symbol)<Ptrint(K2^.Symbol) then R:=-1 else
+  if Ptrint(K1^.Symbol)>Ptrint(K2^.Symbol) then R:= 1 else
   R:=0;
   Compare:=R;
 end;
@@ -1441,7 +1441,7 @@ end;
                     assigned(tpointerdef(vartype.def).pointertype.def) then
                  begin
                    Symbol^.Flags:=(Symbol^.Flags or sfPointer);
-                   Symbol^.RelatedTypeID:=longint(tpointerdef(vartype.def).pointertype.def);
+                   Symbol^.RelatedTypeID:=Ptrint(tpointerdef(vartype.def).pointertype.def);
                  end;
                if  Table.symtabletype in [recordsymtable,objectsymtable] then
                  MemInfo.Addr:=fieldoffset
@@ -1508,7 +1508,7 @@ end;
             with ttypesym(sym) do
               if assigned(restype.def) then
                begin
-                Symbol^.TypeID:=longint(restype.def);
+                Symbol^.TypeID:=Ptrint(restype.def);
                 case restype.def.deftype of
                   arraydef :
                     SetDType(Symbol,GetArrayDefStr(tarraydef(restype.def)));
@@ -1523,7 +1523,7 @@ end;
                     begin
                       ObjDef:=childof;
                       if ObjDef<>nil then
-                        Symbol^.RelatedTypeID:=longint(ObjDef);{TypeNames^.Add(S);}
+                        Symbol^.RelatedTypeID:=Ptrint(ObjDef);{TypeNames^.Add(S);}
                       Symbol^.Flags:=(Symbol^.Flags or sfObject);
                       if tobjectdef(restype.def).objecttype=odt_class then
                         Symbol^.Flags:=(Symbol^.Flags or sfClass);
@@ -1537,7 +1537,7 @@ end;
                   pointerdef :
                     begin
                       Symbol^.Flags:=(Symbol^.Flags or sfPointer);
-                      Symbol^.RelatedTypeID:=longint(tpointerdef(restype.def).pointertype.def);{TypeNames^.Add(S);}
+                      Symbol^.RelatedTypeID:=Ptrint(tpointerdef(restype.def).pointertype.def);{TypeNames^.Add(S);}
                       SetDType(Symbol,GetPointerDefStr(tpointerdef(restype.def)));
                     end;
 
@@ -1943,8 +1943,8 @@ var K1: PPointerXRef absolute Key1;
     K2: PPointerXRef absolute Key2;
     R: integer;
 begin
-  if longint(K1^.PtrValue)<longint(K2^.PtrValue) then R:=-1 else
-  if longint(K1^.PtrValue)>longint(K2^.PtrValue) then R:= 1 else
+  if Ptrint(K1^.PtrValue)<Ptrint(K2^.PtrValue) then R:=-1 else
+  if Ptrint(K1^.PtrValue)>Ptrint(K2^.PtrValue) then R:= 1 else
   R:=0;
   Compare:=R;
 end;
@@ -2118,7 +2118,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.37  2004-03-23 22:34:49  peter
+  Revision 1.38  2004-06-16 20:07:07  florian
+    * dwarf branch merged
+
+  Revision 1.37.2.1  2004/05/03 21:08:56  peter
+    * use ptrint
+
+  Revision 1.37  2004/03/23 22:34:49  peter
     * constants ordinals now always have a type assigned
     * integer constants have the smallest type, unsigned prefered over
       signed

compiler/cclasses.pas

@@ -269,6 +269,7 @@ type
          function  search(const s:string):TNamedIndexItem;
          function  speedsearch(const s:string;SpeedValue:cardinal):TNamedIndexItem;
          property  Items[const s:string]:TNamedIndexItem read Search;default;
+         property  Count:longint read FCount;
        end;
 
        tsingleList=class
@@ -1379,27 +1380,27 @@ end;
             if root<>nil then
               begin
                 dec(FCount);
-            if root.FLeft<>nil then
-             begin
-               { Now the Node pointing to root must point to the left
-                 subtree of root. The right subtree of root must be
-                 connected to the right bottom of the left subtree.}
-               if lr=left then
-                oldroot.FLeft:=root.FLeft
-               else
-                oldroot.FRight:=root.FLeft;
-               if root.FRight<>nil then
-                insert_right_bottom(root.FLeft,root.FRight);
-             end
-            else
-             begin
-               { There is no left subtree. So we can just replace the Node to
-                 delete with the right subtree.}
-               if lr=left then
-                oldroot.FLeft:=root.FRight
-               else
-                oldroot.FRight:=root.FRight;
-             end;
+                if root.FLeft<>nil then
+                 begin
+                   { Now the Node pointing to root must point to the left
+                     subtree of root. The right subtree of root must be
+                     connected to the right bottom of the left subtree.}
+                   if lr=left then
+                    oldroot.FLeft:=root.FLeft
+                   else
+                    oldroot.FRight:=root.FLeft;
+                   if root.FRight<>nil then
+                    insert_right_bottom(root.FLeft,root.FRight);
+                 end
+                else
+                 begin
+                   { There is no left subtree. So we can just replace the Node to
+                     delete with the right subtree.}
+                   if lr=left then
+                    oldroot.FLeft:=root.FRight
+                   else
+                    oldroot.FRight:=root.FRight;
+                 end;
               end;
             delete_from_tree:=root;
           end;
@@ -1602,9 +1603,9 @@ end;
       begin
         inc(FCount);
         if assigned(FHashArray) then
-         insert:=insertNode(obj,FHashArray^[obj.SpeedValue mod hasharraysize])
+          insert:=insertNode(obj,FHashArray^[obj.SpeedValue mod hasharraysize])
         else
-         insert:=insertNode(obj,FRoot);
+          insert:=insertNode(obj,FRoot);
       end;
 
 
@@ -2300,7 +2301,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.33  2004-05-24 17:30:09  peter
+  Revision 1.34  2004-06-16 20:07:07  florian
+    * dwarf branch merged
+
+  Revision 1.33  2004/05/24 17:30:09  peter
     * allow setting of name in dictionary always. Otherwise it is never
       possible to create an item with a name and rename before insert
       this is used in the symtable to hide the current symbol
@@ -2311,6 +2315,15 @@ end.
   Revision 1.31  2004/04/28 18:02:54  peter
     * add TList to cclasses, remove classes dependency from t_win32
 
+  Revision 1.30.2.3  2004/05/02 14:27:21  peter
+    * use sizeof(pointer) instead of 4
+
+  Revision 1.30.2.2  2004/04/09 14:34:53  peter
+    * fixed compilation for win32
+
+  Revision 1.30.2.1  2004/04/08 18:33:22  peter
+    * rewrite of TAsmSection
+
   Revision 1.30  2004/01/15 15:16:17  daniel
     * Some minor stuff
     * Managed to eliminate speed effects of string compression
@@ -2409,4 +2422,4 @@ end.
     * fixed pascal calling method with reversing also the high tree in
       the parast, detected by tcalcst3 test
 
-}
+}

compiler/cg64f32.pas

@@ -48,14 +48,14 @@ unit cg64f32;
       tcg64f32 = class(tcg64)
         procedure a_reg_alloc(list : taasmoutput;r : tregister64);override;
         procedure a_reg_dealloc(list : taasmoutput;r : tregister64);override;
-        procedure a_load64_const_ref(list : taasmoutput;value : qword;const ref : treference);override;
+        procedure a_load64_const_ref(list : taasmoutput;value : int64;const ref : treference);override;
         procedure a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);override;
         procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64);override;
         procedure a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64);override;
-        procedure a_load64_const_reg(list : taasmoutput;value: qword;reg : tregister64);override;
+        procedure a_load64_const_reg(list : taasmoutput;value: int64;reg : tregister64);override;
         procedure a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64);override;
         procedure a_load64_loc_ref(list : taasmoutput;const l : tlocation;const ref : treference);override;
-        procedure a_load64_const_loc(list : taasmoutput;value : qword;const l : tlocation);override;
+        procedure a_load64_const_loc(list : taasmoutput;value : int64;const l : tlocation);override;
         procedure a_load64_reg_loc(list : taasmoutput;reg : tregister64;const l : tlocation);override;
 
         procedure a_load64high_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);override;
@@ -67,13 +67,13 @@ unit cg64f32;
 
         procedure a_op64_ref_reg(list : taasmoutput;op:TOpCG;const ref : treference;reg : tregister64);override;
         procedure a_op64_reg_ref(list : taasmoutput;op:TOpCG;reg : tregister64; const ref: treference);override;
-        procedure a_op64_const_loc(list : taasmoutput;op:TOpCG;value : qword;const l: tlocation);override;
+        procedure a_op64_const_loc(list : taasmoutput;op:TOpCG;value : int64;const l: tlocation);override;
         procedure a_op64_reg_loc(list : taasmoutput;op:TOpCG;reg : tregister64;const l : tlocation);override;
         procedure a_op64_loc_reg(list : taasmoutput;op:TOpCG;const l : tlocation;reg : tregister64);override;
-        procedure a_op64_const_ref(list : taasmoutput;op:TOpCG;value : qword;const ref : treference);override;
+        procedure a_op64_const_ref(list : taasmoutput;op:TOpCG;value : int64;const ref : treference);override;
 
         procedure a_param64_reg(list : taasmoutput;reg : tregister64;const locpara : tparalocation);override;
-        procedure a_param64_const(list : taasmoutput;value : qword;const locpara : tparalocation);override;
+        procedure a_param64_const(list : taasmoutput;value : int64;const locpara : tparalocation);override;
         procedure a_param64_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);override;
         procedure a_param64_loc(list : taasmoutput;const l : tlocation;const locpara : tparalocation);override;
 
@@ -82,7 +82,7 @@ unit cg64f32;
            must continue in op64_const_reg, otherwise, everything is processed
            entirely in this routine, by emitting the appropriate 32-bit opcodes.
         }
-        function optimize64_op_const_reg(list: taasmoutput; var op: topcg; var a : qword; var reg: tregister64): boolean;override;
+        function optimize64_op_const_reg(list: taasmoutput; var op: topcg; var a : int64; var reg: tregister64): boolean;override;
 
         procedure g_rangecheck64(list: taasmoutput; const l:tlocation;fromdef,todef: tdef); override;
       end;
@@ -93,7 +93,7 @@ unit cg64f32;
   implementation
 
     uses
-       globals,systems,
+       globtype,globals,systems,
        verbose,
        symbase,symconst,symdef,defutil,tgobj,paramgr;
 
@@ -108,6 +108,12 @@ unit cg64f32;
       end;
 
 
+    procedure swap64(var q : int64);
+      begin
+         q:=(int64(lo(q)) shl 32) or hi(q);
+      end;
+
+
 {****************************************************************************
                                    TCG64F32
 ****************************************************************************}
@@ -144,16 +150,16 @@ unit cg64f32;
       end;
 
 
-    procedure tcg64f32.a_load64_const_ref(list : taasmoutput;value : qword;const ref : treference);
+    procedure tcg64f32.a_load64_const_ref(list : taasmoutput;value : int64;const ref : treference);
       var
         tmpref: treference;
       begin
         if target_info.endian = endian_big then
-          swap_qword(value);
-        cg.a_load_const_ref(list,OS_32,lo(value),ref);
+          swap64(value);
+        cg.a_load_const_ref(list,OS_32,aint(lo(value)),ref);
         tmpref := ref;
         inc(tmpref.offset,4);
-        cg.a_load_const_ref(list,OS_32,hi(value),tmpref);
+        cg.a_load_const_ref(list,OS_32,aint(hi(value)),tmpref);
       end;
 
 
@@ -205,11 +211,11 @@ unit cg64f32;
       end;
 
 
-    procedure tcg64f32.a_load64_const_reg(list : taasmoutput;value : qword;reg : tregister64);
+    procedure tcg64f32.a_load64_const_reg(list : taasmoutput;value : int64;reg : tregister64);
 
       begin
-        cg.a_load_const_reg(list,OS_32,lo(value),reg.reglo);
-        cg.a_load_const_reg(list,OS_32,hi(value),reg.reghi);
+        cg.a_load_const_reg(list,OS_32,aint(lo(value)),reg.reglo);
+        cg.a_load_const_reg(list,OS_32,aint(hi(value)),reg.reghi);
       end;
 
 
@@ -222,7 +228,7 @@ unit cg64f32;
           LOC_REGISTER,LOC_CREGISTER:
             a_load64_reg_reg(list,l.register64,reg);
           LOC_CONSTANT :
-            a_load64_const_reg(list,l.valueqword,reg);
+            a_load64_const_reg(list,l.value64,reg);
           else
             internalerror(200112292);
         end;
@@ -235,14 +241,14 @@ unit cg64f32;
           LOC_REGISTER,LOC_CREGISTER:
             a_load64_reg_ref(list,l.reg64,ref);
           LOC_CONSTANT :
-            a_load64_const_ref(list,l.valueqword,ref);
+            a_load64_const_ref(list,l.value64,ref);
           else
             internalerror(200203288);
         end;
       end;
 
 
-    procedure tcg64f32.a_load64_const_loc(list : taasmoutput;value : qword;const l : tlocation);
+    procedure tcg64f32.a_load64_const_loc(list : taasmoutput;value : int64;const l : tlocation);
 
       begin
         case l.loc of
@@ -338,12 +344,13 @@ unit cg64f32;
           LOC_REGISTER :
             cg.a_load_reg_reg(list,OS_32,OS_32,l.registerlow,reg);
           LOC_CONSTANT :
-            cg.a_load_const_reg(list,OS_32,lo(l.valueqword),reg);
+            cg.a_load_const_reg(list,OS_32,aint(lo(l.value64)),reg);
           else
             internalerror(200203244);
         end;
       end;
 
+
     procedure tcg64f32.a_load64high_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);
       begin
         case l.loc of
@@ -353,14 +360,14 @@ unit cg64f32;
           LOC_REGISTER :
             cg.a_load_reg_reg(list,OS_32,OS_32,l.registerhigh,reg);
           LOC_CONSTANT :
-            cg.a_load_const_reg(list,OS_32,hi(l.valueqword),reg);
+            cg.a_load_const_reg(list,OS_32,hi(l.value64),reg);
           else
             internalerror(200203244);
         end;
       end;
 
 
-    procedure tcg64f32.a_op64_const_loc(list : taasmoutput;op:TOpCG;value : qword;const l: tlocation);
+    procedure tcg64f32.a_op64_const_loc(list : taasmoutput;op:TOpCG;value : int64;const l: tlocation);
       begin
         case l.loc of
           LOC_REFERENCE, LOC_CREFERENCE:
@@ -395,7 +402,7 @@ unit cg64f32;
           LOC_REGISTER,LOC_CREGISTER:
             a_op64_reg_reg(list,op,l.register64,reg);
           LOC_CONSTANT :
-            a_op64_const_reg(list,op,l.valueqword,reg);
+            a_op64_const_reg(list,op,l.value64,reg);
           else
             internalerror(200203242);
         end;
@@ -406,8 +413,8 @@ unit cg64f32;
       var
         tempreg: tregister64;
       begin
-        tempreg.reghi:=cg.getintregister(list,OS_INT);
-        tempreg.reglo:=cg.getintregister(list,OS_INT);
+        tempreg.reghi:=cg.getintregister(list,OS_32);
+        tempreg.reglo:=cg.getintregister(list,OS_32);
         a_load64_ref_reg(list,ref,tempreg);
         a_op64_reg_reg(list,op,tempreg,reg);
         cg.ungetregister(list,tempreg.reglo);
@@ -419,8 +426,8 @@ unit cg64f32;
       var
         tempreg: tregister64;
       begin
-        tempreg.reghi:=cg.getintregister(list,OS_INT);
-        tempreg.reglo:=cg.getintregister(list,OS_INT);
+        tempreg.reghi:=cg.getintregister(list,OS_32);
+        tempreg.reglo:=cg.getintregister(list,OS_32);
         a_load64_ref_reg(list,ref,tempreg);
         a_op64_reg_reg(list,op,reg,tempreg);
         a_load64_reg_ref(list,tempreg,ref);
@@ -429,12 +436,12 @@ unit cg64f32;
       end;
 
 
-    procedure tcg64f32.a_op64_const_ref(list : taasmoutput;op:TOpCG;value : qword;const ref : treference);
+    procedure tcg64f32.a_op64_const_ref(list : taasmoutput;op:TOpCG;value : int64;const ref : treference);
       var
         tempreg: tregister64;
       begin
-        tempreg.reghi:=cg.getintregister(list,OS_INT);
-        tempreg.reglo:=cg.getintregister(list,OS_INT);
+        tempreg.reghi:=cg.getintregister(list,OS_32);
+        tempreg.reglo:=cg.getintregister(list,OS_32);
         a_load64_ref_reg(list,ref,tempreg);
         a_op64_const_reg(list,op,value,tempreg);
         a_load64_reg_ref(list,tempreg,ref);
@@ -453,13 +460,13 @@ unit cg64f32;
       end;
 
 
-    procedure tcg64f32.a_param64_const(list : taasmoutput;value : qword;const locpara : tparalocation);
+    procedure tcg64f32.a_param64_const(list : taasmoutput;value : int64;const locpara : tparalocation);
       var
         tmplochi,tmploclo: tparalocation;
       begin
         paramanager.splitparaloc64(locpara,tmploclo,tmplochi);
-        cg.a_param_const(list,OS_32,hi(value),tmplochi);
-        cg.a_param_const(list,OS_32,lo(value),tmploclo);
+        cg.a_param_const(list,OS_32,aint(hi(value)),tmplochi);
+        cg.a_param_const(list,OS_32,aint(lo(value)),tmploclo);
       end;
 
 
@@ -487,7 +494,7 @@ unit cg64f32;
           LOC_CREGISTER :
             a_param64_reg(list,l.register64,locpara);
           LOC_CONSTANT :
-            a_param64_const(list,l.valueqword,locpara);
+            a_param64_const(list,l.value64,locpara);
           LOC_CREFERENCE,
           LOC_REFERENCE :
             a_param64_ref(list,l.reference,locpara);
@@ -528,7 +535,7 @@ unit cg64f32;
                end
              else
                begin
-                 hreg:=cg.getintregister(list,OS_INT);
+                 hreg:=cg.getintregister(list,OS_32);
                  got_scratch := true;
                  a_load64high_ref_reg(list,l.reference,hreg);
                end;
@@ -541,7 +548,7 @@ unit cg64f32;
              if from_signed and to_signed then
                begin
                  objectlibrary.getlabel(neglabel);
-                 cg.a_cmp_const_reg_label(list,OS_32,OC_EQ,aword(-1),hreg,neglabel);
+                 cg.a_cmp_const_reg_label(list,OS_32,OC_EQ,-1,hreg,neglabel);
                end;
              { !!! freeing of register should happen directly after compare! (JM) }
              if got_scratch then
@@ -552,7 +559,7 @@ unit cg64f32;
              { if the high dword = 0, the low dword can be considered a }
              { simple cardinal                                          }
              cg.a_label(list,poslabel);
-             hdef:=torddef.create(u32bit,0,cardinal($ffffffff));
+             hdef:=torddef.create(u32bit,0,$ffffffff);
 
              location_copy(temploc,l);
              temploc.size:=OS_32;
@@ -578,7 +585,7 @@ unit cg64f32;
                    end
                  else
                    begin
-                     hreg:=cg.getintregister(list,OS_INT);
+                     hreg:=cg.getintregister(list,OS_32);
                      got_scratch := true;
                      a_load64low_ref_reg(list,l.reference,hreg);
                    end;
@@ -631,14 +638,14 @@ unit cg64f32;
                  end
                else
                  begin
-                   hreg:=cg.getintregister(list,OS_INT);
+                   hreg:=cg.getintregister(list,OS_32);
                    got_scratch := true;
 
                    opsize := def_cgsize(fromdef);
                    if opsize in [OS_64,OS_S64] then
                      a_load64high_ref_reg(list,l.reference,hreg)
                    else
-                     cg.a_load_ref_reg(list,opsize,OS_INT,l.reference,hreg);
+                     cg.a_load_ref_reg(list,opsize,OS_32,l.reference,hreg);
                  end;
                objectlibrary.getlabel(poslabel);
                cg.a_cmp_const_reg_label(list,opsize,OC_GTE,0,hreg,poslabel);
@@ -651,7 +658,7 @@ unit cg64f32;
              end;
       end;
 
-    function tcg64f32.optimize64_op_const_reg(list: taasmoutput; var op: topcg; var a : qword; var reg: tregister64): boolean;
+    function tcg64f32.optimize64_op_const_reg(list: taasmoutput; var op: topcg; var a : int64; var reg: tregister64): boolean;
       var
         lowvalue, highvalue : cardinal;
         hreg: tregister;
@@ -746,7 +753,26 @@ unit cg64f32;
 end.
 {
   $Log$
-  Revision 1.57  2004-01-22 02:22:47  florian
+  Revision 1.58  2004-06-16 20:07:07  florian
+    * dwarf branch merged
+
+  Revision 1.57.2.5  2004/06/13 10:51:16  florian
+    * fixed several register allocator problems (sparc/arm)
+
+  Revision 1.57.2.4  2004/06/12 17:01:01  florian
+    * fixed compilation of arm compiler
+
+  Revision 1.57.2.3  2004/05/01 16:02:09  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
+  Revision 1.57.2.2  2004/04/29 19:07:22  peter
+    * compile fixes
+
+  Revision 1.57.2.1  2004/04/27 18:18:25  peter
+    * aword -> aint
+
+  Revision 1.57  2004/01/22 02:22:47  florian
     * op_const_reg_reg with OP_SAR fixed
 
   Revision 1.56  2003/12/24 00:10:02  florian
@@ -882,8 +908,8 @@ end.
   Revision 1.25  2002/08/14 18:41:47  jonas
     - remove valuelow/valuehigh fields from tlocation, because they depend
       on the endianess of the host operating system -> difficult to get
-      right. Use lo/hi(location.valueqword) instead (remember to use
-      valueqword and not value!!)
+      right. Use lo/hi(location.valueint64) instead (remember to use
+      valueint64 and not value!!)
 
   Revision 1.24  2002/08/11 14:32:26  peter
     * renamed current_library to objectlibrary

compiler/cg64f64.pas

@@ -37,6 +37,7 @@ unit cg64f64;
        cgbase,cgobj,
        symtype;
 
+{$ifndef cpu64bit}
     type
       {# Defines all the methods required on 32-bit processors
          to handle 64-bit integers.
@@ -44,14 +45,14 @@ unit cg64f64;
       tcg64f64 = class(tcg64)
         procedure a_reg_alloc(list : taasmoutput;r : tregister64);override;
         procedure a_reg_dealloc(list : taasmoutput;r : tregister64);override;
-        procedure a_load64_const_ref(list : taasmoutput;value : AWord;const ref : treference);override;
+        procedure a_load64_const_ref(list : taasmoutput;value : int64;const ref : treference);override;
         procedure a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);override;
         procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64);override;
         procedure a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64);override;
-        procedure a_load64_const_reg(list : taasmoutput;value: qword;reg : tregister64);override;
+        procedure a_load64_const_reg(list : taasmoutput;value: int64;reg : tregister64);override;
         procedure a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64);override;
         procedure a_load64_loc_ref(list : taasmoutput;const l : tlocation;const ref : treference);override;
-        procedure a_load64_const_loc(list : taasmoutput;value : qword;const l : tlocation);override;
+        procedure a_load64_const_loc(list : taasmoutput;value : int64;const l : tlocation);override;
         procedure a_load64_reg_loc(list : taasmoutput;reg : tregister64;const l : tlocation);override;
 
         procedure a_load64high_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);override;
@@ -63,92 +64,116 @@ unit cg64f64;
 
         procedure a_op64_reg_ref(list : taasmoutput;op:TOpCG;regsrc : tregister64;const ref : treference);override;
         procedure a_op64_ref_reg(list : taasmoutput;op:TOpCG;const ref : treference;reg : tregister64);override;
-        procedure a_op64_const_loc(list : taasmoutput;op:TOpCG;value:qword;const l: tlocation);override;
+        procedure a_op64_const_loc(list : taasmoutput;op:TOpCG;value:int64;const l: tlocation);override;
         procedure a_op64_reg_loc(list : taasmoutput;op:TOpCG;reg : tregister64;const l : tlocation);override;
         procedure a_op64_loc_reg(list : taasmoutput;op:TOpCG;const l : tlocation;reg : tregister64);override;
-        procedure a_op64_const_reg(list : taasmoutput;op:TOpCG;value : qword;regdst : tregister64);override;
-        procedure a_op64_const_ref(list : taasmoutput;op:TOpCG;value : qword;const ref : treference);override;
+        procedure a_op64_const_reg(list : taasmoutput;op:TOpCG;value : int64;regdst : tregister64);override;
+        procedure a_op64_const_ref(list : taasmoutput;op:TOpCG;value : int64;const ref : treference);override;
 
         procedure a_param64_reg(list : taasmoutput;reg : tregister64;const locpara : tparalocation);override;
-        procedure a_param64_const(list : taasmoutput;value : qword;const locpara : tparalocation);override;
+        procedure a_param64_const(list : taasmoutput;value : int64;const locpara : tparalocation);override;
         procedure a_param64_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);override;
         procedure a_param64_loc(list : taasmoutput;const l : tlocation;const locpara : tparalocation);override;
 
-        function optimize64_op_const_reg(list: taasmoutput; var op: topcg; var a : qword; var reg: tregister64): boolean;override;
+        function optimize64_op_const_reg(list: taasmoutput; var op: topcg; var a : int64; var reg: tregister64): boolean;override;
 
         { override to catch 64bit rangechecks }
         procedure g_rangecheck64(list: taasmoutput; const l:tlocation;fromdef,todef: tdef); override;
       end;
+{$endif cpu64bit}
 
   implementation
 
-    procedure tcg64f64.a_load64_const_ref(list : taasmoutput;value : qword;const ref : treference);
+    uses
+      verbose;
+
+{$ifndef cpu64bit}
+    procedure tcg64f64.a_load64_const_ref(list : taasmoutput;value : int64;const ref : treference);
       begin
          cg.a_load_const_ref(list,OS_64,value,ref);
       end;
 
+
     procedure tcg64f64.a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);
       begin
          cg.a_load_reg_ref(list,OS_64,OS_64,reg,ref);
       end;
 
+
     procedure tcg64f64.a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64);
       begin
          cg.a_load_ref_reg(list,OS_64,OS_64,ref,reg);
       end;
 
+
     procedure tcg64f64.a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64);
       begin
          cg.a_load_reg_reg(list,OS_64,OS_64,regsrc,regdst);
       end;
 
-    procedure tcg64f64.a_load64_const_reg(list : taasmoutput;value : qword;reg : tregister64);
+
+    procedure tcg64f64.a_load64_const_reg(list : taasmoutput;value : int64;reg : tregister64);
       begin
          cg.a_load_const_reg(list,OS_64,value,reg);
       end;
 
+
     procedure tcg64f64.a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64);
       begin
          cg.a_load_loc_reg(list,l.size,l,reg);
       end;
 
+
     procedure tcg64f64.a_load64_loc_ref(list : taasmoutput;const l : tlocation;const ref : treference);
       begin
          cg.a_load_loc_ref(list,l.size,l,ref);
       end;
 
-    procedure tcg64f64.a_load64_const_loc(list : taasmoutput;value : qword;const l : tlocation);
+
+    procedure tcg64f64.a_load64_const_loc(list : taasmoutput;value : int64;const l : tlocation);
       begin
          cg.a_load_const_loc(list,value,l);
       end;
 
+
     procedure tcg64f64.a_load64_reg_loc(list : taasmoutput;reg : tregister64;const l : tlocation);
       begin
          cg.a_load_reg_loc(list,OS_64,reg,l);
       end;
 
+
     procedure tcg64f64.a_load64high_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);
       begin
+        internalerror(200404211);
       end;
 
+
     procedure tcg64f64.a_load64low_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);
       begin
+        internalerror(200404212);
       end;
 
+
     procedure tcg64f64.a_load64high_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);
       begin
+        internalerror(200404213);
       end;
 
+
     procedure tcg64f64.a_load64low_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);
       begin
+        internalerror(200404214);
       end;
 
+
     procedure tcg64f64.a_load64high_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);
       begin
+        internalerror(200404215);
       end;
 
     procedure tcg64f64.a_load64low_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);
       begin
+        internalerror(200404216);
       end;
 
 
@@ -157,73 +182,105 @@ unit cg64f64;
          cg.a_op_ref_reg(list,op,OS_64,ref,reg);
       end;
 
+
     procedure tcg64f64.a_op64_reg_ref(list : taasmoutput;op:TOpCG;regsrc : tregister64;const ref : treference);
       begin
+        cg.a_op_reg_ref(list,op,OS_64,regsrc,ref);
       end;
 
-    procedure tcg64f64.a_op64_const_reg(list : taasmoutput;op:TOpCG;value : qword;regdst : tregister64);
+
+    procedure tcg64f64.a_op64_const_reg(list : taasmoutput;op:TOpCG;value : int64;regdst : tregister64);
       begin
+        cg.a_op_const_reg(list,op,OS_64,value,regdst);
       end;
 
-    procedure tcg64f64.a_op64_const_ref(list : taasmoutput;op:TOpCG;value : qword;const ref : treference);
+
+    procedure tcg64f64.a_op64_const_ref(list : taasmoutput;op:TOpCG;value : int64;const ref : treference);
       begin
+        cg.a_op_const_ref(list,op,OS_64,value,ref);
       end;
 
-    procedure tcg64f64.a_op64_const_loc(list : taasmoutput;op:TOpCG;value : qword;const l: tlocation);
+
+    procedure tcg64f64.a_op64_const_loc(list : taasmoutput;op:TOpCG;value : int64;const l: tlocation);
       begin
+        cg.a_op_const_loc(list,op,value,l);
       end;
 
+
     procedure tcg64f64.a_op64_reg_loc(list : taasmoutput;op:TOpCG;reg : tregister64;const l : tlocation);
       begin
+        cg.a_op_reg_loc(list,op,reg,l);
       end;
 
+
     procedure tcg64f64.a_op64_loc_reg(list : taasmoutput;op:TOpCG;const l : tlocation;reg : tregister64);
       begin
+        internalerror(200404217);
       end;
 
+
     procedure tcg64f64.a_param64_reg(list : taasmoutput;reg : tregister64;const locpara : tparalocation);
       begin
+        cg.a_param_reg(list,OS_64,reg,locpara);
       end;
 
-    procedure tcg64f64.a_param64_const(list : taasmoutput;value : qword;const locpara : tparalocation);
+
+    procedure tcg64f64.a_param64_const(list : taasmoutput;value : int64;const locpara : tparalocation);
       begin
+        cg.a_param_const(list,OS_64,value,locpara);
       end;
 
+
     procedure tcg64f64.a_param64_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);
       begin
+        cg.a_param_ref(list,OS_64,r,locpara);
       end;
 
+
     procedure tcg64f64.a_param64_loc(list : taasmoutput;const l : tlocation;const locpara : tparalocation);
       begin
+        cg.a_param_loc(list,l,locpara);
       end;
 
+
     procedure tcg64f64.g_rangecheck64(list: taasmoutput; const l:tlocation;fromdef,todef: tdef);
       begin
+        cg.g_rangecheck(list,l,fromdef,todef);
       end;
 
-    function tcg64f64.optimize64_op_const_reg(list: taasmoutput; var op: topcg; var a : qword; var reg: tregister64): boolean;
-     begin
-       { this should be the same routine as optimize_const_reg!!!!!!!! }
-     end;
 
+    function tcg64f64.optimize64_op_const_reg(list: taasmoutput; var op: topcg; var a : int64; var reg: tregister64): boolean;
+      begin
+        result:=cg.optimize_op_const_reg(list,op,a,reg);
+      end;
 
-    procedure tcg64f64.a_reg_alloc(list : taasmoutput;r : tregister64);
 
+    procedure tcg64f64.a_reg_alloc(list : taasmoutput;r : tregister64);
       begin
-         list.concat(tai_regalloc.alloc(r));
+        list.concat(tai_regalloc.alloc(r));
       end;
 
-    procedure tcg64f64.a_reg_dealloc(list : taasmoutput;r : tregister64);
 
+    procedure tcg64f64.a_reg_dealloc(list : taasmoutput;r : tregister64);
       begin
-         list.concat(tai_regalloc.dealloc(r));
+        list.concat(tai_regalloc.dealloc(r));
       end;
+{$endif cpu64bit}
 
 
 end.
 {
   $Log$
-  Revision 1.11  2004-01-13 18:08:58  florian
+  Revision 1.12  2004-06-16 20:07:07  florian
+    * dwarf branch merged
+
+  Revision 1.11.2.2  2004/04/27 18:18:25  peter
+    * aword -> aint
+
+  Revision 1.11.2.1  2004/04/21 18:54:29  florian
+    + implemented most methods as redirections to cg
+
+  Revision 1.11  2004/01/13 18:08:58  florian
     * x86-64 compilation fixed
 
   Revision 1.10  2003/12/24 00:10:02  florian

compiler/cgbase.pas

@@ -28,6 +28,7 @@ unit cgbase;
 interface
 
     uses
+      globtype,
       cpuinfo,
       symconst;
 
@@ -283,7 +284,7 @@ interface
     {# From a constant numeric value, return the abstract code generator
        size.
     }
-    function int_cgsize(const a: aword): tcgsize;{$ifdef USEINLINE}inline;{$endif}
+    function int_cgsize(const a: aint): tcgsize;{$ifdef USEINLINE}inline;{$endif}
 
     { return the inverse condition of opcmp }
     function inverse_opcmp(opcmp: topcmp): topcmp;{$ifdef USEINLINE}inline;{$endif}
@@ -510,7 +511,7 @@ implementation
       end;
 
 
-    function int_cgsize(const a: aword): tcgsize;{$ifdef USEINLINE}inline;{$endif}
+    function int_cgsize(const a: aint): tcgsize;{$ifdef USEINLINE}inline;{$endif}
       const
         size2cgsize : array[0..8] of tcgsize = (
           OS_NO,OS_8,OS_16,OS_32,OS_32,OS_64,OS_64,OS_64,OS_64
@@ -587,7 +588,17 @@ finalization
 end.
 {
   $Log$
-  Revision 1.88  2004-02-27 10:21:05  florian
+  Revision 1.89  2004-06-16 20:07:07  florian
+    * dwarf branch merged
+
+  Revision 1.88.2.2  2004/05/01 16:02:09  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
+  Revision 1.88.2.1  2004/04/27 18:18:25  peter
+    * aword -> aint
+
+  Revision 1.88  2004/02/27 10:21:05  florian
     * top_symbol killed
     + refaddr to treference added
     + refsymbol to treference added

compiler/cgobj.pas

@@ -1,6 +1,5 @@
 {
     $Id$
-
     Copyright (c) 1998-2002 by Florian Klaempfl
     Member of the Free Pascal development team
 
@@ -41,7 +40,7 @@ unit cgobj;
 {$ifdef delphi}
        dmisc,
 {$endif}
-       cclasses,
+       cclasses,globtype,
        cpubase,cpuinfo,cgbase,
        aasmbase,aasmtai,aasmcpu,
        symconst,symbase,symtype,symdef,symtable,rgobj
@@ -106,9 +105,6 @@ unit cgobj;
 
           function makeregsize(list:Taasmoutput;reg:Tregister;size:Tcgsize):Tregister;
 
-          {# Returns the tcgsize corresponding with the size of reg.}
-          class function reg_cgsize(const reg: tregister) : tcgsize; virtual;
-
           {# Emit a label to the instruction stream. }
           procedure a_label(list : taasmoutput;l : tasmlabel);virtual;
 
@@ -138,7 +134,7 @@ unit cgobj;
              @param(a value of constant to send)
              @param(locpara where the parameter will be stored)
           }
-          procedure a_param_const(list : taasmoutput;size : tcgsize;a : aword;const locpara : tparalocation);virtual;
+          procedure a_param_const(list : taasmoutput;size : tcgsize;a : aint;const locpara : tparalocation);virtual;
           {# Pass the value of a parameter, which is located in memory, to a routine.
 
              A generic version is provided. This routine should
@@ -174,7 +170,7 @@ unit cgobj;
           procedure a_paramaddr_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);virtual;
 
           { Copies a whole memory block to the stack, the locpara must be a memory location }
-          procedure a_param_copy_ref(list : taasmoutput;size : qword;const r : treference;const locpara : tparalocation);
+          procedure a_param_copy_ref(list : taasmoutput;size : aint;const r : treference;const locpara : tparalocation);
           { Remarks:
             * If a method specifies a size you have only to take care
               of that number of bits, i.e. load_const_reg with OP_8 must
@@ -208,9 +204,9 @@ unit cgobj;
           procedure a_call_reg(list : taasmoutput;reg : tregister);virtual;abstract;
 
           { move instructions }
-          procedure a_load_const_reg(list : taasmoutput;size : tcgsize;a : aword;register : tregister);virtual; abstract;
-          procedure a_load_const_ref(list : taasmoutput;size : tcgsize;a : aword;const ref : treference);virtual;
-          procedure a_load_const_loc(list : taasmoutput;a : aword;const loc : tlocation);
+          procedure a_load_const_reg(list : taasmoutput;size : tcgsize;a : aint;register : tregister);virtual; abstract;
+          procedure a_load_const_ref(list : taasmoutput;size : tcgsize;a : aint;const ref : treference);virtual;
+          procedure a_load_const_loc(list : taasmoutput;a : aint;const loc : tlocation);
           procedure a_load_reg_ref(list : taasmoutput;fromsize,tosize : tcgsize;register : tregister;const ref : treference);virtual; abstract;
           procedure a_load_reg_reg(list : taasmoutput;fromsize,tosize : tcgsize;reg1,reg2 : tregister);virtual; abstract;
           procedure a_load_reg_loc(list : taasmoutput;fromsize : tcgsize;reg : tregister;const loc: tlocation);
@@ -248,9 +244,9 @@ unit cgobj;
           { the op_reg_reg, op_reg_ref or op_reg_loc methods and keep in mind   }
           { that in this case the *second* operand is used as both source and   }
           { destination (JM)                                                    }
-          procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; reg: TRegister); virtual; abstract;
-          procedure a_op_const_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; const ref: TReference); virtual;
-          procedure a_op_const_loc(list : taasmoutput; Op: TOpCG; a: AWord; const loc: tlocation);
+          procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; a: Aint; reg: TRegister); virtual; abstract;
+          procedure a_op_const_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; a: Aint; const ref: TReference); virtual;
+          procedure a_op_const_loc(list : taasmoutput; Op: TOpCG; a: Aint; const loc: tlocation);
           procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister); virtual; abstract;
           procedure a_op_reg_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; reg: TRegister; const ref: TReference); virtual;
           procedure a_op_ref_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); virtual;
@@ -260,20 +256,19 @@ unit cgobj;
           { trinary operations for processors that support them, 'emulated' }
           { on others. None with "ref" arguments since I don't think there  }
           { are any processors that support it (JM)                         }
-          procedure a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
-            size: tcgsize; a: aword; src, dst: tregister); virtual;
-          procedure a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
-            size: tcgsize; src1, src2, dst: tregister); virtual;
+          procedure a_op_const_reg_reg(list: taasmoutput; op: TOpCg; size: tcgsize; a: aint; src, dst: tregister); virtual;
+          procedure a_op_reg_reg_reg(list: taasmoutput; op: TOpCg; size: tcgsize; src1, src2, dst: tregister); virtual;
 
           {  comparison operations }
-          procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
+          procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aint;reg : tregister;
             l : tasmlabel);virtual; abstract;
-          procedure a_cmp_const_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const ref : treference;
+          procedure a_cmp_const_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aint;const ref : treference;
             l : tasmlabel); virtual;
-          procedure a_cmp_const_loc_label(list: taasmoutput; size: tcgsize;cmp_op: topcmp; a: aword; const loc: tlocation;
+          procedure a_cmp_const_loc_label(list: taasmoutput; size: tcgsize;cmp_op: topcmp; a: aint; const loc: tlocation;
             l : tasmlabel);
           procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); virtual; abstract;
           procedure a_cmp_ref_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp; const ref: treference; reg : tregister; l : tasmlabel); virtual;
+          procedure a_cmp_reg_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg : tregister; const ref: treference; l : tasmlabel); virtual;
           procedure a_cmp_loc_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp; const loc: tlocation; reg : tregister; l : tasmlabel);
           procedure a_cmp_ref_loc_label(list: taasmoutput; size: tcgsize;cmp_op: topcmp; const ref: treference; const loc: tlocation;
             l : tasmlabel);
@@ -300,7 +295,7 @@ unit cgobj;
              @param(reg The register to emit the opcode with, returns the register with
                    which the opcode will be emitted)
           }
-          function optimize_op_const_reg(list: taasmoutput; var op: topcg; var a : aword; var reg: tregister): boolean;virtual;
+          function optimize_op_const_reg(list: taasmoutput; var op: topcg; var a : aint; var reg: tregister): boolean;virtual;
 
          {#
              This routine is used in exception management nodes. It should
@@ -321,7 +316,7 @@ unit cgobj;
              The size of the value to save is OS_S32. The default version
              saves the exception reason to a temp. memory area.
           }
-         procedure g_exception_reason_save_const(list : taasmoutput; const href : treference; a: aword);virtual;
+         procedure g_exception_reason_save_const(list : taasmoutput; const href : treference; a: aint);virtual;
          {#
              This routine is used in exception management nodes. It should
              load the exception reason to the FUNCTION_RETURN_REG. The saved value
@@ -348,7 +343,7 @@ unit cgobj;
              @param(loadref Is the source reference a pointer to the actual source (TRUE), is it the actual source address (FALSE))
 
           }
-          procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword;delsource,loadref : boolean);virtual; abstract;
+          procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aint;delsource,loadref : boolean);virtual; abstract;
           {# This should emit the opcode to a shortrstring from the source
              to destination, if loadref is true, it assumes that it first must load
              the source address from the memory location where
@@ -379,19 +374,8 @@ unit cgobj;
           {# Generates overflow checking code for a node }
           procedure g_overflowcheck(list: taasmoutput; const l:tlocation; def:tdef); virtual; abstract;
 
-          procedure g_copyvaluepara_openarray(list : taasmoutput;const ref, lenref:treference;elesize:aword);virtual;
+          procedure g_copyvaluepara_openarray(list : taasmoutput;const ref, lenref:treference;elesize:aint);virtual;
           procedure g_releasevaluepara_openarray(list : taasmoutput;const ref:treference);virtual;
-          {# Emits instructions which should be emitted when entering
-             a routine declared as @var(interrupt). The default
-             behavior does nothing, should be overriden as required.
-          }
-          procedure g_interrupt_stackframe_entry(list : taasmoutput);virtual;
-
-          {# Emits instructions which should be emitted when exiting
-             a routine declared as @var(interrupt). The default
-             behavior does nothing, should be overriden as required.
-          }
-          procedure g_interrupt_stackframe_exit(list : taasmoutput;accused,acchiused:boolean);virtual;
 
           {# Emits instructions when compilation is done in profile
              mode (this is set as a command line option). The default
@@ -409,18 +393,13 @@ unit cgobj;
 
              @param(localsize Number of bytes to allocate as locals)
           }
-          procedure g_stackframe_entry(list : taasmoutput;localsize : longint);virtual; abstract;
-          {# Emits instructiona for restoring the frame pointer
-             at routine exit. For some processors, this routine
-             may do nothing at all.
-          }
-          procedure g_restore_frame_pointer(list : taasmoutput);virtual; abstract;
+          procedure g_proc_entry(list : taasmoutput;localsize : longint;nostackframe:boolean);virtual; abstract;
           {# Emits instructions for returning from a subroutine.
-             Should also restore the stack.
+             Should also restore the framepointer and stack.
 
              @param(parasize  Number of bytes of parameters to deallocate from stack)
           }
-          procedure g_return_from_proc(list : taasmoutput;parasize : aword);virtual; abstract;
+          procedure g_proc_exit(list : taasmoutput;parasize:longint;nostackframe:boolean);virtual;abstract;
           {# This routine is called when generating the code for the entry point
              of a routine. It should save all registers which are not used in this
              routine, and which should be declared as saved in the std_saved_registers
@@ -444,6 +423,7 @@ unit cgobj;
           procedure g_restore_all_registers(list : taasmoutput;const funcretparaloc:tparalocation);virtual;abstract;
        end;
 
+{$ifndef cpu64bit}
     {# @abstract(Abstract code generator for 64 Bit operations)
        This class implements an abstract code generator class
        for 64 Bit operations.
@@ -453,14 +433,14 @@ unit cgobj;
         procedure a_reg_alloc(list : taasmoutput;r : tregister64);virtual;abstract;
         { Deallocates 64 Bit register r by inserting a pa_regdealloc record}
         procedure a_reg_dealloc(list : taasmoutput;r : tregister64);virtual;abstract;
-        procedure a_load64_const_ref(list : taasmoutput;value : qword;const ref : treference);virtual;abstract;
+        procedure a_load64_const_ref(list : taasmoutput;value : int64;const ref : treference);virtual;abstract;
         procedure a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);virtual;abstract;
         procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64);virtual;abstract;
         procedure a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64);virtual;abstract;
-        procedure a_load64_const_reg(list : taasmoutput;value : qword;reg : tregister64);virtual;abstract;
+        procedure a_load64_const_reg(list : taasmoutput;value : int64;reg : tregister64);virtual;abstract;
         procedure a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64);virtual;abstract;
         procedure a_load64_loc_ref(list : taasmoutput;const l : tlocation;const ref : treference);virtual;abstract;
-        procedure a_load64_const_loc(list : taasmoutput;value : qword;const l : tlocation);virtual;abstract;
+        procedure a_load64_const_loc(list : taasmoutput;value : int64;const l : tlocation);virtual;abstract;
         procedure a_load64_reg_loc(list : taasmoutput;reg : tregister64;const l : tlocation);virtual;abstract;
 
         procedure a_load64high_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);virtual;abstract;
@@ -473,16 +453,16 @@ unit cgobj;
         procedure a_op64_ref_reg(list : taasmoutput;op:TOpCG;const ref : treference;reg : tregister64);virtual;abstract;
         procedure a_op64_reg_reg(list : taasmoutput;op:TOpCG;regsrc,regdst : tregister64);virtual;abstract;
         procedure a_op64_reg_ref(list : taasmoutput;op:TOpCG;regsrc : tregister64;const ref : treference);virtual;abstract;
-        procedure a_op64_const_reg(list : taasmoutput;op:TOpCG;value : qword;regdst : tregister64);virtual;abstract;
-        procedure a_op64_const_ref(list : taasmoutput;op:TOpCG;value : qword;const ref : treference);virtual;abstract;
-        procedure a_op64_const_loc(list : taasmoutput;op:TOpCG;value : qword;const l: tlocation);virtual;abstract;
+        procedure a_op64_const_reg(list : taasmoutput;op:TOpCG;value : int64;regdst : tregister64);virtual;abstract;
+        procedure a_op64_const_ref(list : taasmoutput;op:TOpCG;value : int64;const ref : treference);virtual;abstract;
+        procedure a_op64_const_loc(list : taasmoutput;op:TOpCG;value : int64;const l: tlocation);virtual;abstract;
         procedure a_op64_reg_loc(list : taasmoutput;op:TOpCG;reg : tregister64;const l : tlocation);virtual;abstract;
         procedure a_op64_loc_reg(list : taasmoutput;op:TOpCG;const l : tlocation;reg64 : tregister64);virtual;abstract;
-        procedure a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : qword;regsrc,regdst : tregister64);virtual;
+        procedure a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : int64;regsrc,regdst : tregister64);virtual;
         procedure a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;regsrc1,regsrc2,regdst : tregister64);virtual;
 
         procedure a_param64_reg(list : taasmoutput;reg64 : tregister64;const loc : tparalocation);virtual;abstract;
-        procedure a_param64_const(list : taasmoutput;value : qword;const loc : tparalocation);virtual;abstract;
+        procedure a_param64_const(list : taasmoutput;value : int64;const loc : tparalocation);virtual;abstract;
         procedure a_param64_ref(list : taasmoutput;const r : treference;const loc : tparalocation);virtual;abstract;
         procedure a_param64_loc(list : taasmoutput;const l : tlocation;const loc : tparalocation);virtual;abstract;
 
@@ -498,12 +478,13 @@ unit cgobj;
              @param(reg The register to emit the opcode with, returns the register with
                    which the opcode will be emitted)
         }
-        function optimize64_op_const_reg(list: taasmoutput; var op: topcg; var a : qword; var reg: tregister64): boolean;virtual;abstract;
+        function optimize64_op_const_reg(list: taasmoutput; var op: topcg; var a : int64; var reg: tregister64): boolean;virtual;abstract;
 
 
         { override to catch 64bit rangechecks }
         procedure g_rangecheck64(list: taasmoutput; const l:tlocation; fromdef,todef: tdef);virtual;abstract;
     end;
+{$endif cpu64bit}
 
     procedure reference_release(list: taasmoutput; const ref : treference);
 
@@ -519,14 +500,16 @@ unit cgobj;
     var
        {# Main code generator class }
        cg : tcg;
+{$ifndef cpu64bit}
        {# Code generator class for all operations working with 64-Bit operands }
        cg64 : tcg64;
+{$endif cpu64bit}
 
 
 implementation
 
     uses
-       globals,globtype,options,systems,
+       globals,options,systems,
        verbose,defutil,paramgr,
        tgobj,cutils,
        cgutils;
@@ -672,7 +655,7 @@ implementation
       end;
 
 
-    function  tcg.uses_registers(rt:Tregistertype):boolean;
+    function tcg.uses_registers(rt:Tregistertype):boolean;
       begin
         if assigned(rg[rt]) then
           result:=rg[rt].uses_registers
@@ -710,11 +693,17 @@ implementation
       var
         rt : tregistertype;
       begin
-        for rt:=low(tregistertype) to high(tregistertype) do
+        for rt:=R_FPUREGISTER to R_SPECIALREGISTER do
           begin
             if assigned(rg[rt]) then
               rg[rt].do_register_allocation(list,headertai);
           end;
+         { running the other register allocator passes could require addition int/addr. registers
+           when spilling so run int/addr register allocation at the end }
+         if assigned(rg[R_INTREGISTER]) then
+           rg[R_INTREGISTER].do_register_allocation(list,headertai);
+         if assigned(rg[R_ADDRESSREGISTER]) then
+           rg[R_ADDRESSREGISTER].do_register_allocation(list,headertai);
       end;
 
 
@@ -760,7 +749,7 @@ implementation
       end;
 
 
-    procedure tcg.a_param_const(list : taasmoutput;size : tcgsize;a : aword;const locpara : tparalocation);
+    procedure tcg.a_param_const(list : taasmoutput;size : tcgsize;a : aint;const locpara : tparalocation);
       var
          ref : treference;
       begin
@@ -792,7 +781,9 @@ implementation
                  reference_reset(ref);
                  ref.base:=locpara.reference.index;
                  ref.offset:=locpara.reference.offset;
-                 a_load_ref_ref(list,size,locpara.size,r,ref);
+                 { use concatcopy, because it can also be a float which fails when
+                   load_ref_ref is used }
+                 g_concatcopy(list,r,ref,tcgsize2size[size],false,false);
               end
             else
               internalerror(2002071004);
@@ -828,7 +819,7 @@ implementation
       end;
 
 
-    procedure tcg.a_param_copy_ref(list : taasmoutput;size : qword;const r : treference;const locpara : tparalocation);
+    procedure tcg.a_param_copy_ref(list : taasmoutput;size : aint;const r : treference;const locpara : tparalocation);
       var
         ref : treference;
       begin
@@ -960,7 +951,7 @@ implementation
       end;
 
 
-    procedure tcg.a_load_const_ref(list : taasmoutput;size : tcgsize;a : aword;const ref : treference);
+    procedure tcg.a_load_const_ref(list : taasmoutput;size : tcgsize;a : aint;const ref : treference);
       var
         tmpreg: tregister;
       begin
@@ -971,7 +962,7 @@ implementation
       end;
 
 
-    procedure tcg.a_load_const_loc(list : taasmoutput;a : aword;const loc: tlocation);
+    procedure tcg.a_load_const_loc(list : taasmoutput;a : aint;const loc: tlocation);
       begin
         case loc.loc of
           LOC_REFERENCE,LOC_CREFERENCE:
@@ -1027,7 +1018,7 @@ implementation
       end;
 
 
-    function tcg.optimize_op_const_reg(list: taasmoutput; var op: topcg; var a : aword; var reg:tregister): boolean;
+    function tcg.optimize_op_const_reg(list: taasmoutput; var op: topcg; var a : aint; var reg:tregister): boolean;
       var
         powerval : longint;
       begin
@@ -1148,7 +1139,7 @@ implementation
       end;
 
 
-    procedure tcg.a_op_const_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; const ref: TReference);
+    procedure tcg.a_op_const_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; a: aint; const ref: TReference);
 
       var
         tmpreg: tregister;
@@ -1162,7 +1153,7 @@ implementation
       end;
 
 
-    procedure tcg.a_op_const_loc(list : taasmoutput; Op: TOpCG; a: AWord; const loc: tlocation);
+    procedure tcg.a_op_const_loc(list : taasmoutput; Op: TOpCG; a: aint; const loc: tlocation);
 
       begin
         case loc.loc of
@@ -1250,7 +1241,7 @@ implementation
       end;
 
     procedure Tcg.a_op_const_reg_reg(list:Taasmoutput;op:Topcg;size:Tcgsize;
-                                     a:aword;src,dst:Tregister);
+                                     a:aint;src,dst:Tregister);
 
     begin
       a_load_reg_reg(list,size,size,src,dst);
@@ -1279,7 +1270,7 @@ implementation
 
 
 
-    procedure tcg.a_cmp_const_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const ref : treference;
+    procedure tcg.a_cmp_const_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aint;const ref : treference;
      l : tasmlabel);
 
       var
@@ -1292,7 +1283,7 @@ implementation
         ungetregister(list,tmpreg);
       end;
 
-    procedure tcg.a_cmp_const_loc_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const loc : tlocation;
+    procedure tcg.a_cmp_const_loc_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aint;const loc : tlocation;
       l : tasmlabel);
 
       begin
@@ -1306,11 +1297,10 @@ implementation
         end;
       end;
 
-    procedure tcg.a_cmp_ref_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp; const ref: treference; reg : tregister; l : tasmlabel);
 
+    procedure tcg.a_cmp_ref_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp; const ref: treference; reg : tregister; l : tasmlabel);
       var
         tmpreg: tregister;
-
       begin
         tmpreg:=getintregister(list,size);
         a_load_ref_reg(list,size,size,ref,tmpreg);
@@ -1318,6 +1308,18 @@ implementation
         ungetregister(list,tmpreg);
       end;
 
+
+    procedure tcg.a_cmp_reg_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp; reg : tregister; const ref: treference; l : tasmlabel);
+      var
+        tmpreg: tregister;
+      begin
+        tmpreg:=getintregister(list,size);
+        a_load_ref_reg(list,size,size,ref,tmpreg);
+        a_cmp_reg_reg_label(list,size,cmp_op,reg,tmpreg,l);
+        ungetregister(list,tmpreg);
+      end;
+
+
     procedure tcg.a_cmp_loc_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp; const loc: tlocation; reg : tregister; l : tasmlabel);
       begin
         case loc.loc of
@@ -1489,12 +1491,6 @@ implementation
       end;
 
 
-    class function tcg.reg_cgsize(const reg: tregister) : tcgsize;
-      begin
-        reg_cgsize := OS_INT;
-      end;
-
-
     procedure tcg.g_copyshortstring(list : taasmoutput;const source,dest : treference;len:byte;delsource,loadref : boolean);
       var
         paraloc1,paraloc2,paraloc3 : tparalocation;
@@ -1762,11 +1758,9 @@ implementation
     { type used is checked against todefs ranges. fromdef (p.resulttype.def) }
     { is the original type used at that location. When both defs are equal   }
     { the check is also insert (needed for succ,pref,inc,dec)                }
+{$ifndef ver1_0}
       const
-{$ifdef ver1_0}
-        awordsignedmax=high(longint);
-{$else}
-        awordsignedmax=high(aword) div 2;
+        aintmax=high(aint);
 {$endif}
       var
         neglabel : tasmlabel;
@@ -1774,43 +1768,71 @@ implementation
         lto,hto,
         lfrom,hfrom : TConstExprInt;
         from_signed: boolean;
+{$ifdef ver1_0}
+        aintmax : aint;
+{$endif ver1_0}
       begin
+{$ifdef ver1_0}
+  {$ifdef cpu64bit}
+        { this is required to prevent incorrect code }
+        aintmax:=$7fffffff;
+        aintmax:=int64(aintmax shl 16) or int64($ffff);
+        aintmax:=int64(aintmax shl 16) or int64($ffff);
+  {$else cpu64bit}
+        aintmax:=high(aint);
+  {$endif cpu64bit}
+{$endif}
         { range checking on and range checkable value? }
         if not(cs_check_range in aktlocalswitches) or
            not(fromdef.deftype in [orddef,enumdef,arraydef]) then
           exit;
+{$ifndef cpu64bit}
+        { handle 64bit rangechecks separate for 32bit processors }
         if is_64bit(fromdef) or is_64bit(todef) then
           begin
              cg64.g_rangecheck64(list,l,fromdef,todef);
              exit;
           end;
+{$endif cpu64bit}
         { only check when assigning to scalar, subranges are different, }
         { when todef=fromdef then the check is always generated         }
         getrange(fromdef,lfrom,hfrom);
         getrange(todef,lto,hto);
+        from_signed := is_signed(fromdef);
         { no range check if from and to are equal and are both longint/dword }
         { (if we have a 32bit processor) or int64/qword, since such          }
         { operations can at most cause overflows (JM)                        }
         { Note that these checks are mostly processor independent, they only }
         { have to be changed once we introduce 64bit subrange types          }
-{$warning range check still s32bit}
+{$ifdef cpu64bit}
+        if (fromdef = todef) and
+           (fromdef.deftype=orddef) and
+           (((((torddef(fromdef).typ = s64bit) and
+               (lfrom = low(int64)) and
+               (hfrom = high(int64))) or
+              ((torddef(fromdef).typ = u64bit) and
+               (lfrom = low(qword)) and
+               (hfrom = high(qword)))))) then
+          exit;
+{$else cpu64bit}
         if (fromdef = todef) and
            (fromdef.deftype=orddef) and
-           (((sizeof(aword) = 4) and
-             (((torddef(fromdef).typ = s32bit) and
+           (((((torddef(fromdef).typ = s32bit) and
                (lfrom = low(longint)) and
                (hfrom = high(longint))) or
               ((torddef(fromdef).typ = u32bit) and
                (lfrom = low(cardinal)) and
                (hfrom = high(cardinal)))))) then
           exit;
-        if todef<>fromdef then
-         begin
-           { if the from-range falls completely in the to-range, no check }
-           { is necessary                                                 }
-           if (lto<=lfrom) and (hto>=hfrom) then
-            exit;
-         end;
+{$endif cpu64bit}
+
+        { if the from-range falls completely in the to-range, no check }
+        { is necessary. Don't do this conversion for the largest unsigned type }
+        if (todef<>fromdef) and
+           (from_signed or (hfrom>=0)) and
+           (lto<=lfrom) and (hto>=hfrom) then
+          exit;
+
         { generate the rangecheck code for the def where we are going to }
         { store the result                                               }
 
@@ -1822,45 +1844,46 @@ implementation
         { the parts < 0 and > maxlongint out                                 }
 
         { is_signed now also works for arrays (it checks the rangetype) (JM) }
-        from_signed := is_signed(fromdef);
         if from_signed xor is_signed(todef) then
-          if from_signed then
-            { from is signed, to is unsigned }
-            begin
-              { if high(from) < 0 -> always range error }
-              if (hfrom < 0) or
-                 { if low(to) > maxlongint also range error }
-                 (lto > awordsignedmax) then
-                begin
-                  a_call_name(list,'FPC_RANGEERROR');
-                  exit
-                end;
-              { from is signed and to is unsigned -> when looking at from }
-              { as an unsigned value, it must be < maxlongint (otherwise  }
-              { it's negative, which is invalid since "to" is unsigned)   }
-              if hto > awordsignedmax then
-                hto := awordsignedmax;
-            end
-          else
-            { from is unsigned, to is signed }
-            begin
-              if (lfrom > awordsignedmax) or
-                 (hto < 0) then
-                begin
-                  a_call_name(list,'FPC_RANGEERROR');
-                  exit
-                end;
-              { from is unsigned and to is signed -> when looking at to }
-              { as an unsigned value, it must be >= 0 (since negative   }
-              { values are the same as values > maxlongint)             }
-              if lto < 0 then
-                lto := 0;
-            end;
+          begin
+             if from_signed then
+               { from is signed, to is unsigned }
+               begin
+                 { if high(from) < 0 -> always range error }
+                 if (hfrom < 0) or
+                    { if low(to) > maxlongint also range error }
+                    (lto > aintmax) then
+                   begin
+                     a_call_name(list,'FPC_RANGEERROR');
+                     exit
+                   end;
+                 { from is signed and to is unsigned -> when looking at to }
+                 { as an signed value, it must be < maxaint (otherwise     }
+                 { it will become negative, which is invalid since "to" is unsigned) }
+                 if hto < 0 then
+                   hto := aintmax;
+               end
+             else
+               { from is unsigned, to is signed }
+               begin
+                 if (lfrom > aintmax) or
+                    (hto < 0) then
+                   begin
+                     a_call_name(list,'FPC_RANGEERROR');
+                     exit
+                   end;
+                 { from is unsigned and to is signed -> when looking at to }
+                 { as an unsigned value, it must be >= 0 (since negative   }
+                 { values are the same as values > maxlongint)             }
+                 if lto < 0 then
+                   lto := 0;
+               end;
+          end;
         hreg:=getintregister(list,OS_INT);
         a_load_loc_reg(list,OS_INT,l,hreg);
-        a_op_const_reg(list,OP_SUB,OS_INT,aword(lto),hreg);
+        a_op_const_reg(list,OP_SUB,OS_INT,aint(lto),hreg);
         objectlibrary.getlabel(neglabel);
-        a_cmp_const_reg_label(list,OS_INT,OC_BE,aword(hto-lto),hreg,neglabel);
+        a_cmp_const_reg_label(list,OS_INT,OC_BE,aint(hto-lto),hreg,neglabel);
         { !!! should happen right after the compare (JM) }
         ungetregister(list,hreg);
         a_call_name(list,'FPC_RANGEERROR');
@@ -1916,7 +1939,6 @@ implementation
            a_param_reg(list,OS_ADDR,reg,paraloc1);
            paramanager.freeparaloc(list,paraloc1);
            paramanager.freeparaloc(list,paraloc2);
-           { No register saving needed, saveregisters is used }
            allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
            a_call_name(list,'FPC_CHECK_OBJECT_EXT');
            deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
@@ -1927,7 +1949,6 @@ implementation
             paramanager.allocparaloc(list,paraloc1);
             a_param_reg(list,OS_ADDR,reg,paraloc1);
             paramanager.freeparaloc(list,paraloc1);
-            { No register saving needed, saveregisters is used }
             allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
             a_call_name(list,'FPC_CHECK_OBJECT');
             deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
@@ -1939,7 +1960,7 @@ implementation
                             Entry/Exit Code Functions
 *****************************************************************************}
 
-    procedure tcg.g_copyvaluepara_openarray(list : taasmoutput;const ref, lenref:treference;elesize:aword);
+    procedure tcg.g_copyvaluepara_openarray(list : taasmoutput;const ref, lenref:treference;elesize:aint);
       var
         sizereg,sourcereg,destreg : tregister;
         paraloc1,paraloc2,paraloc3 : tparalocation;
@@ -1955,7 +1976,7 @@ implementation
         { calculate necessary memory }
         a_load_ref_reg(list,OS_INT,OS_INT,lenref,sizereg);
         a_op_const_reg(list,OP_ADD,OS_INT,1,sizereg);
-        a_op_const_reg(list,OP_MUL,OS_INT,elesize,sizereg);
+        a_op_const_reg(list,OP_IMUL,OS_INT,elesize,sizereg);
         { load source }
         a_load_ref_reg(list,OS_ADDR,OS_ADDR,ref,sourcereg);
 
@@ -2013,16 +2034,6 @@ implementation
       end;
 
 
-    procedure tcg.g_interrupt_stackframe_entry(list : taasmoutput);
-      begin
-      end;
-
-
-    procedure tcg.g_interrupt_stackframe_exit(list : taasmoutput;accused,acchiused:boolean);
-      begin
-      end;
-
-
     procedure tcg.g_profilecode(list : taasmoutput);
       begin
       end;
@@ -2030,19 +2041,19 @@ implementation
 
     procedure tcg.g_exception_reason_save(list : taasmoutput; const href : treference);
       begin
-        a_load_reg_ref(list, OS_S32, OS_32, NR_FUNCTION_RETURN_REG, href);
+        a_load_reg_ref(list, OS_INT, OS_INT, NR_FUNCTION_RESULT_REG, href);
       end;
 
 
-    procedure tcg.g_exception_reason_save_const(list : taasmoutput; const href : treference; a: aword);
+    procedure tcg.g_exception_reason_save_const(list : taasmoutput; const href : treference; a: aint);
       begin
-        a_load_const_ref(list, OS_S32, a, href);
+        a_load_const_ref(list, OS_INT, a, href);
       end;
 
 
     procedure tcg.g_exception_reason_load(list : taasmoutput; const href : treference);
       begin
-        a_load_ref_reg(list, OS_S32, OS_S32, href, NR_FUNCTION_RETURN_REG);
+        a_load_ref_reg(list, OS_INT, OS_INT, href, NR_FUNCTION_RESULT_REG);
       end;
 
 
@@ -2050,7 +2061,8 @@ implementation
                                     TCG64
 *****************************************************************************}
 
-    procedure tcg64.a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : qword; regsrc,regdst : tregister64);
+{$ifndef cpu64bit}
+    procedure tcg64.a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : int64; regsrc,regdst : tregister64);
       begin
         a_load64_reg_reg(list,regsrc,regdst);
         a_op64_const_reg(list,op,value,regdst);
@@ -2058,10 +2070,30 @@ implementation
 
 
     procedure tcg64.a_op64_reg_reg_reg(list: taasmoutput;op:TOpCG;regsrc1,regsrc2,regdst : tregister64);
-      begin
-        a_load64_reg_reg(list,regsrc2,regdst);
-        a_op64_reg_reg(list,op,regsrc1,regdst);
+      var
+        tmpreg64 : tregister64;
+      begin
+        { when src1=dst then we need to first create a temp to prevent
+          overwriting src1 with src2 }
+        if (regsrc1.reghi=regdst.reghi) or
+           (regsrc1.reglo=regdst.reghi) or
+           (regsrc1.reghi=regdst.reglo) or
+           (regsrc1.reglo=regdst.reglo) then
+          begin
+            tmpreg64.reglo:=cg.getintregister(list,OS_32);
+            tmpreg64.reghi:=cg.getintregister(list,OS_32);
+            a_load64_reg_reg(list,regsrc2,tmpreg64);
+            a_op64_reg_reg(list,op,regsrc1,tmpreg64);
+            a_load64_reg_reg(list,tmpreg64,regdst);
+          end
+        else
+          begin
+            a_load64_reg_reg(list,regsrc2,regdst);
+            a_op64_reg_reg(list,op,regsrc1,regdst);
+          end;
       end;
+{$endif cpu64bit}
+
 
 {****************************************************************************
                                   TReference
@@ -2136,11 +2168,16 @@ initialization
     ;
 finalization
   cg.free;
+{$ifndef cpu64bit}
   cg64.free;
+{$endif cpu64bit}
 end.
 {
   $Log$
-  Revision 1.164  2004-05-22 23:34:27  peter
+  Revision 1.165  2004-06-16 20:07:07  florian
+    * dwarf branch merged
+
+  Revision 1.164  2004/05/22 23:34:27  peter
   tai_regalloc.allocation changed to ratype to notify rgobj of register size changes
 
   Revision 1.163  2004/04/29 19:56:36  daniel
@@ -2149,6 +2186,65 @@ end.
   Revision 1.162  2004/04/18 07:52:43  florian
     * fixed web bug 3048: comparision of dyn. arrays
 
+  Revision 1.161.2.17  2004/06/13 10:51:16  florian
+    * fixed several register allocator problems (sparc/arm)
+
+  Revision 1.161.2.16  2004/06/02 16:07:00  peter
+    * fixed op64_reg_reg_reg to not override src when src=dst
+
+  Revision 1.161.2.15  2004/05/30 17:54:13  florian
+    + implemented cmp64bit
+    * started to fix spilling
+    * fixed int64 sub partially
+
+  Revision 1.161.2.14  2004/05/30 12:07:54  florian
+    * fixed loading/saving of exception reason for CPUs where RETURN and RESULT registers of functions are differently named
+
+  Revision 1.161.2.13  2004/05/27 23:36:18  peter
+    * nostackframe procdirective added
+
+  Revision 1.161.2.12  2004/05/10 21:28:34  peter
+    * section_smartlink enabled for gas under linux
+
+  Revision 1.161.2.11  2004/05/03 19:06:34  peter
+    * fixed range checking
+
+  Revision 1.161.2.10  2004/05/02 20:20:59  florian
+    * started to fix callee side result value handling
+
+  Revision 1.161.2.9  2004/05/02 12:45:32  peter
+    * enabled cpuhasfixedstack for x86-64 again
+    * fixed size of temp allocation for parameters
+
+  Revision 1.161.2.8  2004/05/01 16:02:09  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
+  Revision 1.161.2.7  2004/05/01 11:12:23  florian
+    * spilling of registers with size<>4 fixed
+
+  Revision 1.161.2.6  2004/04/28 21:46:22  peter
+    * fix 1.0.x bootstrap of maxaint
+
+  Revision 1.161.2.5  2004/04/27 18:18:25  peter
+    * aword -> aint
+
+  Revision 1.161.2.4  2004/04/26 16:09:16  peter
+    * fixed infinite loop with 64bit rangecheck
+
+  Revision 1.161.2.3  2004/04/26 15:54:33  peter
+    * small x86-64 fixes
+
+  Revision 1.161.2.2  2004/04/24 20:13:24  florian
+    * fixed x86-64 exception handling
+
+  Revision 1.161.2.1  2004/04/18 16:55:37  peter
+    * procedure entry and exit code restructured, some x86 specific
+      things are removed from the generic ncgutil code and moved to
+      the target depend cg.g_proc_entry and cg.g_proc_exit that now
+      contain all the code during startup including stackframe allocation
+      only the saving of registers is excluded from this code
+
   Revision 1.161  2004/03/06 20:35:19  florian
     * fixed arm compilation
     * cleaned up code generation for exported linux procedures
@@ -2678,4 +2774,4 @@ end.
       unit so this would conflicts if D6 programms are compiled
     + Willamette/SSE2 instructions to assembler added
 
-}
+}

compiler/cmsgs.pas

@@ -113,8 +113,8 @@ begin
   for i:=1 to n do
    begin
      msgidxmax[i]:=idxmax[i-1];
-     getmem(msgidx[i],msgidxmax[i]*4);
-     fillchar(msgidx[i]^,msgidxmax[i]*4,0);
+     getmem(msgidx[i],msgidxmax[i]*sizeof(pointer));
+     fillchar(msgidx[i]^,msgidxmax[i]*sizeof(pointer),0);
    end;
 end;
 
@@ -124,7 +124,7 @@ var
   i : longint;
 begin
   for i:=1 to msgparts do
-   freemem(msgidx[i],msgidxmax[i]*4);
+   freemem(msgidx[i],msgidxmax[i]*sizeof(pointer));
   if msgallocsize>0 then
    begin
      freemem(msgtxt,msgsize);
@@ -333,7 +333,7 @@ var
 begin
   { clear }
   for i:=1 to msgparts do
-   fillchar(msgidx[i]^,msgidxmax[i]*4,0);
+   fillchar(msgidx[i]^,msgidxmax[i]*sizeof(pointer),0);
 end;
 
 
@@ -418,7 +418,13 @@ end;
 end.
 {
   $Log$
-  Revision 1.10  2004-02-20 19:49:21  daniel
+  Revision 1.11  2004-06-16 20:07:07  florian
+    * dwarf branch merged
+
+  Revision 1.10.2.1  2004/05/02 14:09:54  peter
+    * fix case 64bit issues
+
+  Revision 1.10  2004/02/20 19:49:21  daniel
     * Message system uses open arrays internally
     * Bugfix for string handling in array constructor node
     * Micro code reductions in pdecl.pas

compiler/cresstr.pas

@@ -60,11 +60,11 @@ var
 implementation
 
 uses
-   cutils,globals,
+   cutils,globtype,globals,
    symdef,
    verbose,fmodule,
    aasmbase,aasmtai,
-   aasmcpu,cpuinfo;
+   aasmcpu;
 
 
 { ---------------------------------------------------------------------
@@ -149,15 +149,15 @@ procedure TResourceStrings.CreateResourceStringList;
     With P Do
      begin
        if (Value=nil) or (len=0) then
-         resourcestringlist.concat(tai_const.create_ptr(0))
+         resourcestringlist.concat(tai_const.create_sym(nil))
        else
          begin
             objectlibrary.getdatalabel(l1);
-            resourcestringlist.concat(tai_const_symbol.create(l1));
-            consts.concat(tai_align.Create(const_align(pointer_size)));
+            resourcestringlist.concat(tai_const.create_sym(l1));
+            consts.concat(tai_align.Create(const_align(sizeof(aint))));
             consts.concat(tai_const.create_32bit(len));
             consts.concat(tai_const.create_32bit(len));
-            consts.concat(tai_const.create_32bit(cardinal(-1)));
+            consts.concat(tai_const.create_32bit(-1));
             consts.concat(tai_label.create(l1));
             getmem(s,len+1);
             move(Value^,s^,len);
@@ -166,16 +166,16 @@ procedure TResourceStrings.CreateResourceStringList;
             consts.concat(tai_const.create_8bit(0));
          end;
        { append Current value (nil) and hash...}
-       resourcestringlist.concat(tai_const.create_ptr(0));
-       resourcestringlist.concat(tai_const.create_32bit(hash));
+       resourcestringlist.concat(tai_const.create_sym(nil));
+       resourcestringlist.concat(tai_const.create_32bit(longint(hash)));
        { Append the name as a ansistring. }
        objectlibrary.getdatalabel(l1);
        L:=Length(Name);
-       resourcestringlist.concat(tai_const_symbol.create(l1));
-       consts.concat(tai_align.Create(const_align(pointer_size)));
+       resourcestringlist.concat(tai_const.create_sym(l1));
+       consts.concat(tai_align.Create(const_align(sizeof(aint))));
        consts.concat(tai_const.create_32bit(l));
        consts.concat(tai_const.create_32bit(l));
-       consts.concat(tai_const.create_32bit(cardinal(-1)));
+       consts.concat(tai_const.create_32bit(-1));
        consts.concat(tai_label.create(l1));
        getmem(s,l+1);
        move(Name[1],s^,l);
@@ -192,7 +192,7 @@ begin
     resourcestringlist:=taasmoutput.create;
   resourcestringlist.insert(tai_const.create_32bit(resstrcount));
   resourcestringlist.insert(tai_symbol.createname_global(make_mangledname('RESOURCESTRINGLIST',current_module.localsymtable,''),AT_DATA,0));
-  resourcestringlist.insert(tai_align.Create(const_align(pointer_size)));
+  resourcestringlist.insert(tai_align.Create(const_align(sizeof(aint))));
   R:=TResourceStringItem(List.First);
   While assigned(R) do
    begin
@@ -295,11 +295,24 @@ end;
 end.
 {
   $Log$
-  Revision 1.23  2004-05-23 15:23:30  peter
+  Revision 1.24  2004-06-16 20:07:07  florian
+    * dwarf branch merged
+
+  Revision 1.23  2004/05/23 15:23:30  peter
     * fixed qword(longint) that removed sign from the number
     * removed code in the compiler that relied on wrong qword(longint)
       code generation
 
+  Revision 1.22.2.3  2004/05/01 16:02:09  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
+  Revision 1.22.2.2  2004/04/27 18:18:25  peter
+    * aword -> aint
+
+  Revision 1.22.2.1  2004/04/12 14:45:11  peter
+    * tai_const_symbol and tai_const merged
+
   Revision 1.22  2004/03/02 00:36:33  olle
     * big transformation of Tai_[const_]Symbol.Create[data]name*
 
@@ -349,4 +362,4 @@ end.
   + generic constructor calls
   + start of tassembler / tmodulebase class cleanup
 
-}
+}

compiler/cstreams.pas

@@ -26,6 +26,10 @@ unit cstreams;
 
 interface
 
+   uses
+     cutils;
+
+
 {****************************************************************************
                                   TCStream
 ****************************************************************************}
@@ -307,7 +311,7 @@ implementation
     if TheSize>0 then
      begin
        ReadBuffer (Pointer(Result)^,TheSize);
-       P:=PByte(Longint(Result)+TheSize);
+       P:=PByte(PtrInt(Result)+TheSize);
        p^:=0;
      end;
    end;
@@ -451,7 +455,7 @@ begin
     begin
     Result:=FSize-FPosition;
     If Result>Count then Result:=Count;
-    Move (Pointer(Longint(FMemory)+FPosition)^,Buffer,Result);
+    Move (Pointer(PtrInt(FMemory)+FPosition)^,Buffer,Result);
     FPosition:=Fposition+Result;
     end;
 end;
@@ -602,7 +606,7 @@ begin
       SetCapacity (NewPos);
     FSize:=Newpos;
     end;
-  System.Move (Buffer,Pointer(Longint(FMemory)+FPosition)^,Count);
+  System.Move (Buffer,Pointer(Ptrint(FMemory)+FPosition)^,Count);
   FPosition:=NewPos;
   Result:=Count;
 end;
@@ -610,7 +614,16 @@ end;
 end.
 {
   $Log$
-  Revision 1.6  2002-07-01 16:23:52  peter
+  Revision 1.7  2004-06-16 20:07:07  florian
+    * dwarf branch merged
+
+  Revision 1.6.2.2  2004/04/29 19:07:22  peter
+    * compile fixes
+
+  Revision 1.6.2.1  2004/04/28 21:46:56  peter
+    * compile fixes for x86-64
+
+  Revision 1.6  2002/07/01 16:23:52  peter
     * cg64 patch
     * basics for currency
     * asnode updates for class and interface (not finished)

compiler/cutils.pas

@@ -32,6 +32,9 @@ interface
 
 
     type
+{$ifdef ver1_0}
+       ptrint = longint;
+{$endif ver1_0}
        pstring = ^string;
        get_var_value_proc=function(const s:string):string of object;
        Tcharset=set of char;
@@ -65,11 +68,11 @@ interface
     function GetToken(var s:string;endchar:char):string;
     procedure uppervar(var s : string);
     function hexstr(val : cardinal;cnt : cardinal) : string;
-    function tostru(i:cardinal) : string;{$ifdef USEINLINE}inline;{$endif}
-    function tostr(i : longint) : string;{$ifdef USEINLINE}inline;{$endif}
     function realtostr(e:extended):string;{$ifdef USEINLINE}inline;{$endif}
-    function int64tostr(i : int64) : string;{$ifdef USEINLINE}inline;{$endif}
-    function tostr_with_plus(i : longint) : string;{$ifdef USEINLINE}inline;{$endif}
+    function tostr(i : qword) : string;{$ifdef USEINLINE}inline;{$endif}overload;
+    function tostr(i : int64) : string;{$ifdef USEINLINE}inline;{$endif}overload;
+    function tostr(i : longint) : string;{$ifdef USEINLINE}inline;{$endif}overload;
+    function tostr_with_plus(i : int64) : string;{$ifdef USEINLINE}inline;{$endif}
     function DStr(l:longint):string;
     procedure valint(S : string;var V : longint;var code : integer);
     {# Returns true if the string s is a number }
@@ -405,24 +408,6 @@ uses
       end;
 
 
-    function tostru(i:cardinal):string;{$ifdef USEINLINE}inline;{$endif}
-    {
-      return string of value i, but for cardinals
-    }
-      begin
-        str(i,result);
-      end;
-
-
-   function tostr(i : longint) : string;{$ifdef USEINLINE}inline;{$endif}
-   {
-     return string of value i
-   }
-     begin
-       str(i,result);
-     end;
-
-
     function DStr(l:longint):string;
       var
         TmpStr : string[32];
@@ -553,7 +538,25 @@ uses
      end;
 
 
-   function int64tostr(i : int64) : string;{$ifdef USEINLINE}inline;{$endif}
+   function tostr(i : qword) : string;{$ifdef USEINLINE}inline;{$endif}overload;
+   {
+     return string of value i
+   }
+     begin
+        str(i,result);
+     end;
+
+
+   function tostr(i : int64) : string;{$ifdef USEINLINE}inline;{$endif}overload;
+   {
+     return string of value i
+   }
+     begin
+        str(i,result);
+     end;
+
+
+   function tostr(i : longint) : string;{$ifdef USEINLINE}inline;{$endif}overload;
    {
      return string of value i
    }
@@ -562,7 +565,7 @@ uses
      end;
 
 
-   function tostr_with_plus(i : longint) : string;{$ifdef USEINLINE}inline;{$endif}
+   function tostr_with_plus(i : int64) : string;{$ifdef USEINLINE}inline;{$endif}
    {
      return string of value i, but always include a + when i>=0
    }
@@ -1188,9 +1191,21 @@ initialization
 end.
 {
   $Log$
-  Revision 1.39  2004-05-22 23:33:18  peter
+  Revision 1.40  2004-06-16 20:07:07  florian
+    * dwarf branch merged
+
+  Revision 1.39  2004/05/22 23:33:18  peter
   fix range check error when array size > maxlongint
 
+  Revision 1.38.2.3  2004/04/29 19:07:22  peter
+    * compile fixes
+
+  Revision 1.38.2.2  2004/04/26 21:01:36  peter
+    * aint fixes
+
+  Revision 1.38.2.1  2004/04/20 16:35:58  peter
+    * generate dwarf for stackframe entry
+
   Revision 1.38  2004/03/29 19:19:35  florian
     + arm floating point register saving implemented
     * hopefully stabs generation for MacOSX fixed
@@ -1287,4 +1302,4 @@ end.
   Revision 1.14  2002/04/12 17:16:35  carl
   + more documentation of basic unit
 
-}
+}

compiler/defutil.pas

@@ -28,9 +28,9 @@ interface
 
     uses
        cclasses,
-       globals,
+       globtype,globals,
        symconst,symbase,symtype,symdef,
-       cgbase,cpuinfo,cpubase;
+       cgbase,cpubase;
 
     type
        tmmxtype = (mmxno,mmxu8bit,mmxs8bit,mmxu16bit,mmxs16bit,
@@ -57,9 +57,6 @@ interface
     {# Returns true, if definition defines an integer type }
     function is_integer(def : tdef) : boolean;
 
-    { true if p is a 32bit int i.e. dword or longint }
-    function is_32bitint(def : tdef) : boolean;
-
     {# Returns true if definition is a boolean }
     function is_boolean(def : tdef) : boolean;
 
@@ -173,6 +170,9 @@ interface
     {# Returns true, if def is an extended type }
     function is_extended(def : tdef) : boolean;
 
+    {# Returns true, if def is a 32 bit integer type }
+    function is_32bitint(def : tdef) : boolean;
+
     {# Returns true, if def is a 64 bit integer type }
     function is_64bitint(def : tdef) : boolean;
 
@@ -203,7 +203,7 @@ interface
 implementation
 
     uses
-       globtype,tokens,systems,verbose;
+       tokens,systems,verbose;
 
     { returns true, if def uses FPU }
     function is_fpu(def : tdef) : boolean;
@@ -342,14 +342,6 @@ implementation
       end;
 
 
-    { true if p is a 32bit int i.e. dword or longint }
-    function is_32bitint(def : tdef) : boolean;
-      begin
-        is_32bitint:=(def.deftype=orddef) and
-                    (torddef(def).typ in [u32bit,s32bit]);
-      end;
-
-
     { true if p is a boolean }
     function is_boolean(def : tdef) : boolean;
       begin
@@ -609,6 +601,13 @@ implementation
       end;
 
 
+    { true, if def is a 32 bit int type }
+    function is_32bitint(def : tdef) : boolean;
+      begin
+         result:=(def.deftype=orddef) and (torddef(def).typ in [u32bit,s32bit])
+      end;
+
+
     { true, if def is a 64 bit int type }
     function is_64bitint(def : tdef) : boolean;
       begin
@@ -905,7 +904,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.15  2004-05-28 21:13:23  peter
+  Revision 1.16  2004-06-16 20:07:07  florian
+    * dwarf branch merged
+
+  Revision 1.15  2004/05/28 21:13:23  peter
     * prefer signed constants over unsigned
 
   Revision 1.14  2004/05/01 22:05:01  florian
@@ -914,6 +916,13 @@ end.
   Revision 1.13  2004/04/29 19:56:36  daniel
     * Prepare compiler infrastructure for multiple ansistring types
 
+  Revision 1.12.2.2  2004/05/03 16:27:38  peter
+    * fixed shl for x86-64
+
+  Revision 1.12.2.1  2004/05/01 16:02:09  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
   Revision 1.12  2004/03/29 14:44:10  peter
     * fixes to previous constant integer commit
 
@@ -1106,7 +1115,7 @@ end.
     * moved more routines from cga/n386util
 
   Revision 1.68  2002/04/15 19:08:22  carl
-  + target_info.size_of_pointer -> pointer_size
+  + target_info.size_of_pointer -> sizeof(aint)
   + some cleanup of unused types/variables
 
   Revision 1.67  2002/04/07 13:40:29  carl

compiler/dwarf.pas

@@ -0,0 +1,447 @@
+{
+    $Id$
+    Copyright (c) 2003-2004 by Peter Vreman and Florian Klaempfl
+
+    This units contains special support for DWARF debug info
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit dwarf;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      cclasses,
+      globtype,
+      cgbase,cpubase,
+      aasmbase,aasmtai;
+
+    const
+      maxdwarfops = 2;
+
+    type
+      tdwarfoperenc=(doe_uleb,doe_sleb,doe_ptr,doe_32bit,doe_16bit,doe_8bit);
+      tdwarfopertype=(dop_reg,dop_const,dop_sym,dop_reloffset);
+
+      tdwarfoper=record
+        enc : tdwarfoperenc;
+        case typ:tdwarfopertype of
+          dop_reg : (register:tregister);
+          dop_const : (value:int64);
+          dop_sym : (sym:tasmsymbol);
+          dop_reloffset : (beginsym,endsym:tasmsymbol);
+      end;
+
+      tdwarfitem=class(TLinkedListItem)
+        op   : byte;
+        ops  : byte;
+        oper : array[0..maxdwarfops-1] of tdwarfoper;
+        constructor create(aop:longint);
+        constructor create_reg(aop:longint;enc1:tdwarfoperenc;reg:tregister);
+        constructor create_const(aop:longint;enc1:tdwarfoperenc;val:int64);
+        constructor create_reloffset(aop:longint;enc1:tdwarfoperenc;beginlab,endlab:tasmsymbol);
+        constructor create_reg_const(aop:longint;enc1:tdwarfoperenc;reg:tregister;enc2:tdwarfoperenc;val:longint);
+        procedure generate_code(list:taasmoutput);
+      end;
+
+      tdwarf=class
+      private
+        FDwarfList : TLinkedList;
+      public
+        constructor create;
+        destructor destroy;override;
+        property DwarfList:TlinkedList read FDwarfList;
+      end;
+
+      tdwarfcfi=class(tdwarf)
+      private
+        FFrameStartLabel,
+        FFrameEndLabel,
+        FLastloclabel : tasmlabel;
+        procedure cfa_advance_loc(list:taasmoutput);
+      protected
+        code_alignment_factor,
+        data_alignment_factor : shortint;
+      public
+        constructor create;
+        procedure generate_code(list:taasmoutput);
+        { operations }
+        procedure start_frame(list:taasmoutput);
+        procedure end_frame(list:taasmoutput);
+        procedure cfa_offset(list:taasmoutput;reg:tregister;ofs:longint);
+        procedure cfa_restore(list:taasmoutput;reg:tregister);
+        procedure cfa_def_cfa_register(list:taasmoutput;reg:tregister);
+        procedure cfa_def_cfa_offset(list:taasmoutput;ofs:longint);
+      end;
+
+
+    var
+      dwarfcfi : tdwarfcfi;
+
+    function dwarf_reg(r:tregister):longint;
+
+
+implementation
+
+    uses
+      verbose,
+      cpuinfo;
+
+    const
+      { Call frame information }
+      DW_CFA_set_loc          = $01;
+      DW_CFA_advance_loc1     = $02;
+      DW_CFA_advance_loc2     = $03;
+      DW_CFA_advance_loc4     = $04;
+      DW_CFA_offset_extended  = $05;
+      DW_CFA_restore_extended = $06;
+      DW_CFA_def_cfa          = $0c;
+      DW_CFA_def_cfa_register = $0d;
+      DW_CFA_def_cfa_offset   = $0e;
+      { Own additions }
+      DW_CFA_start_frame = $f0;
+      DW_CFA_end_frame   = $f1;
+
+
+{****************************************************************************
+                                  Helpers
+****************************************************************************}
+
+    function dwarf_reg(r:tregister):longint;
+      begin
+        result:=regdwarf_table[findreg_by_number(r)];
+      end;
+
+
+{****************************************************************************
+                                  TDWARF
+****************************************************************************}
+
+    constructor tdwarf.create;
+      begin
+        FDwarfList:=TLinkedList.Create;
+      end;
+
+
+    destructor tdwarf.destroy;
+      begin
+        FDwarfList.Free;
+      end;
+
+
+{****************************************************************************
+                                TDWARFITEM
+****************************************************************************}
+
+    constructor tdwarfitem.create(aop:longint);
+      begin
+        inherited create;
+        op:=aop;
+        ops:=0;
+      end;
+
+
+    constructor tdwarfitem.create_reg(aop:longint;enc1:tdwarfoperenc;reg:tregister);
+      begin
+        inherited create;
+        op:=aop;
+        ops:=1;
+        oper[0].typ:=dop_reg;
+        oper[0].enc:=enc1;
+        oper[0].register:=reg;
+      end;
+
+
+    constructor tdwarfitem.create_const(aop:longint;enc1:tdwarfoperenc;val:int64);
+      begin
+        inherited create;
+        op:=aop;
+        ops:=1;
+        oper[0].typ:=dop_const;
+        oper[0].enc:=enc1;
+        oper[0].value:=val;
+      end;
+
+
+    constructor tdwarfitem.create_reloffset(aop:longint;enc1:tdwarfoperenc;beginlab,endlab:tasmsymbol);
+      begin
+        inherited create;
+        op:=aop;
+        ops:=1;
+        { relative offsets are passed }
+        oper[0].typ:=dop_reloffset;
+        oper[0].enc:=enc1;
+        oper[0].beginsym:=beginlab;
+        oper[0].endsym:=endlab;
+      end;
+
+
+    constructor tdwarfitem.create_reg_const(aop:longint;enc1:tdwarfoperenc;reg:tregister;enc2:tdwarfoperenc;val:longint);
+      begin
+        inherited create;
+        op:=aop;
+        ops:=2;
+        oper[0].typ:=dop_reg;
+        oper[0].enc:=enc1;
+        oper[0].register:=reg;
+        oper[1].typ:=dop_const;
+        oper[1].enc:=enc2;
+        oper[1].value:=val;
+      end;
+
+
+    procedure tdwarfitem.generate_code(list:taasmoutput);
+      const
+        enc2ait_const : array[tdwarfoperenc] of taitype = (
+          ait_const_uleb128bit,ait_const_sleb128bit,ait_const_ptr,
+          ait_const_32bit,ait_const_16bit,ait_const_8bit
+        );
+      var
+        i : integer;
+        v : int64;
+      begin
+        list.concat(tai_const.create_8bit(op));
+        for i:=0 to ops-1 do
+          begin
+            case oper[i].typ of
+              dop_const :
+                list.concat(tai_const.create(enc2ait_const[oper[i].enc],oper[i].value));
+              dop_sym :
+                begin
+                  if oper[i].enc<>doe_ptr then
+                    internalerror(200404127);
+                  list.concat(tai_const.create_sym(oper[i].sym));
+                end;
+              dop_reloffset :
+                list.concat(tai_const.create_rel_sym(enc2ait_const[oper[i].enc],oper[i].beginsym,oper[i].endsym));
+              dop_reg :
+                list.concat(tai_const.create(enc2ait_const[oper[i].enc],regdwarf_table[findreg_by_number(oper[i].register)]));
+              else
+                internalerror(200404128);
+            end;
+          end;
+      end;
+
+
+{****************************************************************************
+                                 TDWARFCFI
+****************************************************************************}
+
+    constructor tdwarfcfi.create;
+      begin
+        inherited create;
+        FFrameStartLabel:=nil;
+        FFrameEndLabel:=nil;
+        FLastLocLabel:=nil;
+        code_alignment_factor:=1;
+        data_alignment_factor:=-1;
+      end;
+
+
+    procedure tdwarfcfi.generate_code(list:taasmoutput);
+      var
+        hp : tdwarfitem;
+        cielabel,
+        lenstartlabel,
+        lenendlabel    : tasmlabel;
+        tc             : tai_const;
+      begin
+        new_section(list,sec_debug_frame,'',0);
+        { CIE
+           DWORD   length
+           DWORD   CIE_Id = 0xffffffff
+           BYTE    version = 1
+           STRING  augmentation = "" = BYTE 0
+           ULEB128 code alignment factor = 1
+           ULEB128 data alignment factor = -1
+           BYTE    return address register
+           <...>   start sequence
+        }
+        objectlibrary.getlabel(cielabel);
+        list.concat(tai_label.create(cielabel));
+        objectlibrary.getlabel(lenstartlabel);
+        objectlibrary.getlabel(lenendlabel);
+        list.concat(tai_const.create_rel_sym(ait_const_32bit,lenstartlabel,lenendlabel));
+        list.concat(tai_label.create(lenstartlabel));
+        list.concat(tai_const.create_32bit(longint($ffffffff)));
+        list.concat(tai_const.create_8bit(1));
+        list.concat(tai_const.create_8bit(0)); { empty string }
+        list.concat(tai_const.create_uleb128bit(code_alignment_factor));
+        list.concat(tai_const.create_sleb128bit(data_alignment_factor));
+        list.concat(tai_const.create_8bit(dwarf_reg(NR_RETURN_ADDRESS_REG)));
+        { Generate standard code
+            def_cfa(stackpointer,sizeof(aint))
+            cfa_offset_extended(returnaddres,-sizeof(aint))
+        }
+{$warning TODO This needs to be target dependent}
+        list.concat(tai_const.create_8bit(DW_CFA_def_cfa));
+        list.concat(tai_const.create_uleb128bit(dwarf_reg(NR_STACK_POINTER_REG)));
+        list.concat(tai_const.create_uleb128bit(sizeof(aint)));
+        list.concat(tai_const.create_8bit(DW_CFA_offset_extended));
+        list.concat(tai_const.create_uleb128bit(dwarf_reg(NR_RETURN_ADDRESS_REG)));
+        list.concat(tai_const.create_uleb128bit((-sizeof(aint)) div data_alignment_factor));
+        list.concat(cai_align.create_zeros(4));
+        list.concat(tai_label.create(lenendlabel));
+        lenstartlabel:=nil;
+        lenendlabel:=nil;
+
+        hp:=TDwarfItem(Dwarflist.first);
+        while assigned(hp) do
+          begin
+            case hp.op of
+              DW_CFA_Start_Frame :
+                begin
+                  if assigned(lenstartlabel) then
+                    internalerror(200404125);
+                  if (hp.ops<>1) or
+                     (hp.oper[0].typ<>dop_reloffset) then
+                    internalerror(200404126);
+                  objectlibrary.getlabel(lenstartlabel);
+                  objectlibrary.getlabel(lenendlabel);
+                  { FDE
+                     DWORD length
+                     DWORD CIE-pointer = cielabel
+                     PTRSIZE initial location = oper[0]
+                     PTRSIZE function size = oper[1]
+                  }
+                  list.concat(tai_const.create_rel_sym(ait_const_32bit,lenstartlabel,lenendlabel));
+                  list.concat(tai_label.create(lenstartlabel));
+                  { force label offset to 32bit }
+                  tc:=tai_const.create_sym(cielabel);
+                  tc.typ:=ait_const_32bit;
+                  list.concat(tc);
+                  list.concat(tai_const.create_sym(hp.oper[0].beginsym));
+                  list.concat(tai_const.create_rel_sym(ait_const_ptr,hp.oper[0].beginsym,hp.oper[0].endsym));
+                end;
+              DW_CFA_End_Frame :
+                begin
+                  list.concat(cai_align.create_zeros(4));
+                  list.concat(tai_label.create(lenendlabel));
+                  lenstartlabel:=nil;
+                  lenendlabel:=nil;
+                end;
+              else
+                hp.generate_code(list);
+            end;
+            hp:=TDwarfItem(hp.next);
+          end;
+        { Check for open frames }
+        if assigned(lenstartlabel) then
+          internalerror(2004041210);
+        { Dwarflist is processed, remove items }
+        DwarfList.Clear;
+      end;
+
+
+    procedure tdwarfcfi.start_frame(list:taasmoutput);
+      begin
+        if assigned(FFrameStartLabel) then
+          internalerror(200404129);
+        objectlibrary.getlabel(FFrameStartLabel);
+        objectlibrary.getlabel(FFrameEndLabel);
+        FLastloclabel:=FFrameStartLabel;
+        list.concat(tai_label.create(FFrameStartLabel));
+        dwarflist.concat(tdwarfitem.create_reloffset(DW_CFA_start_frame,doe_32bit,FFrameStartLabel,FFrameEndLabel));
+      end;
+
+
+    procedure tdwarfcfi.end_frame(list:taasmoutput);
+      begin
+        if not assigned(FFrameStartLabel) then
+          internalerror(2004041213);
+        dwarflist.concat(tdwarfitem.create(DW_CFA_end_frame));
+        list.concat(tai_label.create(FFrameEndLabel));
+        FFrameStartLabel:=nil;
+        FFrameEndLabel:=nil;
+        FLastLocLabel:=nil;
+      end;
+
+
+    procedure tdwarfcfi.cfa_advance_loc(list:taasmoutput);
+      var
+        currloclabel : tasmlabel;
+      begin
+        if FLastloclabel=nil then
+          internalerror(200404082);
+        objectlibrary.getlabel(currloclabel);
+        list.concat(tai_label.create(currloclabel));
+        dwarflist.concat(tdwarfitem.create_reloffset(DW_CFA_advance_loc4,doe_32bit,FLastloclabel,currloclabel));
+        FLastloclabel:=currloclabel;
+      end;
+
+
+    procedure tdwarfcfi.cfa_offset(list:taasmoutput;reg:tregister;ofs:longint);
+      begin
+        cfa_advance_loc(list);
+{$warning TODO check if ref is a temp}
+        { offset must be positive }
+        dwarflist.concat(tdwarfitem.create_reg_const(DW_CFA_offset_extended,doe_uleb,reg,doe_uleb,ofs div data_alignment_factor));
+      end;
+
+
+    procedure tdwarfcfi.cfa_restore(list:taasmoutput;reg:tregister);
+      begin
+        cfa_advance_loc(list);
+        dwarflist.concat(tdwarfitem.create_reg(DW_CFA_restore_extended,doe_uleb,reg));
+      end;
+
+
+    procedure tdwarfcfi.cfa_def_cfa_register(list:taasmoutput;reg:tregister);
+      begin
+        cfa_advance_loc(list);
+        dwarflist.concat(tdwarfitem.create_reg(DW_CFA_def_cfa_register,doe_uleb,reg));
+      end;
+
+
+    procedure tdwarfcfi.cfa_def_cfa_offset(list:taasmoutput;ofs:longint);
+      begin
+        cfa_advance_loc(list);
+        dwarflist.concat(tdwarfitem.create_const(DW_CFA_def_cfa_offset,doe_uleb,ofs));
+      end;
+
+
+begin
+{$warning TODO Maybe initialize per module}
+  dwarfcfi:=tdwarfcfi.create;
+end.
+{
+  $Log$
+  Revision 1.2  2004-06-16 20:07:07  florian
+    * dwarf branch merged
+
+  Revision 1.1.2.6  2004/05/01 16:02:09  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
+  Revision 1.1.2.5  2004/04/27 18:18:25  peter
+    * aword -> aint
+
+  Revision 1.1.2.4  2004/04/20 16:35:58  peter
+    * generate dwarf for stackframe entry
+
+  Revision 1.1.2.3  2004/04/12 19:34:45  peter
+    * basic framework for dwarf CFI
+
+  Revision 1.1.2.2  2004/04/12 14:45:11  peter
+    * tai_const_symbol and tai_const merged
+
+  Revision 1.1.2.1  2004/04/08 21:04:24  peter
+    * prototype
+
+}

compiler/finput.pas

@@ -417,7 +417,7 @@ uses
               break;
              inc(i);
              getlinestr[i]:=c;
-             inc(longint(p));
+             inc(p);
            until (i=255);
            getlinestr[0]:=chr(i);
          end;
@@ -712,7 +712,13 @@ uses
 end.
 {
   $Log$
-  Revision 1.23  2003-12-27 22:27:24  peter
+  Revision 1.24  2004-06-16 20:07:07  florian
+    * dwarf branch merged
+
+  Revision 1.23.2.1  2004/04/28 21:46:56  peter
+    * compile fixes for x86-64
+
+  Revision 1.23  2003/12/27 22:27:24  peter
     * check with fileexists() before opening a file
 
   Revision 1.22  2003/04/28 16:18:16  peter

compiler/fpcdefs.inc

@@ -18,8 +18,10 @@
       { We don't use exceptions, so turn off the implicit
         exceptions in the constructors }
       {$IMPLICITEXCEPTIONS OFF}
-      { Inline small functions }
-      {$define USEINLINE}
+      { Inline small functions, but not when EXTDEBUG is used }
+      {$ifndef EXTDEBUG}
+        {$define USEINLINE}
+      {$endif EXTDEBUG}
     {$else}
       { Optimizer is broken when compiling with optimizations using 1.0.x }
       {$ifndef USEOPT}
@@ -64,6 +66,7 @@
   {$define cpuextended}
   {$define cpufloat128}
   {$define noopt}
+  {$define cputargethasfixedstack}
 {$endif x86_64}
 
 {$ifdef alpha}
@@ -99,9 +102,25 @@
 
 {
   $Log$
-  Revision 1.36  2004-05-30 21:20:40  jonas
+  Revision 1.37  2004-06-16 20:07:07  florian
+    * dwarf branch merged
+
+  Revision 1.36  2004/05/30 21:20:40  jonas
     * enable regvars by default for PPC
 
+  Revision 1.35.2.4  2004/05/02 12:45:32  peter
+    * enabled cpuhasfixedstack for x86-64 again
+    * fixed size of temp allocation for parameters
+
+  Revision 1.35.2.3  2004/05/02 01:02:24  peter
+    * remove fixed stack for x86-64
+
+  Revision 1.35.2.2  2004/04/29 23:30:28  peter
+    * fix i386 compiler
+
+  Revision 1.35.2.1  2004/04/23 22:12:37  florian
+    * fixed some potential stack corruption reasons
+
   Revision 1.35  2004/03/16 22:12:10  florian
     * some alignment issues resolved
     * compiler doesn't generate anymore instructions not supported by the linux fpe
@@ -226,4 +245,4 @@
 
   Revision 1.3  2002/07/04 18:56:50  florian
     + log added
-}
+}

compiler/gendef.pas

@@ -91,13 +91,13 @@ begin
   is_empty:=false;
 end;
 
+
 function tdeffile.empty : boolean;
 begin
-  empty:=is_empty and (description='');
+  empty:=is_empty or DescriptionSetExplicity;
 end;
 
 
-
 procedure tdeffile.writefile;
 var
   t : text;
@@ -160,7 +160,13 @@ end;
 end.
 {
   $Log$
-  Revision 1.12  2003-03-23 23:20:38  hajny
+  Revision 1.13  2004-06-16 20:07:07  florian
+    * dwarf branch merged
+
+  Revision 1.12.2.1  2004/05/03 14:59:57  peter
+    * no dlltool needed for win32 linking executables
+
+  Revision 1.12  2003/03/23 23:20:38  hajny
     + emx target added
 
   Revision 1.11  2002/07/26 21:15:38  florian

compiler/globals.pas

@@ -89,9 +89,6 @@ interface
 
 
     type
-{$ifdef ver1_0}
-       PtrInt = DWord;
-{$endif ver1_0}
        TFPUException = (exInvalidOp, exDenormalized, exZeroDivide,
                         exOverflow, exUnderflow, exPrecision);
        TFPUExceptionMask = set of TFPUException;
@@ -113,11 +110,6 @@ interface
 
        tcodepagestring = string[20];
 
-       { the ordinal type used when evaluating constant integer expressions }
-       TConstExprInt = int64;
-       { ... the same unsigned }
-       TConstExprUInt = {$ifdef fpc}qword{$else}int64{$endif};
-
     var
        { specified inputfile }
        inputdir       : dirstr;
@@ -157,11 +149,19 @@ interface
        objectsearchpath,
        includesearchpath  : TSearchPathList;
 
-       { deffile }
+       { linking }
        usewindowapi  : boolean;
        description   : string;
+       DescriptionSetExplicity : boolean;
        dllversion    : string;
-       dllmajor,dllminor,dllrevision : word;  { revision only for netware }
+       dllmajor,
+       dllminor,
+       dllrevision   : word;  { revision only for netware }
+       UseDeffileForExports    : boolean;
+       UseDeffileForExportsSetExplicitly : boolean;
+       RelocSection : boolean;
+       RelocSectionSetExplicitly : boolean;
+       LinkTypeSetExplicitly : boolean;
 
        akttokenpos,                  { position of the last token }
        aktfilepos : tfileposinfo;    { current position }
@@ -244,14 +244,8 @@ interface
        apptype : tapptype;
 
     const
-       RelocSection : boolean = true;
-       RelocSectionSetExplicitly : boolean = false;
-       LinkTypeSetExplicitly : boolean = false;
-
        DLLsource : boolean = false;
        DLLImageBase : pstring = nil;
-       UseDeffileForExport : boolean = true;
-       ForceDeffileForExport : boolean = false;
 
        { used to set all registers used for each global function
          this should dramatically decrease the number of
@@ -325,7 +319,6 @@ interface
 
     function  string2guid(const s: string; var GUID: TGUID): boolean;
     function  guid2string(const GUID: TGUID): string;
-    procedure swap_qword(var q : qword);
 
     function UpdateAlignmentStr(s:string;var a:talignmentinfo):boolean;
 
@@ -1377,7 +1370,7 @@ implementation
         begin
           CtlWord:=Get8087CW;
           Set8087CW( (CtlWord and $FFC0) or Byte(Longint(Mask)) );
-          Result:=TFPUExceptionMask(CtlWord and $3F);
+          Result:=TFPUExceptionMask(Longint(CtlWord and $3F));
         end;
 {$else CPUI386}
 {$ifdef CPUPOWERPC}
@@ -1666,11 +1659,6 @@ implementation
       end;
 
 
-    procedure swap_qword(var q : qword);
-      begin
-         q:=(qword(lo(q)) shl 32) or hi(q);
-      end;
-
     function UpdateAlignmentStr(s:string;var a:talignmentinfo):boolean;
       var
         tok  : string;
@@ -1777,9 +1765,6 @@ implementation
        initdefines.free;
        if assigned(DLLImageBase) then
          StringDispose(DLLImageBase);
-       RelocSection:=true;
-       RelocSectionSetExplicitly:=false;
-       UseDeffileForExport:=true;
        librarysearchpath.Free;
        unitsearchpath.Free;
        objectsearchpath.Free;
@@ -1799,6 +1784,7 @@ implementation
         inlining_procedure:=false;
         resolving_forward:=false;
         make_ref:=false;
+        LinkTypeSetExplicitly:=false;
 
       { Output }
         OutputFile:='';
@@ -1820,10 +1806,19 @@ implementation
       { Def file }
         usewindowapi:=false;
         description:='Compiled by FPC '+version_string+' - '+target_cpu_string;
+        DescriptionSetExplicity:=false;
         dllversion:='';
+        dllmajor:=1;
+        dllminor:=0;
+        dllrevision:=0;
         nwscreenname := '';
         nwthreadname := '';
         nwcopyright  := '';
+        UseDeffileForExports:=false;
+        UseDeffileForExportsSetExplicitly:=false;
+        RelocSection:=false;
+        RelocSectionSetExplicitly:=false;
+        LinkTypeSetExplicitly:=false;
 
       { Init values }
         initmodeswitches:=fpcmodeswitches;
@@ -1903,7 +1898,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.129  2004-05-11 18:20:52  olle
+  Revision 1.130  2004-06-16 20:07:07  florian
+    * dwarf branch merged
+
+  Revision 1.129  2004/05/11 18:20:52  olle
     * changed $mode mac to $mode macpas
     * changed macmodeswitches to be more faithful to the mac dialect
 
@@ -1913,6 +1911,19 @@ end.
   Revision 1.127  2004/04/28 15:19:03  florian
     + syscall directive support for MorphOS added
 
+  Revision 1.126.2.4  2004/05/09 15:47:21  peter
+    * fix typecast from word->set
+
+  Revision 1.126.2.3  2004/05/03 14:59:57  peter
+    * no dlltool needed for win32 linking executables
+
+  Revision 1.126.2.2  2004/05/01 16:02:09  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
+  Revision 1.126.2.1  2004/04/27 18:18:25  peter
+    * aword -> aint
+
   Revision 1.126  2004/03/14 20:08:37  peter
     * packrecords fixed for settings from $PACKRECORDS
     * default packrecords now uses value 0 and uses info from aligment
@@ -2231,4 +2242,4 @@ end.
    * implicit result variable generation for assembler routines
    * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
 
-}
+}

compiler/globtype.pas

@@ -29,12 +29,38 @@ interface
        maxidlen = 64;
 
     type
+{$ifndef fpc}
+       qword = int64;
+{$endif fpc}
+
 {$ifdef ver1_0}
        { Bootstrapping }
        PtrInt = DWord;
        SizeInt = Longint;
 {$endif ver1_0}
 
+       { Natural integer register type and size for the target machine }
+{$ifdef cpu64bit}
+       AWord = qword;
+       AInt = Int64;
+{$else cpu64bit}
+       AWord = longword;
+       AInt = longint;
+{$endif cpu64bit}
+       PAWord = ^AWord;
+       PAInt = ^AInt;
+
+       { the ordinal type used when evaluating constant integer expressions }
+       TConstExprInt = int64;
+       { ... the same unsigned }
+       TConstExprUInt = qword;
+       { This must be an ordinal type with the same size as a pointer
+         Note: Must be unsigned! Otherwise, ugly code like
+         pointer(-1) will result in a pointer with the value
+         $fffffffffffffff on a 32bit machine if the compiler uses
+         int64 constants internally (JM) }
+       TConstPtrUInt = AWord;
+
        { Switches which can be changed locally }
        tlocalswitch = (cs_localnone,
          { codegen }
@@ -79,7 +105,7 @@ interface
          cs_browser_log,
          { debugger }
          cs_gdb_dbx,cs_gdb_gsym,cs_gdb_heaptrc,cs_gdb_lineinfo,
-         cs_checkpointer,cs_gdb_valgrind,
+         cs_checkpointer,cs_gdb_valgrind,cs_gdb_dwarf,
          { assembling }
          cs_asm_leave,cs_asm_extern,cs_asm_pipe,cs_asm_source,
          cs_asm_regalloc,cs_asm_tempalloc,cs_asm_nodes,
@@ -267,7 +293,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.56  2004-05-23 15:06:20  peter
+  Revision 1.57  2004-06-16 20:07:07  florian
+    * dwarf branch merged
+
+  Revision 1.56  2004/05/23 15:06:20  peter
     * implicit_finally flag must be set in pass1
     * add check whether the implicit frame is generated when expected
 
@@ -283,6 +312,16 @@ end.
   Revision 1.52  2004/04/28 15:19:03  florian
     + syscall directive support for MorphOS added
 
+  Revision 1.51.2.3  2004/05/02 00:45:51  peter
+    * define sizeint for 1.0.x
+
+  Revision 1.51.2.2  2004/05/01 16:02:09  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
+  Revision 1.51.2.1  2004/04/10 22:08:52  florian
+    + more dwarf infrastructure
+
   Revision 1.51  2004/04/04 18:46:09  olle
     + added $APPTYPE TOOL for MPW tools on MacOS
 
@@ -439,4 +478,4 @@ end.
    * implicit result variable generation for assembler routines
    * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
 
-}
+}

compiler/htypechk.pas

@@ -451,7 +451,7 @@ implementation
         { Multiple candidates left? }
         if cand_cnt>1 then
           begin
-            CGMessage(cg_e_cant_choose_overload_function);
+            CGMessage(type_e_cant_choose_overload_function);
 {$ifdef EXTDEBUG}
             candidates.dump_info(V_Hint);
 {$else EXTDEBUG}
@@ -597,7 +597,7 @@ implementation
         { Multiple candidates left? }
         if cand_cnt>1 then
           begin
-            CGMessage(cg_e_cant_choose_overload_function);
+            CGMessage(type_e_cant_choose_overload_function);
 {$ifdef EXTDEBUG}
             candidates.dump_info(V_Hint);
 {$else EXTDEBUG}
@@ -696,11 +696,6 @@ implementation
 {$endif SUPPORT_MMX}
             end;
          end;
-
-         { error CGMessage, if more than 8 floating point }
-         { registers are needed                         }
-         { if p.registersfpu>maxfpuregs then
-          CGMessage(cg_e_too_complex_expr); now pushed if needed PM }
       end;
 
 
@@ -1909,7 +1904,37 @@ implementation
 end.
 {
   $Log$
-  Revision 1.92  2004-05-25 21:27:35  florian
+  Revision 1.93  2004-06-16 20:07:07  florian
+    * dwarf branch merged
+
+  Revision 1.92  2004/05/25 21:27:35  florian
+    * fixed another formal const problem caused by yesterday's changes
+
+  Revision 1.91  2004/05/24 21:24:40  florian
+    * properties are allowed as formal const parameters as well
+
+  Revision 1.90  2004/05/24 21:04:31  florian
+    * fixed more formal const problems
+
+  Revision 1.89  2004/05/24 20:39:41  florian
+    * stricter handling of formal const parameters and IE fixed
+
+  Revision 1.88  2004/05/23 18:28:40  peter
+    * methodpointer is loaded into a temp when it was a calln
+
+  Revision 1.87  2004/05/23 15:03:40  peter
+    * some typeconvs don't allow assignment or passing to var para
+
+  Revision 1.86  2004/05/16 13:29:46  peter
+    * forbid more overloaded operators with orddef/enumdef
+
+  Revision 1.85  2004/04/18 07:52:43  florian
+    * fixed web bug 3048: comparision of dyn. arrays
+
+  Revision 1.84.2.2  2004/05/30 10:45:49  peter
+    * merged fixes from main branch
+
+  Revision 1.92  2004/05/25 21:27:35  florian
     * fixed another formal const problem caused by yesterday's changes
 
   Revision 1.91  2004/05/24 21:24:40  florian
@@ -1933,6 +1958,10 @@ end.
   Revision 1.85  2004/04/18 07:52:43  florian
     * fixed web bug 3048: comparision of dyn. arrays
 
+  Revision 1.84.2.1  2004/04/28 19:55:51  peter
+    * new warning for ordinal-pointer when size is different
+    * fixed some cg_e_ messages to the correct section type_e_ or parser_e_
+
   Revision 1.84  2004/03/18 16:29:07  peter
     * missing result initialization in node2opstr
 
@@ -2115,4 +2144,4 @@ end.
     * no longer allow assignments to pointer expressions (unless there's a
       deref), reported by John Lee
 
-}
+}

compiler/i386/ag386int.pas

@@ -62,6 +62,12 @@ implementation
     const
       line_length = 70;
 
+      secnames : array[TAsmSectionType] of string[4] = ('',
+        'CODE','DATA','DATA','BSS',
+        '','','','','','',
+        '','','','','',''
+      );
+
     function single2str(d : single) : string;
       var
          hs : string;
@@ -305,14 +311,17 @@ implementation
 
 
     var
-      LasTSec : TSection;
+      LasTSectype : TAsmSectionType;
       lastfileinfo : tfileposinfo;
       infile,
       lastinfile   : tinputfile;
 
     const
-      ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
-        (#9'DD'#9,#9'DW'#9,#9'DB'#9);
+      ait_const2str : array[ait_const_128bit..ait_const_indirect_symbol] of string[20]=(
+        #9'FIXME128',#9'FIXME64',#9'DD'#9,#9'DW'#9,#9'DB'#9,
+        #9'FIXMESLEB',#9'FIXEMEULEB',
+        #9'RVA'#9,#9'FIXMEINDIRECT'#9
+      );
 
     Function PadTabs(const p:string;addch:char):string;
     var
@@ -439,57 +448,65 @@ implementation
              end;
 
        ait_section : begin
-                       if LasTSec<>sec_none then
-                        AsmWriteLn('_'+target_asm.secnames[LasTSec]+#9#9'ENDS');
-                       if tai_section(hp).sec<>sec_none then
+                       if LasTSecType<>sec_none then
+                        AsmWriteLn('_'+secnames[LasTSecType]+#9#9'ENDS');
+                       if tai_section(hp).sectype<>sec_none then
                         begin
                           AsmLn;
-                          AsmWriteLn('_'+target_asm.secnames[tai_section(hp).sec]+#9#9+
+                          AsmWriteLn('_'+secnames[tai_section(hp).sectype]+#9#9+
                                      'SEGMENT'#9'PARA PUBLIC USE32 '''+
-                                     target_asm.secnames[tai_section(hp).sec]+'''');
+                                     secnames[tai_section(hp).sectype]+'''');
                         end;
-                       LasTSec:=tai_section(hp).sec;
+                       LasTSecType:=tai_section(hp).sectype;
                      end;
          ait_align : begin
                      { CAUSES PROBLEMS WITH THE SEGMENT DEFINITION   }
                      { SEGMENT DEFINITION SHOULD MATCH TYPE OF ALIGN }
                      { HERE UNDER TASM!                              }
-                       AsmWriteLn(#9'ALIGN '+tostr(tai_align(hp).aligntype));
+                       if tai_align(hp).aligntype>1 then
+                         AsmWriteLn(#9'ALIGN '+tostr(tai_align(hp).aligntype));
                      end;
      ait_datablock : begin
                        if tai_datablock(hp).is_global then
                          AsmWriteLn(#9'PUBLIC'#9+tai_datablock(hp).sym.name);
                        AsmWriteLn(PadTabs(tai_datablock(hp).sym.name,#0)+'DB'#9+tostr(tai_datablock(hp).size)+' DUP(?)');
                      end;
-   ait_const_32bit,
-    ait_const_8bit,
-   ait_const_16bit : begin
-                       AsmWrite(ait_const2str[hp.typ]+tostru(tai_const(hp).value));
-                       consttyp:=hp.typ;
-                       l:=0;
-                       repeat
-                         found:=(not (tai(hp.next)=nil)) and (tai(hp.next).typ=consttyp);
-                         if found then
-                          begin
-                            hp:=tai(hp.next);
-                            s:=','+tostru(tai_const(hp).value);
-                            AsmWrite(s);
-                            inc(l,length(s));
-                          end;
-                       until (not found) or (l>line_length);
-                       AsmLn;
-                     end;
-  ait_const_symbol : begin
-                       AsmWriteLn(#9#9'DD'#9'offset '+tai_const_symbol(hp).sym.name);
-                       if tai_const_symbol(hp).offset>0 then
-                         AsmWrite('+'+tostr(tai_const_symbol(hp).offset))
-                       else if tai_const_symbol(hp).offset<0 then
-                         AsmWrite(tostr(tai_const_symbol(hp).offset));
-                       AsmLn;
-                     end;
-     ait_const_rva : begin
-                       AsmWriteLn(#9#9'RVA'#9+tai_const_symbol(hp).sym.name);
-                     end;
+           ait_const_uleb128bit,
+           ait_const_sleb128bit,
+           ait_const_128bit,
+           ait_const_64bit,
+           ait_const_32bit,
+           ait_const_16bit,
+           ait_const_8bit,
+           ait_const_rva_symbol,
+           ait_const_indirect_symbol :
+             begin
+               AsmWrite(ait_const2str[hp.typ]);
+               consttyp:=hp.typ;
+               l:=0;
+               repeat
+                 if assigned(tai_const(hp).sym) then
+                   begin
+                     if assigned(tai_const(hp).endsym) then
+                       s:=tai_const(hp).endsym.name+'-'+tai_const(hp).sym.name
+                     else
+                       s:=tai_const(hp).sym.name;
+                     if tai_const(hp).value<>0 then
+                       s:=s+tostr_with_plus(tai_const(hp).value);
+                   end
+                 else
+                   s:=tostr(tai_const(hp).value);
+                 AsmWrite(s);
+                 if (l>line_length) or
+                    (hp.next=nil) or
+                    (tai(hp.next).typ<>consttyp) then
+                   break;
+                 hp:=tai(hp.next);
+                 AsmWrite(',');
+               until false;
+               AsmLn;
+             end;
+
         ait_real_32bit : AsmWriteLn(#9#9'DD'#9+single2str(tai_real_32bit(hp).value));
         ait_real_64bit : AsmWriteLn(#9#9'DQ'#9+double2str(tai_real_64bit(hp).value));
       ait_real_80bit : AsmWriteLn(#9#9'DT'#9+extended2str(tai_real_80bit(hp).value));
@@ -575,7 +592,7 @@ implementation
                           AsmWrite(tai_label(hp).l.name);
                           if assigned(hp.next) and not(tai(hp.next).typ in
                              [ait_const_32bit,ait_const_16bit,ait_const_8bit,
-                              ait_const_symbol,ait_const_rva,
+                              ait_const_rva_symbol,
                               ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then
                            AsmWriteLn(':')
                           else
@@ -592,7 +609,7 @@ implementation
                        AsmWrite(tai_symbol(hp).sym.name);
                        if assigned(hp.next) and not(tai(hp.next).typ in
                           [ait_const_32bit,ait_const_16bit,ait_const_8bit,
-                           ait_const_symbol,ait_const_rva,
+                           ait_const_rva_symbol,
                            ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then
                         AsmWriteLn(':')
                      end;
@@ -683,27 +700,25 @@ implementation
         ait_force_line,
 ait_stab_function_name : ;
 {$endif GDB}
-           ait_cut : begin
+           ait_cutobject : begin
                      { only reset buffer if nothing has changed }
                        if AsmSize=AsmStartSize then
                         AsmClear
                        else
                         begin
-                          if LasTSec<>sec_none then
-                           AsmWriteLn('_'+target_asm.secnames[LasTSec]+#9#9'ENDS');
+                          if LasTSecType<>sec_none then
+                           AsmWriteLn('_'+secnames[LasTSecType]+#9#9'ENDS');
                           AsmLn;
                           AsmWriteLn(#9'END');
                           AsmClose;
                           DoAssemble;
-                          AsmCreate(tai_cut(hp).place);
+                          AsmCreate(tai_cutobject(hp).place);
                         end;
                      { avoid empty files }
-                       while assigned(hp.next) and (tai(hp.next).typ in [ait_cut,ait_section,ait_comment]) do
+                       while assigned(hp.next) and (tai(hp.next).typ in [ait_cutobject,ait_section,ait_comment]) do
                         begin
                           if tai(hp.next).typ=ait_section then
-                           begin
-                             lasTSec:=tai_section(hp.next).sec;
-                           end;
+                            lasTSecType:=tai_section(hp.next).sectype;
                           hp:=tai(hp.next);
                         end;
                        AsmWriteLn(#9'.386p');
@@ -712,10 +727,10 @@ ait_stab_function_name : ;
                        { I was told that this isn't necesarry because }
                        { the labels generated by FPC are unique (FK)  }
                        { AsmWriteLn(#9'LOCALS '+target_asm.labelprefix); }
-                       if lasTSec<>sec_none then
-                          AsmWriteLn('_'+target_asm.secnames[lasTSec]+#9#9+
+                       if lasTSectype<>sec_none then
+                          AsmWriteLn('_'+secnames[lasTSectype]+#9#9+
                                      'SEGMENT'#9'PARA PUBLIC USE32 '''+
-                                     target_asm.secnames[lasTSec]+'''');
+                                     secnames[lasTSectype]+'''');
                        AsmStartSize:=AsmSize;
                      end;
            ait_marker :
@@ -782,7 +797,7 @@ ait_stab_function_name : ;
       if assigned(current_module.mainsource) then
        comment(v_info,'Start writing intel-styled assembler output for '+current_module.mainsource^);
 {$endif}
-      LasTSec:=sec_none;
+      LasTSecType:=sec_none;
       AsmWriteLn(#9'.386p');
       { masm 6.11 does not seem to like LOCALS PM }
       if (aktoutputformat = as_i386_tasm) then
@@ -827,16 +842,9 @@ ait_stab_function_name : ;
             asmbin : 'tasm';
             asmcmd : '/m2 /ml $ASM $OBJ';
             supported_target : system_any; { what should I write here ?? }
-            outputbinary: false;
-            allowdirect : true;
-            needar : true;
-            labelprefix_only_inside_procedure : true;
+            flags : [af_allowdirect,af_needar,af_labelprefix_only_inside_procedure];
             labelprefix : '@@';
             comment : '; ';
-            secnames : ('',
-              'CODE','DATA','BSS',
-              '','','','','','',
-              '','','')
           );
 
        as_i386_masm_info : tasminfo =
@@ -846,16 +854,9 @@ ait_stab_function_name : ;
             asmbin : 'masm';
             asmcmd : '/c /Cp $ASM /Fo$OBJ';
             supported_target : system_any; { what should I write here ?? }
-            outputbinary: false;
-            allowdirect : true;
-            needar : true;
-            labelprefix_only_inside_procedure : false;
+            flags : [af_allowdirect,af_needar];
             labelprefix : '@@';
             comment : '; ';
-            secnames : ('',
-              'CODE','DATA','BSS',
-              '','','','','','',
-              '','','')
           );
 
        as_i386_wasm_info : tasminfo =
@@ -865,16 +866,9 @@ ait_stab_function_name : ;
             asmbin : 'wasm';
             asmcmd : '$ASM -6s -fp6 -ms -zq -Fo=$OBJ';
             supported_target : system_any; { what should I write here ?? }
-            outputbinary: false;
-            allowdirect : true;
-            needar : true;
-            labelprefix_only_inside_procedure : false;
+            flags : [af_allowdirect,af_needar];
             labelprefix : '@@';
             comment : '; ';
-            secnames : ('',
-              'CODE','DATA','BSS',
-              '','','','','','',
-              '','','')
           );
 
 initialization
@@ -884,9 +878,31 @@ initialization
 end.
 {
   $Log$
-  Revision 1.48  2004-05-22 23:34:28  peter
+  Revision 1.49  2004-06-16 20:07:10  florian
+    * dwarf branch merged
+
+  Revision 1.48  2004/05/22 23:34:28  peter
   tai_regalloc.allocation changed to ratype to notify rgobj of register size changes
 
+  Revision 1.47.2.6  2004/05/01 16:02:10  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
+  Revision 1.47.2.5  2004/04/29 19:07:22  peter
+    * compile fixes
+
+  Revision 1.47.2.4  2004/04/12 19:34:46  peter
+    * basic framework for dwarf CFI
+
+  Revision 1.47.2.3  2004/04/12 14:45:11  peter
+    * tai_const_symbol and tai_const merged
+
+  Revision 1.47.2.2  2004/04/10 12:36:41  peter
+    * fixed alignment issues
+
+  Revision 1.47.2.1  2004/04/08 18:33:22  peter
+    * rewrite of TAsmSection
+
   Revision 1.47  2004/03/17 12:03:00  olle
     * bugfix for multiline string constants
 
@@ -1039,7 +1055,7 @@ end.
       the parast, detected by tcalcst3 test
 
   Revision 1.17  2002/04/15 19:12:09  carl
-  + target_info.size_of_pointer -> pointer_size
+  + target_info.size_of_pointer -> sizeof(aint)
   + some cleanup of unused types/variables
   * move several constants from cpubase to their specific units
     (where they are used)
@@ -1061,4 +1077,4 @@ end.
       with string operations
     * adapted some routines to use the new cg methods
 
-}
+}

compiler/i386/ag386nsm.pas

@@ -37,6 +37,7 @@ interface
         procedure WriteReference(var ref : treference);
         procedure WriteOper(const o:toper;s : topsize; opcode: tasmop;ops:longint;dest : boolean);
         procedure WriteOper_jmp(const o:toper; op : tasmop);
+        procedure WriteSection(atype:tasmsectiontype;const aname:string);
       public
         procedure WriteTree(p:taasmoutput);override;
         procedure WriteAsmList;override;
@@ -346,11 +347,38 @@ interface
 
 
     var
-      LasTSec : TSection;
+      LastSecType : TAsmSectionType;
 
     const
-      ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
-        (#9'DD'#9,#9'DW'#9,#9'DB'#9);
+      ait_const2str : array[ait_const_128bit..ait_const_indirect_symbol] of string[20]=(
+        #9'FIXME128',#9'FIXME64',#9'DD'#9,#9'DW'#9,#9'DB'#9,
+        #9'FIXMESLEB',#9'FIXEMEULEB',
+        #9'RVA'#9,#9'FIXMEINDIRECT'#9
+      );
+
+    procedure T386NasmAssembler.WriteSection(atype:tasmsectiontype;const aname:string);
+      const
+        secnames : array[tasmsectiontype] of string[12] = ('',
+          '.text','.data','.rodata','.bss',
+          'common',
+          '.note',
+          '.stab','.stabstr',
+          '.idata2','.idata4','.idata5','.idata6','.idata7','.edata',
+          '.eh_frame',
+          '.debug_frame'
+        );
+      begin
+        AsmLn;
+        AsmWrite('SECTION ');
+        AsmWrite(secnames[atype]);
+        if (atype<>sec_bss) and (aname<>'') then
+          begin
+            AsmWrite('.');
+            AsmWrite(aname);
+          end;
+        AsmLn;
+        LasTSecType:=atype;
+      end;
 
     procedure T386NasmAssembler.WriteTree(p:taasmoutput);
     const
@@ -460,19 +488,17 @@ interface
 
            ait_section :
              begin
-               if tai_section(hp).sec<>sec_none then
-                begin
-                  AsmLn;
-                  AsmWriteLn('SECTION '+target_asm.secnames[tai_section(hp).sec]);
-                end;
-               LasTSec:=tai_section(hp).sec;
+               if tai_section(hp).sectype<>sec_none then
+                 WriteSection(tai_section(hp).sectype,tai_section(hp).name^);
+               LasTSecType:=tai_section(hp).sectype;
              end;
 
            ait_align :
              begin
                { nasm gives warnings when it finds align in bss as it
                  wants to store data }
-               if lastsec<>sec_bss then
+               if (lastsectype<>sec_bss) and
+                  (tai_align(hp).aligntype>1) then
                  AsmWriteLn(#9'ALIGN '+tostr(tai_align(hp).aligntype));
              end;
 
@@ -487,43 +513,43 @@ interface
                AsmWriteLn('RESB'#9+tostr(tai_datablock(hp).size));
              end;
 
+           ait_const_uleb128bit,
+           ait_const_sleb128bit,
+           ait_const_128bit,
+           ait_const_64bit,
            ait_const_32bit,
            ait_const_16bit,
-           ait_const_8bit :
+           ait_const_8bit,
+           ait_const_rva_symbol,
+           ait_const_indirect_symbol :
              begin
-               AsmWrite(ait_const2str[hp.typ]+tostru(tai_const(hp).value));
+               AsmWrite(ait_const2str[hp.typ]);
                consttyp:=hp.typ;
                l:=0;
                repeat
-                 found:=(not (tai(hp.next)=nil)) and (tai(hp.next).typ=consttyp);
-                 if found then
-                  begin
-                    hp:=tai(hp.next);
-                    s:=','+tostru(tai_const(hp).value);
-                    AsmWrite(s);
-                    inc(l,length(s));
-                  end;
-               until (not found) or (l>line_length);
-               AsmLn;
-             end;
-
-           ait_const_symbol :
-             begin
-               AsmWrite(#9#9'DD'#9);
-               AsmWrite(tai_const_symbol(hp).sym.name);
-               if tai_const_symbol(hp).offset>0 then
-                 AsmWrite('+'+tostr(tai_const_symbol(hp).offset))
-               else if tai_const_symbol(hp).offset<0 then
-                 AsmWrite(tostr(tai_const_symbol(hp).offset));
+                 if assigned(tai_const(hp).sym) then
+                   begin
+                     if assigned(tai_const(hp).endsym) then
+                       s:=tai_const(hp).endsym.name+'-'+tai_const(hp).sym.name
+                     else
+                       s:=tai_const(hp).sym.name;
+                     if tai_const(hp).value<>0 then
+                       s:=s+tostr_with_plus(tai_const(hp).value);
+                   end
+                 else
+                   s:=tostr(tai_const(hp).value);
+                 AsmWrite(s);
+                 inc(l,length(s));
+                 if (l>line_length) or
+                    (hp.next=nil) or
+                    (tai(hp.next).typ<>consttyp) then
+                   break;
+                 hp:=tai(hp.next);
+                 AsmWrite(',');
+               until false;
                AsmLn;
              end;
 
-           ait_const_rva :
-             begin
-               AsmWrite(#9#9'RVA'#9);
-               AsmWriteLn(tai_const_symbol(hp).sym.name);
-             end;
-
            ait_real_32bit :
              AsmWriteLn(#9#9'DD'#9+single2str(tai_real_32bit(hp).value));
 
@@ -635,7 +661,7 @@ interface
                AsmWrite(tai_symbol(hp).sym.name);
                if assigned(hp.next) and not(tai(hp.next).typ in
                   [ait_const_32bit,ait_const_16bit,ait_const_8bit,
-                   ait_const_symbol,ait_const_rva,
+                   ait_const_rva_symbol,
                    ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then
                 AsmWriteLn(':')
              end;
@@ -701,7 +727,7 @@ interface
            ait_stab_function_name : ;
 {$endif GDB}
 
-           ait_cut :
+           ait_cutobject :
              begin
              { only reset buffer if nothing has changed }
                if AsmSize=AsmStartSize then
@@ -710,17 +736,17 @@ interface
                 begin
                   AsmClose;
                   DoAssemble;
-                  AsmCreate(tai_cut(hp).place);
+                  AsmCreate(tai_cutobject(hp).place);
                 end;
              { avoid empty files }
-               while assigned(hp.next) and (tai(hp.next).typ in [ait_cut,ait_section,ait_comment]) do
+               while assigned(hp.next) and (tai(hp.next).typ in [ait_cutobject,ait_section,ait_comment]) do
                 begin
                   if tai(hp.next).typ=ait_section then
-                    lasTSec:=tai_section(hp.next).sec;
+                    lasTSectype:=tai_section(hp.next).sectype;
                   hp:=tai(hp.next);
                 end;
-               if lasTSec<>sec_none then
-                 AsmWriteLn('SECTION '+target_asm.secnames[lasTSec]);
+               if lasTSectype<>sec_none then
+                 WriteSection(tai_section(hp).sectype,tai_section(hp).name^);
                AsmStartSize:=AsmSize;
              end;
 
@@ -760,7 +786,7 @@ interface
       if assigned(current_module.mainsource) then
        comment(v_info,'Start writing nasm-styled assembler output for '+current_module.mainsource^);
 {$endif}
-      LasTSec:=sec_none;
+      LasTSecType:=sec_none;
       AsmWriteLn('BITS 32');
       AsmLn;
 
@@ -782,7 +808,7 @@ interface
       Writetree(importssection);
       { exports are written by DLLTOOL
         if we use it so don't insert it twice (PM) }
-      if not UseDeffileForExport and assigned(exportssection) then
+      if not UseDeffileForExports and assigned(exportssection) then
         Writetree(exportssection);
       Writetree(resourcesection);
 
@@ -806,16 +832,9 @@ interface
             asmbin : 'nasm';
             asmcmd : '-f coff -o $OBJ $ASM';
             supported_target : system_i386_go32v2;
-            outputbinary: false;
-            allowdirect : true;
-            needar : true;
-            labelprefix_only_inside_procedure: false;
+            flags : [af_allowdirect,af_needar];
             labelprefix : '..@';
             comment : '; ';
-            secnames : ('',
-              '.text','.data','.bss',
-              '.idata2','.idata4','.idata5','.idata6','.idata7','.edata',
-              '.stab','.stabstr','')
           );
 
        as_i386_nasmwin32_info : tasminfo =
@@ -825,16 +844,9 @@ interface
             asmbin : 'nasm';
             asmcmd : '-f win32 -o $OBJ $ASM';
             supported_target : system_i386_win32;
-            outputbinary: false;
-            allowdirect : true;
-            needar : true;
-            labelprefix_only_inside_procedure: false;
+            flags : [af_allowdirect,af_needar];
             labelprefix : '..@';
             comment : '; ';
-            secnames : ('',
-              '.text','.data','.bss',
-              '.idata2','.idata4','.idata5','.idata6','.idata7','.edata',
-              '.stab','.stabstr','')
           );
 
        as_i386_nasmobj_info : tasminfo =
@@ -844,16 +856,9 @@ interface
             asmbin : 'nasm';
             asmcmd : '-f obj -o $OBJ $ASM';
             supported_target : system_any; { what should I write here ?? }
-            outputbinary: false;
-            allowdirect : true;
-            needar : true;
-            labelprefix_only_inside_procedure: false;
+            flags : [af_allowdirect,af_needar];
             labelprefix : '..@';
             comment : '; ';
-            secnames : ('',
-              '.text','.data','.bss',
-              '.idata2','.idata4','.idata5','.idata6','.idata7','.edata',
-              '.stab','.stabstr','')
           );
 
        as_i386_nasmwdosx_info : tasminfo =
@@ -863,16 +868,9 @@ interface
             asmbin : 'nasm';
             asmcmd : '-f win32 -o $OBJ $ASM';
             supported_target : system_i386_wdosx;
-            outputbinary: false;
-            allowdirect : true;
-            needar : true;
-            labelprefix_only_inside_procedure: false;
+            flags : [af_allowdirect,af_needar];
             labelprefix : '..@';
             comment : '; ';
-            secnames : ('',
-              '.text','.data','.bss',
-              '.idata2','.idata4','.idata5','.idata6','.idata7','.edata',
-              '.stab','.stabstr','')
           );
 
 
@@ -883,16 +881,9 @@ interface
             asmbin : 'nasm';
             asmcmd : '-f elf -o $OBJ $ASM';
             supported_target : system_i386_linux;
-            outputbinary: false;
-            allowdirect : true;
-            needar : true;
-            labelprefix_only_inside_procedure: false;
+            flags : [af_allowdirect,af_needar];
             labelprefix : '..@';
             comment : '; ';
-            secnames : ('',
-              '.text','.data','.bss',
-              '.idata2','.idata4','.idata5','.idata6','.idata7','.edata',
-              '.stab','.stabstr','')
           );
 
        as_i386_nasmbeos_info : tasminfo =
@@ -902,16 +893,9 @@ interface
             asmbin : 'nasm';
             asmcmd : '-f elf -o $OBJ $ASM';
             supported_target : system_i386_beos;
-            outputbinary: false;
-            allowdirect : true;
-            needar : true;
-            labelprefix_only_inside_procedure: false;
+            flags : [af_allowdirect,af_needar];
             labelprefix : '..@';
             comment : '; ';
-            secnames : ('',
-              '.text','.data','.bss',
-              '.idata2','.idata4','.idata5','.idata6','.idata7','.edata',
-              '.stab','.stabstr','')
           );
 
 
@@ -925,9 +909,34 @@ initialization
 end.
 {
   $Log$
-  Revision 1.45  2004-05-22 23:34:28  peter
+  Revision 1.46  2004-06-16 20:07:10  florian
+    * dwarf branch merged
+
+  Revision 1.45  2004/05/22 23:34:28  peter
   tai_regalloc.allocation changed to ratype to notify rgobj of register size changes
 
+  Revision 1.44.2.7  2004/05/03 14:59:58  peter
+    * no dlltool needed for win32 linking executables
+
+  Revision 1.44.2.6  2004/05/01 16:02:10  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
+  Revision 1.44.2.5  2004/04/29 19:07:22  peter
+    * compile fixes
+
+  Revision 1.44.2.4  2004/04/12 19:34:46  peter
+    * basic framework for dwarf CFI
+
+  Revision 1.44.2.3  2004/04/12 14:45:11  peter
+    * tai_const_symbol and tai_const merged
+
+  Revision 1.44.2.2  2004/04/10 12:36:41  peter
+    * fixed alignment issues
+
+  Revision 1.44.2.1  2004/04/08 18:33:22  peter
+    * rewrite of TAsmSection
+
   Revision 1.44  2004/02/27 10:21:05  florian
     * top_symbol killed
     + refaddr to treference added
@@ -1072,7 +1081,7 @@ end.
       the parast, detected by tcalcst3 test
 
   Revision 1.16  2002/04/15 19:12:09  carl
-  + target_info.size_of_pointer -> pointer_size
+  + target_info.size_of_pointer -> sizeof(aint)
   + some cleanup of unused types/variables
   * move several constants from cpubase to their specific units
     (where they are used)
@@ -1096,4 +1105,4 @@ end.
       with string operations
     * adapted some routines to use the new cg methods
 
-}
+}

compiler/i386/cgcpu.pas

@@ -29,6 +29,7 @@ unit cgcpu;
   interface
 
     uses
+       globtype,
        cgbase,cgobj,cg64f32,cgx86,
        aasmbase,aasmtai,aasmcpu,
        cpubase,cpuinfo,
@@ -41,17 +42,27 @@ unit cgcpu;
     type
       tcg386 = class(tcgx86)
         procedure init_register_allocators;override;
-        class function reg_cgsize(const reg: tregister): tcgsize; override;
+        { passing parameter using push instead of mov }
+        procedure a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;const locpara : tparalocation);override;
+        procedure a_param_const(list : taasmoutput;size : tcgsize;a : aint;const locpara : tparalocation);override;
+        procedure a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const locpara : tparalocation);override;
+        procedure a_paramaddr_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);override;
+
         procedure g_save_all_registers(list : taasmoutput);override;
         procedure g_restore_all_registers(list : taasmoutput;const funcretparaloc:tparalocation);override;
-        procedure g_copyvaluepara_openarray(list : taasmoutput;const ref, lenref:treference;elesize:aword);override;
+        procedure g_proc_exit(list : taasmoutput;parasize:longint;nostackframe:boolean);override;
+        procedure g_copyvaluepara_openarray(list : taasmoutput;const ref, lenref:treference;elesize:aint);override;
+
+        procedure g_exception_reason_save(list : taasmoutput; const href : treference);override;
+        procedure g_exception_reason_save_const(list : taasmoutput; const href : treference; a: aint);override;
+        procedure g_exception_reason_load(list : taasmoutput; const href : treference);override;
      end;
 
       tcg64f386 = class(tcg64f32)
         procedure a_op64_ref_reg(list : taasmoutput;op:TOpCG;const ref : treference;reg : tregister64);override;
         procedure a_op64_reg_reg(list : taasmoutput;op:TOpCG;regsrc,regdst : tregister64);override;
-        procedure a_op64_const_reg(list : taasmoutput;op:TOpCG;value : qword;reg : tregister64);override;
-        procedure a_op64_const_ref(list : taasmoutput;op:TOpCG;value : qword;const ref : treference);override;
+        procedure a_op64_const_reg(list : taasmoutput;op:TOpCG;value : int64;reg : tregister64);override;
+        procedure a_op64_const_ref(list : taasmoutput;op:TOpCG;value : int64;const ref : treference);override;
       private
         procedure get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp);
       end;
@@ -59,7 +70,7 @@ unit cgcpu;
   implementation
 
     uses
-       globtype,globals,verbose,systems,cutils,
+       globals,verbose,systems,cutils,
        symdef,symsym,defutil,paramgr,procinfo,
        rgcpu,rgx86,tgobj,
        cgutils;
@@ -77,47 +88,109 @@ unit cgcpu;
       end;
 
 
-    class function tcg386.reg_cgsize(const reg: tregister): tcgsize;
-
-    const subreg2cgsize:array[Tsubregister] of Tcgsize =
-          (OS_NO,OS_8,OS_8,OS_16,OS_32,OS_64,OS_NO,OS_NO);
-
-    begin
-      case getregtype(reg) of
-        R_INTREGISTER :
-          reg_cgsize:=subreg2cgsize[getsubreg(reg)];
-        R_FPUREGISTER :
-          reg_cgsize:=OS_F80;
-        R_MMXREGISTER,
-        R_MMREGISTER :
-          reg_cgsize:=OS_M64;
-        R_SPECIALREGISTER :
-          case reg of
-            NR_CS,NR_DS,NR_ES,NR_SS,NR_FS,NR_GS:
-              reg_cgsize:=OS_16
-            else
-              reg_cgsize:=OS_32
-          end
-        else
-            internalerror(200303181);
-        end;
+    procedure tcg386.a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;const locpara : tparalocation);
+      var
+        pushsize : tcgsize;
+      begin
+        check_register_size(size,r);
+        with locpara do
+          if (loc=LOC_REFERENCE) and
+             (reference.index=NR_STACK_POINTER_REG) then
+            begin
+              pushsize:=int_cgsize(alignment);
+              list.concat(taicpu.op_reg(A_PUSH,tcgsize2opsize[pushsize],makeregsize(list,r,pushsize)));
+            end
+          else
+            inherited a_param_reg(list,size,r,locpara);
+      end;
+
+
+    procedure tcg386.a_param_const(list : taasmoutput;size : tcgsize;a : aint;const locpara : tparalocation);
+      var
+        pushsize : tcgsize;
+      begin
+        with locpara do
+          if (loc=LOC_REFERENCE) and
+             (reference.index=NR_STACK_POINTER_REG) then
+            begin
+              pushsize:=int_cgsize(alignment);
+              list.concat(taicpu.op_const(A_PUSH,tcgsize2opsize[pushsize],a));
+            end
+          else
+            inherited a_param_const(list,size,a,locpara);
+      end;
+
+
+    procedure tcg386.a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;const locpara : tparalocation);
+      var
+        pushsize : tcgsize;
+        tmpreg : tregister;
+      begin
+        with locpara do
+          if (loc=LOC_REFERENCE) and
+             (reference.index=NR_STACK_POINTER_REG) then
+            begin
+              pushsize:=int_cgsize(alignment);
+              if tcgsize2size[size]<alignment then
+                begin
+                  tmpreg:=getintregister(list,pushsize);
+                  a_load_ref_reg(list,size,pushsize,r,tmpreg);
+                  list.concat(taicpu.op_reg(A_PUSH,TCgsize2opsize[pushsize],tmpreg));
+                  ungetregister(list,tmpreg);
+                end
+              else
+                list.concat(taicpu.op_ref(A_PUSH,TCgsize2opsize[pushsize],r));
+            end
+          else
+            inherited a_param_ref(list,size,r,locpara);
       end;
 
-{      const
-        opsize_2_cgsize: array[topsize] of tcgsize = (OS_NO,
-          OS_8,OS_16,OS_32,OS_NO,OS_NO,OS_NO,
-          OS_32,OS_64,OS_64,
-          OS_F32,OS_F64,OS_F80,OS_F32,OS_F64,OS_M64,OS_NO,
-          OS_NO,OS_NO,OS_NO
-        );
+
+    procedure tcg386.a_paramaddr_ref(list : taasmoutput;const r : treference;const locpara : tparalocation);
+      var
+        tmpreg : tregister;
+        opsize : topsize;
       begin
-        result := opsize_2_cgsize[reg2opsize(reg)];
-      end;}
+        with r do
+          begin
+            if (segment<>NR_NO) then
+              cgmessage(cg_e_cant_use_far_pointer_there);
+            with locpara do
+              if (locpara.loc=LOC_REFERENCE) and
+                 (locpara.reference.index=NR_STACK_POINTER_REG) then
+                begin
+                  opsize:=tcgsize2opsize[OS_ADDR];
+                  if (base=NR_NO) and (index=NR_NO) then
+                    begin
+                      if assigned(symbol) then
+                        list.concat(Taicpu.Op_sym_ofs(A_PUSH,opsize,symbol,offset))
+                      else
+                        list.concat(Taicpu.Op_const(A_PUSH,opsize,offset));
+                    end
+                  else if (base=NR_NO) and (index<>NR_NO) and
+                          (offset=0) and (scalefactor=0) and (symbol=nil) then
+                    list.concat(Taicpu.Op_reg(A_PUSH,opsize,index))
+                  else if (base<>NR_NO) and (index=NR_NO) and
+                          (offset=0) and (symbol=nil) then
+                    list.concat(Taicpu.Op_reg(A_PUSH,opsize,base))
+                  else
+                    begin
+                      tmpreg:=getaddressregister(list);
+                      a_loadaddr_ref_reg(list,r,tmpreg);
+                      ungetregister(list,tmpreg);
+                      list.concat(taicpu.op_reg(A_PUSH,opsize,tmpreg));
+                    end;
+                end
+              else
+                inherited a_paramaddr_ref(list,r,locpara);
+        end;
+      end;
+
 
     procedure tcg386.g_save_all_registers(list : taasmoutput);
       begin
         list.concat(Taicpu.Op_none(A_PUSHA,S_L));
-        tg.GetTemp(list,POINTER_SIZE,tt_noreuse,current_procinfo.save_regs_ref);
+        tg.GetTemp(list,sizeof(aint),tt_noreuse,current_procinfo.save_regs_ref);
         a_load_reg_ref(list,OS_ADDR,OS_ADDR,NR_STACK_POINTER_REG,current_procinfo.save_regs_ref);
       end;
 
@@ -148,7 +221,81 @@ unit cgcpu;
         list.concat(taicpu.op_none(A_NOP,S_L));
       end;
 
-    procedure tcg386.g_copyvaluepara_openarray(list : taasmoutput;const ref, lenref:treference;elesize:aword);
+
+    procedure tcg386.g_proc_exit(list : taasmoutput;parasize:longint;nostackframe:boolean);
+      var
+        stacksize : longint;
+      begin
+        { Release PIC register }
+        if cs_create_pic in aktmoduleswitches then
+          list.concat(tai_regalloc.dealloc(NR_PIC_OFFSET_REG));
+
+        { MMX needs to call EMMS }
+        if assigned(rg[R_MMXREGISTER]) and
+           (rg[R_MMXREGISTER].uses_registers) then
+          list.concat(Taicpu.op_none(A_EMMS,S_NO));
+
+        { remove stackframe }
+        if not nostackframe then
+          begin
+            if (current_procinfo.framepointer=NR_STACK_POINTER_REG) then
+              begin
+                stacksize:=current_procinfo.calc_stackframe_size;
+                if (stacksize<>0) then
+                  cg.a_op_const_reg(list,OP_ADD,OS_ADDR,stacksize,current_procinfo.framepointer);
+              end
+            else
+              list.concat(Taicpu.op_none(A_LEAVE,S_NO));
+            list.concat(tai_regalloc.dealloc(NR_FRAME_POINTER_REG));
+          end;
+
+        { return from proc }
+        if (po_interrupt in current_procinfo.procdef.procoptions) then
+          begin
+            if current_procinfo.procdef.funcret_paraloc[calleeside].loc=LOC_REGISTER then
+              list.concat(Taicpu.Op_const_reg(A_ADD,S_L,4,NR_ESP))
+            else
+              list.concat(Taicpu.Op_reg(A_POP,S_L,NR_EAX));
+            list.concat(Taicpu.Op_reg(A_POP,S_L,NR_EBX));
+            list.concat(Taicpu.Op_reg(A_POP,S_L,NR_ECX));
+            if current_procinfo.procdef.funcret_paraloc[calleeside].lochigh=LOC_REGISTER then
+              list.concat(Taicpu.Op_const_reg(A_ADD,S_L,4,NR_ESP))
+            else
+              list.concat(Taicpu.Op_reg(A_POP,S_L,NR_EDX));
+            list.concat(Taicpu.Op_reg(A_POP,S_L,NR_ESI));
+            list.concat(Taicpu.Op_reg(A_POP,S_L,NR_EDI));
+            { .... also the segment registers }
+            list.concat(Taicpu.Op_reg(A_POP,S_W,NR_DS));
+            list.concat(Taicpu.Op_reg(A_POP,S_W,NR_ES));
+            list.concat(Taicpu.Op_reg(A_POP,S_W,NR_FS));
+            list.concat(Taicpu.Op_reg(A_POP,S_W,NR_GS));
+            { this restores the flags }
+            list.concat(Taicpu.Op_none(A_IRET,S_NO));
+          end
+        { Routines with the poclearstack flag set use only a ret }
+        else if current_procinfo.procdef.proccalloption in clearstack_pocalls then
+         begin
+           { complex return values are removed from stack in C code PM }
+           if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,
+                                       current_procinfo.procdef.proccalloption) then
+             list.concat(Taicpu.Op_const(A_RET,S_NO,sizeof(aint)))
+           else
+             list.concat(Taicpu.Op_none(A_RET,S_NO));
+         end
+        { ... also routines with parasize=0 }
+        else if (parasize=0) then
+         list.concat(Taicpu.Op_none(A_RET,S_NO))
+        else
+         begin
+           { parameters are limited to 65535 bytes because ret allows only imm16 }
+           if (parasize>65535) then
+             CGMessage(cg_e_parasize_too_big);
+           list.concat(Taicpu.Op_const(A_RET,S_NO,parasize));
+         end;
+      end;
+
+
+    procedure tcg386.g_copyvaluepara_openarray(list : taasmoutput;const ref, lenref:treference;elesize:aint);
       var
         power,len  : longint;
         opsize : topsize;
@@ -202,7 +349,7 @@ unit cgcpu;
 {$endif __NOWINPECOFF__}
           list.concat(Taicpu.op_reg_reg(A_SUB,S_L,NR_EDI,NR_ESP));
         { align stack on 4 bytes }
-        list.concat(Taicpu.op_const_reg(A_AND,S_L,$fffffff4,NR_ESP));
+        list.concat(Taicpu.op_const_reg(A_AND,S_L,aint($fffffff4),NR_ESP));
         { load destination }
         a_load_reg_reg(list,OS_INT,OS_INT,NR_ESP,NR_EDI);
 
@@ -253,6 +400,22 @@ unit cgcpu;
       end;
 
 
+    procedure tcg386.g_exception_reason_save(list : taasmoutput; const href : treference);
+      begin
+        list.concat(Taicpu.op_reg(A_PUSH,tcgsize2opsize[OS_INT],NR_FUNCTION_RESULT_REG));
+      end;
+
+
+    procedure tcg386.g_exception_reason_save_const(list : taasmoutput;const href : treference; a: aint);
+      begin
+        list.concat(Taicpu.op_const(A_PUSH,tcgsize2opsize[OS_INT],a));
+      end;
+
+
+    procedure tcg386.g_exception_reason_load(list : taasmoutput; const href : treference);
+      begin
+        list.concat(Taicpu.op_reg(A_POP,tcgsize2opsize[OS_INT],NR_FUNCTION_RESULT_REG));
+      end;
 
 
 { ************* 64bit operations ************ }
@@ -315,7 +478,7 @@ unit cgcpu;
                 a_load64_reg_reg(list,regsrc,regdst);
               list.concat(taicpu.op_reg(A_NOT,S_L,regdst.reghi));
               list.concat(taicpu.op_reg(A_NEG,S_L,regdst.reglo));
-              list.concat(taicpu.op_const_reg(A_SBB,S_L,aword(-1),regdst.reghi));
+              list.concat(taicpu.op_const_reg(A_SBB,S_L,-1,regdst.reghi));
               exit;
             end;
           OP_NOT :
@@ -333,22 +496,22 @@ unit cgcpu;
       end;
 
 
-    procedure tcg64f386.a_op64_const_reg(list : taasmoutput;op:TOpCG;value : qword;reg : tregister64);
+    procedure tcg64f386.a_op64_const_reg(list : taasmoutput;op:TOpCG;value : int64;reg : tregister64);
       var
         op1,op2 : TAsmOp;
       begin
         case op of
           OP_AND,OP_OR,OP_XOR:
             begin
-              cg.a_op_const_reg(list,op,OS_32,lo(value),reg.reglo);
-              cg.a_op_const_reg(list,op,OS_32,hi(value),reg.reghi);
+              cg.a_op_const_reg(list,op,OS_32,aint(lo(value)),reg.reglo);
+              cg.a_op_const_reg(list,op,OS_32,aint(hi(value)),reg.reghi);
             end;
           OP_ADD, OP_SUB:
             begin
               // can't use a_op_const_ref because this may use dec/inc
               get_64bit_ops(op,op1,op2);
-              list.concat(taicpu.op_const_reg(op1,S_L,lo(value),reg.reglo));
-              list.concat(taicpu.op_const_reg(op2,S_L,hi(value),reg.reghi));
+              list.concat(taicpu.op_const_reg(op1,S_L,aint(lo(value)),reg.reglo));
+              list.concat(taicpu.op_const_reg(op2,S_L,aint(hi(value)),reg.reghi));
             end;
           else
             internalerror(200204021);
@@ -356,7 +519,7 @@ unit cgcpu;
       end;
 
 
-    procedure tcg64f386.a_op64_const_ref(list : taasmoutput;op:TOpCG;value : qword;const ref : treference);
+    procedure tcg64f386.a_op64_const_ref(list : taasmoutput;op:TOpCG;value : int64;const ref : treference);
       var
         op1,op2 : TAsmOp;
         tempref : treference;
@@ -389,9 +552,41 @@ begin
 end.
 {
   $Log$
-  Revision 1.48  2004-04-09 14:36:05  peter
+  Revision 1.49  2004-06-16 20:07:10  florian
+    * dwarf branch merged
+
+  Revision 1.48  2004/04/09 14:36:05  peter
     * A_MOVSL renamed to A_MOVSD
 
+  Revision 1.47.2.9  2004/05/30 10:45:50  peter
+    * merged fixes from main branch
+
+  Revision 1.47.2.8  2004/05/02 21:34:01  florian
+    * i386 compilation fixed
+
+  Revision 1.47.2.7  2004/05/02 12:45:32  peter
+    * enabled cpuhasfixedstack for x86-64 again
+    * fixed size of temp allocation for parameters
+
+  Revision 1.47.2.6  2004/05/01 16:02:10  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
+  Revision 1.47.2.5  2004/04/29 23:30:28  peter
+    * fix i386 compiler
+
+  Revision 1.47.2.4  2004/04/29 19:07:22  peter
+    * compile fixes
+
+  Revision 1.47.2.3  2004/04/24 20:13:24  florian
+    * fixed x86-64 exception handling
+
+  Revision 1.47.2.2  2004/04/24 18:30:11  florian
+    * extended parameters shouldn't be poped by the callee on x86-64 either
+
+  Revision 1.47.2.1  2004/04/08 18:33:22  peter
+    * rewrite of TAsmSection
+
   Revision 1.47  2004/02/27 10:21:05  florian
     * top_symbol killed
     + refaddr to treference added

compiler/i386/cpubase.inc

@@ -111,6 +111,8 @@
       {# Frame pointer register }
       RS_FRAME_POINTER_REG = RS_EBP;
       NR_FRAME_POINTER_REG = NR_EBP;
+      { Return address for DWARF }
+      NR_RETURN_ADDRESS_REG = NR_EIP;
       {# Register for addressing absolute data in a position independant way,
          such as in PIC code. The exact meaning is ABI specific. For
          further information look at GCC source : PIC_OFFSET_TABLE_REGNUM
@@ -167,7 +169,13 @@
 
 {
   $Log$
-  Revision 1.12  2004-02-05 18:28:37  peter
+  Revision 1.13  2004-06-16 20:07:10  florian
+    * dwarf branch merged
+
+  Revision 1.12.2.1  2004/04/20 16:35:58  peter
+    * generate dwarf for stackframe entry
+
+  Revision 1.12  2004/02/05 18:28:37  peter
     * x86_64 fixes for opsize
 
   Revision 1.11  2004/01/14 23:39:05  florian

compiler/i386/cpuinfo.pas

@@ -1,6 +1,6 @@
 {
     $Id$
-    Copyright (c) 1998-2002 by Florian Klaempfl
+    Copyright (c) 1998-2004 by Florian Klaempfl
 
     Basic Processor information
 
@@ -30,18 +30,6 @@ Interface
     globtype;
 
 Type
-   { Natural integer register type and size for the target machine }
-   AWord = longword;
-   AInt = longint;
-   PAWord = ^AWord;
-
-   { This must be an ordinal type with the same size as a pointer
-     Note: Must be unsigned! Otherwise, ugly code like
-     pointer(-1) will result in a pointer with the value
-     $fffffffffffffff on a 32bit machine if the compiler uses
-     int64 constants internally (JM)                              }
-   TConstPtrUInt = longword;
-
    bestreal = extended;
    ts32real = single;
    ts64real = double;
@@ -73,8 +61,6 @@ Type
 Const
    {# Size of native extended floating point type }
    extended_size = 10;
-   {# Size of a pointer                           }
-   pointer_size  = 4;
    {# Size of a multimedia register               }
    mmreg_size = 8;
 
@@ -124,9 +110,19 @@ Implementation
 end.
 {
   $Log$
-  Revision 1.24  2004-04-28 15:19:03  florian
+  Revision 1.25  2004-06-16 20:07:10  florian
+    * dwarf branch merged
+
+  Revision 1.24  2004/04/28 15:19:03  florian
     + syscall directive support for MorphOS added
 
+  Revision 1.23.2.2  2004/05/01 16:02:10  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
+  Revision 1.23.2.1  2004/04/26 21:00:37  peter
+    * AInt fixed, PAInt added
+
   Revision 1.23  2004/02/27 10:21:05  florian
     * top_symbol killed
     + refaddr to treference added
@@ -227,4 +223,4 @@ end.
       with string operations
     * adapted some routines to use the new cg methods
 
-}
+}

compiler/i386/cpupara.pas

@@ -207,14 +207,14 @@ unit cpupara;
                begin
                  result.loc:=LOC_REFERENCE;
                  result.reference.index:=NR_STACK_POINTER_REG;
-                 result.reference.offset:=POINTER_SIZE*nr;
+                 result.reference.offset:=sizeof(aint)*nr;
                end;
            end
          else
            begin
              result.loc:=LOC_REFERENCE;
              result.reference.index:=NR_STACK_POINTER_REG;
-             result.reference.offset:=POINTER_SIZE*nr;
+             result.reference.offset:=sizeof(aint)*nr;
            end;
       end;
 
@@ -225,34 +225,37 @@ unit cpupara;
       begin
         { Function return }
         fillchar(paraloc,sizeof(tparalocation),0);
-        paraloc.size:=def_cgsize(p.rettype.def);
-        paraloc.lochigh:=LOC_INVALID;
-        { Return in FPU register? }
-        if p.rettype.def.deftype=floatdef then
-          begin
-            paraloc.loc:=LOC_FPUREGISTER;
-            paraloc.register:=NR_FPU_RESULT_REG;
-          end
+        if (p.proctypeoption=potype_constructor) then
+          paraloc.size:=OS_ADDR
         else
-         { Return in register? }
-         if not ret_in_param(p.rettype.def,p.proccalloption) then
+          paraloc.size:=def_cgsize(p.rettype.def);
+        paraloc.lochigh:=LOC_INVALID;
+        if paraloc.size<>OS_NO then
           begin
-            paraloc.loc:=LOC_REGISTER;
-{$ifndef cpu64bit}
-            if paraloc.size in [OS_64,OS_S64] then
-             begin
-               paraloc.register64.reglo:=NR_FUNCTION_RETURN64_LOW_REG;
-               paraloc.register64.reghi:=NR_FUNCTION_RETURN64_HIGH_REG;
-             end
+            { Return in FPU register? }
+            if p.rettype.def.deftype=floatdef then
+              begin
+                paraloc.loc:=LOC_FPUREGISTER;
+                paraloc.register:=NR_FPU_RESULT_REG;
+              end
             else
-{$endif cpu64bit}
-             begin
-               paraloc.register:=NR_FUNCTION_RETURN_REG;
-             end;
-          end
-        else
-          begin
-            paraloc.loc:=LOC_REFERENCE;
+             { Return in register? }
+             if not ret_in_param(p.rettype.def,p.proccalloption) then
+              begin
+                paraloc.loc:=LOC_REGISTER;
+                if paraloc.size in [OS_64,OS_S64] then
+                  begin
+                    paraloc.lochigh:=LOC_REGISTER;
+                    paraloc.register64.reglo:=NR_FUNCTION_RETURN64_LOW_REG;
+                    paraloc.register64.reghi:=NR_FUNCTION_RETURN64_HIGH_REG;
+                  end
+                else
+                  paraloc.register:=newreg(R_INTREGISTER,RS_FUNCTION_RETURN_REG,cgsize2subreg(paraloc.size));
+              end
+            else
+              begin
+                paraloc.loc:=LOC_REFERENCE;
+              end;
           end;
         p.funcret_paraloc[side]:=paraloc;
       end;
@@ -494,7 +497,21 @@ begin
 end.
 {
   $Log$
-  Revision 1.50  2004-02-09 22:14:17  peter
+  Revision 1.51  2004-06-16 20:07:10  florian
+    * dwarf branch merged
+
+  Revision 1.50.2.3  2004/05/02 21:37:35  florian
+    * setting of func. ret. for i386 fixed
+
+  Revision 1.50.2.2  2004/05/02 12:45:32  peter
+    * enabled cpuhasfixedstack for x86-64 again
+    * fixed size of temp allocation for parameters
+
+  Revision 1.50.2.1  2004/05/01 16:02:10  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
+  Revision 1.50  2004/02/09 22:14:17  peter
     * more x86_64 parameter fixes
     * tparalocation.lochigh is now used to indicate if registerhigh
       is used and what the type is

compiler/i386/csopt386.pas

@@ -1386,7 +1386,7 @@ begin
 end;
 
 
-function FindRegWithConst(p: tai; size: topsize; l: aword; var Res: TRegister): Boolean;
+function FindRegWithConst(p: tai; size: topsize; l: aint; var Res: TRegister): Boolean;
 {Finds a register which contains the constant l}
 var
   Counter: tsuperregister;
@@ -2115,7 +2115,17 @@ end.
 
 {
   $Log$
-  Revision 1.61  2004-02-27 10:21:05  florian
+  Revision 1.62  2004-06-16 20:07:10  florian
+    * dwarf branch merged
+
+  Revision 1.61.2.2  2004/05/01 16:02:10  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
+  Revision 1.61.2.1  2004/04/29 23:30:28  peter
+    * fix i386 compiler
+
+  Revision 1.61  2004/02/27 10:21:05  florian
     * top_symbol killed
     + refaddr to treference added
     + refsymbol to treference added
@@ -2261,7 +2271,7 @@ end.
     * fixed default stacksize of linux and go32v2, 8kb was a bit small :-)
 
   Revision 1.29  2002/04/15 19:12:09  carl
-  + target_info.size_of_pointer -> pointer_size
+  + target_info.size_of_pointer -> sizeof(aint)
   + some cleanup of unused types/variables
   * move several constants from cpubase to their specific units
     (where they are used)

compiler/i386/n386add.pas

@@ -425,9 +425,9 @@ interface
                end;
              LOC_CONSTANT :
                begin
-                 exprasmlist.concat(taicpu.op_const_reg(A_CMP,S_L,aword(hi(right.location.valueqword)),left.location.registerhigh));
+                 exprasmlist.concat(taicpu.op_const_reg(A_CMP,S_L,aint(hi(right.location.value64)),left.location.registerhigh));
                  firstjmp64bitcmp;
-                 exprasmlist.concat(taicpu.op_const_reg(A_CMP,S_L,aword(lo(right.location.valueqword)),left.location.registerlow));
+                 exprasmlist.concat(taicpu.op_const_reg(A_CMP,S_L,aint(lo(right.location.value64)),left.location.registerlow));
                  secondjmp64bitcmp;
                end;
              else
@@ -687,9 +687,15 @@ begin
 end.
 {
   $Log$
-  Revision 1.96  2004-05-19 23:30:18  peter
+  Revision 1.97  2004-06-16 20:07:10  florian
+    * dwarf branch merged
+
+  Revision 1.96  2004/05/19 23:30:18  peter
     * extra typecast to prevent range check
 
+  Revision 1.95.2.1  2004/04/29 19:07:22  peter
+    * compile fixes
+
   Revision 1.95  2004/02/04 19:22:27  peter
   *** empty log message ***
 

compiler/i386/n386cal.pas

@@ -34,7 +34,6 @@ interface
     type
        ti386callnode = class(tcgcallnode)
        protected
-          function  align_parasize:longint;override;
           procedure pop_parasize(pop_size:longint);override;
           procedure extra_interrupt_code;override;
        end;
@@ -67,62 +66,6 @@ implementation
       end;
 
 
-    function ti386callnode.align_parasize:longint;
-      var
-         pop_size : longint;
-{$ifdef OPTALIGN}
-         pop_esp : boolean;
-         push_size : longint;
-{$endif OPTALIGN}
-         i : integer;
-      begin
-        pop_size:=0;
-        { This parasize aligned on 4 ? }
-        i:=pushedparasize and 3;
-        if i>0 then
-         inc(pop_size,4-i);
-        { insert the opcode and update pushedparasize }
-        { never push 4 or more !! }
-        pop_size:=pop_size mod 4;
-        if pop_size>0 then
-         begin
-           inc(pushedparasize,pop_size);
-           exprasmlist.concat(taicpu.op_const_reg(A_SUB,S_L,pop_size,NR_ESP));
-{$ifdef GDB}
-           if (cs_debuginfo in aktmoduleswitches) and
-              (exprasmList.first=exprasmList.last) then
-             exprasmList.concat(Tai_force_line.Create);
-{$endif GDB}
-         end;
-{$ifdef OPTALIGN}
-         if pop_allowed and (cs_align in aktglobalswitches) then
-           begin
-              pop_esp:=true;
-              push_size:=pushedparasize;
-              { !!!! here we have to take care of return type, self
-                and nested procedures
-              }
-              inc(push_size,12);
-              emit_reg_reg(A_MOV,S_L,rsp,R_EDI);
-              if (push_size mod 8)=0 then
-                emit_const_reg(A_AND,S_L,$fffffff8,rsp)
-              else
-                begin
-                   emit_const_reg(A_SUB,S_L,push_size,rsp);
-                   emit_const_reg(A_AND,S_L,$fffffff8,rsp);
-                   emit_const_reg(A_SUB,S_L,push_size,rsp);
-                end;
-              r.enum:=R_INTREGISTER;
-              r.number:=R_EDI;
-              emit_reg(A_PUSH,S_L,r);
-           end
-         else
-           pop_esp:=false;
-{$endif OPTALIGN}
-        align_parasize:=pop_size;
-      end;
-
-
     procedure ti386callnode.pop_parasize(pop_size:longint);
       var
         hreg : tregister;
@@ -151,11 +94,6 @@ implementation
         else
           if pop_size<>0 then
             exprasmlist.concat(taicpu.op_const_reg(A_ADD,S_L,pop_size,NR_ESP));
-
-{$ifdef OPTALIGN}
-        if pop_esp then
-          emit_reg(A_POP,S_L,NR_ESP);
-{$endif OPTALIGN}
       end;
 
 
@@ -164,7 +102,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.99  2003-11-07 15:58:32  florian
+  Revision 1.100  2004-06-16 20:07:10  florian
+    * dwarf branch merged
+
+  Revision 1.99.2.1  2004/05/02 12:45:32  peter
+    * enabled cpuhasfixedstack for x86-64 again
+    * fixed size of temp allocation for parameters
+
+  Revision 1.99  2003/11/07 15:58:32  florian
     * Florian's culmutative nr. 1; contains:
       - invalid calling conventions for a certain cpu are rejected
       - arm softfloat calling conventions

compiler/i386/n386mem.pas

@@ -27,6 +27,7 @@ unit n386mem;
 interface
 
     uses
+      globtype,
       cgbase,cpuinfo,cpubase,
       node,nmem,ncgmem;
 
@@ -40,7 +41,7 @@ interface
        end;
 
        ti386vecnode = class(tcgvecnode)
-          procedure update_reference_reg_mul(reg:tregister;l:aword);override;
+          procedure update_reference_reg_mul(reg:tregister;l:aint);override;
           procedure pass_2;override;
        end;
 
@@ -87,7 +88,7 @@ implementation
                              TI386VECNODE
 *****************************************************************************}
 
-     procedure ti386vecnode.update_reference_reg_mul(reg:tregister;l:aword);
+     procedure ti386vecnode.update_reference_reg_mul(reg:tregister;l:aint);
        var
          l2 : integer;
          hreg : tregister;
@@ -144,7 +145,17 @@ begin
 end.
 {
   $Log$
-  Revision 1.60  2004-02-27 10:21:05  florian
+  Revision 1.61  2004-06-16 20:07:10  florian
+    * dwarf branch merged
+
+  Revision 1.60.2.2  2004/05/01 16:02:10  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
+  Revision 1.60.2.1  2004/04/29 19:07:22  peter
+    * compile fixes
+
+  Revision 1.60  2004/02/27 10:21:05  florian
     * top_symbol killed
     + refaddr to treference added
     + refsymbol to treference added
@@ -320,7 +331,7 @@ end.
     * moved arrayconstructnode secondpass to ncgld
 
   Revision 1.25  2002/04/15 19:12:09  carl
-  + target_info.size_of_pointer -> pointer_size
+  + target_info.size_of_pointer -> sizeof(aint)
   + some cleanup of unused types/variables
   * move several constants from cpubase to their specific units
     (where they are used)

compiler/i386/n386obj.pas

@@ -92,9 +92,9 @@ function getselfoffsetfromsp(procdef: tprocdef): longint;
 begin
   { framepointer is pushed for nested procs }
   if procdef.parast.symtablelevel>normal_function_level then
-    getselfoffsetfromsp:=2*POINTER_SIZE
+    getselfoffsetfromsp:=2*sizeof(aint)
   else
-    getselfoffsetfromsp:=POINTER_SIZE;
+    getselfoffsetfromsp:=sizeof(aint);
 end;
 
 
@@ -164,6 +164,7 @@ begin
   make_global:=false;
   if (not current_module.is_unit) or
      (cs_create_smart in aktmoduleswitches) or
+     (af_smartlink_sections in target_asm.flags) or
      (procdef.owner.defowner.owner.symtabletype=globalsymtable) then
     make_global:=true;
 
@@ -238,7 +239,17 @@ initialization
 end.
 {
   $Log$
-  Revision 1.32  2004-03-02 00:36:33  olle
+  Revision 1.33  2004-06-16 20:07:10  florian
+    * dwarf branch merged
+
+  Revision 1.32.2.2  2004/05/01 16:02:10  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
+  Revision 1.32.2.1  2004/04/08 18:33:22  peter
+    * rewrite of TAsmSection
+
+  Revision 1.32  2004/03/02 00:36:33  olle
     * big transformation of Tai_[const_]Symbol.Create[data]name*
 
   Revision 1.31  2004/02/27 13:42:52  olle

compiler/i386/n386set.pas

@@ -27,13 +27,14 @@ unit n386set;
 interface
 
     uses
+      globtype,
       node,nset,pass_1,ncgset;
 
     type
       ti386casenode = class(tcgcasenode)
-         procedure optimizevalues(var max_linear_list:longint;var max_dist:cardinal);override;
+         procedure optimizevalues(var max_linear_list:aint;var max_dist:aword);override;
          function  has_jumptable : boolean;override;
-         procedure genjumptable(hp : pcaserecord;min_,max_ : longint);override;
+         procedure genjumptable(hp : pcaserecord;min_,max_ : aint);override;
          procedure genlinearlist(hp : pcaserecord);override;
       end;
 
@@ -41,7 +42,7 @@ interface
 implementation
 
     uses
-      globtype,systems,
+      systems,
       verbose,globals,
       symconst,symdef,defutil,
       aasmbase,aasmtai,aasmcpu,
@@ -56,7 +57,7 @@ implementation
                             TI386CASENODE
 *****************************************************************************}
 
-    procedure ti386casenode.optimizevalues(var max_linear_list:longint;var max_dist:cardinal);
+    procedure ti386casenode.optimizevalues(var max_linear_list:aint;var max_dist:aword);
       begin
         { a jump table crashes the pipeline! }
         if aktoptprocessor=Class386 then
@@ -76,7 +77,7 @@ implementation
       end;
 
 
-    procedure ti386casenode.genjumptable(hp : pcaserecord;min_,max_ : longint);
+    procedure ti386casenode.genjumptable(hp : pcaserecord;min_,max_ : aint);
       var
         table : tasmlabel;
         last : TConstExprInt;
@@ -86,31 +87,32 @@ implementation
 
         procedure genitem(t : pcaserecord);
           var
-            i : longint;
+            i : aint;
           begin
             if assigned(t^.less) then
               genitem(t^.less);
             { fill possible hole }
             for i:=last+1 to t^._low-1 do
-              jumpSegment.concat(Tai_const_symbol.Create(elselabel));
+              jumpSegment.concat(Tai_const.Create_sym(elselabel));
             for i:=t^._low to t^._high do
-              jumpSegment.concat(Tai_const_symbol.Create(t^.statement));
+              jumpSegment.concat(Tai_const.Create_sym(t^.statement));
             last:=t^._high;
             if assigned(t^.greater) then
               genitem(t^.greater);
           end;
 
       begin
-        if (cs_create_smart in aktmoduleswitches) then
+        if (cs_create_smart in aktmoduleswitches) or
+           (af_smartlink_sections in target_asm.flags) then
           jumpsegment:=current_procinfo.aktlocaldata
         else
           jumpsegment:=datasegment;
         if not(jumptable_no_range) then
           begin
              { case expr less than min_ => goto elselabel }
-             cg.a_cmp_const_reg_label(exprasmlist,opsize,jmp_lt,aword(min_),hregister,elselabel);
+             cg.a_cmp_const_reg_label(exprasmlist,opsize,jmp_lt,aint(min_),hregister,elselabel);
              { case expr greater than max_ => goto elselabel }
-             cg.a_cmp_const_reg_label(exprasmlist,opsize,jmp_gt,aword(max_),hregister,elselabel);
+             cg.a_cmp_const_reg_label(exprasmlist,opsize,jmp_gt,aint(max_),hregister,elselabel);
           end;
         objectlibrary.getlabel(table);
         { make it a 32bit register }
@@ -118,7 +120,7 @@ implementation
         cg.a_load_reg_reg(exprasmlist,opsize,OS_INT,hregister,indexreg);
         { create reference }
         reference_reset_symbol(href,table,0);
-        href.offset:=(-longint(min_))*4;
+        href.offset:=(-aint(min_))*4;
         href.index:=indexreg;
         href.scalefactor:=4;
         emit_ref(A_JMP,S_NO,href);
@@ -145,7 +147,7 @@ implementation
              { need we to test the first value }
              if first and (t^._low>get_min_value(left.resulttype.def)) then
                begin
-                 cg.a_cmp_const_reg_label(exprasmlist,opsize,jmp_lt,aword(t^._low),hregister,elselabel);
+                 cg.a_cmp_const_reg_label(exprasmlist,opsize,jmp_lt,aint(t^._low),hregister,elselabel);
                end;
              if t^._low=t^._high then
                begin
@@ -153,7 +155,7 @@ implementation
                     cg.a_cmp_const_reg_label(exprasmlist, opsize, OC_EQ,0,hregister,t^.statement)
                   else
                     begin
-                      cg.a_op_const_reg(exprasmlist, OP_SUB, opsize, aword(t^._low-last), hregister);
+                      cg.a_op_const_reg(exprasmlist, OP_SUB, opsize, aint(t^._low-last), hregister);
                       cg.a_jmp_flags(exprasmlist,F_E,t^.statement);
                     end;
                   last:=t^._low;
@@ -168,7 +170,7 @@ implementation
                     begin
                        { have we to ajust the first value ? }
                        if (t^._low>get_min_value(left.resulttype.def)) then
-                         cg.a_op_const_reg(exprasmlist, OP_SUB, opsize, longint(t^._low), hregister);
+                         cg.a_op_const_reg(exprasmlist, OP_SUB, opsize, aint(t^._low), hregister);
                     end
                   else
                     begin
@@ -176,7 +178,7 @@ implementation
                       { present label then the lower limit can be checked    }
                       { immediately. else check the range in between:       }
 
-                      cg.a_op_const_reg(exprasmlist, OP_SUB, opsize, longint(t^._low-last), hregister);
+                      cg.a_op_const_reg(exprasmlist, OP_SUB, opsize, aint(t^._low-last), hregister);
                       { no jump necessary here if the new range starts at }
                       { at the value following the previous one           }
                       if ((t^._low-last) <> 1) or
@@ -185,7 +187,7 @@ implementation
                     end;
                   {we need to use A_SUB, because A_DEC does not set the correct flags, therefor
                    using a_op_const_reg(OP_SUB) is not possible }
-                  emit_const_reg(A_SUB,TCGSize2OpSize[opsize],longint(t^._high-t^._low),hregister);
+                  emit_const_reg(A_SUB,TCGSize2OpSize[opsize],aint(t^._high-t^._low),hregister);
                   cg.a_jmp_flags(exprasmlist,cond_le,t^.statement);
                   last:=t^._high;
                   lastrange:=true;
@@ -224,9 +226,27 @@ begin
 end.
 {
   $Log$
-  Revision 1.74  2004-05-22 23:34:28  peter
+  Revision 1.75  2004-06-16 20:07:10  florian
+    * dwarf branch merged
+
+  Revision 1.74  2004/05/22 23:34:28  peter
   tai_regalloc.allocation changed to ratype to notify rgobj of register size changes
 
+  Revision 1.73.2.5  2004/05/02 20:54:41  peter
+    * compile fix
+
+  Revision 1.73.2.4  2004/05/02 14:09:54  peter
+    * fix case 64bit issues
+
+  Revision 1.73.2.3  2004/04/29 23:30:28  peter
+    * fix i386 compiler
+
+  Revision 1.73.2.2  2004/04/12 14:45:11  peter
+    * tai_const_symbol and tai_const merged
+
+  Revision 1.73.2.1  2004/04/08 18:33:22  peter
+    * rewrite of TAsmSection
+
   Revision 1.73  2004/02/27 10:21:05  florian
     * top_symbol killed
     + refaddr to treference added
@@ -506,4 +526,4 @@ end.
     - list field removed of the tnode class because it's not used currently
       and can cause hard-to-find bugs
 
-}
+}

compiler/i386/popt386.pas

@@ -343,7 +343,7 @@ begin
                         taicpu(hp1).opcode := A_AND;
                         l := (1 shl (taicpu(hp1).oper[0]^.val)) - 1;
                         case taicpu(p).opsize Of
-                          S_L: taicpu(hp1).LoadConst(0,l Xor aword($ffffffff));
+                          S_L: taicpu(hp1).LoadConst(0,l Xor aint($ffffffff));
                           S_B: taicpu(hp1).LoadConst(0,l Xor $ff);
                           S_W: taicpu(hp1).LoadConst(0,l Xor $ffff);
                         end;
@@ -558,7 +558,7 @@ var
               (taicpu(hp1).oper[1]^.typ = top_reg) and
               (taicpu(hp1).oper[1]^.reg = taicpu(p).oper[1]^.reg) then
              begin
-               taicpu(p).LoadConst(0,AWord(int64(taicpu(p).oper[0]^.val)-int64(taicpu(hp1).oper[0]^.val)));
+               taicpu(p).LoadConst(0,taicpu(p).oper[0]^.val-taicpu(hp1).oper[0]^.val);
                asml.remove(hp1);
                hp1.free;
                if (taicpu(p).oper[0]^.val = 0) then
@@ -877,7 +877,7 @@ begin
                                 else
                                   begin
                                     taicpu(p).opcode := A_ADD;
-                                    taicpu(p).loadconst(0,aword(l));
+                                    taicpu(p).loadconst(0,l);
                                   end;
                               end;
                     end;
@@ -2002,7 +2002,13 @@ end.
 
 {
   $Log$
-  Revision 1.59  2004-03-14 18:42:32  jonas
+  Revision 1.60  2004-06-16 20:07:10  florian
+    * dwarf branch merged
+
+  Revision 1.59.2.1  2004/04/29 23:30:28  peter
+    * fix i386 compiler
+
+  Revision 1.59  2004/03/14 18:42:32  jonas
     * fixed refaddr bug that caused go32v2 cycle failure
 
   Revision 1.58  2004/02/28 16:59:02  jonas

compiler/i386/r386ari.inc

@@ -8,22 +8,22 @@
 15,
 6,
 5,
-37,
 38,
 39,
 40,
-25,
+41,
+26,
 7,
 10,
 19,
 9,
-31,
 32,
 33,
 34,
 35,
 36,
-26,
+37,
+27,
 11,
 4,
 22,
@@ -31,12 +31,11 @@
 8,
 20,
 12,
-27,
+28,
 18,
 24,
-29,
 30,
-55,
+31,
 56,
 57,
 58,
@@ -44,11 +43,11 @@
 60,
 61,
 62,
+63,
 17,
 23,
-28,
-54,
-46,
+29,
+55,
 47,
 48,
 49,
@@ -56,12 +55,12 @@
 51,
 52,
 53,
-41,
+54,
 42,
 43,
 44,
 45,
-63,
+46,
 64,
 65,
 66,
@@ -69,4 +68,6 @@
 68,
 69,
 70,
+71,
+25,
 0

compiler/i386/r386att.inc

@@ -24,6 +24,7 @@
 '%ebp',
 '%sp',
 '%esp',
+'EIP',
 '%cs',
 '%ds',
 '%es',

compiler/i386/r386con.inc

@@ -24,6 +24,7 @@ NR_BP = tregister($01030006);
 NR_EBP = tregister($01040006);
 NR_SP = tregister($01030007);
 NR_ESP = tregister($01040007);
+NR_EIP = tregister($05000000);
 NR_CS = tregister($05000001);
 NR_DS = tregister($05000002);
 NR_ES = tregister($05000003);

compiler/i386/r386dwrf.inc

@@ -0,0 +1,73 @@
+{ don't edit, this file is generated from x86reg.dat }
+-1,
+0,
+0,
+0,
+0,
+1,
+1,
+1,
+1,
+2,
+2,
+2,
+2,
+3,
+3,
+3,
+3,
+6,
+6,
+7,
+7,
+5,
+5,
+4,
+4,
+8,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+-1,
+11,
+12,
+13,
+14,
+15,
+16,
+17,
+18,
+11,
+29,
+30,
+31,
+32,
+33,
+34,
+35,
+36,
+21,
+22,
+23,
+24,
+25,
+26,
+27,
+28

compiler/i386/r386int.inc

@@ -24,6 +24,7 @@
 'ebp',
 'sp',
 'esp',
+'EIP',
 'cs',
 'ds',
 'es',

compiler/i386/r386iri.inc

@@ -1,4 +1,5 @@
 { don't edit, this file is generated from x86reg.dat }
+25,
 0,
 2,
 1,
@@ -9,22 +10,22 @@
 15,
 6,
 5,
-37,
 38,
 39,
 40,
-25,
+41,
+26,
 7,
 10,
 19,
 9,
-31,
 32,
 33,
 34,
 35,
 36,
-26,
+37,
+27,
 11,
 4,
 22,
@@ -32,12 +33,11 @@
 8,
 20,
 12,
-27,
+28,
 18,
 24,
-29,
 30,
-55,
+31,
 56,
 57,
 58,
@@ -45,11 +45,11 @@
 60,
 61,
 62,
+63,
 17,
 23,
-28,
-54,
-46,
+29,
+55,
 47,
 48,
 49,
@@ -57,16 +57,17 @@
 51,
 52,
 53,
-41,
+54,
 42,
 43,
 44,
 45,
-63,
+46,
 64,
 65,
 66,
 67,
 68,
 69,
-70
+70,
+71

compiler/i386/r386nasm.inc

@@ -24,6 +24,7 @@
 'ebp',
 'sp',
 'esp',
+'EIP',
 'cs',
 'ds',
 'es',

compiler/i386/r386nor.inc

@@ -1,2 +1,2 @@
 { don't edit, this file is generated from x86reg.dat }
-71
+72

compiler/i386/r386nri.inc

@@ -1,4 +1,5 @@
 { don't edit, this file is generated from x86reg.dat }
+25,
 0,
 2,
 1,
@@ -9,22 +10,22 @@
 15,
 6,
 5,
-37,
 38,
 39,
 40,
-25,
+41,
+26,
 7,
 10,
 19,
 9,
-31,
 32,
 33,
 34,
 35,
 36,
-26,
+37,
+27,
 11,
 4,
 22,
@@ -32,12 +33,11 @@
 8,
 20,
 12,
-27,
+28,
 18,
 24,
-29,
 30,
-55,
+31,
 56,
 57,
 58,
@@ -45,11 +45,11 @@
 60,
 61,
 62,
+63,
 17,
 23,
-28,
-54,
-46,
+29,
+55,
 47,
 48,
 49,
@@ -57,16 +57,17 @@
 51,
 52,
 53,
-41,
+54,
 42,
 43,
 44,
 45,
-63,
+46,
 64,
 65,
 66,
 67,
 68,
 69,
-70
+70,
+71

compiler/i386/r386num.inc

@@ -24,6 +24,7 @@ tregister($01030006),
 tregister($01040006),
 tregister($01030007),
 tregister($01040007),
+tregister($05000000),
 tregister($05000001),
 tregister($05000002),
 tregister($05000003),

compiler/i386/r386op.inc

@@ -24,6 +24,7 @@
 5,
 4,
 4,
+0,
 1,
 3,
 0,

compiler/i386/r386ot.inc

@@ -24,6 +24,7 @@ OT_REG16,
 OT_REG32,
 OT_REG16,
 OT_REG32,
+OT_NONE,
 OT_REG_CS,
 OT_REG_DESS,
 OT_REG_DESS,

compiler/i386/r386rni.inc

@@ -24,7 +24,6 @@
 20,
 22,
 24,
-46,
 47,
 48,
 49,
@@ -49,6 +48,7 @@
 68,
 69,
 70,
+71,
 25,
 26,
 27,
@@ -69,4 +69,5 @@
 42,
 43,
 44,
-45
+45,
+46

compiler/i386/r386sri.inc

@@ -1,4 +1,5 @@
 { don't edit, this file is generated from x86reg.dat }
+25,
 0,
 2,
 1,
@@ -9,22 +10,22 @@
 15,
 6,
 5,
-37,
 38,
 39,
 40,
-25,
+41,
+26,
 7,
 10,
 19,
 9,
-31,
 32,
 33,
 34,
 35,
 36,
-26,
+37,
+27,
 11,
 4,
 22,
@@ -32,12 +33,11 @@
 8,
 20,
 12,
-27,
+28,
 18,
 24,
-29,
 30,
-55,
+31,
 56,
 57,
 58,
@@ -45,11 +45,11 @@
 60,
 61,
 62,
+63,
 17,
 23,
-28,
-54,
-46,
+29,
+55,
 47,
 48,
 49,
@@ -57,16 +57,17 @@
 51,
 52,
 53,
-41,
+54,
 42,
 43,
 44,
 45,
-63,
+46,
 64,
 65,
 66,
 67,
 68,
 69,
-70
+70,
+71

compiler/i386/r386stab.inc

@@ -45,6 +45,7 @@
 -1,
 -1,
 -1,
+-1,
 12,
 13,
 14,

compiler/i386/r386std.inc

@@ -24,6 +24,7 @@
 'ebp',
 'sp',
 'esp',
+'EIP',
 'cs',
 'ds',
 'es',

compiler/i386/ra386int.pas

@@ -29,6 +29,7 @@ Unit Ra386int;
     uses
       cclasses,
       cpubase,
+      globtype,
       rasm,
       rax86;
 
@@ -60,15 +61,15 @@ Unit Ra386int;
          procedure GetToken;
          function consume(t : tasmtoken):boolean;
          procedure RecoverConsume(allowcomma:boolean);
-         procedure BuildRecordOffsetSize(const expr: string;var offset:longint;var size:longint);
-         procedure BuildConstSymbolExpression(needofs,isref:boolean;var value:longint;var asmsym:string);
-         function BuildConstExpression:longint;
-         function BuildRefConstExpression:longint;
+         procedure BuildRecordOffsetSize(const expr: string;var offset:aint;var size:aint);
+         procedure BuildConstSymbolExpression(needofs,isref:boolean;var value:aint;var asmsym:string);
+         function BuildConstExpression:aint;
+         function BuildRefConstExpression:aint;
          procedure BuildReference(oper : tx86operand);
          procedure BuildOperand(oper: tx86operand);
          procedure BuildConstantOperand(oper: tx86operand);
          procedure BuildOpCode(instr : tx86instruction);
-         procedure BuildConstant(maxvalue: longint);
+         procedure BuildConstant(constsize: longint);
        end;
 
 
@@ -78,7 +79,7 @@ Unit Ra386int;
        { common }
        cutils,
        { global }
-       globtype,globals,verbose,
+       globals,verbose,
        systems,
        { aasm }
        cpuinfo,aasmbase,aasmtai,aasmcpu,
@@ -686,7 +687,7 @@ Unit Ra386int;
     { This routine builds up a record offset after a AS_DOT
       token is encountered.
       On entry actasmtoken should be equal to AS_DOT                     }
-    Procedure ti386intreader.BuildRecordOffsetSize(const expr: string;var offset:longint;var size:longint);
+    Procedure ti386intreader.BuildRecordOffsetSize(const expr: string;var offset:aint;var size:aint);
       var
         s : string;
       Begin
@@ -709,10 +710,11 @@ Unit Ra386int;
       end;
 
 
-    Procedure ti386intreader.BuildConstSymbolExpression(needofs,isref:boolean;var value:longint;var asmsym:string);
+    Procedure ti386intreader.BuildConstSymbolExpression(needofs,isref:boolean;var value:aint;var asmsym:string);
       var
         tempstr,expr,hs : string;
-        parenlevel,l,k : longint;
+        parenlevel : longint;
+        l,k : aint;
         hasparen,
         errorflag : boolean;
         prevtok : tasmtoken;
@@ -997,9 +999,9 @@ Unit Ra386int;
       end;
 
 
-    Function ti386intreader.BuildConstExpression:longint;
+    Function ti386intreader.BuildConstExpression:aint;
       var
-        l : longint;
+        l : aint;
         hs : string;
       begin
         BuildConstSymbolExpression(false,false,l,hs);
@@ -1009,9 +1011,9 @@ Unit Ra386int;
       end;
 
 
-    Function ti386intreader.BuildRefConstExpression:longint;
+    Function ti386intreader.BuildRefConstExpression:aint;
       var
-        l : longint;
+        l : aint;
         hs : string;
       begin
         BuildConstSymbolExpression(false,true,l,hs);
@@ -1023,7 +1025,7 @@ Unit Ra386int;
 
     procedure ti386intreader.BuildReference(oper : tx86operand);
       var
-        k,l,scale : longint;
+        k,l,scale : aint;
         tempstr,hs : string;
         typesize : longint;
         code : integer;
@@ -1361,7 +1363,7 @@ Unit Ra386int;
 
     Procedure ti386intreader.BuildConstantOperand(oper: tx86operand);
       var
-        l : longint;
+        l : aint;
         tempstr : string;
       begin
         if not (oper.opr.typ in [OPR_NONE,OPR_CONSTANT]) then
@@ -1406,10 +1408,10 @@ Unit Ra386int;
         expr    : string;
         tempreg : tregister;
         typesize,
-        l       : longint;
+        l       : aint;
         hl      : tasmlabel;
         toffset,
-        tsize   : longint;
+        tsize   : aint;
       Begin
         expr:='';
         repeat
@@ -1594,7 +1596,7 @@ Unit Ra386int;
                      Message(asmr_e_invalid_operand_type);
                    oper.opr.typ:=OPR_REGISTER;
                    oper.opr.reg:=tempreg;
-                   oper.SetSize(tcgsize2size[cg.reg_cgsize(oper.opr.reg)],true);
+                   oper.SetSize(tcgsize2size[reg_cgsize(oper.opr.reg)],true);
                  end;
               end;
 
@@ -1779,23 +1781,19 @@ Unit Ra386int;
       end;
 
 
-    Procedure ti386intreader.BuildConstant(maxvalue: longint);
+    Procedure ti386intreader.BuildConstant(constsize: longint);
       var
        strlength: byte;
        asmsym,
        expr: string;
-       value : longint;
+       value : aint;
       Begin
         strlength:=0; { assume it is a DB }
         Repeat
           Case actasmtoken of
             AS_STRING:
               Begin
-                if maxvalue = $ffff then
-                  strlength:=2
-                else
-                  if maxvalue = longint($ffffffff) then
-                    strlength:=4;
+                strlength:=constsize;
                 { DD and DW cases }
                 if strlength <> 0 then
                  Begin
@@ -1824,12 +1822,12 @@ Unit Ra386int;
                 BuildConstSymbolExpression(false,false,value,asmsym);
                 if asmsym<>'' then
                  begin
-                   if maxvalue<>longint($ffffffff) then
+                   if constsize<>sizeof(aint) then
                      Message1(asmr_w_const32bit_for_address,asmsym);
                    ConcatConstSymbol(curlist,asmsym,value)
                  end
                 else
-                 ConcatConstant(curlist,value,maxvalue);
+                 ConcatConstant(curlist,value,constsize);
               end;
             AS_COMMA:
               Consume(AS_COMMA);
@@ -1891,7 +1889,7 @@ Unit Ra386int;
             Begin
               inexpression:=true;
               Consume(AS_DW);
-              BuildConstant($ffff);
+              BuildConstant(2);
               inexpression:=false;
             end;
 
@@ -1899,7 +1897,7 @@ Unit Ra386int;
             Begin
               inexpression:=true;
               Consume(AS_DB);
-              BuildConstant($ff);
+              BuildConstant(1);
               inexpression:=false;
             end;
 
@@ -1907,7 +1905,7 @@ Unit Ra386int;
             Begin
               inexpression:=true;
               Consume(AS_DD);
-              BuildConstant(longint($ffffffff));
+              BuildConstant(4);
               inexpression:=false;
             end;
 
@@ -1970,10 +1968,23 @@ begin
 end.
 {
   $Log$
-  Revision 1.72  2004-05-20 21:54:33  florian
+  Revision 1.73  2004-06-16 20:07:10  florian
+    * dwarf branch merged
+
+  Revision 1.72  2004/05/20 21:54:33  florian
     + <pointer> - <pointer> result is divided by the pointer element size now
       this is delphi compatible as well as resulting in the expected result for p1+(p2-p1)
 
+  Revision 1.71.2.3  2004/05/02 00:31:33  peter
+    * fixedi i386 compile
+
+  Revision 1.71.2.2  2004/05/01 23:36:47  peter
+    * assembler reader 64bit fixes
+
+  Revision 1.71.2.1  2004/05/01 16:02:10  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
   Revision 1.71  2004/03/02 17:32:12  florian
     * make cycle fixed
     + pic support for darwin
@@ -2187,7 +2198,7 @@ end.
     * fixed default stacksize of linux and go32v2, 8kb was a bit small :-)
 
   Revision 1.23  2002/04/15 19:12:09  carl
-  + target_info.size_of_pointer -> pointer_size
+  + target_info.size_of_pointer -> sizeof(aint)
   + some cleanup of unused types/variables
   * move several constants from cpubase to their specific units
     (where they are used)
@@ -2213,4 +2224,4 @@ end.
    * implicit result variable generation for assembler routines
    * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
 
-}
+}

compiler/ia64/cpubase.pas

@@ -112,7 +112,7 @@ Const
   HiGPReg = R_31;
 
   { sizes }
-  pointer_size  = 8;
+  sizeof(aint)  = 8;
   extended_size = 16;
 
   general_registers = [R_0..R_31];
@@ -283,7 +283,14 @@ implementation
 end.
 {
   $Log$
-  Revision 1.6  2002-11-17 18:26:16  mazen
+  Revision 1.7  2004-06-16 20:07:10  florian
+    * dwarf branch merged
+
+  Revision 1.6.2.1  2004/05/01 16:02:10  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
+  Revision 1.6  2002/11/17 18:26:16  mazen
   * fixed a compilation bug accmulator-->accumulator, in definition of return_result_reg
 
   Revision 1.5  2002/11/17 17:49:09  mazen

compiler/m68k/agcpugas.pas

@@ -40,9 +40,71 @@ interface
       end;
 
     const
-      gas_opsize2str : array[topsize] of string[2] =
-      ('','.b','.w','.l','.s','.d','.x',''
-      );
+      gas_op2str:op2strtable=
+    {  warning: CPU32 opcodes are not fully compatible with the MC68020. }
+       { 68000 only opcodes }
+       ('abcd',
+         'add','adda','addi','addq','addx','and','andi',
+         'asl','asr','bcc','bcs','beq','bge','bgt','bhi',
+         'ble','bls','blt','bmi','bne','bpl','bvc','bvs',
+         'bchg','bclr','bra','bset','bsr','btst','chk',
+         'clr','cmp','cmpa','cmpi','cmpm','dbcc','dbcs','dbeq','dbge',
+         'dbgt','dbhi','dble','dbls','dblt','dbmi','dbne','dbra',
+         'dbpl','dbt','dbvc','dbvs','dbf','divs','divu',
+         'eor','eori','exg','illegal','ext','jmp','jsr',
+         'lea','link','lsl','lsr','move','movea','movei','moveq',
+         'movem','movep','muls','mulu','nbcd','neg','negx',
+         'nop','not','or','ori','pea','rol','ror','roxl',
+         'roxr','rtr','rts','sbcd','scc','scs','seq','sge',
+         'sgt','shi','sle','sls','slt','smi','sne',
+         'spl','st','svc','svs','sf','sub','suba','subi','subq',
+         'subx','swap','tas','trap','trapv','tst','unlk',
+         'rte','reset','stop',
+         { mc68010 instructions }
+         'bkpt','movec','moves','rtd',
+         { mc68020 instructions }
+         'bfchg','bfclr','bfexts','bfextu','bfffo',
+         'bfins','bfset','bftst','callm','cas','cas2',
+         'chk2','cmp2','divsl','divul','extb','pack','rtm',
+         'trapcc','tracs','trapeq','trapf','trapge','trapgt',
+         'traphi','traple','trapls','traplt','trapmi','trapne',
+         'trappl','trapt','trapvc','trapvs','unpk',
+         { fpu processor instructions - directly supported only. }
+         { ieee aware and misc. condition codes not supported   }
+         'fabs','fadd',
+         'fbeq','fbne','fbngt','fbgt','fbge','fbnge',
+         'fblt','fbnlt','fble','fbgl','fbngl','fbgle','fbngle',
+         'fdbeq','fdbne','fdbgt','fdbngt','fdbge','fdbnge',
+         'fdblt','fdbnlt','fdble','fdbgl','fdbngl','fdbgle','fdbngle',
+         'fseq','fsne','fsgt','fsngt','fsge','fsnge',
+         'fslt','fsnlt','fsle','fsgl','fsngl','fsgle','fsngle',
+         'fcmp','fdiv','fmove','fmovem',
+         'fmul','fneg','fnop','fsqrt','fsub','fsgldiv',
+         'fsflmul','ftst',
+         'ftrapeq','ftrapne','ftrapgt','ftrapngt','ftrapge','ftrapnge',
+         'ftraplt','ftrapnlt','ftraple','ftrapgl','ftrapngl','ftrapgle','ftrapngle',
+         { protected instructions }
+         'cprestore','cpsave',
+         { fpu unit protected instructions                    }
+         { and 68030/68851 common mmu instructions            }
+         { (this may include 68040 mmu instructions)          }
+         'frestore','fsave','pflush','pflusha','pload','pmove','ptest',
+         { useful for assembly language output }
+         'label','none','db','s','b','fb');
+
+
+     gas_opsize2str : array[topsize] of string[2] =
+     ('','.b','.w','.l','.s','.d','.x',''
+     );
+
+     gas_reg2str : reg2strtable =
+      ('', '%d0','%d1','%d2','%d3','%d4','%d5','%d6','%d7',
+       '%a0','%a1','%a2','%a3','%a4','%a5','%a6','%sp',
+       '-(%sp)','(%sp)+',
+       '%ccr','%fp0','%fp1','%fp2','%fp3','%fp4','%fp5',
+       '%fp6','%fp7','%fpcr','%sr','%ssp','%dfc',
+       '%sfc','%vbr','%fpsr');
+
 
   implementation
 
@@ -300,7 +362,10 @@ initialization
 end.
 {
   $Log$
-  Revision 1.11  2004-05-01 23:29:01  florian
+  Revision 1.12  2004-06-16 20:07:10  florian
+    * dwarf branch merged
+
+  Revision 1.11  2004/05/01 23:29:01  florian
     * continued to fix m68k compiler compilation
 
   Revision 1.10  2004/04/27 15:46:01  florian
@@ -312,6 +377,9 @@ end.
   Revision 1.8  2004/04/25 21:26:16  florian
     * some m68k stuff fixed
 
+  Revision 1.7.2.1  2004/06/13 20:38:38  florian
+    * fixed floating point register spilling on sparc
+
   Revision 1.7  2003/02/19 22:00:16  daniel
     * Code generator converted to new register notation
     - Horribily outdated todo.txt removed

compiler/m68k/cpubase.pas

@@ -28,6 +28,10 @@ unit cpubase;
 
   interface
 
+  uses
+    globtype,
+    strings,cutils,cclasses,aasmbase,cpuinfo,cgbase;
+
     uses
       strings,cutils,cclasses,aasmbase,cpuinfo,cgbase;
 
@@ -244,12 +248,12 @@ unit cpubase;
             LOC_FLAGS : (resflags : tresflags);
             LOC_CONSTANT : (
               case longint of
-                1 : (value : AWord);
+                1 : (value : aint);
                 { can't do this, this layout depends on the host cpu. Use }
                 { lo(valueqword)/hi(valueqword) instead (JM)              }
                 { 2 : (valuelow, valuehigh:AWord);                        }
                 { overlay a complete 64 Bit value }
-                3 : (valueqword : qword);
+                3 : (value64 : qword);
               );
             LOC_CREFERENCE,
             LOC_REFERENCE : (reference : treference);
@@ -514,7 +518,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.28  2004-05-06 22:01:54  florian
+  Revision 1.29  2004-06-16 20:07:10  florian
+    * dwarf branch merged
+
+  Revision 1.28  2004/05/06 22:01:54  florian
     * register numbers for address registers fixed
 
   Revision 1.27  2004/05/06 20:30:51  florian
@@ -526,6 +533,9 @@ end.
   Revision 1.25  2004/04/18 21:13:59  florian
     * more adaptions for m68k
 
+  Revision 1.24.2.1  2004/06/13 20:38:38  florian
+    * fixed floating point register spilling on sparc
+
   Revision 1.24  2004/01/30 12:17:18  florian
     * fixed some m68k compilation problems
 

compiler/m68k/cpuinfo.pas

@@ -21,20 +21,6 @@ Interface
     globtype;
 
 Type
-   { Architecture word - Native unsigned type }
-   aword  = longword;
-   PAWord = ^AWord;
-   AInt = longint;
-
-   { this must be an ordinal type with the same size as a pointer }
-   { to allow some dirty type casts for example when using        }
-   { tconstsym.value                                              }
-   { Note: must be unsigned!! Otherwise, ugly code like           }
-   { pointer(-1) will result in a pointer with the value          }
-   { $fffffffffffffff on a 32bit machine if the compiler uses     }
-   { int64 constants internally (JM)                              }
-   TConstPtrUInt = longword;
-
    bestreal = real;
    ts32real = single;
    ts64real = double;
@@ -62,8 +48,6 @@ Type
 Const
    {# Size of native extended floating point type }
    extended_size = 8;
-   {# Size of a pointer                           }
-   pointer_size  = 4;
    {# Size of a multimedia register               }
    mmreg_size = 16;
    { size of the buffer used for setjump/longjmp
@@ -105,7 +89,10 @@ Implementation
 end.
 {
   $Log$
-  Revision 1.11  2004-05-01 23:29:01  florian
+  Revision 1.12  2004-06-16 20:07:10  florian
+    * dwarf branch merged
+
+  Revision 1.11  2004/05/01 23:29:01  florian
     * continued to fix m68k compiler compilation
 
   Revision 1.10  2004/04/28 15:19:03  florian
@@ -114,6 +101,10 @@ end.
   Revision 1.9  2004/04/18 21:13:59  florian
     * more adaptions for m68k
 
+  Revision 1.8.2.1  2004/05/01 16:02:10  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
   Revision 1.8  2004/01/30 12:17:18  florian
     * fixed some m68k compilation problems
 

compiler/msg/errore.msg

@@ -933,7 +933,7 @@ parser_e_goto_outside_proc=03201_E_Goto statements aren't allowed between differ
 %   procedure p1;
 %   label
 %     l1;
-%    
+%
 %     procedure p2;
 %     begin
 %       goto l1; // This goto ISN'T allowed
@@ -946,6 +946,25 @@ parser_e_goto_outside_proc=03201_E_Goto statements aren't allowed between differ
 % ...
 %
 % \end{verbatim}
+parser_e_too_complex_expr=03202_E_Expression too complicated - FPU stack overflow
+% Your expression is too long for the compiler. You should try dividing the
+% construct over multiple assignments.
+parser_e_illegal_expression=03203_E_Illegal expression
+% This can occur under many circumstances. Mostly when trying to evaluate
+% constant expressions.
+parser_e_invalid_integer=03204_E_Invalid integer expression
+% You made an expression which isn't an integer, and the compiler expects the
+% result to be an integer.
+parser_e_invalid_qualifier=03205_E_Illegal qualifier
+% One of the following is happening :
+% \begin{itemize}
+% \item You're trying to access a field of a variable that is not a record.
+% \item You're indexing a variable that is not an array.
+% \item You're dereferencing a variable that is not a pointer.
+% \end{itemize}
+parser_e_upper_lower_than_lower=03206_E_High range limit < low range limit
+% You are declaring a subrange, and the lower limit is higher than the high
+% limit of the range.
 % \end{description}
 #
 # Type Checking
@@ -1157,6 +1176,24 @@ type_e_constant_expr_expected=04052_E_Constant Expression expected
 % The compiler expects an constant expression, but gets a variable expression.
 type_e_operator_not_supported_for_types=04053_E_Operation "$1" not supported types "$2" and "$3"
 % The operation is not allowed for the supplied types
+type_e_illegal_type_conversion=04054_E_Illegal type conversion: "$1" to "$2"
+% When doing a type-cast, you must take care that the sizes of the variable and
+% the destination type are the same.
+type_h_pointer_to_longint_conv_not_portable=04055_H_Conversion between ordinals and pointers is not portable
+% If you typecast a pointer to a longint (or vice-versa), this code will not compile
+% on a machine using 64-bit for pointer storage.
+type_w_pointer_to_longint_conv_not_portable=04056_W_Conversion between ordinals and pointers is not portable
+% If you typecast a pointer to a ordinal type of a different size (or vice-versa), this can
+% cause problems. This is a warning to help finding the 32bit specific code where cardinal/longint is used
+% to typecast pointers to ordinals. A solution is to use the ptrint/ptruint types instead.
+type_e_cant_choose_overload_function=04057_E_Can't determine which overloaded function to call
+% You're calling overloaded functions with a parameter that doesn't correspond
+% to any of the declared function parameter lists. e.g. when you have declared
+% a function with parameters \var{word} and \var{longint}, and then you call
+% it with a parameter which is of type \var{integer}.
+type_e_illegal_count_var=04058_E_Illegal counter variable
+% The type of a \var{for} loop variable must be an ordinal type.
+% Loop variables cannot be reals or strings.
 % \end{description}
 #
 # Symtable
@@ -1305,46 +1342,9 @@ sym_e_cant_create_unique_type=05056_E_Can't create unique type from this type
 % This section lists all messages that can be displayed if the code
 % generator encounters an error condition.
 % \begin{description}
-cg_e_break_not_allowed=06000_E_BREAK not allowed
-% You're trying to use \var{break} outside a loop construction.
-cg_e_continue_not_allowed=06001_E_CONTINUE not allowed
-% You're trying to use \var{continue} outside a loop construction.
-cg_e_too_complex_expr=06002_E_Expression too complicated - FPU stack overflow
-% Your expression is too long for the compiler. You should try dividing the
-% construct over multiple assignments.
-cg_e_illegal_expression=06003_E_Illegal expression
-% This can occur under many circumstances. Mostly when trying to evaluate
-% constant expressions.
-cg_e_invalid_integer=06004_E_Invalid integer expression
-% You made an expression which isn't an integer, and the compiler expects the
-% result to be an integer.
-cg_e_invalid_qualifier=06005_E_Illegal qualifier
-% One of the following is happening :
-% \begin{itemize}
-% \item You're trying to access a field of a variable that is not a record.
-% \item You're indexing a variable that is not an array.
-% \item You're dereferencing a variable that is not a pointer.
-% \end{itemize}
-cg_e_upper_lower_than_lower=06006_E_High range limit < low range limit
-% You are declaring a subrange, and the lower limit is higher than the high
-% limit of the range.
-cg_e_illegal_count_var=06007_E_Illegal counter variable
-% The type of a \var{for} loop variable must be an ordinal type.
-% Loop variables cannot be reals or strings.
-cg_e_cant_choose_overload_function=06008_E_Can't determine which overloaded function to call
-% You're calling overloaded functions with a parameter that doesn't correspond
-% to any of the declared function parameter lists. e.g. when you have declared
-% a function with parameters \var{word} and \var{longint}, and then you call
-% it with a parameter which is of type \var{integer}.
 cg_e_parasize_too_big=06009_E_Parameter list size exceeds 65535 bytes
 % The I386 processor limits the parameter list to 65535 bytes (the \var{RET}
 % instruction causes this)
-cg_e_illegal_type_conversion=06010_E_Illegal type conversion: "$1" to "$2"
-% When doing a type-cast, you must take care that the sizes of the variable and
-% the destination type are the same.
-cg_h_pointer_to_longint_conv_not_portable=06011_H_Conversion between ordinals and pointers are not portable
-% If you typecast a pointer to a longint (or vice-versa), this code will not compile
-% on a machine using 64-bit for pointer storage.
 cg_e_file_must_call_by_reference=06012_E_File types must be var parameters
 % You cannot specify files as value parameters, i.e. they must always be
 % declared \var{var} parameters.
@@ -1358,10 +1358,6 @@ cg_e_cant_use_far_pointer_there=06013_E_The use of a far pointer isn't allowed t
 % ...
 % p:=@mem[a000:000];
 % \end{verbatim}
-cg_e_var_must_be_reference=06014_E_illegal call by reference parameters
-% You are trying to pass a constant or an expression to a procedure that
-% requires a \var{var} parameter. Only variables can be passed as a \var{var}
-% parameter.
 cg_e_dont_call_exported_direct=06015_E_EXPORT declared functions can't be called
 % No longer in use.
 cg_w_member_cd_call_from_method=06016_W_Possible illegal call of constructor or destructor
@@ -1446,6 +1442,10 @@ cg_w_localsize_too_big=06042_W_Local variable size exceed limit for certain cpu'
 cg_e_localsize_too_big=06043_E_Local variables size exceeds supported limit
 % This indicates that you are declaring more than 32K of lcoal variables, which
 % is not supported by this processor.
+cg_e_break_not_allowed=06044_E_BREAK not allowed
+% You're trying to use \var{break} outside a loop construction.
+cg_e_continue_not_allowed=06045_E_CONTINUE not allowed
+% You're trying to use \var{continue} outside a loop construction.
 # EndOfTeX
 
 #
@@ -2141,6 +2141,8 @@ option_help_pages=11025_[
 *g2gh_use heap trace unit (for memory leak debugging)
 *g2gl_use line info unit to show more info for backtraces
 *g2gc_generate checks for pointers
+*g2gv_generates programs tracable with valygrind
+*g2gw_generate dwarf debugging info
 **1i_information
 **2iD_return compiler date
 **2iV_return compiler version
@@ -2201,6 +2203,7 @@ option_help_pages=11025_[
 *L2Xc_link with the c library
 **2Xs_strip all symbols from executable
 **2XD_try to link dynamic          (defines FPC_LINK_DYNAMIC)
+**2XP<x>_prepend the binutils names with the prefix <x>
 **2XS_try to link static (default) (defines FPC_LINK_STATIC)
 **2XX_try to link smart            (defines FPC_LINK_SMART)
 **0*_Processor specific options:

compiler/msgidx.inc

@@ -260,6 +260,11 @@ const
   parser_e_illegal_explicit_paraloc=03199;
   parser_e_32bitint_or_pointer_variable_expected=03200;
   parser_e_goto_outside_proc=03201;
+  parser_e_too_complex_expr=03202;
+  parser_e_illegal_expression=03203;
+  parser_e_invalid_integer=03204;
+  parser_e_invalid_qualifier=03205;
+  parser_e_upper_lower_than_lower=03206;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
@@ -313,6 +318,11 @@ const
   type_e_operator_not_allowed=04051;
   type_e_constant_expr_expected=04052;
   type_e_operator_not_supported_for_types=04053;
+  type_e_illegal_type_conversion=04054;
+  type_h_pointer_to_longint_conv_not_portable=04055;
+  type_w_pointer_to_longint_conv_not_portable=04056;
+  type_e_cant_choose_overload_function=04057;
+  type_e_illegal_count_var=04058;
   sym_e_id_not_found=05000;
   sym_f_internal_error_in_symtablestack=05001;
   sym_e_duplicate_id=05002;
@@ -356,21 +366,9 @@ const
   sym_w_non_portable_symbol=05044;
   sym_w_non_implemented_symbol=05055;
   sym_e_cant_create_unique_type=05056;
-  cg_e_break_not_allowed=06000;
-  cg_e_continue_not_allowed=06001;
-  cg_e_too_complex_expr=06002;
-  cg_e_illegal_expression=06003;
-  cg_e_invalid_integer=06004;
-  cg_e_invalid_qualifier=06005;
-  cg_e_upper_lower_than_lower=06006;
-  cg_e_illegal_count_var=06007;
-  cg_e_cant_choose_overload_function=06008;
   cg_e_parasize_too_big=06009;
-  cg_e_illegal_type_conversion=06010;
-  cg_h_pointer_to_longint_conv_not_portable=06011;
   cg_e_file_must_call_by_reference=06012;
   cg_e_cant_use_far_pointer_there=06013;
-  cg_e_var_must_be_reference=06014;
   cg_e_dont_call_exported_direct=06015;
   cg_w_member_cd_call_from_method=06016;
   cg_n_inefficient_code=06017;
@@ -389,6 +387,8 @@ const
   cg_w_parasize_too_big=06041;
   cg_w_localsize_too_big=06042;
   cg_e_localsize_too_big=06043;
+  cg_e_break_not_allowed=06044;
+  cg_e_continue_not_allowed=06045;
   asmr_d_start_reading=07000;
   asmr_d_finish_reading=07001;
   asmr_e_none_label_contain_at=07002;
@@ -639,9 +639,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 36547;
+  MsgTxtSize = 36707;
 
   MsgIdxMax : array[1..20] of longint=(
-    17,63,202,54,57,44,99,20,35,60,
+    17,63,207,59,57,46,99,20,35,60,
     40,1,1,1,1,1,1,1,1,1
   );

compiler/msgtxt.inc

@@ -293,298 +293,298 @@ const msgtxt : array[0..000152,1..240] of char=(
   '03200_E_32 Bit Integer or Pointer Variable expected'#000+
   '03201_E_Goto statements aren'#039't allowed between different procedure'+
   's'#000+
+  '03202_E_Expression too complicated - FPU stack overflow'#000+
+  '03203_E_Illegal expression'#000+
+  '03','204_E_Invalid integer expression'#000+
+  '03205_E_Illegal qualifier'#000+
+  '03206_E_High range limit < low range limit'#000+
   '04000_E_Type mismatch'#000+
   '04001_E_Incompatible types: got "$1" expected "$2"'#000+
-  '04002_E_Type',' mismatch between "$1" and "$2"'#000+
-  '04003_E_Type identifier expected'#000+
+  '04002_E_Type mismatch between "$1" and "$2"'#000+
+  '04003_E_Type identifi','er expected'#000+
   '04004_E_Variable identifier expected'#000+
   '04005_E_Integer expression expected, but got "$1"'#000+
   '04006_E_Boolean expression expected, but got "$1"'#000+
   '04007_E_Ordinal expression expected'#000+
-  '04','008_E_pointer type expected, but got "$1"'#000+
-  '04009_E_class type expected, but got "$1"'#000+
+  '04008_E_pointer type expected, but got "$1"'#000+
+  '04009_E_cla','ss type expected, but got "$1"'#000+
   '04011_E_Can'#039't evaluate constant expression'#000+
   '04012_E_Set elements are not compatible'#000+
   '04013_E_Operation not implemented for sets'#000+
-  '04014_W_Automatic type convers','ion from floating type to COMP which i'+
-  's an integer type'#000+
+  '04014_W_Automatic type conversion from floating type to COMP which is '+
+  'an integer ty','pe'#000+
   '04015_H_use DIV instead to get an integer result'#000+
   '04016_E_string types doesn'#039't match, because of $V+ mode'#000+
   '04017_E_succ or pred on enums with assignments not possible'#000+
-  '04018_E_Can'#039't read ','or write variables of this type'#000+
-  '04019_E_Can'#039't use readln or writeln on typed file'#000+
+  '04018_E_Can'#039't read or write variables of this type'#000+
+  '04019_E_Can'#039't use rea','dln or writeln on typed file'#000+
   '04020_E_Can'#039't use read or write on untyped file.'#000+
   '04021_E_Type conflict between set elements'#000+
   '04022_W_lo/hi(dword/qword) returns the upper/lower word/dword'#000+
-  '0402','3_E_Integer or real expression expected'#000+
-  '04024_E_Wrong type "$1" in array constructor'#000+
+  '04023_E_Integer or real expression expected'#000+
+  '04024_E_Wrong',' type "$1" in array constructor'#000+
   '04025_E_Incompatible type for arg no. $1: Got "$2", expected "$3"'#000+
   '04026_E_Method (variable) and Procedure (variable) are not compatible'#000+
-  '04027_E_Illegal con','stant passed to internal math function'#000+
-  '04028_E_Can'#039't get the address of constants'#000+
+  '04027_E_Illegal constant passed to internal math function'#000+
+  '04028_E_Can'#039't ','get the address of constants'#000+
   '04029_E_Argument can'#039't be assigned to'#000+
   '04030_E_Can'#039't assign local procedure/function to procedure variabl'+
   'e'#000+
   '04031_E_Can'#039't assign values to an address'#000+
-  '04032_E_Ca','n'#039't assign values to const variable'#000+
-  '04033_E_Array type required'#000+
+  '04032_E_Can'#039't assign values to const variable'#000+
+  '04033_E_Array typ','e required'#000+
   '04034_E_interface type expected, but got "$1"'#000+
   '04035_W_Mixing signed expressions and longwords gives a 64bit result'#000+
-  '04036_W_Mixing signed expressions and cardinals here may caus','e a ran'+
-  'ge check error'#000+
-  '04037_E_Typecast has different size ($1 -> $2) in assignment'#000+
+  '04036_W_Mixing signed expressions and cardinals here may cause a range'+
+  ' check error'#000+
+  '04037_E_Typecast has different ','size ($1 -> $2) in assignment'#000+
   '04038_E_enums with assignments can'#039't be used as array index'#000+
   '04039_E_Class or Object types "$1" and "$2" are not related'#000+
-  '04040_W_Class types "$1" and "$2" are',' not related'#000+
-  '04041_E_Class or interface type expected, but got "$1"'#000+
+  '04040_W_Class types "$1" and "$2" are not related'#000+
+  '04041_E_Class or interface type expected',', but got "$1"'#000+
   '04042_E_Type "$1" is not completely defined'#000+
   '04043_W_String literal has more characters than short string length'#000+
   '04044_W_Comparison is always false due to range of values'#000+
-  '04','045_W_Comparison is always true due to range of values'#000+
+  '04045_W_Comparison is always true due to range of value','s'#000+
   '04046_W_Constructing a class "$1" with abstract methods'#000+
   '04047_H_The left operand of the IN operator should be byte sized'#000+
-  '04048_W_Type size mismatch, possible loss of data / range check ','erro'+
+  '04048_W_Type size mismatch, possible loss of data / range check error'#000+
+  '04049_H_Type size mismatch, possible loss of da','ta / range check erro'+
   'r'#000+
-  '04049_H_Type size mismatch, possible loss of data / range check error'#000+
   '04050_E_The address of an abstract method can'#039't be taken'#000+
   '04051_E_The operator is not applicable for the operand type'#000+
   '04052_E_Constant Expression expected'#000+
-  '04053_E_Op','eration "$1" not supported types "$2" and "$3"'#000+
+  '04053_E_Operation "$1" not supported types "$2" and "$3"'#000+
+  '04054_','E_Illegal type conversion: "$1" to "$2"'#000+
+  '04055_H_Conversion between ordinals and pointers is not portable'#000+
+  '04056_W_Conversion between ordinals and pointers is not portable'#000+
+  '04057_E_Can'#039't determine which overloaded function to call'#000+
+  '04058_E_Ille','gal counter variable'#000+
   '05000_E_Identifier not found "$1"'#000+
   '05001_F_Internal Error in SymTableStack()'#000+
   '05002_E_Duplicate identifier "$1"'#000+
   '05003_H_Identifier already defined in $1 at line $2'#000+
-  '05004_E_Unknown identifier "$1"',#000+
-  '05005_E_Forward declaration not solved "$1"'#000+
+  '05004_E_Unknown identifier "$1"'#000+
+  '05005_E_Forward declarati','on not solved "$1"'#000+
   '05007_E_Error in type definition'#000+
   '05009_E_Forward type not resolved "$1"'#000+
   '05010_E_Only static variables can be used in static methods or outside'+
   ' methods'#000+
   '05012_F_record or class type expected'#000+
-  '05013_','E_Instances of classes or objects with an abstract method are '+
+  '05013_E_Instances of classes or ','objects with an abstract method are '+
   'not allowed'#000+
   '05014_W_Label not defined "$1"'#000+
   '05015_E_Label used but not defined "$1"'#000+
   '05016_E_Illegal label declaration'#000+
   '05017_E_GOTO and LABEL are not supported (use switch -Sg)'#000+
-  '050','18_E_Label not found'#000+
-  '05019_E_identifier isn'#039't a label'#000+
+  '05018_E_Label not found'#000+
+  '05019','_E_identifier isn'#039't a label'#000+
   '05020_E_label already defined'#000+
   '05021_E_illegal type declaration of set elements'#000+
   '05022_E_Forward class definition not resolved "$1"'#000+
   '05023_H_Unit "$1" not used in $2'#000+
-  '05024_H_Parameter "$1" ','not used'#000+
-  '05025_N_Local variable "$1" not used'#000+
+  '05024_H_Parameter "$1" not used'#000+
+  '05025_N_Local var','iable "$1" not used'#000+
   '05026_H_Value parameter "$1" is assigned but never used'#000+
   '05027_N_Local variable "$1" is assigned but never used'#000+
   '05028_H_Local $1 "$2" is not used'#000+
   '05029_N_Private field "$1.$2" is never used'#000+
-  '05030','_N_Private field "$1.$2" is assigned but never used'#000+
+  '05030_N_Private field "$1.$2" i','s assigned but never used'#000+
   '05031_N_Private method "$1.$2" never used'#000+
   '05032_E_Set type expected'#000+
   '05033_W_Function result does not seem to be set'#000+
   '05034_W_Type "$1" is not aligned correctly in current record for C'#000+
-  '05035','_E_Unknown record field identifier "$1"'#000+
+  '05035_E_Unknown record field id','entifier "$1"'#000+
   '05036_W_Local variable "$1" does not seem to be initialized'#000+
   '05037_W_Variable "$1" does not seem to be initialized'#000+
   '05038_E_identifier idents no member "$1"'#000+
   '05039_H_Found declaration: $1'#000+
-  '05040_E_Data el','ement too large'#000+
-  '05042_E_No matching implementation for interface method "$1" found'#000+
+  '05040_E_Data element too large'#000+
+  '05042_E_No',' matching implementation for interface method "$1" found'#000+
   '05043_W_Symbol "$1" is deprecated'#000+
   '05044_W_Symbol "$1" is not portable'#000+
   '05055_W_Symbol "$1" is not implemented'#000+
-  '05056_E_Can'#039't create unique type from this type'#000,
-  '06000_E_BREAK not allowed'#000+
-  '06001_E_CONTINUE not allowed'#000+
-  '06002_E_Expression too complicated - FPU stack overflow'#000+
-  '06003_E_Illegal expression'#000+
-  '06004_E_Invalid integer expression'#000+
-  '06005_E_Illegal qualifier'#000+
-  '06006_E_High range limit < low range limi','t'#000+
-  '06007_E_Illegal counter variable'#000+
-  '06008_E_Can'#039't determine which overloaded function to call'#000+
-  '06009_E_Parameter list size exceeds 65535 bytes'#000+
-  '06010_E_Illegal type conversion: "$1" to "$2"'#000+
-  '06011_H_Conversion between ordinals and pointers are ','not portable'#000+
+  '05056_E_Can'#039't create unique type from this type'#000+
+  '06009_E_Parameter list siz','e exceeds 65535 bytes'#000+
   '06012_E_File types must be var parameters'#000+
   '06013_E_The use of a far pointer isn'#039't allowed there'#000+
-  '06014_E_illegal call by reference parameters'#000+
   '06015_E_EXPORT declared functions can'#039't be called'#000+
-  '06016_W_Possible illegal call of cons','tructor or destructor'#000+
-  '06017_N_Inefficient code'#000+
+  '06016_W_Possible illegal call of constructor or destructor'#000+
+  '06017_N_Ineffi','cient code'#000+
   '06018_W_unreachable code'#000+
   '06020_E_Abstract methods can'#039't be called directly'#000+
   '06027_DL_Register $1 weight $2 $3'#000+
   '06029_DL_Stack frame is omitted'#000+
   '06031_E_Object or class methods can'#039't be inline.'#000+
-  '060','32_E_Procvar calls cannot be inline.'#000+
+  '06032_E_Procvar calls cannot be inline.',#000+
   '06033_E_No code for inline procedure stored'#000+
   '06035_E_Element zero of an ansi/wide- or longstring can'#039't be acces'+
   'sed, use (set)length instead'#000+
-  '06037_E_Constructors or destructors can not be called inside a '#039,'w'+
-  'ith'#039' clause'#000+
-  '06038_E_Cannot call message handler methods directly'#000+
+  '06037_E_Constructors or destructors can not be called inside a '#039'wi'+
+  'th'#039' clause'#000+
+  '06038_E_Cannot call mes','sage handler methods directly'#000+
   '06039_E_Jump in or outside of an exception block'#000+
   '06040_E_Control flow statements aren'#039't allowed in a finally block'#000+
   '06041_W_Parameters size exceeds limit for certain cpu'#039's'#000+
-  '060','42_W_Local variable size exceed limit for certain cpu'#039's'#000+
+  '06042_W_Local variable size exceed limi','t for certain cpu'#039's'#000+
   '06043_E_Local variables size exceeds supported limit'#000+
+  '06044_E_BREAK not allowed'#000+
+  '06045_E_CONTINUE not allowed'#000+
   '07000_DL_Starting $1 styled assembler parsing'#000+
   '07001_DL_Finished $1 styled assembler parsing'#000+
-  '07002_E_Non-label pattern contains @'#000+
-  '07','004_E_Error building record offset'#000+
+  '07002_E_Non-label pa','ttern contains @'#000+
+  '07004_E_Error building record offset'#000+
   '07005_E_OFFSET used without identifier'#000+
   '07006_E_TYPE used without identifier'#000+
   '07007_E_Cannot use local variable or parameters here'#000+
   '07008_E_need to use OFFSET here'#000+
-  '07009_E_need to use $ here'#000+
-  '07010_E_Cannot us','e multiple relocatable symbols'#000+
+  '07009_E_need to use $ her','e'#000+
+  '07010_E_Cannot use multiple relocatable symbols'#000+
   '07011_E_Relocatable symbol can only be added'#000+
   '07012_E_Invalid constant expression'#000+
   '07013_E_Relocatable symbol is not allowed'#000+
   '07014_E_Invalid reference syntax'#000+
-  '07015_E_You can not reach $1 from that code'#000+
-  '07016_E_L','ocal symbols/labels aren'#039't allowed as references'#000+
+  '07015_E_You can not reach $1 from ','that code'#000+
+  '07016_E_Local symbols/labels aren'#039't allowed as references'#000+
   '07017_E_Invalid base and index register usage'#000+
   '07018_W_Possible error in object field handling'#000+
   '07019_E_Wrong scale factor specified'#000+
   '07020_E_Multiple index register usage'#000+
-  '07021_E_Invalid operan','d type'#000+
+  '070','21_E_Invalid operand type'#000+
   '07022_E_Invalid string as opcode operand: $1'#000+
   '07023_W_@CODE and @DATA not supported'#000+
   '07024_E_Null label references are not allowed'#000+
   '07025_E_Divide by zero in asm evaluator'#000+
   '07026_E_Illegal expression'#000+
-  '07027_E_escape sequence ignored: $1'#000+
-  '0','7028_E_Invalid symbol reference'#000+
+  '07027_E_escape seq','uence ignored: $1'#000+
+  '07028_E_Invalid symbol reference'#000+
   '07029_W_Fwait can cause emulation problems with emu387'#000+
   '07030_W_$1 without operand translated into $1P'#000+
   '07031_W_ENTER instruction is not supported by Linux kernel'#000+
-  '07032_W_Calling an overload function in assembl','er'#000+
+  '07032_W_Calling an overload ','function in assembler'#000+
   '07033_E_Unsupported symbol type for operand'#000+
   '07034_E_Constant value out of bounds'#000+
   '07035_E_Error converting decimal $1'#000+
   '07036_E_Error converting octal $1'#000+
   '07037_E_Error converting binary $1'#000+
-  '07038_E_Error converting hexadecimal $1'#000+
-  '07039_H_$1 ','translated to $2'#000+
+  '07038_E_Error converting hexadec','imal $1'#000+
+  '07039_H_$1 translated to $2'#000+
   '07040_W_$1 is associated to an overloaded function'#000+
   '07041_E_Cannot use SELF outside a method'#000+
   '07042_E_Cannot use OLDEBP outside a nested procedure'#000+
   '07043_W_Procedures can'#039't return any value in asm code'#000+
-  '07044_E_SEG not supporte','d'#000+
+  '07044','_E_SEG not supported'#000+
   '07045_E_Size suffix and destination or source size do not match'#000+
   '07046_W_Size suffix and destination or source size do not match'#000+
   '07047_E_Assembler syntax error'#000+
   '07048_E_Invalid combination of opcode and operands'#000+
-  '07049_E_Assembler syntax err','or in operand'#000+
+  '07049_E_A','ssembler syntax error in operand'#000+
   '07050_E_Assembler syntax error in constant'#000+
   '07051_E_Invalid String expression'#000+
   '07052_W_constant with symbol $1 for address which is not on a pointer'#000+
   '07053_E_Unrecognized opcode $1'#000+
-  '07054_E_Invalid or missing opcode'#000+
-  '07055_E_Invali','d combination of prefix and opcode: $1'#000+
+  '07054_E_Invalid or missing op','code'#000+
+  '07055_E_Invalid combination of prefix and opcode: $1'#000+
   '07056_E_Invalid combination of override and opcode: $1'#000+
   '07057_E_Too many operands on line'#000+
   '07058_W_NEAR ignored'#000+
   '07059_W_FAR ignored'#000+
   '07060_E_Duplicate local symbol $1'#000+
-  '07061_E_Undefined local symbol $1'#000+
-  '070','62_E_Unknown label identifier $1'#000+
+  '07061_E_Undefined ','local symbol $1'#000+
+  '07062_E_Unknown label identifier $1'#000+
   '07063_E_Invalid register name'#000+
   '07064_E_Invalid floating point register name'#000+
   '07066_W_Modulo not supported'#000+
   '07067_E_Invalid floating point constant $1'#000+
-  '07068_E_Invalid floating point expression'#000+
-  '07069_E_Wrong symb','ol type'#000+
+  '07068_E_Invalid floating point expression',#000+
+  '07069_E_Wrong symbol type'#000+
   '07070_E_Cannot index a local var or parameter with a register'#000+
   '07071_E_Invalid segment override expression'#000+
   '07072_W_Identifier $1 supposed external'#000+
   '07073_E_Strings not allowed as constants'#000+
-  '07074_No type of variable specified'#000+
-  '07075_E_a','ssembler code not returned to text section'#000+
+  '07074_No type of variable ','specified'#000+
+  '07075_E_assembler code not returned to text section'#000+
   '07076_E_Not a directive or local symbol $1'#000+
   '07077_E_Using a defined name as a local label'#000+
   '07078_E_Dollar token is used without an identifier'#000+
-  '07079_W_32bit constant created for address'#000+
-  '07080_N_.align',' is target specific, use .balign or .p2align'#000+
+  '07079_W_32bit constant created for add','ress'#000+
+  '07080_N_.align is target specific, use .balign or .p2align'#000+
   '07081_E_Can'#039't access fields directly for parameters'#000+
   '07082_E_Can'#039't access fields of objects/classes directly'#000+
-  '07083_E_No size specified and unable to determine the size of the oper'+
-  'ands'#000+
-  '07084_E_Cann','ot use RESULT in this function'#000+
+  '07083_E_No size specified and unable to determine the size of the op','e'+
+  'rands'#000+
+  '07084_E_Cannot use RESULT in this function'#000+
   '07086_W_"$1" without operand translated into "$1 %st,%st(1)"'#000+
   '07087_W_"$1 %st(n)" translated into "$1 %st,%st(n)"'#000+
   '07088_W_"$1 %st(n)" translated into "$1 %st(n),%st"'#000+
-  '07089_E_Char < not allowed here'#000+
-  '07090_E_Char',' > not allowed here'#000+
+  '07089_E_Char < not allowe','d here'#000+
+  '07090_E_Char > not allowed here'#000+
   '07093_W_ALIGN not supported'#000+
   '07094_E_Inc and Dec cannot be together'#000+
   '07095_E_Invalid reglist for movem'#000+
   '07096_E_Reglist invalid for opcode'#000+
   '07097_E_Higher cpu mode required ($1)'#000+
-  '07098_W_No size specified and unable to determ','ine the size of the op'+
+  '07098_W_No size specified a','nd unable to determine the size of the op'+
   'erands, using DWORD as default'#000+
   '08000_F_Too many assembler files'#000+
   '08001_F_Selected assembler output not supported'#000+
   '08002_F_Comp not supported'#000+
   '08003_F_Direct not support for binary writers'#000+
-  '08004_E_Allocating of data is onl','y allowed in bss section'#000+
+  '08004_E_Alloca','ting of data is only allowed in bss section'#000+
   '08005_F_No binary writer selected'#000+
   '08006_E_Asm: Opcode $1 not in table'#000+
   '08007_E_Asm: $1 invalid combination of opcode and operands'#000+
   '08008_E_Asm: 16 Bit references not supported'#000+
-  '08009_E_Asm: Invalid effective address'#000+
-  '08','010_E_Asm: Immediate or reference expected'#000+
+  '08009_E_Asm: Invalid e','ffective address'#000+
+  '08010_E_Asm: Immediate or reference expected'#000+
   '08011_E_Asm: $1 value exceeds bounds $2'#000+
   '08012_E_Asm: Short jump is out of range $1'#000+
   '08013_E_Asm: Undefined label $1'#000+
   '08014_E_Asm: Comp type not supported for this target'#000+
-  '08015_E_Asm: Extended type no','t supported for this target'#000+
+  '08015_E_As','m: Extended type not supported for this target'#000+
   '08016_E_Asm: Duplicate label $1'#000+
   '08017_E_Asm: Redefined label $1'#000+
   '08018_E_Asm: First defined here'#000+
   '08019_E_Asm: Invalid register $1'#000+
   '09000_W_Source operating system redefined'#000+
-  '09001_I_Assembling (pipe) $1'#000+
-  '09002_E_Can'#039,'t create assember file: $1'#000+
+  '09001_I_Assembling (pi','pe) $1'#000+
+  '09002_E_Can'#039't create assember file: $1'#000+
   '09003_E_Can'#039't create object file: $1'#000+
   '09004_E_Can'#039't create archive file: $1'#000+
   '09005_E_Assembler $1 not found, switching to external assembling'#000+
   '09006_T_Using assembler: $1'#000+
-  '09007_E_Error while assembling exitcode $1'#000+
-  '09','008_E_Can'#039't call the assembler, error $1 switching to external'+
-  ' assembling'#000+
+  '09007_E_Error while assemb','ling exitcode $1'#000+
+  '09008_E_Can'#039't call the assembler, error $1 switching to external a'+
+  'ssembling'#000+
   '09009_I_Assembling $1'#000+
   '09010_I_Assembling with smartlinking $1'#000+
   '09011_W_Object $1 not found, Linking may fail !'#000+
-  '09012_W_Library $1 not found, Linking may fail !'#000+
-  '09013_E','_Error while linking'#000+
+  '09012_W_Library $1 not found, Linking',' may fail !'#000+
+  '09013_E_Error while linking'#000+
   '09014_E_Can'#039't call the linker, switching to external linking'#000+
   '09015_I_Linking $1'#000+
   '09016_E_Util $1 not found, switching to external linking'#000+
   '09017_T_Using util $1'#000+
-  '09018_E_Creation of Executables not supported'#000+
-  '09019_E_Creati','on of Dynamic/Shared Libraries not supported'#000+
+  '09018_E_Creation of Executables not suppo','rted'#000+
+  '09019_E_Creation of Dynamic/Shared Libraries not supported'#000+
   '09020_I_Closing script $1'#000+
   '09021_E_resource compiler not found, switching to external mode'#000+
   '09022_I_Compiling resource $1'#000+
-  '09023_T_unit $1 can'#039't be statically linked, switching to smart lin'+
-  'king'#000+
-  '0902','4_T_unit $1 can'#039't be smart linked, switching to static linki'+
-  'ng'#000+
+  '09023_T_unit $1 can'#039't be statically linked, switching to',' smart l'+
+  'inking'#000+
+  '09024_T_unit $1 can'#039't be smart linked, switching to static linking'+
+  #000+
   '09025_T_unit $1 can'#039't be shared linked, switching to static linkin'+
   'g'#000+
   '09026_E_unit $1 can'#039't be smart or static linked'#000+
-  '09027_E_unit $1 can'#039't be shared or static linked'#000+
-  '09028_F_Can'#039,'t post process executable $1'#000+
+  '09027_E_unit $1 can'#039't be shared or static ','linked'#000+
+  '09028_F_Can'#039't post process executable $1'#000+
   '09029_F_Can'#039't open executable $1'#000+
   '09030_X_Size of Code: $1 bytes'#000+
   '09031_X_Size of initialized data: $1 bytes'#000+
   '09032_X_Size of uninitialized data: $1 bytes'#000+
   '09033_X_Stack space reserved: $1 bytes'#000+
-  '09034_X_Stack space ','commited: $1 bytes'#000+
+  '0','9034_X_Stack space commited: $1 bytes'#000+
   '10000_T_Unitsearch: $1'#000+
   '10001_T_PPU Loading $1'#000+
   '10002_U_PPU Name: $1'#000+
@@ -592,105 +592,105 @@ const msgtxt : array[0..000152,1..240] of char=(
   '10004_U_PPU Crc: $1'#000+
   '10005_U_PPU Time: $1'#000+
   '10006_U_PPU File too short'#000+
-  '10007_U_PPU Invalid Header (no PPU at the begin)'#000+
-  '10008_U_PPU Inv','alid Version $1'#000+
+  '10007_U_PPU Invalid Header (no PPU at the beg','in)'#000+
+  '10008_U_PPU Invalid Version $1'#000+
   '10009_U_PPU is compiled for another processor'#000+
   '10010_U_PPU is compiled for an other target'#000+
   '10011_U_PPU Source: $1'#000+
   '10012_U_Writing $1'#000+
   '10013_F_Can'#039't Write PPU-File'#000+
   '10014_F_Error reading PPU-File'#000+
-  '10015_F_unexpected end of PPU-Fi','le'#000+
+  '10015_F_unexp','ected end of PPU-File'#000+
   '10016_F_Invalid PPU-File entry: $1'#000+
   '10017_F_PPU Dbx count problem'#000+
   '10018_E_Illegal unit name: $1'#000+
   '10019_F_Too much units'#000+
   '10020_F_Circular unit reference between $1 and $2'#000+
-  '10021_F_Can'#039't compile unit $1, no sources available'#000+
-  '10022_F_Can'#039't fin','d unit $1'#000+
+  '10021_F_Can'#039't compile unit $1, no sources availabl','e'#000+
+  '10022_F_Can'#039't find unit $1'#000+
   '10023_W_Unit $1 was not found but $2 exists'#000+
   '10024_F_Unit $1 searched but $2 found'#000+
   '10025_W_Compiling the system unit requires the -Us switch'#000+
   '10026_F_There were $1 errors compiling module, stopping'#000+
-  '10027_U_Load from $1 ($2) unit $3'#000,
+  '10027_U_Load fr','om $1 ($2) unit $3'#000+
   '10028_U_Recompiling $1, checksum changed for $2'#000+
   '10029_U_Recompiling $1, source found only'#000+
   '10030_U_Recompiling unit, static lib is older than ppufile'#000+
   '10031_U_Recompiling unit, shared lib is older than ppufile'#000+
-  '10032_U_Recompiling unit, obj an','d asm are older than ppufile'#000+
+  '10032_U_Recom','piling unit, obj and asm are older than ppufile'#000+
   '10033_U_Recompiling unit, obj is older than asm'#000+
   '10034_U_Parsing interface of $1'#000+
   '10035_U_Parsing implementation of $1'#000+
   '10036_U_Second load for unit $1'#000+
   '10037_U_PPU Check file $1 time $2'#000+
-  '10038_H_Conditional $1 was n','ot set at startup in last compilation of'+
+  '10038_H_C','onditional $1 was not set at startup in last compilation of'+
   ' $2'#000+
   '10039_H_Conditional $1 was set at startup in last compilation of $2'#000+
   '10040_W_Can'#039't recompile unit $1, but found modifed include files'#000+
-  '10041_H_File $1 is newer than Release PPU file $2'#000+
-  '10042_U_Using',' a unit which was not compiled with correct FPU mode'#000+
+  '10041_H_File $1 is newer than Release PPU fi','le $2'#000+
+  '10042_U_Using a unit which was not compiled with correct FPU mode'#000+
   '10043_U_Loading interface units from $1'#000+
   '10044_U_Loading implementation units from $1'#000+
   '10045_U_Interface CRC changed for unit $1'#000+
-  '10046_U_Implementation CRC changed for unit $1'#000+
-  '10047_U_Finis','hed compiling unit $1'#000+
+  '10046_U_Implementation CRC changed for un','it $1'#000+
+  '10047_U_Finished compiling unit $1'#000+
   '10048_U_Add dependency of $1 to $2'#000+
   '10049_U_No reload, is caller: $1'#000+
   '10050_U_No reload, already in second compile: $1'#000+
   '10051_U_Flag for reload: $1'#000+
   '10052_U_Forced reloading'#000+
-  '10053_U_Previous state of $1: $2'#000+
-  '10054_U_Already',' compiling $1, setting second compile'#000+
+  '10053_U_Previous state of $1:',' $2'#000+
+  '10054_U_Already compiling $1, setting second compile'#000+
   '10055_U_Loading unit $1'#000+
   '10056_U_Finished loading unit $1'#000+
   '10057_U_Registering new unit $1'#000+
   '10058_U_Re-resolving unit $1'#000+
   '10059_U_Skipping re-resolving unit $1, still loading used units'#000+
-  '11000_$1 [options] <','inputfile> [options]'#000+
+  '1','1000_$1 [options] <inputfile> [options]'#000+
   '11001_W_Only one source file supported'#000+
   '11002_W_DEF file can be created only for OS/2'#000+
   '11003_E_nested response files are not supported'#000+
   '11004_F_No source file name in command line'#000+
-  '11005_N_No option inside $1 config file'#000+
-  '11','006_E_Illegal parameter: $1'#000+
+  '11005_N_No option insid','e $1 config file'#000+
+  '11006_E_Illegal parameter: $1'#000+
   '11007_H_-? writes help pages'#000+
   '11008_F_Too many config files nested'#000+
   '11009_F_Unable to open file $1'#000+
   '11010_D_Reading further options from $1'#000+
   '11011_W_Target is already set to: $1'#000+
-  '11012_W_Shared libs not supported on D','OS platform, reverting to stat'+
+  '11012_W_Shared libs',' not supported on DOS platform, reverting to stat'+
   'ic'#000+
   '11013_F_too many IF(N)DEFs'#000+
   '11014_F_too many ENDIFs'#000+
   '11015_F_open conditional at the end of the file'#000+
   '11016_W_Debug information generation is not supported by this executab'+
   'le'#000+
-  '11017_H_Try recompiling with -dGDB'#000,
+  '11017_H_Try reco','mpiling with -dGDB'#000+
   '11018_E_You are using the obsolete switch $1'#000+
   '11019_E_You are using the obsolete switch $1, please use $2'#000+
   '11020_N_Switching assembler to default source writing assembler'#000+
-  '11021_W_Assembler output selected "$1" is not compatible with "$2"'#000+
-  '1102','2_W_"$1" assembler use forced'#000+
+  '11021_W_Assembler output selected "$1" is not compat','ible with "$2"'#000+
+  '11022_W_"$1" assembler use forced'#000+
   '11026_T_Reading options from file $1'#000+
   '11027_T_Reading options from environment $1'#000+
   '11028_D_Handling option "$1"'#000+
   '11029__*** press enter ***'#000+
   '11030_H_Start of reading config file $1'#000+
-  '11031_H_End of reading config fil','e $1'#000+
+  '11031_H_End of',' reading config file $1'#000+
   '11032_D_interpreting option "$1"'#000+
   '11036_D_interpreting firstpass option "$1"'#000+
   '11033_D_interpreting file option "$1"'#000+
   '11034_D_Reading config file "$1"'#000+
   '11035_D_found source file name "$1"'#000+
   '11037_D_Defining symbol $1'#000+
-  '11038_D_Undefining symbol',' $1'#000+
+  '11038_','D_Undefining symbol $1'#000+
   '11039_E_Unknown code page'#000+
   '11023_Free Pascal Compiler version $FPCVER [$FPCDATE] for $FPCTARGET'#010+
   'Copyright (c) 1993-2004 by Florian Klaempfl'#000+
   '11024_Free Pascal Compiler version $FPCVER'#010+
   #010+
   'Compiler Date  : $FPCDATE'#010+
-  'Compiler Target: $FPCTARGET',#010+
+  'Compiler',' Target: $FPCTARGET'#010+
   #010+
   'Supported targets:'#010+
   '  $OSTARGETS'#010+
@@ -700,188 +700,191 @@ const msgtxt : array[0..000152,1..240] of char=(
   #010+
   'Report bugs,suggestions etc to:'#010+
   '                 [email protected]'#000+
-  '11025_**0*_put + after a boolean switch',' option to enable it, - to di'+
+  '11025_**0*_put + aft','er a boolean switch option to enable it, - to di'+
   'sable it'#010+
   '**1a_the compiler doesn'#039't delete the generated assembler file'#010+
   '**2al_list sourcecode lines in assembler file'#010+
   '**2ar_list register allocation/release info in assembler file'#010+
-  '**2at_list temp allocation/relea','se info in assembler file'#010+
+  '**2at_list te','mp allocation/release info in assembler file'#010+
   '**1b_generate browser info'#010+
   '**2bl_generate local symbol info'#010+
   '**1B_build all modules'#010+
   '**1C<x>_code generation options:'#010+
   '**2CD_create also dynamic library (not supported)'#010+
-  '**2Ce_Compilation with emulated floating point o','pcodes'#010+
+  '**2Ce_Compilation with emulat','ed floating point opcodes'#010+
   '**2Cf_Select fpu instruction set to use'#010+
   '**2Cg_Generate PIC code'#010+
   '**2Ch<n>_<n> bytes heap (between 1023 and 67107840)'#010+
   '**2Ci_IO-checking'#010+
   '**2Cn_omit linking stage'#010+
   '**2Co_check overflow of integer operations'#010+
-  '**2Cr_range checking'#010+
-  '**2CR_veri','fy object method call validity'#010+
+  '**2Cr_range ','checking'#010+
+  '**2CR_verify object method call validity'#010+
   '**2Cs<n>_set stack size to <n>'#010+
   '**2Ct_stack checking'#010+
   '**2CX_create also smartlinked library'#010+
   '**1d<x>_defines the symbol <x>'#010+
   '*O1D_generate a DEF file'#010+
   '*O2Dd<x>_set description to <x>'#010+
-  '*O2Dw_PM application'#010+
-  '**1e<x>_se','t path to executable'#010+
+  '*O2Dw_PM app','lication'#010+
+  '**1e<x>_set path to executable'#010+
   '**1E_same as -Cn'#010+
   '**1F<x>_set file names and paths:'#010+
   '**2FD<x>_sets the directory where to search for compiler utilities'#010+
   '**2Fe<x>_redirect error output to <x>'#010+
   '**2FE<x>_set exe/unit output path to <x>'#010+
-  '**2Fi<x>_adds <x> to i','nclude path'#010+
+  '**2','Fi<x>_adds <x> to include path'#010+
   '**2Fl<x>_adds <x> to library path'#010+
   '*L2FL<x>_uses <x> as dynamic linker'#010+
   '**2Fo<x>_adds <x> to object path'#010+
   '**2Fr<x>_load error message file <x>'#010+
   '**2Fu<x>_adds <x> to unit path'#010+
-  '**2FU<x>_set unit output path to <x>, overrides -FE'#010+
-  '*g1g_','generate debugger information:'#010+
+  '**2FU<x>_set unit output path to <x>, ','overrides -FE'#010+
+  '*g1g_generate debugger information:'#010+
   '*g2gg_use gsym'#010+
   '*g2gd_use dbx'#010+
   '*g2gh_use heap trace unit (for memory leak debugging)'#010+
   '*g2gl_use line info unit to show more info for backtraces'#010+
   '*g2gc_generate checks for pointers'#010+
+  '*g2gv_generate','s programs tracable with valygrind'#010+
+  '*g2gw_generate dwarf debugging info'#010+
   '**1i_information'#010+
-  '**2iD_return com','piler date'#010+
+  '**2iD_return compiler date'#010+
   '**2iV_return compiler version'#010+
   '**2iSO_return compiler OS'#010+
   '**2iSP_return compiler processor'#010+
   '**2iTO_return target OS'#010+
-  '**2iTP_return target processor'#010+
+  '**2iTP_retur','n target processor'#010+
   '**1I<x>_adds <x> to include path'#010+
   '**1k<x>_Pass <x> to the linker'#010+
   '**1l_write logo'#010+
-  '**1M<','x>_set language mode to <x>'#010+
+  '**1M<x>_set language mode to <x>'#010+
   '**2Mfpc_free pascal dialect (default)'#010+
   '**2Mobjfpc_switch some Delphi 2 extensions on'#010+
-  '**2Mdelphi_tries to be Delphi compatible'#010+
+  '**2Mdelphi_tries to be D','elphi compatible'#010+
   '**2Mtp_tries to be TP/BP 7.0 compatible'#010+
   '**2Mgpc_tries to be gpc compatible'#010+
-  '**2Mmacpas_t','ries to be compatible to the macintosh pascal dialects'#010+
+  '**2Mmacpas_tries to be compatible to the macintosh pascal dialects'#010+
   '**1n_don'#039't read the default config file'#010+
-  '**1o<x>_change the name of the executable produced to <x>'#010+
+  '**1o<x>_change the name of the executable',' produced to <x>'#010+
   '**1pg_generate profile code for gprof (defines FPC_PROFILE)'#010+
-  '*L1P_use pipes instead of c','reating temporary assembler files'#010+
+  '*L1P_use pipes instead of creating temporary assembler files'#010+
   '**1S<x>_syntax options:'#010+
   '**2S2_same as -Mobjfpc'#010+
   '**2Sc_supports operators like C (*=,+=,/= and -=)'#010+
-  '**2Sa_include assertion code.'#010+
+  '**2Sa','_include assertion code.'#010+
   '**2Sd_same as -Mdelphi'#010+
-  '**2Se<x>_compiler stops after the <x> errors (default is',' 1)'#010+
+  '**2Se<x>_compiler stops after the <x> errors (default is 1)'#010+
   '**2Sg_allow LABEL and GOTO'#010+
   '**2Sh_Use ansistrings'#010+
   '**2Si_support C++ styled INLINE'#010+
   '**2Sm_support macros like C (global)'#010+
-  '**2So_same as -Mtp'#010+
+  '**2So_same as ','-Mtp'#010+
   '**2Sp_same as -Mgpc'#010+
   '**2Ss_constructor name must be init (destructor must be done)'#010+
-  '**2St_allow stati','c keyword in objects'#010+
+  '**2St_allow static keyword in objects'#010+
   '**1s_don'#039't call assembler and linker'#010+
   '**2sh_Generate script to link on host'#010+
-  '**2st_Generate script to link on target'#010+
+  '**2st_Generate script to link on target'#010,
   '**2sr_Skip register allocation phase (optimizations will be disabled)'#010+
   '**1u<x>_undefines the symbol <x>'#010+
-  '*','*1U_unit options:'#010+
+  '**1U_unit options:'#010+
   '**2Un_don'#039't check the unit name'#010+
   '**2Ur_generate release unit files'#010+
   '**2Us_compile a system unit'#010+
-  '**1v<x>_Be verbose. <x> is a combination of the following letters:'#010+
+  '**1v<x>_Be verbose. <x> ','is a combination of the following letters:'#010+
   '**2*_e : Show errors (default)       d : Show debug info'#010+
-  '**2*','_w : Show warnings               u : Show unit info'#010+
+  '**2*_w : Show warnings               u : Show unit info'#010+
   '**2*_n : Show notes                  t : Show tried/used files'#010+
-  '**2*_h : Show hints                  m : Show defined macros'#010+
-  '**2*_i : Show general info           p : Show compiled procedure','s'#010+
+  '**2*_h : Show hints  ','                m : Show defined macros'#010+
+  '**2*_i : Show general info           p : Show compiled procedures'#010+
   '**2*_l : Show linenumbers            c : Show conditionals'#010+
   '**2*_a : Show everything             0 : Show nothing (except errors)'#010+
-  '**2*_b : Show all procedure          r : Rhide/GCC compatibility mode'#010+
-  '**2*_    declarations if an error    x ',': Executable info (Win32 only'+
-  ')'#010+
+  '**2*_','b : Show all procedure          r : Rhide/GCC compatibility mod'+
+  'e'#010+
+  '**2*_    declarations if an error    x : Executable info (Win32 only)'#010+
   '**2*_    occurs'#010+
   '**1V_write fpcdebug.txt file with lots of debugging info'#010+
   '**1X_executable options:'#010+
-  '*L2Xc_link with the c library'#010+
+  '*L2Xc_l','ink with the c library'#010+
   '**2Xs_strip all symbols from executable'#010+
-  '**2XD_try to link dynamic          (defin','es FPC_LINK_DYNAMIC)'#010+
-  '**2XS_try to link static (default) (defines FPC_LINK_STATIC)'#010+
+  '**2XD_try to link dynamic          (defines FPC_LINK_DYNAMIC)'#010+
+  '**2XP<x>_prepend the binutils names with the prefix <x>'#010+
+  '**2XS_try to link static (default) (defines FPC_LINK_STATIC',')'#010+
   '**2XX_try to link smart            (defines FPC_LINK_SMART)'#010+
   '**0*_Processor specific options:'#010+
   '3*1A<x>_output format:'#010+
   '3*2Aas_assemble using GNU AS'#010+
-  '3*2Anasmcoff_','coff (Go32v2) file using Nasm'#010+
+  '3*2Anasmcoff_coff (Go32v2) file using Nasm'#010+
   '3*2Anasmelf_elf32 (Linux) file using Nasm'#010+
-  '3*2Awasm_obj file using Wasm (Watcom)'#010+
+  '3*2Awasm','_obj file using Wasm (Watcom)'#010+
   '3*2Anasmobj_obj file using Nasm'#010+
   '3*2Amasm_obj file using Masm (Microsoft)'#010+
   '3*2Atasm_obj file using Tasm (Borland)'#010+
-  '3*2Acoff_coff (Go3','2v2) using internal writer'#010+
+  '3*2Acoff_coff (Go32v2) using internal writer'#010+
   '3*2Apecoff_pecoff (Win32) using internal writer'#010+
-  '3*1R<x>_assembler reading style:'#010+
+  '3*1R<','x>_assembler reading style:'#010+
   '3*2Ratt_read AT&T style assembler'#010+
   '3*2Rintel_read Intel style assembler'#010+
   '3*2Rdirect_copy assembler text directly to assembler file'#010+
-  '3*1','O<x>_optimizations:'#010+
+  '3*1O<x>_optimizations:'#010+
   '3*2Og_generate smaller code'#010+
-  '3*2OG_generate faster code (default)'#010+
+  '3*2OG_generate faster code (defa','ult)'#010+
   '3*2Or_keep certain variables in registers'#010+
   '3*2Ou_enable uncertain optimizations (see docs)'#010+
   '3*2O1_level 1 optimizations (quick optimizations)'#010+
-  '3*2O2_level 2 o','ptimizations (-O1 + slower optimizations)'#010+
-  '3*2O3_level 3 optimizations (-O2 repeatedly, max 5 times)'#010+
+  '3*2O2_level 2 optimizations (-O1 + slower optimizations)'#010+
+  '3*2O3_level 3 optimizations (-O2 repea','tedly, max 5 times)'#010+
   '3*2Op<x>_target processor:'#010+
   '3*3Op1_set target processor to 386/486'#010+
   '3*3Op2_set target processor to Pentium/PentiumMMX (tm)'#010+
-  '3*3Op3_set target p','rocessor to PPro/PII/c6x86/K6 (tm)'#010+
+  '3*3Op3_set target processor to PPro/PII/c6x86/K6 (tm)'#010+
   '3*1T<x>_Target operating system:'#010+
-  '3*2Temx_OS/2 via EMX (including EMX/RSX extender)'#010+
+  '3*2Temx_OS/2',' via EMX (including EMX/RSX extender)'#010+
   '3*2Tgo32v2_Version 2 of DJ Delorie DOS extender'#010+
   '3*2Tlinux_Linux'#010+
   '3*2Tnetware_Novell Netware Module (clib)'#010+
-  '3*2Tos2_OS/2 / eC','omStation'#010+
+  '3*2Tos2_OS/2 / eComStation'#010+
   '3*2Tsunos_SunOS/Solaris'#010+
   '3*2Twatcom_Watcom compatible DOS extender'#010+
-  '3*2Twdosx_WDOSX DOS extender'#010+
+  '3*2T','wdosx_WDOSX DOS extender'#010+
   '3*2Twin32_Windows 32 Bit'#010+
   '3*1W<x>_Win32-like target options'#010+
   '3*2WB<x>_Set Image base to Hexadecimal <x> value'#010+
-  '3*2WC_Specify console type ','application'#010+
+  '3*2WC_Specify console type application'#010+
   '3*2WD_Use DEFFILE to export functions of DLL or EXE'#010+
-  '3*2WF_Specify full-screen type application (OS/2 only)'#010+
+  '3*2WF_Specify fu','ll-screen type application (OS/2 only)'#010+
   '3*2WG_Specify graphic type application'#010+
   '3*2WN_Do not generate relocation code (necessary for debugging)'#010+
-  '3*2WR_Generate rel','ocation code'#010+
+  '3*2WR_Generate relocation code'#010+
   '6*1A<x>_output format'#010+
   '6*2Aas_Unix o-file using GNU AS'#010+
-  '6*2Agas_GNU Motorola assembler'#010+
+  '6*2Agas_GNU M','otorola assembler'#010+
   '6*2Amit_MIT Syntax (old GAS)'#010+
   '6*2Amot_Standard Motorola assembler'#010+
   '6*1O_optimizations:'#010+
   '6*2Oa_turn on the optimizer'#010+
   '6*2Og_generate smaller code'#010+
-  '6','*2OG_generate faster code (default)'#010+
+  '6*2OG_generate faster code (default)'#010+
   '6*2Ox_optimize maximum (still BUGGY!!!)'#010+
-  '6*2O0_set target processor to a MC68000'#010+
+  '6*2O','0_set target processor to a MC68000'#010+
   '6*2O2_set target processor to a MC68020+ (default)'#010+
   '6*1R<x>_assembler reading style:'#010+
   '6*2RMOT_read motorola style assembler'#010+
-  '6*','1T<x>_Target operating system:'#010+
+  '6*1T<x>_Target operating system:'#010+
   '6*2Tamiga_Commodore Amiga'#010+
-  '6*2Tatari_Atari ST/STe/TT'#010+
+  '6*2Tatari_Atari ST/STe/','TT'#010+
   '6*2Tlinux_Linux-68k'#010+
   '6*2Tmacos_Macintosh m68k (not supported)'#010+
   '6*2Tpalmos_PalmOS'#010+
   'P*1T<x>_Target operating system:'#010+
   'P*2Tdarwin_Darwin and MacOS X on PowerPC'#010+
-  'P*2T','linux_Linux on PowerPC'#010+
+  'P*2Tlinux_Linux on PowerPC'#010+
   'P*2Tmacos_MacOS (classic) on PowerPC'#010+
-  'P*2Tmorphos_MorphOS'#010+
+  'P*2Tmorphos_MorphOS'#010,
   'P*2WC_Specify console type application (MacOS only)'#010+
   'P*2WG_Specify graphic type application (MacOS only)'#010+
-  'P*2WT_Specify tool type application (MPW tool, MacOS onl','y)'#010+
+  'P*2WT_Specify tool type application (MPW tool, MacOS only)'#010+
   '**1*_'#010+
   '**1?_shows this help'#010+
   '**1h_shows this help without waiting'#000

compiler/nadd.pas

@@ -765,6 +765,15 @@ implementation
                   if (torddef(rd).typ<>scurrency) then
                    inserttypeconv(right,s64currencytype);
                end
+             { and,or,xor work on bit patterns and don't care
+               about the sign }
+             else if nodetype in [andn,orn,xorn] then
+               begin
+                 if rd.size>ld.size then
+                   inserttypeconv_explicit(left,right.resulttype)
+                 else
+                   inserttypeconv_explicit(right,left.resulttype);
+               end
              { is there a signed 64 bit type ? }
              else if ((torddef(rd).typ=s64bit) or (torddef(ld).typ=s64bit)) then
                begin
@@ -786,12 +795,23 @@ implementation
              { is there a cardinal? }
              else if ((torddef(rd).typ=u32bit) or (torddef(ld).typ=u32bit)) then
                begin
-                 { and,or,xor work on bit patterns and don't care
-                   about the sign }
-                 if nodetype in [andn,orn,xorn] then
+                 { convert positive constants to u32bit }
+                 if (torddef(ld).typ<>u32bit) and
+                    is_constintnode(left) and
+                    (tordconstnode(left).value >= 0) then
+                   inserttypeconv(left,u32inttype);
+                 if (torddef(rd).typ<>u32bit) and
+                    is_constintnode(right) and
+                    (tordconstnode(right).value >= 0) then
+                   inserttypeconv(right,u32inttype);
+                 { when one of the operand is signed perform
+                   the operation in 64bit, can't use rd/ld here because there
+                   could be already typeconvs inserted }
+                 if is_signed(left.resulttype.def) or is_signed(right.resulttype.def) then
                    begin
-                     inserttypeconv_explicit(left,u32inttype);
-                     inserttypeconv_explicit(right,u32inttype);
+                     CGMessage(type_w_mixed_signed_unsigned);
+                     inserttypeconv(left,s64inttype);
+                     inserttypeconv(right,s64inttype);
                    end
                  else
                    begin
@@ -1679,12 +1699,20 @@ implementation
                  end
                 else
                  begin
-                   expectloc:=LOC_FLAGS;
-                   if (left.expectloc in [LOC_JUMP,LOC_FLAGS]) and
-                      (left.expectloc in [LOC_JUMP,LOC_FLAGS]) then
-                     calcregisters(self,2,0,0)
+                   if nodetype in [ltn,lten,gtn,gten,equaln,unequaln] then
+                     begin
+                       expectloc:=LOC_FLAGS;
+                       if (left.expectloc in [LOC_JUMP,LOC_FLAGS]) and
+                          (left.expectloc in [LOC_JUMP,LOC_FLAGS]) then
+                         calcregisters(self,2,0,0)
+                       else
+                         calcregisters(self,1,0,0);
+                     end
                    else
-                     calcregisters(self,1,0,0);
+                     begin
+                       expectloc:=LOC_REGISTER;
+                       calcregisters(self,0,0,0);
+                     end;
                  end;
               end
              else
@@ -1706,7 +1734,11 @@ implementation
                   if nodetype in [addn,subn,muln,andn,orn,xorn] then
                     expectloc:=LOC_REGISTER
                   else
+{$ifdef sparc}
+                    expectloc:=LOC_FLAGS;
+{$else sparc}
                     expectloc:=LOC_JUMP;
+{$endif sparc}
                   calcregisters(self,2,0,0)
                end
 {$endif cpu64bit}
@@ -1978,7 +2010,44 @@ begin
 end.
 {
   $Log$
-  Revision 1.123  2004-05-28 21:13:44  peter
+  Revision 1.124  2004-06-16 20:07:07  florian
+    * dwarf branch merged
+
+  Revision 1.123  2004/05/28 21:13:44  peter
+    * fix cardinal+constint
+
+  Revision 1.122  2004/05/23 14:14:18  florian
+    + added set of widechar support (limited to 256 chars, is delphi compatible)
+
+  Revision 1.121  2004/05/23 14:08:39  peter
+    * only convert widechar to widestring when both operands are
+      constant
+    * support widechar-widechar operations in orddef part
+
+  Revision 1.120  2004/05/21 13:08:14  florian
+    * fixed <ordinal>+<pointer>
+
+  Revision 1.119  2004/05/20 21:54:33  florian
+    + <pointer> - <pointer> result is divided by the pointer element size now
+      this is delphi compatible as well as resulting in the expected result for p1+(p2-p1)
+
+  Revision 1.118  2004/05/19 23:29:26  peter
+    * don't change sign for unsigned shl/shr operations
+    * cleanup for u32bit
+
+  Revision 1.117  2004/04/29 19:56:37  daniel
+    * Prepare compiler infrastructure for multiple ansistring types
+
+  Revision 1.116  2004/04/18 07:52:43  florian
+    * fixed web bug 3048: comparision of dyn. arrays
+
+  Revision 1.115.2.3  2004/05/31 16:39:42  peter
+    * add ungetiftemp in a few locations
+
+  Revision 1.115.2.2  2004/05/30 10:45:50  peter
+    * merged fixes from main branch
+
+  Revision 1.123  2004/05/28 21:13:44  peter
     * fix cardinal+constint
 
   Revision 1.122  2004/05/23 14:14:18  florian
@@ -2006,6 +2075,9 @@ end.
   Revision 1.116  2004/04/18 07:52:43  florian
     * fixed web bug 3048: comparision of dyn. arrays
 
+  Revision 1.115.2.1  2004/05/02 21:26:28  peter
+    * for xor,or,and only typecast to the biggest size
+
   Revision 1.115  2004/03/29 14:44:10  peter
     * fixes to previous constant integer commit
 
@@ -2332,4 +2404,4 @@ end.
       with string operations
     * adapted some routines to use the new cg methods
 
-}
+}

compiler/nbas.pas

@@ -310,7 +310,7 @@ implementation
                 (assigned(tcallnode(left).funcretnode) or
                  (tcallnode(left).procdefinition.proctypeoption=potype_constructor))) and
             not(is_void(left.resulttype.def)) then
-           CGMessage(cg_e_illegal_expression);
+           CGMessage(parser_e_illegal_expression);
          if codegenerror then
            exit;
 
@@ -397,7 +397,7 @@ implementation
                       not((tcallnode(hp.left).procdefinition.proctypeoption=potype_constructor) and
                           assigned(tprocdef(tcallnode(hp.left).procdefinition)._class) and
                           is_object(tprocdef(tcallnode(hp.left).procdefinition)._class)) then
-                     CGMessagePos(hp.left.fileinfo,cg_e_illegal_expression);
+                     CGMessagePos(hp.left.fileinfo,parser_e_illegal_expression);
                    { the resulttype of the block is the last type that is
                      returned. Normally this is a voidtype. But when the
                      compiler inserts a block of multiple statements then the
@@ -1017,13 +1017,20 @@ begin
 end.
 {
   $Log$
-  Revision 1.83  2004-05-23 18:28:41  peter
+  Revision 1.84  2004-06-16 20:07:07  florian
+    * dwarf branch merged
+
+  Revision 1.83  2004/05/23 18:28:41  peter
     * methodpointer is loaded into a temp when it was a calln
 
   Revision 1.82  2004/05/23 15:06:20  peter
     * implicit_finally flag must be set in pass1
     * add check whether the implicit frame is generated when expected
 
+  Revision 1.81.2.1  2004/04/28 19:55:51  peter
+    * new warning for ordinal-pointer when size is different
+    * fixed some cg_e_ messages to the correct section type_e_ or parser_e_
+
   Revision 1.81  2004/03/10 20:41:17  peter
     * maybe_in_reg moved to tempinfo
     * fixed expectloc for maybe_in_reg
@@ -1332,4 +1339,4 @@ end.
     - list field removed of the tnode class because it's not used currently
       and can cause hard-to-find bugs
 
-}
+}

compiler/ncal.pas

@@ -63,6 +63,8 @@ interface
           procedure setfuncretnode(const returnnode: tnode);
           procedure convert_carg_array_of_const;
           procedure order_parameters;
+       protected
+          pushedparasize : longint;
        public
           { the symbol containing the definition of the procedure }
           { to call                                               }
@@ -415,6 +417,9 @@ type
                  end;
                  set_varstate(left,vs_used,true);
                  resulttype:=left.resulttype;
+                 { also update paraitem type to get the correct parameter location
+                   for the new types }
+                 paraitem.paratype:=left.resulttype;
                end
              else
               if (paraitem.is_hidden) then
@@ -1530,7 +1535,7 @@ type
                       { Multiple candidates left? }
                       if cand_cnt>1 then
                        begin
-                         CGMessage(cg_e_cant_choose_overload_function);
+                         CGMessage(type_e_cant_choose_overload_function);
 {$ifdef EXTDEBUG}
                          candidates.dump_info(V_Hint);
 {$else EXTDEBUG}
@@ -1852,12 +1857,14 @@ type
              procdefinition.has_paraloc_info:=true;
            end;
 
-         current_procinfo.maxpushedparasize:=max(current_procinfo.maxpushedparasize,procdefinition.requiredargarea);
-
-         { calculate the parameter info for varargs }
+         { calculate the parameter size needed for this call include varargs if they are available }
          if assigned(varargsparas) then
-           current_procinfo.maxpushedparasize:=max(current_procinfo.maxpushedparasize,
-             paramanager.create_varargs_paraloc_info(procdefinition,varargsparas));
+           pushedparasize:=paramanager.create_varargs_paraloc_info(procdefinition,varargsparas)
+         else
+           pushedparasize:=procdefinition.requiredargarea;
+
+         { record maximum parameter size used in this proc }
+         current_procinfo.allocate_push_parasize(pushedparasize);
 
          { work trough all parameters to get the register requirements }
          if assigned(left) then
@@ -1940,14 +1947,14 @@ type
                move them to memory after ... }
              if (resulttype.def.deftype=recorddef) then
               begin
-                expectloc:=LOC_CREFERENCE;
+                expectloc:=LOC_REFERENCE;
               end
              else
              { ansi/widestrings must be registered, so we can dispose them }
               if is_ansistring(resulttype.def) or
                  is_widestring(resulttype.def) then
                begin
-                 expectloc:=LOC_CREFERENCE;
+                 expectloc:=LOC_REFERENCE;
                  registersint:=1;
                end
              else
@@ -2140,7 +2147,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.237  2004-05-25 18:51:49  peter
+  Revision 1.238  2004-06-16 20:07:08  florian
+    * dwarf branch merged
+
+  Revision 1.237  2004/05/25 18:51:49  peter
     * fix tcallnode.getcopy. the parameters need to be copied after
       methodpointerinit is copied
 
@@ -2160,6 +2170,21 @@ end.
   Revision 1.232  2004/05/01 22:05:01  florian
     + added lib support for Amiga/MorphOS syscalls
 
+  Revision 1.231.2.4  2004/05/31 16:39:42  peter
+    * add ungetiftemp in a few locations
+
+  Revision 1.231.2.3  2004/05/03 20:54:00  peter
+    * update paraitem after varargs typeconvs have been inserted so
+      the parameter location uses the new type
+
+  Revision 1.231.2.2  2004/05/02 12:45:32  peter
+    * enabled cpuhasfixedstack for x86-64 again
+    * fixed size of temp allocation for parameters
+
+  Revision 1.231.2.1  2004/04/28 19:55:51  peter
+    * new warning for ordinal-pointer when size is different
+    * fixed some cg_e_ messages to the correct section type_e_ or parser_e_
+
   Revision 1.231  2004/03/14 20:07:13  peter
     * removed unused paravisible
 
@@ -2785,4 +2810,4 @@ end.
   Revision 1.78  2002/07/04 20:43:00  florian
     * first x86-64 patches
 
-}
+}

compiler/ncgadd.pas

@@ -292,7 +292,7 @@ interface
                    internalerror(43244);
                   if (right.location.loc = LOC_CONSTANT) then
                     cg.a_op_const_reg_reg(exprasmlist,OP_OR,location.size,
-                      aword(1 shl aword(right.location.value)),
+                      aint(1 shl right.location.value),
                       left.location.register,location.register)
                   else
                     begin
@@ -305,7 +305,7 @@ interface
                             left.location.register,location.register)
                       else
                         cg.a_op_const_reg_reg(exprasmlist,OP_OR,location.size,
-                            aword(left.location.value),tmpreg,location.register);
+                            left.location.value,tmpreg,location.register);
                       cg.ungetregister(exprasmlist,tmpreg);
                     end;
                   opdone := true;
@@ -338,7 +338,7 @@ interface
                     begin
                       tmpreg := cg.getintregister(exprasmlist,location.size);
                       cg.a_load_const_reg(exprasmlist,location.size,
-                        aword(left.location.value),tmpreg);
+                        left.location.value,tmpreg);
                       cg.a_op_reg_reg(exprasmlist,OP_NOT,location.size,right.location.register,right.location.register);
                       cg.a_op_reg_reg(exprasmlist,OP_AND,location.size,right.location.register,tmpreg);
                       cg.a_load_reg_reg(exprasmlist,OS_INT,location.size,tmpreg,location.register);
@@ -363,7 +363,7 @@ interface
               swapleftright;
             if (right.location.loc = LOC_CONSTANT) then
               cg.a_op_const_reg_reg(exprasmlist,cgop,location.size,
-                aword(right.location.value),left.location.register,
+                right.location.value,left.location.register,
                 location.register)
             else
               cg.a_op_reg_reg_reg(exprasmlist,cgop,location.size,
@@ -447,7 +447,7 @@ interface
                  location.register)
             else
               cg.a_op_const_reg_reg(exprasmlist,cgop,location.size,
-                 aword(right.location.value),left.location.register,
+                 right.location.value,left.location.register,
                  location.register);
          end;
 
@@ -507,11 +507,55 @@ interface
             internalerror(2002072705);
         end;
 
+{$ifdef cpu64bit}
         case nodetype of
           xorn,orn,andn,addn:
             begin
               if (right.location.loc = LOC_CONSTANT) then
-                cg64.a_op64_const_reg_reg(exprasmlist,op,right.location.valueqword,
+                cg.a_op_const_reg_reg(exprasmlist,op,location.size,right.location.value,
+                  left.location.register64,location.register)
+              else
+                cg.a_op_reg_reg_reg(exprasmlist,op,location.size,right.location.register,
+                  left.location.register64,location.register);
+            end;
+          subn:
+            begin
+              if (nf_swaped in flags) then
+                swapleftright;
+
+              if left.location.loc <> LOC_CONSTANT then
+                begin
+                  if (location.registerlow = NR_NO) then
+                    begin
+                     location.registerlow := cg.getintregister(exprasmlist,OS_INT);
+                     location.registerhigh := cg.getintregister(exprasmlist,OS_INT);
+                  end;
+                  if right.location.loc <> LOC_CONSTANT then
+                    // reg64 - reg64
+                    cg.a_op_reg_reg_reg(exprasmlist,OP_SUB,location.size,
+                      right.location.register,left.location.register,location.register)
+                  else
+                    // reg64 - const64
+                    cg.a_op_const_reg_reg(exprasmlist,OP_SUB,location.size,
+                      right.location.value,left.location.register,location.register);
+                end
+              else
+                begin
+                  // const64 - reg64
+                  location_force_reg(exprasmlist,left.location,left.location.size,true);
+                  cg.a_op_reg_reg_reg(exprasmlist,OP_SUB,location.size,
+                    right.location.register,left.location.register,location.register);
+                end;
+            end;
+          else
+            internalerror(2002072803);
+        end;
+{$else cpu64bit}
+        case nodetype of
+          xorn,orn,andn,addn:
+            begin
+              if (right.location.loc = LOC_CONSTANT) then
+                cg64.a_op64_const_reg_reg(exprasmlist,op,right.location.value64,
                   left.location.register64,location.register64)
               else
                 cg64.a_op64_reg_reg_reg(exprasmlist,op,right.location.register64,
@@ -532,7 +576,7 @@ interface
                   else
                     // reg64 - const64
                     cg64.a_op64_const_reg_reg(exprasmlist,OP_SUB,
-                      right.location.valueqword,left.location.register64,
+                      right.location.value64,left.location.register64,
                       location.register64)
                 end
               else
@@ -547,6 +591,7 @@ interface
           else
             internalerror(2002072803);
         end;
+{$endif cpu64bit}
 
         { emit overflow check if enabled }
         if checkoverflow then
@@ -653,7 +698,7 @@ interface
                location.register)
           else
             cg.a_op_const_reg_reg(exprasmlist,cgop,location.size,
-               aword(right.location.value),left.location.register,
+               right.location.value,left.location.register,
                location.register);
         end
       else  { subtract is a special case since its not commutative }
@@ -762,7 +807,27 @@ begin
 end.
 {
   $Log$
-  Revision 1.29  2004-02-26 16:11:29  peter
+  Revision 1.30  2004-06-16 20:07:08  florian
+    * dwarf branch merged
+
+  Revision 1.29.2.5  2004/06/13 10:51:16  florian
+    * fixed several register allocator problems (sparc/arm)
+
+  Revision 1.29.2.4  2004/06/12 17:01:01  florian
+    * fixed compilation of arm compiler
+
+  Revision 1.29.2.3  2004/06/02 20:59:05  peter
+    * fix negative consts
+
+  Revision 1.29.2.2  2004/05/30 17:54:14  florian
+    + implemented cmp64bit
+    * started to fix spilling
+    * fixed int64 sub partially
+
+  Revision 1.29.2.1  2004/04/27 18:18:25  peter
+    * aword -> aint
+
+  Revision 1.29  2004/02/26 16:11:29  peter
     * use op_ordinal for dynarr compares
 
   Revision 1.28  2004/02/04 19:22:27  peter

compiler/ncgbas.pas

@@ -161,22 +161,20 @@ interface
                         if indexreg=NR_NO then
                           begin
                             op.typ:=top_const;
-                            op.val:=aword(sym.localloc.reference.offset+sofs);
+                            op.val:=sym.localloc.reference.offset+sofs;
                           end
                         else
                           begin
                             op.typ:=top_ref;
                             new(op.ref);
-                            reference_reset_base(op.ref^,indexreg,
-                                sym.localloc.reference.offset+sofs);
+                            reference_reset_base(op.ref^,indexreg,sym.localloc.reference.offset+sofs);
                           end;
                       end
                     else
                       begin
                         op.typ:=top_ref;
                         new(op.ref);
-                        reference_reset_base(op.ref^,sym.localloc.reference.index,
-                            sym.localloc.reference.offset+sofs);
+                        reference_reset_base(op.ref^,sym.localloc.reference.index,sym.localloc.reference.offset+sofs);
                         op.ref^.index:=indexreg;
 {$ifdef x86}
                         op.ref^.scalefactor:=scale;
@@ -233,10 +231,18 @@ interface
                 case hp2.typ of
                   ait_label :
                      ReLabel(tasmsymbol(tai_label(hp2).l));
-                  ait_indirect_symbol,
-                  ait_const_rva,
-                  ait_const_symbol :
-                     ReLabel(tai_const_symbol(hp2).sym);
+                  ait_const_64bit,
+                  ait_const_32bit,
+                  ait_const_16bit,
+                  ait_const_8bit,
+                  ait_const_rva_symbol,
+                  ait_const_indirect_symbol :
+                     begin
+                       if assigned(tai_const(hp2).sym) then
+                         ReLabel(tai_const(hp2).sym);
+                       if assigned(tai_const(hp2).endsym) then
+                         ReLabel(tai_const(hp2).endsym);
+                     end;
                   ait_instruction :
                      begin
                        { remove cached insentry, because the new code can
@@ -477,13 +483,25 @@ begin
 end.
 {
   $Log$
-  Revision 1.62  2004-05-23 18:28:41  peter
+  Revision 1.63  2004-06-16 20:07:08  florian
+    * dwarf branch merged
+
+  Revision 1.62  2004/05/23 18:28:41  peter
     * methodpointer is loaded into a temp when it was a calln
 
   Revision 1.61  2004/05/23 15:06:20  peter
     * implicit_finally flag must be set in pass1
     * add check whether the implicit frame is generated when expected
 
+  Revision 1.60.2.3  2004/04/27 18:18:25  peter
+    * aword -> aint
+
+  Revision 1.60.2.2  2004/04/12 19:34:45  peter
+    * basic framework for dwarf CFI
+
+  Revision 1.60.2.1  2004/04/12 14:45:11  peter
+    * tai_const_symbol and tai_const merged
+
   Revision 1.60  2004/03/15 08:44:51  michael
   + Fix from peter: fixes crash when inlining assembler code referencing local vars
 
@@ -737,4 +755,4 @@ end.
     - list field removed of the tnode class because it's not used currently
       and can cause hard-to-find bugs
 
-}
+}

compiler/ncgcal.pas

@@ -48,9 +48,6 @@ interface
           procedure normal_pass_2;
           procedure inlined_pass_2;
        protected
-          { save the size of pushed parameter, needed po_clearstack
-            and alignment }
-          pushedparasize : longint;
           framepointer_paraloc : tparalocation;
           refcountedtemp : treference;
           procedure handle_return_value;
@@ -63,7 +60,6 @@ interface
              most stack based machines, where the frame pointer is
              the first invisible parameter.
           }
-          function  align_parasize:longint;virtual;
           procedure pop_parasize(pop_size:longint);virtual;
           procedure extra_interrupt_code;virtual;
           procedure extra_call_code;virtual;
@@ -88,7 +84,7 @@ implementation
       gdb,
 {$endif GDB}
       cgbase,pass_2,
-      cpuinfo,aasmbase,aasmtai,
+      aasmbase,aasmtai,
       nbas,nmem,nld,ncnv,nutils,
 {$ifdef x86}
       cga,cgx86,
@@ -127,15 +123,16 @@ implementation
           internalerror(200304235);
         location_release(exprasmlist,left.location);
         cg.a_paramaddr_ref(exprasmlist,left.location.reference,tempparaloc);
-        inc(tcgcallnode(aktcallnode).pushedparasize,POINTER_SIZE);
       end;
 
 
     procedure tcgcallparanode.push_value_para;
+{$ifdef i386}
       var
+        cgsize : tcgsize;
         href   : treference;
         size   : longint;
-        cgsize : tcgsize;
+{$endif i386}
       begin
         { we've nothing to push when the size of the parameter is 0 }
         if left.resulttype.def.size=0 then
@@ -157,7 +154,6 @@ implementation
              LOC_CFPUREGISTER:
                begin
                  size:=align(TCGSize2Size[left.location.size],tempparaloc.alignment);
-                 inc(tcgcallnode(aktcallnode).pushedparasize,size);
                  if tempparaloc.reference.index=NR_STACK_POINTER_REG then
                    begin
                      cg.g_stackpointer_alloc(exprasmlist,size);
@@ -171,7 +167,6 @@ implementation
              LOC_CMMREGISTER:
                begin
                  size:=align(tfloatdef(left.resulttype.def).size,tempparaloc.alignment);
-                 inc(tcgcallnode(aktcallnode).pushedparasize,size);
                  if tempparaloc.reference.index=NR_STACK_POINTER_REG then
                    begin
                      cg.g_stackpointer_alloc(exprasmlist,size);
@@ -194,14 +189,12 @@ implementation
                         if (size>=4) or (tempparaloc.alignment>=4) then
                          begin
                            cgsize:=OS_32;
-                           inc(tcgcallnode(aktcallnode).pushedparasize,4);
                            dec(href.offset,4);
                            dec(size,4);
                          end
                         else
                          begin
                            cgsize:=OS_16;
-                           inc(tcgcallnode(aktcallnode).pushedparasize,2);
                            dec(href.offset,2);
                            dec(size,2);
                          end;
@@ -212,7 +205,6 @@ implementation
                    begin
                      reference_reset_base(href,tempparaloc.reference.index,tempparaloc.reference.offset);
                      cg.g_concatcopy(exprasmlist,left.location.reference,href,size,false,false);
-                     inc(tcgcallnode(aktcallnode).pushedparasize,size);
                    end;
                end;
              else
@@ -299,7 +291,6 @@ implementation
                 internalerror(200204241);
               { push on stack }
               size:=align(left.resulttype.def.size,tempparaloc.alignment);
-              inc(tcgcallnode(aktcallnode).pushedparasize,size);
               if tempparaloc.reference.index=NR_STACK_POINTER_REG then
                 begin
                   cg.g_stackpointer_alloc(exprasmlist,size);
@@ -321,17 +312,16 @@ implementation
                 LOC_REFERENCE,
                 LOC_CREFERENCE :
                   begin
-                    cgsize:=def_cgsize(left.resulttype.def);
-                    if cgsize in [OS_64,OS_S64] then
+{$ifndef cpu64bit}
+                    if left.location.size in [OS_64,OS_S64] then
                      begin
-                       inc(tcgcallnode(aktcallnode).pushedparasize,8);
                        cg64.a_param64_loc(exprasmlist,left.location,tempparaloc);
                        location_release(exprasmlist,left.location);
                      end
                     else
+{$endif cpu64bit}
                      begin
                        location_release(exprasmlist,left.location);
-                       inc(tcgcallnode(aktcallnode).pushedparasize,align(tcgsize2size[tempparaloc.size],tempparaloc.alignment));
                        cg.a_param_loc(exprasmlist,left.location,tempparaloc);
                      end;
                   end;
@@ -340,7 +330,6 @@ implementation
                 LOC_CMMXREGISTER:
                   begin
                      location_release(exprasmlist,left.location);
-                     inc(tcgcallnode(aktcallnode).pushedparasize,8);
                      cg.a_parammm_reg(exprasmlist,left.location.register);
                   end;
 {$endif SUPPORT_MMX}
@@ -413,7 +402,6 @@ implementation
                   if (hp.nodetype=addrn) and
                      (not(nf_procvarload in hp.flags)) then
                     begin
-                      inc(tcgcallnode(aktcallnode).pushedparasize,POINTER_SIZE);
                       location_release(exprasmlist,left.location);
                       cg.a_param_loc(exprasmlist,left.location,tempparaloc);
                     end
@@ -480,12 +468,6 @@ implementation
       end;
 
 
-    function tcgcallnode.align_parasize:longint;
-      begin
-        result:=0;
-      end;
-
-
     procedure tcgcallnode.pop_parasize(pop_size:longint);
       begin
       end;
@@ -496,23 +478,25 @@ implementation
         cgsize : tcgsize;
         hregister : tregister;
         tempnode: tnode;
+        resultloc : tparalocation;
       begin
-        { structured results are easy to handle.... }
-        { needed also when result_no_used !! }
+        resultloc:=procdefinition.funcret_paraloc[callerside];
+        cgsize:=resultloc.size;
+        { structured results are easy to handle....
+          needed also when result_no_used !! }
         if paramanager.ret_in_param(resulttype.def,procdefinition.proccalloption) then
-         begin
-           { Location should be setup by the funcret para }
-           if location.loc<>LOC_REFERENCE then
-            internalerror(200304241);
-         end
-        else
+          begin
+            { Location should be setup by the funcret para }
+            if location.loc<>LOC_REFERENCE then
+             internalerror(200304241);
+          end
         { ansi/widestrings must be registered, so we can dispose them }
-         if resulttype.def.needs_inittable then
+        else if resulttype.def.needs_inittable then
           begin
             { the FUNCTION_RESULT_REG is already allocated }
             if not assigned(funcretnode) then
               begin
-                location_reset(location,LOC_CREFERENCE,OS_ADDR);
+                location_reset(location,LOC_REFERENCE,OS_ADDR);
                 location.reference:=refcountedtemp;
                 { a_load_reg_ref may allocate registers! }
                 cg.a_load_reg_ref(exprasmlist,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,location.reference);
@@ -520,9 +504,9 @@ implementation
               end
             else
               begin
-                cg.ungetregister(exprasmlist,NR_FUNCTION_RESULT_REG);
+                cg.ungetregister(exprasmlist,resultloc.register);
                 hregister := cg.getaddressregister(exprasmlist);
-                cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,hregister);
+                cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,resultloc.register,hregister);
                 { in case of a regular funcretnode with ret_in_param, the }
                 { original funcretnode isn't touched -> make sure it's    }
                 { the same here (not sure if it's necessary)              }
@@ -530,98 +514,88 @@ implementation
                 tempnode.pass_2;
                 location := tempnode.location;
                 tempnode.free;
-                cg.g_decrrefcount(exprasmlist,resulttype.def,location.reference, false);
+                cg.g_decrrefcount(exprasmlist,resulttype.def,location.reference,false);
                 cg.a_load_reg_ref(exprasmlist,OS_ADDR,OS_ADDR,hregister,location.reference);
                 cg.ungetregister(exprasmlist,hregister);
              end;
           end
-        else
         { we have only to handle the result if it is used }
-         if (cnf_return_value_used in callnodeflags) then
+        else if (cnf_return_value_used in callnodeflags) then
           begin
-            if (resulttype.def.deftype=floatdef) then
-              begin
-                location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
-{$ifdef cpufpemu}
-                if cs_fp_emulation in aktmoduleswitches then
-                  location.register:=NR_FUNCTION_RESULT_REG
-                else
-{$endif cpufpemu}
-                  begin
-                    location.register:=NR_FPU_RESULT_REG;
-{$ifdef sparc}
-                    { Double are returned in F0:F1 }
-                    if location.size=OS_F64 then
-                      setsubreg(location.register,R_SUBFD);
-{$endif sparc}
-                  end;
+            location.loc:=resultloc.loc;
+            case resultloc.loc of
+               LOC_FPUREGISTER:
+                 begin
+                   location_reset(location,LOC_FPUREGISTER,cgsize);
+                   location.register:=procdefinition.funcret_paraloc[callerside].register;
 {$ifdef x86}
-                tcgx86(cg).inc_fpu_stack;
+                   tcgx86(cg).inc_fpu_stack;
 {$else x86}
-                cg.ungetregister(exprasmlist,location.register);
-                hregister := cg.getfpuregister(exprasmlist,location.size);
-                cg.a_loadfpu_reg_reg(exprasmlist,location.size,location.register,hregister);
-                location.register := hregister;
+                   cg.ungetregister(exprasmlist,location.register);
+                   hregister:=cg.getfpuregister(exprasmlist,location.size);
+                   cg.a_loadfpu_reg_reg(exprasmlist,location.size,location.register,hregister);
+                   location.register:=hregister;
 {$endif x86}
-              end
-            else
-              begin
-                cgsize:=def_cgsize(resulttype.def);
-                if cgsize<>OS_NO then
+                 end;
+
+               LOC_REGISTER:
                  begin
-                   location_reset(location,LOC_REGISTER,cgsize);
-{$ifndef cpu64bit}
-                   if cgsize in [OS_64,OS_S64] then
+                   if cgsize<>OS_NO then
                     begin
-                      { Move the function result to free registers, preferably the
-                        FUNCTION_RESULT_REG/FUNCTION_RESULTHIGH_REG, so no move is necessary.}
-                      { the FUNCTION_RESULT_LOW_REG/FUNCTION_RESULT_HIGH_REG
-                        are already allocated }
-                      cg.ungetregister(exprasmlist,NR_FUNCTION_RESULT64_LOW_REG);
-                      location.registerlow:=cg.getintregister(exprasmlist,OS_INT);
-                      cg.a_load_reg_reg(exprasmlist,OS_32,OS_32,NR_FUNCTION_RESULT64_LOW_REG,location.registerlow);
-                      cg.ungetregister(exprasmlist,NR_FUNCTION_RESULT64_HIGH_REG);
-                      location.registerhigh:=cg.getintregister(exprasmlist,OS_INT);
-                      cg.a_load_reg_reg(exprasmlist,OS_32,OS_32,NR_FUNCTION_RESULT64_HIGH_REG,location.registerhigh);
+                      location_reset(location,LOC_REGISTER,cgsize);
+{$ifndef cpu64bit}
+                      if cgsize in [OS_64,OS_S64] then
+                       begin
+                         { Move the function result to free registers, preferably the
+                           FUNCTION_RESULT_REG/FUNCTION_RESULTHIGH_REG, so no move is necessary.}
+                         { the FUNCTION_RESULT_LOW_REG/FUNCTION_RESULT_HIGH_REG
+                           are already allocated }
+                         cg.ungetregister(exprasmlist,NR_FUNCTION_RESULT64_LOW_REG);
+                         location.registerlow:=cg.getintregister(exprasmlist,OS_32);
+                         cg.a_load_reg_reg(exprasmlist,OS_32,OS_32,NR_FUNCTION_RESULT64_LOW_REG,location.registerlow);
+                         cg.ungetregister(exprasmlist,NR_FUNCTION_RESULT64_HIGH_REG);
+                         location.registerhigh:=cg.getintregister(exprasmlist,OS_32);
+                         cg.a_load_reg_reg(exprasmlist,OS_32,OS_32,NR_FUNCTION_RESULT64_HIGH_REG,location.registerhigh);
+                       end
+                      else
+{$endif cpu64bit}
+                       begin
+                         { Move the function result to a free register, preferably the
+                           FUNCTION_RESULT_REG, so no move is necessary.}
+                         { the FUNCTION_RESULT_REG is already allocated }
+                         cg.ungetregister(exprasmlist,resultloc.register);
+                         { change register size after the unget because the
+                           getregister was done for the full register
+
+                           def_cgsize(resulttype.def) is used here because
+                           it could be a constructor call }
+                         location.register:=cg.getintregister(exprasmlist,def_cgsize(resulttype.def));
+                         cg.a_load_reg_reg(exprasmlist,cgsize,def_cgsize(resulttype.def),resultloc.register,location.register);
+                       end;
                     end
                    else
-{$endif cpu64bit}
                     begin
-                      {Move the function result to a free register, preferably the
-                       FUNCTION_RESULT_REG, so no move is necessary.}
-                      { the FUNCTION_RESULT_REG is already allocated }
-                      cg.ungetregister(exprasmlist,NR_FUNCTION_RESULT_REG);
-                      { change register size after the unget because the
-                      getregister was done for the full register }
-                      location.register:=cg.getintregister(exprasmlist,cgsize);
-                      cg.a_load_reg_reg(exprasmlist,cgsize,cgsize,cg.makeregsize(exprasmlist,NR_FUNCTION_RESULT_REG,cgsize),location.register);
+                      if resulttype.def.size>0 then
+                        internalerror(200305131);
                     end;
-                 end
-                else
+                 end;
+
+               LOC_MMREGISTER:
                  begin
-                   if resulttype.def.size>0 then
-                     internalerror(200305131);
+                   location_reset(location,LOC_MMREGISTER,cgsize);
+                   cg.ungetregister(exprasmlist,resultloc.register);
+                   location.register:=cg.getmmregister(exprasmlist,cgsize);
+                   cg.a_loadmm_reg_reg(exprasmlist,cgsize,cgsize,resultloc.register,location.register,mms_movescalar);
                  end;
-              end;
+
+               else
+                 internalerror(200405023);
+             end;
           end
         else
           begin
-            cgsize:=def_cgsize(resulttype.def);
-
-            { an object constructor is a function with pointer result }
-            if (procdefinition.proctypeoption=potype_constructor) then
-              cgsize:=OS_ADDR;
-
             if cgsize<>OS_NO then
-{$ifndef cpu64bit}
-              if cgsize in [OS_64,OS_S64] then
-                begin
-                  cg.ungetregister(exprasmlist,NR_FUNCTION_RESULT64_LOW_REG);
-                  cg.ungetregister(exprasmlist,NR_FUNCTION_RESULT64_HIGH_REG);
-                end
-              else
-{$endif cpu64bit}
-                cg.ungetregister(exprasmlist,NR_FUNCTION_RESULT_REG);
+              paramanager.freeparaloc(exprasmlist,resultloc);
             location_reset(location,LOC_VOID,OS_NO);
           end;
       end;
@@ -666,10 +640,6 @@ implementation
          regs_to_push_fpu,
          regs_to_alloc,
          regs_to_free : Tcpuregisterset;
-         oldpushedparasize : longint;
-{$ifdef cputargethasfixedstack}
-         href2,
-{$endif cputargethasfixedstack}
          href : treference;
          pop_size : longint;
          pvreg,
@@ -739,22 +709,17 @@ implementation
                            LOC_REFERENCE:
                              begin
                                reference_reset_base(href,ppn.tempparaloc.reference.index,ppn.tempparaloc.reference.offset);
-                               reference_reset_base(href2,ppn.paraitem.paraloc[callerside].reference.index,ppn.paraitem.paraloc[callerside].reference.offset);
-                               cg.g_concatcopy(exprasmlist,href,href2,ppn.paraitem.paratype.def.size,false,false);
+                               if ppn.paraitem.paraloc[callerside].size=OS_NO then
+                                 cg.a_param_copy_ref(exprasmlist,ppn.paraitem.paratype.def.size,href,ppn.paraitem.paraloc[callerside])
+                               else
+                                 cg.a_param_ref(exprasmlist,ppn.paraitem.paraloc[callerside].size,href,ppn.paraitem.paraloc[callerside]);
                              end;
                            LOC_REGISTER:
+{$ifndef cpu64bit}
                              if ppn.tempparaloc.size in [OS_64,OS_S64] then
-                               begin
-                                 reference_reset_base(href,ppn.paraitem.paraloc[callerside].reference.index,ppn.paraitem.paraloc[callerside].reference.offset);
-                                 cg.a_load_reg_ref(exprasmlist,OS_32,OS_32,ppn.tempparaloc.registerlow,
-                                    href);
-                                 { we don't use a c64.load here because later (when fixed ;)) one dword could be on the stack and the
-                                   other in a cpu register }
-                                 reference_reset_base(href,ppn.paraitem.paraloc[callerside].reference.index,ppn.paraitem.paraloc[callerside].reference.offset+4);
-                                 cg.a_load_reg_ref(exprasmlist,OS_32,OS_32,ppn.tempparaloc.registerhigh,
-                                    href);
-                               end
+                               cg64.a_param64_reg(exprasmlist,ppn.tempparaloc.register64,ppn.paraitem.paraloc[callerside])
                              else
+{$endif cpu64bit}
                                cg.a_param_reg(exprasmlist,ppn.paraitem.paraloc[callerside].size,ppn.tempparaloc.register,ppn.paraitem.paraloc[callerside]);
                            LOC_FPUREGISTER:
                              cg.a_paramfpu_reg(exprasmlist,ppn.paraitem.paraloc[callerside].size,ppn.tempparaloc.register,ppn.paraitem.paraloc[callerside]);
@@ -822,15 +787,11 @@ implementation
                 end;
               LOC_MMREGISTER,LOC_CMMREGISTER:
                 begin
-                  internalerror(2003102911);
+                  include(regs_to_alloc,getsupreg(procdefinition.funcret_paraloc[callerside].register));
                 end;
             end;
           end;
 
-         { Initialize for pushing the parameters }
-         oldpushedparasize:=pushedparasize;
-         pushedparasize:=0;
-
          { Process parameters, register parameters will be loaded
            in imaginary registers. The actual load to the correct
            register is done just before the call }
@@ -840,9 +801,6 @@ implementation
            tcallparanode(left).secondcallparan;
          aktcallnode:=oldaktcallnode;
 
-         { Align stack if required }
-         pop_size:=align_parasize;
-
          { procedure variable or normal function call ? }
          if (right=nil) then
            begin
@@ -973,24 +931,15 @@ implementation
          { Need to remove the parameters from the stack? }
          if (procdefinition.proccalloption in clearstack_pocalls) then
           begin
-            { the old pop_size was already included in pushedparasize }
             pop_size:=pushedparasize;
             { for Cdecl functions we don't need to pop the funcret when it
               was pushed by para }
             if paramanager.ret_in_param(procdefinition.rettype.def,procdefinition.proccalloption) then
-              dec(pop_size,POINTER_SIZE);
+              dec(pop_size,sizeof(aint));
+            { Remove parameters/alignment from the stack }
+            pop_parasize(pop_size);
           end;
 
-         { Remove parameters/alignment from the stack }
-         if pop_size>0 then
-           pop_parasize(pop_size);
-
-         { Reserve space for storing parameters that will be pushed }
-         current_procinfo.allocate_push_parasize(pushedparasize);
-
-         { Restore }
-         pushedparasize:=oldpushedparasize;
-
          { Release registers, but not the registers that contain the
            function result }
          regs_to_free:=regs_to_alloc;
@@ -1071,7 +1020,6 @@ implementation
          oldprocinfo : tprocinfo;
          oldinlining_procedure : boolean;
          inlineentrycode,inlineexitcode : TAAsmoutput;
-         usesacc,usesacchi,usesfpu : boolean;
 {$ifdef GDB}
          startlabel,endlabel : tasmlabel;
          pp : pchar;
@@ -1173,7 +1121,7 @@ implementation
 
          cg.a_label(exprasmlist,current_procinfo.aktexitlabel);
          gen_finalize_code(inlineexitcode,true);
-         gen_load_return_value(inlineexitcode,usesacc,usesacchi,usesfpu);
+         gen_load_return_value(inlineexitcode);
          if po_assembler in current_procinfo.procdef.procoptions then
            inlineexitcode.concat(Tai_marker.Create(asmblockend));
          exprasmlist.concatlist(inlineexitcode);
@@ -1278,7 +1226,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.167  2004-05-23 18:28:41  peter
+  Revision 1.168  2004-06-16 20:07:08  florian
+    * dwarf branch merged
+
+  Revision 1.167  2004/05/23 18:28:41  peter
     * methodpointer is loaded into a temp when it was a calln
 
   Revision 1.166  2004/05/22 23:34:27  peter
@@ -1287,6 +1238,48 @@ end.
   Revision 1.165  2004/04/28 15:19:03  florian
     + syscall directive support for MorphOS added
 
+  Revision 1.164.2.13  2004/06/12 17:01:01  florian
+    * fixed compilation of arm compiler
+
+  Revision 1.164.2.12  2004/05/31 16:39:42  peter
+    * add ungetiftemp in a few locations
+
+  Revision 1.164.2.11  2004/05/30 17:07:07  peter
+    * fix shl shr for sparc
+
+  Revision 1.164.2.10  2004/05/02 21:17:39  florian
+    * fixed boolean test of constructors
+
+  Revision 1.164.2.9  2004/05/02 21:07:29  florian
+    * fixed constructor results
+
+  Revision 1.164.2.8  2004/05/02 20:56:54  florian
+    * more fixes to handle_return_value update
+
+  Revision 1.164.2.7  2004/05/02 20:20:59  florian
+    * started to fix callee side result value handling
+
+  Revision 1.164.2.6  2004/05/02 19:08:01  florian
+    * rewrote tcgcallnode.handle_return_value
+
+  Revision 1.164.2.5  2004/05/02 14:09:35  peter
+    * use size of paraloc when copying reference, only when size is OS_NO
+      use the size of the type
+
+  Revision 1.164.2.4  2004/05/02 12:45:32  peter
+    * enabled cpuhasfixedstack for x86-64 again
+    * fixed size of temp allocation for parameters
+
+  Revision 1.164.2.3  2004/05/01 16:02:09  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
+  Revision 1.164.2.2  2004/05/01 11:12:23  florian
+    * spilling of registers with size<>4 fixed
+
+  Revision 1.164.2.1  2004/04/27 18:18:25  peter
+    * aword -> aint
+
   Revision 1.164  2004/03/14 20:10:56  peter
     * disable some debuginfo info when valgrind support is used
 
@@ -1971,5 +1964,4 @@ end.
 
   Revision 1.2  2002/07/13 19:38:43  florian
     * some more generic calling stuff fixed
-
-}
+}

compiler/ncgcnv.pas

@@ -452,9 +452,9 @@ interface
            begin
               if hd.implementedinterfaces.searchintf(resulttype.def)<>-1 then
                 begin
-                   cg.a_op_const_reg(exprasmlist,OP_ADD,OS_ADDR,aword(
+                   cg.a_op_const_reg(exprasmlist,OP_ADD,OS_ADDR,
                      hd.implementedinterfaces.ioffsets(
-                       hd.implementedinterfaces.searchintf(resulttype.def))^),location.register);
+                       hd.implementedinterfaces.searchintf(resulttype.def))^,location.register);
                    break;
                 end;
               hd:=hd.childof;
@@ -539,9 +539,15 @@ end.
 
 {
   $Log$
-  Revision 1.57  2004-04-29 19:56:37  daniel
+  Revision 1.58  2004-06-16 20:07:08  florian
+    * dwarf branch merged
+
+  Revision 1.57  2004/04/29 19:56:37  daniel
     * Prepare compiler infrastructure for multiple ansistring types
 
+  Revision 1.56.2.1  2004/04/27 18:18:25  peter
+    * aword -> aint
+
   Revision 1.56  2004/03/02 00:36:33  olle
     * big transformation of Tai_[const_]Symbol.Create[data]name*
 
@@ -758,4 +764,4 @@ end.
     * fixed returnvalue handling
     * fixed default stacksize of linux and go32v2, 8kb was a bit small :-)
 
-}
+}

compiler/ncgcon.pas

@@ -67,10 +67,11 @@ implementation
       verbose,globals,
       symconst,symdef,aasmbase,aasmtai,aasmcpu,defutil,
       cpuinfo,cpubase,
-      cgbase,cgobj
+      cgbase,cgobj,
 {$ifdef delphi}
       ,dmisc
 {$endif}
+      ncgutil
       ;
 
 
@@ -141,9 +142,8 @@ implementation
                begin
                   objectlibrary.getdatalabel(lastlabel);
                   lab_real:=lastlabel;
-                  if (cs_create_smart in aktmoduleswitches) then
-                   Consts.concat(Tai_cut.Create);
-                  consts.concat(tai_align.create(const_align(resulttype.def.size)));
+                  maybe_new_object_file(consts);
+                  new_section(consts,sec_rodata,lastlabel.name,const_align(resulttype.def.size));
                   Consts.concat(Tai_label.Create(lastlabel));
                   case realait of
                     ait_real_32bit :
@@ -190,7 +190,11 @@ implementation
     procedure tcgordconstnode.pass_2;
       begin
          location_reset(location,LOC_CONSTANT,def_cgsize(resulttype.def));
-         location.valueqword:=TConstExprUInt(value);
+{$ifdef cpu64bit}
+         location.value:=value;
+{$else cpu64bit}
+         location.value64:=int64(value);
+{$endif cpu64bit}
       end;
 
 
@@ -202,7 +206,7 @@ implementation
       begin
          { an integer const. behaves as a memory reference }
          location_reset(location,LOC_CONSTANT,OS_ADDR);
-         location.value:=AWord(value);
+         location.value:=aint(value);
       end;
 
 
@@ -339,23 +343,23 @@ implementation
                                        { before the string the following sequence must be found:
                                          <label>
                                            constsymbol <datalabel>
-                                           const32 <len>
-                                           const32 <len>
-                                           const32 -1
+                                           constint <len>
+                                           constint <len>
+                                           constint -1
                                          we must then return <label> to reuse
                                        }
                                        hp2:=tai(lastlabelhp.previous);
                                        if assigned(hp2) and
-                                          (hp2.typ=ait_const_32bit) and
-                                          (tai_const(hp2).value=aword(-1)) and
+                                          (hp2.typ=ait_const_aint) and
+                                          (tai_const(hp2).value=-1) and
                                           assigned(hp2.previous) and
-                                          (tai(hp2.previous).typ=ait_const_32bit) and
+                                          (tai(hp2.previous).typ=ait_const_aint) and
                                           (tai_const(hp2.previous).value=len) and
                                           assigned(hp2.previous.previous) and
-                                          (tai(hp2.previous.previous).typ=ait_const_32bit) and
+                                          (tai(hp2.previous.previous).typ=ait_const_aint) and
                                           (tai_const(hp2.previous.previous).value=len) and
                                           assigned(hp2.previous.previous.previous) and
-                                          (tai(hp2.previous.previous.previous).typ=ait_const_symbol) and
+                                          (tai(hp2.previous.previous.previous).typ=ait_const_ptr) and
                                           assigned(hp2.previous.previous.previous.previous) and
                                           (tai(hp2.previous.previous.previous.previous).typ=ait_label) then
                                          begin
@@ -438,9 +442,8 @@ implementation
                 begin
                    objectlibrary.getdatalabel(lastlabel);
                    lab_str:=lastlabel;
-                   if (cs_create_smart in aktmoduleswitches) then
-                    Consts.concat(Tai_cut.Create);
-                   consts.concat(tai_align.create(const_align(4)));
+                   maybe_new_object_file(consts);
+                   new_section(consts,sec_rodata,lastlabel.name,const_align(sizeof(aint)));
                    Consts.concat(Tai_label.Create(lastlabel));
                    { generate an ansi string ? }
                    case st_type of
@@ -475,16 +478,16 @@ implementation
                         begin
                            { an empty ansi string is nil! }
                            if len=0 then
-                             Consts.concat(Tai_const.Create_ptr(0))
+                             Consts.concat(Tai_const.Create_sym(nil))
                            else
                              begin
                                 objectlibrary.getdatalabel(l1);
                                 objectlibrary.getdatalabel(l2);
                                 Consts.concat(Tai_label.Create(l2));
-                                Consts.concat(Tai_const_symbol.Create(l1));
-                                Consts.concat(Tai_const.Create_32bit(len));
-                                Consts.concat(Tai_const.Create_32bit(len));
-                                Consts.concat(Tai_const.Create_32bit(Cardinal(-1)));
+                                Consts.concat(Tai_const.Create_sym(l1));
+                                Consts.concat(Tai_const.Create_aint(len));
+                                Consts.concat(Tai_const.Create_aint(len));
+                                Consts.concat(Tai_const.Create_aint(-1));
                                 Consts.concat(Tai_label.Create(l1));
                                 getmem(pc,len+2);
                                 move(value_str^,pc^,len);
@@ -527,20 +530,20 @@ implementation
                         begin
                            { an empty wide string is nil! }
                            if len=0 then
-                             Consts.concat(Tai_const.Create_ptr(0))
+                             Consts.concat(Tai_const.Create_sym(nil))
                            else
                              begin
                                 objectlibrary.getdatalabel(l1);
                                 objectlibrary.getdatalabel(l2);
                                 Consts.concat(Tai_label.Create(l2));
-                                Consts.concat(Tai_const_symbol.Create(l1));
+                                Consts.concat(Tai_const.Create_sym(l1));
 
                                 { we use always UTF-16 coding for constants }
                                 { at least for now                          }
                                 { Consts.concat(Tai_const.Create_8bit(2)); }
-                                Consts.concat(Tai_const.Create_32bit(len));
-                                Consts.concat(Tai_const.Create_32bit(len));
-                                Consts.concat(Tai_const.Create_32bit(Cardinal(-1)));
+                                Consts.concat(Tai_const.Create_aint(len));
+                                Consts.concat(Tai_const.Create_aint(len));
+                                Consts.concat(Tai_const.Create_aint(-1));
                                 Consts.concat(Tai_label.Create(l1));
                                 for i:=0 to len-1 do
                                   Consts.concat(Tai_const.Create_16bit(pcompilerwidestring(value_str)^.data[i]));
@@ -599,7 +602,7 @@ implementation
         if tsetdef(resulttype.def).settype=smallset then
          begin
            location_reset(location,LOC_CONSTANT,OS_32);
-           location.value:=PAWord(value_set)^;
+           location.value:=PAInt(value_set)^;
            exit;
          end;
         location_reset(location,LOC_CREFERENCE,OS_NO);
@@ -643,7 +646,7 @@ implementation
                           else
                            begin
                              { compare small set }
-                             if paword(value_set)^=tai_const(hp1).value then
+                             if paint(value_set)^=tai_const(hp1).value then
                               begin
                                 { found! }
                                 lab_set:=lastlabel;
@@ -660,9 +663,8 @@ implementation
                begin
                  objectlibrary.getdatalabel(lastlabel);
                  lab_set:=lastlabel;
-                 if (cs_create_smart in aktmoduleswitches) then
-                  Consts.concat(Tai_cut.Create);
-                 consts.concat(tai_align.create(const_align(4)));
+                 maybe_new_object_file(consts);
+                 new_section(consts,sec_rodata,lastlabel.name,const_align(sizeof(aint)));
                  Consts.concat(Tai_label.Create(lastlabel));
                  { already handled at the start of this method?? (JM)
                  if tsetdef(resulttype.def).settype=smallset then
@@ -727,9 +729,40 @@ begin
 end.
 {
   $Log$
-  Revision 1.40  2004-04-29 19:56:37  daniel
+  Revision 1.41  2004-06-16 20:07:08  florian
+    * dwarf branch merged
+
+  Revision 1.40  2004/04/29 19:56:37  daniel
     * Prepare compiler infrastructure for multiple ansistring types
 
+  Revision 1.39.2.9  2004/06/13 10:51:16  florian
+    * fixed several register allocator problems (sparc/arm)
+
+  Revision 1.39.2.8  2004/06/12 17:01:01  florian
+    * fixed compilation of arm compiler
+
+  Revision 1.39.2.7  2004/05/01 16:02:09  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
+  Revision 1.39.2.6  2004/04/29 19:07:22  peter
+    * compile fixes
+
+  Revision 1.39.2.5  2004/04/27 18:18:25  peter
+    * aword -> aint
+
+  Revision 1.39.2.4  2004/04/12 19:34:45  peter
+    * basic framework for dwarf CFI
+
+  Revision 1.39.2.3  2004/04/12 14:45:11  peter
+    * tai_const_symbol and tai_const merged
+
+  Revision 1.39.2.2  2004/04/10 12:36:41  peter
+    * fixed alignment issues
+
+  Revision 1.39.2.1  2004/04/08 18:33:22  peter
+    * rewrite of TAsmSection
+
   Revision 1.39  2004/03/18 17:29:40  peter
     * fix overflow
 
@@ -896,4 +929,3 @@ end.
 
 
 
-

compiler/ncgflw.pas

@@ -79,8 +79,6 @@ interface
           procedure pass_2;override;
        end;
 
-
-
 implementation
 
     uses
@@ -411,7 +409,7 @@ implementation
              if lnf_testatbegin in loopflags then
                begin
                  cg.a_cmp_const_loc_label(exprasmlist,opsize,hcond,
-                   aword(tordconstnode(right).value),
+                   tordconstnode(right).value,
                    t2.location,aktbreaklabel);
                end;
            end;
@@ -981,7 +979,7 @@ implementation
               }
               paraloc1:=paramanager.getintparaloc(pocall_default,1);
               paramanager.allocparaloc(exprasmlist,paraloc1);
-              cg.a_param_const(exprasmlist,OS_ADDR,aword(-1),paraloc1);
+              cg.a_param_const(exprasmlist,OS_ADDR,-1,paraloc1);
               paramanager.freeparaloc(exprasmlist,paraloc1);
               cg.allocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
               cg.a_call_name(exprasmlist,'FPC_CATCHES');
@@ -1161,7 +1159,7 @@ implementation
          if assigned(exceptsymtable) then
            begin
              tvarsym(exceptsymtable.symindex.first).localloc.loc:=LOC_REFERENCE;
-             tg.GetLocal(exprasmlist,POINTER_SIZE,voidpointertype.def,
+             tg.GetLocal(exprasmlist,sizeof(aint),voidpointertype.def,
                 tvarsym(exceptsymtable.symindex.first).localloc.reference);
              reference_reset_base(href2,tvarsym(exceptsymtable.symindex.first).localloc.reference.index,
                 tvarsym(exceptsymtable.symindex.first).localloc.reference.offset);
@@ -1169,13 +1167,12 @@ implementation
            end
          else
            begin
-             tg.GetTemp(exprasmlist,POINTER_SIZE,tt_normal,exceptref);
+             tg.GetTemp(exprasmlist,sizeof(aint),tt_normal,exceptref);
              cg.a_load_reg_ref(exprasmlist,OS_ADDR,OS_ADDR,NR_FUNCTION_RESULT_REG,exceptref);
            end;
 
-
-         { in the case that another exception is risen }
-         { we've to destroy the old one                }
+         { in the case that another exception is risen
+           we've to destroy the old one                }
          objectlibrary.getlabel(doobjectdestroyandreraise);
 
          { call setjmp, and jump to finally label on non-zero result }
@@ -1443,7 +1440,20 @@ begin
 end.
 {
   $Log$
-  Revision 1.95  2004-03-29 14:43:47  peter
+  Revision 1.96  2004-06-16 20:07:08  florian
+    * dwarf branch merged
+
+  Revision 1.95.2.3  2004/05/01 16:02:09  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
+  Revision 1.95.2.2  2004/04/27 18:18:25  peter
+    * aword -> aint
+
+  Revision 1.95.2.1  2004/04/24 20:13:24  florian
+    * fixed x86-64 exception handling
+
+  Revision 1.95  2004/03/29 14:43:47  peter
     * cleaner temp get/unget for exceptions
 
   Revision 1.94  2004/03/02 00:36:33  olle

compiler/ncginl.pas

@@ -243,7 +243,10 @@ implementation
          hrefvmt   : treference;
          hregister : tregister;
       begin
-        location_reset(location,LOC_REGISTER,OS_ADDR);
+        if inlinenumber=in_sizeof_x then
+          location_reset(location,LOC_REGISTER,OS_INT)
+        else
+          location_reset(location,LOC_REGISTER,OS_ADDR);
         { for both cases load vmt }
         if left.nodetype=typen then
           begin
@@ -327,15 +330,15 @@ implementation
          end
         else
          begin
-           { length in ansi strings is at offset -8 }
+           { length in ansi strings is at offset sizeof(aint)*2 }
            location_force_reg(exprasmlist,left.location,OS_ADDR,false);
            objectlibrary.getlabel(lengthlab);
            cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,left.location.register,lengthlab);
-           reference_reset_base(href,left.location.register,-8);
-           hregister:=cg.makeregsize(exprasmlist,left.location.register,OS_32);
-           cg.a_load_ref_reg(exprasmlist,OS_32,OS_32,href,hregister);
+           reference_reset_base(href,left.location.register,-sizeof(aint)*2);
+           hregister:=cg.makeregsize(exprasmlist,left.location.register,OS_INT);
+           cg.a_load_ref_reg(exprasmlist,OS_INT,OS_INT,href,hregister);
            cg.a_label(exprasmlist,lengthlab);
-           location_reset(location,LOC_REGISTER,OS_32);
+           location_reset(location,LOC_REGISTER,OS_INT);
            location.register:=hregister;
          end;
       end;
@@ -361,10 +364,11 @@ implementation
         location_copy(location,left.location);
         location_force_reg(exprasmlist,location,cgsize,false);
 
+{$ifndef cpu64bit}
         if cgsize in [OS_64,OS_S64] then
-          cg64.a_op64_const_reg(exprasmlist,cgop,1,
-                      location.register64)
+          cg64.a_op64_const_reg(exprasmlist,cgop,1,location.register64)
         else
+{$endif cpu64bit}
           cg.a_op_const_reg(exprasmlist,cgop,location.size,1,location.register);
 
         cg.g_rangecheck(exprasmlist,location,resulttype.def,resulttype.def);
@@ -429,12 +433,13 @@ implementation
           { write the add instruction }
           if addconstant then
             begin
+{$ifndef cpu64bit}
               if cgsize in [OS_64,OS_S64] then
-               cg64.a_op64_const_loc(exprasmlist,addsubop[inlinenumber],
-                  addvalue,tcallparanode(left).left.location)
+                cg64.a_op64_const_loc(exprasmlist,addsubop[inlinenumber],addvalue,tcallparanode(left).left.location)
               else
-               cg.a_op_const_loc(exprasmlist,addsubop[inlinenumber],
-                  aword(addvalue),tcallparanode(left).left.location);
+{$endif cpu64bit}
+                cg.a_op_const_loc(exprasmlist,addsubop[inlinenumber],
+                  addvalue,tcallparanode(left).left.location);
             end
            else
              begin
@@ -475,19 +480,21 @@ implementation
 
       procedure tcginlinenode.second_IncludeExclude;
         var
-          L : longint;
+          bitsperop,l : longint;
+          opsize : tcgsize;
           cgop : topcg;
           addrreg2,addrreg,
           hregister,hregister2: tregister;
           use_small : boolean;
-          cgsize : tcgsize;
           href : treference;
         begin
+          opsize:=OS_32;
+          bitsperop:=(8*tcgsize2size[opsize]);
           secondpass(tcallparanode(left).left);
           if tcallparanode(tcallparanode(left).right).left.nodetype=ordconstn then
             begin
               { calculate bit position }
-              l:=1 shl (tordconstnode(tcallparanode(tcallparanode(left).right).left).value mod 32);
+              l:=1 shl (tordconstnode(tcallparanode(tcallparanode(left).right).left).value mod bitsperop);
 
               { determine operator }
               if inlinenumber=in_include_x_y then
@@ -497,18 +504,19 @@ implementation
                   cgop:=OP_AND;
                   l:=not(l);
                 end;
-              if (tcallparanode(left).left.location.loc=LOC_REFERENCE) then
-                begin
-                  inc(tcallparanode(left).left.location.reference.offset,
-                    (tordconstnode(tcallparanode(tcallparanode(left).right).left).value div 32)*4);
-                  cg.a_op_const_ref(exprasmlist,cgop,OS_INT,aword(l),tcallparanode(left).left.location.reference);
-                  location_release(exprasmlist,tcallparanode(left).left.location);
-                end
-              else
-                { LOC_CREGISTER }
-                begin
-                  cg.a_op_const_reg(exprasmlist,cgop,tcallparanode(left).left.location.size,aword(l),tcallparanode(left).left.location.register);
-                end;
+              case tcallparanode(left).left.location.loc of
+                LOC_REFERENCE :
+                  begin
+                    inc(tcallparanode(left).left.location.reference.offset,
+                      (tordconstnode(tcallparanode(tcallparanode(left).right).left).value div bitsperop)*tcgsize2size[opsize]);
+                    cg.a_op_const_ref(exprasmlist,cgop,opsize,l,tcallparanode(left).left.location.reference);
+                    location_release(exprasmlist,tcallparanode(left).left.location);
+                  end;
+                LOC_CREGISTER :
+                  cg.a_op_const_reg(exprasmlist,cgop,tcallparanode(left).left.location.size,l,tcallparanode(left).left.location.register);
+                else
+                  internalerror(200405021);
+              end;
             end
           else
             begin
@@ -526,17 +534,17 @@ implementation
               secondpass(tcallparanode(tcallparanode(left).right).left);
 
               { bitnumber - which must be loaded into register }
-              hregister:=cg.getintregister(exprasmlist,OS_32);
-              hregister2:=cg.getintregister(exprasmlist,OS_32);
+              hregister:=cg.getintregister(exprasmlist,opsize);
+              hregister2:=cg.getintregister(exprasmlist,opsize);
 
-              cg.a_load_loc_reg(exprasmlist,OS_32,
+              cg.a_load_loc_reg(exprasmlist,opsize,
                   tcallparanode(tcallparanode(left).right).left.location,hregister);
 
               if use_small then
                 begin
                   { hregister contains the bitnumber to add }
-                  cg.a_load_const_reg(exprasmlist, OS_32, 1, hregister2);
-                  cg.a_op_reg_reg(exprasmlist, OP_SHL, OS_32, hregister, hregister2);
+                  cg.a_load_const_reg(exprasmlist, opsize, 1, hregister2);
+                  cg.a_op_reg_reg(exprasmlist, OP_SHL, opsize, hregister, hregister2);
 
                   { possiblities :
                        bitnumber : LOC_REFERENCE, LOC_REGISTER, LOC_CREGISTER
@@ -547,13 +555,13 @@ implementation
                     begin
                       if inlinenumber=in_include_x_y then
                         begin
-                          cg.a_op_reg_ref(exprasmlist, OP_OR, OS_32, hregister2,
+                          cg.a_op_reg_ref(exprasmlist, OP_OR, opsize, hregister2,
                           tcallparanode(left).left.location.reference);
                         end
                       else
                         begin
-                          cg.a_op_reg_reg(exprasmlist, OP_NOT, OS_32, hregister2,hregister2);
-                          cg.a_op_reg_ref(exprasmlist, OP_AND, OS_32, hregister2,
+                          cg.a_op_reg_reg(exprasmlist, OP_NOT, opsize, hregister2,hregister2);
+                          cg.a_op_reg_ref(exprasmlist, OP_AND, opsize, hregister2,
                               tcallparanode(left).left.location.reference);
                         end;
                     end
@@ -569,30 +577,30 @@ implementation
                   { hregister contains the bitnumber (div 32 to get the correct offset) }
                   { hregister contains the bitnumber to add }
 
-                  cg.a_op_const_reg_reg(exprasmlist, OP_SHR, OS_32, 5, hregister,hregister2);
-                  cg.a_op_const_reg(exprasmlist, OP_SHL, OS_32, 2, hregister2);
+                  cg.a_op_const_reg_reg(exprasmlist, OP_SHR, opsize, 5, hregister,hregister2);
+                  cg.a_op_const_reg(exprasmlist, OP_SHL, opsize, 2, hregister2);
                   addrreg:=cg.getaddressregister(exprasmlist);
                   { we need an extra address register to be able to do an ADD operation }
                   addrreg2:=cg.getaddressregister(exprasmlist);
-                  cg.a_load_reg_reg(exprasmlist,OS_32,OS_ADDR,hregister2,addrreg2);
+                  cg.a_load_reg_reg(exprasmlist,opsize,OS_ADDR,hregister2,addrreg2);
                   { calculate the correct address of the operand }
                   cg.a_loadaddr_ref_reg(exprasmlist, tcallparanode(left).left.location.reference,addrreg);
-                  cg.a_op_reg_reg(exprasmlist, OP_ADD, OS_32, addrreg2, addrreg);
+                  cg.a_op_reg_reg(exprasmlist, OP_ADD, OS_ADDR, addrreg2, addrreg);
                   cg.ungetregister(exprasmlist,addrreg2);
 
                   { hregister contains the bitnumber to add }
-                  cg.a_load_const_reg(exprasmlist, OS_32, 1, hregister2);
-                  cg.a_op_const_reg(exprasmlist, OP_AND, OS_32, 31, hregister);
-                  cg.a_op_reg_reg(exprasmlist, OP_SHL, OS_32, hregister, hregister2);
+                  cg.a_load_const_reg(exprasmlist, opsize, 1, hregister2);
+                  cg.a_op_const_reg(exprasmlist, OP_AND, opsize, 31, hregister);
+                  cg.a_op_reg_reg(exprasmlist, OP_SHL, opsize, hregister, hregister2);
 
                   reference_reset_base(href,addrreg,0);
 
                   if inlinenumber=in_include_x_y then
-                    cg.a_op_reg_ref(exprasmlist, OP_OR, OS_32, hregister2, href)
+                    cg.a_op_reg_ref(exprasmlist, OP_OR, opsize, hregister2, href)
                   else
                     begin
-                      cg.a_op_reg_reg(exprasmlist, OP_NOT, OS_32, hregister2, hregister2);
-                      cg.a_op_reg_ref(exprasmlist, OP_AND, OS_32, hregister2, href);
+                      cg.a_op_reg_reg(exprasmlist, OP_NOT, opsize, hregister2, hregister2);
+                      cg.a_op_reg_ref(exprasmlist, OP_AND, opsize, hregister2, href);
                     end;
                   cg.ungetregister(exprasmlist,addrreg);
                 end;
@@ -678,12 +686,27 @@ end.
 
 {
   $Log$
-  Revision 1.58  2004-05-30 21:18:22  jonas
+  Revision 1.59  2004-06-16 20:07:08  florian
+    * dwarf branch merged
+
+  Revision 1.58  2004/05/30 21:18:22  jonas
     * some optimizations and associated fixes for better regvar code
 
   Revision 1.57  2004/05/22 23:34:28  peter
   tai_regalloc.allocation changed to ratype to notify rgobj of register size changes
 
+  Revision 1.56.2.4  2004/05/02 16:49:12  peter
+    * 64 bit fixes
+
+  Revision 1.56.2.3  2004/05/01 16:35:51  florian
+    * fixed length(<ansi/widestring>) for 64 Bit CPUs
+
+  Revision 1.56.2.2  2004/04/27 18:18:25  peter
+    * aword -> aint
+
+  Revision 1.56.2.1  2004/04/26 21:02:34  peter
+    * 64bit fixes
+
   Revision 1.56  2004/03/02 00:36:33  olle
     * big transformation of Tai_[const_]Symbol.Create[data]name*
 

compiler/ncgld.pas

@@ -56,7 +56,7 @@ implementation
       aasmbase,aasmtai,aasmcpu,
       cgbase,pass_2,
       procinfo,
-      cpubase,cpuinfo,
+      cpubase,
       tgobj,ncgutil,
       cgutils,cgobj,
       ncgbas;
@@ -110,7 +110,7 @@ implementation
                    begin
                       location_reset(location,LOC_CREFERENCE,OS_ADDR);
                       location.reference.symbol:=objectlibrary.newasmsymbol(make_mangledname('RESOURCESTRINGLIST',tconstsym(symtableentry).owner,''),AB_EXTERNAL,AT_DATA);
-                      location.reference.offset:=tconstsym(symtableentry).resstrindex*16+8;
+                      location.reference.offset:=tconstsym(symtableentry).resstrindex*(4+sizeof(aint)*3)+4+sizeof(aint);
                    end
                  else
                    internalerror(22798);
@@ -188,7 +188,7 @@ implementation
                          layout of a threadvar is (4 bytes pointer):
                            0 - Threadvar index
                            4 - Threadvar value in single threading }
-                       reference_reset_symbol(href,objectlibrary.newasmsymbol(tvarsym(symtableentry).mangledname,AB_EXTERNAL,AT_DATA),POINTER_SIZE);
+                       reference_reset_symbol(href,objectlibrary.newasmsymbol(tvarsym(symtableentry).mangledname,AB_EXTERNAL,AT_DATA),sizeof(aint));
                        cg.a_loadaddr_ref_reg(exprasmlist,href,hregister);
                        cg.a_label(exprasmlist,endrelocatelab);
                        location.reference.base:=hregister;
@@ -296,13 +296,13 @@ implementation
                         to OS_64 - how to solve?? Carl
                         Solved. Florian
                       }
-                      if (sizeof(aword) = 4) then
+                      if (sizeof(aint) = 4) then
                          location_reset(location,LOC_CREFERENCE,OS_64)
-                      else if (sizeof(aword) = 8) then
+                      else if (sizeof(aint) = 8) then
                          location_reset(location,LOC_CREFERENCE,OS_128)
                       else
                          internalerror(20020520);
-                      tg.GetTemp(exprasmlist,2*POINTER_SIZE,tt_normal,location.reference);
+                      tg.GetTemp(exprasmlist,2*sizeof(aint),tt_normal,location.reference);
                       secondpass(left);
 
                       { load class instance address }
@@ -332,7 +332,7 @@ implementation
 
                       { store the class instance address }
                       href:=location.reference;
-                      inc(href.offset,POINTER_SIZE);
+                      inc(href.offset,sizeof(aint));
                       cg.a_load_reg_ref(exprasmlist,OS_ADDR,OS_ADDR,hregister,href);
 
                       { virtual method ? }
@@ -552,10 +552,11 @@ implementation
             case right.location.loc of
               LOC_CONSTANT :
                 begin
+{$ifndef cpu64bit}
                   if right.location.size in [OS_64,OS_S64] then
-                   cg64.a_load64_const_loc(exprasmlist,
-                       right.location.valueqword,left.location)
+                   cg64.a_load64_const_loc(exprasmlist,right.location.value64,left.location)
                   else
+{$endif cpu64bit}
                    cg.a_load_const_loc(exprasmlist,right.location.value,left.location);
                 end;
               LOC_REFERENCE,
@@ -565,6 +566,7 @@ implementation
                     LOC_CREGISTER :
                       begin
                         cgsize:=def_cgsize(left.resulttype.def);
+{$ifndef cpu64bit}
                         if cgsize in [OS_64,OS_S64] then
                           begin
                             cg64.a_load64_ref_reg(exprasmlist,
@@ -572,6 +574,7 @@ implementation
                             location_release(exprasmlist,right.location);
                           end
                         else
+{$endif cpu64bit}
                           begin
                             location_release(exprasmlist,right.location);
                             cg.a_load_ref_reg(exprasmlist,cgsize,cgsize,
@@ -626,10 +629,12 @@ implementation
               LOC_CREGISTER :
                 begin
                   cgsize:=def_cgsize(left.resulttype.def);
+{$ifndef cpu64bit}
                   if cgsize in [OS_64,OS_S64] then
                     cg64.a_load64_reg_loc(exprasmlist,
                       right.location.register64,left.location)
                   else
+{$endif cpu64bit}
                     cg.a_load_reg_loc(exprasmlist,right.location.size,right.location.register,left.location);
                 end;
               LOC_FPUREGISTER,LOC_CFPUREGISTER :
@@ -692,6 +697,7 @@ implementation
 
         if releaseright then
           location_release(exprasmlist,right.location);
+        location_freetemp(exprasmlist,right.location);
         location_release(exprasmlist,left.location);
 
         truelabel:=otlabel;
@@ -740,9 +746,9 @@ implementation
       begin
         dovariant:=(nf_forcevaria in flags) or tarraydef(resulttype.def).isvariant;
         if dovariant then
-         elesize:=8
+          elesize:=sizeof(aint)+sizeof(aint)
         else
-         elesize:=tarraydef(resulttype.def).elesize;
+          elesize:=tarraydef(resulttype.def).elesize;
         location_reset(location,LOC_CREFERENCE,OS_NO);
         fillchar(paraloc,sizeof(paraloc),0);
         { Allocate always a temp, also if no elements are required, to
@@ -866,7 +872,7 @@ implementation
                  if vtype=$ff then
                    internalerror(14357);
                  { write changing field update href to the next element }
-                 inc(href.offset,4);
+                 inc(href.offset,sizeof(aint));
                  if vaddr then
                   begin
                     location_force_mem(exprasmlist,hp.left.location);
@@ -884,10 +890,10 @@ implementation
                     cg.a_load_loc_ref(exprasmlist,OS_ADDR,hp.left.location,href);
                   end;
                  { update href to the vtype field and write it }
-                 dec(href.offset,4);
+                 dec(href.offset,sizeof(aint));
                  cg.a_load_const_ref(exprasmlist, OS_INT,vtype,href);
                  { goto next array element }
-                 inc(href.offset,8);
+                 inc(href.offset,sizeof(aint)*2);
                end
               else
               { normal array constructor of the same type }
@@ -915,12 +921,14 @@ implementation
                      end;
                    else
                      begin
+{$ifndef cpu64bit}
                        if hp.left.location.size in [OS_64,OS_S64] then
                          begin
                            cg64.a_load64_loc_ref(exprasmlist,hp.left.location,href);
                            location_release(exprasmlist,hp.left.location);
                          end
                        else
+{$endif cpu64bit}
                          begin
                            location_release(exprasmlist,hp.left.location);
                            cg.a_load_loc_ref(exprasmlist,hp.left.location.size,hp.left.location,href);
@@ -942,12 +950,40 @@ begin
 end.
 {
   $Log$
-  Revision 1.116  2004-05-22 23:34:28  peter
+  Revision 1.117  2004-06-16 20:07:08  florian
+    * dwarf branch merged
+
+  Revision 1.116  2004/05/22 23:34:28  peter
   tai_regalloc.allocation changed to ratype to notify rgobj of register size changes
 
   Revision 1.115  2004/04/29 19:56:37  daniel
     * Prepare compiler infrastructure for multiple ansistring types
 
+  Revision 1.114.2.8  2004/06/13 10:51:16  florian
+    * fixed several register allocator problems (sparc/arm)
+
+  Revision 1.114.2.7  2004/06/12 17:01:01  florian
+    * fixed compilation of arm compiler
+
+  Revision 1.114.2.6  2004/05/31 16:39:42  peter
+    * add ungetiftemp in a few locations
+
+  Revision 1.114.2.5  2004/05/01 16:02:09  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
+  Revision 1.114.2.4  2004/04/29 20:51:25  florian
+    * tvarrec generation fixed
+
+  Revision 1.114.2.3  2004/04/29 19:07:22  peter
+    * compile fixes
+
+  Revision 1.114.2.2  2004/04/28 19:23:00  florian
+    * resource string offset calculation for 64 bit fixed
+
+  Revision 1.114.2.1  2004/04/27 18:18:25  peter
+    * aword -> aint
+
   Revision 1.114  2004/03/02 17:32:12  florian
     * make cycle fixed
     + pic support for darwin
@@ -1413,4 +1449,4 @@ end.
   * bugfix of hdisponen (base must be set, not index)
   * more portability fixes
 
-}
+}

compiler/ncgmat.pas

@@ -82,6 +82,7 @@ interface
            been done and emitted, so this should really a do a modulo.
          }
          procedure emit_mod_reg_reg(signed: boolean;denum,num : tregister);virtual;abstract;
+{$ifndef cpu64bit}
          { This routine must do an actual 64-bit division, be it
            signed or unsigned. The result must set into the the
            @var(num) register.
@@ -96,6 +97,7 @@ interface
            64-bit systems, otherwise a helper is called in 1st pass.
          }
          procedure emit64_div_reg_reg(signed: boolean;denum,num : tregister64);virtual;
+{$endif cpu64bit}
       end;
 
       tcgshlshrnode = class(tshlshrnode)
@@ -126,10 +128,9 @@ implementation
     uses
       globtype,systems,
       cutils,verbose,globals,
-      symconst,symdef,aasmbase,aasmtai,aasmcpu,defutil,
-      pass_1,pass_2,
+      symconst,aasmbase,aasmtai,aasmcpu,defutil,
+      pass_2,
       ncon,
-      cpuinfo,
       tgobj,ncgutil,cgobj,paramgr
 {$ifndef cpu64bit}
       ,cg64f32
@@ -142,8 +143,8 @@ implementation
 
     procedure tcgunaryminusnode.emit_float_sign_change(r: tregister; _size : tcgsize);
       var
-        href : treference;
-        hreg : tregister;
+        href,
+        href2 : treference;
       begin
         { get a temporary memory reference to store the floating
           point value
@@ -151,38 +152,22 @@ implementation
         tg.gettemp(exprasmlist,tcgsize2size[_size],tt_normal,href);
         { store the floating point value in the temporary memory area }
         cg.a_loadfpu_reg_ref(exprasmlist,_size,r,href);
-        { only single and double ieee are supported }
-        if _size = OS_F64 then
-          begin
-            { on little-endian machine the most significant
-              32-bit value is stored at the highest address
-            }
-            if target_info.endian = endian_little then
-              inc(href.offset,4);
-          end
-        else
-        if _size <> OS_F32 then
-           internalerror(20020814);
-        hreg := cg.getintregister(exprasmlist,OS_32);
-        { load value }
-        cg.a_load_ref_reg(exprasmlist,OS_32,OS_32,href,hreg);
-        { bitwise complement copied value }
-        cg.a_op_reg_reg(exprasmlist,OP_NOT,OS_32,hreg,hreg);
-        { sign-bit is bit 31/63 of single/double }
-        cg.a_op_const_reg(exprasmlist,OP_AND,OS_32,aword($80000000),hreg);
-        { or with value in reference memory }
-        cg.a_op_reg_ref(exprasmlist,OP_OR,OS_32,hreg,href);
-        cg.ungetregister(exprasmlist,hreg);
-        { store the floating point value in the temporary memory area }
-        if _size = OS_F64 then
-          begin
-            { on little-endian machine the most significant
-              32-bit value is stored at the highest address
-            }
+        { only single and double ieee are supported, for little endian
+          the signed bit is in the second dword }
+        href2:=href;
+        case _size of
+          OS_F64 :
             if target_info.endian = endian_little then
-              dec(href.offset,4);
-          end;
+              inc(href2.offset,4);
+          OS_F32 :
+            ;
+          else
+            internalerror(200406021);
+        end;
+        { flip sign-bit (bit 31/63) of single/double }
+        cg.a_op_const_ref(exprasmlist,OP_XOR,OS_32,aint($80000000),href2);
         cg.a_loadfpu_ref_reg(exprasmlist,_size,href,r);
+        tg.ungetiftemp(exprasmlist,href);
       end;
 
 
@@ -263,6 +248,7 @@ implementation
                              TCGMODDIVNODE
 *****************************************************************************}
 
+{$ifndef cpu64bit}
     procedure tcgmoddivnode.emit64_div_reg_reg(signed: boolean; denum,num:tregister64);
       begin
         { handled in pass_1 already, unless pass_1 is
@@ -271,6 +257,7 @@ implementation
         { should be handled in pass_1 (JM) }
         internalerror(200109052);
       end;
+{$endif cpu64bit}
 
 
     procedure tcgmoddivnode.pass_2;
@@ -370,40 +357,9 @@ implementation
 
 {$ifndef cpu64bit}
     procedure tcgshlshrnode.second_64bit;
-      var
-         freescratch : boolean;
-         op : topcg;
       begin
-{$ifdef cpu64bit}
-         freescratch:=false;
-         secondpass(left);
-         secondpass(right);
-         { determine operator }
-         case nodetype of
-           shln: op:=OP_SHL;
-           shrn: op:=OP_SHR;
-         end;
-         freescratch:=false;
-         location_reset(location,LOC_REGISTER,OS_64);
-
-         { load left operator in a register }
-         location_force_reg(exprasmlist,left.location,OS_64,false);
-         location_copy(location,left.location);
-
-         if (right.nodetype=ordconstn) then
-           begin
-              cg64.a_op64_const_reg(exprasmlist,op,tordconstnode(right).value,
-                joinreg64(location.registerlow,location.registerhigh));
-           end
-         else
-           begin
-             { this should be handled in pass_1 }
-             internalerror(2002081501);
-           end;
-{$else cpu64bit}
          { already hanled in 1st pass }
          internalerror(2002081501);
-{$endif cpu64bit}
       end;
 {$endif cpu64bit}
 
@@ -524,7 +480,22 @@ begin
 end.
 {
   $Log$
-  Revision 1.25  2004-01-23 15:12:49  florian
+  Revision 1.26  2004-06-16 20:07:08  florian
+    * dwarf branch merged
+
+  Revision 1.25.2.4  2004/06/02 19:04:51  peter
+    * fixed minusunary for float
+
+  Revision 1.25.2.3  2004/05/31 16:39:42  peter
+    * add ungetiftemp in a few locations
+
+  Revision 1.25.2.2  2004/05/30 17:07:07  peter
+    * fix shl shr for sparc
+
+  Revision 1.25.2.1  2004/04/27 18:18:25  peter
+    * aword -> aint
+
+  Revision 1.25  2004/01/23 15:12:49  florian
     * fixed generic shl/shr operations
     + added register allocation hook calls for arm specific operand types:
       register set and shifter op

compiler/ncgmem.pas

@@ -30,7 +30,7 @@ unit ncgmem;
 interface
 
     uses
-      cgbase,cpuinfo,cpubase,
+      globtype,cgbase,cpuinfo,cpubase,
       node,nmem;
 
     type
@@ -69,7 +69,7 @@ interface
            This routine should update location.reference correctly,
            so it points to the correct address.
          }
-         procedure update_reference_reg_mul(reg:tregister;l:aword);virtual;
+         procedure update_reference_reg_mul(reg:tregister;l:aint);virtual;
          procedure second_wideansistring;virtual;
          procedure second_dynamicarray;virtual;
        public
@@ -88,7 +88,7 @@ implementation
 {$ifdef GDB}
       gdb,
 {$endif GDB}
-      globtype,systems,
+      systems,
       cutils,verbose,globals,
       symconst,symdef,symsym,defutil,paramgr,
       aasmbase,aasmtai,
@@ -296,8 +296,9 @@ implementation
             paramanager.allocparaloc(exprasmlist,paraloc1);
             cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paraloc1);
             paramanager.freeparaloc(exprasmlist,paraloc1);
-            { FPC_CHECKPOINTER uses saveregisters }
+            cg.allocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
             cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER');
+            cg.deallocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
           end;
       end;
 
@@ -350,8 +351,9 @@ implementation
                 paramanager.allocparaloc(exprasmlist,paraloc1);
                 cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paraloc1);
                 paramanager.freeparaloc(exprasmlist,paraloc1);
-                { FPC_CHECKPOINTER uses saveregisters }
+                cg.allocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
                 cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER');
+                cg.deallocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
               end;
            end
          else if is_interfacecom(left.resulttype.def) then
@@ -367,8 +369,9 @@ implementation
                 paramanager.allocparaloc(exprasmlist,paraloc1);
                 cg.a_param_reg(exprasmlist, OS_ADDR,location.reference.base,paraloc1);
                 paramanager.freeparaloc(exprasmlist,paraloc1);
-                { FPC_CHECKPOINTER uses saveregisters }
+                cg.allocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
                 cg.a_call_name(exprasmlist,'FPC_CHECKPOINTER');
+                cg.deallocexplicitregisters(exprasmlist,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
               end;
            end
          else
@@ -471,7 +474,7 @@ implementation
        end;
 
 
-     procedure tcgvecnode.update_reference_reg_mul(reg:tregister;l:aword);
+     procedure tcgvecnode.update_reference_reg_mul(reg:tregister;l:aint);
        var
          hreg: tregister;
        begin
@@ -535,7 +538,7 @@ implementation
                { generate compares }
                freereg:=false;
                if (right.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
-                 hreg:=right.location.register
+                 hreg:=cg.makeregsize(exprasmlist,right.location.register,OS_INT)
                else
                  begin
                    hreg:=cg.getintregister(exprasmlist,OS_INT);
@@ -891,7 +894,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.91  2004-04-29 19:56:37  daniel
+  Revision 1.92  2004-06-16 20:07:08  florian
+    * dwarf branch merged
+
+  Revision 1.91  2004/04/29 19:56:37  daniel
     * Prepare compiler infrastructure for multiple ansistring types
 
   Revision 1.90  2004/04/21 17:39:40  jonas
@@ -899,6 +905,19 @@ end.
       at the same time confused the register allocator and therefore also
       the optimizer. May be fixed in the future using dwarf support
 
+  Revision 1.89.2.4  2004/05/10 21:28:34  peter
+    * section_smartlink enabled for gas under linux
+
+  Revision 1.89.2.3  2004/05/02 13:04:28  peter
+    * ofs fixed
+
+  Revision 1.89.2.2  2004/05/01 16:02:09  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
+  Revision 1.89.2.1  2004/04/27 18:18:25  peter
+    * aword -> aint
+
   Revision 1.89  2004/03/02 00:36:33  olle
     * big transformation of Tai_[const_]Symbol.Create[data]name*
 
@@ -1264,7 +1283,7 @@ end.
   * fix generic size problems which depend now on EXTEND_SIZE constant
 
   Revision 1.7  2002/04/15 18:58:47  carl
-  + target_info.size_of_pointer -> pointer_Size
+  + target_info.size_of_pointer -> sizeof(aint)
 
   Revision 1.6  2002/04/04 19:05:57  peter
     * removed unused units

compiler/ncgset.pas

@@ -27,7 +27,8 @@ unit ncgset;
 interface
 
     uses
-       node,nset,cpubase,cgbase,cgobj,aasmbase,aasmtai,globals;
+       globtype,globals,
+       node,nset,cpubase,cgbase,cgobj,aasmbase,aasmtai;
 
     type
        tcgsetelementnode = class(tsetelementnode)
@@ -72,9 +73,9 @@ interface
           { has the implementation jumptable support }
           min_label : tconstexprint;
 
-          procedure optimizevalues(var max_linear_list:longint;var max_dist:cardinal);virtual;
+          procedure optimizevalues(var max_linear_list:aint;var max_dist:aword);virtual;
           function  has_jumptable : boolean;virtual;
-          procedure genjumptable(hp : pcaserecord;min_,max_ : longint); virtual;
+          procedure genjumptable(hp : pcaserecord;min_,max_ : aint); virtual;
           procedure genlinearlist(hp : pcaserecord); virtual;
           procedure genlinearcmplist(hp : pcaserecord); virtual;
           procedure gentreejmp(p : pcaserecord);
@@ -84,7 +85,7 @@ interface
 implementation
 
     uses
-      globtype,systems,
+      systems,
       verbose,
       symconst,symdef,defutil,
       paramgr,
@@ -143,14 +144,23 @@ implementation
       { be caught when range checking is on! (JM)                        }
       { cg.a_op_const_reg(list,OP_AND,31,bitnumber);                     }
 
-      if (bitsize <> OS_32) then
-        internalerror(2004053010);
-      newres := cg.makeregsize(list,res,OS_32);
-      { rotate value register "bitnumber" bits to the right }
-      cg.a_op_reg_reg_reg(list,OP_SHR,OS_32,bitnumber,value,newres);
-      { extract the bit we want }
-      cg.a_op_const_reg(list,OP_AND,OS_32,1,newres);
-      cg.a_load_reg_reg(list,OS_32,ressize,newres,res);
+      if bitsize<>ressize then
+        begin
+          { FIX ME! We're not allowed to modify the value register here! }
+
+          { shift value register "bitnumber" bits to the right }
+          cg.a_op_reg_reg(list,OP_SHR,bitsize,bitnumber,value);
+          { extract the bit we want }
+          cg.a_op_const_reg(list,OP_AND,bitsize,1,value);
+          cg.a_load_reg_reg(list,bitsize,ressize,value,res);
+        end
+      else
+        begin
+          { rotate value register "bitnumber" bits to the right }
+          cg.a_op_reg_reg_reg(list,OP_SHR,bitsize,bitnumber,value,res);
+          { extract the bit we want }
+          cg.a_op_const_reg(list,OP_AND,bitsize,1,res);
+        end;
     end;
 
 
@@ -161,16 +171,15 @@ implementation
            start,stop : byte;    {Start/stop when range; Stop=element when an element.}
          end;
        var
-         l,l2,l3       : tasmlabel;
-         adjustment : longint;
+         l,l3       : tasmlabel;
+         adjustment : aint;
          href : treference;
-         hr,hr2,hr3,
+         hr,hr2,
          pleftreg   : tregister;
          setparts   : array[1..8] of Tsetpart;
          opsize     : tcgsize;
          genjumps,
-         use_small,
-         ranges     : boolean;
+         use_small  : boolean;
          i,numparts : byte;
 
          function analizeset(const Aset:Tconstset;is_small:boolean):boolean;
@@ -179,7 +188,6 @@ implementation
              i:byte;
            begin
              analizeset:=false;
-             ranges:=false;
              numparts:=0;
              compares:=0;
              { Lots of comparisions take a lot of time, so do not allow
@@ -214,7 +222,6 @@ implementation
                      setparts[numparts].range:=true;
                      setparts[numparts].start:=setparts[numparts].stop;
                      setparts[numparts].stop:=i;
-                     ranges := true;
                      { there's only one compare per range anymore. Only a }
                      { sub is added, but that's much faster than a        }
                      { cmp/jcc combo so neglect its effect                }
@@ -245,6 +252,8 @@ implementation
          genjumps:=(right.nodetype=setconstn) and
                    analizeset(Tsetconstnode(right).value_set^,use_small);
 
+         opsize:=OS_32;
+
          { calculate both operators }
          { the complex one first }
          firstcomplex(self);
@@ -272,9 +281,8 @@ implementation
             { clear the register value, indicating result is FALSE }
             cg.a_load_const_reg(exprasmlist,location.size,0,location.register);
             { If register is used, use only lower 8 bits }
-            location_force_reg(exprasmlist,left.location,OS_INT,false);
+            location_force_reg(exprasmlist,left.location,opsize,false);
             pleftreg := left.location.register;
-            opsize := OS_INT;
 
             { how much have we already substracted from the x in the }
             { "x in [y..z]" expression                               }
@@ -283,7 +291,7 @@ implementation
 
             for i:=1 to numparts do
              if setparts[i].range then
-              { use fact that a <= x <= b <=> cardinal(x-a) <= cardinal(b-a) }
+              { use fact that a <= x <= b <=> aword(x-a) <= aword(b-a) }
               begin
                 { is the range different from all legal values? }
                 if (setparts[i].stop-setparts[i].start <> 255) then
@@ -298,10 +306,9 @@ implementation
                          (hr<>pleftreg) then
                         begin
                           cg.a_op_const_reg(exprasmlist,OP_SUB,opsize,setparts[i].start,pleftreg);
-                          hr:=cg.getintregister(exprasmlist,OS_INT);
-                          cg.a_load_reg_reg(exprasmlist,opsize,OS_INT,pleftreg,hr);
+                          hr:=cg.getintregister(exprasmlist,opsize);
+                          cg.a_load_reg_reg(exprasmlist,opsize,opsize,pleftreg,hr);
                           pleftreg:=hr;
-                          opsize := OS_INT;
                         end
                       else
                         begin
@@ -368,18 +375,18 @@ implementation
                {****************************  SMALL SET **********************}
                if left.nodetype=ordconstn then
                 begin
-                  location_force_reg(exprasmlist,right.location,OS_32,false);
+                  location_force_reg(exprasmlist,right.location,opsize,true);
                   { first SHR the register }
-                  cg.a_op_const_reg(exprasmlist,OP_SHR,OS_32,tordconstnode(left).value and 31,right.location.register);
+                  cg.a_op_const_reg(exprasmlist,OP_SHR,opsize,tordconstnode(left).value and 31,right.location.register);
                   { then extract the lowest bit }
-                  cg.a_op_const_reg(exprasmlist,OP_AND,OS_32,1,right.location.register);
+                  cg.a_op_const_reg(exprasmlist,OP_AND,opsize,1,right.location.register);
                   location.register:=cg.getintregister(exprasmlist,location.size);
-                  cg.a_load_reg_reg(exprasmlist,OS_32,location.size,right.location.register,location.register);
+                  cg.a_load_reg_reg(exprasmlist,opsize,location.size,right.location.register,location.register);
                 end
                else
                 begin
-                  location_force_reg(exprasmlist,left.location,OS_32,false);
-                  location_force_reg(exprasmlist,right.location,OS_32,true);
+                  location_force_reg(exprasmlist,left.location,opsize,false);
+                  location_force_reg(exprasmlist,right.location,opsize,true);
                   { allocate a register for the result }
                   location.register:=cg.getintregister(exprasmlist,location.size);
                   { emit bit test operation }
@@ -401,21 +408,21 @@ implementation
                   { assumption (other cases will be caught by range checking) (JM)  }
 
                   { load left in register }
-                  location_force_reg(exprasmlist,left.location,OS_32,true);
+                  location_force_reg(exprasmlist,left.location,opsize,true);
                   if left.location.loc = LOC_CREGISTER then
-                    hr := cg.getintregister(exprasmlist,OS_32)
+                    hr := cg.getintregister(exprasmlist,opsize)
                   else
                     hr := left.location.register;
                   { load right in register }
-                  hr2:=cg.getintregister(exprasmlist,OS_32);
-                  cg.a_load_const_reg(exprasmlist,OS_32,right.location.value,hr2);
+                  hr2:=cg.getintregister(exprasmlist,opsize);
+                  cg.a_load_const_reg(exprasmlist,opsize,right.location.value,hr2);
 
                   { emit bit test operation }
-                  emit_bit_test_reg_reg(exprasmlist,OS_32,left.location.register,hr2,OS_32,hr2);
+                  emit_bit_test_reg_reg(exprasmlist,left.location.size,left.location.register,hr2,opsize,hr2);
 
                   { if left > 31 then hr := 0 else hr := $ffffffff }
-                  cg.a_op_const_reg_reg(exprasmlist,OP_SUB,OS_32,32,left.location.register,hr);
-                  cg.a_op_const_reg(exprasmlist,OP_SAR,OS_32,31,hr);
+                  cg.a_op_const_reg_reg(exprasmlist,OP_SUB,opsize,32,left.location.register,hr);
+                  cg.a_op_const_reg(exprasmlist,OP_SAR,opsize,31,hr);
 
                   { free registers }
                   cg.ungetregister(exprasmlist,hr2);
@@ -425,10 +432,10 @@ implementation
                     cg.ungetregister(exprasmlist,left.location.register);
 
                   { if left > 31, then result := 0 else result := result of bit test }
-                  cg.a_op_reg_reg(exprasmlist,OP_AND,OS_32,hr,hr2);
+                  cg.a_op_reg_reg(exprasmlist,OP_AND,opsize,hr,hr2);
                   { allocate a register for the result }
                   location.register := cg.getintregister(exprasmlist,location.size);
-                  cg.a_load_reg_reg(exprasmlist,OS_32,location.size,hr2,location.register);
+                  cg.a_load_reg_reg(exprasmlist,opsize,location.size,hr2,location.register);
                 end { of right.location.loc=LOC_CONSTANT }
                { do search in a normal set which could have >32 elementsm
                  but also used if the left side contains higher values > 32 }
@@ -455,8 +462,8 @@ implementation
 
                   location_freetemp(exprasmlist,left.location);
                   hr := cg.getaddressregister(exprasmlist);
-                  cg.a_op_const_reg_reg(exprasmlist,OP_SHR,OS_ADDR,5,pleftreg,hr);
-                  cg.a_op_const_reg(exprasmlist,OP_SHL,OS_ADDR,2,hr);
+                  cg.a_op_const_reg_reg(exprasmlist,OP_SHR,OS_INT,5,pleftreg,hr);
+                  cg.a_op_const_reg(exprasmlist,OP_SHL,OS_INT,2,hr);
 
                   href := right.location.reference;
                   if (href.base = NR_NO) then
@@ -473,15 +480,15 @@ implementation
                     end;
                   reference_release(exprasmlist,href);
                   { allocate a register for the result }
-                  location.register := cg.getintregister(exprasmlist,OS_INT);
-                  cg.a_load_ref_reg(exprasmlist,OS_32,OS_INT,href,location.register);
+                  location.register := cg.getintregister(exprasmlist,opsize);
+                  cg.a_load_ref_reg(exprasmlist,opsize,opsize,href,location.register);
 
                   cg.ungetregister(exprasmlist,pleftreg);
-                  hr := cg.getintregister(exprasmlist,OS_INT);
-                  cg.a_op_const_reg_reg(exprasmlist,OP_AND,OS_INT,31,pleftreg,hr);
-                  cg.a_op_reg_reg(exprasmlist,OP_SHR,OS_INT,hr,location.register);
+                  hr := cg.getintregister(exprasmlist,opsize);
+                  cg.a_op_const_reg_reg(exprasmlist,OP_AND,opsize,31,pleftreg,hr);
+                  cg.a_op_reg_reg(exprasmlist,OP_SHR,opsize,hr,location.register);
                   cg.ungetregister(exprasmlist,hr);
-                  cg.a_op_const_reg(exprasmlist,OP_AND,OS_INT,1,location.register);
+                  cg.a_op_const_reg(exprasmlist,OP_AND,opsize,1,location.register);
                 end;
              end;
           end;
@@ -492,7 +499,7 @@ implementation
                             TCGCASENODE
 *****************************************************************************}
 
-    procedure tcgcasenode.optimizevalues(var max_linear_list:longint;var max_dist:cardinal);
+    procedure tcgcasenode.optimizevalues(var max_linear_list:aint;var max_dist:aword);
       begin
         { no changes by default }
       end;
@@ -505,7 +512,7 @@ implementation
       end;
 
 
-    procedure tcgcasenode.genjumptable(hp : pcaserecord;min_,max_ : longint);
+    procedure tcgcasenode.genjumptable(hp : pcaserecord;min_,max_ : aint);
       begin
         internalerror(200209161);
       end;
@@ -520,7 +527,7 @@ implementation
 
       procedure genitem(t : pcaserecord);
 
-          procedure gensub(value:longint);
+          procedure gensub(value:aint);
           begin
             { here, since the sub and cmp are separate we need
               to move the result before subtract to a help
@@ -536,7 +543,7 @@ implementation
            { need we to test the first value }
            if first and (t^._low>get_min_value(left.resulttype.def)) then
              begin
-                cg.a_cmp_const_reg_label(exprasmlist,opsize,jmp_lt,aword(t^._low),hregister,elselabel);
+                cg.a_cmp_const_reg_label(exprasmlist,opsize,jmp_lt,t^._low,hregister,elselabel);
              end;
            if t^._low=t^._high then
              begin
@@ -544,8 +551,8 @@ implementation
                   cg.a_cmp_const_reg_label(exprasmlist, opsize, OC_EQ,0,hregister,t^.statement)
                 else
                   begin
-                      gensub(longint(t^._low-last));
-                      cg.a_cmp_const_reg_label(exprasmlist, opsize, OC_EQ,aword(t^._low-last),scratch_reg,t^.statement);
+                      gensub(aint(t^._low-last));
+                      cg.a_cmp_const_reg_label(exprasmlist, opsize, OC_EQ,aint(t^._low-last),scratch_reg,t^.statement);
                   end;
                 last:=t^._low;
              end
@@ -558,18 +565,18 @@ implementation
                   begin
                      { have we to ajust the first value ? }
                      if (t^._low>get_min_value(left.resulttype.def)) then
-                       gensub(longint(t^._low));
+                       gensub(aint(t^._low));
                   end
                 else
                   begin
                     { if there is no unused label between the last and the }
                     { present label then the lower limit can be checked    }
                     { immediately. else check the range in between:       }
-                    gensub(longint(t^._low-last));
-                    cg.a_cmp_const_reg_label(exprasmlist, opsize,jmp_lt,aword(t^._low-last),scratch_reg,elselabel);
+                    gensub(aint(t^._low-last));
+                    cg.a_cmp_const_reg_label(exprasmlist, opsize,jmp_lt,aint(t^._low-last),scratch_reg,elselabel);
                   end;
-                gensub(longint(t^._high-t^._low));
-                cg.a_cmp_const_reg_label(exprasmlist, opsize,jmp_le,aword(t^._high-t^._low),scratch_reg,t^.statement);
+                gensub(aint(t^._high-t^._low));
+                cg.a_cmp_const_reg_label(exprasmlist, opsize,jmp_le,aint(t^._high-t^._low),scratch_reg,t^.statement);
                 last:=t^._high;
              end;
            first:=false;
@@ -601,8 +608,10 @@ implementation
 
       procedure genitem(t : pcaserecord);
 
+{$ifndef cpu64bit}
         var
            l1 : tasmlabel;
+{$endif cpu64bit}
 
         begin
            if assigned(t^.less) then
@@ -613,19 +622,14 @@ implementation
                 if opsize in [OS_S64,OS_64] then
                   begin
                      objectlibrary.getlabel(l1);
-{$ifdef Delphi}
-                     cg.a_cmp_const_reg_label(exprasmlist, OS_32, OC_NE, hi((t^._low)),hregister2,l1);
-                     cg.a_cmp_const_reg_label(exprasmlist, OS_32, OC_EQ, lo((t^._low)),hregister, t^.statement);
-{$else}
-                     cg.a_cmp_const_reg_label(exprasmlist, OS_32, OC_NE, aword(hi(int64(t^._low))),hregister2,l1);
-                     cg.a_cmp_const_reg_label(exprasmlist, OS_32, OC_EQ, aword(lo(int64(t^._low))),hregister, t^.statement);
-{$endif}
+                     cg.a_cmp_const_reg_label(exprasmlist, OS_32, OC_NE, aint(hi(int64(t^._low))),hregister2,l1);
+                     cg.a_cmp_const_reg_label(exprasmlist, OS_32, OC_EQ, aint(lo(int64(t^._low))),hregister, t^.statement);
                      cg.a_label(exprasmlist,l1);
                   end
                 else
 {$endif cpu64bit}
                   begin
-                     cg.a_cmp_const_reg_label(exprasmlist, opsize, OC_EQ, aword(t^._low),hregister, t^.statement);
+                     cg.a_cmp_const_reg_label(exprasmlist, opsize, OC_EQ, aint(t^._low),hregister, t^.statement);
                   end;
                 { Reset last here, because we've only checked for one value and need to compare
                   for the next range both the lower and upper bound }
@@ -642,27 +646,18 @@ implementation
                      if opsize in [OS_64,OS_S64] then
                        begin
                           objectlibrary.getlabel(l1);
-{$ifdef Delphi}
-                          cg.a_cmp_const_reg_label(exprasmlist, OS_32, jmp_lt, aword(hi((t^._low))),
-                               hregister2, elselabel);
-                          cg.a_cmp_const_reg_label(exprasmlist, OS_32, jmp_gt, aword(hi((t^._low))),
-                               hregister2, l1);
-                          { the comparisation of the low dword must be always unsigned! }
-                          cg.a_cmp_const_reg_label(exprasmlist, OS_32, OC_B, aword(lo((t^._low))), hregister, elselabel);
-{$else}
-                          cg.a_cmp_const_reg_label(exprasmlist, OS_32, jmp_lt, aword(hi(int64(t^._low))),
+                          cg.a_cmp_const_reg_label(exprasmlist, OS_32, jmp_lt, aint(hi(int64(t^._low))),
                                hregister2, elselabel);
-                          cg.a_cmp_const_reg_label(exprasmlist, OS_32, jmp_gt, aword(hi(int64(t^._low))),
+                          cg.a_cmp_const_reg_label(exprasmlist, OS_32, jmp_gt, aint(hi(int64(t^._low))),
                                hregister2, l1);
                           { the comparisation of the low dword must be always unsigned! }
-                          cg.a_cmp_const_reg_label(exprasmlist, OS_32, OC_B, aword(lo(int64(t^._low))), hregister, elselabel);
-{$endif}
+                          cg.a_cmp_const_reg_label(exprasmlist, OS_32, OC_B, aint(lo(int64(t^._low))), hregister, elselabel);
                           cg.a_label(exprasmlist,l1);
                        end
                      else
 {$endif cpu64bit}
                        begin
-                        cg.a_cmp_const_reg_label(exprasmlist, opsize, jmp_lt, aword(t^._low), hregister,
+                        cg.a_cmp_const_reg_label(exprasmlist, opsize, jmp_lt, aint(t^._low), hregister,
                            elselabel);
                        end;
                   end;
@@ -670,25 +665,17 @@ implementation
                 if opsize in [OS_S64,OS_64] then
                   begin
                      objectlibrary.getlabel(l1);
-{$ifdef Delphi}
-                     cg.a_cmp_const_reg_label(exprasmlist, OS_32, jmp_lt, aword(hi(t^._high)), hregister2,
+                     cg.a_cmp_const_reg_label(exprasmlist, OS_32, jmp_lt, aint(hi(int64(t^._high))), hregister2,
                            t^.statement);
-                     cg.a_cmp_const_reg_label(exprasmlist, OS_32, jmp_gt, aword(hi(t^._high)), hregister2,
+                     cg.a_cmp_const_reg_label(exprasmlist, OS_32, jmp_gt, aint(hi(int64(t^._high))), hregister2,
                            l1);
-                    cg.a_cmp_const_reg_label(exprasmlist, OS_32, OC_BE, aword(lo(t^._high)), hregister, t^.statement);
-{$else}
-                     cg.a_cmp_const_reg_label(exprasmlist, OS_32, jmp_lt, aword(hi(int64(t^._high))), hregister2,
-                           t^.statement);
-                     cg.a_cmp_const_reg_label(exprasmlist, OS_32, jmp_gt, aword(hi(int64(t^._high))), hregister2,
-                           l1);
-                    cg.a_cmp_const_reg_label(exprasmlist, OS_32, OC_BE, aword(lo(int64(t^._high))), hregister, t^.statement);
-{$endif}
+                    cg.a_cmp_const_reg_label(exprasmlist, OS_32, OC_BE, aint(lo(int64(t^._high))), hregister, t^.statement);
                     cg.a_label(exprasmlist,l1);
                   end
                 else
 {$endif cpu64bit}
                   begin
-                     cg.a_cmp_const_reg_label(exprasmlist, opsize, jmp_le, aword(t^._high), hregister, t^.statement);
+                     cg.a_cmp_const_reg_label(exprasmlist, opsize, jmp_le, aint(t^._high), hregister, t^.statement);
                   end;
 
                 last:=t^._high;
@@ -775,12 +762,12 @@ implementation
       var
          lv,hv,
          max_label: tconstexprint;
-         labels : longint;
-         max_linear_list : longint;
+         labels : aint;
+         max_linear_list : aint;
          otl, ofl: tasmlabel;
          isjump : boolean;
          max_dist,
-         dist : cardinal;
+         dist : aword;
          hp : tstatementnode;
       begin
          location_reset(location,LOC_VOID,OS_NO);
@@ -866,14 +853,14 @@ implementation
                    getrange(left.resulttype.def,lv,hv);
                    jumptable_no_range:=(lv=min_label) and (hv=max_label);
                    { hack a little bit, because the range can be greater }
-                   { than the positive range of a longint            }
+                   { than the positive range of a aint            }
 
                    if (min_label<0) and (max_label>0) then
                      begin
-                        if min_label=TConstExprInt($80000000) then
-                          dist:=Cardinal(max_label)+Cardinal($80000000)
+                        if min_label=TConstExprInt(low(aint)) then
+                          dist:=aword(max_label)+aword(low(aint))
                         else
-                          dist:=Cardinal(max_label)+Cardinal(-min_label)
+                          dist:=aword(max_label)+aword(-min_label)
                      end
                    else
                      dist:=max_label-min_label;
@@ -897,7 +884,7 @@ implementation
                      end
                    else
                      begin
-                        max_dist:=4*cardinal(labels);
+                        max_dist:=4*aword(labels);
                         if jumptable_no_range then
                           max_linear_list:=4
                         else
@@ -984,9 +971,28 @@ begin
 end.
 {
   $Log$
-  Revision 1.61  2004-05-30 21:18:22  jonas
+  Revision 1.62  2004-06-16 20:07:08  florian
+    * dwarf branch merged
+
+  Revision 1.61  2004/05/30 21:18:22  jonas
     * some optimizations and associated fixes for better regvar code
 
+  Revision 1.60.2.5  2004/05/02 16:49:12  peter
+    * 64 bit fixes
+
+  Revision 1.60.2.4  2004/05/02 14:09:54  peter
+    * fix case 64bit issues
+
+  Revision 1.60.2.3  2004/05/01 16:02:09  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
+  Revision 1.60.2.2  2004/04/27 18:18:25  peter
+    * aword -> aint
+
+  Revision 1.60.2.1  2004/04/26 21:02:34  peter
+    * 64bit fixes
+
   Revision 1.60  2004/02/27 10:21:05  florian
     * top_symbol killed
     + refaddr to treference added
@@ -1244,4 +1250,3 @@ end.
   + generic sets
 
 }
-

compiler/ncgutil.pas

@@ -53,8 +53,8 @@ interface
 
     procedure gen_proc_symbol(list:Taasmoutput);
     procedure gen_proc_symbol_end(list:Taasmoutput);
-    procedure gen_stackalloc_code(list:Taasmoutput);
-    procedure gen_stackfree_code(list:Taasmoutput;usesacc,usesacchi:boolean);
+    procedure gen_proc_entry_code(list:Taasmoutput);
+    procedure gen_proc_exit_code(list:Taasmoutput);
     procedure gen_save_used_regs(list:TAAsmoutput);
     procedure gen_restore_used_regs(list:TAAsmoutput;const funcretparaloc:tparalocation);
     procedure gen_initialize_code(list:TAAsmoutput;inlined:boolean);
@@ -62,7 +62,7 @@ interface
     procedure gen_entry_code(list:TAAsmoutput);
     procedure gen_exit_code(list:TAAsmoutput);
     procedure gen_load_para_value(list:TAAsmoutput);
-    procedure gen_load_return_value(list:TAAsmoutput; var uses_acc,uses_acchi,uses_fpu : boolean);
+    procedure gen_load_return_value(list:TAAsmoutput);
 
 (*
     procedure geninlineentrycode(list:TAAsmoutput;stackframe:longint);
@@ -86,7 +86,8 @@ interface
     }
 
     const
-      EXCEPT_BUF_SIZE = 12;
+
+      EXCEPT_BUF_SIZE = 4*2*sizeof(aint);
     type
       texceptiontemps=record
         jmpbuf,
@@ -96,8 +97,8 @@ interface
 
     procedure get_exception_temps(list:taasmoutput;var t:texceptiontemps);
     procedure unget_exception_temps(list:taasmoutput;const t:texceptiontemps);
-    procedure new_exception(list:TAAsmoutput;const t:texceptiontemps;a:aword;exceptlabel:tasmlabel);
-    procedure free_exception(list:TAAsmoutput;const t:texceptiontemps;a:aword;endexceptlabel:tasmlabel;onlyfree:boolean);
+    procedure new_exception(list:TAAsmoutput;const t:texceptiontemps;a:aint;exceptlabel:tasmlabel);
+    procedure free_exception(list:TAAsmoutput;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean);
 
     procedure insertconstdata(sym : ttypedconstsym);
     procedure insertbssdata(sym : tvarsym);
@@ -125,7 +126,7 @@ implementation
     globals,systems,verbose,
     ppu,defutil,
     procinfo,paramgr,fmodule,
-    regvars,
+    regvars,dwarf,
 {$ifdef GDB}
     gdb,
 {$endif GDB}
@@ -274,6 +275,7 @@ implementation
       end;
         *)
 
+
 {*****************************************************************************
                             EXCEPTION MANAGEMENT
 *****************************************************************************}
@@ -282,7 +284,7 @@ implementation
       begin
         tg.GetTemp(list,EXCEPT_BUF_SIZE,tt_persistent,t.envbuf);
         tg.GetTemp(list,JMP_BUF_SIZE,tt_persistent,t.jmpbuf);
-        tg.GetTemp(list,sizeof(aword),tt_persistent,t.reasonbuf);
+        tg.GetTemp(list,sizeof(aint),tt_persistent,t.reasonbuf);
       end;
 
 
@@ -294,7 +296,7 @@ implementation
       end;
 
 
-    procedure new_exception(list:TAAsmoutput;const t:texceptiontemps;a:aword;exceptlabel:tasmlabel);
+    procedure new_exception(list:TAAsmoutput;const t:texceptiontemps;a:aint;exceptlabel:tasmlabel);
       var
         paraloc1,paraloc2,paraloc3 : tparalocation;
       begin
@@ -328,7 +330,7 @@ implementation
      end;
 
 
-    procedure free_exception(list:TAAsmoutput;const t:texceptiontemps;a:aword;endexceptlabel:tasmlabel;onlyfree:boolean);
+    procedure free_exception(list:TAAsmoutput;const t:texceptiontemps;a:aint;endexceptlabel:tasmlabel;onlyfree:boolean);
      begin
          cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
          cg.a_call_name(list,'FPC_POPADDRSTACK');
@@ -400,7 +402,7 @@ implementation
                  if l.loc=LOC_CONSTANT then
                   begin
                     if (longint(l.value)<0) then
-                     cg.a_load_const_reg(list,OS_32,$ffffffff,hregisterhi)
+                     cg.a_load_const_reg(list,OS_32,aint($ffffffff),hregisterhi)
                     else
                      cg.a_load_const_reg(list,OS_32,0,hregisterhi);
                   end
@@ -446,7 +448,7 @@ implementation
             allocator eliminates unnecessary moves, so it's not needed
             and trying to recycle registers can cause problems because
             the registers changes size and may need aditional constraints.
-            
+
             Not if it's about LOC_CREGISTER's (JM)
             }
            const_location :=
@@ -523,6 +525,7 @@ implementation
         hl : tasmlabel;
         oldloc : tlocation;
       begin
+        oldloc:=l;
         {Do not bother to recycle the existing register. The register
          allocator eliminates unnecessary moves, so it's not needed
          and trying to recycle registers can cause problems because
@@ -665,12 +668,14 @@ implementation
           LOC_CREGISTER :
             begin
               tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
+{$ifndef cpu64bit}
               if l.size in [OS_64,OS_S64] then
                 begin
                   cg64.a_load64_loc_ref(list,l,r);
                   location_release(list,l);
                 end
               else
+{$endif cpu64bit}
                 begin
                   location_release(list,l);
                   cg.a_load_loc_ref(list,l.size,l,r);
@@ -701,6 +706,8 @@ implementation
           end
         else
           maybe_pushfpu:=false;
+{$else i386}
+        maybe_pushfpu:=false;
 {$endif i386}
       end;
 
@@ -950,9 +957,7 @@ implementation
       var
         hp : ptemprecord;
         href : treference;
-        paraloc1 : tparalocation;
       begin
-        paraloc1:=paramanager.getintparaloc(pocall_default,1);
         hp:=tg.templist;
         while assigned(hp) do
          begin
@@ -968,13 +973,14 @@ implementation
       end;
 
 
-    procedure gen_load_return_value(list:TAAsmoutput; var uses_acc,uses_acchi,uses_fpu : boolean);
+    procedure gen_load_return_value(list:TAAsmoutput);
       var
         ressym : tvarsym;
         resloc : tlocation;
-        href   : treference;
         hreg   : tregister;
+        resultloc : tparalocation;
       begin
+        resultloc:=current_procinfo.procdef.funcret_paraloc[calleeside];
         { Is the loading needed? }
         if is_void(current_procinfo.procdef.rettype.def) or
            (
@@ -982,53 +988,37 @@ implementation
             (not(assigned(current_procinfo.procdef.funcretsym)) or
              (tvarsym(current_procinfo.procdef.funcretsym).refs=0))
            ) then
-          exit;
+           exit;
 
-        { Constructors need to return self }
+        { constructors return self }
         if (current_procinfo.procdef.proctypeoption=potype_constructor) then
+          ressym:=tvarsym(current_procinfo.procdef.parast.search('self'))
+        else
+          ressym := tvarsym(current_procinfo.procdef.funcretsym);
+        if (ressym.refs>0) then
           begin
-            cg.getexplicitregister(list,NR_FUNCTION_RETURN_REG);
-            { return the self pointer }
-            ressym:=tvarsym(current_procinfo.procdef.parast.search('self'));
-            if not assigned(ressym) then
-              internalerror(200305058);
-            cg.ungetregister(list,NR_FUNCTION_RETURN_REG);
-            // for the optimizer
-            cg.a_reg_alloc(list,NR_FUNCTION_RETURN_REG);
             case ressym.localloc.loc of
-              LOC_REFERENCE :
+              LOC_FPUREGISTER:
                 begin
-                  reference_reset_base(href,ressym.localloc.reference.index,ressym.localloc.reference.offset);
-                  cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_FUNCTION_RETURN_REG);
+                  location_reset(resloc,LOC_CREGISTER,resultloc.size);
+                  resloc.register:=ressym.localloc.register;
                 end;
+
               LOC_REGISTER:
-                cg.a_load_reg_reg(list,OS_ADDR,OS_ADDR,ressym.localloc.register,NR_FUNCTION_RETURN_REG);
-              else
-                internalerror(2004020409);
-            end;
-            uses_acc:=true;
-            exit;
-          end;
+                begin
+                  location_reset(resloc,LOC_CREGISTER,resultloc.size);
+                  resloc.register:=ressym.localloc.register;
+                end;
 
-        ressym := tvarsym(current_procinfo.procdef.funcretsym);
-        if (ressym.refs>0) then
-          begin
-            case ressym.localloc.loc of
-              LOC_FPUREGISTER,
-              LOC_REGISTER :
+              LOC_MMREGISTER:
                 begin
-                  if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
-                    location_reset(resloc,LOC_CREGISTER,OS_ADDR)
-                  else
-                    if ressym.vartype.def.deftype = floatdef then
-                      location_reset(resloc,LOC_CFPUREGISTER,def_cgsize(current_procinfo.procdef.rettype.def))
-                    else
-                      location_reset(resloc,LOC_CREGISTER,def_cgsize(current_procinfo.procdef.rettype.def));
+                  location_reset(resloc,LOC_CMMREGISTER,resultloc.size);
                   resloc.register:=ressym.localloc.register;
                 end;
-              LOC_REFERENCE :
+
+              LOC_REFERENCE:
                 begin
-                  location_reset(resloc,LOC_REFERENCE,def_cgsize(current_procinfo.procdef.rettype.def));
+                  location_reset(resloc,LOC_REFERENCE,resultloc.size);
                   reference_reset_base(resloc.reference,ressym.localloc.reference.index,ressym.localloc.reference.offset);
                 end;
               else
@@ -1038,78 +1028,46 @@ implementation
             { Here, we return the function result. In most architectures, the value is
               passed into the FUNCTION_RETURN_REG, but in a windowed architecure like sparc a
               function returns in a register and the caller receives it in an other one }
-            case current_procinfo.procdef.rettype.def.deftype of
-              orddef,
-              enumdef :
+            case resultloc.loc of
+              LOC_REGISTER:
                 begin
-                  uses_acc:=true;
-    {$ifndef cpu64bit}
+{$ifndef cpu64bit}
                   if resloc.size in [OS_64,OS_S64] then
-                   begin
-                     uses_acchi:=true;
-                     cg.getexplicitregister(list,NR_FUNCTION_RETURN64_LOW_REG);
-                     cg.getexplicitregister(list,NR_FUNCTION_RETURN64_HIGH_REG);
-                     cg.ungetregister(list,NR_FUNCTION_RETURN64_LOW_REG);
-                     cg.ungetregister(list,NR_FUNCTION_RETURN64_HIGH_REG);
-                     // for the optimizer
-                     cg.a_reg_alloc(list,NR_FUNCTION_RETURN64_LOW_REG);
-                     cg.a_reg_alloc(list,NR_FUNCTION_RETURN64_HIGH_REG);
-                     cg64.a_load64_loc_reg(list,resloc,joinreg64(NR_FUNCTION_RETURN64_LOW_REG,
-                                           NR_FUNCTION_RETURN64_HIGH_REG));
-                   end
+                    begin
+                      cg.getexplicitregister(list,NR_FUNCTION_RETURN64_LOW_REG);
+                      cg.getexplicitregister(list,NR_FUNCTION_RETURN64_HIGH_REG);
+                      cg.ungetregister(list,NR_FUNCTION_RETURN64_LOW_REG);
+                      cg.ungetregister(list,NR_FUNCTION_RETURN64_HIGH_REG);
+                      // for the optimizer
+                      cg.a_reg_alloc(list,NR_FUNCTION_RETURN64_LOW_REG);
+                      cg.a_reg_alloc(list,NR_FUNCTION_RETURN64_HIGH_REG);
+                      cg64.a_load64_loc_reg(list,resloc,joinreg64(NR_FUNCTION_RETURN64_LOW_REG,
+                                            NR_FUNCTION_RETURN64_HIGH_REG));
+                    end
                   else
-    {$endif cpu64bit}
-                   begin
-                     cg.getexplicitregister(list,NR_FUNCTION_RETURN_REG);
-                     hreg:=cg.makeregsize(list,NR_FUNCTION_RETURN_REG,resloc.size);
-                     cg.ungetregister(list,hreg);
-                     // for the optimizer
-                     cg.a_reg_alloc(list,NR_FUNCTION_RETURN_REG);
-                     cg.a_load_loc_reg(list,resloc.size,resloc,hreg);
-                   end;
+{$endif cpu64bit}
+                    begin
+                      cg.getexplicitregister(list,resultloc.register);
+                      hreg:=cg.makeregsize(list,resultloc.register,resloc.size);
+                      cg.ungetregister(list,hreg);
+                      // for the optimizer
+                      cg.a_reg_alloc(list,resultloc.register);
+                      cg.a_load_loc_reg(list,resloc.size,resloc,hreg);
+                    end;
                 end;
-              floatdef :
+              LOC_FPUREGISTER:
                 begin
-                  uses_fpu := true;
-    {$ifdef cpufpemu}
-                  if cs_fp_emulation in aktmoduleswitches then
-                    cg.a_loadfpu_loc_reg(list,resloc,NR_FUNCTION_RETURN_REG)
-                  else
-    {$endif cpufpemu}
-                    cg.a_loadfpu_loc_reg(list,resloc,NR_FPU_RESULT_REG);
+                  cg.a_loadfpu_loc_reg(list,resloc,resultloc.register);
                 end;
-              else
+              LOC_MMREGISTER:
                 begin
-                  if not paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
-                   begin
-                     uses_acc:=true;
-    {$ifndef cpu64bit}
-                     { Win32 can return records in EAX:EDX }
-                     if resloc.size in [OS_64,OS_S64] then
-                      begin
-                        uses_acchi:=true;
-                        cg.getexplicitregister(list,NR_FUNCTION_RETURN64_LOW_REG);
-                        cg.getexplicitregister(list,NR_FUNCTION_RETURN64_HIGH_REG);
-                        cg.ungetregister(list,NR_FUNCTION_RETURN64_LOW_REG);
-                        cg.ungetregister(list,NR_FUNCTION_RETURN64_HIGH_REG);
-                        // for the optimizer
-                        cg.a_reg_alloc(list,NR_FUNCTION_RETURN64_LOW_REG);
-                        cg.a_reg_alloc(list,NR_FUNCTION_RETURN64_HIGH_REG);
-                        cg64.a_load64_loc_reg(list,resloc,joinreg64(NR_FUNCTION_RETURN64_LOW_REG,
-                                              NR_FUNCTION_RETURN64_HIGH_REG));
-                      end
-                     else
-    {$endif cpu64bit}
-                      begin
-                        cg.getexplicitregister(list,NR_FUNCTION_RETURN_REG);
-                        hreg:=cg.makeregsize(list,NR_FUNCTION_RETURN_REG,resloc.size);
-                        cg.ungetregister(list,hreg);
-                        // for the optimizer
-                        cg.a_reg_alloc(list,NR_FUNCTION_RETURN_REG);
-                        cg.a_load_loc_reg(list,resloc.size,resloc,hreg);
-                      end;
-                    end
+                  cg.a_loadmm_loc_reg(list,resloc.size,resloc,resultloc.register,mms_movescalar);
                 end;
+              LOC_INVALID,
+              LOC_REFERENCE:
+                ;
+              else
+                internalerror(200405025);
             end;
          end;
       end;
@@ -1141,36 +1099,39 @@ implementation
                       { cg.a_load_param_reg will first allocate and then deallocate paraloc }
                       { register (if the parameter resides in a register) and then allocate }
                       { the regvar (which is currently not allocated)                       }
-                      cg.a_loadany_param_reg(list,hp.paraloc[calleeside],tvarsym(hp.parasym).localloc.register,nil);
+                      cg.a_loadany_param_reg(list,hp.paraloc[calleeside],tvarsym(hp.parasym).localloc.register,mms_movescalar);
                     end;
                   LOC_REFERENCE :
                     begin
                       if hp.paraloc[calleeside].loc<>LOC_REFERENCE then
                         begin
-                          if getsupreg(hp.paraloc[calleeside].register)<first_int_imreg then
+                          if getregtype(hp.paraloc[calleeside].register)=R_INTREGISTER then
                             begin
+                              if getsupreg(hp.paraloc[calleeside].register)<first_int_imreg then
+                                begin
+{$ifndef cpu64bit}
+                                  if (hp.paraloc[calleeside].size in [OS_S64,OS_64]) then
+                                    begin
+                                      cg.getexplicitregister(list,hp.paraloc[calleeside].registerlow);
+                                      cg.getexplicitregister(list,hp.paraloc[calleeside].registerhigh);
+                                    end
+                                  else
+{$endif cpu64bit}
+                                    cg.getexplicitregister(list,hp.paraloc[calleeside].register);
+                                end;
+                              { Release parameter register }
 {$ifndef cpu64bit}
                               if (hp.paraloc[calleeside].size in [OS_S64,OS_64]) then
                                 begin
-                                  cg.getexplicitregister(list,hp.paraloc[calleeside].registerlow);
-                                  cg.getexplicitregister(list,hp.paraloc[calleeside].registerhigh);
+                                  cg.ungetregister(list,hp.paraloc[calleeside].registerlow);
+                                  cg.ungetregister(list,hp.paraloc[calleeside].registerhigh);
                                 end
                               else
 {$endif cpu64bit}
-                                cg.getexplicitregister(list,hp.paraloc[calleeside].register);
+                                cg.ungetregister(list,hp.paraloc[calleeside].register);
                             end;
-                          { Release parameter register }
-{$ifndef cpu64bit}
-                          if (hp.paraloc[calleeside].size in [OS_S64,OS_64]) then
-                            begin
-                              cg.ungetregister(list,hp.paraloc[calleeside].registerlow);
-                              cg.ungetregister(list,hp.paraloc[calleeside].registerhigh);
-                            end
-                          else
-{$endif cpu64bit}
-                            cg.ungetregister(list,hp.paraloc[calleeside].register);
                           reference_reset_base(href,tvarsym(hp.parasym).localloc.reference.index,tvarsym(hp.parasym).localloc.reference.offset);
-                          cg.a_loadany_param_ref(list,hp.paraloc[calleeside],href,nil);
+                          cg.a_loadany_param_ref(list,hp.paraloc[calleeside],href,mms_movescalar);
                         end;
                     end;
                   else
@@ -1323,11 +1284,11 @@ implementation
                while assigned(hp) do
                  begin
                    If (hp.u.flags and uf_has_debuginfo)=uf_has_debuginfo then
-                     current_procinfo.aktlocaldata.concat(Tai_const_symbol.Createname(make_mangledname('DEBUGINFO',hp.u.globalsymtable,''),AT_DATA,0));
+                     current_procinfo.aktlocaldata.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',hp.u.globalsymtable,''),AT_DATA,0));
                    hp:=tused_unit(hp.next);
                  end;
                { include reference to debuginfo for this program }
-               current_procinfo.aktlocaldata.concat(Tai_const_symbol.Createname(make_mangledname('DEBUGINFO',current_module.localsymtable,''),AT_DATA,0));
+               current_procinfo.aktlocaldata.concat(Tai_const.Createname(make_mangledname('DEBUGINFO',current_module.localsymtable,''),AT_DATA,0));
              end;
 {$endif GDB}
          end;
@@ -1478,7 +1439,7 @@ implementation
       end;
 
 
-    procedure gen_stackalloc_code(list:Taasmoutput);
+    procedure gen_proc_entry_code(list:Taasmoutput);
       var
         hitemp,
         lotemp,
@@ -1487,6 +1448,11 @@ implementation
         paraloc1   : tparalocation;
         href       : treference;
       begin
+        { generate call frame marker for dwarf call frame info }
+        dwarfcfi.start_frame(list);
+
+        { allocate temp for saving the argument used when
+          stack checking uses a register for pushing the stackframe size }
         check:=(cs_check_stack in aktlocalswitches) and (current_procinfo.procdef.proctypeoption<>potype_proginit);
         if check then
           begin
@@ -1494,8 +1460,9 @@ implementation
               is destroyed when calling stackchecking code }
             paraloc1:=paramanager.getintparaloc(pocall_default,1);
             if paraloc1.loc=LOC_REGISTER then
-              tg.GetTemp(list,POINTER_SIZE,tt_normal,href);
+              tg.GetTemp(list,sizeof(aint),tt_normal,href);
           end;
+
         { Calculate size of stackframe }
         stackframe:=current_procinfo.calc_stackframe_size;
 
@@ -1516,94 +1483,56 @@ implementation
               tostr_with_plus(lotemp)+' and '+std_regname(current_procinfo.framepointer)+tostr_with_plus(hitemp))));
           end;
 
-{$ifndef powerpc}
-        { at least for the ppc this applies always, so this code isn't usable (FK) }
-        { omit stack frame ? }
-        if (current_procinfo.framepointer=NR_STACK_POINTER_REG) then
-          begin
-            CGmessage(cg_d_stackframe_omited);
-            if stackframe<>0 then
-              cg.g_stackpointer_alloc(list,stackframe);
-          end
-        else
-{$endif powerpc}
-          begin
-            if (po_interrupt in current_procinfo.procdef.procoptions) then
-              cg.g_interrupt_stackframe_entry(list);
+         { generate target specific proc entry code }
+         cg.g_proc_entry(list,stackframe,(po_nostackframe in current_procinfo.procdef.procoptions));
 
-            cg.g_stackframe_entry(list,stackframe);
-
-            { Add stack checking code? }
-            if check then
-              begin
-                { The tempspace to store original register is already
-                  allocated above before the stackframe size is calculated. }
-                if paraloc1.loc=LOC_REGISTER then
-                  cg.a_load_reg_ref(list,OS_INT,OS_INT,paraloc1.register,href);
-                paramanager.allocparaloc(list,paraloc1);
-                cg.a_param_const(list,OS_INT,stackframe,paraloc1);
-                paramanager.freeparaloc(list,paraloc1);
-                { No register saving needed, saveregisters is used }
-{$ifndef x86}
-                cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
-{$endif x86}
-                cg.a_call_name(list,'FPC_STACKCHECK');
-{$ifndef x86}
-                cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
-{$endif x86}
-                if paraloc1.loc=LOC_REGISTER then
-                  begin
-                    cg.a_load_ref_reg(list,OS_INT,OS_INT,href,paraloc1.register);
-                    tg.UnGetTemp(list,href);
-                  end;
-              end;
-          end;
+         { Add stack checking code? }
+         if check then
+           begin
+             { The tempspace to store original register is already
+               allocated above before the stackframe size is calculated. }
+             if paraloc1.loc=LOC_REGISTER then
+               cg.a_load_reg_ref(list,OS_INT,OS_INT,paraloc1.register,href);
+             paramanager.allocparaloc(list,paraloc1);
+             cg.a_param_const(list,OS_INT,stackframe,paraloc1);
+             paramanager.freeparaloc(list,paraloc1);
+             cg.allocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+             cg.a_call_name(list,'FPC_STACKCHECK');
+             cg.deallocexplicitregisters(list,R_INTREGISTER,paramanager.get_volatile_registers_int(pocall_default));
+             if paraloc1.loc=LOC_REGISTER then
+               begin
+                 cg.a_load_ref_reg(list,OS_INT,OS_INT,href,paraloc1.register);
+                 tg.UnGetTemp(list,href);
+               end;
+           end;
       end;
 
 
-    procedure gen_stackfree_code(list:Taasmoutput;usesacc,usesacchi:boolean);
+    procedure gen_proc_exit_code(list:Taasmoutput);
       var
-        stacksize,
-        retsize : longint;
+        parasize : longint;
       begin
-{$ifndef powerpc}
-        { remove stackframe }
-        if (current_procinfo.framepointer=NR_STACK_POINTER_REG) then
-          begin
-            stacksize:=current_procinfo.calc_stackframe_size;
-            if (stacksize<>0) then
-              cg.a_op_const_reg(list,OP_ADD,OS_ADDR,stacksize,current_procinfo.framepointer);
-          end
-        else
-          cg.g_restore_frame_pointer(list);
-{$endif}
-{$ifdef x86}
-        { at last, the return is generated }
-        if (po_interrupt in current_procinfo.procdef.procoptions) then
-          cg.g_interrupt_stackframe_exit(list,usesacc,usesacchi)
-        else
-{$endif x86}
-          begin
-            if current_procinfo.procdef.proccalloption in clearstack_pocalls then
-              begin
-                retsize:=0;
-                if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
-                  inc(retsize,POINTER_SIZE);
-              end
-            else
-              retsize:=current_procinfo.para_stack_size;
-            cg.g_return_from_proc(list,retsize);
-          end;
-{$ifndef cpu64bit}
-        if usesacchi then
+        { c style clearstack does not need to remove parameters from the stack, only the
+          return value when it was pushed by arguments }
+        if current_procinfo.procdef.proccalloption in clearstack_pocalls then
           begin
-            cg.a_reg_dealloc(list,NR_FUNCTION_RETURN64_LOW_REG);
-            cg.a_reg_dealloc(list,NR_FUNCTION_RETURN64_HIGH_REG);
+            parasize:=0;
+            if paramanager.ret_in_param(current_procinfo.procdef.rettype.def,current_procinfo.procdef.proccalloption) then
+              inc(parasize,sizeof(aint));
           end
         else
-{$endif cpu64bit}
-        if usesacc then
-          cg.a_reg_dealloc(list,NR_FUNCTION_RETURN_REG);
+          parasize:=current_procinfo.para_stack_size;
+
+        { generate target specific proc exit code }
+        cg.g_proc_exit(list,parasize,(po_nostackframe in current_procinfo.procdef.procoptions));
+
+        { release return registers, needed for optimizer }
+        if current_procinfo.procdef.funcret_paraloc[calleeside].loc<>LOC_INVALID then
+          paramanager.freeparaloc(list,
+            current_procinfo.procdef.funcret_paraloc[calleeside]);
+
+        { end of frame marker for call frame info }
+        dwarfcfi.end_frame(list);
       end;
 
 
@@ -1797,8 +1726,6 @@ implementation
         storefilepos : tfileposinfo;
         curconstsegment : taasmoutput;
         l : longint;
-        stabstr:Pchar;
-
       begin
         storefilepos:=aktfilepos;
         aktfilepos:=sym.fileinfo;
@@ -1808,11 +1735,10 @@ implementation
           curconstsegment:=consts;
         l:=sym.getsize;
         { insert cut for smartlinking or alignment }
-        if (cs_create_smart in aktmoduleswitches) then
-          curconstSegment.concat(Tai_cut.Create);
-        curconstSegment.concat(Tai_align.create(const_align(l)));
+        maybe_new_object_file(curconstSegment);
+        new_section(curconstSegment,sec_rodata,lower(sym.mangledname),const_align(l));
         if (sym.owner.symtabletype=globalsymtable) or
-           (cs_create_smart in aktmoduleswitches) or
+           maybe_smartlink_symbol or
            (assigned(current_procinfo) and
             (current_procinfo.procdef.proccalloption=pocall_inline)) or
            DLLSource then
@@ -1827,24 +1753,17 @@ implementation
       var
         l,varalign : longint;
         storefilepos : tfileposinfo;
-        stabstr:Pchar;
       begin
         storefilepos:=aktfilepos;
         aktfilepos:=sym.fileinfo;
         l:=sym.getvaluesize;
         if (vo_is_thread_var in sym.varoptions) then
-          inc(l,pointer_size);
+          inc(l,sizeof(aint));
         varalign:=var_align(l);
-        {
-        sym.address:=align(datasize,varalign);
-        datasize:=tvarsym(sym).address+l;
-        }
-        { insert cut for smartlinking or alignment }
-        if (cs_create_smart in aktmoduleswitches) then
-          bssSegment.concat(Tai_cut.Create);
-        bssSegment.concat(Tai_align.create(varalign));
+        maybe_new_object_file(bssSegment);
+        new_section(bssSegment,sec_bss,lower(sym.mangledname),varalign);
         if (sym.owner.symtabletype=globalsymtable) or
-           (cs_create_smart in aktmoduleswitches) or
+           maybe_smartlink_symbol or
            DLLSource or
            (assigned(current_procinfo) and
             (current_procinfo.procdef.proccalloption=pocall_inline)) or
@@ -2015,7 +1934,7 @@ implementation
                   begin
 {$warning TODO Allocate register paras}
                     localloc.loc:=LOC_REFERENCE;
-                    localloc.size:=int_cgsize(paramanager.push_size(vs_value,vartype.def,pocall_inline));
+                    localloc.size:=int_cgsize(paramanager.push_size(varspez,vartype.def,pocall_inline));
                     tg.GetLocal(list,tcgsize2size[localloc.size],vartype.def,localloc.reference);
                     if cs_asm_source in aktglobalswitches then
                       begin
@@ -2083,7 +2002,7 @@ implementation
         { rtti can only be generated for classes that are always typesyms }
         def:=tstoreddef(ttypesym(p).restype.def);
         { there is an error, skip rtti info }
-        if def.deftype=errordef then
+        if (def.deftype=errordef) or (Errorcount>0) then
           exit;
         { only create rtti once for each definition }
         if not(df_has_rttitable in def.defoptions) then
@@ -2099,9 +2018,8 @@ implementation
            def.rttitablesym:=rsym;
            { write rtti data }
            def.write_child_rtti_data(fullrtti);
-           if (cs_create_smart in aktmoduleswitches) then
-            rttiList.concat(Tai_cut.Create);
-           rttilist.concat(tai_align.create(const_align(pointer_size)));
+           maybe_new_object_file(rttilist);
+           new_section(rttilist,sec_rodata,rsym.get_label.name,const_align(sizeof(aint)));
            rttiList.concat(Tai_symbol.Create_global(rsym.get_label,0));
            def.write_rtti_data(fullrtti);
            rttiList.concat(Tai_symbol_end.Create(rsym.get_label));
@@ -2138,9 +2056,8 @@ implementation
            def.inittablesym:=rsym;
            { write inittable data }
            def.write_child_rtti_data(initrtti);
-           if (cs_create_smart in aktmoduleswitches) then
-            rttiList.concat(Tai_cut.Create);
-           rttilist.concat(tai_align.create(const_align(pointer_size)));
+           maybe_new_object_file(rttilist);
+           new_section(rttilist,sec_rodata,rsym.get_label.name,const_align(sizeof(aint)));
            rttiList.concat(Tai_symbol.Create_global(rsym.get_label,0));
            def.write_rtti_data(initrtti);
            rttiList.concat(Tai_symbol_end.Create(rsym.get_label));
@@ -2150,7 +2067,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.206  2004-06-01 20:39:33  jonas
+  Revision 1.207  2004-06-16 20:07:08  florian
+    * dwarf branch merged
+
+  Revision 1.206  2004/06/01 20:39:33  jonas
     * fixed bug regarding parameters on the ppc (they were allocated twice
       under some circumstances and not at all in others)
 
@@ -2184,6 +2104,68 @@ end.
   Revision 1.198  2004/05/02 17:26:19  peter
     * fix stabs for globals
 
+  Revision 1.197.2.19  2004/05/31 16:39:42  peter
+    * add ungetiftemp in a few locations
+
+  Revision 1.197.2.18  2004/05/27 23:36:18  peter
+    * nostackframe procdirective added
+
+  Revision 1.197.2.17  2004/05/10 21:28:34  peter
+    * section_smartlink enabled for gas under linux
+
+  Revision 1.197.2.16  2004/05/02 21:07:30  florian
+    * fixed constructor results
+
+  Revision 1.197.2.15  2004/05/02 20:56:54  florian
+    * more fixes to handle_return_value update
+
+  Revision 1.197.2.14  2004/05/02 20:20:59  florian
+    * started to fix callee side result value handling
+
+  Revision 1.197.2.13  2004/05/02 16:49:43  peter
+    * generate stabs for globals/locals at the end of a unit compile
+
+  Revision 1.197.2.12  2004/05/01 23:34:43  peter
+    * don't generate rtti when there is an error
+
+  Revision 1.197.2.11  2004/05/01 16:02:09  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
+  Revision 1.197.2.10  2004/04/29 23:30:28  peter
+    * fix i386 compiler
+
+  Revision 1.197.2.9  2004/04/27 18:47:51  florian
+    * exception addr record size for 64 bit systems fixed
+
+  Revision 1.197.2.8  2004/04/27 18:18:25  peter
+    * aword -> aint
+
+  Revision 1.197.2.7  2004/04/26 21:02:34  peter
+    * 64bit fixes
+
+  Revision 1.197.2.6  2004/04/26 19:57:39  florian
+    * first part of single parameter fix
+
+  Revision 1.197.2.5  2004/04/26 15:54:33  peter
+    * small x86-64 fixes
+
+  Revision 1.197.2.4  2004/04/18 16:55:37  peter
+    * procedure entry and exit code restructured, some x86 specific
+      things are removed from the generic ncgutil code and moved to
+      the target depend cg.g_proc_entry and cg.g_proc_exit that now
+      contain all the code during startup including stackframe allocation
+      only the saving of registers is excluded from this code
+
+  Revision 1.197.2.3  2004/04/12 19:34:45  peter
+    * basic framework for dwarf CFI
+
+  Revision 1.197.2.2  2004/04/10 12:36:41  peter
+    * fixed alignment issues
+
+  Revision 1.197.2.1  2004/04/08 18:33:22  peter
+    * rewrite of TAsmSection
+
   Revision 1.197  2004/03/29 14:43:47  peter
     * cleaner temp get/unget for exceptions
 

compiler/ncnv.pas

@@ -603,7 +603,7 @@ implementation
     function ttypeconvnode.resulttype_string_to_chararray : tnode;
 
       var
-        arrsize: aword;
+        arrsize : aint;
 
       begin
          with tarraydef(resulttype.def) do
@@ -1331,7 +1331,7 @@ implementation
                      if assigned(htype.def) then
                        inserttypeconv_explicit(left,htype)
                      else
-                       CGMessage2(cg_e_illegal_type_conversion,left.resulttype.def.gettypename,resulttype.def.gettypename);
+                       CGMessage2(type_e_illegal_type_conversion,left.resulttype.def.gettypename,resulttype.def.gettypename);
                    end;
 
                  { check if the result could be in a register }
@@ -1380,7 +1380,7 @@ implementation
                              (left.nodetype=derefn)
                             )
                            ) then
-                       CGMessage2(cg_e_illegal_type_conversion,left.resulttype.def.gettypename,resulttype.def.gettypename);
+                       CGMessage2(type_e_illegal_type_conversion,left.resulttype.def.gettypename,resulttype.def.gettypename);
                    end;
                end
               else
@@ -1391,12 +1391,22 @@ implementation
             internalerror(200211231);
         end;
 
-        { Give hint for unportable code }
-        if ((left.resulttype.def.deftype=orddef) and
-            (resulttype.def.deftype in [pointerdef,procvardef,classrefdef])) or
-           ((resulttype.def.deftype=orddef) and
-            (left.resulttype.def.deftype in [pointerdef,procvardef,classrefdef])) then
-          CGMessage(cg_h_pointer_to_longint_conv_not_portable);
+        { Give hint or warning for unportable code, exceptions are
+           - typecasts from constants
+           - void }
+        if (left.nodetype<>ordconstn) and
+           not(is_void(left.resulttype.def)) and
+           (((left.resulttype.def.deftype=orddef) and
+             (resulttype.def.deftype in [pointerdef,procvardef,classrefdef])) or
+            ((resulttype.def.deftype=orddef) and
+             (left.resulttype.def.deftype in [pointerdef,procvardef,classrefdef]))) then
+          begin
+            { Give a warning when sizes don't match, because then info will be lost }
+            if left.resulttype.def.size=resulttype.def.size then
+              CGMessage(type_h_pointer_to_longint_conv_not_portable)
+            else
+              CGMessage(type_w_pointer_to_longint_conv_not_portable);
+          end;
 
         { Constant folding and other node transitions to
           remove the typeconv node }
@@ -1438,8 +1448,15 @@ implementation
               { ordinal contants can be directly converted }
               { but not char to char because it is a widechar to char or via versa }
               { which needs extra code to do the code page transistion             }
-              if is_ordinal(resulttype.def) and
-                 not(convtype=tc_char_2_char) then
+              { constant ordinal to pointer }
+              if (resulttype.def.deftype=pointerdef) then
+                begin
+                   hp:=cpointerconstnode.create(TConstPtrUInt(tordconstnode(left).value),resulttype);
+                   result:=hp;
+                   exit;
+                end
+              else if is_ordinal(resulttype.def) and
+                      not(convtype=tc_char_2_char) then
                 begin
                    { replace the resulttype and recheck the range }
                    left.resulttype:=resulttype;
@@ -1463,7 +1480,7 @@ implementation
               { constant pointer to ordinal }
               else if is_ordinal(resulttype.def) then
                 begin
-                   hp:=cordconstnode.create(tpointerconstnode(left).value,
+                   hp:=cordconstnode.create(TConstExprInt(tpointerconstnode(left).value),
                      resulttype,true);
                    result:=hp;
                    exit;
@@ -1630,7 +1647,7 @@ implementation
            exit;
          { when converting to 64bit, first convert to a 32bit int and then   }
          { convert to a 64bit int (only necessary for 32bit processors) (JM) }
-         if resulttype.def.size > sizeof(aword) then
+         if resulttype.def.size > sizeof(aint) then
            begin
              result := ctypeconvnode.create_explicit(left,u32inttype);
              result := ctypeconvnode.create(result,resulttype);
@@ -1687,7 +1704,7 @@ implementation
          if assigned(tunarynode(left).left) then
           begin
             if (left.expectloc<>LOC_CREFERENCE) then
-              CGMessage(cg_e_illegal_expression);
+              CGMessage(parser_e_illegal_expression);
             registersint:=left.registersint;
             expectloc:=left.expectloc
           end
@@ -2446,7 +2463,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.147  2004-05-23 18:28:41  peter
+  Revision 1.148  2004-06-16 20:07:08  florian
+    * dwarf branch merged
+
+  Revision 1.147  2004/05/23 18:28:41  peter
     * methodpointer is loaded into a temp when it was a calln
 
   Revision 1.146  2004/05/23 15:03:40  peter
@@ -2458,6 +2478,29 @@ end.
   Revision 1.144  2004/04/29 19:56:37  daniel
     * Prepare compiler infrastructure for multiple ansistring types
 
+  Revision 1.143.2.4  2004/05/30 10:45:50  peter
+    * merged fixes from main branch
+
+  Revision 1.146  2004/05/23 15:03:40  peter
+    * some typeconvs don't allow assignment or passing to var para
+
+  Revision 1.145  2004/05/23 14:14:18  florian
+    + added set of widechar support (limited to 256 chars, is delphi compatible)
+
+  Revision 1.144  2004/04/29 19:56:37  daniel
+    * Prepare compiler infrastructure for multiple ansistring types
+
+  Revision 1.143.2.3  2004/04/28 20:37:27  peter
+    * don't give ordinal->pointer warning when typecasting from
+      constant or void type
+
+  Revision 1.143.2.2  2004/04/28 19:55:51  peter
+    * new warning for ordinal-pointer when size is different
+    * fixed some cg_e_ messages to the correct section type_e_ or parser_e_
+
+  Revision 1.143.2.1  2004/04/27 18:18:26  peter
+    * aword -> aint
+
   Revision 1.143  2004/03/23 22:34:49  peter
     * constants ordinals now always have a type assigned
     * integer constants have the smallest type, unsigned prefered over
@@ -2782,4 +2825,4 @@ end.
   Revision 1.58  2002/05/18 13:34:09  peter
     * readded missing revisions
 
-}
+}

compiler/ncon.pas

@@ -88,7 +88,7 @@ interface
 
        tstringconstnode = class(tnode)
           value_str : pchar;
-          len     : aword;
+          len     : longint;
           lab_str : tasmlabel;
           st_type : tstringtype;
           constructor createstr(const s : string;st:tstringtype);virtual;
@@ -915,12 +915,27 @@ begin
 end.
 {
   $Log$
-  Revision 1.62  2004-05-24 20:39:41  florian
+  Revision 1.63  2004-06-16 20:07:08  florian
+    * dwarf branch merged
+
+  Revision 1.62  2004/05/24 20:39:41  florian
     * stricter handling of formal const parameters and IE fixed
 
   Revision 1.61  2004/04/29 19:56:37  daniel
     * Prepare compiler infrastructure for multiple ansistring types
 
+  Revision 1.60.2.2  2004/05/30 10:45:50  peter
+    * merged fixes from main branch
+
+  Revision 1.62  2004/05/24 20:39:41  florian
+    * stricter handling of formal const parameters and IE fixed
+
+  Revision 1.61  2004/04/29 19:56:37  daniel
+    * Prepare compiler infrastructure for multiple ansistring types
+
+  Revision 1.60.2.1  2004/04/27 18:18:26  peter
+    * aword -> aint
+
   Revision 1.60  2004/03/23 22:34:49  peter
     * constants ordinals now always have a type assigned
     * integer constants have the smallest type, unsigned prefered over
@@ -1087,4 +1102,4 @@ end.
   Revision 1.25  2002/03/04 19:10:11  peter
     * removed compiler warnings
 
-}
+}

compiler/nflw.pas

@@ -695,7 +695,7 @@ implementation
 
          if left.nodetype<>assignn then
            begin
-              CGMessage(cg_e_illegal_expression);
+              CGMessage(parser_e_illegal_expression);
               exit;
            end;
 
@@ -764,7 +764,7 @@ implementation
               CGMessagePos(hp.fileinfo,type_e_ordinal_expr_expected);
           end
          else
-           CGMessagePos(hp.fileinfo,cg_e_illegal_count_var);
+           CGMessagePos(hp.fileinfo,type_e_illegal_count_var);
 
          resulttypepass(right);
          set_varstate(right,vs_used,true);
@@ -1471,9 +1471,16 @@ begin
 end.
 {
   $Log$
-  Revision 1.96  2004-05-23 15:04:13  peter
+  Revision 1.97  2004-06-16 20:07:08  florian
+    * dwarf branch merged
+
+  Revision 1.96  2004/05/23 15:04:13  peter
     * remvoe writeln
 
+  Revision 1.95.2.1  2004/04/28 19:55:51  peter
+    * new warning for ordinal-pointer when size is different
+    * fixed some cg_e_ messages to the correct section type_e_ or parser_e_
+
   Revision 1.95  2004/03/18 16:19:03  peter
     * fixed operator overload allowing for pointer-string
     * replaced some type_e_mismatch with more informational messages
@@ -1751,4 +1758,4 @@ end.
   + generic constructor calls
   + start of tassembler / tmodulebase class cleanup
 
-}
+}

compiler/ninl.pas

@@ -160,7 +160,7 @@ implementation
           begin
             { the parser will give this message already because we }
             { return an errornode (JM)                             }
-            { CGMessagePos(fileinfo,cg_e_illegal_expression);      }
+            { CGMessagePos(fileinfo,parser_e_illegal_expression);      }
             exit;
           end;
 
@@ -241,15 +241,20 @@ implementation
           procname := procname + 'float'
         else
           case torddef(source.resulttype.def).typ of
+{$ifdef cpu64bit}
+            u64bit:
+              procname := procname + 'uint';
+{$else}
             u32bit:
-              procname := procname + 'longword';
+              procname := procname + 'uint';
             u64bit:
               procname := procname + 'qword';
             scurrency,
             s64bit:
               procname := procname + 'int64';
+{$endif}
             else
-              procname := procname + 'longint';
+              procname := procname + 'sint';
           end;
 
         { free the errornode we generated in the beginning }
@@ -284,6 +289,12 @@ implementation
     function tinlinenode.handle_read_write: tnode;
 
       const
+{$ifdef cpu64bit}
+        hasownreadfunc = [uchar,uwidechar,bool8bit,bool16bit,bool32bit];
+{$else cpu64bit}
+        hasownreadfunc = [uchar,uwidechar,bool8bit,bool16bit,bool32bit,s64bit,u64bit];
+{$endif cpu64bit}
+
         procnames: array[boolean,boolean] of string[11] =
           (('write_text_','read_text_'),('typed_write','typed_read'));
 
@@ -598,18 +609,30 @@ implementation
                     begin
                       is_ordinal := true;
                       case torddef(para.left.resulttype.def).typ of
-                        s8bit,s16bit,s32bit :
+{$ifdef cpu64bit}
+                        s64bit,
+{$endif cpu64bit}
+                        s8bit,
+                        s16bit,
+                        s32bit :
                           name := procprefix+'sint';
-                        u8bit,u16bit,u32bit :
+{$ifdef cpu64bit}
+                        u64bit,
+{$endif cpu64bit}
+                        u8bit,
+                        u16bit,
+                        u32bit :
                           name := procprefix+'uint';
                         uchar :
                           name := procprefix+'char';
                         uwidechar :
                           name := procprefix+'widechar';
+{$ifndef cpu64bit}
                         s64bit :
                           name := procprefix+'int64';
                         u64bit :
                           name := procprefix+'qword';
+{$endif cpu64bit}
                         bool8bit,
                         bool16bit,
                         bool32bit :
@@ -694,7 +717,7 @@ implementation
                           begin
                             if not assigned(lenpara) then
                               lenpara := ccallparanode.create(
-                                cordconstnode.create(0,s32inttype,false),nil)
+                                cordconstnode.create(0,sinttype,false),nil)
                             else
                               { make sure we don't pass the successive }
                               { parameters too. We also already have a }
@@ -706,24 +729,25 @@ implementation
                           begin
                             if not assigned(lenpara) then
                               lenpara := ccallparanode.create(
-                                cordconstnode.create(-32767,s32inttype,false),nil);
+                                cordconstnode.create(-32767,sinttype,false),nil);
                             { also create a default fracpara if necessary }
                             if not assigned(fracpara) then
                               fracpara := ccallparanode.create(
-                                cordconstnode.create(-1,s32inttype,false),nil);
+                                cordconstnode.create(-1,sinttype,false),nil);
                             { add it to the lenpara }
                             lenpara.right := fracpara;
                             { and add the realtype para (this also removes the link }
                             { to any parameters coming after it)                    }
                             fracpara.right := ccallparanode.create(
                                 cordconstnode.create(ord(tfloatdef(para.left.resulttype.def).typ),
-                                s32inttype,true),nil);
+                                sinttype,true),nil);
                           end;
                       end;
 
                     if do_read and
                       ((is_ordinal and
-                        (torddef(para.left.resulttype.def).typ in [s8bit,s16bit,u8bit,u16bit])
+                        not(torddef(para.left.resulttype.def).typ in hasownreadfunc) and
+                        (para.left.resulttype.def.size<>sinttype.def.size)
                        ) or
                        (is_real and
                         not equal_defs(para.left.resulttype.def,pbestrealtype^.def)
@@ -738,9 +762,9 @@ implementation
                         if is_real then
                           restype := pbestrealtype
                         else if is_signed(para.left.resulttype.def) then
-                          restype := @s32inttype
+                          restype := @sinttype
                         else
-                          restype := @u32inttype;
+                          restype := @uinttype;
 
                         { create the parameter list: the temp ... }
                         temp := ctempcreatenode.create(restype^,restype^.def.size,tt_persistent);
@@ -877,8 +901,12 @@ implementation
 
         { check if codepara is valid }
         if assigned(codepara) and
-           ((codepara.resulttype.def.deftype <> orddef) or
-            is_64bitint(codepara.resulttype.def)) then
+           (
+            (codepara.resulttype.def.deftype <> orddef)
+{$ifndef cpu64bit}
+            or is_64bitint(codepara.resulttype.def)
+{$endif cpu64bit}
+            ) then
           begin
             CGMessagePos1(codepara.fileinfo,type_e_integer_expr_expected,codepara.resulttype.def.typename);
             exit;
@@ -904,9 +932,9 @@ implementation
         { code is not a 32bit parameter (we already checked whether the }
         { the code para, if specified, was an orddef)                   }
         if not assigned(codepara) or
-           (torddef(codepara.resulttype.def).typ in [u8bit,u16bit,s8bit,s16bit]) then
+           (codepara.resulttype.def.size<>sinttype.def.size) then
           begin
-            tempcode := ctempcreatenode.create(s32inttype,4,tt_persistent);
+            tempcode := ctempcreatenode.create(sinttype,sinttype.def.size,tt_persistent);
             addstatement(newstatement,tempcode);
             { set the resulttype of the temp (needed to be able to get }
             { the resulttype of the tempref used in the new code para) }
@@ -923,13 +951,13 @@ implementation
             { we need its resulttype later on }
             codepara.get_paratype;
           end
-        else if (torddef(codepara.resulttype.def).typ = u32bit) then
+        else if (torddef(codepara.resulttype.def).typ = torddef(sinttype.def).typ) then
           { because code is a var parameter, it must match types exactly    }
           { however, since it will return values in [0..255], both longints }
           { and cardinals are fine. Since the formal code para type is      }
           { longint, insert a typecoversion to longint for cardinal para's  }
           begin
-            codepara.left := ctypeconvnode.create_explicit(codepara.left,s32inttype);
+            codepara.left := ctypeconvnode.create_explicit(codepara.left,sinttype);
             { make it explicit, oterwise you may get a nonsense range }
             { check error if the cardinal already contained a value   }
             { > $7fffffff                                             }
@@ -943,18 +971,31 @@ implementation
           orddef:
             begin
               case torddef(destpara.resulttype.def).typ of
-                s8bit,s16bit,s32bit:
+{$ifdef cpu64bit}
+                scurrency,
+                s64bit,
+{$endif cpu64bit}
+                s8bit,
+                s16bit,
+                s32bit:
                   begin
                     suffix := 'sint_';
                     { we also need a destsize para in this case }
                     sizepara := ccallparanode.create(cordconstnode.create
                       (destpara.resulttype.def.size,s32inttype,true),nil);
                   end;
-                u8bit,u16bit,u32bit:
+{$ifdef cpu64bit}
+                u64bit,
+{$endif cpu64bit}
+                u8bit,
+                u16bit,
+                u32bit:
                    suffix := 'uint_';
+{$ifndef cpu64bit}
                 scurrency,
                 s64bit: suffix := 'int64_';
                 u64bit: suffix := 'qword_';
+{$endif cpu64bit}
                 else
                   internalerror(200304225);
               end;
@@ -1194,7 +1235,7 @@ implementation
                      vl2:=tordconstnode(tcallparanode(tcallparanode(left).right).left).value;
                    end;
                  else
-                   CGMessage(cg_e_illegal_expression);
+                   CGMessage(parser_e_illegal_expression);
                end;
                case inlinenumber of
                  in_const_trunc :
@@ -1402,16 +1443,16 @@ implementation
                      if assigned(hightree) then
                       begin
                         hp:=caddnode.create(addn,hightree,
-                                         cordconstnode.create(1,s32inttype,false));
+                                         cordconstnode.create(1,sinttype,false));
                         if (left.resulttype.def.deftype=arraydef) and
                            (tarraydef(left.resulttype.def).elesize<>1) then
                           hp:=caddnode.create(muln,hp,cordconstnode.create(tarraydef(
-                            left.resulttype.def).elesize,s32inttype,true));
+                            left.resulttype.def).elesize,sinttype,true));
                         result:=hp;
                       end;
                    end
                   else
-                   resulttype:=s32inttype;
+                   resulttype:=sinttype;
                 end;
 
               in_typeof_x:
@@ -1425,7 +1466,7 @@ implementation
                    if (left.nodetype=ordconstn) then
                     begin
                       hp:=cordconstnode.create(
-                         tordconstnode(left).value,s32inttype,true);
+                         tordconstnode(left).value,sinttype,true);
                       result:=hp;
                       goto myexit;
                     end;
@@ -1592,7 +1633,7 @@ implementation
                   if is_shortstring(left.resulttype.def) then
                    resulttype:=u8inttype
                   else
-                   resulttype:=s32inttype;
+                   resulttype:=sinttype;
                 end;
 
               in_typeinfo_x:
@@ -1697,7 +1738,7 @@ implementation
                              set_varstate(tcallparanode(tcallparanode(left).right).left,vs_used,true);
                              inserttypeconv_explicit(tcallparanode(tcallparanode(left).right).left,tcallparanode(left).left.resulttype);
                              if assigned(tcallparanode(tcallparanode(left).right).right) then
-                               CGMessage(cg_e_illegal_expression);
+                               CGMessage(parser_e_illegal_expression);
                            end;
                         end
                        else
@@ -2126,7 +2167,7 @@ implementation
                        hpp := tcallparanode(tcallparanode(left).right).left;
                        tcallparanode(tcallparanode(left).right).left := nil;
                        if assigned(tcallparanode(tcallparanode(left).right).right) then
-                         CGMessage(cg_e_illegal_expression);
+                         CGMessage(parser_e_illegal_expression);
                      end
                    else
                      { no, create constant 1 }
@@ -2359,13 +2400,44 @@ begin
 end.
 {
   $Log$
-  Revision 1.135  2004-05-28 21:15:20  peter
+  Revision 1.136  2004-06-16 20:07:08  florian
+    * dwarf branch merged
+
+  Revision 1.135  2004/05/28 21:15:20  peter
     * inc(x,y) makes y always of type x to prevent 64bit operations
       when x is a u32bit and y is signed
 
   Revision 1.134  2004/05/23 18:28:41  peter
     * methodpointer is loaded into a temp when it was a calln
 
+  Revision 1.133.2.9  2004/05/03 16:49:00  peter
+    * sizeof fixed
+
+  Revision 1.133.2.8  2004/05/02 11:26:05  peter
+    * fixed i386 readln(qword)
+
+  Revision 1.133.2.7  2004/05/01 21:30:17  peter
+    * fixed read for int64/qword
+
+  Revision 1.133.2.6  2004/05/01 20:51:19  peter
+    * fix val code parameter
+
+  Revision 1.133.2.5  2004/05/01 16:35:51  florian
+    * fixed length(<ansi/widestring>) for 64 Bit CPUs
+
+  Revision 1.133.2.4  2004/04/29 19:50:36  peter
+    * fixed val for 64bit
+
+  Revision 1.133.2.3  2004/04/29 19:07:22  peter
+    * compile fixes
+
+  Revision 1.133.2.2  2004/04/28 19:55:51  peter
+    * new warning for ordinal-pointer when size is different
+    * fixed some cg_e_ messages to the correct section type_e_ or parser_e_
+
+  Revision 1.133.2.1  2004/04/26 21:05:09  peter
+    * size of classes is now stored as aint
+
   Revision 1.133  2004/03/18 16:19:03  peter
     * fixed operator overload allowing for pointer-string
     * replaced some type_e_mismatch with more informational messages
@@ -2660,4 +2732,4 @@ end.
   Revision 1.68  2002/01/19 11:53:56  peter
     * constant evaluation for assinged added
 
-}
+}

compiler/nld.pas

@@ -1018,7 +1018,7 @@ implementation
         resulttype:=restype;
         { check if it's valid }
         if restype.def.deftype = errordef then
-          CGMessage(cg_e_illegal_expression);
+          CGMessage(parser_e_illegal_expression);
       end;
 
 
@@ -1137,9 +1137,16 @@ begin
 end.
 {
   $Log$
-  Revision 1.126  2004-04-29 19:56:37  daniel
+  Revision 1.127  2004-06-16 20:07:08  florian
+    * dwarf branch merged
+
+  Revision 1.126  2004/04/29 19:56:37  daniel
     * Prepare compiler infrastructure for multiple ansistring types
 
+  Revision 1.125.2.1  2004/04/28 19:55:51  peter
+    * new warning for ordinal-pointer when size is different
+    * fixed some cg_e_ messages to the correct section type_e_ or parser_e_
+
   Revision 1.125  2004/03/02 17:32:12  florian
     * make cycle fixed
     + pic support for darwin
@@ -1542,4 +1549,4 @@ end.
       one or more statements
     * moved finalize and setlength from ninl to pinline
 
-}
+}

compiler/nmat.pas

@@ -459,18 +459,12 @@ implementation
               exit;
            end;
 
-         { expand to cpu wordsize, but don't change sign. For
-           32bit ignore 64bit since that has it's own code }
-{$ifndef cpu64bit}
-         if not is_64bit(left.resulttype.def) then
-{$endif}
-           begin
-             { constants generate signed integers }
-             if is_signed(left.resulttype.def) then
-               inserttypeconv(left,sinttype)
-             else
-               inserttypeconv(left,uinttype);
-           end;
+         { calculations for ordinals < 32 bit have to be done in
+           32 bit for backwards compatibility. That way 'shl 33' is
+           the same as 'shl 1'. It's ugly but compatible with delphi/tp/gcc }
+         if (not is_64bit(left.resulttype.def)) and
+            (torddef(left.resulttype.def).typ<>u32bit) then
+           inserttypeconv(left,s32inttype);
 
          inserttypeconv(right,sinttype);
 
@@ -861,13 +855,19 @@ begin
 end.
 {
   $Log$
-  Revision 1.63  2004-05-28 21:14:34  peter
+  Revision 1.64  2004-06-16 20:07:09  florian
+    * dwarf branch merged
+
+  Revision 1.63  2004/05/28 21:14:34  peter
     * fixed div qword
 
   Revision 1.62  2004/05/19 23:29:25  peter
     * don't change sign for unsigned shl/shr operations
     * cleanup for u32bit
 
+  Revision 1.61.2.1  2004/05/03 16:27:38  peter
+    * fixed shl for x86-64
+
   Revision 1.61  2004/03/29 14:44:10  peter
     * fixes to previous constant integer commit
 
@@ -1021,4 +1021,4 @@ end.
   Revision 1.28  2002/02/11 11:45:51  michael
   * Compilation without mmx support fixed from Peter
 
-}
+}

compiler/nmem.pas

@@ -333,7 +333,7 @@ implementation
                begin
                  { a load of a procvar can't have parameters }
                  if assigned(tcallnode(left).left) then
-                   CGMessage(cg_e_illegal_expression);
+                   CGMessage(parser_e_illegal_expression);
                  { is it a procvar? }
                  hp:=tcallnode(left).right;
                  if assigned(hp) then
@@ -367,7 +367,7 @@ implementation
          { if it were a valid construct, the addr node would already have }
          { been removed in the parser. This happens for (in FPC mode)     }
          { procvar1 := @procvar2(parameters);                             }
-         CGMessage(cg_e_illegal_expression)
+         CGMessage(parser_e_illegal_expression)
         else
          if (left.nodetype=loadn) and (tloadnode(left).symtableentry.typ=procsym) then
           begin
@@ -482,7 +482,7 @@ implementation
          if not(left.expectloc in [LOC_CREFERENCE,LOC_REFERENCE]) then
            begin
              aktfilepos:=left.fileinfo;
-             CGMessage(cg_e_illegal_expression);
+             CGMessage(parser_e_illegal_expression);
            end;
 
          registersint:=left.registersint;
@@ -522,7 +522,7 @@ implementation
          if left.resulttype.def.deftype=pointerdef then
           resulttype:=tpointerdef(left.resulttype.def).pointertype
          else
-          CGMessage(cg_e_invalid_qualifier);
+          CGMessage(parser_e_invalid_qualifier);
       end;
 
     procedure Tderefnode.mark_write;
@@ -638,7 +638,7 @@ implementation
            begin
               if (left.expectloc<>LOC_CREFERENCE) and
                  (left.expectloc<>LOC_REFERENCE) then
-                CGMessage(cg_e_illegal_expression);
+                CGMessage(parser_e_illegal_expression);
               expectloc:=left.expectloc;
            end;
       end;
@@ -981,9 +981,16 @@ begin
 end.
 {
   $Log$
-  Revision 1.83  2004-04-29 19:56:37  daniel
+  Revision 1.84  2004-06-16 20:07:09  florian
+    * dwarf branch merged
+
+  Revision 1.83  2004/04/29 19:56:37  daniel
     * Prepare compiler infrastructure for multiple ansistring types
 
+  Revision 1.82.2.1  2004/04/28 19:55:51  peter
+    * new warning for ordinal-pointer when size is different
+    * fixed some cg_e_ messages to the correct section type_e_ or parser_e_
+
   Revision 1.82  2004/03/29 14:42:52  peter
     * variant array support
 
@@ -1251,4 +1258,4 @@ end.
         constructs with either too many or too little parameters)
     (both merged, includes second typo fix of pexpr.pas)
 
-}
+}

compiler/nobj.pas

@@ -110,7 +110,7 @@ interface
         { adjusts the self value with ioffset when casting a interface
           to a class
         }
-        procedure adjustselfvalue(procdef: tprocdef;ioffset: aword);virtual;
+        procedure adjustselfvalue(procdef: tprocdef;ioffset: aint);virtual;
         { generates the wrapper for a call to a method via an interface }
         procedure cgintfwrapper(asmlist: TAAsmoutput; procdef: tprocdef; const labelname: string; ioffset: longint);virtual;abstract;
       public
@@ -147,7 +147,7 @@ implementation
 {$else}
        strings,
 {$endif}
-       globals,verbose,
+       globals,verbose,systems,
        symtable,symconst,symtype,symsym,defcmp,paramgr,
 {$ifdef GDB}
        gdb,
@@ -285,7 +285,7 @@ implementation
          objectlibrary.getdatalabel(p^.nl);
          if assigned(p^.l) then
            writenames(p^.l);
-         datasegment.concat(tai_align.create(const_align(POINTER_SIZE)));
+         datasegment.concat(tai_align.create(const_align(sizeof(aint))));
          dataSegment.concat(Tai_label.Create(p^.nl));
          len:=strlen(p^.data.messageinf.str);
          datasegment.concat(tai_const.create_8bit(len));
@@ -303,8 +303,8 @@ implementation
            writestrentry(p^.l);
 
          { write name label }
-         dataSegment.concat(Tai_const_symbol.Create(p^.nl));
-         dataSegment.concat(Tai_const_symbol.Createname(p^.data.mangledname,AT_FUNCTION,0));
+         dataSegment.concat(Tai_const.Create_sym(p^.nl));
+         dataSegment.concat(Tai_const.Createname(p^.data.mangledname,AT_FUNCTION,0));
 
          if assigned(p^.r) then
            writestrentry(p^.r);
@@ -326,7 +326,7 @@ implementation
 
          { now start writing of the message string table }
          objectlibrary.getdatalabel(r);
-         datasegment.concat(tai_align.create(const_align(POINTER_SIZE)));
+         datasegment.concat(tai_align.create(const_align(sizeof(aint))));
          dataSegment.concat(Tai_label.Create(r));
          genstrmsgtab:=r;
          dataSegment.concat(Tai_const.Create_32bit(count));
@@ -345,7 +345,7 @@ implementation
 
          { write name label }
          dataSegment.concat(Tai_const.Create_32bit(p^.data.messageinf.i));
-         dataSegment.concat(Tai_const_symbol.Createname(p^.data.mangledname,AT_FUNCTION,0));
+         dataSegment.concat(Tai_const.Createname(p^.data.mangledname,AT_FUNCTION,0));
 
          if assigned(p^.r) then
            writeintentry(p^.r);
@@ -363,7 +363,7 @@ implementation
 
          { now start writing of the message string table }
          objectlibrary.getdatalabel(r);
-         datasegment.concat(tai_align.create(const_align(POINTER_SIZE)));
+         datasegment.concat(tai_align.create(const_align(sizeof(aint))));
          dataSegment.concat(Tai_label.Create(r));
          genintmsgtab:=r;
          dataSegment.concat(Tai_const.Create_32bit(count));
@@ -441,7 +441,7 @@ implementation
            begin
               objectlibrary.getdatalabel(r);
               gendmt:=r;
-              datasegment.concat(tai_align.create(const_align(POINTER_SIZE)));
+              datasegment.concat(tai_align.create(const_align(sizeof(aint))));
               dataSegment.concat(Tai_label.Create(r));
               { entries for caching }
               dataSegment.concat(Tai_const.Create_ptr(0));
@@ -484,13 +484,13 @@ implementation
               hp:=tprocsym(p).first_procdef;
               objectlibrary.getdatalabel(l);
 
-              consts.concat(tai_align.create(const_align(POINTER_SIZE)));
+              consts.concat(tai_align.create(const_align(sizeof(aint))));
               Consts.concat(Tai_label.Create(l));
               Consts.concat(Tai_const.Create_8bit(length(p.name)));
               Consts.concat(Tai_string.Create(p.name));
 
-              dataSegment.concat(Tai_const_symbol.Create(l));
-              dataSegment.concat(Tai_const_symbol.Createname(hp.mangledname,AT_FUNCTION,0));
+              dataSegment.concat(Tai_const.Create_sym(l));
+              dataSegment.concat(Tai_const.Createname(hp.mangledname,AT_FUNCTION,0));
            end;
       end;
 
@@ -505,7 +505,7 @@ implementation
          if count>0 then
            begin
               objectlibrary.getdatalabel(l);
-              datasegment.concat(tai_align.create(const_align(POINTER_SIZE)));
+              datasegment.concat(tai_align.create(const_align(sizeof(aint))));
               dataSegment.concat(Tai_label.Create(l));
               dataSegment.concat(Tai_const.Create_32bit(count));
               _class.symtable.foreach({$ifdef FPCPROCVAR}@{$endif}genpubmethodtableentry,nil);
@@ -853,8 +853,8 @@ implementation
       begin
         implintf:=_class.implementedinterfaces;
         curintf:=implintf.interfaces(intfindex);
-        rawdata.concat(tai_align.create(const_align(POINTER_SIZE)));
-        if (cs_create_smart in aktmoduleswitches) then
+        rawdata.concat(tai_align.create(const_align(sizeof(aint))));
+        if maybe_smartlink_symbol then
          rawdata.concat(Tai_symbol.Createname_global(gintfgetvtbllabelname(intfindex),AT_DATA ,0))
         else
          rawdata.concat(Tai_symbol.Createname(gintfgetvtbllabelname(intfindex),AT_DATA,0));
@@ -867,7 +867,7 @@ implementation
             { create wrapper code }
             cgintfwrapper(rawcode,implintf.implprocs(intfindex,i),tmps,implintf.ioffsets(intfindex)^);
             { create reference }
-            rawdata.concat(Tai_const_symbol.Createname(tmps,AT_FUNCTION,0));
+            rawdata.concat(Tai_const.Createname(tmps,AT_FUNCTION,0));
           end;
       end;
 
@@ -886,34 +886,34 @@ implementation
           begin
             { label for GUID }
             objectlibrary.getdatalabel(tmplabel);
-            rawdata.concat(tai_align.create(const_align(pointer_size)));
+            rawdata.concat(tai_align.create(const_align(sizeof(aint))));
             rawdata.concat(Tai_label.Create(tmplabel));
             rawdata.concat(Tai_const.Create_32bit(longint(curintf.iidguid^.D1)));
             rawdata.concat(Tai_const.Create_16bit(curintf.iidguid^.D2));
             rawdata.concat(Tai_const.Create_16bit(curintf.iidguid^.D3));
             for i:=Low(curintf.iidguid^.D4) to High(curintf.iidguid^.D4) do
               rawdata.concat(Tai_const.Create_8bit(curintf.iidguid^.D4[i]));
-            dataSegment.concat(Tai_const_symbol.Create(tmplabel));
+            dataSegment.concat(Tai_const.Create_sym(tmplabel));
           end
         else
           begin
             { nil for Corba interfaces }
-            dataSegment.concat(Tai_const.Create_ptr(0)); { nil }
+            dataSegment.concat(Tai_const.Create_sym(nil));
           end;
         { VTable }
-        dataSegment.concat(Tai_const_symbol.Createname(gintfgetvtbllabelname(contintfindex),AT_DATA,0));
+        dataSegment.concat(Tai_const.Createname(gintfgetvtbllabelname(contintfindex),AT_DATA,0));
         { IOffset field }
         dataSegment.concat(Tai_const.Create_32bit(implintf.ioffsets(contintfindex)^));
         { IIDStr }
         objectlibrary.getdatalabel(tmplabel);
-        rawdata.concat(tai_align.create(const_align(pointer_size)));
+        rawdata.concat(tai_align.create(const_align(sizeof(aint))));
         rawdata.concat(Tai_label.Create(tmplabel));
         rawdata.concat(Tai_const.Create_8bit(length(curintf.iidstr^)));
         if curintf.objecttype=odt_interfacecom then
           rawdata.concat(Tai_string.Create(upper(curintf.iidstr^)))
         else
           rawdata.concat(Tai_string.Create(curintf.iidstr^));
-        dataSegment.concat(Tai_const_symbol.Create(tmplabel));
+        dataSegment.concat(Tai_const.Create_sym(tmplabel));
       end;
 
 
@@ -1020,9 +1020,9 @@ implementation
                 { allocate a pointer in the object memory }
                 with tobjectsymtable(_class.symtable) do
                   begin
-                    datasize:=align(datasize,min(POINTER_SIZE,fieldalignment));
+                    datasize:=align(datasize,min(sizeof(aint),fieldalignment));
                     _class.implementedinterfaces.ioffsets(i)^:=datasize;
-                    inc(datasize,POINTER_SIZE);
+                    inc(datasize,sizeof(aint));
                   end;
                 { write vtbl }
                 gintfcreatevtbl(i,rawdata,rawcode);
@@ -1139,7 +1139,7 @@ implementation
         { 2. step calc required fieldcount and their offsets in the object memory map
              and write data }
         objectlibrary.getdatalabel(intftable);
-        dataSegment.concat(tai_align.create(const_align(POINTER_SIZE)));
+        dataSegment.concat(tai_align.create(const_align(sizeof(aint))));
         dataSegment.concat(Tai_label.Create(intftable));
         gintfwritedata;
         _class.implementedinterfaces.clearimplprocs; { release temporary information }
@@ -1150,22 +1150,25 @@ implementation
   { Write interface identifiers to the data section }
   procedure tclassheader.writeinterfaceids;
     var
-      i: longint;
+      i : longint;
+      s : string;
     begin
       if assigned(_class.iidguid) then
         begin
-          if (cs_create_smart in aktmoduleswitches) then
-            dataSegment.concat(Tai_cut.Create);
-          dataSegment.concat(Tai_symbol.Createname_global(make_mangledname('IID',_class.owner,_class.objname^),AT_DATA,0));
-          dataSegment.concat(Tai_const.Create_32bit(_class.iidguid^.D1));
+          s:=make_mangledname('IID',_class.owner,_class.objname^);
+          maybe_new_object_file(dataSegment);
+          new_section(dataSegment,sec_rodata,s,const_align(sizeof(aint)));
+          dataSegment.concat(Tai_symbol.Createname_global(s,AT_DATA,0));
+          dataSegment.concat(Tai_const.Create_32bit(longint(_class.iidguid^.D1)));
           dataSegment.concat(Tai_const.Create_16bit(_class.iidguid^.D2));
           dataSegment.concat(Tai_const.Create_16bit(_class.iidguid^.D3));
           for i:=Low(_class.iidguid^.D4) to High(_class.iidguid^.D4) do
             dataSegment.concat(Tai_const.Create_8bit(_class.iidguid^.D4[i]));
         end;
-      if (cs_create_smart in aktmoduleswitches) then
-        dataSegment.concat(Tai_cut.Create);
-      dataSegment.concat(Tai_symbol.Createname_global(make_mangledname('IIDSTR',_class.owner,_class.objname^),AT_DATA,0));
+      maybe_new_object_file(dataSegment);
+      s:=make_mangledname('IIDSTR',_class.owner,_class.objname^);
+      new_section(dataSegment,sec_rodata,s,0);
+      dataSegment.concat(Tai_symbol.Createname_global(s,AT_DATA,0));
       dataSegment.concat(Tai_const.Create_8bit(length(_class.iidstr^)));
       dataSegment.concat(Tai_string.Create(_class.iidstr^));
     end;
@@ -1201,9 +1204,9 @@ implementation
                                   { class abstract and it's not allow to      }
                                   { generates an instance                     }
                                   if (po_abstractmethod in procdefcoll^.data.procoptions) then
-                                    List.concat(Tai_const_symbol.Createname('FPC_ABSTRACTERROR',AT_FUNCTION,0))
+                                    List.concat(Tai_const.Createname('FPC_ABSTRACTERROR',AT_FUNCTION,0))
                                   else
-                                    List.concat(Tai_const_symbol.createname(procdefcoll^.data.mangledname,AT_FUNCTION,0));
+                                    List.concat(Tai_const.createname(procdefcoll^.data.mangledname,AT_FUNCTION,0));
                                end;
                           end;
                         procdefcoll:=procdefcoll^.next;
@@ -1229,26 +1232,21 @@ implementation
          dmtlabel:=gendmt;
 {$endif WITHDMT}
 
-         if (cs_create_smart in aktmoduleswitches) then
-           dataSegment.concat(Tai_cut.Create);
-
          { write tables for classes, this must be done before the actual
            class is written, because we need the labels defined }
          if is_class(_class) then
           begin
+            objectlibrary.getdatalabel(classnamelabel);
+            maybe_new_object_file(dataSegment);
+            new_section(dataSegment,sec_rodata,classnamelabel.name,const_align(sizeof(aint)));
+
             { interface table }
             if _class.implementedinterfaces.count>0 then
-             begin
-               if (cs_create_smart in aktmoduleswitches) then
-                codeSegment.concat(Tai_cut.Create);
-               interfacetable:=genintftable;
-             end;
+              interfacetable:=genintftable;
 
             methodnametable:=genpublishedmethodstable;
             fieldtablelabel:=_class.generate_field_table;
             { write class name }
-            objectlibrary.getdatalabel(classnamelabel);
-            dataSegment.concat(tai_align.create(const_align(POINTER_SIZE)));
             dataSegment.concat(Tai_label.Create(classnamelabel));
             dataSegment.concat(Tai_const.Create_8bit(length(_class.objrealname^)));
             dataSegment.concat(Tai_string.Create(_class.objrealname^));
@@ -1261,6 +1259,8 @@ implementation
           end;
 
         { write debug info }
+        maybe_new_object_file(dataSegment);
+        new_section(dataSegment,sec_rodata,_class.vmt_mangledname,const_align(sizeof(aint)));
 {$ifdef GDB}
         if (cs_debuginfo in aktmoduleswitches) then
          begin
@@ -1270,13 +1270,12 @@ implementation
                tstoreddef(vmttype.def).numberstring+'",'+tostr(N_STSYM)+',0,0,'+_class.vmt_mangledname)));
          end;
 {$endif GDB}
-         dataSegment.concat(tai_align.create(const_align(POINTER_SIZE)));
          dataSegment.concat(Tai_symbol.Createname_global(_class.vmt_mangledname,AT_DATA,0));
 
          { determine the size with symtable.datasize, because }
          { size gives back 4 for classes                    }
-         dataSegment.concat(Tai_const.Create_32bit(tobjectsymtable(_class.symtable).datasize));
-         dataSegment.concat(Tai_const.Create_32bit(Cardinal(-tobjectsymtable(_class.symtable).datasize)));
+         dataSegment.concat(Tai_const.Create(ait_const_ptr,tobjectsymtable(_class.symtable).datasize));
+         dataSegment.concat(Tai_const.Create(ait_const_ptr,-int64(tobjectsymtable(_class.symtable).datasize)));
 {$ifdef WITHDMT}
          if _class.classtype=ct_object then
            begin
@@ -1292,49 +1291,46 @@ implementation
          { it is not written for parents that don't have any vmt !! }
          if assigned(_class.childof) and
             (oo_has_vmt in _class.childof.objectoptions) then
-           dataSegment.concat(Tai_const_symbol.Createname(_class.childof.vmt_mangledname,AT_DATA,0))
+           dataSegment.concat(Tai_const.Createname(_class.childof.vmt_mangledname,AT_DATA,0))
          else
-           dataSegment.concat(Tai_const.Create_ptr(0));
+           dataSegment.concat(Tai_const.Create_sym(nil));
 
          { write extended info for classes, for the order see rtl/inc/objpash.inc }
          if is_class(_class) then
           begin
             { pointer to class name string }
-            dataSegment.concat(Tai_const_symbol.Create(classnamelabel));
-            { pointer to dynamic table }
+            dataSegment.concat(Tai_const.Create_sym(classnamelabel));
+            { pointer to dynamic table or nil }
             if (oo_has_msgint in _class.objectoptions) then
-              dataSegment.concat(Tai_const_symbol.Create(intmessagetable))
-            else
-              dataSegment.concat(Tai_const.Create_ptr(0));
-            { pointer to method table }
-            if assigned(methodnametable) then
-              dataSegment.concat(Tai_const_symbol.Create(methodnametable))
+              dataSegment.concat(Tai_const.Create_sym(intmessagetable))
             else
-              dataSegment.concat(Tai_const.Create_ptr(0));
+              dataSegment.concat(Tai_const.Create_sym(nil));
+            { pointer to method table or nil }
+            dataSegment.concat(Tai_const.Create_sym(methodnametable));
             { pointer to field table }
-            dataSegment.concat(Tai_const_symbol.Create(fieldtablelabel));
+            dataSegment.concat(Tai_const.Create_sym(fieldtablelabel));
             { pointer to type info of published section }
             if (oo_can_have_published in _class.objectoptions) then
-              dataSegment.concat(Tai_const_symbol.Create(_class.get_rtti_label(fullrtti)))
+              dataSegment.concat(Tai_const.Create_sym(_class.get_rtti_label(fullrtti)))
             else
-              dataSegment.concat(Tai_const.Create_ptr(0));
+              dataSegment.concat(Tai_const.Create_sym(nil));
             { inittable for con-/destruction }
             if _class.members_need_inittable then
-              dataSegment.concat(Tai_const_symbol.Create(_class.get_rtti_label(initrtti)))
+              dataSegment.concat(Tai_const.Create_sym(_class.get_rtti_label(initrtti)))
             else
-              dataSegment.concat(Tai_const.Create_ptr(0));
+              dataSegment.concat(Tai_const.Create_sym(nil));
             { auto table }
-            dataSegment.concat(Tai_const.Create_ptr(0));
+            dataSegment.concat(Tai_const.Create_sym(nil));
             { interface table }
             if _class.implementedinterfaces.count>0 then
-              dataSegment.concat(Tai_const_symbol.Create(interfacetable))
+              dataSegment.concat(Tai_const.Create_sym(interfacetable))
             else
-              dataSegment.concat(Tai_const.Create_ptr(0));
+              dataSegment.concat(Tai_const.Create_sym(nil));
             { table for string messages }
             if (oo_has_msgstr in _class.objectoptions) then
-              dataSegment.concat(Tai_const_symbol.Create(strmessagetable))
+              dataSegment.concat(Tai_const.Create_sym(strmessagetable))
             else
-              dataSegment.concat(Tai_const.Create_ptr(0));
+              dataSegment.concat(Tai_const.Create_sym(nil));
           end;
          { write virtual methods }
          writevirtualmethods(dataSegment);
@@ -1343,7 +1339,7 @@ implementation
       end;
 
 
-  procedure tclassheader.adjustselfvalue(procdef: tprocdef;ioffset: aword);
+  procedure tclassheader.adjustselfvalue(procdef: tprocdef;ioffset: aint);
     var
       hsym : tsym;
       href : treference;
@@ -1368,7 +1364,7 @@ implementation
           begin
              { offset in the wrapper needs to be adjusted for the stored
                return address }
-             reference_reset_base(href,locpara.reference.index,locpara.reference.offset+POINTER_SIZE);
+             reference_reset_base(href,locpara.reference.index,locpara.reference.offset+sizeof(aint));
              cg.a_op_const_ref(exprasmlist,OP_SUB,locpara.size,ioffset,href);
           end
         else
@@ -1382,7 +1378,35 @@ initialization
 end.
 {
   $Log$
-  Revision 1.69  2004-03-31 21:01:01  florian
+  Revision 1.70  2004-06-16 20:07:09  florian
+    * dwarf branch merged
+
+  Revision 1.69.2.8  2004/05/10 21:28:34  peter
+    * section_smartlink enabled for gas under linux
+
+  Revision 1.69.2.7  2004/05/01 16:02:09  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
+  Revision 1.69.2.6  2004/04/28 20:36:13  florian
+    * fixed writing of sizes in classes/object vmts
+
+  Revision 1.69.2.5  2004/04/27 18:18:26  peter
+    * aword -> aint
+
+  Revision 1.69.2.4  2004/04/26 21:02:34  peter
+    * 64bit fixes
+
+  Revision 1.69.2.3  2004/04/12 14:45:11  peter
+    * tai_const_symbol and tai_const merged
+
+  Revision 1.69.2.2  2004/04/10 12:36:41  peter
+    * fixed alignment issues
+
+  Revision 1.69.2.1  2004/04/08 18:33:22  peter
+    * rewrite of TAsmSection
+
+  Revision 1.69  2004/03/31 21:01:01  florian
     * vtbls are now properly aligned
 
   Revision 1.68  2004/03/18 11:43:57  olle
@@ -1642,7 +1666,7 @@ end.
       on demand from tprocdef.mangledname
 
   Revision 1.14  2002/04/15 18:59:07  carl
-  + target_info.size_of_pointer -> pointer_Size
+  + target_info.size_of_pointer -> sizeof(aint)
 
   Revision 1.13  2002/02/11 18:51:35  peter
     * fixed vmt generation for private procedures that were skipped after

compiler/node.pas

@@ -1132,7 +1132,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.85  2004-05-24 20:39:41  florian
+  Revision 1.86  2004-06-16 20:07:09  florian
+    * dwarf branch merged
+
+  Revision 1.85  2004/05/24 20:39:41  florian
     * stricter handling of formal const parameters and IE fixed
 
   Revision 1.84  2004/05/23 18:28:41  peter
@@ -1146,6 +1149,16 @@ end.
     + <pointer> - <pointer> result is divided by the pointer element size now
       this is delphi compatible as well as resulting in the expected result for p1+(p2-p1)
 
+  Revision 1.81.2.1  2004/05/30 10:45:50  peter
+    * merged fixes from main branch
+
+  Revision 1.85  2004/05/24 20:39:41  florian
+    * stricter handling of formal const parameters and IE fixed
+
+  Revision 1.82  2004/05/20 21:54:33  florian
+    + <pointer> - <pointer> result is divided by the pointer element size now
+      this is delphi compatible as well as resulting in the expected result for p1+(p2-p1)
+
   Revision 1.81  2004/02/03 22:32:54  peter
     * renamed xNNbittype to xNNinttype
     * renamed registers32 to registersint
@@ -1410,4 +1423,4 @@ end.
     - list field removed of the tnode class because it's not used currently
       and can cause hard-to-find bugs
 
-}
+}

compiler/nset.pas

@@ -27,7 +27,7 @@ unit nset;
 interface
 
     uses
-       node,globals,
+       node,globtype,globals,
        aasmbase,aasmtai,symtype;
 
     type
@@ -114,7 +114,7 @@ interface
 implementation
 
     uses
-      globtype,systems,
+      systems,
       verbose,
       symconst,symdef,symsym,symtable,defutil,defcmp,
       htypechk,pass_1,
@@ -354,7 +354,7 @@ implementation
             { upper limit must be greater or equal than lower limit }
             if (tordconstnode(left).value>tordconstnode(right).value) and
                ((tordconstnode(left).value<0) or (tordconstnode(right).value>=0)) then
-              CGMessage(cg_e_upper_lower_than_lower);
+              CGMessage(parser_e_upper_lower_than_lower);
           end;
         resulttype:=left.resulttype;
       end;
@@ -694,7 +694,18 @@ begin
 end.
 {
   $Log$
-  Revision 1.53  2004-03-18 16:19:03  peter
+  Revision 1.54  2004-06-16 20:07:09  florian
+    * dwarf branch merged
+
+  Revision 1.53.2.2  2004/05/01 16:02:09  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
+  Revision 1.53.2.1  2004/04/28 19:55:51  peter
+    * new warning for ordinal-pointer when size is different
+    * fixed some cg_e_ messages to the correct section type_e_ or parser_e_
+
+  Revision 1.53  2004/03/18 16:19:03  peter
     * fixed operator overload allowing for pointer-string
     * replaced some type_e_mismatch with more informational messages
 

compiler/nutils.pas

@@ -246,7 +246,7 @@ implementation
             resulttypepass(result);
           end
         else
-          CGMessage(cg_e_illegal_expression);
+          CGMessage(parser_e_illegal_expression);
       end;
 
 
@@ -263,7 +263,7 @@ implementation
             resulttypepass(result);
           end
         else
-          CGMessage(cg_e_illegal_expression);
+          CGMessage(parser_e_illegal_expression);
       end;
 
 
@@ -280,7 +280,7 @@ implementation
             resulttypepass(result);
           end
         else
-          CGMessage(cg_e_illegal_expression);
+          CGMessage(parser_e_illegal_expression);
       end;
 
 
@@ -298,7 +298,7 @@ implementation
             resulttypepass(result);
           end
         else
-          CGMessage(cg_e_illegal_expression);
+          CGMessage(parser_e_illegal_expression);
       end;
 
 
@@ -315,7 +315,7 @@ implementation
             resulttypepass(result);
           end
         else
-          CGMessage(cg_e_illegal_expression);
+          CGMessage(parser_e_illegal_expression);
       end;
 
 
@@ -438,12 +438,19 @@ end.
 
 {
   $Log$
-  Revision 1.12  2004-05-23 18:28:41  peter
+  Revision 1.13  2004-06-16 20:07:09  florian
+    * dwarf branch merged
+
+  Revision 1.12  2004/05/23 18:28:41  peter
     * methodpointer is loaded into a temp when it was a calln
 
   Revision 1.11  2004/05/23 15:04:49  peter
     * generate better code for ansistring initialization
 
+  Revision 1.10.2.1  2004/04/28 19:55:52  peter
+    * new warning for ordinal-pointer when size is different
+    * fixed some cg_e_ messages to the correct section type_e_ or parser_e_
+
   Revision 1.10  2004/02/20 21:55:59  peter
     * procvar cleanup
 
@@ -484,4 +491,4 @@ end.
     + applied a patch from Jonas for nested function calls (PowerPC only)
     * ...
 
-}
+}

compiler/ogbase.pas

@@ -63,7 +63,6 @@ interface
          { reader }
          FReader    : tobjectreader;
        protected
-         function  str2sec(const s:string):TSection;
          function  readobjectdata(data:TAsmObjectData):boolean;virtual;abstract;
        public
          constructor create;
@@ -73,9 +72,8 @@ interface
          property Reader:TObjectReader read FReader;
        end;
 
-       texesection = class
+       texesection = class(tnamedindexitem)
        public
-         name      : string[32];
          available : boolean;
          secsymidx,
          datasize,
@@ -83,21 +81,22 @@ interface
          memsize,
          mempos    : longint;
          flags     : cardinal;
-         DataList  : TLinkedList;
+         secdatalist : TLinkedList;
          constructor create(const n:string);
          destructor  destroy;override;
        end;
 
        texeoutput = class
+       private
+         procedure Sections_FixUpSymbol(s:tnamedindexitem;arg:pointer);
        protected
          { writer }
          FWriter : tobjectwriter;
-         procedure WriteZeros(l:longint);
          procedure MapObjectdata(var datapos:longint;var mempos:longint);
          function  writedata:boolean;virtual;abstract;
        public
          { info for each section }
-         sections     : array[TSection] of texesection;
+         sections     : tdictionary;
          { global symbols }
          externalsyms : tsinglelist;
          commonsyms   : tsinglelist;
@@ -193,7 +192,7 @@ implementation
 
     constructor texesection.create(const n:string);
       begin
-        name:=n;
+        inherited createname(n);
         mempos:=0;
         memsize:=0;
         datapos:=0;
@@ -201,7 +200,7 @@ implementation
         secsymidx:=0;
         available:=false;
         flags:=0;
-        datalist:=TLinkedList.Create;
+        secdatalist:=TLinkedList.Create;
       end;
 
 
@@ -215,8 +214,6 @@ implementation
 ****************************************************************************}
 
     constructor texeoutput.create;
-      var
-        sec : TSection;
       begin
         { init writer }
         FWriter:=tobjectwriter.create;
@@ -228,18 +225,13 @@ implementation
         globalsyms.noclear:=true;
         externalsyms:=tsinglelist.create;
         commonsyms:=tsinglelist.create;
-        { sections }
-        for sec:=low(TSection) to high(TSection) do
-         sections[sec]:=texesection.create(target_asm.secnames[sec]);
+        sections:=tdictionary.create;
       end;
 
 
     destructor texeoutput.destroy;
-      var
-        sec : TSection;
       begin
-        for sec:=low(TSection) to high(TSection) do
-         sections[sec].free;
+        sections.free;
         globalsyms.free;
         externalsyms.free;
         commonsyms.free;
@@ -273,23 +265,13 @@ implementation
 
 
     procedure texeoutput.addobjdata(objdata:TAsmObjectData);
-      var
-        sec : TSection;
       begin
         objdatalist.concat(objdata);
-        { check which sections are available }
-        for sec:=low(TSection) to high(TSection) do
-         begin
-           if assigned(objdata.sects[sec]) then
-            begin
-              sections[sec].available:=true;
-              sections[sec].flags:=objdata.sects[sec].flags;
-            end;
-         end;
       end;
 
 
     procedure texeoutput.MapObjectdata(var datapos:longint;var mempos:longint);
+{$ifdef needrewrite}
       var
         sec : TSection;
         s   : TAsmSection;
@@ -333,27 +315,54 @@ implementation
               sections[sec].memsize:=mempos-sections[sec].mempos;
             end;
          end;
+{$endif needrewrite}
+      begin
       end;
 
 
-    procedure texeoutput.WriteZeros(l:longint);
+    procedure texeoutput.Sections_FixUpSymbol(s:tnamedindexitem;arg:pointer);
+{$ifdef needrewrite}
       var
-        empty : array[0..63] of char;
+        secdata : TAsmSection;
+        hsym    : TAsmSymbol;
+      begin
+        with texesection(s) do
+          begin
+            if assigned(exemap) then
+              exemap.AddMemoryMapExeSection(TExeSection(s));
+            secdata:=TAsmSection(secdatalist.first);
+            while assigned(secdata) do
+             begin
+               if assigned(exemap) then
+                 exemap.AddMemoryMapObjectSection(secdata);
+               hsym:=tasmsymbol(secdata.owner.symbols.first);
+               while assigned(hsym) do
+                 begin
+                   { process only the symbols that are defined in this section
+                     and are located in this module }
+                   if ((hsym.section=secdata) or
+                       ((secdata.sectype=sec_bss) and (hsym.section.sectype=sec_common))) then
+                     begin
+                       if hsym.currbind=AB_EXTERNAL then
+                         internalerror(200206303);
+                       inc(hsym.address,secdata.mempos);
+                       if assigned(exemap) then
+                         exemap.AddMemoryMapSymbol(hsym);
+                     end;
+                   hsym:=tasmsymbol(hsym.indexnext);
+                 end;
+               secdata:=TAsmSection(secdata.indexnext);
+             end;
+          end;
+      end;
+{$endif needrewrite}
       begin
-        if l>0 then
-         begin
-           fillchar(empty,l,0);
-           FWriter.Write(empty,l);
-         end;
       end;
 
 
     procedure texeoutput.FixUpSymbols;
       var
-        sec : TSection;
-        objdata : TAsmObjectData;
-        sym,
-        hsym : tasmsymbol;
+        sym : tasmsymbol;
       begin
         {
           Fixing up symbols is done in the following steps:
@@ -363,39 +372,8 @@ implementation
         }
         { Step 1, Update addresses }
         if assigned(exemap) then
-         exemap.AddMemoryMapHeader;
-        for sec:=low(TSection) to high(TSection) do
-         if sections[sec].available then
-          begin
-            if assigned(exemap) then
-              exemap.AddMemoryMapSection(sections[sec]);
-            objdata:=TAsmObjectData(objdatalist.first);
-            while assigned(objdata) do
-             begin
-               if assigned(objdata.sects[sec]) then
-                begin
-                  if assigned(exemap) then
-                    exemap.AddMemoryMapObjectData(objdata,sec);
-                  hsym:=tasmsymbol(objdata.symbols.first);
-                  while assigned(hsym) do
-                   begin
-                     { process only the symbols that are defined in this section
-                       and are located in this module }
-                     if ((hsym.section=sec) or
-                         ((sec=sec_bss) and (hsym.section=sec_common))) then
-                      begin
-                        if hsym.currbind=AB_EXTERNAL then
-                         internalerror(200206303);
-                        inc(hsym.address,TAsmObjectData(hsym.objectdata).sects[sec].mempos);
-                        if assigned(exemap) then
-                          exemap.AddMemoryMapSymbol(hsym);
-                      end;
-                     hsym:=tasmsymbol(hsym.indexnext);
-                   end;
-                end;
-               objdata:=TAsmObjectData(objdata.next);
-             end;
-          end;
+          exemap.AddMemoryMapHeader;
+        sections.foreach(@sections_fixupsymbol,nil);
         { Step 2, Update commons }
         sym:=tasmsymbol(commonsyms.first);
         while assigned(sym) do
@@ -408,7 +386,7 @@ implementation
               sym.size:=sym.altsymbol.size;
               sym.section:=sym.altsymbol.section;
               sym.typ:=sym.altsymbol.typ;
-              sym.objectdata:=sym.altsymbol.objectdata;
+              sym.owner:=sym.altsymbol.owner;
             end;
            sym:=tasmsymbol(sym.listnext);
          end;
@@ -424,7 +402,7 @@ implementation
               sym.size:=sym.altsymbol.size;
               sym.section:=sym.altsymbol.section;
               sym.typ:=sym.altsymbol.typ;
-              sym.objectdata:=sym.altsymbol.objectdata;
+              sym.owner:=sym.altsymbol.owner;
             end;
            sym:=tasmsymbol(sym.listnext);
          end;
@@ -463,7 +441,6 @@ implementation
       var
         commonobjdata,
         objdata : TAsmObjectData;
-        s : TAsmSection;
         sym,p : tasmsymbol;
       begin
         commonobjdata:=nil;
@@ -484,7 +461,7 @@ implementation
            sym:=tasmsymbol(objdata.symbols.first);
            while assigned(sym) do
             begin
-              if not assigned(sym.objectdata) then
+              if not assigned(sym.owner) then
                internalerror(200206302);
               case sym.currbind of
                 AB_GLOBAL :
@@ -495,7 +472,7 @@ implementation
                     else
                       begin
                         Comment(V_Error,'Multiple defined symbol '+sym.name);
-                        CalculateSymbols:=false;
+                        result:=false;
                       end;
                   end;
                 AB_EXTERNAL :
@@ -528,17 +505,12 @@ implementation
                     if assigned(exemap) then
                       exemap.AddCommonSymbolsHeader;
                     { create .bss section and add to list }
-                    s:=TAsmSection.create(target_asm.secnames[sec_common],0,true);
                     commonobjdata:=TAsmObjectData.create('*COMMON*');
-                    commonobjdata.sects[sec_bss]:=s;
+                    commonobjdata.createsection(sec_bss,'',0,[aso_alloconly]);
                     addobjdata(commonobjdata);
                   end;
                  p:=TAsmSymbol.Create(sym.name,AB_GLOBAL,AT_FUNCTION);
-                 p.SetAddress(0,sec_common,s.datasize,sym.size);
-                 p.objectdata:=commonobjdata;
-                 commonobjdata.sects[sec_bss].alloc(sym.size);
-                 commonobjdata.symbols.insert(p);
-                 { update this symbol }
+                 commonobjdata.writesymbol(p);
                  if assigned(exemap) then
                    exemap.AddCommonSymbol(p);
                  { make this symbol available as a global }
@@ -605,25 +577,16 @@ implementation
       end;
 
 
-    function tobjectinput.str2sec(const s:string):TSection;
-      var
-        t : TSection;
-      begin
-        for t:=low(TSection) to high(TSection) do
-         begin
-           if (s=target_asm.secnames[t]) then
-            begin
-              str2sec:=t;
-              exit;
-            end;
-         end;
-        str2sec:=sec_none;
-      end;
-
 end.
 {
   $Log$
-  Revision 1.13  2003-04-22 14:33:38  peter
+  Revision 1.14  2004-06-16 20:07:09  florian
+    * dwarf branch merged
+
+  Revision 1.13.2.1  2004/04/08 18:33:22  peter
+    * rewrite of TAsmSection
+
+  Revision 1.13  2003/04/22 14:33:38  peter
     * removed some notes/hints
 
   Revision 1.12  2002/07/01 18:46:24  peter

compiler/ogelf.pas

@@ -32,11 +32,11 @@ interface
 
     uses
        { common }
-       cclasses,
+       cclasses,globtype,
        { target }
        systems,
        { assembler }
-       cpubase,aasmbase,assemble,
+       cpuinfo,cpubase,aasmbase,aasmtai,assemble,
        { output }
        ogbase;
 
@@ -52,8 +52,8 @@ interface
           entsize   : longint;
           { relocation }
           relocsect : telf32Section;
-          constructor createsec(sec:TSection);
-          constructor createname(const Aname:string;Atype,Aflags,Alink,Ainfo,Aalign,Aentsize:longint);
+          constructor create(const Aname:string;Atype:TAsmSectionType;Aalign:longint;Aoptions:TAsmSectionOptions);override;
+          constructor create_ext(const Aname:string;Atype:TAsmSectionType;Ashtype,Ashflags,Ashlink,Ashinfo,Aalign,Aentsize:longint);
           destructor  destroy;override;
        end;
 
@@ -70,13 +70,13 @@ interface
          syms     : Tdynamicarray;
          constructor create(const n:string);
          destructor  destroy;override;
-         procedure createsection(sec:TSection);override;
-         procedure seTSectionsizes(var s:TAsmSectionSizes);override;
-         procedure writereloc(data,len:longint;p:tasmsymbol;relative:TAsmRelocationType);override;
+         function  sectionname(atype:tasmsectiontype;const aname:string):string;override;
+         procedure writereloc(data,len:aint;p:tasmsymbol;relative:TAsmRelocationType);override;
          procedure writesymbol(p:tasmsymbol);override;
-         procedure writestabs(section:TSection;offset:longint;p:pchar;nidx,nother,line:longint;reloc:boolean);override;
-         procedure writesymstabs(section:TSection;offset:longint;p:pchar;ps:tasmsymbol;
-                                 nidx,nother,line:longint;reloc:boolean);override;
+         procedure writestabs(offset:aint;p:pchar;nidx,nother,line:longint;reloc:boolean);override;
+         procedure writesymstabs(offset:aint;p:pchar;ps:tasmsymbol;nidx,nother,line:longint;reloc:boolean);override;
+         procedure beforealloc;override;
+         procedure beforewrite;override;
        end;
 
        telf32objectoutput = class(tobjectoutput)
@@ -87,6 +87,17 @@ interface
          procedure createshstrtab;
          procedure createsymtab;
          procedure writesectionheader(s:telf32section);
+         procedure writesectiondata(s:telf32section);
+         procedure section_write_symbol(p:tnamedindexitem;arg:pointer);
+         procedure section_write_sh_string(p:tnamedindexitem;arg:pointer);
+         procedure section_number_symbol(p:tnamedindexitem;arg:pointer);
+         procedure section_count_sects(p:tnamedindexitem;arg:pointer);
+         procedure section_create_relocsec(p:tnamedindexitem;arg:pointer);
+         procedure section_set_datapos(p:tnamedindexitem;arg:pointer);
+         procedure section_relocsec_set_datapos(p:tnamedindexitem;arg:pointer);
+         procedure section_write_data(p:tnamedindexitem;arg:pointer);
+         procedure section_write_sechdr(p:tnamedindexitem;arg:pointer);
+         procedure section_write_relocsec(p:tnamedindexitem;arg:pointer);
        protected
          function writedata(data:TAsmObjectData):boolean;override;
        public
@@ -107,7 +118,7 @@ implementation
         strings,
 {$endif}
         verbose,
-        globtype,cutils,globals,fmodule;
+        cutils,globals,fmodule;
 
     const
       symbolresize = 200*18;
@@ -210,58 +221,62 @@ implementation
                                TSection
 ****************************************************************************}
 
-    constructor telf32section.createsec(sec:TSection);
+    constructor telf32section.create(const Aname:string;Atype:TAsmSectionType;Aalign:longint;Aoptions:TAsmSectionOptions);
       var
-        Aflags,Atype,Aalign,Aentsize : longint;
+        Ashflags,Ashtype,Aentsize : longint;
       begin
-        Aflags:=0;
-        Atype:=0;
-        Aalign:=0;
+        Ashflags:=0;
+        Ashtype:=0;
         Aentsize:=0;
-        case sec of
+        case Atype of
           sec_code :
             begin
-              Aflags:=SHF_ALLOC or SHF_EXECINSTR;
-              AType:=SHT_PROGBITS;
-              AAlign:=16;
+              Ashflags:=SHF_ALLOC or SHF_EXECINSTR;
+              AshType:=SHT_PROGBITS;
+              AAlign:=max(sizeof(aint),AAlign);
             end;
           sec_data :
             begin
-              Aflags:=SHF_ALLOC or SHF_WRITE;
-              AType:=SHT_PROGBITS;
-              AAlign:=4;
+              Ashflags:=SHF_ALLOC or SHF_WRITE;
+              AshType:=SHT_PROGBITS;
+              AAlign:=max(sizeof(aint),AAlign);
             end;
           sec_bss :
             begin
-              Aflags:=SHF_ALLOC or SHF_WRITE;
-              AType:=SHT_NOBITS;
-              AAlign:=4;
+              Ashflags:=SHF_ALLOC or SHF_WRITE;
+              AshType:=SHT_NOBITS;
+              AAlign:=max(sizeof(aint),AAlign);
             end;
           sec_stab :
             begin
-              AType:=SHT_PROGBITS;
-              AAlign:=4;
+              AshType:=SHT_PROGBITS;
+              AAlign:=max(sizeof(aint),AAlign);
               Aentsize:=sizeof(telf32stab);
             end;
           sec_stabstr :
             begin
-              AType:=SHT_STRTAB;
+              AshType:=SHT_STRTAB;
               AAlign:=1;
             end;
         end;
-        createname(target_asm.secnames[sec],Atype,Aflags,0,0,Aalign,Aentsize);
+        create_ext(Aname,Atype,Ashtype,Ashflags,0,0,Aalign,Aentsize);
       end;
 
 
-    constructor telf32section.createname(const Aname:string;Atype,Aflags,Alink,Ainfo,Aalign,Aentsize:longint);
+    constructor telf32section.create_ext(const Aname:string;Atype:TAsmSectionType;Ashtype,Ashflags,Ashlink,Ashinfo,Aalign,Aentsize:longint);
+      var
+        aoptions : TAsmSectionOptions;
       begin
-        inherited create(Aname,Aalign,(AType=SHT_NOBITS));
+        aoptions:=[];
+        if (AshType=SHT_NOBITS) then
+          include(aoptions,aso_alloconly);
+        inherited create(Aname,Atype,Aalign,aoptions);
         secshidx:=0;
         shstridx:=0;
-        shtype:=AType;
-        shflags:=AFlags;
-        shlink:=Alink;
-        shinfo:=Ainfo;
+        shtype:=AshType;
+        shflags:=AshFlags;
+        shlink:=Ashlink;
+        shinfo:=Ashinfo;
         entsize:=Aentsize;
         relocsect:=nil;
       end;
@@ -284,28 +299,25 @@ implementation
         s : string;
       begin
         inherited create(n);
+        CAsmSection:=TElf32Section;
         { reset }
         Syms:=TDynamicArray.Create(symbolresize);
         { default sections }
-        symtabsect:=telf32section.createname('.symtab',2,0,0,0,4,16);
-        strtabsect:=telf32section.createname('.strtab',3,0,0,0,1,0);
-        shstrtabsect:=telf32section.createname('.shstrtab',3,0,0,0,1,0);
+        symtabsect:=telf32section.create_ext('.symtab',sec_custom,2,0,0,0,4,16);
+        strtabsect:=telf32section.create_ext('.strtab',sec_custom,3,0,0,0,1,0);
+        shstrtabsect:=telf32section.create_ext('.shstrtab',sec_custom,3,0,0,0,1,0);
         { insert the empty and filename as first in strtab }
         strtabsect.writestr(#0);
         strtabsect.writestr(SplitFileName(current_module.mainsource^)+#0);
         { we need at least the following sections }
-        createsection(sec_code);
-        createsection(sec_data);
-        createsection(sec_bss);
+        createsection(sec_code,'',0,[]);
+        createsection(sec_data,'',0,[]);
+        createsection(sec_bss,'',0,[]);
         { create stabs sections if debugging }
         if (cs_debuginfo in aktmoduleswitches) then
          begin
-           createsection(sec_stab);
-           createsection(sec_stabstr);
-           writestabs(sec_none,0,nil,0,0,0,false);
-           { write zero pchar and name together (PM) }
-           s:=#0+SplitFileName(current_module.mainsource^)+#0;
-           sects[sec_stabstr].write(s[1],length(s));
+           stabssec:=createsection(sec_stab,'',0,[]);
+           stabstrsec:=createsection(sec_stabstr,'',0,[]);
          end;
       end;
 
@@ -320,20 +332,35 @@ implementation
       end;
 
 
-    procedure telf32objectdata.createsection(sec:TSection);
+    function telf32objectdata.sectionname(atype:tasmsectiontype;const aname:string):string;
+      const
+        secnames : array[tasmsectiontype] of string[12] = ('',
+{$warning TODO .rodata not yet working}
+          '.text','.data','.data','.bss',
+          'common',
+          '.note',
+          '.stab','.stabstr',
+          '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
+          '.eh_frame',
+          '.debug_frame'
+        );
       begin
-        sects[sec]:=telf32Section.createsec(Sec);
+        if use_smartlink_section and
+           (atype<>sec_bss) and
+           (aname<>'') then
+          result:='.gnu.linkonce'+copy(secnames[atype],1,2)+'.'+aname
+        else
+          result:=secnames[atype];
       end;
 
 
     procedure telf32objectdata.writesymbol(p:tasmsymbol);
       begin
+        if currsec=nil then
+          internalerror(200403291);
         { already written ? }
         if p.indexnr<>-1 then
          exit;
-        { be sure that the section will exists }
-        if (p.section<>sec_none) and not(assigned(sects[p.section])) then
-          createsection(p.section);
         { calculate symbol index }
         if (p.currbind<>AB_LOCAL) then
          begin
@@ -346,12 +373,12 @@ implementation
       end;
 
 
-    procedure telf32objectdata.writereloc(data,len:longint;p:tasmsymbol;relative:TAsmRelocationType);
+    procedure telf32objectdata.writereloc(data,len:aint;p:tasmsymbol;relative:TAsmRelocationType);
       var
         symaddr : longint;
       begin
-        if not assigned(sects[currsec]) then
-         createsection(currsec);
+        if currsec=nil then
+          internalerror(200403292);
         if assigned(p) then
          begin
            { real address of the symbol }
@@ -362,12 +389,12 @@ implementation
                case relative of
                  RELOC_ABSOLUTE :
                    begin
-                     sects[currsec].addsectionreloc(sects[currsec].datasize,currsec,RELOC_ABSOLUTE);
+                     currsec.addsectionreloc(currsec.datasize,currsec,RELOC_ABSOLUTE);
                      inc(data,symaddr);
                    end;
                  RELOC_RELATIVE :
                    begin
-                     inc(data,symaddr-len-sects[currsec].datasize);
+                     inc(data,symaddr-len-currsec.datasize);
                    end;
                  RELOC_RVA :
                    internalerror(3219583);
@@ -376,27 +403,30 @@ implementation
            else
              begin
                writesymbol(p);
-               if (p.section<>sec_none) and (relative<>RELOC_RELATIVE) then
+               { For common (global .bss) symbols a reloc by sym is required }
+               if assigned(p.section) and
+                  (p.currbind<>AB_COMMON) and
+                  (relative<>RELOC_RELATIVE) then
                 begin
-                  sects[currsec].addsectionreloc(sects[currsec].datasize,p.section,relative);
+                  currsec.addsectionreloc(currsec.datasize,p.section,relative);
                   inc(data,symaddr);
                 end
                else
-                sects[currsec].addsymreloc(sects[currsec].datasize,p,relative);
+                currsec.addsymreloc(currsec.datasize,p,relative);
                if relative=RELOC_RELATIVE then
                 begin
                   if p.currbind=AB_EXTERNAL then
                    dec(data,len)
                   else
-                   dec(data,len+sects[currsec].datasize);
+                   dec(data,len+currsec.datasize);
                 end;
             end;
          end;
-        sects[currsec].write(data,len);
+        currsec.write(data,len);
       end;
 
 
-    procedure telf32objectdata.writestabs(section:TSection;offset:longint;p:pchar;nidx,nother,line:longint;reloc : boolean);
+    procedure telf32objectdata.writestabs(offset:aint;p:pchar;nidx,nother,line:longint;reloc : boolean);
       var
         stab : telf32stab;
       begin
@@ -404,55 +434,75 @@ implementation
          begin
            if (offset=-1) then
             begin
-              if section=sec_none then
+              if currsec=nil then
                offset:=0
               else
-               offset:=sects[section].datasize;
+               offset:=currsec.datasize;
             end;
          end;
         fillchar(stab,sizeof(telf32stab),0);
         if assigned(p) and (p[0]<>#0) then
          begin
-           stab.strpos:=sects[sec_stabstr].datasize;
-           sects[sec_stabstr].write(p^,strlen(p)+1);
+           stab.strpos:=stabstrsec.datasize;
+           stabstrsec.write(p^,strlen(p)+1);
          end;
         stab.ntype:=nidx;
         stab.ndesc:=line;
         stab.nother:=nother;
         stab.nvalue:=offset;
-        sects[sec_stab].write(stab,sizeof(stab));
+        stabssec.write(stab,sizeof(stab));
         { when the offset is not 0 then write a relocation, take also the
           hdrstab into account with the offset }
         if reloc then
-         sects[sec_stab].addsectionreloc(sects[sec_stab].datasize-4,section,RELOC_ABSOLUTE);
+         stabssec.addsectionreloc(stabssec.datasize-4,currsec,RELOC_ABSOLUTE);
       end;
 
 
-    procedure telf32objectdata.writesymstabs(section:TSection;offset:longint;p:pchar;ps:tasmsymbol;
-                                             nidx,nother,line:longint;reloc:boolean);
+    procedure telf32objectdata.writesymstabs(offset:aint;p:pchar;ps:tasmsymbol;nidx,nother,line:longint;reloc:boolean);
       var
         stab : telf32stab;
       begin
         fillchar(stab,sizeof(telf32stab),0);
         if assigned(p) and (p[0]<>#0) then
          begin
-           stab.strpos:=sects[sec_stabstr].datasize;
-           sects[sec_stabstr].write(p^,strlen(p)+1);
+           stab.strpos:=stabstrsec.datasize;
+           stabstrsec.write(p^,strlen(p)+1);
          end;
         stab.ntype:=nidx;
         stab.ndesc:=line;
         stab.nother:=nother;
         stab.nvalue:=0;
-        sects[sec_stab].write(stab,sizeof(stab));
+        stabssec.write(stab,sizeof(stab));
         { when the offset is not 0 then write a relocation, take also the
           hdrstab into account with the offset }
         if reloc then
-         sects[sec_stab].addsymreloc(sects[sec_stab].datasize-4,ps,RELOC_ABSOLUTE);
+         stabssec.addsymreloc(stabssec.datasize-4,ps,RELOC_ABSOLUTE);
       end;
 
 
-    procedure telf32objectdata.seTSectionsizes(var s:TAsmSectionSizes);
+    procedure telf32objectdata.beforealloc;
       begin
+        { create stabs sections if debugging }
+        if (cs_debuginfo in aktmoduleswitches) then
+          begin
+            StabsSec.Alloc(sizeof(telf32stab));
+            StabStrSec.Alloc(length(SplitFileName(current_module.mainsource^))+2);
+          end;
+      end;
+
+
+    procedure telf32objectdata.beforewrite;
+      var
+        s : string;
+      begin
+        { create stabs sections if debugging }
+        if (cs_debuginfo in aktmoduleswitches) then
+         begin
+           writestabs(0,nil,0,0,0,false);
+           { write zero pchar and name together (PM) }
+           s:=#0+SplitFileName(current_module.mainsource^)+#0;
+           stabstrsec.write(s[1],length(s));
+         end;
       end;
 
 
@@ -475,7 +525,7 @@ implementation
         with elf32data do
          begin
            { create the reloc section }
-           s.relocsect:=telf32section.createname('.rel'+s.name,9,0,symtabsect.secshidx,s.secshidx,4,8);
+           s.relocsect:=telf32section.create_ext('.rel'+s.name,sec_custom,9,0,symtabsect.secshidx,s.secshidx,4,8);
            { add the relocations }
            r:=TasmRelocation(s.relocations.first);
            while assigned(r) do
@@ -484,7 +534,7 @@ implementation
               if assigned(r.symbol) then
                begin
                  if (r.symbol.currbind=AB_LOCAL) then
-                  relsym:=sects[r.symbol.section].secsymidx
+                  relsym:=r.symbol.section.secsymidx
                  else
                   begin
                     if r.symbol.indexnr=-1 then
@@ -494,8 +544,8 @@ implementation
                   end;
                end
               else
-               if r.section<>sec_none then
-                relsym:=sects[r.section].secsymidx
+               if r.section<>nil then
+                relsym:=r.section.secsymidx
                else
                 relsym:=SHN_UNDEF;
               case r.typ of
@@ -513,10 +563,23 @@ implementation
       end;
 
 
+    procedure telf32objectoutput.section_write_symbol(p:tnamedindexitem;arg:pointer);
+      var
+        elfsym : telf32symbol;
+      begin
+        fillchar(elfsym,sizeof(elfsym),0);
+        elfsym.st_name:=telf32section(p).shstridx;
+        elfsym.st_info:=STT_SECTION;
+        elfsym.st_shndx:=telf32section(p).secshidx;
+        elf32data.symtabsect.write(elfsym,sizeof(elfsym));
+        { increase locals count }
+        inc(plongint(arg)^);
+      end;
+
+
     procedure telf32objectoutput.createsymtab;
       var
         elfsym : telf32symbol;
-        sec : TSection;
         locals : longint;
         sym : tasmsymbol;
       begin
@@ -532,16 +595,7 @@ implementation
            elfsym.st_shndx:=SHN_ABS;
            symtabsect.write(elfsym,sizeof(elfsym));
            { section }
-           for sec:=low(TSection) to high(TSection) do
-            if assigned(sects[sec]) then
-             begin
-               fillchar(elfsym,sizeof(elfsym),0);
-               elfsym.st_name:=telf32section(sects[sec]).shstridx;
-               elfsym.st_info:=STT_SECTION;
-               elfsym.st_shndx:=telf32section(sects[sec]).secshidx;
-               symtabsect.write(elfsym,sizeof(elfsym));
-               inc(locals);
-             end;
+           sects.foreach(@section_write_symbol,@locals);
            { symbols }
            sym:=Tasmsymbol(symbols.First);
            while assigned(sym) do
@@ -582,8 +636,8 @@ implementation
               if sym.currbind=AB_COMMON then
                elfsym.st_shndx:=SHN_COMMON
               else
-               if assigned(sects[sym.section]) then
-                elfsym.st_shndx:=telf32section(sects[sym.section]).secshidx
+               if assigned(sym.section) then
+                elfsym.st_shndx:=telf32section(sym.section).secshidx
                else
                 elfsym.st_shndx:=SHN_UNDEF;
               symtabsect.write(elfsym,sizeof(elfsym));
@@ -596,9 +650,15 @@ implementation
       end;
 
 
+    procedure telf32objectoutput.section_write_sh_string(p:tnamedindexitem;arg:pointer);
+      begin
+        telf32section(p).shstridx:=elf32data.shstrtabsect.writestr(tasmsection(p).name+#0);
+        if assigned(telf32section(p).relocsect) then
+          telf32section(p).relocsect.shstridx:=elf32data.shstrtabsect.writestr(telf32section(p).relocsect.name+#0);
+      end;
+
+
     procedure telf32objectoutput.createshstrtab;
-      var
-        sec : TSection;
       begin
         with elf32data do
          begin
@@ -608,13 +668,7 @@ implementation
               symtabsect.shstridx:=writestr('.symtab'#0);
               strtabsect.shstridx:=writestr('.strtab'#0);
               shstrtabsect.shstridx:=writestr('.shstrtab'#0);
-              for sec:=low(TSection) to high(TSection) do
-               if assigned(sects[sec]) then
-                begin
-                  telf32section(sects[sec]).shstridx:=writestr(sects[sec].name+#0);
-                  if assigned(telf32section(sects[sec]).relocsect) then
-                   telf32section(sects[sec]).relocsect.shstridx:=writestr(telf32section(sects[sec]).relocsect.name+#0);
-                end;
+              sects.foreach(@section_write_sh_string,nil);
             end;
          end;
       end;
@@ -638,37 +692,108 @@ implementation
       end;
 
 
+
+    procedure telf32objectoutput.writesectiondata(s:telf32section);
+      var
+        hp : pdynamicblock;
+      begin
+        FWriter.writezeros(s.dataalignbytes);
+        s.alignsection;
+        hp:=s.data.firstblock;
+        while assigned(hp) do
+          begin
+            FWriter.write(hp^.data,hp^.used);
+            hp:=hp^.next;
+          end;
+      end;
+
+
+    procedure telf32objectoutput.section_number_symbol(p:tnamedindexitem;arg:pointer);
+      begin
+        tasmsection(p).secsymidx:=plongint(arg)^;
+        inc(plongint(arg)^);
+      end;
+
+
+    procedure telf32objectoutput.section_count_sects(p:tnamedindexitem;arg:pointer);
+      begin
+        telf32section(p).secshidx:=plongint(arg)^;
+        inc(plongint(arg)^);
+        if telf32section(p).relocations.count>0 then
+          inc(plongint(arg)^);
+      end;
+
+
+    procedure telf32objectoutput.section_create_relocsec(p:tnamedindexitem;arg:pointer);
+      begin
+        if (telf32section(p).relocations.count>0) then
+          createrelocsection(telf32section(p));
+      end;
+
+
+    procedure telf32objectoutput.section_set_datapos(p:tnamedindexitem;arg:pointer);
+      begin
+        if (aso_alloconly in tasmsection(p).secoptions) then
+          tasmsection(p).datapos:=paint(arg)^
+        else
+          tasmsection(p).setdatapos(paint(arg)^);
+      end;
+
+
+    procedure telf32objectoutput.section_relocsec_set_datapos(p:tnamedindexitem;arg:pointer);
+      begin
+        if assigned(telf32section(p).relocsect) then
+          telf32section(p).relocsect.setdatapos(paint(arg)^);
+      end;
+
+
+    procedure telf32objectoutput.section_write_data(p:tnamedindexitem;arg:pointer);
+      begin
+        if (aso_alloconly in tasmsection(p).secoptions) then
+          exit;
+        if tasmsection(p).data=nil then
+          internalerror(200403073);
+        writesectiondata(telf32section(p));
+      end;
+
+
+    procedure telf32objectoutput.section_write_sechdr(p:tnamedindexitem;arg:pointer);
+      begin
+        writesectionheader(telf32section(p));
+        if assigned(telf32section(p).relocsect) then
+          writesectionheader(telf32section(p).relocsect);
+      end;
+
+
+    procedure telf32objectoutput.section_write_relocsec(p:tnamedindexitem;arg:pointer);
+      begin
+        if assigned(telf32section(p).relocsect) then
+          writesectiondata(telf32section(p).relocsect);
+      end;
+
+
+
     function telf32objectoutput.writedata(data:TAsmObjectData):boolean;
       var
         header : telf32header;
-        datapos,
+        datapos : aint;
         shoffset,
         nsects : longint;
         hstab  : telf32stab;
-        sec    : TSection;
         empty  : array[0..63] of byte;
-        hp     : pdynamicblock;
       begin
         result:=false;
         elf32data:=telf32objectdata(data);
         with elf32data do
          begin
-         { calc amount of sections we have }
-           fillchar(empty,sizeof(empty),0);
-           nsects:=1;
+           { calc amount of sections we have }
            initsym:=2;
-           for sec:=low(TSection) to high(TSection) do
-            if assigned(sects[sec]) then
-             begin
-               { each section requires a symbol for relocation }
-               sects[sec].secsymidx:=initsym;
-               inc(initsym);
-               { also create the index in the section header table }
-               telf32section(sects[sec]).secshidx:=nsects;
-               inc(nsects);
-               if sects[sec].relocations.count>0 then
-                inc(nsects);
-             end;
+           nsects:=1;
+           fillchar(empty,sizeof(empty),0);
+           { each section requires a symbol for relocation }
+           sects.foreach(@section_number_symbol,@initsym);
+           { also create the index in the section header table }
+           sects.foreach(@section_count_sects,@nsects);
            { add default sections follows }
            shstrtabsect.secshidx:=nsects;
            inc(nsects);
@@ -678,21 +803,18 @@ implementation
            inc(nsects);
          { For the stab section we need an HdrSym which can now be
            calculated more easily }
-           if assigned(sects[sec_stab]) then
+           if assigned(stabssec) then
             begin
               hstab.strpos:=1;
               hstab.ntype:=0;
               hstab.nother:=0;
-              hstab.ndesc:=(sects[sec_stab].datasize div sizeof(telf32stab))-1{+1 according to gas output PM};
-              hstab.nvalue:=sects[sec_stabstr].datasize;
-              sects[sec_stab].Data.seek(0);
-              sects[sec_stab].Data.write(hstab,sizeof(hstab));
+              hstab.ndesc:=(stabssec.datasize div sizeof(telf32stab))-1{+1 according to gas output PM};
+              hstab.nvalue:=stabstrsec.datasize;
+              stabssec.Data.seek(0);
+              stabssec.Data.write(hstab,sizeof(hstab));
             end;
          { Create the relocation sections }
-           for sec:=low(TSection) to high(TSection) do
-            if assigned(sects[sec]) and
-               (sects[sec].relocations.count>0) then
-              createrelocsection(telf32section(sects[sec]));
+           sects.foreach(@section_create_relocsec,nil);
          { create .symtab and .strtab }
            createsymtab;
          { create .shstrtab }
@@ -700,33 +822,18 @@ implementation
          { Calculate the filepositions }
            datapos:=$40; { elfheader + alignment }
            { sections first }
-           for sec:=low(TSection) to high(TSection) do
-            if assigned(sects[sec]) then
-             begin
-               sects[sec].datapos:=datapos;
-               if assigned(sects[sec].data) then
-                 inc(datapos,sects[sec].aligneddatasize);
-             end;
+           sects.foreach(@section_set_datapos,@datapos);
            { shstrtab }
-           shstrtabsect.datapos:=datapos;
-           inc(datapos,shstrtabsect.aligneddatasize);
+           shstrtabsect.setdatapos(datapos);
            { section headers }
            shoffset:=datapos;
            inc(datapos,nsects*sizeof(telf32sechdr));
            { symtab }
-           symtabsect.datapos:=datapos;
-           inc(datapos,symtabsect.aligneddatasize);
+           symtabsect.setdatapos(datapos);
            { strtab }
-           strtabsect.datapos:=datapos;
-           inc(datapos,align(strtabsect.datasize,4));
+           strtabsect.setdatapos(datapos);
            { .rel sections }
-           for sec:=low(TSection) to high(TSection) do
-            if assigned(sects[sec]) and
-               assigned(telf32section(sects[sec]).relocsect) then
-             begin
-               telf32section(sects[sec]).relocsect.datapos:=datapos;
-               inc(datapos,telf32section(sects[sec]).relocsect.aligneddatasize);
-             end;
+           sects.foreach(@section_relocsec_set_datapos,@datapos);
          { Write ELF Header }
            fillchar(header,sizeof(header),0);
            header.magic0123:=$464c457f; { = #127'ELF' }
@@ -744,67 +851,21 @@ implementation
            writer.write(header,sizeof(header));
            writer.write(empty,$40-sizeof(header)); { align }
          { Sections }
-           for sec:=low(TSection) to high(TSection) do
-            if assigned(sects[sec]) and
-               assigned(sects[sec].data) then
-             begin
-               sects[sec].alignsection;
-               hp:=sects[sec].Data.firstblock;
-               while assigned(hp) do
-                begin
-                  writer.write(hp^.data,hp^.used);
-                  hp:=hp^.next;
-                end;
-             end;
+           sects.foreach(@section_write_data,nil);
          { .shstrtab }
-           shstrtabsect.alignsection;
-           hp:=shstrtabsect.Data.firstblock;
-           while assigned(hp) do
-            begin
-              writer.write(hp^.data,hp^.used);
-              hp:=hp^.next;
-            end;
+           writesectiondata(shstrtabsect);
          { section headers, start with an empty header for sh_undef }
            writer.write(empty,sizeof(telf32sechdr));
-           for sec:=low(TSection) to high(TSection) do
-            if assigned(sects[sec]) then
-             begin
-               writesectionheader(telf32section(sects[sec]));
-               if assigned(telf32section(sects[sec]).relocsect) then
-                writesectionheader(telf32section(sects[sec]).relocsect);
-             end;
+           sects.foreach(@section_write_sechdr,nil);
            writesectionheader(shstrtabsect);
            writesectionheader(symtabsect);
            writesectionheader(strtabsect);
          { .symtab }
-           symtabsect.alignsection;
-           hp:=symtabsect.Data.firstblock;
-           while assigned(hp) do
-            begin
-              writer.write(hp^.data,hp^.used);
-              hp:=hp^.next;
-            end;
+           writesectiondata(symtabsect);
          { .strtab }
-           strtabsect.writealign(4);
-           hp:=strtabsect.Data.firstblock;
-           while assigned(hp) do
-            begin
-              writer.write(hp^.data,hp^.used);
-              hp:=hp^.next;
-            end;
+           writesectiondata(strtabsect);
          { .rel sections }
-           for sec:=low(TSection) to high(TSection) do
-            if assigned(sects[sec]) and
-               assigned(telf32section(sects[sec]).relocsect) then
-             begin
-               telf32section(sects[sec]).relocsect.alignsection;
-               hp:=telf32section(sects[sec]).relocsect.Data.firstblock;
-               while assigned(hp) do
-                begin
-                  writer.write(hp^.data,hp^.used);
-                  hp:=hp^.next;
-                end;
-             end;
+           sects.foreach(@section_write_relocsec,nil);
          end;
         result:=true;
       end;
@@ -833,16 +894,10 @@ implementation
             asmbin : '';
             asmcmd : '';
             supported_target : system_any;  //target_i386_linux;
-            outputbinary : true;
-            allowdirect : false;
-            needar : false;
-            labelprefix_only_inside_procedure: false;
+//            flags : [af_outputbinary,af_smartlink_sections];
+            flags : [af_outputbinary];
             labelprefix : '.L';
             comment : '';
-            secnames : ('',
-              '.text','.data','.bss',
-              '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
-              '.stab','.stabstr','')
           );
 
 
@@ -851,7 +906,29 @@ initialization
 end.
 {
   $Log$
-  Revision 1.19  2003-04-22 14:33:38  peter
+  Revision 1.20  2004-06-16 20:07:09  florian
+    * dwarf branch merged
+
+  Revision 1.19.2.6  2004/05/18 20:14:18  peter
+    * no section smartlink when using debuginfo
+
+  Revision 1.19.2.5  2004/05/10 21:28:34  peter
+    * section_smartlink enabled for gas under linux
+
+  Revision 1.19.2.4  2004/05/01 16:02:09  peter
+    * POINTER_SIZE replaced with sizeof(aint)
+    * aint,aword,tconst*int moved to globtype
+
+  Revision 1.19.2.3  2004/04/26 21:01:36  peter
+    * aint fixes
+
+  Revision 1.19.2.2  2004/04/12 19:34:46  peter
+    * basic framework for dwarf CFI
+
+  Revision 1.19.2.1  2004/04/08 18:33:22  peter
+    * rewrite of TAsmSection
+
+  Revision 1.19  2003/04/22 14:33:38  peter
     * removed some notes/hints
 
   Revision 1.18  2002/08/12 15:08:39  carl

compiler/ogmap.pas

@@ -44,8 +44,8 @@ interface
          procedure AddCommonSymbolsHeader;
          procedure AddCommonSymbol(p:tasmsymbol);
          procedure AddMemoryMapHeader;
-         procedure AddMemoryMapSection(p:texesection);
-         procedure AddMemoryMapObjectData(p:TAsmObjectData;sec:TSection);
+         procedure AddMemoryMapExeSection(p:texesection);
+         procedure AddMemoryMapObjectSection(p:TAsmSection);
          procedure AddMemoryMapSymbol(p:tasmsymbol);
        end;
 
@@ -102,7 +102,7 @@ implementation
             writeln(t,p.name);
             s:='';
           end;
-         writeln(t,PadSpace(s,20)+'0x'+PadSpace(hexstr(p.size,1),16)+TAsmObjectData(p.objectdata).name);
+         writeln(t,PadSpace(s,20)+'0x'+PadSpace(hexstr(p.size,1),16)+p.owner.name);
        end;
 
 
@@ -114,18 +114,18 @@ implementation
        end;
 
 
-     procedure TExeMap.AddMemoryMapSection(p:texesection);
+     procedure TExeMap.AddMemoryMapExeSection(p:texesection);
        begin
          { .text           0x000018a8     0xd958 }
          writeln(t,PadSpace(p.name,18)+PadSpace('0x'+HexStr(p.mempos,8),15)+'0x'+HexStr(p.memsize,1));
        end;
 
 
-     procedure TExeMap.AddMemoryMapObjectData(p:TAsmObjectData;sec:TSection);
+     procedure TExeMap.AddMemoryMapObjectSection(p:TAsmSection);
        begin
          { .text           0x000018a8     0xd958     object.o }
-         writeln(t,' '+PadSpace(p.sects[sec].name,17)+PadSpace('0x'+HexStr(p.sects[sec].mempos,8),16)+
-                   '0x'+HexStr(p.sects[sec].memsize,1)+' '+p.name);
+         writeln(t,' '+PadSpace(p.name,17)+PadSpace('0x'+HexStr(p.mempos,8),16)+
+                   '0x'+HexStr(p.memsize,1)+' '+p.owner.name);
        end;
 
 
@@ -138,7 +138,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.2  2003-04-22 14:33:38  peter
+  Revision 1.3  2004-06-16 20:07:09  florian
+    * dwarf branch merged
+
+  Revision 1.2.2.1  2004/04/08 18:33:22  peter
+    * rewrite of TAsmSection
+
+  Revision 1.2  2003/04/22 14:33:38  peter
     * removed some notes/hints
 
   Revision 1.1  2002/07/01 18:46:24  peter