paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-15 07:09:18 +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_pointer_to_array;override; }
{ procedure second_chararray_to_string;override; } { procedure second_chararray_to_string;override; }
{ procedure second_char_to_string;override; } { procedure second_char_to_string;override; }
function first_int_to_real: tnode; 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_real_to_real;override; }
{ procedure second_cord_to_pointer;override; } { procedure second_cord_to_pointer;override; }
{ procedure second_proc_to_procvar;override; } { procedure second_proc_to_procvar;override; }
@ -66,97 +66,15 @@ implementation
cgobj,cga,cgx86,ncgutil; 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 begin
ctypeconvnode:=ti386typeconvnode; ctypeconvnode:=ti386typeconvnode;
end. end.
{ {
$Log$ $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 * removed unused checkobject method
Revision 1.70 2003/12/08 15:35:00 peter Revision 1.70 2003/12/08 15:35:00 peter

323
compiler/i386/n386inl.pas
View File

@ -27,333 +27,26 @@ unit n386inl;
interface interface
uses uses
node,ninl,ncginl; nx86inl;
type type
ti386inlinenode = class(tcginlinenode) ti386inlinenode = class(tx86inlinenode)
{ 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; end;
implementation implementation
uses uses
systems, ninl;
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;
begin begin
cinlinenode:=ti386inlinenode; cinlinenode:=ti386inlinenode;
end. end.
{ {
$Log$ $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 xNNbittype to xNNinttype
* renamed registers32 to registersint * renamed registers32 to registersint
* replace some s32bit,u32bit with torddef([su]inttype).def.typ * replace some s32bit,u32bit with torddef([su]inttype).def.typ

20
compiler/nadd.pas
View File

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

32
compiler/ncal.pas
View File

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

7
compiler/ncgcnv.pas
View File

@ -466,7 +466,7 @@ interface
{$ifdef fpc} {$ifdef fpc}
{$warning todo: add RTL routine for widechar-char conversion } {$warning todo: add RTL routine for widechar-char conversion }
{$endif} {$endif}
{ Quick hack to atleast generate 'working' code (PFV) } { Quick hack to at least generate 'working' code (PFV) }
second_int_to_int; second_int_to_int;
end; end;
@ -535,7 +535,10 @@ end.
{ {
$Log$ $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 $ifdef i386 to x86
* Change several OS_32 to OS_INT/OS_ADDR * Change several OS_32 to OS_INT/OS_ADDR

12
compiler/ncginl.pas
View File

@ -327,10 +327,11 @@ implementation
begin begin
{ length in ansi strings is at offset -8 } { length in ansi strings is at offset -8 }
location_force_reg(exprasmlist,left.location,OS_ADDR,false); location_force_reg(exprasmlist,left.location,OS_ADDR,false);
hregister:=left.location.register;
objectlibrary.getlabel(lengthlab); objectlibrary.getlabel(lengthlab);
cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,hregister,lengthlab); cg.a_cmp_const_reg_label(exprasmlist,OS_ADDR,OC_EQ,0,left.location.register,lengthlab);
reference_reset_base(href,hregister,-8); 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_load_ref_reg(exprasmlist,OS_32,OS_32,href,hregister);
cg.a_label(exprasmlist,lengthlab); cg.a_label(exprasmlist,lengthlab);
location_reset(location,LOC_REGISTER,OS_32); location_reset(location,LOC_REGISTER,OS_32);
@ -676,7 +677,10 @@ end.
{ {
$Log$ $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 + added prefetch(const mem) support
Revision 1.51 2004/01/31 17:45:17 peter Revision 1.51 2004/01/31 17:45:17 peter

11
compiler/ncgld.pas
View File

@ -611,10 +611,10 @@ implementation
begin begin
cgsize:=def_cgsize(left.resulttype.def); cgsize:=def_cgsize(left.resulttype.def);
if cgsize in [OS_64,OS_S64] then if cgsize in [OS_64,OS_S64] then
cg64.a_load64_reg_loc(exprasmlist, cg64.a_load64_reg_loc(exprasmlist,
right.location.register64,left.location) right.location.register64,left.location)
else 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; end;
LOC_FPUREGISTER,LOC_CFPUREGISTER : LOC_FPUREGISTER,LOC_CFPUREGISTER :
begin begin
@ -906,7 +906,10 @@ begin
end. end.
{ {
$Log$ $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 xNNbittype to xNNinttype
* renamed registers32 to registersint * renamed registers32 to registersint
* replace some s32bit,u32bit with torddef([su]inttype).def.typ * replace some s32bit,u32bit with torddef([su]inttype).def.typ

162
compiler/ncgutil.pas
View File

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

7
compiler/ncnv.pas
View File

@ -1482,9 +1482,11 @@ implementation
expectloc:=LOC_REGISTER expectloc:=LOC_REGISTER
else else
expectloc:=left.expectloc; expectloc:=left.expectloc;
{$ifndef cpu64bit}
if is_64bit(resulttype.def) then if is_64bit(resulttype.def) then
registersint:=max(registersint,2) registersint:=max(registersint,2)
else else
{$endif cpu64bit}
registersint:=max(registersint,1); registersint:=max(registersint,1);
end; end;
@ -2405,7 +2407,10 @@ begin
end. end.
{ {
$Log$ $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 * Rtti generation moved to ncgutil
* Assmtai usage of symsym removed * Assmtai usage of symsym removed
* operator overloading cleanup up * 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); 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; function twhilerepeatnode.det_resulttype:tnode;
var var
@ -1475,7 +1475,10 @@ begin
end. end.
{ {
$Log$ $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 xNNbittype to xNNinttype
* renamed registers32 to registersint * renamed registers32 to registersint
* replace some s32bit,u32bit with torddef([su]inttype).def.typ * replace some s32bit,u32bit with torddef([su]inttype).def.typ

9
compiler/symdef.pas
View File

@ -2171,10 +2171,10 @@ implementation
{$ifdef cpu64bit} {$ifdef cpu64bit}
case filetyp of case filetyp of
ft_text : ft_text :
savesize:=592; savesize:=616;
ft_typed, ft_typed,
ft_untyped : ft_untyped :
savesize:=316; savesize:=324;
end; end;
{$else cpu64bit} {$else cpu64bit}
case filetyp of case filetyp of
@ -6152,7 +6152,10 @@ implementation
end. end.
{ {
$Log$ $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 xNNbittype to xNNinttype
* renamed registers32 to registersint * renamed registers32 to registersint
* replace some s32bit,u32bit with torddef([su]inttype).def.typ * 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_pointer_to_array;override; }
{ procedure second_chararray_to_string;override; } { procedure second_chararray_to_string;override; }
{ procedure second_char_to_string;override; } { procedure second_char_to_string;override; }
{ function first_int_to_real: tnode; 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_real_to_real;override; }
{ procedure second_cord_to_pointer;override; } { procedure second_cord_to_pointer;override; }
{ procedure second_proc_to_procvar;override; } { procedure second_proc_to_procvar;override; }
@ -60,12 +60,13 @@ implementation
uses uses
verbose,systems,globals, verbose,systems,globals,
aasmbase,aasmtai, aasmbase,aasmtai,aasmcpu,
symconst,symdef, symconst,symdef,
cgbase,pass_2, cgbase,cga,pass_2,
ncon,ncal,ncnv, ncon,ncal,ncnv,
cpubase, cpubase,
cgobj,cgx86,ncgutil; cgobj,cgx86,ncgutil,
tgobj;
function tx86typeconvnode.first_real_to_real : tnode; function tx86typeconvnode.first_real_to_real : tnode;
@ -188,10 +189,98 @@ implementation
falselabel:=oldfalselabel; falselabel:=oldfalselabel;
end; 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. end.
{ {
$Log$ $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 + fpu<->mm register conversion
Revision 1.7 2003/10/10 17:48:14 peter 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, ncgcon,
ncgcal, ncgcal,
ncgset, ncgset,
ncginl,
ncgopt, ncgopt,
// n386con,n386flw,n386mat,n386mem, // n386con,n386flw,n386mat,n386mem,
// n386set,n386inl,n386opt, // n386set,n386inl,n386opt,
@ -52,13 +51,17 @@ unit cpunode;
get the correct class pointer } get the correct class pointer }
nx64add, nx64add,
nx64cnv, nx64cnv,
nx64mat nx64mat,
nx64inl
; ;
end. end.
{ {
$Log$ $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 $ifdef i386 to x86
* Change several OS_32 to OS_INT/OS_ADDR * Change several OS_32 to OS_INT/OS_ADDR

39
compiler/x86_64/nx64add.pas
View File

@ -51,23 +51,23 @@ interface
hl4 : tasmlabel; hl4 : tasmlabel;
begin 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); location_reset(location,LOC_REGISTER,OS_INT);
{Get a temp register and load the left value into it { Get a temp register and load the left value into it
and free the location.} and free the location. }
r:=cg.getintregister(exprasmlist,OS_INT); r:=cg.getintregister(exprasmlist,OS_INT);
cg.a_load_loc_reg(exprasmlist,OS_INT,left.location,r); cg.a_load_loc_reg(exprasmlist,OS_INT,left.location,r);
location_release(exprasmlist,left.location); location_release(exprasmlist,left.location);
{Allocate EAX.} { Allocate RAX. }
cg.getexplicitregister(exprasmlist,NR_EAX); cg.getexplicitregister(exprasmlist,NR_RAX);
{Load the right value.} { Load the right value. }
cg.a_load_loc_reg(exprasmlist,OS_INT,right.location,NR_EAX); cg.a_load_loc_reg(exprasmlist,OS_INT,right.location,NR_RAX);
location_release(exprasmlist,right.location); location_release(exprasmlist,right.location);
{The mul instruction frees register r.} { The mul instruction frees register r.}
cg.ungetregister(exprasmlist,r); cg.ungetregister(exprasmlist,r);
{Also allocate EDX, since it is also modified by a mul (JM).} { Also allocate RDX, since it is also modified by a mul (JM). }
cg.getexplicitregister(exprasmlist,NR_EDX); cg.getexplicitregister(exprasmlist,NR_RDX);
emit_reg(A_MUL,S_L,r); emit_reg(A_MUL,S_Q,r);
if cs_check_overflow in aktlocalswitches then if cs_check_overflow in aktlocalswitches then
begin begin
objectlibrary.getlabel(hl4); objectlibrary.getlabel(hl4);
@ -75,13 +75,13 @@ interface
cg.a_call_name(exprasmlist,'FPC_OVERFLOW'); cg.a_call_name(exprasmlist,'FPC_OVERFLOW');
cg.a_label(exprasmlist,hl4); cg.a_label(exprasmlist,hl4);
end; end;
{Free EDX} { Free RDX }
cg.ungetregister(exprasmlist,NR_EDX); cg.ungetregister(exprasmlist,NR_RDX);
{Free EAX} { Free RAX }
cg.ungetregister(exprasmlist,NR_EAX); cg.ungetregister(exprasmlist,NR_RAX);
{Allocate a new register and store the result in EAX in it.} { Allocate a new register and store the result in RAX in it. }
location.register:=cg.getintregister(exprasmlist,OS_INT); 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,left.location);
location_freetemp(exprasmlist,right.location); location_freetemp(exprasmlist,right.location);
end; end;
@ -92,6 +92,9 @@ begin
end. end.
{ {
$Log$ $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 * common addnode code for x86-64 and i386
} }

26
compiler/x86_64/nx64cnv.pas
View File

@ -31,7 +31,7 @@ interface
nx86cnv; nx86cnv;
type type
tx86_64typeconvnode = class(tx86typeconvnode) tx8664typeconvnode = class(tx86typeconvnode)
protected protected
{ procedure second_int_to_int;override; } { procedure second_int_to_int;override; }
{ procedure second_string_to_string;override; } { procedure second_string_to_string;override; }
@ -42,7 +42,7 @@ interface
{ procedure second_chararray_to_string;override; } { procedure second_chararray_to_string;override; }
{ procedure second_char_to_string;override; } { procedure second_char_to_string;override; }
{ function first_int_to_real: tnode; 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_real_to_real;override; }
{ procedure second_cord_to_pointer;override; } { procedure second_cord_to_pointer;override; }
{ procedure second_proc_to_procvar;override; } { procedure second_proc_to_procvar;override; }
@ -58,27 +58,19 @@ interface
implementation implementation
uses uses
verbose,systems,globtype, ncnv;
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;
begin begin
ctypeconvnode:=tx86_64typeconvnode; ctypeconvnode:=tx8664typeconvnode;
end. end.
{ {
$Log$ $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 * x86-64 compilation fixed
Revision 1.1 2003/04/30 20:53:32 florian 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) tx8664unaryminusnode = class(tx86unaryminusnode)
end; end;
tx8664notnode = class(tx86notnode)
end;
implementation implementation
@ -199,10 +201,14 @@ begin
cunaryminusnode:=tx8664unaryminusnode; cunaryminusnode:=tx8664unaryminusnode;
cmoddivnode:=tx8664moddivnode; cmoddivnode:=tx8664moddivnode;
cshlshrnode:=tx8664shlshrnode; cshlshrnode:=tx8664shlshrnode;
cnotnode:=tx8664notnode;
end. end.
{ {
$Log$ $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 *** *** empty log message ***
Revision 1.1 2004/01/20 12:59:37 florian 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 interface
uses uses
aasmbase,aasmtai, rgx86;
cpubase,
rgobj;
type type
trgcpu = class(trgobj) trgcpu = class(trgx86)
end; end;
implementation implementation
@ -43,6 +41,9 @@ end.
{ {
$Log$ $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 - delete parameter in cg64 methods removed
} }