* first x86-64 patches

compiler/aasm.pas

@@ -0,0 +1,1103 @@
+{
+    $Id$
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    This unit implements an abstract asmoutput class for all processor types
+
+    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.
+
+ ****************************************************************************
+}
+{# @abstract(This unit implements an abstract asm output class for all processor types)
+  This unit implements an abstract assembler output class for all processors, these
+  are then overriden for each assembler writer to actually write the data in these
+  classes to an assembler file.
+}
+
+unit aasm;
+
+interface
+
+    uses
+       cutils,cclasses,
+       globtype,globals,systems;
+
+    type
+       tait = (
+          ait_none,
+          ait_direct,
+          ait_string,
+          ait_label,
+          ait_comment,
+          ait_instruction,
+          ait_datablock,
+          ait_symbol,
+          ait_symbol_end, { needed to calc the size of a symbol }
+          ait_const_32bit,
+          ait_const_16bit,
+          ait_const_8bit,
+          ait_const_symbol,
+          ait_real_80bit,
+          ait_real_64bit,
+          ait_real_32bit,
+          ait_comp_64bit,
+          ait_align,
+          ait_section,
+          { 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_stabn,
+          ait_stabs,
+          ait_force_line,
+          ait_stab_function_name,
+          ait_cut, { used to split into tiny assembler files }
+          ait_regalloc, { for register,temp allocation debugging }
+          ait_tempalloc,
+          ait_marker,
+{$ifdef alpha}
+          { the follow is for the DEC Alpha }
+          ait_frame,
+          ait_ent,
+{$endif alpha}
+{$ifdef m68k}
+          ait_labeled_instruction,
+{$endif m68k}
+{$ifdef ia64}
+          ait_bundle,
+          ait_stop,
+{$endif ia64}
+{$ifdef SPARC}
+          ait_labeled_instruction,
+{$endif SPARC}
+          { never used, makes insertation of new ait_ easier to type }
+          { lazy guy !!!! ;-) (FK) }
+          ait_dummy);
+
+
+{ ait_* types which don't result in executable code or which don't influence   }
+{ the way the program runs/behaves, but which may be encountered by the        }
+{ optimizer (= if it's sometimes added to the exprasm list). Update if you add }
+{ a new ait type!                                                              }
+    const
+      SkipInstr = [ait_comment, ait_symbol,ait_force_line,ait_section
+{$ifdef GDB}
+                   ,ait_stabs, ait_stabn, ait_stab_function_name
+{$endif GDB}
+                   ,ait_regalloc, ait_tempalloc, ait_symbol_end
+  ];
+
+
+  { asm symbol functions }
+    type
+       TAsmsymbind=(AB_NONE,AB_EXTERNAL,AB_COMMON,AB_LOCAL,AB_GLOBAL);
+
+       TAsmsymtype=(AT_NONE,AT_FUNCTION,AT_DATA,AT_SECTION);
+
+       tasmsymbol = class(TNamedIndexItem)
+         defbind,
+         bind      : TAsmsymbind;
+         typ       : TAsmsymtype;
+         { the next fields are filled in the binary writer }
+         section : tsection;
+         idx     : longint;
+         address,
+         size    : longint;
+         { this need to be incremented with every symbol loading into the
+           paasmoutput, thus in loadsym/loadref/const_symbol (PFV) }
+         refs    : longint;
+         {# Alternate symbol which can be used for 'renaming' needed for
+           inlining }
+         altsymbol : tasmsymbol;
+         {# TRUE if the symbol is local for a procedure/function }
+         proclocal : boolean;
+         {# Is the symbol in the used list }
+         inusedlist : boolean;
+         { assembler pass label is set, used for detecting multiple labels }
+         pass : byte;
+         constructor create(const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype);
+         procedure reset;
+         function  is_used:boolean;
+         procedure setaddress(_pass:byte;sec:tsection;offset,len:longint);
+         procedure GenerateAltSymbol;
+       end;
+
+       tasmlabel = class(tasmsymbol)
+         { this is set by the tai_label.Init }
+         is_set,
+         { is the label only there for getting an address (e.g. for i/o }
+         { checks -> true) or is it a jump target (false)               }
+         is_addr : boolean;
+         labelnr : longint;
+         constructor create;
+         constructor createdata;
+         constructor createaddr;
+         function getname:string;override;
+       end;
+
+
+       { the short name makes typing easier }
+       tai = class(tlinkedlistitem)
+          { pointer to record with optimizer info about this tai object }
+          optinfo  : pointer;
+          fileinfo : tfileposinfo;
+          typ      : tait;
+          constructor Create;
+       end;
+
+       tai_string = class(tai)
+          str : pchar;
+          { extra len so the string can contain an \0 }
+          len : longint;
+          constructor Create(const _str : string);
+          constructor Create_pchar(_str : pchar);
+          constructor Create_length_pchar(_str : pchar;length : longint);
+          destructor Destroy;override;
+       end;
+
+       { generates a common label }
+       tai_symbol = class(tai)
+          is_global : boolean;
+          sym : tasmsymbol;
+          size : longint;
+          constructor Create(_sym:tasmsymbol;siz:longint);
+          constructor Createname(const _name : string;siz:longint);
+          constructor Createname_global(const _name : string;siz:longint);
+          constructor Createdataname(const _name : string;siz:longint);
+          constructor Createdataname_global(const _name : string;siz:longint);
+       end;
+
+       tai_symbol_end = class(tai)
+          sym : tasmsymbol;
+          constructor Create(_sym:tasmsymbol);
+          constructor Createname(const _name : string);
+       end;
+
+       tai_label = class(tai)
+          is_global : boolean;
+          l : tasmlabel;
+          constructor Create(_l : tasmlabel);
+       end;
+
+       tai_direct = class(tai)
+          str : pchar;
+          constructor Create(_str : pchar);
+          destructor Destroy; override;
+       end;
+
+       { to insert a comment into the generated assembler file }
+       tai_asm_comment = class(tai)
+          str : pchar;
+          constructor Create(_str : pchar);
+          destructor Destroy; override;
+       end;
+
+
+       { Insert a section/segment directive }
+       tai_section = class(tai)
+          sec : tsection;
+          constructor Create(s : tsection);
+       end;
+
+
+       { generates an uninitializised data block }
+       tai_datablock = class(tai)
+          is_global : boolean;
+          sym  : tasmsymbol;
+          size : longint;
+          constructor Create(const _name : string;_size : longint);
+          constructor Create_global(const _name : string;_size : longint);
+       end;
+
+
+       { generates a long integer (32 bit) }
+       tai_const = class(tai)
+          value : longint;
+          constructor Create_32bit(_value : longint);
+          constructor Create_16bit(_value : word);
+          constructor Create_8bit(_value : byte);
+       end;
+
+       tai_const_symbol = class(tai)
+          sym    : tasmsymbol;
+          offset : longint;
+          constructor Create(_sym:tasmsymbol);
+          constructor Create_offset(_sym:tasmsymbol;ofs:longint);
+          constructor Create_rva(_sym:tasmsymbol);
+          constructor Createname(const name:string);
+          constructor Createname_offset(const name:string;ofs:longint);
+          constructor Createname_rva(const name:string);
+       end;
+
+       { generates a single (32 bit real) }
+       tai_real_32bit = class(tai)
+          value : ts32real;
+          constructor Create(_value : ts32real);
+       end;
+
+       { generates a double (64 bit real) }
+       tai_real_64bit = class(tai)
+          value : ts64real;
+          constructor Create(_value : ts64real);
+       end;
+
+       { generates an extended (80 bit real) }
+       tai_real_80bit = class(tai)
+          value : ts80real;
+          constructor Create(_value : ts80real);
+       end;
+
+       { generates an comp (integer over 64 bits) }
+       tai_comp_64bit = class(tai)
+          value : ts64comp;
+          constructor Create(_value : ts64comp);
+       end;
+
+       { insert a cut to split into several smaller files }
+
+       tcutplace=(cut_normal,cut_begin,cut_end);
+
+       tai_cut = class(tai)
+          place : tcutplace;
+          constructor Create;
+          constructor Create_begin;
+          constructor Create_end;
+       end;
+
+       TMarker = (NoPropInfoStart, NoPropInfoEnd,
+         AsmBlockStart, AsmBlockEnd,
+         InlineStart,InlineEnd
+       );
+
+       tai_marker = class(tai)
+         Kind: TMarker;
+         Constructor Create(_Kind: TMarker);
+       end;
+
+       taitempalloc = class(tai)
+          allocation : boolean;
+          temppos,
+          tempsize   : longint;
+          constructor alloc(pos,size:longint);
+          constructor dealloc(pos,size:longint);
+       end;
+
+{ for each processor define the best precision }
+{ bestreal is defined in globals }
+{$ifdef x86}
+const
+       ait_bestreal = ait_real_80bit;
+type
+       tai_bestreal = tai_real_80bit;
+{$endif x86}
+{$ifdef m68k}
+const
+       ait_bestreal = ait_real_32bit;
+type
+       tai_bestreal = tai_real_32bit;
+{$endif m68k}
+
+       taasmoutput = class(tlinkedlist)
+         function getlasttaifilepos : pfileposinfo;
+       end;
+
+    const
+    { maximum of aasmoutput lists there will be }
+      maxoutputlists = 10;
+
+    var
+    { temporary lists }
+      exprasmlist,
+    { default lists }
+      datasegment,codesegment,bsssegment,
+      debuglist,withdebuglist,consts,
+      importssection,exportssection,
+      resourcesection,rttilist,
+      resourcestringlist         : taasmoutput;
+    { asm symbol list }
+      asmsymbollist : tdictionary;
+      usedasmsymbollist : tsinglelist;
+
+    const
+      nextaltnr   : longint = 1;
+      nextlabelnr : longint = 1;
+      countlabelref : boolean = true;
+
+    {# create a new assembler label }
+    procedure getlabel(var l : tasmlabel);
+    { make l as a new label and flag is_addr }
+    procedure getaddrlabel(var l : tasmlabel);
+    { make l as a new label and flag is_data }
+    procedure getdatalabel(var l : tasmlabel);
+    {# return a label number }
+    procedure getlabelnr(var l : longint);
+
+    function  newasmsymbol(const s : string) : tasmsymbol;
+    function  newasmsymboltype(const s : string;_bind:TAsmSymBind;_typ:TAsmsymtype) : tasmsymbol;
+    function  getasmsymbol(const s : string) : tasmsymbol;
+    function  renameasmsymbol(const sold, snew : string):tasmsymbol;
+
+    procedure CreateUsedAsmSymbolList;
+    procedure DestroyUsedAsmSymbolList;
+    procedure UsedAsmSymbolListInsert(p:tasmsymbol);
+    procedure UsedAsmSymbolListReset;
+    procedure UsedAsmSymbolListResetAltSym;
+    procedure UsedAsmSymbolListCheckUndefined;
+
+
+implementation
+
+uses
+{$ifdef delphi}
+  sysutils,
+{$else}
+  strings,
+{$endif}
+  fmodule,verbose;
+
+{****************************************************************************
+                             TAI
+ ****************************************************************************}
+
+    constructor tai.Create;
+      begin
+        optinfo := nil;
+        fileinfo:=aktfilepos;
+      end;
+
+{****************************************************************************
+                             TAI_SECTION
+ ****************************************************************************}
+
+    constructor tai_section.Create(s : tsection);
+      begin
+         inherited Create;
+         typ:=ait_section;
+         sec:=s;
+      end;
+
+
+{****************************************************************************
+                             TAI_DATABLOCK
+ ****************************************************************************}
+
+    constructor tai_datablock.Create(const _name : string;_size : longint);
+
+      begin
+         inherited Create;
+         typ:=ait_datablock;
+         sym:=newasmsymboltype(_name,AB_LOCAL,AT_DATA);
+         { keep things aligned }
+         if _size<=0 then
+           _size:=4;
+         size:=_size;
+         is_global:=false;
+      end;
+
+
+    constructor tai_datablock.Create_global(const _name : string;_size : longint);
+      begin
+         inherited Create;
+         typ:=ait_datablock;
+         sym:=newasmsymboltype(_name,AB_GLOBAL,AT_DATA);
+         { keep things aligned }
+         if _size<=0 then
+           _size:=4;
+         size:=_size;
+         is_global:=true;
+      end;
+
+
+{****************************************************************************
+                               TAI_SYMBOL
+ ****************************************************************************}
+
+    constructor tai_symbol.Create(_sym:tasmsymbol;siz:longint);
+      begin
+         inherited Create;
+         typ:=ait_symbol;
+         sym:=_sym;
+         size:=siz;
+         is_global:=(sym.defbind=AB_GLOBAL);
+      end;
+
+    constructor tai_symbol.Createname(const _name : string;siz:longint);
+      begin
+         inherited Create;
+         typ:=ait_symbol;
+         sym:=newasmsymboltype(_name,AB_LOCAL,AT_FUNCTION);
+         size:=siz;
+         is_global:=false;
+      end;
+
+    constructor tai_symbol.Createname_global(const _name : string;siz:longint);
+      begin
+         inherited Create;
+         typ:=ait_symbol;
+         sym:=newasmsymboltype(_name,AB_GLOBAL,AT_FUNCTION);
+         size:=siz;
+         is_global:=true;
+      end;
+
+    constructor tai_symbol.Createdataname(const _name : string;siz:longint);
+      begin
+         inherited Create;
+         typ:=ait_symbol;
+         sym:=newasmsymboltype(_name,AB_LOCAL,AT_DATA);
+         size:=siz;
+         is_global:=false;
+      end;
+
+    constructor tai_symbol.Createdataname_global(const _name : string;siz:longint);
+      begin
+         inherited Create;
+         typ:=ait_symbol;
+         sym:=newasmsymboltype(_name,AB_GLOBAL,AT_DATA);
+         size:=siz;
+         is_global:=true;
+      end;
+
+
+{****************************************************************************
+                               TAI_SYMBOL
+ ****************************************************************************}
+
+    constructor tai_symbol_end.Create(_sym:tasmsymbol);
+      begin
+         inherited Create;
+         typ:=ait_symbol_end;
+         sym:=_sym;
+      end;
+
+    constructor tai_symbol_end.Createname(const _name : string);
+      begin
+         inherited Create;
+         typ:=ait_symbol_end;
+         sym:=newasmsymboltype(_name,AB_GLOBAL,AT_NONE);
+      end;
+
+
+{****************************************************************************
+                               TAI_CONST
+ ****************************************************************************}
+
+    constructor tai_const.Create_32bit(_value : longint);
+
+      begin
+         inherited Create;
+         typ:=ait_const_32bit;
+         value:=_value;
+      end;
+
+    constructor tai_const.Create_16bit(_value : word);
+
+      begin
+         inherited Create;
+         typ:=ait_const_16bit;
+         value:=_value;
+      end;
+
+    constructor tai_const.Create_8bit(_value : byte);
+
+      begin
+         inherited Create;
+         typ:=ait_const_8bit;
+         value:=_value;
+      end;
+
+
+{****************************************************************************
+                               TAI_CONST_SYMBOL_OFFSET
+ ****************************************************************************}
+
+    constructor tai_const_symbol.Create(_sym:tasmsymbol);
+      begin
+         inherited Create;
+         typ:=ait_const_symbol;
+         sym:=_sym;
+         offset:=0;
+         { update sym info }
+         inc(sym.refs);
+      end;
+
+    constructor tai_const_symbol.Create_offset(_sym:tasmsymbol;ofs:longint);
+      begin
+         inherited Create;
+         typ:=ait_const_symbol;
+         sym:=_sym;
+         offset:=ofs;
+         { update sym info }
+         inc(sym.refs);
+      end;
+
+    constructor tai_const_symbol.Create_rva(_sym:tasmsymbol);
+      begin
+         inherited Create;
+         typ:=ait_const_rva;
+         sym:=_sym;
+         offset:=0;
+         { update sym info }
+         inc(sym.refs);
+      end;
+
+    constructor tai_const_symbol.Createname(const name:string);
+      begin
+         inherited Create;
+         typ:=ait_const_symbol;
+         sym:=newasmsymbol(name);
+         offset:=0;
+         { update sym info }
+         inc(sym.refs);
+      end;
+
+    constructor tai_const_symbol.Createname_offset(const name:string;ofs:longint);
+      begin
+         inherited Create;
+         typ:=ait_const_symbol;
+         sym:=newasmsymbol(name);
+         offset:=ofs;
+         { update sym info }
+         inc(sym.refs);
+      end;
+
+    constructor tai_const_symbol.Createname_rva(const name:string);
+      begin
+         inherited Create;
+         typ:=ait_const_rva;
+         sym:=newasmsymbol(name);
+         offset:=0;
+         { update sym info }
+         inc(sym.refs);
+      end;
+
+
+{****************************************************************************
+                               TAI_real_32bit
+ ****************************************************************************}
+
+    constructor tai_real_32bit.Create(_value : ts32real);
+
+      begin
+         inherited Create;
+         typ:=ait_real_32bit;
+         value:=_value;
+      end;
+
+{****************************************************************************
+                               TAI_real_64bit
+ ****************************************************************************}
+
+    constructor tai_real_64bit.Create(_value : ts64real);
+
+      begin
+         inherited Create;
+         typ:=ait_real_64bit;
+         value:=_value;
+      end;
+
+{****************************************************************************
+                               TAI_real_80bit
+ ****************************************************************************}
+
+    constructor tai_real_80bit.Create(_value : ts80real);
+
+      begin
+         inherited Create;
+         typ:=ait_real_80bit;
+         value:=_value;
+      end;
+
+{****************************************************************************
+                               Tai_comp_64bit
+ ****************************************************************************}
+
+    constructor tai_comp_64bit.Create(_value : ts64comp);
+
+      begin
+         inherited Create;
+         typ:=ait_comp_64bit;
+         value:=_value;
+      end;
+
+
+{****************************************************************************
+                               TAI_STRING
+ ****************************************************************************}
+
+     constructor tai_string.Create(const _str : string);
+
+       begin
+          inherited Create;
+          typ:=ait_string;
+          getmem(str,length(_str)+1);
+          strpcopy(str,_str);
+          len:=length(_str);
+       end;
+
+     constructor tai_string.Create_pchar(_str : pchar);
+
+       begin
+          inherited Create;
+          typ:=ait_string;
+          str:=_str;
+          len:=strlen(_str);
+       end;
+
+    constructor tai_string.Create_length_pchar(_str : pchar;length : longint);
+
+       begin
+          inherited Create;
+          typ:=ait_string;
+          str:=_str;
+          len:=length;
+       end;
+
+    destructor tai_string.destroy;
+
+      begin
+         { you can have #0 inside the strings so }
+         if str<>nil then
+           freemem(str,len+1);
+         inherited Destroy;
+      end;
+
+
+{****************************************************************************
+                               TAI_LABEL
+ ****************************************************************************}
+
+    constructor tai_label.create(_l : tasmlabel);
+      begin
+        inherited Create;
+        typ:=ait_label;
+        l:=_l;
+        l.is_set:=true;
+        is_global:=(l.defbind=AB_GLOBAL);
+      end;
+
+
+{****************************************************************************
+                              TAI_DIRECT
+ ****************************************************************************}
+
+     constructor tai_direct.Create(_str : pchar);
+
+       begin
+          inherited Create;
+          typ:=ait_direct;
+          str:=_str;
+       end;
+
+    destructor tai_direct.destroy;
+
+      begin
+         strdispose(str);
+         inherited Destroy;
+      end;
+
+{****************************************************************************
+          TAI_ASM_COMMENT  comment to be inserted in the assembler file
+ ****************************************************************************}
+
+     constructor tai_asm_comment.Create(_str : pchar);
+
+       begin
+          inherited Create;
+          typ:=ait_comment;
+          str:=_str;
+       end;
+
+    destructor tai_asm_comment.destroy;
+
+      begin
+         strdispose(str);
+         inherited Destroy;
+      end;
+
+{****************************************************************************
+                              TAI_CUT
+ ****************************************************************************}
+
+     constructor tai_cut.Create;
+       begin
+          inherited Create;
+          typ:=ait_cut;
+          place:=cut_normal;
+       end;
+
+
+     constructor tai_cut.Create_begin;
+       begin
+          inherited Create;
+          typ:=ait_cut;
+          place:=cut_begin;
+       end;
+
+
+     constructor tai_cut.Create_end;
+       begin
+          inherited Create;
+          typ:=ait_cut;
+          place:=cut_end;
+       end;
+
+
+{****************************************************************************
+                             Tai_Marker
+ ****************************************************************************}
+
+     Constructor Tai_Marker.Create(_Kind: TMarker);
+     Begin
+       Inherited Create;
+       typ := ait_marker;
+       Kind := _Kind;
+     End;
+
+{*****************************************************************************
+                                TaiTempAlloc
+*****************************************************************************}
+
+    constructor taitempalloc.alloc(pos,size:longint);
+      begin
+        inherited Create;
+        typ:=ait_tempalloc;
+        allocation:=true;
+        temppos:=pos;
+        tempsize:=size;
+      end;
+
+
+    constructor taitempalloc.dealloc(pos,size:longint);
+      begin
+        inherited Create;
+        typ:=ait_tempalloc;
+        allocation:=false;
+        temppos:=pos;
+        tempsize:=size;
+      end;
+
+
+
+{*****************************************************************************
+                                  AsmSymbol
+*****************************************************************************}
+
+    constructor tasmsymbol.create(const s:string;_bind:TAsmsymbind;_typ:Tasmsymtype);
+      begin;
+        inherited createname(s);
+        reset;
+        defbind:=_bind;
+        typ:=_typ;
+        inusedlist:=false;
+        pass:=255;
+        { mainly used to remove unused labels from the codesegment }
+        refs:=0;
+      end;
+
+    procedure tasmsymbol.GenerateAltSymbol;
+      begin
+        if not assigned(altsymbol) then
+         begin
+           altsymbol:=tasmsymbol.create(name+'_'+tostr(nextaltnr),defbind,typ);
+           { also copy the amount of references }
+           altsymbol.refs:=refs;
+           inc(nextaltnr);
+         end;
+      end;
+
+    procedure tasmsymbol.reset;
+      begin
+        { reset section info }
+        section:=sec_none;
+        address:=0;
+        size:=0;
+        idx:=-1;
+        pass:=255;
+        bind:=AB_EXTERNAL;
+        proclocal:=false;
+      end;
+
+    function tasmsymbol.is_used:boolean;
+      begin
+        is_used:=(refs>0);
+      end;
+
+    procedure tasmsymbol.setaddress(_pass:byte;sec:tsection;offset,len:longint);
+      begin
+        if (_pass=pass) then
+         begin
+           Message1(asmw_e_duplicate_label,name);
+           exit;
+         end;
+        pass:=_pass;
+        section:=sec;
+        address:=offset;
+        size:=len;
+        { when the bind was reset to External, set it back to the default
+          bind it got when defined }
+        if (bind=AB_EXTERNAL) and (defbind<>AB_NONE) then
+         bind:=defbind;
+      end;
+
+
+{*****************************************************************************
+                                  AsmLabel
+*****************************************************************************}
+
+    constructor tasmlabel.create;
+      begin;
+        labelnr:=nextlabelnr;
+        inc(nextlabelnr);
+        inherited create(target_asm.labelprefix+tostr(labelnr),AB_LOCAL,AT_FUNCTION);
+        proclocal:=true;
+        is_set:=false;
+        is_addr := false;
+      end;
+
+
+    constructor tasmlabel.createdata;
+      begin;
+        labelnr:=nextlabelnr;
+        inc(nextlabelnr);
+        if (cs_create_smart in aktmoduleswitches) or
+           target_asm.labelprefix_only_inside_procedure then
+          inherited create('_$'+current_module.modulename^+'$_L'+tostr(labelnr),AB_GLOBAL,AT_DATA)
+        else
+          inherited create(target_asm.labelprefix+tostr(labelnr),AB_LOCAL,AT_DATA);
+        is_set:=false;
+        is_addr := false;
+        { write it always }
+        refs:=1;
+      end;
+
+    constructor tasmlabel.createaddr;
+      begin;
+        create;
+        is_addr := true;
+      end;
+
+    function tasmlabel.getname:string;
+      begin
+        getname:=inherited getname;
+        inc(refs);
+      end;
+
+
+{*****************************************************************************
+                              AsmSymbolList helpers
+*****************************************************************************}
+
+    function newasmsymbol(const s : string) : tasmsymbol;
+      var
+        hp : tasmsymbol;
+      begin
+        hp:=tasmsymbol(asmsymbollist.search(s));
+        if not assigned(hp) then
+         begin
+           { Not found, insert it as an External }
+           hp:=tasmsymbol.create(s,AB_EXTERNAL,AT_FUNCTION);
+           asmsymbollist.insert(hp);
+         end;
+        newasmsymbol:=hp;
+      end;
+
+
+    function newasmsymboltype(const s : string;_bind:TAsmSymBind;_typ:Tasmsymtype) : tasmsymbol;
+      var
+        hp : tasmsymbol;
+      begin
+        hp:=tasmsymbol(asmsymbollist.search(s));
+        if assigned(hp) then
+         hp.defbind:=_bind
+        else
+         begin
+           { Not found, insert it as an External }
+           hp:=tasmsymbol.create(s,_bind,_typ);
+           asmsymbollist.insert(hp);
+         end;
+        newasmsymboltype:=hp;
+      end;
+
+
+    function getasmsymbol(const s : string) : tasmsymbol;
+      begin
+        getasmsymbol:=tasmsymbol(asmsymbollist.search(s));
+      end;
+
+
+    { renames an asmsymbol }
+    function renameasmsymbol(const sold, snew : string):tasmsymbol;
+      begin
+        renameasmsymbol:=tasmsymbol(asmsymbollist.rename(sold,snew));
+      end;
+
+
+{*****************************************************************************
+                              Used AsmSymbolList
+*****************************************************************************}
+
+    procedure CreateUsedAsmSymbolList;
+      begin
+        if assigned(usedasmsymbollist) then
+         internalerror(78455782);
+        usedasmsymbollist:=TSingleList.create;
+      end;
+
+
+    procedure DestroyUsedAsmSymbolList;
+      begin
+        usedasmsymbollist.destroy;
+        usedasmsymbollist:=nil;
+      end;
+
+
+    procedure UsedAsmSymbolListInsert(p:tasmsymbol);
+      begin
+        if not p.inusedlist then
+         usedasmsymbollist.insert(p);
+        p.inusedlist:=true;
+      end;
+
+
+    procedure UsedAsmSymbolListReset;
+      var
+        hp : tasmsymbol;
+      begin
+        hp:=tasmsymbol(usedasmsymbollist.first);
+        while assigned(hp) do
+         begin
+           with hp do
+            begin
+              reset;
+              inusedlist:=false;
+            end;
+           hp:=tasmsymbol(hp.listnext);
+         end;
+      end;
+
+
+    procedure UsedAsmSymbolListResetAltSym;
+      var
+        hp : tasmsymbol;
+      begin
+        hp:=tasmsymbol(usedasmsymbollist.first);
+        while assigned(hp) do
+         begin
+           with hp do
+            begin
+              altsymbol:=nil;
+              inusedlist:=false;
+            end;
+           hp:=tasmsymbol(hp.listnext);
+         end;
+      end;
+
+
+    procedure UsedAsmSymbolListCheckUndefined;
+      var
+        hp : tasmsymbol;
+      begin
+        hp:=tasmsymbol(usedasmsymbollist.first);
+        while assigned(hp) do
+         begin
+           with hp do
+            begin
+              if (refs>0) and
+                 (section=Sec_none) and
+                 not(bind in [AB_EXTERNAL,AB_COMMON]) then
+               Message1(asmw_e_undefined_label,name);
+            end;
+           hp:=tasmsymbol(hp.listnext);
+         end;
+      end;
+
+
+{*****************************************************************************
+                              Label Helpers
+*****************************************************************************}
+
+    procedure getlabel(var l : tasmlabel);
+      begin
+        l:=tasmlabel.create;
+        asmsymbollist.insert(l);
+      end;
+
+
+    procedure getdatalabel(var l : tasmlabel);
+      begin
+        l:=tasmlabel.createdata;
+        asmsymbollist.insert(l);
+      end;
+
+    procedure getaddrlabel(var l : tasmlabel);
+      begin
+        l:=tasmlabel.createaddr;
+        asmsymbollist.insert(l);
+      end;
+
+    procedure getlabelnr(var l : longint);
+      begin
+         l:=nextlabelnr;
+         inc(nextlabelnr);
+      end;
+
+
+{*****************************************************************************
+                                 TAAsmOutput
+*****************************************************************************}
+
+    function taasmoutput.getlasttaifilepos : pfileposinfo;
+      begin
+         if assigned(last) then
+           getlasttaifilepos:=@tai(last).fileinfo
+         else
+           getlasttaifilepos:=nil;
+      end;
+
+end.
+{
+  $Log$
+  Revision 1.29  2002-07-04 20:43:00  florian
+    * first x86-64 patches
+
+  Revision 1.28  2002/07/01 18:46:20  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.27  2002/05/18 13:34:04  peter
+    * readded missing revisions
+
+  Revision 1.25  2002/05/14 19:34:38  peter
+    * removed old logs and updated copyright year
+
+  Revision 1.24  2002/05/14 17:28:08  peter
+    * synchronized cpubase between powerpc and i386
+    * moved more tables from cpubase to cpuasm
+    * tai_align_abstract moved to tainst, cpuasm must define
+      the tai_align class now, which may be empty
+
+  Revision 1.23  2002/04/15 18:54:34  carl
+  - removed tcpuflags
+
+  Revision 1.22  2002/04/07 13:18:19  carl
+  + more documentation
+
+  Revision 1.21  2002/04/07 10:17:40  carl
+  - remove packenumfixed (requires version 1.0.2 or later to compile now!)
+  + changing some comments so its commented automatically
+
+  Revision 1.20  2002/03/24 19:04:31  carl
+  + patch for SPARC from Mazen NEIFER
+
+}

compiler/globtype.pas

@@ -30,7 +30,7 @@ interface
 
     type
        { System independent float names }
-{$ifdef i386}
+{$ifdef x86}
        bestreal = extended;
        ts32real = single;
        ts64real = double;
@@ -255,7 +255,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.27  2002-07-01 18:46:22  peter
+  Revision 1.28  2002-07-04 20:43:00  florian
+    * first x86-64 patches
+
+  Revision 1.27  2002/07/01 18:46:22  peter
     * internal linker
     * reorganized aasm layer
 
@@ -299,4 +302,4 @@ end.
    * implicit result variable generation for assembler routines
    * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
 
-}
+}

compiler/i386/tgcpu.pas

@@ -0,0 +1,791 @@
+{
+    $Id$
+    Copyright (C) 1998-2000 by Florian Klaempfl
+
+    This unit handles the temporary variables stuff for i386
+
+    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 tgcpu;
+
+{$i defines.inc}
+
+interface
+
+    uses
+       globals,
+       cgbase,verbose,aasm,
+       node,
+       cpubase,cpuasm
+       ;
+
+    type
+       tregisterset = set of tregister;
+
+       tpushed = array[R_EAX..R_MM6] of boolean;
+       tsaved = array[R_EAX..R_MM6] of longint;
+
+    const
+       usablereg32 : byte = 4;
+
+       { this value is used in tsaved, if the register isn't saved }
+       reg_not_saved = $7fffffff;
+{$ifdef SUPPORT_MMX}
+       usableregmmx : byte = 8;
+{$endif SUPPORT_MMX}
+
+    var
+       { tries to hold the amount of times which the current tree is processed  }
+       t_times : longint;
+
+{$ifdef TEMPREGDEBUG}
+    procedure testregisters32;
+{$endif TEMPREGDEBUG}
+    function getregisterint : tregister;
+    function getaddressregister: tregister;
+    procedure ungetregister32(r : tregister);
+    { tries to allocate the passed register, if possible }
+    function getexplicitregister32(r : tregister) : tregister;
+{$ifdef SUPPORT_MMX}
+    function getregistermmx : tregister;
+    procedure ungetregistermmx(r : tregister);
+{$endif SUPPORT_MMX}
+
+    function isaddressregister(reg: tregister): boolean;
+
+    procedure ungetregister(r : tregister);
+
+    procedure cleartempgen;
+    procedure del_reference(const ref : treference);
+    procedure del_locref(const location : tlocation);
+    procedure del_location(const l : tlocation);
+
+    { pushs and restores registers }
+    procedure pushusedregisters(var pushed : tpushed;b : tregisterset);
+    procedure popusedregisters(const pushed : tpushed);
+
+    { saves register variables (restoring happens automatically (JM) }
+    procedure saveregvars(b : tregisterset);
+
+    { saves and restores used registers to temp. values }
+    procedure saveusedregisters(var saved : tsaved;b : tregisterset);
+    procedure restoreusedregisters(const saved : tsaved);
+
+    { increments the push count of all registers in b}
+    procedure incrementregisterpushed(b : tregisterset);
+
+    procedure clearregistercount;
+    procedure resetusableregisters;
+
+    { corrects the fpu stack register by ofs }
+    function correct_fpuregister(r : tregister;ofs : byte) : tregister;
+
+    type
+{$ifdef SUPPORT_MMX}
+       regvar_longintarray = array[R_EAX..R_MM6] of longint;
+       regvar_booleanarray = array[R_EAX..R_MM6] of boolean;
+       regvar_ptreearray = array[R_EAX..R_MM6] of tnode;
+{$else SUPPORT_MMX}
+       regvar_longintarray = array[R_EAX..R_EDI] of longint;
+       regvar_booleanarray = array[R_EAX..R_EDI] of boolean;
+       regvar_ptreearray = array[R_EAX..R_EDI] of tnode;
+{$endif SUPPORT_MMX}
+
+    var
+       unused,usableregs : tregisterset;
+       c_usableregs : longint;
+
+       { uses only 1 byte while a set uses in FPC 32 bytes }
+       usedinproc : tregisterset;
+
+       fpuvaroffset : byte;
+
+       { count, how much a register must be pushed if it is used as register }
+       { variable                                                           }
+       reg_pushes : regvar_longintarray;
+       is_reg_var : regvar_booleanarray;
+       regvar_loaded: regvar_booleanarray;
+
+{$ifdef TEMPREGDEBUG}
+       reg_user   : regvar_ptreearray;
+       reg_releaser : regvar_ptreearray;
+{$endif TEMPREGDEBUG}
+
+
+implementation
+
+    uses
+      globtype,temp_gen,tainst,regvars;
+
+    procedure incrementregisterpushed(b : tregisterset);
+
+      var
+         regi : tregister;
+
+      begin
+         for regi:=R_EAX to R_EDI do
+           begin
+              if regi in b then
+                inc(reg_pushes[regi],t_times*2);
+           end;
+      end;
+
+    procedure pushusedregisters(var pushed : tpushed;b : tregisterset);
+
+      var
+         r : tregister;
+{$ifdef SUPPORT_MMX}
+         hr : preference;
+{$endif}
+      begin
+         usedinproc:=usedinproc+b;
+         for r:=R_EAX to R_EBX do
+           begin
+              pushed[r]:=false;
+              { if the register is used by the calling subroutine    }
+              if r in b then
+                begin
+                  { and is present in use }
+                  if not is_reg_var[r] then
+                    if not(r in unused) then
+                     begin
+                        { then save it }
+                        exprasmlist.concat(Taicpu.Op_reg(A_PUSH,S_L,r));
+
+                        { here was a big problem  !!!!!}
+                        { you cannot do that for a register that is
+                        globally assigned to a var
+                        this also means that you must push it much more
+                        often, but there must be a better way
+                        maybe by putting the value back to the stack !! }
+                        if not(is_reg_var[r]) then
+                          begin
+                            unused:=unused+[r];
+{$ifdef TEMPREGDEBUG}
+                            inc(usablereg32);
+{$endif TEMPREGDEBUG}
+                          end;
+                        pushed[r]:=true;
+                     end;
+                end;
+           end;
+{$ifdef SUPPORT_MMX}
+         for r:=R_MM0 to R_MM6 do
+           begin
+              pushed[r]:=false;
+              { if the mmx register is in use, save it }
+              if not(r in unused) then
+                begin
+                   exprasmList.concat(Taicpu.Op_const_reg(A_SUB,S_L,8,R_ESP));
+                   new(hr);
+                   reset_reference(hr^);
+                   hr^.base:=R_ESP;
+                   exprasmList.concat(Taicpu.Op_reg_ref(A_MOVQ,S_NO,r,hr));
+                   if not(is_reg_var[r]) then
+                     begin
+                       unused:=unused+[r];
+{$ifdef TEMPREGDEBUG}
+                       inc(usableregmmx);
+{$endif TEMPREGDEBUG}
+                     end;
+                   pushed[r]:=true;
+                end;
+           end;
+{$endif SUPPORT_MMX}
+{$ifdef TEMPREGDEBUG}
+        testregisters32;
+{$endif TEMPREGDEBUG}
+      end;
+
+
+    procedure saveregvars(b : tregisterset);
+
+      var
+         r : tregister;
+
+      begin
+         if not(cs_regalloc in aktglobalswitches) then
+           exit;
+         for r:=R_EAX to R_EBX do
+           { if the register is used by the calling subroutine    }
+           if (r in b) and is_reg_var[r] then
+             store_regvar(exprasmlist,r)
+      end;
+
+
+    procedure saveusedregisters(var saved : tsaved;b : tregisterset);
+
+      var
+         r : tregister;
+         hr : treference;
+
+      begin
+         usedinproc:=usedinproc+b;
+         for r:=R_EAX to R_EBX do
+           begin
+              saved[r]:=reg_not_saved;
+              { if the register is used by the calling subroutine    }
+              if r in b then
+                begin
+                   { and is present in use }
+                   if not(r in unused) then
+                     begin
+                        { then save it }
+                        gettempofsizereference(4,hr);
+                        saved[r]:=hr.offset;
+                        exprasmList.concat(Taicpu.Op_reg_ref(A_MOV,S_L,r,newreference(hr)));
+                        { here was a big problem  !!!!!}
+                        { you cannot do that for a register that is
+                        globally assigned to a var
+                        this also means that you must push it much more
+                        often, but there must be a better way
+                        maybe by putting the value back to the stack !! }
+                        if not(is_reg_var[r]) then
+                          begin
+                            unused:=unused+[r];
+{$ifdef TEMPREGDEBUG}
+                            inc(usablereg32);
+{$endif TEMPREGDEBUG}
+                          end;
+                     end;
+                end;
+           end;
+{$ifdef SUPPORT_MMX}
+         for r:=R_MM0 to R_MM6 do
+           begin
+              saved[r]:=reg_not_saved;
+              { if the mmx register is in use, save it }
+              if not(r in unused) then
+                begin
+                   gettempofsizereference(8,hr);
+                   exprasmList.concat(Taicpu.Op_reg_ref(A_MOVQ,S_NO,r,newreference(hr)));
+                   if not(is_reg_var[r]) then
+                     begin
+                       unused:=unused+[r];
+{$ifdef TEMPREGDEBUG}
+                       inc(usableregmmx);
+{$endif TEMPREGDEBUG}
+                     end;
+                   saved[r]:=hr.offset;
+                end;
+           end;
+{$endif SUPPORT_MMX}
+{$ifdef TEMPREGDEBUG}
+        testregisters32;
+{$endif TEMPREGDEBUG}
+      end;
+
+    procedure popusedregisters(const pushed : tpushed);
+
+      var
+         r : tregister;
+{$ifdef SUPPORT_MMX}
+         hr : preference;
+{$endif SUPPORT_MMX}
+      begin
+         { restore in reverse order: }
+{$ifdef SUPPORT_MMX}
+         for r:=R_MM6 downto R_MM0 do
+           begin
+              if pushed[r] then
+                begin
+                   new(hr);
+                   reset_reference(hr^);
+                   hr^.base:=R_ESP;
+                   exprasmList.concat(Taicpu.Op_ref_reg(
+                     A_MOVQ,S_NO,hr,r));
+                   exprasmList.concat(Taicpu.Op_const_reg(
+                     A_ADD,S_L,8,R_ESP));
+                   unused:=unused-[r];
+{$ifdef TEMPREGDEBUG}
+                   dec(usableregmmx);
+{$endif TEMPREGDEBUG}
+                end;
+           end;
+{$endif SUPPORT_MMX}
+         for r:=R_EBX downto R_EAX do
+           if pushed[r] then
+             begin
+                exprasmList.concat(Taicpu.Op_reg(A_POP,S_L,r));
+{$ifdef TEMPREGDEBUG}
+                if not (r in unused) then
+                  { internalerror(10)
+                    in cg386cal we always restore regs
+                    that appear as used
+                    due to a unused tmep storage PM }
+                else
+                  dec(usablereg32);
+{$endif TEMPREGDEBUG}
+                unused:=unused-[r];
+             end;
+{$ifdef TEMPREGDEBUG}
+        testregisters32;
+{$endif TEMPREGDEBUG}
+      end;
+
+    procedure restoreusedregisters(const saved : tsaved);
+      var
+         r : tregister;
+         hr : treference;
+
+      begin
+         { restore in reverse order: }
+{$ifdef SUPPORT_MMX}
+         for r:=R_MM6 downto R_MM0 do
+           begin
+              if saved[r]<>reg_not_saved then
+                begin
+                   reset_reference(hr);
+                   hr.base:=frame_pointer;
+                   hr.offset:=saved[r];
+                   exprasmList.concat(Taicpu.Op_ref_reg(
+                     A_MOVQ,S_NO,newreference(hr),r));
+                   unused:=unused-[r];
+{$ifdef TEMPREGDEBUG}
+                   dec(usableregmmx);
+{$endif TEMPREGDEBUG}
+                   ungetiftemp(hr);
+                end;
+           end;
+{$endif SUPPORT_MMX}
+         for r:=R_EBX downto R_EAX do
+           if saved[r]<>reg_not_saved then
+             begin
+                reset_reference(hr);
+                hr.base:=frame_pointer;
+                hr.offset:=saved[r];
+                exprasmList.concat(Taicpu.Op_ref_reg(A_MOV,S_L,newreference(hr),r));
+{$ifdef TEMPREGDEBUG}
+                if not (r in unused) then
+                  internalerror(10)
+                else
+                  dec(usablereg32);
+{$endif TEMPREGDEBUG}
+                unused:=unused-[r];
+                ungetiftemp(hr);
+             end;
+{$ifdef TEMPREGDEBUG}
+        testregisters32;
+{$endif TEMPREGDEBUG}
+      end;
+
+    procedure ungetregister(r : tregister);
+
+      begin
+         if r in [R_EAX,R_ECX,R_EDX,R_EBX,R_ESP,R_EBP,R_ESI,R_EDI] then
+           ungetregister32(r)
+          else if r in [R_AX,R_CX,R_DX,R_BX,R_SP,R_BP,R_SI,R_DI] then
+           ungetregister32(reg16toreg32(r))
+         else if r in [R_AL,R_BL,R_CL,R_DL] then
+           ungetregister32(reg8toreg32(r))
+{$ifdef SUPPORT_MMX}
+         else if r in [R_MM0..R_MM6] then
+           ungetregistermmx(r)
+{$endif SUPPORT_MMX}
+         else internalerror(200112021);
+      end;
+
+    procedure ungetregister32(r : tregister);
+
+      begin
+         if (r = R_EDI) or
+            ((not assigned(procinfo^._class)) and (r = R_ESI)) then
+           begin
+             exprasmList.concat(Tairegalloc.DeAlloc(r));
+             exit;
+           end;
+         if cs_regalloc in aktglobalswitches then
+           begin
+              { takes much time }
+              if not(r in usableregs) then
+                exit;
+              unused:=unused+[r];
+              inc(usablereg32);
+           end
+         else
+           begin
+              if not(r in [R_EAX,R_EBX,R_ECX,R_EDX]) then
+                exit;
+{$ifdef TEMPREGDEBUG}
+                if (r in unused) then
+{$ifdef EXTTEMPREGDEBUG}
+                  begin
+                    Comment(V_Debug,'register freed twice '+reg2str(r));
+                    testregisters32;
+                    exit;
+                  end
+{$else EXTTEMPREGDEBUG}
+                  exit
+{$endif EXTTEMPREGDEBUG}
+                else
+{$endif TEMPREGDEBUG}
+                  inc(usablereg32);
+              unused:=unused+[r];
+{$ifdef TEMPREGDEBUG}
+              reg_releaser[r]:=curptree^;
+{$endif TEMPREGDEBUG}
+           end;
+         exprasmList.concat(Tairegalloc.DeAlloc(r));
+{$ifdef TEMPREGDEBUG}
+        testregisters32;
+{$endif TEMPREGDEBUG}
+      end;
+
+{$ifdef SUPPORT_MMX}
+    function getregistermmx : tregister;
+
+      var
+         r : tregister;
+
+      begin
+         dec(usableregmmx);
+         for r:=R_MM0 to R_MM6 do
+           if r in unused then
+             begin
+                unused:=unused-[r];
+                usedinproc:=usedinproc or ($80 shr byte(R_EAX));
+                getregistermmx:=r;
+                exit;
+             end;
+         internalerror(10);
+      end;
+
+    procedure ungetregistermmx(r : tregister);
+
+      begin
+         if cs_regalloc in aktglobalswitches then
+           begin
+              { takes much time }
+              if not(r in usableregs) then
+                exit;
+              unused:=unused+[r];
+              inc(usableregmmx);
+           end
+         else
+           begin
+              unused:=unused+[r];
+              inc(usableregmmx);
+           end;
+      end;
+{$endif SUPPORT_MMX}
+
+    function isaddressregister(reg: tregister): boolean;
+
+      begin
+        isaddressregister := true;
+      end;
+
+    procedure del_reference(const ref : treference);
+
+      begin
+         if ref.is_immediate then
+           exit;
+         ungetregister32(ref.base);
+         ungetregister32(ref.index);
+      end;
+
+
+    procedure del_locref(const location : tlocation);
+      begin
+         if (location.loc<>loc_mem) and (location.loc<>loc_reference) then
+           exit;
+         if location.reference.is_immediate then
+           exit;
+         ungetregister32(location.reference.base);
+         ungetregister32(location.reference.index);
+      end;
+
+
+    procedure del_location(const l : tlocation);
+      begin
+        case l.loc of
+          LOC_REGISTER :
+            ungetregister(l.register);
+          LOC_MEM,LOC_REFERENCE :
+            del_reference(l.reference);
+        end;
+      end;
+
+
+{$ifdef TEMPREGDEBUG}
+    procedure testregisters32;
+     var test : byte;
+       begin
+         test:=0;
+         if R_EAX in unused then
+           inc(test);
+         if R_EBX in unused then
+           inc(test);
+         if R_ECX in unused then
+           inc(test);
+         if R_EDX in unused then
+           inc(test);
+         if test<>usablereg32 then
+           internalerror(10);
+       end;
+{$endif TEMPREGDEBUG}
+
+<<<<<<< tgcpu.pas
+    function getregister32 : tregister;
+      var
+         r : tregister;
+=======
+    function getregisterint : tregister;
+>>>>>>> 1.8
+      begin
+         if usablereg32=0 then
+           internalerror(10);
+{$ifdef TEMPREGDEBUG}
+         if curptree^^.usableregs-usablereg32>curptree^^.registers32 then
+           internalerror(10);
+{$endif TEMPREGDEBUG}
+{$ifdef EXTTEMPREGDEBUG}
+         if curptree^^.usableregs-usablereg32>curptree^^.reallyusedregs then
+           curptree^^.reallyusedregs:=curptree^^.usableregs-usablereg32;
+{$endif EXTTEMPREGDEBUG}
+         dec(usablereg32);
+         if R_EAX in unused then
+           begin
+<<<<<<< tgcpu.pas
+              r:=R_EAX;
+=======
+              unused:=unused-[R_EAX];
+              usedinproc:=usedinproc or ($80 shr byte(R_EAX));
+              getregisterint:=R_EAX;
+>>>>>>> 1.8
+{$ifdef TEMPREGDEBUG}
+              reg_user[R_EAX]:=curptree^;
+{$endif TEMPREGDEBUG}
+              exprasmList.concat(Tairegalloc.Alloc(R_EAX));
+           end
+         else if R_EDX in unused then
+           begin
+<<<<<<< tgcpu.pas
+              r:=R_EDX;
+=======
+              unused:=unused-[R_EDX];
+              usedinproc:=usedinproc or ($80 shr byte(R_EDX));
+              getregisterint:=R_EDX;
+>>>>>>> 1.8
+{$ifdef TEMPREGDEBUG}
+              reg_user[R_EDX]:=curptree^;
+{$endif TEMPREGDEBUG}
+              exprasmList.concat(Tairegalloc.Alloc(R_EDX));
+           end
+         else if R_EBX in unused then
+           begin
+<<<<<<< tgcpu.pas
+              r:=R_EBX;
+=======
+              unused:=unused-[R_EBX];
+              usedinproc:=usedinproc or ($80 shr byte(R_EBX));
+              getregisterint:=R_EBX;
+>>>>>>> 1.8
+{$ifdef TEMPREGDEBUG}
+              reg_user[R_EBX]:=curptree^;
+{$endif TEMPREGDEBUG}
+              exprasmList.concat(Tairegalloc.Alloc(R_EBX));
+           end
+         else if R_ECX in unused then
+           begin
+<<<<<<< tgcpu.pas
+              r:=R_ECX;
+=======
+              unused:=unused-[R_ECX];
+              usedinproc:=usedinproc or ($80 shr byte(R_ECX));
+              getregisterint:=R_ECX;
+>>>>>>> 1.8
+{$ifdef TEMPREGDEBUG}
+              reg_user[R_ECX]:=curptree^;
+{$endif TEMPREGDEBUG}
+              exprasmList.concat(Tairegalloc.Alloc(R_ECX));
+           end
+         else internalerror(10);
+{$ifdef TEMPREGDEBUG}
+         testregisters32;
+{$endif TEMPREGDEBUG}
+         exclude(unused,r);
+         include(usedinproc,r);
+         getregister32:=r;
+      end;
+
+
+    function getaddressregister: tregister;
+
+      begin
+        getaddressregister := getregisterint;
+      end;
+
+    function getexplicitregister32(r : tregister) : tregister;
+
+      begin
+         if r in [R_ESI,R_EDI] then
+           begin
+             exprasmList.concat(Tairegalloc.Alloc(r));
+             getexplicitregister32 := r;
+             exit;
+           end;
+         if r in unused then
+           begin
+              dec(usablereg32);
+{$ifdef TEMPREGDEBUG}
+              if curptree^^.usableregs-usablereg32>curptree^^.registers32 then
+                internalerror(10);
+              reg_user[r]:=curptree^;
+{$endif TEMPREGDEBUG}
+              include(unused,r);
+              include(usedinproc,r);
+              exprasmList.concat(Tairegalloc.Alloc(r));
+              getexplicitregister32:=r;
+{$ifdef TEMPREGDEBUG}
+         testregisters32;
+{$endif TEMPREGDEBUG}
+           end
+         else
+           getexplicitregister32:=getregisterint;
+      end;
+
+    procedure cleartempgen;
+
+      begin
+         unused:=usableregs;
+         usablereg32:=c_usableregs;
+         {fpuvaroffset:=0;
+          this must only be resetted at each procedure
+          compilation start PM }
+      end;
+
+
+   procedure clearregistercount;
+      var
+        regi : tregister;
+      begin
+{$ifdef SUPPORT_MMX}
+         for regi:=R_EAX to R_MM6 do
+           begin
+              reg_pushes[regi]:=0;
+              is_reg_var[regi]:=false;
+           end;
+{$else SUPPORT_MMX}
+         for regi:=R_EAX to R_EDI do
+           begin
+              reg_pushes[regi]:=0;
+              is_reg_var[regi]:=false;
+           end;
+{$endif SUPPORT_MMX}
+      end;
+
+   function correct_fpuregister(r : tregister;ofs : byte) : tregister;
+
+     begin
+        correct_fpuregister:=tregister(longint(r)+ofs);
+     end;
+
+   procedure resetusableregisters;
+      begin
+{$ifdef SUPPORT_MMX}
+        usableregs:=[R_EAX,R_EBX,R_ECX,R_EDX,R_MM0..R_MM6];
+        c_usableregs:=4;
+        usableregmmx:=8;
+{$else}
+        usableregs:=[R_EAX,R_EBX,R_ECX,R_EDX];
+        c_usableregs:=4;
+{$endif SUPPORT_MMX}
+        fillchar(regvar_loaded,sizeof(regvar_loaded),false);
+        fillchar(is_reg_var,sizeof(is_reg_var),false);
+        fpuvaroffset:=0;
+      end;
+
+begin
+  resetusableregisters;
+end.
+{
+  $Log$
+  Revision 1.10  2002-07-04 20:43:02  florian
+    * first x86-64 patches
+
+  Revision 1.9  2002/03/31 20:26:42  jonas
+    + a_loadfpu_* and a_loadmm_* methods in tcg
+    * register allocation is now handled by a class and is mostly processor
+      independent (+rgobj.pas and i386/rgcpu.pas)
+    * temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
+    * some small improvements and fixes to the optimizer
+    * some register allocation fixes
+    * some fpuvaroffset fixes in the unary minus node
+    * push/popusedregisters is now called rg.save/restoreusedregisters and
+      (for i386) uses temps instead of push/pop's when using -Op3 (that code is
+      also better optimizable)
+    * fixed and optimized register saving/restoring for new/dispose nodes
+    * LOC_FPU locations now also require their "register" field to be set to
+      R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
+    - list field removed of the tnode class because it's not used currently
+      and can cause hard-to-find bugs
+
+  Revision 1.8  2001/12/31 09:53:16  jonas
+    * changed remaining "getregister32" calls to "getregisterint"
+
+  Revision 1.7  2001/12/29 15:29:59  jonas
+    * powerpc/cgcpu.pas compiles :)
+    * several powerpc-related fixes
+    * cpuasm unit is now based on common tainst unit
+    + nppcmat unit for powerpc (almost complete)
+
+  Revision 1.5  2001/08/26 13:37:03  florian
+    * some cg reorganisation
+    * some PPC updates
+
+  Revision 1.4  2001/04/13 01:22:21  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.3  2000/12/25 00:07:34  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.2  2000/12/05 11:44:34  jonas
+    + new integer regvar handling, should be much more efficient
+
+  Revision 1.1  2000/11/29 00:30:51  florian
+    * unused units removed from uses clause
+    * some changes for widestrings
+
+  Revision 1.9  2000/10/31 22:30:13  peter
+    * merged asm result patch part 2
+
+  Revision 1.8  2000/10/14 10:14:56  peter
+    * moehrendorf oct 2000 rewrite
+
+  Revision 1.7  2000/09/30 16:08:46  peter
+    * more cg11 updates
+
+  Revision 1.6  2000/09/24 15:06:32  peter
+    * use defines.inc
+
+  Revision 1.5  2000/08/27 16:11:55  peter
+    * moved some util functions from globals,cobjects to cutils
+    * splitted files into finput,fmodule
+
+  Revision 1.4  2000/08/05 13:32:39  peter
+    * fixed build prob without support_mmx
+
+  Revision 1.3  2000/08/04 05:09:49  jonas
+    * forgot to commit :( (part of regvar changes)
+
+  Revision 1.2  2000/07/13 11:32:52  michael
+  + removed logs
+}

compiler/ncal.pas

@@ -813,7 +813,6 @@ implementation
              ;
         end;
 
-
       var
         i : longint;
         found,
@@ -1631,9 +1630,9 @@ implementation
                     procinfo^.flags:=procinfo^.flags or pi_do_call;
                 end;
 
-             { for the PowerPC standard calling conventions this information isn't necassary (FK) }
              { It doesn't hurt to calculate it already though :) (JM) }
              rg.incrementregisterpushed(tprocdef(procdefinition).usedregisters);
+             
            end;
 
          { get a register for the return value }
@@ -1744,7 +1743,7 @@ implementation
 
                      registersfpu:=max(methodpointer.registersfpu,registersfpu);
                      registers32:=max(methodpointer.registers32,registers32);
-{$ifdef SUPPORT_MMX}
+{$ifdef SUPPORT_MMX }
                      registersmmx:=max(methodpointer.registersmmx,registersmmx);
 {$endif SUPPORT_MMX}
                   end;
@@ -1871,7 +1870,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.77  2002-07-01 16:23:52  peter
+  Revision 1.78  2002-07-04 20:43:00  florian
+    * first x86-64 patches
+
+  Revision 1.77  2002/07/01 16:23:52  peter
     * cg64 patch
     * basics for currency
     * asnode updates for class and interface (not finished)
@@ -1982,4 +1984,4 @@ end.
   Revision 1.62  2002/01/19 11:57:05  peter
     * fixed path appending for lib
 
-}
+}

compiler/ncgcnv.pas

@@ -490,7 +490,10 @@ end.
 
 {
   $Log$
-  Revision 1.17  2002-07-01 18:46:22  peter
+  Revision 1.18  2002-07-04 20:43:01  florian
+    * first x86-64 patches
+
+  Revision 1.17  2002/07/01 18:46:22  peter
     * internal linker
     * reorganized aasm layer
 
@@ -580,4 +583,4 @@ end.
     - list field removed of the tnode class because it's not used currently
       and can cause hard-to-find bugs
 
-}
+}

compiler/ncgflw.pas

@@ -75,8 +75,9 @@ implementation
       cginfo,cgbase,pass_2,
       cpubase,cpuinfo,
       nld,ncon,
-      tgobj,rgobj,
       ncgutil,
+      cga,
+      tgobj,rgobj,
       regvars,cgobj,cgcpu,cg64f32;
 
 {*****************************************************************************
@@ -628,7 +629,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.21  2002-07-01 18:46:22  peter
+  Revision 1.22  2002-07-04 20:43:01  florian
+    * first x86-64 patches
+
+  Revision 1.21  2002/07/01 18:46:22  peter
     * internal linker
     * reorganized aasm layer
 
@@ -718,5 +722,4 @@ end.
   Revision 1.8  2002/03/04 19:10:11  peter
     * removed compiler warnings
 
-}
-
+}

compiler/options.pas

@@ -1359,39 +1359,41 @@ begin
   def_symbol('VALUEFREEMEM');
   def_symbol('HASCURRENCY');
 
-  { some stuff for TP compatibility }
-  case target_info.cpu of
-   cpu_i386:
-        begin
-         def_symbol('CPU86');
-         def_symbol('CPU87');
-         def_symbol('CPUI386');
-        end;
-   cpu_m68k:
-        begin
-          def_symbol('CPU68');
-          def_symbol('CPU68K');
-        end;
-   cpu_alpha:
-        begin
-          def_symbol('CPUALPHA');
-        end;
-   cpu_powerpc:
-        begin
-          def_symbol('CPUPOWERPC');
-        end;
-   cpu_sparc:
-        begin
-          def_symbol('CPUSPARC');
-        end;
-   cpu_vm:
-        begin
-          def_symbol('CPUVIS');
-        end;
-   else
-        internalerror(1295969);
-  end;
+{ using a case is pretty useless here (FK) }
+{ some stuff for TP compatibility }
+{$ifdef i386}
+  def_symbol('CPU86');
+  def_symbol('CPU87');
+{$endif}
+{$ifdef m68k}
+  def_symbol('CPU68');
+{$endif}
 
+{ new processor stuff }
+{$ifdef i386}
+  def_symbol('CPUI386');
+{$endif}
+{$ifdef m68k}
+  def_symbol('CPU68K');
+{$endif}
+{$ifdef ALPHA}
+  def_symbol('CPUALPHA');
+{$endif}
+{$ifdef powerpc}
+  def_symbol('CPUPOWERPC');
+{$endif}
+{$ifdef iA64}
+  def_symbol('CPUIA64');
+{$endif}
+{$ifdef x64_64}
+  def_symbol('CPU 86_64');
+{$endif}
+{$ifdef sparc}
+  def_symbol('CPUSPARC');
+{$endif}
+{$ifdef vis}
+  def_symbol('CPUVIS');
+{$endif}
 
 { get default messagefile }
 {$ifdef Delphi}
@@ -1668,7 +1670,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.75  2002-07-01 18:46:24  peter
+  Revision 1.76  2002-07-04 20:43:01  florian
+    * first x86-64 patches
+
+  Revision 1.75  2002/07/01 18:46:24  peter
     * internal linker
     * reorganized aasm layer
 
@@ -1729,4 +1734,4 @@ end.
   Revision 1.65  2002/04/04 18:39:45  carl
   + added wdosx support (patch from Pavel)
 
-}
+}

compiler/pmodules.pas

@@ -276,6 +276,10 @@ implementation
           On OS/2 the heap is also intialized by the RTL. We do
           not output a pointer }
          case target_info.target of
+{$ifdef x86_64}
+            target_x86_64_linux:
+              ;
+{$endif x86_64}
 {$ifdef i386}
             target_i386_OS2:
               ;
@@ -1384,7 +1388,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.67  2002-07-01 18:46:25  peter
+  Revision 1.68  2002-07-04 20:43:01  florian
+    * first x86-64 patches
+
+  Revision 1.67  2002/07/01 18:46:25  peter
     * internal linker
     * reorganized aasm layer
 
@@ -1474,4 +1481,4 @@ end.
    * implicit result variable generation for assembler routines
    * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
 
-}
+}

compiler/pp.pas

@@ -27,6 +27,7 @@ program pp;
   -----------------------------------------------------------------
   GDB*                support of the GNU Debugger
   I386                generate a compiler for the Intel i386+
+  x86_64              generate a compiler for the AMD x86-64 architecture
   M68K                generate a compiler for the M68000
   SPARC               generate a compiler for SPARC
   POWERPC             generate a compiler for the PowerPC
@@ -64,6 +65,12 @@ program pp;
      {$endif CPUDEFINED}
      {$define CPUDEFINED}
    {$endif I386}
+   {$ifdef x86_64}
+     {$ifdef CPUDEFINED}
+        {$fatal ONLY one of the switches for the CPU type must be defined}
+     {$endif CPUDEFINED}
+     {$define CPUDEFINED}
+   {$endif x86_64}
    {$ifdef M68K}
      {$ifdef CPUDEFINED}
         {$fatal ONLY one of the switches for the CPU type must be defined}
@@ -170,7 +177,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.14  2002-05-22 19:02:16  carl
+  Revision 1.15  2002-07-04 20:43:01  florian
+    * first x86-64 patches
+
+  Revision 1.14  2002/05/22 19:02:16  carl
   + generic FPC_HELP_FAIL
   + generic FPC_HELP_DESTRUCTOR instated (original from Pierre)
   + generic FPC_DISPOSE_CLASS

compiler/pstatmnt.pas

@@ -66,6 +66,11 @@ implementation
        ,ra386dir
   {$endif NoRa386Dir}
 {$endif i386}
+{$ifdef x86_64}
+  {$ifndef NoRax86Dir}
+       ,rax86dir
+  {$endif NoRax86Dir}
+{$endif i386}
 {$ifdef m68k}
   {$ifndef NoRa68kMot}
        ,ra68kmot
@@ -771,6 +776,24 @@ implementation
              end;
   {$endif NoRA386Dir}
 {$endif}
+
+{$ifdef x86_64}
+  {$ifndef NoRA386Dir}
+           asmmode_i386_direct:
+             begin
+               if not target_asm.allowdirect then
+                 Message(parser_f_direct_assembler_not_allowed);
+               if (aktprocdef.proccalloption=pocall_inline) then
+                 Begin
+                    Message1(parser_w_not_supported_for_inline,'direct asm');
+                    Message(parser_w_inlining_disabled);
+                    aktprocdef.proccalloption:=pocall_fpccall;
+                 End;
+               asmstat:=tasmnode(rax86dir.assemble);
+             end;
+  {$endif NoRA386Dir}
+{$endif x86_64}
+
 {$ifdef m68k}
   {$ifndef NoRA68kMot}
            asmmode_m68k_mot:
@@ -810,6 +833,23 @@ implementation
                   else if pattern='EDI' then
                     include(rg.usedinproc,R_EDI)
 {$endif i386}
+{$ifdef x86_64}
+                  if pattern='RAX' then
+                    include(usedinproc,R_RAX)
+                  else if pattern='RBX' then
+                    include(usedinproc,R_RBX)
+                  else if pattern='RCX' then
+                    include(usedinproc,R_RCX)
+                  else if pattern='RDX' then
+                    include(usedinproc,R_RDX)
+                  else if pattern='RSI' then
+                    begin
+                       include(usedinproc,R_RSI);
+                       exclude(asmstat.flags,nf_object_preserved);
+                    end
+                  else if pattern='RDI' then
+                    include(usedinproc,R_RDI)
+{$endif x86_64}
 {$ifdef m68k}
                   if pattern='D0' then
                     include(rg.usedinproc,R_D0)
@@ -1217,7 +1257,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.59  2002-07-01 18:46:25  peter
+  Revision 1.60  2002-07-04 20:43:01  florian
+    * first x86-64 patches
+
+  Revision 1.59  2002/07/01 18:46:25  peter
     * internal linker
     * reorganized aasm layer
 
@@ -1290,4 +1333,4 @@ end.
    * implicit result variable generation for assembler routines
    * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead
 
-}
+}

compiler/psub.pas

@@ -23,9 +23,6 @@
 unit psub;
 
 {$i fpcdefs.inc}
-{$ifdef powerpc}
-  {$define newcg}
-{$endif powerpc}
 
 interface
 
@@ -47,7 +44,7 @@ implementation
        globtype,globals,tokens,verbose,comphook,
        systems,
        { aasm }
-       cpubase,cpuinfo,aasmbase,aasmtai,aasmcpu,
+       cpubase,cpuinfo,aasmbase,aasmtai,
        { symtable }
        symconst,symbase,symdef,symsym,symtype,symtable,types,
        ppu,fmodule,
@@ -281,8 +278,8 @@ implementation
 
          { reset the temporary memory }
          rg.cleartempgen;
-
          rg.usedinproc:=[];
+         
          { save entry info }
          entrypos:=aktfilepos;
          entryswitches:=aktlocalswitches;
@@ -819,7 +816,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.54  2002-07-01 18:46:25  peter
+  Revision 1.55  2002-07-04 20:43:01  florian
+    * first x86-64 patches
+
+  Revision 1.54  2002/07/01 18:46:25  peter
     * internal linker
     * reorganized aasm layer
 
@@ -901,4 +901,4 @@ end.
   Revision 1.42  2002/01/19 15:12:34  peter
     * check for unresolved forward classes in the interface
 
-}
+}

compiler/psystem.pas

@@ -114,10 +114,10 @@ begin
   addtype('Double',s64floattype);
   addtype('Extended',s80floattype);
   addtype('Real',s64floattype);
-{$ifdef i386}
+{$ifdef x86}
   adddef('Comp',tfloatdef.create(s64comp));
+{$endif x86}
   addtype('Currency',s64currencytype);
-{$endif}
   addtype('Pointer',voidpointertype);
   addtype('FarPointer',voidfarpointertype);
   addtype('ShortString',cshortstringtype);
@@ -248,12 +248,12 @@ begin
   openshortstringtype.setdef(tstringdef.createshort(0));
   openchararraytype.setdef(tarraydef.create(0,-1,s32bittype));
   tarraydef(openchararraytype.def).elementtype:=cchartype;
-{$ifdef i386}
+{$ifdef x86}
   s32floattype.setdef(tfloatdef.create(s32real));
   s64floattype.setdef(tfloatdef.create(s64real));
   s80floattype.setdef(tfloatdef.create(s80real));
+{$endif x86}
   s64currencytype.setdef(tfloatdef.create(s64currency));
-{$endif}
 {$ifdef m68k}
   s32floattype.setdef(tfloatdef.create(s32real));
   if (cs_fp_emulation in aktmoduleswitches) then
@@ -280,7 +280,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.27  2002-07-01 16:23:54  peter
+  Revision 1.28  2002-07-04 20:43:02  florian
+    * first x86-64 patches
+
+  Revision 1.27  2002/07/01 16:23:54  peter
     * cg64 patch
     * basics for currency
     * asnode updates for class and interface (not finished)
@@ -326,4 +329,4 @@ end.
       instead of direct comparisons of low/high values of orddefs because
       qword is a special case
 
-}
+}

compiler/systems.pas

@@ -46,7 +46,11 @@ interface
              cpu_alpha,                    { 3 }
              cpu_powerpc,                  { 4 }
              cpu_sparc,                    { 5 }
-             cpu_vm                        { 6 }
+             cpu_vm,                       { 6 }
+             cpu_iA64,                     { 7 }
+             cpu_x86_64,                   { 8 }
+             cpu_mips,                     { 9 }
+             cpu_arm                       { 10 }
        );
 
        tprocessors = (no_processor
@@ -100,7 +104,8 @@ interface
              target_i386_qnx,           { 20 }
              target_i386_wdosx,         { 21 }
              target_sparc_sunos,        { 22 }
-             target_sparc_linux         { 23 }
+             target_sparc_linux,        { 23 }
+             target_x86_64_linux        { 24 }
        );
 
        tasm = (as_none
@@ -120,11 +125,12 @@ interface
             ld_i386_GO32V1,ld_i386_GO32V2,ld_i386_linux,
               ld_i386_OS2,ld_i386_Win32,ld_i386_freebsd,
               ld_i386_Netware,ld_i386_sunos,ld_i386_beos,
-              ld_i386_coff,ld_i386_pecoff,
+              ld_i386_coff,ld_i386_pecoff,ld_i386_Wdosx,
             ld_m68k_Amiga,ld_m68k_Atari,ld_m68k_Mac,
               ld_m68k_linux,ld_m68k_PalmOS,ld_m68k_freebsd,
             ld_alpha_linux,
-            ld_powerpc_linux,ld_powerpc_macos,ld_i386_Wdosx,
+            ld_x86_64_linux,
+            ld_powerpc_linux,ld_powerpc_macos,
             ld_SPARC_SunOs,ld_SPARC_linux
        );
 
@@ -627,6 +633,9 @@ begin
       {$endif os2}
     {$endif go32v2}
 {$endif cpu86}
+{$ifdef cpu86_64}
+  set_source(target_x86_64_linux);
+{$endif cpu86_64}
 {$ifdef cpu68}
   {$ifdef AMIGA}
     set_source(target_m68k_Amiga);
@@ -654,6 +663,13 @@ begin
     default_target(target_i386_linux);
   {$endif cpu86}
 {$endif i386}
+{$ifdef x86_64}
+  {$ifdef cpu86_64}
+    default_target(source_info.target);
+  {$else cpu86_64}
+    default_target(target_x86_64_linux);
+  {$endif cpu86_64}
+{$endif x86_64}
 {$ifdef m68k}
   {$ifdef cpu68}
     default_target(source_info.target);
@@ -687,7 +703,10 @@ finalization
 end.
 {
   $Log$
-  Revision 1.46  2002-07-01 18:46:29  peter
+  Revision 1.47  2002-07-04 20:43:02  florian
+    * first x86-64 patches
+
+  Revision 1.46  2002/07/01 18:46:29  peter
     * internal linker
     * reorganized aasm layer
 
@@ -722,12 +741,4 @@ end.
 
   Revision 1.38  2002/04/14 16:56:30  carl
   - remove duplicate comment
-
-  Revision 1.37  2002/04/07 10:20:15  carl
-  + added SPARC targets
-  + added VM target
-
-  Revision 1.36  2002/04/04 19:18:06  carl
-  - removed cmnts
-
-}
+}

compiler/tainst.pas

@@ -0,0 +1,332 @@
+{
+    $Id$
+    Copyright (c) 1998-2002 by Michael Van Canneyt
+
+    Contains a generic assembler instruction object;
+
+    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 tainst;
+
+{$i fpcdefs.inc}
+
+interface
+
+    Uses
+      cpuinfo,cpubase,aasm,cclasses;
+
+    Type
+      tairegalloc = class(tai)
+         allocation : boolean;
+         reg        : tregister;
+         constructor alloc(r : tregister);
+         constructor dealloc(r : tregister);
+      end;
+
+      taicpu_abstract = class(tai)
+        condition : TAsmCond;
+        ops       : longint;
+        oper      : array[0..max_operands-1] of toper;
+        opcode    : tasmop;
+{$ifdef x86}
+        segprefix : tregister;
+{$endif x86}
+        is_jmp    : boolean; { is this instruction a jump? (needed for optimizer) }
+        Constructor Create(op : tasmop);
+        Destructor Destroy;override;
+        function getcopy:tlinkedlistitem;override;
+        procedure loadconst(opidx:longint;l:aword);
+        procedure loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
+        procedure loadref(opidx:longint;const r:treference);
+        procedure loadreg(opidx:longint;r:tregister);
+        procedure loadoper(opidx:longint;o:toper);
+        procedure SetCondition(const c:TAsmCond);
+      end;
+
+      { alignment for operator }
+      tai_align_abstract = class(tai)
+         buf       : array[0..63] of char; { buf used for fill }
+         aligntype : byte;   { 1 = no align, 2 = word align, 4 = dword align }
+         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);
+         function getfillbuf:pchar;virtual;
+      end;
+
+
+implementation
+
+    uses
+      verbose;
+
+
+{*****************************************************************************
+                                 TaiRegAlloc
+*****************************************************************************}
+
+    constructor tairegalloc.alloc(r : tregister);
+      begin
+        inherited create;
+        typ:=ait_regalloc;
+        allocation:=true;
+        reg:=r;
+      end;
+
+
+    constructor tairegalloc.dealloc(r : tregister);
+      begin
+        inherited create;
+        typ:=ait_regalloc;
+        allocation:=false;
+        reg:=r;
+      end;
+
+
+{*****************************************************************************
+                               TaiInstruction
+*****************************************************************************}
+
+    constructor taicpu_abstract.Create(op : tasmop);
+
+      begin
+         inherited create;
+         typ:=ait_instruction;
+         is_jmp:=false;
+         opcode:=op;
+         ops:=0;
+         fillchar(condition,sizeof(condition),0);
+         fillchar(oper,sizeof(oper),0);
+      end;
+
+
+
+    destructor taicpu_abstract.Destroy;
+
+      var
+        i : longint;
+      begin
+        for i:=0 to ops-1 do
+        case oper[i].typ of
+          top_ref:
+            dispose(oper[i].ref);
+          top_symbol:
+            dec(tasmsymbol(oper[i].sym).refs);
+        end;
+        inherited destroy;
+      end;
+
+
+
+{ ---------------------------------------------------------------------
+    Loading of operands.
+  ---------------------------------------------------------------------}
+
+
+
+    procedure taicpu_abstract.loadconst(opidx:longint;l:aword);
+      begin
+        if opidx>=ops then
+         ops:=opidx+1;
+        with oper[opidx] do
+         begin
+           if typ=top_ref then
+            dispose(ref);
+           val:=l;
+           typ:=top_const;
+         end;
+      end;
+
+
+
+    procedure taicpu_abstract.loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
+      begin
+        if not assigned(s) then
+         internalerror(200204251);
+        if opidx>=ops then
+         ops:=opidx+1;
+        with oper[opidx] do
+         begin
+           if typ=top_ref then
+            dispose(ref);
+           sym:=s;
+           symofs:=sofs;
+           typ:=top_symbol;
+         end;
+        inc(s.refs);
+      end;
+
+
+
+    procedure taicpu_abstract.loadref(opidx:longint;const r:treference);
+      begin
+        if opidx>=ops then
+         ops:=opidx+1;
+        with oper[opidx] do
+         begin
+           if typ<>top_ref then
+            new(ref);
+           ref^:=r;
+{$ifdef x86}
+           { We allow this exception for i386, since overloading this would be
+             too much of a a speed penalty}
+           if not(ref^.segment in [R_DS,R_NO]) then
+            segprefix:=ref^.segment;
+{$endif x86}
+           typ:=top_ref;
+           { mark symbol as used }
+           if assigned(ref^.symbol) then
+             inc(ref^.symbol.refs);
+         end;
+      end;
+
+
+
+    procedure taicpu_abstract.loadreg(opidx:longint;r:tregister);
+      begin
+        if opidx>=ops then
+         ops:=opidx+1;
+        with oper[opidx] do
+         begin
+           if typ=top_ref then
+            dispose(ref);
+           reg:=r;
+           typ:=top_reg;
+         end;
+      end;
+
+
+
+    procedure taicpu_abstract.loadoper(opidx:longint;o:toper);
+      begin
+        if opidx>=ops then
+         ops:=opidx+1;
+        if oper[opidx].typ=top_ref then
+         dispose(oper[opidx].ref);
+        oper[opidx]:=o;
+        { copy also the reference }
+        if oper[opidx].typ=top_ref then
+         begin
+           new(oper[opidx].ref);
+           oper[opidx].ref^:=o.ref^;
+         end;
+      end;
+
+
+{ ---------------------------------------------------------------------
+    Miscellaneous methods.
+  ---------------------------------------------------------------------}
+
+    procedure taicpu_abstract.SetCondition(const c:TAsmCond);
+      begin
+         condition:=c;
+      end;
+
+
+    Function taicpu_abstract.getcopy:tlinkedlistitem;
+      var
+        i : longint;
+        p : tlinkedlistitem;
+      begin
+        p:=inherited getcopy;
+        { make a copy of the references }
+        for i:=1 to ops do
+         if (taicpu_abstract(p).oper[i-1].typ=top_ref) then
+          begin
+            new(taicpu_abstract(p).oper[i-1].ref);
+            taicpu_abstract(p).oper[i-1].ref^:=oper[i-1].ref^;
+          end;
+        getcopy:=p;
+      end;
+
+{****************************************************************************
+                              tai_align_abstract
+ ****************************************************************************}
+
+     constructor tai_align_abstract.Create(b: byte);
+       begin
+          inherited Create;
+          typ:=ait_align;
+          if b in [1,2,4,8,16,32] then
+            aligntype := b
+          else
+            aligntype := 1;
+          fillsize:=0;
+          fillop:=0;
+          use_op:=false;
+       end;
+
+
+     constructor tai_align_abstract.Create_op(b: byte; _op: byte);
+       begin
+          inherited Create;
+          typ:=ait_align;
+          if b in [1,2,4,8,16,32] then
+            aligntype := b
+          else
+            aligntype := 1;
+          fillsize:=0;
+          fillop:=_op;
+          use_op:=true;
+          fillchar(buf,sizeof(buf),_op)
+       end;
+
+
+     function tai_align_abstract.getfillbuf:pchar;
+       begin
+         getfillbuf:=@buf;
+       end;
+
+end.
+
+{
+  $Log$
+  Revision 1.11  2002-07-04 20:43:02  florian
+    * first x86-64 patches
+
+  Revision 1.10  2002/07/01 18:46:29  peter
+    * internal linker
+    * reorganized aasm layer
+
+  Revision 1.9  2002/05/18 13:34:21  peter
+    * readded missing revisions
+
+  Revision 1.7  2002/05/14 19:34:52  peter
+    * removed old logs and updated copyright year
+
+  Revision 1.6  2002/05/14 17:28:09  peter
+    * synchronized cpubase between powerpc and i386
+    * moved more tables from cpubase to cpuasm
+    * tai_align_abstract moved to tainst, cpuasm must define
+      the tai_align class now, which may be empty
+
+  Revision 1.5  2002/04/25 20:16:39  peter
+    * moved more routines from cga/n386util
+
+  Revision 1.4  2002/04/02 17:11:32  peter
+    * tlocation,treference update
+    * LOC_CONSTANT added for better constant handling
+    * secondadd splitted in multiple routines
+    * location_force_reg added for loading a location to a register
+      of a specified size
+    * secondassignment parses now first the right and then the left node
+      (this is compatible with Kylix). This saves a lot of push/pop especially
+      with string operations
+    * adapted some routines to use the new cg methods
+
+}

compiler/targets/t_linux.pas

@@ -748,6 +748,75 @@ end;
             use_function_relative_addresses : true
           );
 {$endif alpha}
+{$ifdef x86_64}
+    const
+       target_x86_64_linux_info : ttargetinfo =
+          (
+            target       : target_i386_LINUX;
+            name         : 'Linux for x86-64';
+            shortname    : 'Linux64';
+            flags        : [];
+            cpu          : x86_64;
+            unit_env     : 'LINUXUNITS';
+            extradefines : 'UNIX';
+            sourceext    : '.pp';
+            pasext       : '.pas';
+            exeext       : '';
+            defext       : '.def';
+            scriptext    : '.sh';
+            smartext     : '.sl';
+            unitext      : '.ppu';
+            unitlibext   : '.ppl';
+            asmext       : '.s';
+            objext       : '.o';
+            resext       : '.res';
+            resobjext    : '.or';
+            sharedlibext : '.so';
+            staticlibext : '.a';
+            staticlibprefix : 'libp';
+            sharedlibprefix : 'lib';
+            sharedClibext : '.so';
+            staticClibext : '.a';
+            staticClibprefix : 'lib';
+            sharedClibprefix : 'lib';
+            Cprefix      : '';
+            newline      : #10;
+            dirsep       : '/';
+            files_case_relevent : true;
+            assem        : as_i386_elf32;
+            assemextern  : as_i386_as;
+            link         : ld_i386_linux;
+            linkextern   : ld_i386_linux;
+            ar           : ar_gnu_ar;
+            res          : res_none;
+            script       : script_unix;
+            endian       : endian_little;
+            alignment    :
+              (
+                procalign       : 4;
+                loopalign       : 4;
+                jumpalign       : 0;
+                constalignmin   : 0;
+                constalignmax   : 1;
+                varalignmin     : 0;
+                varalignmax     : 1;
+                localalignmin   : 0;
+                localalignmax   : 1;
+                paraalign       : 4;
+                recordalignmin  : 0;
+                recordalignmax  : 2;
+                maxCrecordalign : 4
+              );
+            size_of_pointer : 8;
+            size_of_longint : 4;
+            heapsize     : 256*1024;
+            maxheapsize  : 65536*1024;
+            stacksize    : 16*1024;
+            DllScanSupported:false;
+            use_bound_instruction : false;
+            use_function_relative_addresses : true
+          );
+{$endif x86_64}
 {$IFDEF SPARC}
   CONST
        target_SPARC_linux_info : ttargetinfo =
@@ -815,6 +884,7 @@ end;
           );
 {$ENDIF SPARC}
 
+
 initialization
 {$ifdef i386}
   RegisterLinker(ld_i386_linux,TLinkerLinux);
@@ -840,6 +910,12 @@ initialization
   RegisterExport(target_alpha_linux,texportliblinux);
   RegisterTarget(target_alpha_linux_info);
 {$endif alpha}
+{$ifdef x86_64}
+  RegisterLinker(ld_x86_64_linux,TLinkerLinux);
+  RegisterImport(target_x86_64_linux,timportliblinux);
+  RegisterExport(target_x86_64_linux,texportliblinux);
+  RegisterTarget(target_x86_64_linux_info);
+{$endif x86_64}
 {$IFDEF SPARC}
   RegisterLinker(ld_SPARC_linux,TLinkerLinux);
   RegisterImport(target_SPARC_linux,timportliblinux);
@@ -847,9 +923,13 @@ initialization
   RegisterTarget(target_SPARC_linux_info);
 {$ENDIF SPARC}
 end.
+
 {
   $Log$
-  Revision 1.27  2002-07-01 18:46:35  peter
+  Revision 1.28  2002-07-04 20:43:02  florian
+    * first x86-64 patches
+
+  Revision 1.27  2002/07/01 18:46:35  peter
     * internal linker
     * reorganized aasm layer
 
@@ -897,5 +977,4 @@ end.
 
   Revision 1.15  2002/01/09 07:38:37  michael
   + Patch from Peter for library imports
-
 }

compiler/version.pas

@@ -51,6 +51,9 @@ interface
 {$ifdef i386}
        target_cpu_string = 'i386';
 {$endif}
+{$ifdef x86_64}
+       target_cpu_string = 'x86_64';
+{$endif}
 {$ifdef sparc}
        target_cpu_string = 'sparc';
 {$endif}
@@ -66,6 +69,13 @@ interface
 {$ifdef ia64}
        target_cpu_string = 'ia64';
 {$endif}
+{$ifdef mips}
+       target_cpu_string = 'mips';
+{$endif}
+{$ifdef arm}
+       target_cpu_string = 'arm';
+{$endif}
+
 
        { source cpu string }
 {$ifdef cpu86}
@@ -77,6 +87,9 @@ interface
 {$ifdef cpuia64}
        target_cpu_string = 'ia64';
 {$endif}
+{$ifdef cpu86_64}
+        source_cpu_string = 'x86_64';
+{$endif}
 
 function version_string:string;
 function full_version_string:string;
@@ -104,7 +117,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.12  2002-05-18 13:34:21  peter
+  Revision 1.13  2002-07-04 20:43:02  florian
+    * first x86-64 patches
+
+  Revision 1.12  2002/05/18 13:34:21  peter
     * readded missing revisions
 
   Revision 1.11  2002/05/16 19:46:47  carl
@@ -118,5 +134,4 @@ end.
 
   Revision 1.8  2002/03/01 12:47:21  pierre
    * used shl 7 for release number
-
-}
+}