paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-17 10:39:33 +02:00
Code Issues Packages Projects Releases Wiki Activity

* several fixes to compile x86-64 system

Browse Source
This commit is contained in:
florian 2004-02-05 01:24:08 +00:00
parent c9122a4719
commit 465aa5851b
19 changed files with 698 additions and 598 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

94
compiler/i386/n386cnv.pas
View File

@ -40,8 +40,8 @@ interface
{ procedure second_pointer_to_array;override; }
{ procedure second_chararray_to_string;override; }
{ procedure second_char_to_string;override; }
function first_int_to_real: tnode; override;
procedure second_int_to_real;override;
{ function first_int_to_real: tnode; override; }
{ procedure second_int_to_real;override; }
{ procedure second_real_to_real;override; }
{ procedure second_cord_to_pointer;override; }
{ procedure second_proc_to_procvar;override; }
@ -66,97 +66,15 @@ implementation
cgobj,cga,cgx86,ncgutil;
function ti386typeconvnode.first_int_to_real : tnode;
begin
first_int_to_real:=nil;
if registersfpu<1 then
registersfpu:=1;
expectloc:=LOC_FPUREGISTER;
end;
procedure ti386typeconvnode.second_int_to_real;
var
href : treference;
hregister : tregister;
l1,l2 : tasmlabel;
begin
location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
{ We need to load from a reference }
location_force_mem(exprasmlist,left.location);
{ For u32bit we need to load it as comp and need to
make it 64bits }
if (torddef(left.resulttype.def).typ=u32bit) then
begin
tg.GetTemp(exprasmlist,8,tt_normal,href);
location_release(exprasmlist,left.location);
location_freetemp(exprasmlist,left.location);
cg.a_load_ref_ref(exprasmlist,left.location.size,OS_32,left.location.reference,href);
inc(href.offset,4);
cg.a_load_const_ref(exprasmlist,OS_32,0,href);
dec(href.offset,4);
left.location.reference:=href;
end;
{ Load from reference to fpu reg }
location_release(exprasmlist,left.location);
case torddef(left.resulttype.def).typ of
u32bit,
scurrency,
s64bit:
exprasmlist.concat(taicpu.op_ref(A_FILD,S_IQ,left.location.reference));
u64bit:
begin
{ unsigned 64 bit ints are harder to handle: }
{ we load bits 0..62 and then check bit 63: }
{ if it is 1 then we add $80000000 000000000 }
{ as double }
inc(left.location.reference.offset,4);
hregister:=cg.getintregister(exprasmlist,OS_32);
cg.a_load_ref_reg(exprasmlist,OS_INT,OS_INT,left.location.reference,hregister);
emit_const_ref(A_AND,S_L,$7fffffff,left.location.reference);
emit_const_reg(A_TEST,S_L,longint($80000000),hregister);
cg.ungetregister(exprasmlist,hregister);
dec(left.location.reference.offset,4);
exprasmlist.concat(taicpu.op_ref(A_FILD,S_IQ,left.location.reference));
objectlibrary.getdatalabel(l1);
objectlibrary.getlabel(l2);
cg.a_jmp_flags(exprasmlist,F_E,l2);
Consts.concat(Tai_label.Create(l1));
{ I got this constant from a test progtram (FK) }
Consts.concat(Tai_const.Create_32bit(0));
Consts.concat(Tai_const.Create_32bit(1138753536));
reference_reset_symbol(href,l1,0);
emit_ref(A_FADD,S_FL,href);
cg.a_label(exprasmlist,l2);
end
else
begin
if left.resulttype.def.size<4 then
begin
tg.GetTemp(exprasmlist,4,tt_normal,href);
location_freetemp(exprasmlist,left.location);
cg.a_load_ref_ref(exprasmlist,left.location.size,OS_32,left.location.reference,href);
left.location.reference:=href;
end;
exprasmlist.concat(taicpu.op_ref(A_FILD,S_IL,left.location.reference));
end;
end;
location_freetemp(exprasmlist,left.location);
tcgx86(cg).inc_fpu_stack;
location.register:=NR_ST;
end;
begin
ctypeconvnode:=ti386typeconvnode;
end.
{
$Log$
Revision 1.71 2003-12-22 23:08:59 peter
Revision 1.72 2004-02-05 01:24:08 florian
* several fixes to compile x86-64 system
Revision 1.71 2003/12/22 23:08:59 peter
* removed unused checkobject method
Revision 1.70 2003/12/08 15:35:00 peter

323
compiler/i386/n386inl.pas
View File

@ -27,333 +27,26 @@ unit n386inl;
interface
uses
node,ninl,ncginl;
nx86inl;
type
ti386inlinenode = class(tcginlinenode)
{ first pass override
so that the code generator will actually generate
these nodes.
}
function first_pi: tnode ; override;
function first_arctan_real: tnode; override;
function first_abs_real: tnode; override;
function first_sqr_real: tnode; override;
function first_sqrt_real: tnode; override;
function first_ln_real: tnode; override;
function first_cos_real: tnode; override;
function first_sin_real: tnode; override;
{ second pass override to generate these nodes }
procedure second_IncludeExclude;override;
procedure second_pi; override;
procedure second_arctan_real; override;
procedure second_abs_real; override;
procedure second_sqr_real; override;
procedure second_sqrt_real; override;
procedure second_ln_real; override;
procedure second_cos_real; override;
procedure second_sin_real; override;
procedure second_prefetch;override;
private
procedure load_fpu_location;
ti386inlinenode = class(tx86inlinenode)
end;
implementation
uses
systems,
globals,
cutils,verbose,
defutil,
aasmtai,aasmcpu,
cgbase,pass_2,
cpuinfo,cpubase,paramgr,
nbas,ncon,ncal,ncnv,nld,
cga,cgx86,cgobj;
{*****************************************************************************
TI386INLINENODE
*****************************************************************************}
function ti386inlinenode.first_pi : tnode;
begin
expectloc:=LOC_FPUREGISTER;
registersfpu:=1;
first_pi := nil;
end;
function ti386inlinenode.first_arctan_real : tnode;
begin
expectloc:=LOC_FPUREGISTER;
registersint:=left.registersint;
registersfpu:=max(left.registersfpu,2);
{$ifdef SUPPORT_MMX}
registersmmx:=left.registersmmx;
{$endif SUPPORT_MMX}
first_arctan_real := nil;
end;
function ti386inlinenode.first_abs_real : tnode;
begin
expectloc:=LOC_FPUREGISTER;
registersint:=left.registersint;
registersfpu:=max(left.registersfpu,1);
{$ifdef SUPPORT_MMX}
registersmmx:=left.registersmmx;
{$endif SUPPORT_MMX}
first_abs_real := nil;
end;
function ti386inlinenode.first_sqr_real : tnode;
begin
expectloc:=LOC_FPUREGISTER;
registersint:=left.registersint;
registersfpu:=max(left.registersfpu,1);
{$ifdef SUPPORT_MMX}
registersmmx:=left.registersmmx;
{$endif SUPPORT_MMX}
first_sqr_real := nil;
end;
function ti386inlinenode.first_sqrt_real : tnode;
begin
expectloc:=LOC_FPUREGISTER;
registersint:=left.registersint;
registersfpu:=max(left.registersfpu,1);
{$ifdef SUPPORT_MMX}
registersmmx:=left.registersmmx;
{$endif SUPPORT_MMX}
first_sqrt_real := nil;
end;
function ti386inlinenode.first_ln_real : tnode;
begin
expectloc:=LOC_FPUREGISTER;
registersint:=left.registersint;
registersfpu:=max(left.registersfpu,2);
{$ifdef SUPPORT_MMX}
registersmmx:=left.registersmmx;
{$endif SUPPORT_MMX}
first_ln_real := nil;
end;
function ti386inlinenode.first_cos_real : tnode;
begin
expectloc:=LOC_FPUREGISTER;
registersint:=left.registersint;
registersfpu:=max(left.registersfpu,1);
{$ifdef SUPPORT_MMX}
registersmmx:=left.registersmmx;
{$endif SUPPORT_MMX}
first_cos_real := nil;
end;
function ti386inlinenode.first_sin_real : tnode;
begin
expectloc:=LOC_FPUREGISTER;
registersint:=left.registersint;
registersfpu:=max(left.registersfpu,1);
{$ifdef SUPPORT_MMX}
registersmmx:=left.registersmmx;
{$endif SUPPORT_MMX}
first_sin_real := nil;
end;
procedure ti386inlinenode.second_Pi;
begin
location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
emit_none(A_FLDPI,S_NO);
tcgx86(cg).inc_fpu_stack;
location.register:=NR_FPU_RESULT_REG;
end;
{ load the FPU into the an fpu register }
procedure ti386inlinenode.load_fpu_location;
begin
location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
location.register:=NR_FPU_RESULT_REG;
secondpass(left);
case left.location.loc of
LOC_FPUREGISTER:
;
LOC_CFPUREGISTER:
begin
cg.a_loadfpu_reg_reg(exprasmlist,left.location.size,
left.location.register,location.register);
end;
LOC_REFERENCE,LOC_CREFERENCE:
begin
cg.a_loadfpu_ref_reg(exprasmlist,
def_cgsize(left.resulttype.def),
left.location.reference,location.register);
location_release(exprasmlist,left.location);
end
else
internalerror(309991);
end;
end;
procedure ti386inlinenode.second_arctan_real;
begin
load_fpu_location;
emit_none(A_FLD1,S_NO);
emit_none(A_FPATAN,S_NO);
end;
procedure ti386inlinenode.second_abs_real;
begin
load_fpu_location;
emit_none(A_FABS,S_NO);
end;
procedure ti386inlinenode.second_sqr_real;
begin
load_fpu_location;
emit_reg_reg(A_FMUL,S_NO,NR_ST0,NR_ST0);
end;
procedure ti386inlinenode.second_sqrt_real;
begin
load_fpu_location;
emit_none(A_FSQRT,S_NO);
end;
procedure ti386inlinenode.second_ln_real;
begin
load_fpu_location;
emit_none(A_FLDLN2,S_NO);
emit_none(A_FXCH,S_NO);
emit_none(A_FYL2X,S_NO);
end;
procedure ti386inlinenode.second_cos_real;
begin
load_fpu_location;
emit_none(A_FCOS,S_NO);
end;
procedure ti386inlinenode.second_sin_real;
begin
load_fpu_location;
emit_none(A_FSIN,S_NO)
end;
procedure ti386inlinenode.second_prefetch;
var
ref : treference;
r : tregister;
begin
if aktspecificoptprocessor>=ClassPentium3 then
begin
secondpass(left);
case left.location.loc of
LOC_CREFERENCE,
LOC_REFERENCE:
begin
r:=cg.getintregister(exprasmlist,OS_ADDR);
cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,r);
location_release(exprasmlist,left.location);
reference_reset(ref);
ref.base:=r;
exprasmlist.concat(taicpu.op_ref(A_PREFETCHNTA,S_NO,ref));
cg.ungetregister(exprasmlist,r);
end;
else
internalerror(200402021);
end;
end;
end;
{*****************************************************************************
INCLUDE/EXCLUDE GENERIC HANDLING
*****************************************************************************}
procedure ti386inlinenode.second_IncludeExclude;
var
hregister : tregister;
asmop : tasmop;
L : cardinal;
cgop : topcg;
begin
secondpass(tcallparanode(left).left);
if tcallparanode(tcallparanode(left).right).left.nodetype=ordconstn then
begin
{ calculate bit position }
l:=cardinal(1 shl (tordconstnode(tcallparanode(tcallparanode(left).right).left).value mod 32));
{ determine operator }
if inlinenumber=in_include_x_y then
cgop:=OP_OR
else
begin
cgop:=OP_AND;
l:=not(l);
end;
if (tcallparanode(left).left.location.loc=LOC_REFERENCE) then
begin
inc(tcallparanode(left).left.location.reference.offset,
(tordconstnode(tcallparanode(tcallparanode(left).right).left).value div 32)*4);
cg.a_op_const_ref(exprasmlist,cgop,OS_INT,l,tcallparanode(left).left.location.reference);
location_release(exprasmlist,tcallparanode(left).left.location);
end
else
{ LOC_CREGISTER }
begin
cg.a_op_const_reg(exprasmlist,cgop,tcallparanode(left).left.location.size,
l,tcallparanode(left).left.location.register);
end;
end
else
begin
{ generate code for the element to set }
secondpass(tcallparanode(tcallparanode(left).right).left);
{ determine asm operator }
if inlinenumber=in_include_x_y then
asmop:=A_BTS
else
asmop:=A_BTR;
if tcallparanode(tcallparanode(left).right).left.location.loc in [LOC_CREGISTER,LOC_REGISTER] then
{ we don't need a mod 32 because this is done automatically }
{ by the bts instruction. For proper checking we would }
{ note: bts doesn't do any mod'ing, that's why we can also use }
{ it for normalsets! (JM) }
{ need a cmp and jmp, but this should be done by the }
{ type cast code which does range checking if necessary (FK) }
begin
hregister:=cg.makeregsize(Tcallparanode(Tcallparanode(left).right).left.location.register,OS_INT);
end
else
begin
hregister:=cg.getintregister(exprasmlist,OS_INT);
end;
location_release(exprasmlist,tcallparanode(tcallparanode(left).right).left.location);
cg.a_load_loc_reg(exprasmlist,OS_INT,tcallparanode(tcallparanode(left).right).left.location,hregister);
if (tcallparanode(left).left.location.loc=LOC_REFERENCE) then
emit_reg_ref(asmop,S_L,hregister,tcallparanode(left).left.location.reference)
else
emit_reg_reg(asmop,S_L,hregister,tcallparanode(left).left.location.register);
cg.ungetregister(exprasmlist,hregister);
location_release(exprasmlist,Tcallparanode(left).left.location);
end;
end;
uses
ninl;
begin
cinlinenode:=ti386inlinenode;
end.
{
$Log$
Revision 1.72 2004-02-03 22:32:54 peter
Revision 1.73 2004-02-05 01:24:08 florian
* several fixes to compile x86-64 system
Revision 1.72 2004/02/03 22:32:54 peter
* renamed xNNbittype to xNNinttype
* renamed registers32 to registersint
* replace some s32bit,u32bit with torddef([su]inttype).def.typ

20
compiler/nadd.pas
View File

@ -550,13 +550,13 @@ implementation
case nodetype of
addn :
begin
resultset:=tsetconstnode(right).value_set^ + tsetconstnode(left).value_set^;
t:=csetconstnode.create(@resultset,left.resulttype);
resultset:=tsetconstnode(right).value_set^ + tsetconstnode(left).value_set^;
t:=csetconstnode.create(@resultset,left.resulttype);
end;
muln :
begin
resultset:=tsetconstnode(right).value_set^ * tsetconstnode(left).value_set^;
t:=csetconstnode.create(@resultset,left.resulttype);
resultset:=tsetconstnode(right).value_set^ * tsetconstnode(left).value_set^;
t:=csetconstnode.create(@resultset,left.resulttype);
end;
subn :
begin
@ -756,6 +756,8 @@ implementation
if (torddef(rd).typ<>u64bit) then
inserttypeconv(right,u64inttype);
end
{ 64 bit cpus do calculations always in 64 bit }
{$ifndef cpu64bit}
{ is there a cardinal? }
else if ((torddef(rd).typ=u32bit) or (torddef(ld).typ=u32bit)) then
begin
@ -809,7 +811,8 @@ implementation
end;
end;
end
{ generic ord conversion is s32bit }
{$endif cpu64bit}
{ generic ord conversion is sinttype }
else
begin
{ if the left or right value is smaller than the normal
@ -1625,6 +1628,7 @@ implementation
expectloc:=LOC_FLAGS;
calcregisters(self,1,0,0);
end
{$ifndef cpu64bit}
{ is there a 64 bit type ? }
else if (torddef(ld).typ in [s64bit,u64bit,scurrency]) then
begin
@ -1637,6 +1641,7 @@ implementation
expectloc:=LOC_JUMP;
calcregisters(self,2,0,0)
end
{$endif cpu64bit}
{ is there a cardinal? }
else if (torddef(ld).typ=u32bit) then
begin
@ -1905,7 +1910,10 @@ begin
end.
{
$Log$
Revision 1.109 2004-02-03 22:32:54 peter
Revision 1.110 2004-02-05 01:24:08 florian
* several fixes to compile x86-64 system
Revision 1.109 2004/02/03 22:32:54 peter
* renamed xNNbittype to xNNinttype
* renamed registers32 to registersint
* replace some s32bit,u32bit with torddef([su]inttype).def.typ

32
compiler/ncal.pas
View File

@ -54,6 +54,11 @@ interface
wrongparanr : byte;
end;
tcallnodeflags = (
cnf_restypeset
);
tcallnodeflagset = set of tcallnodeflags;
tcallnode = class(tbinarynode)
private
{ number of parameters passed from the source, this does not include the hidden parameters }
@ -104,7 +109,7 @@ interface
{ you can't have a function with an "array of char" resulttype }
{ the RTL) (JM) }
restype: ttype;
restypeset: boolean;
callnodeflags : tcallnodeflagset;
{ only the processor specific nodes need to override this }
{ constructor }
@ -822,7 +827,7 @@ type
include(flags,nf_return_value_used);
methodpointer:=mp;
procdefinition:=nil;
restypeset:=false;
callnodeflags:=[];
_funcretnode:=nil;
inlinecode:=nil;
paralength:=-1;
@ -838,7 +843,7 @@ type
include(flags,nf_return_value_used);
methodpointer:=mp;
procdefinition:=def;
restypeset:=false;
callnodeflags:=[];
_funcretnode:=nil;
inlinecode:=nil;
paralength:=-1;
@ -854,7 +859,7 @@ type
include(flags,nf_return_value_used);
methodpointer:=nil;
procdefinition:=nil;
restypeset:=false;
callnodeflags:=[];
_funcretnode:=nil;
inlinecode:=nil;
paralength:=-1;
@ -894,7 +899,7 @@ type
begin
self.createintern(name,params);
restype := res;
restypeset := true;
include(callnodeflags,cnf_restypeset);
{ both the normal and specified resulttype either have to be returned via a }
{ parameter or not, but no mixing (JM) }
if paramanager.ret_in_param(restype.def,pocall_compilerproc) xor
@ -966,7 +971,7 @@ type
{$endif}
symtableproc:=nil;
ppufile.getderef(procdefinitionderef);
restypeset:=boolean(ppufile.getbyte);
ppufile.getsmallset(callnodeflags);
methodpointer:=ppuloadnode(ppufile);
_funcretnode:=ppuloadnode(ppufile);
inlinecode:=ppuloadnode(ppufile);
@ -978,7 +983,7 @@ type
inherited ppuwrite(ppufile);
ppufile.putderef(symtableprocentryderef);
ppufile.putderef(procdefinitionderef);
ppufile.putbyte(byte(restypeset));
ppufile.putsmallset(callnodeflags);
ppuwritenode(ppufile,methodpointer);
ppuwritenode(ppufile,_funcretnode);
ppuwritenode(ppufile,inlinecode);
@ -1043,7 +1048,7 @@ type
n.symtableproc:=symtableproc;
n.procdefinition:=procdefinition;
n.restype := restype;
n.restypeset := restypeset;
n.callnodeflags := callnodeflags;
if assigned(methodpointer) then
n.methodpointer:=methodpointer.getcopy
else
@ -2220,7 +2225,7 @@ type
end;
{ ensure that the result type is set }
if not restypeset then
if not(cnf_restypeset in callnodeflags) then
begin
{ constructors return their current class type, not the type where the
constructor is declared, this can be different because of inheritance }
@ -2681,9 +2686,9 @@ type
(symtableprocentry = tcallnode(p).symtableprocentry) and
(procdefinition = tcallnode(p).procdefinition) and
(methodpointer.isequal(tcallnode(p).methodpointer)) and
((restypeset and tcallnode(p).restypeset and
(((cnf_restypeset in callnodeflags) and (cnf_restypeset in tcallnode(p).callnodeflags) and
(equal_defs(restype.def,tcallnode(p).restype.def))) or
(not restypeset and not tcallnode(p).restypeset));
(not(cnf_restypeset in callnodeflags) and not(cnf_restypeset in tcallnode(p).callnodeflags)));
end;
@ -2711,7 +2716,10 @@ begin
end.
{
$Log$
Revision 1.222 2004-02-03 22:32:54 peter
Revision 1.223 2004-02-05 01:24:08 florian
* several fixes to compile x86-64 system
Revision 1.222 2004/02/03 22:32:54 peter
* renamed xNNbittype to xNNinttype
* renamed registers32 to registersint
* replace some s32bit,u32bit with torddef([su]inttype).def.typ

7
compiler/ncgcnv.pas
View File

@ -466,7 +466,7 @@ interface
{$ifdef fpc}
{$warning todo: add RTL routine for widechar-char conversion }
{$endif}
{ Quick hack to atleast generate 'working' code (PFV) }
{ Quick hack to at least generate 'working' code (PFV) }
second_int_to_int;
end;
@ -535,7 +535,10 @@ end.
{
$Log$
Revision 1.53 2004-01-31 17:45:17 peter
Revision 1.54 2004-02-05 01:24:08 florian
* several fixes to compile x86-64 system
Revision 1.53 2004/01/31 17:45:17 peter
* Change several $ifdef i386 to x86
* Change several OS_32 to OS_INT/OS_ADDR

12
compiler/ncginl.pas
View File

@ -327,10 +327,11 @@ implementation
begin
{ length in ansi strings is at offset -8 }
location_force_reg(exprasmlist,left.location,OS_ADDR,false);
hregister:=left.location.register;
objectlibrary.getlabel(lengthlab);
cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,hregister,lengthlab);
reference_reset_base(href,hregister,-8);
cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,left.location.register,lengthlab);
reference_reset_base(href,left.location.register,-8);
reference_release(exprasmlist,href);
hregister:=cg.getintregister(exprasmlist,OS_32);
cg.a_load_ref_reg(exprasmlist,OS_32,OS_32,href,hregister);
cg.a_label(exprasmlist,lengthlab);
location_reset(location,LOC_REGISTER,OS_32);
@ -676,7 +677,10 @@ end.
{
$Log$
Revision 1.52 2004-02-02 20:41:59 florian
Revision 1.53 2004-02-05 01:24:08 florian
* several fixes to compile x86-64 system
Revision 1.52 2004/02/02 20:41:59 florian
+ added prefetch(const mem) support
Revision 1.51 2004/01/31 17:45:17 peter

11
compiler/ncgld.pas
View File

@ -611,10 +611,10 @@ implementation
begin
cgsize:=def_cgsize(left.resulttype.def);
if cgsize in [OS_64,OS_S64] then
cg64.a_load64_reg_loc(exprasmlist,
right.location.register64,left.location)
cg64.a_load64_reg_loc(exprasmlist,
right.location.register64,left.location)
else
cg.a_load_reg_loc(exprasmlist,right.location.size,right.location.register,left.location);
cg.a_load_reg_loc(exprasmlist,right.location.size,right.location.register,left.location);
end;
LOC_FPUREGISTER,LOC_CFPUREGISTER :
begin
@ -906,7 +906,10 @@ begin
end.
{
$Log$
Revision 1.106 2004-02-03 22:32:54 peter
Revision 1.107 2004-02-05 01:24:08 florian
* several fixes to compile x86-64 system
Revision 1.106 2004/02/03 22:32:54 peter
* renamed xNNbittype to xNNinttype
* renamed registers32 to registersint
* replace some s32bit,u32bit with torddef([su]inttype).def.typ

162
compiler/ncgutil.pas
View File

@ -493,116 +493,64 @@ implementation
hregister : tregister;
hl : tasmlabel;
oldloc : tlocation;
begin
oldloc:=l;
if dst_size=OS_NO then
internalerror(200309144);
{ handle transformations to 64bit separate }
if dst_size in [OS_64,OS_S64] then
begin
{ load a smaller size to OS_64 }
if l.loc=LOC_REGISTER then
hregister:=cg.makeregsize(l.register,OS_INT)
else
begin
location_release(list,l);
hregister:=cg.getintregister(list,OS_INT);
end;
{ load value in low register }
case l.loc of
{$ifdef cpuflags}
LOC_FLAGS :
cg.g_flags2reg(list,OS_INT,l.resflags,hregister);
{$endif cpuflags}
LOC_JUMP :
begin
cg.a_label(list,truelabel);
cg.a_load_const_reg(list,OS_INT,1,hregister);
objectlibrary.getlabel(hl);
cg.a_jmp_always(list,hl);
cg.a_label(list,falselabel);
cg.a_load_const_reg(list,OS_INT,0,hregister);
cg.a_label(list,hl);
end;
else
cg.a_load_loc_reg(list,OS_INT,l,hregister);
end;
location_reset(l,LOC_REGISTER,dst_size);
l.register:=hregister;
end
else
begin
{ transformations to 32bit or smaller }
if l.loc=LOC_REGISTER then
begin
{Do not bother to recycle the existing register. The register
allocator eliminates unnecessary moves, so it's not needed
and trying to recycle registers can cause problems because
the registers changes size and may need aditional constraints.}
location_release(list,l);
hregister:=cg.getintregister(list,dst_size);
{ load value in new register }
case l.loc of
LOC_FLAGS :
cg.g_flags2reg(list,dst_size,l.resflags,hregister);
LOC_JUMP :
begin
hregister:=l.register;
end
else
begin
{ get new register }
if (l.loc=LOC_CREGISTER) and
maybeconst and
(TCGSize2Size[dst_size]=TCGSize2Size[l.size]) then
hregister:=l.register
else
begin
location_release(list,l);
hregister:=cg.getintregister(list,OS_INT);
end;
cg.a_label(list,truelabel);
cg.a_load_const_reg(list,dst_size,1,hregister);
objectlibrary.getlabel(hl);
cg.a_jmp_always(list,hl);
cg.a_label(list,falselabel);
cg.a_load_const_reg(list,dst_size,0,hregister);
cg.a_label(list,hl);
end;
hregister:=cg.makeregsize(hregister,dst_size);
{ load value in new register }
case l.loc of
{$ifdef cpuflags}
LOC_FLAGS :
cg.g_flags2reg(list,dst_size,l.resflags,hregister);
{$endif cpuflags}
LOC_JUMP :
else
begin
{ load_loc_reg can only handle size >= l.size, when the
new size is smaller then we need to adjust the size
of the orignal and maybe recalculate l.register for i386 }
if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
begin
cg.a_label(list,truelabel);
cg.a_load_const_reg(list,dst_size,1,hregister);
objectlibrary.getlabel(hl);
cg.a_jmp_always(list,hl);
cg.a_label(list,falselabel);
cg.a_load_const_reg(list,dst_size,0,hregister);
cg.a_label(list,hl);
end;
else
begin
{ load_loc_reg can only handle size >= l.size, when the
new size is smaller then we need to adjust the size
of the orignal and maybe recalculate l.register for i386 }
if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
begin
if (l.loc in [LOC_REGISTER,LOC_CREGISTER]) then
l.register:=cg.makeregsize(l.register,dst_size);
{ for big endian systems, the reference's offset must }
{ be increased in this case, since they have the }
{ MSB first in memory and e.g. byte(word_var) should }
{ return the second byte in this case (JM) }
if (target_info.endian = ENDIAN_BIG) and
(l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
inc(l.reference.offset,TCGSize2Size[l.size]-TCGSize2Size[dst_size]);
if (l.loc in [LOC_REGISTER,LOC_CREGISTER]) then
l.register:=cg.makeregsize(l.register,dst_size);
{ for big endian systems, the reference's offset must }
{ be increased in this case, since they have the }
{ MSB first in memory and e.g. byte(word_var) should }
{ return the second byte in this case (JM) }
if (target_info.endian = ENDIAN_BIG) and
(l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
inc(l.reference.offset,TCGSize2Size[l.size]-TCGSize2Size[dst_size]);
{$ifdef x86}
l.size:=dst_size;
l.size:=dst_size;
{$endif x86}
end;
cg.a_load_loc_reg(list,dst_size,l,hregister);
{$ifndef x86}
if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
l.size:=dst_size;
{$endif not x86}
end;
end;
location_reset(l,LOC_REGISTER,dst_size);
l.register:=hregister;
end;
{ Release temp when it was a reference }
if oldloc.loc=LOC_REFERENCE then
location_freetemp(list,oldloc);
end;
cg.a_load_loc_reg(list,dst_size,l,hregister);
{$ifndef x86}
if (TCGSize2Size[dst_size]<TCGSize2Size[l.size]) then
l.size:=dst_size;
{$endif not x86}
end;
end;
if (l.loc <> LOC_CREGISTER) or
not maybeconst then
location_reset(l,LOC_REGISTER,dst_size)
else
location_reset(l,LOC_CREGISTER,dst_size);
l.register:=hregister;
{ Release temp when it was a reference }
if oldloc.loc=LOC_REFERENCE then
location_freetemp(list,oldloc);
end;
{$endif cpu64bit}
@ -1976,6 +1924,7 @@ implementation
if not(po_assembler in current_procinfo.procdef.procoptions) then
begin
case paraitem.paraloc[calleeside].loc of
LOC_MMREGISTER,
LOC_FPUREGISTER,
LOC_REGISTER:
begin
@ -2188,7 +2137,10 @@ implementation
end.
{
$Log$
Revision 1.189 2004-02-04 22:15:15 daniel
Revision 1.190 2004-02-05 01:24:08 florian
* several fixes to compile x86-64 system
Revision 1.189 2004/02/04 22:15:15 daniel
* Rtti generation moved to ncgutil
* Assmtai usage of symsym removed
* operator overloading cleanup up

7
compiler/ncnv.pas
View File

@ -1482,9 +1482,11 @@ implementation
expectloc:=LOC_REGISTER
else
expectloc:=left.expectloc;
{$ifndef cpu64bit}
if is_64bit(resulttype.def) then
registersint:=max(registersint,2)
else
{$endif cpu64bit}
registersint:=max(registersint,1);
end;
@ -2405,7 +2407,10 @@ begin
end.
{
$Log$
Revision 1.137 2004-02-04 22:15:15 daniel
Revision 1.138 2004-02-05 01:24:08 florian
* several fixes to compile x86-64 system
Revision 1.137 2004/02/04 22:15:15 daniel
* Rtti generation moved to ncgutil
* Assmtai usage of symsym removed
* operator overloading cleanup up

19
compiler/nflw.pas
View File

@ -361,14 +361,14 @@ implementation
*****************************************************************************}
constructor Twhilerepeatnode.create(l,r,_t1:Tnode;tab,cn:boolean);
begin
inherited create(whilerepeatn,l,r,_t1,nil);
if tab then
include(loopflags, lnf_testatbegin);
if cn then
include(loopflags,lnf_checknegate);
end;
begin
inherited create(whilerepeatn,l,r,_t1,nil);
if tab then
include(loopflags, lnf_testatbegin);
if cn then
include(loopflags,lnf_checknegate);
end;
function twhilerepeatnode.det_resulttype:tnode;
var
@ -1475,7 +1475,10 @@ begin
end.
{
$Log$
Revision 1.93 2004-02-03 22:32:54 peter
Revision 1.94 2004-02-05 01:24:08 florian
* several fixes to compile x86-64 system
Revision 1.93 2004/02/03 22:32:54 peter
* renamed xNNbittype to xNNinttype
* renamed registers32 to registersint
* replace some s32bit,u32bit with torddef([su]inttype).def.typ

9
compiler/symdef.pas
View File

@ -2171,10 +2171,10 @@ implementation
{$ifdef cpu64bit}
case filetyp of
ft_text :
savesize:=592;
savesize:=616;
ft_typed,
ft_untyped :
savesize:=316;
savesize:=324;
end;
{$else cpu64bit}
case filetyp of
@ -6152,7 +6152,10 @@ implementation
end.
{
$Log$
Revision 1.214 2004-02-03 22:32:54 peter
Revision 1.215 2004-02-05 01:24:08 florian
* several fixes to compile x86-64 system
Revision 1.214 2004/02/03 22:32:54 peter
* renamed xNNbittype to xNNinttype
* renamed registers32 to registersint
* replace some s32bit,u32bit with torddef([su]inttype).def.typ

101
compiler/x86/nx86cnv.pas
View File

@ -41,8 +41,8 @@ interface
{ procedure second_pointer_to_array;override; }
{ procedure second_chararray_to_string;override; }
{ procedure second_char_to_string;override; }
{ function first_int_to_real: tnode; override; }
{ procedure second_int_to_real;override; }
function first_int_to_real: tnode; override;
procedure second_int_to_real;override;
{ procedure second_real_to_real;override; }
{ procedure second_cord_to_pointer;override; }
{ procedure second_proc_to_procvar;override; }
@ -60,12 +60,13 @@ implementation
uses
verbose,systems,globals,
aasmbase,aasmtai,
aasmbase,aasmtai,aasmcpu,
symconst,symdef,
cgbase,pass_2,
cgbase,cga,pass_2,
ncon,ncal,ncnv,
cpubase,
cgobj,cgx86,ncgutil;
cgobj,cgx86,ncgutil,
tgobj;
function tx86typeconvnode.first_real_to_real : tnode;
@ -188,10 +189,98 @@ implementation
falselabel:=oldfalselabel;
end;
function tx86typeconvnode.first_int_to_real : tnode;
begin
first_int_to_real:=nil;
if registersfpu<1 then
registersfpu:=1;
expectloc:=LOC_FPUREGISTER;
end;
procedure tx86typeconvnode.second_int_to_real;
var
href : treference;
hregister : tregister;
l1,l2 : tasmlabel;
begin
location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
{ We need to load from a reference }
location_force_mem(exprasmlist,left.location);
{ For u32bit we need to load it as comp and need to
make it 64bits }
if (torddef(left.resulttype.def).typ=u32bit) then
begin
tg.GetTemp(exprasmlist,8,tt_normal,href);
location_release(exprasmlist,left.location);
location_freetemp(exprasmlist,left.location);
cg.a_load_ref_ref(exprasmlist,left.location.size,OS_32,left.location.reference,href);
inc(href.offset,4);
cg.a_load_const_ref(exprasmlist,OS_32,0,href);
dec(href.offset,4);
left.location.reference:=href;
end;
{ Load from reference to fpu reg }
location_release(exprasmlist,left.location);
case torddef(left.resulttype.def).typ of
u32bit,
scurrency,
s64bit:
exprasmlist.concat(taicpu.op_ref(A_FILD,S_IQ,left.location.reference));
u64bit:
begin
{ unsigned 64 bit ints are harder to handle: }
{ we load bits 0..62 and then check bit 63: }
{ if it is 1 then we add $80000000 000000000 }
{ as double }
inc(left.location.reference.offset,4);
hregister:=cg.getintregister(exprasmlist,OS_32);
cg.a_load_ref_reg(exprasmlist,OS_INT,OS_INT,left.location.reference,hregister);
emit_const_ref(A_AND,S_L,$7fffffff,left.location.reference);
emit_const_reg(A_TEST,S_L,longint($80000000),hregister);
cg.ungetregister(exprasmlist,hregister);
dec(left.location.reference.offset,4);
exprasmlist.concat(taicpu.op_ref(A_FILD,S_IQ,left.location.reference));
objectlibrary.getdatalabel(l1);
objectlibrary.getlabel(l2);
cg.a_jmp_flags(exprasmlist,F_E,l2);
Consts.concat(Tai_label.Create(l1));
{ I got this constant from a test progtram (FK) }
Consts.concat(Tai_const.Create_32bit(0));
Consts.concat(Tai_const.Create_32bit(1138753536));
reference_reset_symbol(href,l1,0);
emit_ref(A_FADD,S_FL,href);
cg.a_label(exprasmlist,l2);
end
else
begin
if left.resulttype.def.size<4 then
begin
tg.GetTemp(exprasmlist,4,tt_normal,href);
location_freetemp(exprasmlist,left.location);
cg.a_load_ref_ref(exprasmlist,left.location.size,OS_32,left.location.reference,href);
left.location.reference:=href;
end;
exprasmlist.concat(taicpu.op_ref(A_FILD,S_IL,left.location.reference));
end;
end;
location_freetemp(exprasmlist,left.location);
tcgx86(cg).inc_fpu_stack;
location.register:=NR_ST;
end;
end.
{
$Log$
Revision 1.8 2003-12-26 00:32:22 florian
Revision 1.9 2004-02-05 01:24:08 florian
* several fixes to compile x86-64 system
Revision 1.8 2003/12/26 00:32:22 florian
+ fpu<->mm register conversion
Revision 1.7 2003/10/10 17:48:14 peter

358
compiler/x86/nx86inl.pas Normal file
View File

@ -0,0 +1,358 @@
{
$Id$
Copyright (c) 1998-2002 by Florian Klaempfl
Generate x86 inline nodes
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 nx86inl;
{$i fpcdefs.inc}
interface
uses
node,ninl,ncginl;
type
tx86inlinenode = class(tcginlinenode)
{ first pass override
so that the code generator will actually generate
these nodes.
}
function first_pi: tnode ; override;
function first_arctan_real: tnode; override;
function first_abs_real: tnode; override;
function first_sqr_real: tnode; override;
function first_sqrt_real: tnode; override;
function first_ln_real: tnode; override;
function first_cos_real: tnode; override;
function first_sin_real: tnode; override;
{ second pass override to generate these nodes }
procedure second_IncludeExclude;override;
procedure second_pi; override;
procedure second_arctan_real; override;
procedure second_abs_real; override;
procedure second_sqr_real; override;
procedure second_sqrt_real; override;
procedure second_ln_real; override;
procedure second_cos_real; override;
procedure second_sin_real; override;
procedure second_prefetch;override;
private
procedure load_fpu_location;
end;
implementation
uses
systems,
globals,
cutils,verbose,
defutil,
aasmtai,aasmcpu,
cgbase,pass_2,
cpuinfo,cpubase,paramgr,
nbas,ncon,ncal,ncnv,nld,
cga,cgx86,cgobj;
{*****************************************************************************
TX86INLINENODE
*****************************************************************************}
function tx86inlinenode.first_pi : tnode;
begin
expectloc:=LOC_FPUREGISTER;
registersfpu:=1;
first_pi := nil;
end;
function tx86inlinenode.first_arctan_real : tnode;
begin
expectloc:=LOC_FPUREGISTER;
registersint:=left.registersint;
registersfpu:=max(left.registersfpu,2);
{$ifdef SUPPORT_MMX}
registersmmx:=left.registersmmx;
{$endif SUPPORT_MMX}
first_arctan_real := nil;
end;
function tx86inlinenode.first_abs_real : tnode;
begin
expectloc:=LOC_FPUREGISTER;
registersint:=left.registersint;
registersfpu:=max(left.registersfpu,1);
{$ifdef SUPPORT_MMX}
registersmmx:=left.registersmmx;
{$endif SUPPORT_MMX}
first_abs_real := nil;
end;
function tx86inlinenode.first_sqr_real : tnode;
begin
expectloc:=LOC_FPUREGISTER;
registersint:=left.registersint;
registersfpu:=max(left.registersfpu,1);
{$ifdef SUPPORT_MMX}
registersmmx:=left.registersmmx;
{$endif SUPPORT_MMX}
first_sqr_real := nil;
end;
function tx86inlinenode.first_sqrt_real : tnode;
begin
expectloc:=LOC_FPUREGISTER;
registersint:=left.registersint;
registersfpu:=max(left.registersfpu,1);
{$ifdef SUPPORT_MMX}
registersmmx:=left.registersmmx;
{$endif SUPPORT_MMX}
first_sqrt_real := nil;
end;
function tx86inlinenode.first_ln_real : tnode;
begin
expectloc:=LOC_FPUREGISTER;
registersint:=left.registersint;
registersfpu:=max(left.registersfpu,2);
{$ifdef SUPPORT_MMX}
registersmmx:=left.registersmmx;
{$endif SUPPORT_MMX}
first_ln_real := nil;
end;
function tx86inlinenode.first_cos_real : tnode;
begin
expectloc:=LOC_FPUREGISTER;
registersint:=left.registersint;
registersfpu:=max(left.registersfpu,1);
{$ifdef SUPPORT_MMX}
registersmmx:=left.registersmmx;
{$endif SUPPORT_MMX}
first_cos_real := nil;
end;
function tx86inlinenode.first_sin_real : tnode;
begin
expectloc:=LOC_FPUREGISTER;
registersint:=left.registersint;
registersfpu:=max(left.registersfpu,1);
{$ifdef SUPPORT_MMX}
registersmmx:=left.registersmmx;
{$endif SUPPORT_MMX}
first_sin_real := nil;
end;
procedure tx86inlinenode.second_Pi;
begin
location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
emit_none(A_FLDPI,S_NO);
tcgx86(cg).inc_fpu_stack;
location.register:=NR_FPU_RESULT_REG;
end;
{ load the FPU into the an fpu register }
procedure tx86inlinenode.load_fpu_location;
begin
location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
location.register:=NR_FPU_RESULT_REG;
secondpass(left);
case left.location.loc of
LOC_FPUREGISTER:
;
LOC_CFPUREGISTER:
begin
cg.a_loadfpu_reg_reg(exprasmlist,left.location.size,
left.location.register,location.register);
end;
LOC_REFERENCE,LOC_CREFERENCE:
begin
cg.a_loadfpu_ref_reg(exprasmlist,
def_cgsize(left.resulttype.def),
left.location.reference,location.register);
location_release(exprasmlist,left.location);
end
else
internalerror(309991);
end;
end;
procedure tx86inlinenode.second_arctan_real;
begin
load_fpu_location;
emit_none(A_FLD1,S_NO);
emit_none(A_FPATAN,S_NO);
end;
procedure tx86inlinenode.second_abs_real;
begin
load_fpu_location;
emit_none(A_FABS,S_NO);
end;
procedure tx86inlinenode.second_sqr_real;
begin
load_fpu_location;
emit_reg_reg(A_FMUL,S_NO,NR_ST0,NR_ST0);
end;
procedure tx86inlinenode.second_sqrt_real;
begin
load_fpu_location;
emit_none(A_FSQRT,S_NO);
end;
procedure tx86inlinenode.second_ln_real;
begin
load_fpu_location;
emit_none(A_FLDLN2,S_NO);
emit_none(A_FXCH,S_NO);
emit_none(A_FYL2X,S_NO);
end;
procedure tx86inlinenode.second_cos_real;
begin
load_fpu_location;
emit_none(A_FCOS,S_NO);
end;
procedure tx86inlinenode.second_sin_real;
begin
load_fpu_location;
emit_none(A_FSIN,S_NO)
end;
procedure tx86inlinenode.second_prefetch;
var
ref : treference;
r : tregister;
begin
{$ifdef i386}
if aktspecificoptprocessor>=ClassPentium3 then
{$endif i386}
begin
secondpass(left);
case left.location.loc of
LOC_CREFERENCE,
LOC_REFERENCE:
begin
r:=cg.getintregister(exprasmlist,OS_ADDR);
cg.a_loadaddr_ref_reg(exprasmlist,left.location.reference,r);
location_release(exprasmlist,left.location);
reference_reset(ref);
ref.base:=r;
exprasmlist.concat(taicpu.op_ref(A_PREFETCHNTA,S_NO,ref));
cg.ungetregister(exprasmlist,r);
end;
else
internalerror(200402021);
end;
end;
end;
{*****************************************************************************
INCLUDE/EXCLUDE GENERIC HANDLING
*****************************************************************************}
procedure tx86inlinenode.second_IncludeExclude;
var
hregister : tregister;
asmop : tasmop;
L : cardinal;
cgop : topcg;
begin
secondpass(tcallparanode(left).left);
if tcallparanode(tcallparanode(left).right).left.nodetype=ordconstn then
begin
{ calculate bit position }
l:=cardinal(1 shl (tordconstnode(tcallparanode(tcallparanode(left).right).left).value mod 32));
{ determine operator }
if inlinenumber=in_include_x_y then
cgop:=OP_OR
else
begin
cgop:=OP_AND;
l:=not(l);
end;
if (tcallparanode(left).left.location.loc=LOC_REFERENCE) then
begin
inc(tcallparanode(left).left.location.reference.offset,
(tordconstnode(tcallparanode(tcallparanode(left).right).left).value div 32)*4);
cg.a_op_const_ref(exprasmlist,cgop,OS_INT,l,tcallparanode(left).left.location.reference);
location_release(exprasmlist,tcallparanode(left).left.location);
end
else
{ LOC_CREGISTER }
begin
cg.a_op_const_reg(exprasmlist,cgop,tcallparanode(left).left.location.size,
l,tcallparanode(left).left.location.register);
end;
end
else
begin
{ generate code for the element to set }
secondpass(tcallparanode(tcallparanode(left).right).left);
{ determine asm operator }
if inlinenumber=in_include_x_y then
asmop:=A_BTS
else
asmop:=A_BTR;
if tcallparanode(tcallparanode(left).right).left.location.loc in [LOC_CREGISTER,LOC_REGISTER] then
{ we don't need a mod 32 because this is done automatically }
{ by the bts instruction. For proper checking we would }
{ note: bts doesn't do any mod'ing, that's why we can also use }
{ it for normalsets! (JM) }
{ need a cmp and jmp, but this should be done by the }
{ type cast code which does range checking if necessary (FK) }
begin
hregister:=cg.makeregsize(Tcallparanode(Tcallparanode(left).right).left.location.register,OS_INT);
end
else
begin
hregister:=cg.getintregister(exprasmlist,OS_INT);
end;
location_release(exprasmlist,tcallparanode(tcallparanode(left).right).left.location);
cg.a_load_loc_reg(exprasmlist,OS_INT,tcallparanode(tcallparanode(left).right).left.location,hregister);
if (tcallparanode(left).left.location.loc=LOC_REFERENCE) then
emit_reg_ref(asmop,S_L,hregister,tcallparanode(left).left.location.reference)
else
emit_reg_reg(asmop,S_L,hregister,tcallparanode(left).left.location.register);
cg.ungetregister(exprasmlist,hregister);
location_release(exprasmlist,Tcallparanode(left).left.location);
end;
end;
end.
{
$Log$
Revision 1.1 2004-02-05 01:24:08 florian
* several fixes to compile x86-64 system
}

9
compiler/x86_64/cpunode.pas
View File

@ -42,7 +42,6 @@ unit cpunode;
ncgcon,
ncgcal,
ncgset,
ncginl,
ncgopt,
// n386con,n386flw,n386mat,n386mem,
// n386set,n386inl,n386opt,
@ -52,13 +51,17 @@ unit cpunode;
get the correct class pointer }
nx64add,
nx64cnv,
nx64mat
nx64mat,
nx64inl
;
end.
{
$Log$
Revision 1.6 2004-01-31 17:45:17 peter
Revision 1.7 2004-02-05 01:24:08 florian
* several fixes to compile x86-64 system
Revision 1.6 2004/01/31 17:45:17 peter
* Change several $ifdef i386 to x86
* Change several OS_32 to OS_INT/OS_ADDR

39
compiler/x86_64/nx64add.pas
View File

@ -51,23 +51,23 @@ interface
hl4 : tasmlabel;
begin
{The location.register will be filled in later (JM)}
{ The location.register will be filled in later (JM) }
location_reset(location,LOC_REGISTER,OS_INT);
{Get a temp register and load the left value into it
and free the location.}
{ Get a temp register and load the left value into it
and free the location. }
r:=cg.getintregister(exprasmlist,OS_INT);
cg.a_load_loc_reg(exprasmlist,OS_INT,left.location,r);
location_release(exprasmlist,left.location);
{Allocate EAX.}
cg.getexplicitregister(exprasmlist,NR_EAX);
{Load the right value.}
cg.a_load_loc_reg(exprasmlist,OS_INT,right.location,NR_EAX);
{ Allocate RAX. }
cg.getexplicitregister(exprasmlist,NR_RAX);
{ Load the right value. }
cg.a_load_loc_reg(exprasmlist,OS_INT,right.location,NR_RAX);
location_release(exprasmlist,right.location);
{The mul instruction frees register r.}
{ The mul instruction frees register r.}
cg.ungetregister(exprasmlist,r);
{Also allocate EDX, since it is also modified by a mul (JM).}
cg.getexplicitregister(exprasmlist,NR_EDX);
emit_reg(A_MUL,S_L,r);
{ Also allocate RDX, since it is also modified by a mul (JM). }
cg.getexplicitregister(exprasmlist,NR_RDX);
emit_reg(A_MUL,S_Q,r);
if cs_check_overflow in aktlocalswitches then
begin
objectlibrary.getlabel(hl4);
@ -75,13 +75,13 @@ interface
cg.a_call_name(exprasmlist,'FPC_OVERFLOW');
cg.a_label(exprasmlist,hl4);
end;
{Free EDX}
cg.ungetregister(exprasmlist,NR_EDX);
{Free EAX}
cg.ungetregister(exprasmlist,NR_EAX);
{Allocate a new register and store the result in EAX in it.}
{ Free RDX }
cg.ungetregister(exprasmlist,NR_RDX);
{ Free RAX }
cg.ungetregister(exprasmlist,NR_RAX);
{ Allocate a new register and store the result in RAX in it. }
location.register:=cg.getintregister(exprasmlist,OS_INT);
emit_reg_reg(A_MOV,S_L,NR_EAX,location.register);
emit_reg_reg(A_MOV,S_L,NR_RAX,location.register);
location_freetemp(exprasmlist,left.location);
location_freetemp(exprasmlist,right.location);
end;
@ -92,6 +92,9 @@ begin
end.
{
$Log$
Revision 1.1 2004-01-20 12:59:37 florian
Revision 1.2 2004-02-05 01:24:08 florian
* several fixes to compile x86-64 system
Revision 1.1 2004/01/20 12:59:37 florian
* common addnode code for x86-64 and i386
}

26
compiler/x86_64/nx64cnv.pas
View File

@ -31,7 +31,7 @@ interface
nx86cnv;
type
tx86_64typeconvnode = class(tx86typeconvnode)
tx8664typeconvnode = class(tx86typeconvnode)
protected
{ procedure second_int_to_int;override; }
{ procedure second_string_to_string;override; }
@ -42,7 +42,7 @@ interface
{ procedure second_chararray_to_string;override; }
{ procedure second_char_to_string;override; }
{ function first_int_to_real: tnode; override; }
procedure second_int_to_real;override;
{ procedure second_int_to_real;override; }
{ procedure second_real_to_real;override; }
{ procedure second_cord_to_pointer;override; }
{ procedure second_proc_to_procvar;override; }
@ -58,27 +58,19 @@ interface
implementation
uses
verbose,systems,globtype,
symconst,symdef,aasmbase,aasmtai,aasmcpu,
cgbase,pass_2,
ncon,ncal,ncnv,
cpubase,
cgobj,cga,tgobj,rgobj,rgcpu,ncgutil;
procedure tx86_64typeconvnode.second_int_to_real;
begin
internalerror(200304305);
end;
uses
ncnv;
begin
ctypeconvnode:=tx86_64typeconvnode;
ctypeconvnode:=tx8664typeconvnode;
end.
{
$Log$
Revision 1.2 2003-12-24 00:33:10 florian
Revision 1.3 2004-02-05 01:24:08 florian
* several fixes to compile x86-64 system
Revision 1.2 2003/12/24 00:33:10 florian
* x86-64 compilation fixed
Revision 1.1 2003/04/30 20:53:32 florian

48
compiler/x86_64/nx64inl.pas Normal file
View File

@ -0,0 +1,48 @@
{
$Id$
Copyright (c) 1998-2002 by Florian Klaempfl
Generate x86-64 inline nodes
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 nx64inl;
{$i fpcdefs.inc}
interface
uses
nx86inl;
type
tx8664inlinenode = class(tx86inlinenode)
end;
implementation
uses
ninl;
begin
cinlinenode:=tx8664inlinenode;
end.
{
$Log$
Revision 1.1 2004-02-05 01:24:08 florian
* several fixes to compile x86-64 system
}

8
compiler/x86_64/nx64mat.pas
View File

@ -41,6 +41,8 @@ interface
tx8664unaryminusnode = class(tx86unaryminusnode)
end;
tx8664notnode = class(tx86notnode)
end;
implementation
@ -199,10 +201,14 @@ begin
cunaryminusnode:=tx8664unaryminusnode;
cmoddivnode:=tx8664moddivnode;
cshlshrnode:=tx8664shlshrnode;
cnotnode:=tx8664notnode;
end.
{
$Log$
Revision 1.2 2004-02-04 19:22:27 peter
Revision 1.3 2004-02-05 01:24:08 florian
* several fixes to compile x86-64 system
Revision 1.2 2004/02/04 19:22:27 peter
*** empty log message ***
Revision 1.1 2004/01/20 12:59:37 florian

11
compiler/x86_64/rgcpu.pas
View File

@ -29,12 +29,10 @@ unit rgcpu;
interface
uses
aasmbase,aasmtai,
cpubase,
rgobj;
rgx86;
type
trgcpu = class(trgobj)
trgcpu = class(trgx86)
end;
implementation
@ -43,6 +41,9 @@ end.
{
$Log$
Revision 1.7 2003-12-24 00:10:03 florian
Revision 1.8 2004-02-05 01:24:08 florian
* several fixes to compile x86-64 system
Revision 1.7 2003/12/24 00:10:03 florian
- delete parameter in cg64 methods removed
}