paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 13:59:28 +02:00
Code Issues Packages Projects Releases Wiki Activity

* jmpbuf size allocation for exceptions is now cpu specific (as it should)

Browse Source 
* more generic nodes for maths
  * several fixes for better m68k support
This commit is contained in:
carl 2002-08-15 15:15:55 +00:00
parent 65988f5c09
commit 588abc6631
12 changed files with 449 additions and 236 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
compiler/i386/cpuinfo.pas
View File

@ -65,6 +65,11 @@ Const
{ target cpu string (used by compiler options) }
target_cpu_string = 'i386';
{ size of the buffer used for setjump/longjmp
the size of this buffer is deduced from the
jmp_buf structure in setjumph.inc file
}
jmp_buf_size = 24;
Implementation
@ -72,7 +77,12 @@ Implementation
end.
{
$Log$
Revision 1.12 2002-08-12 15:08:41 carl
Revision 1.13 2002-08-15 15:15:55 carl
* jmpbuf size allocation for exceptions is now cpu specific (as it should)
* more generic nodes for maths
* several fixes for better m68k support
Revision 1.12 2002/08/12 15:08:41 carl
+ stab register indexes for powerpc (moved from gdb to cpubase)
+ tprocessor enumeration moved to cpuinfo
+ linker in target_info is now a class

15
compiler/i386/n386flw.pas
View File

@ -200,7 +200,7 @@ implementation
objectlibrary.getlabel(endexceptlabel);
objectlibrary.getlabel(lastonlabel);
tg.gettempofsizereferencepersistant(exprasmlist,24,tempbuf);
tg.gettempofsizereferencepersistant(exprasmlist,JMP_BUF_SIZE,tempbuf);
tg.gettempofsizereferencepersistant(exprasmlist,12,tempaddr);
cg.a_paramaddr_ref(exprasmlist,tempaddr,paramanager.getintparaloc(3));
cg.a_paramaddr_ref(exprasmlist,tempbuf,paramanager.getintparaloc(2));
@ -278,7 +278,7 @@ implementation
objectlibrary.getlabel(doobjectdestroy);
objectlibrary.getlabel(doobjectdestroyandreraise);
tg.gettempofsizereferencepersistant(exprasmlist,24,tempbuf);
tg.gettempofsizereferencepersistant(exprasmlist,JMP_BUF_SIZE,tempbuf);
tg.gettempofsizereferencepersistant(exprasmlist,12,tempaddr);
cg.a_paramaddr_ref(exprasmlist,tempaddr,paramanager.getintparaloc(3));
cg.a_paramaddr_ref(exprasmlist,tempbuf,paramanager.getintparaloc(2));
@ -448,7 +448,7 @@ implementation
objectlibrary.getlabel(doobjectdestroyandreraise);
tg.gettempofsizereferencepersistant(exprasmlist,12,tempaddr);
tg.gettempofsizereferencepersistant(exprasmlist,24,tempbuf);
tg.gettempofsizereferencepersistant(exprasmlist,JMP_BUF_SIZE,tempbuf);
cg.a_paramaddr_ref(exprasmlist,tempaddr,paramanager.getintparaloc(3));
cg.a_paramaddr_ref(exprasmlist,tempbuf,paramanager.getintparaloc(2));
cg.a_param_const(exprasmlist,OS_INT,1,paramanager.getintparaloc(1));
@ -602,7 +602,7 @@ implementation
end;
tg.gettempofsizereferencepersistant(exprasmlist,12,tempaddr);
tg.gettempofsizereferencepersistant(exprasmlist,24,tempbuf);
tg.gettempofsizereferencepersistant(exprasmlist,JMP_BUF_SIZE,tempbuf);
cg.a_paramaddr_ref(exprasmlist,tempaddr,paramanager.getintparaloc(3));
cg.a_paramaddr_ref(exprasmlist,tempbuf,paramanager.getintparaloc(2));
{ Type of stack-frame must be pushed}
@ -726,7 +726,12 @@ begin
end.
{
$Log$
Revision 1.32 2002-08-11 14:32:30 peter
Revision 1.33 2002-08-15 15:15:55 carl
* jmpbuf size allocation for exceptions is now cpu specific (as it should)
* more generic nodes for maths
* several fixes for better m68k support
Revision 1.32 2002/08/11 14:32:30 peter
* renamed current_library to objectlibrary
Revision 1.31 2002/08/11 13:24:17 peter

15
compiler/i386/n386mat.pas
View File

@ -36,6 +36,8 @@ interface
ti386shlshrnode = class(tshlshrnode)
procedure pass_2;override;
{ everything will be handled in pass_2 }
function first_shlshr64bitint: tnode; override;
end;
ti386unaryminusnode = class(tunaryminusnode)
@ -266,6 +268,12 @@ implementation
TI386SHLRSHRNODE
*****************************************************************************}
function ti386shlshrnode.first_shlshr64bitint: tnode;
begin
result := nil;
end;
procedure ti386shlshrnode.pass_2;
var
hregister2,hregister3,
@ -830,7 +838,12 @@ begin
end.
{
$Log$
Revision 1.38 2002-08-14 19:18:16 carl
Revision 1.39 2002-08-15 15:15:55 carl
* jmpbuf size allocation for exceptions is now cpu specific (as it should)
* more generic nodes for maths
* several fixes for better m68k support
Revision 1.38 2002/08/14 19:18:16 carl
* bugfix of unaryminus node with left LOC_CREGISTER
Revision 1.37 2002/08/12 15:08:42 carl

13
compiler/m68k/cpuinfo.pas
View File

@ -54,7 +54,11 @@ Const
pointer_size = 4;
{# Size of a multimedia register }
mmreg_size = 16;
{ size of the buffer used for setjump/longjmp
the size of this buffer is deduced from the
jmp_buf structure in setjumph.inc file
}
jmp_buf_size = 28;
{ target cpu string (used by compiler options) }
target_cpu_string = 'm68k';
@ -63,7 +67,12 @@ Implementation
end.
{
$Log$
Revision 1.2 2002-08-12 15:08:44 carl
Revision 1.3 2002-08-15 15:15:55 carl
* jmpbuf size allocation for exceptions is now cpu specific (as it should)
* more generic nodes for maths
* several fixes for better m68k support
Revision 1.2 2002/08/12 15:08:44 carl
+ stab register indexes for powerpc (moved from gdb to cpubase)
+ tprocessor enumeration moved to cpuinfo
+ linker in target_info is now a class

224
compiler/m68k/n68kmat.pas
View File

@ -30,17 +30,12 @@ interface
node,nmat;
type
tm68kmoddivnode = class(tmoddivnode)
procedure pass_2;override;
end;
tm68kshlshrnode = class(tshlshrnode)
procedure pass_2;override;
end;
tm68knotnode = class(tnotnode)
procedure pass_2;override;
end;
implementation
@ -53,212 +48,6 @@ implementation
cpubase,cpuinfo,paramgr,
tgobj,ncgutil,cgobj,rgobj,rgcpu,cgcpu,cg64f32;
{*****************************************************************************
TM68kMODDIVNODE
*****************************************************************************}
procedure tm68kmoddivnode.pass_2;
var
hreg1 : tregister;
hdenom,hnumerator : tregister;
shrdiv,popeax,popedx : boolean;
power : longint;
hl : tasmlabel;
pushedregs : tmaybesave;
begin
shrdiv := false;
secondpass(left);
if codegenerror then
exit;
maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
secondpass(right);
maybe_restore(exprasmlist,left.location,pushedregs);
if codegenerror then
exit;
location_copy(location,left.location);
if is_64bitint(resulttype.def) then
begin
{ should be handled in pass_1 (JM) }
internalerror(200109052);
end
else
begin
{ put numerator in register }
location_force_reg(exprasmlist,left.location,OS_INT,false);
hreg1:=left.location.register;
if (nodetype=divn) and
(right.nodetype=ordconstn) and
ispowerof2(tordconstnode(right).value,power) then
Begin
shrdiv := true;
{ for signed numbers, the numerator must be adjusted before the
shift instruction, but not wih unsigned numbers! Otherwise,
"Cardinal($ffffffff) div 16" overflows! (JM) }
If is_signed(left.resulttype.def) Then
Begin
objectlibrary.getlabel(hl);
cg.a_cmp_const_reg_label(exprasmlist,OS_INT,OC_GT,0,hreg1,hl);
if power=1 then
cg.a_op_const_reg(exprasmlist,OP_ADD,1,hreg1)
else
cg.a_op_const_reg(exprasmlist,OP_ADD,
tordconstnode(right).value-1,hreg1);
cg.a_label(exprasmlist,hl);
cg.a_op_const_reg(exprasmlist,OP_SAR,power,hreg1);
End
Else { not signed }
Begin
cg.a_op_const_reg(exprasmlist,OP_SHR,power,hreg1);
end;
End
else
begin
{ bring denominator to hdenom }
{ hdenom is always free, it's }
{ only used for temporary }
{ purposes }
hdenom := rg.getregisterint(exprasmlist);
if right.location.loc<>LOC_CREGISTER then
location_release(exprasmlist,right.location);
cg.a_load_loc_reg(exprasmlist,right.location,hdenom);
if nodetype = modn then
begin
hnumerator := rg.getregisterint(exprasmlist);
cg.a_load_reg_reg(exprasmlist,OS_INT,hreg1,hnumerator);
end;
{ verify if the divisor is zero, if so return an error
immediately
}
objectlibrary.getlabel(hl);
cg.a_cmp_const_reg_label(exprasmlist,OS_INT,OC_NE,0,hdenom,hl);
cg.a_param_const(exprasmlist,OS_S32,200,paramanager.getintparaloc(1));
cg.a_call_name(exprasmlist,'FPC_HANDLERROR');
cg.a_label(exprasmlist,hl);
if is_signed(left.resulttype.def) then
cg.a_op_reg_reg(exprasmlist,OP_IDIV,OS_INT,hdenom,hreg1)
else
cg.a_op_reg_reg(exprasmlist,OP_DIV,OS_INT,hdenom,hreg1);
if nodetype = modn then
begin
{$warning modnode should be tested}
{ I mod J = I - (I div J) * J }
cg.a_op_reg_reg(exprasmlist,OP_IMUL,OS_INT,hdenom,hreg1);
cg.a_op_reg_reg(exprasmlist,OP_SUB,OS_INT,hnumerator,hreg1);
rg.ungetregister(exprasmlist,hnumerator);
end;
end;
location_reset(location,LOC_REGISTER,OS_INT);
location.register:=hreg1;
end;
cg.g_overflowcheck(exprasmlist,self);
end;
{*****************************************************************************
TI386SHLRSHRNODE
*****************************************************************************}
procedure tm68kshlshrnode.pass_2;
var
hcountreg : tregister;
op : topcg;
l1,l2,l3 : tasmlabel;
pushedregs : tmaybesave;
freescratch : boolean;
begin
freescratch:=false;
secondpass(left);
maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
secondpass(right);
maybe_restore(exprasmlist,left.location,pushedregs);
{ determine operator }
case nodetype of
shln: op:=OP_SHL;
shrn: op:=OP_SHR;
end;
if is_64bitint(left.resulttype.def) then
begin
location_reset(location,LOC_REGISTER,OS_64);
{ load left operator in a register }
location_force_reg(exprasmlist,left.location,OS_64,false);
location_copy(location,left.location);
if (right.nodetype=ordconstn) then
begin
cg64.a_op64_const_reg(exprasmlist,op,tordconstnode(right).value,
joinreg64(location.registerlow,location.registerhigh));
end
else
begin
{ load right operators in a register - this
is done since most target cpu which will use this
node do not support a shift count in a mem. location (cec)
}
if right.location.loc<>LOC_REGISTER then
begin
if right.location.loc<>LOC_CREGISTER then
location_release(exprasmlist,right.location);
hcountreg:=cg.get_scratch_reg_int(exprasmlist);
cg.a_load_loc_reg(exprasmlist,right.location,hcountreg);
freescratch := true;
end
else
hcountreg:=right.location.register;
cg64.a_op64_reg_reg(exprasmlist,op,hcountreg,
joinreg64(location.registerlow,location.registerhigh));
if freescratch then
cg.free_scratch_reg(exprasmlist,hcountreg);
end;
end
else
begin
{ load left operators in a register }
location_copy(location,left.location);
location_force_reg(exprasmlist,location,OS_INT,false);
{ shifting by a constant directly coded: }
if (right.nodetype=ordconstn) then
begin
{ l shl 32 should 0 imho, but neither TP nor Delphi do it in this way (FK)
if right.value<=31 then
}
cg.a_op_const_reg(exprasmlist,op,tordconstnode(right).value and 31,
location.register);
{
else
emit_reg_reg(A_XOR,S_L,hregister1,
hregister1);
}
end
else
begin
{ load right operators in a register - this
is done since most target cpu which will use this
node do not support a shift count in a mem. location (cec)
}
if right.location.loc<>LOC_REGISTER then
begin
if right.location.loc<>LOC_CREGISTER then
location_release(exprasmlist,right.location);
hcountreg:=cg.get_scratch_reg_int(exprasmlist);
freescratch := true;
cg.a_load_loc_reg(exprasmlist,right.location,hcountreg);
end
else
hcountreg:=right.location.register;
cg.a_op_reg_reg(exprasmlist,op,OS_INT,hcountreg,location.register);
if freescratch then
cg.free_scratch_reg(exprasmlist,hcountreg);
end;
end;
end;
@ -332,14 +121,19 @@ implementation
end;
end;
begin
cmoddivnode:=tm68kmoddivnode;
cshlshrnode:=tm68kshlshrnode;
cnotnode:=tm68knotnode;
end.
{
$Log$
Revision 1.2 2002-08-15 08:13:54 carl
Revision 1.3 2002-08-15 15:15:55 carl
* jmpbuf size allocation for exceptions is now cpu specific (as it should)
* more generic nodes for maths
* several fixes for better m68k support
Revision 1.2 2002/08/15 08:13:54 carl
- a_load_sym_ofs_reg removed
* loadvmt now calls loadaddr_ref_reg instead

77
compiler/nadd.pas
View File

@ -45,6 +45,13 @@ interface
{ only implements "muln" nodes, the rest always has to be done in }
{ the code generator for performance reasons (JM) }
function first_add64bitint: tnode; virtual;
{ This routine calls internal runtime library helpers
for all floating point arithmetic in the case
where the emulation switches is on. Otherwise
returns nil, and everything must be done in
the code generation phase.
}
function first_addfloat : tnode; virtual;
end;
taddnodeclass = class of taddnode;
@ -1415,6 +1422,63 @@ implementation
right := nil;
firstpass(result);
end;
function taddnode.first_addfloat: tnode;
var
procname: string[31];
temp: tnode;
power: longint;
{ do we need to reverse the result ? }
notnode : boolean;
begin
result := nil;
notnode := false;
{ In non-emulation mode, real opcodes are
emitted for floating point values.
}
if not (cs_fp_emulation in aktmoduleswitches) then
exit;
procname := 'FPC_REAL_';
case nodetype of
addn : procname := procname + 'ADD';
muln : procname := procname + 'MUL';
subn : procname := procname + 'SUB';
slashn : procname := procname + 'DIV';
ltn : procname := procname + 'LESS_THAN';
lten: procname := procname + 'LESS_EQUAL_THAN';
gtn:
begin
procname := procname + 'LESS_EQUAL_THAN';
notnode := true;
end;
gten:
begin
procname := procname + 'LESS_THAN';
notnode := true;
end;
equaln: procname := procname + 'EQUAL';
unequaln :
begin
procname := procname + 'EQUAL';
notnode := true;
end;
else
CGMessage(type_e_mismatch);
end;
{ otherwise, create the parameters for the helper }
right := ccallparanode.create(right,ccallparanode.create(left,nil));
left := nil;
{ do we need to reverse the result }
if notnode then
result := cnotnode.create(ccallnode.createintern(procname,right))
else
result := ccallnode.createintern(procname,right);
right := nil;
firstpass(result);
end;
function taddnode.pass_1 : tnode;
var
@ -1439,6 +1503,9 @@ implementation
{ int/int gives real/real! }
if nodetype=slashn then
begin
result := first_addfloat;
if assigned(result) then
exit;
location.loc:=LOC_FPUREGISTER;
{ maybe we need an integer register to save }
{ a reference }
@ -1616,6 +1683,9 @@ implementation
{ is one a real float ? }
else if (rd.deftype=floatdef) or (ld.deftype=floatdef) then
begin
result := first_addfloat;
if assigned(result) then
exit;
location.loc:=LOC_FPUREGISTER;
calcregisters(self,0,1,0);
{ an add node always first loads both the left and the }
@ -1744,7 +1814,12 @@ begin
end.
{
$Log$
Revision 1.60 2002-08-12 15:08:39 carl
Revision 1.61 2002-08-15 15:15:55 carl
* jmpbuf size allocation for exceptions is now cpu specific (as it should)
* more generic nodes for maths
* several fixes for better m68k support
Revision 1.60 2002/08/12 15:08:39 carl
+ stab register indexes for powerpc (moved from gdb to cpubase)
+ tprocessor enumeration moved to cpuinfo
+ linker in target_info is now a class

9
compiler/ncgflw.pas
View File

@ -695,7 +695,7 @@ do_jmp:
procedure try_new_exception(list : taasmoutput;var jmpbuf,envbuf, href : treference;
a : aword; exceptlabel : tasmlabel);
begin
tg.gettempofsizereferencepersistant(list,24,jmpbuf);
tg.gettempofsizereferencepersistant(list,JMP_BUF_SIZE,jmpbuf);
tg.gettempofsizereferencepersistant(list,12,envbuf);
tg.gettempofsizereferencepersistant(list,sizeof(aword),href);
new_exception(list, jmpbuf,envbuf, href, a, exceptlabel);
@ -1225,7 +1225,12 @@ begin
end.
{
$Log$
Revision 1.35 2002-08-13 18:01:52 carl
Revision 1.36 2002-08-15 15:15:55 carl
* jmpbuf size allocation for exceptions is now cpu specific (as it should)
* more generic nodes for maths
* several fixes for better m68k support
Revision 1.35 2002/08/13 18:01:52 carl
* rename swatoperands to swapoperands
+ m68k first compilable version (still needs a lot of testing):
assembler generator, system information , inline

272
compiler/ncgmat.pas
View File

@ -32,6 +32,7 @@ interface
type
tcgunaryminusnode = class(tunaryminusnode)
procedure pass_2;override;
protected
{ This routine is called to change the sign of the
floating point value in the floating point
register r.
@ -45,6 +46,53 @@ type
procedure emit_float_sign_change(r: tregister; _size : tcgsize);virtual;
end;
tcgmoddivnode = class(tmoddivnode)
procedure pass_2;override;
protected
{ This routine must do an actual 32-bit division, be it
signed or unsigned. The result must set into the the
@var(num) register.
@param(signed Indicates if the division must be signed)
@param(denum Register containing the denominator
@param(num Register containing the numerator, will also receive result)
The actual optimizations regarding shifts have already
been done and emitted, so this should really a do a divide.
}
procedure emit_div_reg_reg(signed: boolean;denum,num : tregister);virtual;abstract;
{ This routine must do an actual 32-bit modulo, be it
signed or unsigned. The result must set into the the
@var(num) register.
@param(signed Indicates if the modulo must be signed)
@param(denum Register containing the denominator
@param(num Register containing the numerator, will also receive result)
The actual optimizations regarding shifts have already
been done and emitted, so this should really a do a modulo.
}
procedure emit_mod_reg_reg(signed: boolean;denum,num : tregister);virtual;abstract;
{ This routine must do an actual 64-bit division, be it
signed or unsigned. The result must set into the the
@var(num) register.
@param(signed Indicates if the division must be signed)
@param(denum Register containing the denominator
@param(num Register containing the numerator, will also receive result)
The actual optimizations regarding shifts have already
been done and emitted, so this should really a do a divide.
Currently, this routine should only be implemented on
64-bit systems, otherwise a helper is called in 1st pass.
}
procedure emit64_div_reg_reg(signed: boolean;denum,num : tregister64);virtual;
end;
tcgshlshrnode = class(tshlshrnode)
procedure pass_2;override;
end;
implementation
@ -55,7 +103,7 @@ implementation
pass_1,pass_2,
ncon,
cpuinfo,
tgobj,ncgutil,cgobj,rgobj,rgcpu,cg64f32;
tgobj,ncgutil,cgobj,rgobj,rgcpu,paramgr,cg64f32;
{*****************************************************************************
TCGUNARYMINUSNODE
@ -184,14 +232,234 @@ implementation
end;
{*****************************************************************************
TCGMODDIVNODE
*****************************************************************************}
procedure tcgmoddivnode.emit64_div_reg_reg(signed: boolean; denum,num:tregister64);
begin
{ handled in pass_1 already, unless pass_1 is
overriden
}
{ should be handled in pass_1 (JM) }
internalerror(200109052);
end;
procedure tcgmoddivnode.pass_2;
var
hreg1 : tregister;
hdenom,hnumerator : tregister;
shrdiv,popeax,popedx : boolean;
power : longint;
hl : tasmlabel;
pushedregs : tmaybesave;
begin
shrdiv := false;
secondpass(left);
if codegenerror then
exit;
maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
secondpass(right);
maybe_restore(exprasmlist,left.location,pushedregs);
if codegenerror then
exit;
location_copy(location,left.location);
if is_64bitint(resulttype.def) then
begin
{ this code valid for 64-bit cpu's only ,
otherwise helpers are called in pass_1
}
location_force_reg(exprasmlist,location,OS_64,false);
location_copy(location,left.location);
location_force_reg(exprasmlist,right.location,OS_64,false);
emit64_div_reg_reg(is_signed(left.resulttype.def),
joinreg64(right.location.registerlow,right.location.registerhigh),
joinreg64(location.registerlow,location.registerhigh));
end
else
begin
{ put numerator in register }
location_force_reg(exprasmlist,left.location,OS_INT,false);
hreg1:=left.location.register;
if (nodetype=divn) and
(right.nodetype=ordconstn) and
ispowerof2(tordconstnode(right).value,power) then
Begin
shrdiv := true;
{ for signed numbers, the numerator must be adjusted before the
shift instruction, but not wih unsigned numbers! Otherwise,
"Cardinal($ffffffff) div 16" overflows! (JM) }
If is_signed(left.resulttype.def) Then
Begin
objectlibrary.getlabel(hl);
cg.a_cmp_const_reg_label(exprasmlist,OS_INT,OC_GT,0,hreg1,hl);
if power=1 then
cg.a_op_const_reg(exprasmlist,OP_ADD,1,hreg1)
else
cg.a_op_const_reg(exprasmlist,OP_ADD,
tordconstnode(right).value-1,hreg1);
cg.a_label(exprasmlist,hl);
cg.a_op_const_reg(exprasmlist,OP_SAR,power,hreg1);
End
Else { not signed }
Begin
cg.a_op_const_reg(exprasmlist,OP_SHR,power,hreg1);
end;
End
else
begin
{ bring denominator to hdenom }
{ hdenom is always free, it's }
{ only used for temporary }
{ purposes }
hdenom := rg.getregisterint(exprasmlist);
if right.location.loc<>LOC_CREGISTER then
location_release(exprasmlist,right.location);
cg.a_load_loc_reg(exprasmlist,right.location,hdenom);
{ verify if the divisor is zero, if so return an error
immediately
}
objectlibrary.getlabel(hl);
cg.a_cmp_const_reg_label(exprasmlist,OS_INT,OC_NE,0,hdenom,hl);
cg.a_param_const(exprasmlist,OS_S32,200,paramanager.getintparaloc(1));
cg.a_call_name(exprasmlist,'FPC_HANDLERROR');
cg.a_label(exprasmlist,hl);
if nodetype = modn then
emit_mod_reg_reg(is_signed(left.resulttype.def),hdenom,hreg1)
else
emit_div_reg_reg(is_signed(left.resulttype.def),hdenom,hreg1);
end;
location_reset(location,LOC_REGISTER,OS_INT);
location.register:=hreg1;
end;
cg.g_overflowcheck(exprasmlist,self);
end;
{*****************************************************************************
TCGSHLRSHRNODE
*****************************************************************************}
procedure tcgshlshrnode.pass_2;
var
hcountreg : tregister;
op : topcg;
l1,l2,l3 : tasmlabel;
pushedregs : tmaybesave;
freescratch : boolean;
begin
freescratch:=false;
secondpass(left);
maybe_save(exprasmlist,right.registers32,left.location,pushedregs);
secondpass(right);
maybe_restore(exprasmlist,left.location,pushedregs);
{ determine operator }
case nodetype of
shln: op:=OP_SHL;
shrn: op:=OP_SHR;
end;
if is_64bitint(left.resulttype.def) then
begin
{ already hanled in 1st pass }
internalerror(2002081501);
(* Normally for 64-bit cpu's this here should be here,
and only pass_1 need to be overriden, but dunno how to
do that!
location_reset(location,LOC_REGISTER,OS_64);
{ load left operator in a register }
location_force_reg(exprasmlist,left.location,OS_64,false);
location_copy(location,left.location);
if (right.nodetype=ordconstn) then
begin
cg64.a_op64_const_reg(exprasmlist,op,tordconstnode(right).value,
joinreg64(location.registerlow,location.registerhigh));
end
else
begin
{ this should be handled in pass_1 }
internalerror(2002081501);
if right.location.loc<>LOC_REGISTER then
begin
if right.location.loc<>LOC_CREGISTER then
location_release(exprasmlist,right.location);
hcountreg:=cg.get_scratch_reg_int(exprasmlist);
cg.a_load_loc_reg(exprasmlist,right.location,hcountreg);
freescratch := true;
end
else
hcountreg:=right.location.register;
cg64.a_op64_reg_reg(exprasmlist,op,hcountreg,
joinreg64(location.registerlow,location.registerhigh));
if freescratch then
cg.free_scratch_reg(exprasmlist,hcountreg);
end;*)
end
else
begin
{ load left operators in a register }
location_copy(location,left.location);
location_force_reg(exprasmlist,location,OS_INT,false);
{ shifting by a constant directly coded: }
if (right.nodetype=ordconstn) then
begin
{ l shl 32 should 0 imho, but neither TP nor Delphi do it in this way (FK)
if right.value<=31 then
}
cg.a_op_const_reg(exprasmlist,op,tordconstnode(right).value and 31,
location.register);
{
else
emit_reg_reg(A_XOR,S_L,hregister1,
hregister1);
}
end
else
begin
{ load right operators in a register - this
is done since most target cpu which will use this
node do not support a shift count in a mem. location (cec)
}
if right.location.loc<>LOC_REGISTER then
begin
if right.location.loc<>LOC_CREGISTER then
location_release(exprasmlist,right.location);
hcountreg:=cg.get_scratch_reg_int(exprasmlist);
freescratch := true;
cg.a_load_loc_reg(exprasmlist,right.location,hcountreg);
end
else
hcountreg:=right.location.register;
cg.a_op_reg_reg(exprasmlist,op,OS_INT,hcountreg,location.register);
if freescratch then
cg.free_scratch_reg(exprasmlist,hcountreg);
end;
end;
end;
begin
cmoddivnode:=tcgmoddivnode;
cunaryminusnode:=tcgunaryminusnode;
cshlshrnode:=tcgshlshrnode;
end.
{
$Log$
Revision 1.1 2002-08-14 19:26:55 carl
Revision 1.2 2002-08-15 15:15:55 carl
* jmpbuf size allocation for exceptions is now cpu specific (as it should)
* more generic nodes for maths
* several fixes for better m68k support
Revision 1.1 2002/08/14 19:26:55 carl
+ generic int_to_real type conversion
+ generic unaryminus node

9
compiler/ncgutil.pas
View File

@ -1277,7 +1277,7 @@ implementation
not(aktprocdef.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
begin
include(rg.usedinproc,accumulator);
tg.gettempofsizereferencepersistant(list,24,procinfo^.exception_jmp_ref);
tg.gettempofsizereferencepersistant(list,JMP_BUF_SIZE,procinfo^.exception_jmp_ref);
tg.gettempofsizereferencepersistant(list,12,procinfo^.exception_env_ref);
tg.gettempofsizereferencepersistant(list,sizeof(aword),procinfo^.exception_result_ref);
new_exception(list,procinfo^.exception_jmp_ref,
@ -1731,7 +1731,12 @@ implementation
end.
{
$Log$
Revision 1.36 2002-08-14 19:25:09 carl
Revision 1.37 2002-08-15 15:15:55 carl
* jmpbuf size allocation for exceptions is now cpu specific (as it should)
* more generic nodes for maths
* several fixes for better m68k support
Revision 1.36 2002/08/14 19:25:09 carl
* fix Florian's last commit for m68k compilation
Revision 1.35 2002/08/13 21:40:56 florian

13
compiler/powerpc/cpuinfo.pas
View File

@ -55,13 +55,24 @@ Const
mmreg_size = 16;
{ target cpu string (used by compiler options) }
target_cpu_string = 'powerpc';
{ size of the buffer used for setjump/longjmp
the size of this buffer is deduced from the
jmp_buf structure in setjumph.inc file
}
{$warning setjmp buf_size unknown!}
jmp_buf_size = 0;
Implementation
end.
{
$Log$
Revision 1.9 2002-08-12 15:08:44 carl
Revision 1.10 2002-08-15 15:15:55 carl
* jmpbuf size allocation for exceptions is now cpu specific (as it should)
* more generic nodes for maths
* several fixes for better m68k support
Revision 1.9 2002/08/12 15:08:44 carl
+ stab register indexes for powerpc (moved from gdb to cpubase)
+ tprocessor enumeration moved to cpuinfo
+ linker in target_info is now a class

14
compiler/powerpc/nppcmat.pas
View File

@ -36,6 +36,8 @@ interface
tppcshlshrnode = class(tshlshrnode)
procedure pass_2;override;
{ everything will be handled in pass_2 }
function first_shlshr64bitint: tnode; override;
end;
tppcunaryminusnode = class(tunaryminusnode)
@ -161,6 +163,11 @@ implementation
TPPCSHLRSHRNODE
*****************************************************************************}
function tppcshlshrnode.first_shlshr64bitint: tnode;
begin
result := nil;
end;
procedure tppcshlshrnode.pass_2;
var
@ -495,7 +502,12 @@ begin
end.
{
$Log$
Revision 1.16 2002-08-10 17:15:31 jonas
Revision 1.17 2002-08-15 15:15:55 carl
* jmpbuf size allocation for exceptions is now cpu specific (as it should)
* more generic nodes for maths
* several fixes for better m68k support
Revision 1.16 2002/08/10 17:15:31 jonas
* various fixes and optimizations
Revision 1.15 2002/07/26 10:48:34 jonas

12
compiler/utils/ppudump.pp
View File

@ -156,7 +156,7 @@ type
str : string[30];
end;
const
flagopts=15;
flagopts=16;
flagopt : array[1..flagopts] of tflagopt=(
(mask: $1 ;str:'init'),
(mask: $2 ;str:'final'),
@ -172,7 +172,8 @@ const
(mask: $800 ;str:'has_resources'),
(mask: $1000 ;str:'little_endian'),
(mask: $2000 ;str:'release'),
(mask: $4000 ;str:'local_threadvars')
(mask: $4000 ;str:'local_threadvars'),
(mask: $8000 ;str:'fpu emulation on')
);
var
i : longint;
@ -1823,7 +1824,12 @@ begin
end.
{
$Log$
Revision 1.26 2002-08-11 13:24:20 peter
Revision 1.27 2002-08-15 15:15:56 carl
* jmpbuf size allocation for exceptions is now cpu specific (as it should)
* more generic nodes for maths
* several fixes for better m68k support
Revision 1.26 2002/08/11 13:24:20 peter
* saving of asmsymbols in ppu supported
* asmsymbollist global is removed and moved into a new class
tasmlibrarydata that will hold the info of a .a file which