diff --git a/compiler/aasm.pas b/compiler/aasm.pas new file mode 100644 index 0000000000..f8534eb628 --- /dev/null +++ b/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 + +} \ No newline at end of file diff --git a/compiler/globtype.pas b/compiler/globtype.pas index a591be3990..7c9ff35229 100644 --- a/compiler/globtype.pas +++ b/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 -} +} \ No newline at end of file diff --git a/compiler/i386/tgcpu.pas b/compiler/i386/tgcpu.pas new file mode 100644 index 0000000000..6a4c9d00d8 --- /dev/null +++ b/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 +} diff --git a/compiler/ncal.pas b/compiler/ncal.pas index e3d0aac464..fa0a2babd4 100644 --- a/compiler/ncal.pas +++ b/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 -} +} \ No newline at end of file diff --git a/compiler/ncgcnv.pas b/compiler/ncgcnv.pas index f6e81766ae..ea4353e7df 100644 --- a/compiler/ncgcnv.pas +++ b/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 -} +} \ No newline at end of file diff --git a/compiler/ncgflw.pas b/compiler/ncgflw.pas index 272e3ef4b6..47f3708dc3 100644 --- a/compiler/ncgflw.pas +++ b/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 -} - +} \ No newline at end of file diff --git a/compiler/options.pas b/compiler/options.pas index a36e4235c1..b9a0d5d39d 100644 --- a/compiler/options.pas +++ b/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) -} +} \ No newline at end of file diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index 9ae3f9530b..873c84aa74 100644 --- a/compiler/pmodules.pas +++ b/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 -} +} \ No newline at end of file diff --git a/compiler/pp.pas b/compiler/pp.pas index aea576fb5e..0f0fb53e1e 100644 --- a/compiler/pp.pas +++ b/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 diff --git a/compiler/pstatmnt.pas b/compiler/pstatmnt.pas index 14ad082b9a..b3dec326b6 100644 --- a/compiler/pstatmnt.pas +++ b/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 -} +} \ No newline at end of file diff --git a/compiler/psub.pas b/compiler/psub.pas index cc214cad7b..fa6b84f382 100644 --- a/compiler/psub.pas +++ b/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 -} +} \ No newline at end of file diff --git a/compiler/psystem.pas b/compiler/psystem.pas index 11cc928358..2bca7198e5 100644 --- a/compiler/psystem.pas +++ b/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 -} +} \ No newline at end of file diff --git a/compiler/systems.pas b/compiler/systems.pas index 45cae97cd6..865eb65e32 100644 --- a/compiler/systems.pas +++ b/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 - -} +} \ No newline at end of file diff --git a/compiler/tainst.pas b/compiler/tainst.pas new file mode 100644 index 0000000000..3997639ea9 --- /dev/null +++ b/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 + +} \ No newline at end of file diff --git a/compiler/targets/t_linux.pas b/compiler/targets/t_linux.pas index 303f45cced..cdb097ac5a 100644 --- a/compiler/targets/t_linux.pas +++ b/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 - } diff --git a/compiler/version.pas b/compiler/version.pas index 99e17b017e..81d780e96c 100644 --- a/compiler/version.pas +++ b/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 - -} +} \ No newline at end of file