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

+ m68k type conversion nodes

Browse Source 
+ started some mathematical nodes
  * out of bound references should now be handled correctly
This commit is contained in:
carl 2002-08-14 19:16:34 +00:00
parent c403293c6a
commit 7866026667
4 changed files with 938 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

143
compiler/m68k/cgcpu.pas
View File

@ -78,20 +78,27 @@ unit cgcpu;
procedure g_restore_standard_registers(list : taasmoutput);override;
procedure g_save_all_registers(list : taasmoutput);override;
procedure g_restore_all_registers(list : taasmoutput;selfused,accused,acchiused:boolean);override;
protected
function fixref(list: taasmoutput; var ref: treference): boolean;
private
{ # Sign or zero extend the register to a full 32-bit value.
The new value is left in the same register.
}
procedure sign_extend(list: taasmoutput;_oldsize : tcgsize; reg: tregister);
procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
end;
Implementation
uses
globtype,globals,verbose,systems,cutils,
symdef,symsym,defbase,paramgr,
rgobj,tgobj,rgcpu;
{ This function returns true if the reference+offset is valid.
Otherwise extra code must be generated to solve the reference.
On the m68k, this verifies that the reference is valid
(e.g : if index register is used, then the max displacement
is 256 bytes, if only base is used, then max displacement
is 32K
}
function isvalidrefoffset(const ref: treference): boolean;
const
TCGSize2OpSize: Array[tcgsize] of topsize =
@ -100,6 +107,17 @@ const
S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO,S_NO);
Implementation
uses
globtype,globals,verbose,systems,cutils,
symdef,symsym,defbase,paramgr,
rgobj,tgobj,rgcpu;
const
{ opcode table lookup }
topcg2tasmop: Array[topcg] of tasmop =
(
@ -137,6 +155,58 @@ const
);
function isvalidrefoffset(const ref: treference): boolean;
begin
isvalidrefoffset := true;
if ref.index <> R_NO then
begin
if ref.base <> R_NO then
internalerror(20020814);
if (ref.offset < low(shortint)) or (ref.offset > high(shortint)) then
isvalidrefoffset := false
end
else
begin
if (ref.offset < low(smallint)) or (ref.offset > high(smallint)) then
isvalidrefoffset := false;
end;
end;
function tcg68k.fixref(list: taasmoutput; var ref: treference): boolean;
var
tmpreg: tregister;
begin
result := false;
if (ref.base <> R_NO) then
begin
if (ref.index <> R_NO) and assigned(ref.symbol) then
internalerror(20020814);
{ base + reg }
if ref.index <> R_NO then
begin
{ base + reg + offset }
if (ref.offset < low(shortint)) or (ref.offset > high(shortint)) then
begin
list.concat(taicpu.op_const_reg(A_ADD,S_L,ref.offset,ref.base));
fixref := true;
ref.offset := 0;
exit;
end;
end
else
{ base + offset }
if (ref.offset < low(smallint)) or (ref.offset > high(smallint)) then
begin
list.concat(taicpu.op_const_reg(A_ADD,S_L,ref.offset,ref.base));
fixref := true;
ref.offset := 0;
exit;
end;
end;
end;
procedure tcg68k.a_call_name(list : taasmoutput;const s : string);
@ -147,9 +217,12 @@ const
procedure tcg68k.a_call_ref(list : taasmoutput;const ref : treference);
var
href : treference;
begin
list.concat(taicpu.op_ref(A_JSR,S_NO,ref));
href := ref;
fixref(list,href);
list.concat(taicpu.op_ref(A_JSR,S_NO,href));
end;
@ -164,7 +237,7 @@ const
list.concat(taicpu.op_reg(A_CLR,S_L,register))
else
begin
if (longint(a) >= -128) and (longint(a) <= 127) then
if (longint(a) >= low(shortint)) and (longint(a) <= high(shortint)) then
list.concat(taicpu.op_const_reg(A_MOVEQ,S_L,a,register))
else
list.concat(taicpu.op_const_reg(A_MOVE,S_L,a,register))
@ -172,9 +245,13 @@ const
end;
procedure tcg68k.a_load_reg_ref(list : taasmoutput;size : tcgsize;register : tregister;const ref : treference);
var
href : treference;
begin
href := ref;
fixref(list,href);
{ move to destination reference }
list.concat(taicpu.op_reg_ref(A_MOVE,TCGSize2OpSize[size],register,ref));
list.concat(taicpu.op_reg_ref(A_MOVE,TCGSize2OpSize[size],register,href));
end;
procedure tcg68k.a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister);
@ -186,8 +263,12 @@ const
end;
procedure tcg68k.a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref : treference;register : tregister);
var
href : treference;
begin
list.concat(taicpu.op_ref_reg(A_MOVE,TCGSize2OpSize[size],ref,register));
href := ref;
fixref(list,href);
list.concat(taicpu.op_ref_reg(A_MOVE,TCGSize2OpSize[size],href,register));
{ extend the value in the register }
sign_extend(list, size, register);
end;
@ -198,12 +279,16 @@ const
end;
procedure tcg68k.a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);
var
href : treference;
begin
if (not rg.isaddressregister(r)) then
begin
internalerror(2002072901);
end;
list.concat(taicpu.op_ref_reg(A_LEA,S_L,ref,r));
href:=ref;
fixref(list, href);
list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,r));
end;
procedure tcg68k.a_loadfpu_reg_reg(list: taasmoutput; reg1, reg2: tregister);
@ -215,12 +300,14 @@ const
procedure tcg68k.a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister);
var
opsize : topsize;
href : treference;
begin
opsize := tcgsize2opsize[size];
{ extended is not supported, since it is not available on Coldfire }
if opsize = S_FX then
internalerror(20020729);
list.concat(taicpu.op_ref_reg(A_FMOVE,opsize,ref,reg));
fixref(list,href);
list.concat(taicpu.op_ref_reg(A_FMOVE,opsize,href,reg));
end;
procedure tcg68k.a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference);
@ -261,6 +348,9 @@ const
scratch_reg2: tregister;
opcode : tasmop;
begin
{ need to emit opcode? }
if not optimize_const_reg(op, a) then
exit;
opcode := topcg2tasmop[op];
case op of
OP_ADD :
@ -288,7 +378,7 @@ const
end;
OP_IMUL :
Begin
if aktoptprocessor = MC68000 then
if aktoptprocessor = MC68000 then
begin
rg.getexplicitregisterint(list,R_D0);
rg.getexplicitregisterint(list,R_D1);
@ -751,8 +841,8 @@ const
{ move a dword x times }
for i:=1 to helpsize do
begin
list.concat(taicpu.op_ref_reg(A_MOVE,S_L,srcref,hregister));
list.concat(taicpu.op_reg_ref(A_MOVE,S_L,hregister,dstref));
a_load_ref_reg(list,OS_INT,srcref,hregister);
a_load_reg_ref(list,OS_INT,hregister,dstref);
inc(srcref.offset,4);
inc(dstref.offset,4);
dec(len,4);
@ -760,8 +850,8 @@ const
{ move a word }
if len>1 then
begin
list.concat(taicpu.op_ref_reg(A_MOVE,S_W,srcref,hregister));
list.concat(taicpu.op_reg_ref(A_MOVE,S_W,hregister,dstref));
a_load_ref_reg(list,OS_16,srcref,hregister);
a_load_reg_ref(list,OS_16,hregister,dstref);
inc(srcref.offset,2);
inc(dstref.offset,2);
dec(len,2);
@ -769,8 +859,8 @@ const
{ move a single byte }
if len>0 then
begin
list.concat(taicpu.op_ref_reg(A_MOVE,S_B,srcref,hregister));
list.concat(taicpu.op_reg_ref(A_MOVE,S_B,hregister,dstref));
a_load_ref_reg(list,OS_8,srcref,hregister);
a_load_reg_ref(list,OS_8,hregister,dstref);
end
end
@ -789,11 +879,11 @@ const
{ jregister = destination }
if loadref then
list.concat(taicpu.op_ref_reg(A_MOVE,S_L,source,iregister))
a_load_ref_reg(list,OS_INT,source,iregister)
else
list.concat(taicpu.op_ref_reg(A_LEA,S_L,source,iregister));
a_loadaddr_ref_reg(list,source,iregister);
list.concat(taicpu.op_ref_reg(A_LEA,S_L,dest,jregister));
a_loadaddr_ref_reg(list,dest,jregister);
{ double word move only on 68020+ machines }
{ because of possible alignment problems }
@ -865,7 +955,7 @@ const
{ Not to complicate the code generator too much, and since some }
{ of the systems only support this format, the localsize cannot }
{ exceed 32K in size. }
if (localsize < -32767) or (localsize > 32768) then
if (localsize < low(smallint)) or (localsize > high(smallint)) then
CGMessage(cg_e_stacklimit_in_local_routine);
list.concat(taicpu.op_reg_const(A_LINK,S_W,frame_pointer_reg,-localsize));
end { endif localsize <> 0 }
@ -1012,7 +1102,12 @@ end.
{
$Log$
Revision 1.1 2002-08-13 18:30:22 carl
Revision 1.2 2002-08-14 19:16:34 carl
+ m68k type conversion nodes
+ started some mathematical nodes
* out of bound references should now be handled correctly
Revision 1.1 2002/08/13 18:30:22 carl
* rename swatoperands to swapoperands
+ m68k first compilable version (still needs a lot of testing):
assembler generator, system information , inline

11
compiler/m68k/cpunode.pas
View File

@ -30,7 +30,7 @@ unit cpunode;
uses
{ generic nodes }
ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon,ncgcal,ncgset,ncginl
ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon,ncgcal,ncgset,ncginl,ncgmat
{ to be able to only parts of the generic code,
the processor specific nodes must be included
after the generic one (FK)
@ -46,13 +46,18 @@ unit cpunode;
{ this not really a node }
// nppcobj,
// nppcmat,
// nppccnv
,n68kcnv
;
end.
{
$Log$
Revision 1.1 2002-08-13 18:01:52 carl
Revision 1.2 2002-08-14 19:16:34 carl
+ m68k type conversion nodes
+ started some mathematical nodes
* out of bound references should now be handled correctly
Revision 1.1 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

301
compiler/m68k/n68kcnv.pas Normal file
View File

@ -0,0 +1,301 @@
{
$Id$
Copyright (c) 1998-2002 by Florian Klaempfl
Generate m68k assembler for type converting 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 n68kcnv;
{$i fpcdefs.inc}
interface
uses
node,ncnv,ncgcnv,defbase;
type
tm68ktypeconvnode = class(tcgtypeconvnode)
protected
function first_int_to_real: tnode; override;
procedure second_int_to_real;override;
procedure second_int_to_bool;override;
procedure pass_2;override;
procedure second_call_helper(c : tconverttype); override;
end;
implementation
uses
verbose,globals,systems,
symconst,symdef,aasmbase,aasmtai,
cgbase,pass_1,pass_2,
ncon,ncal,
ncgutil,
cpubase,aasmcpu,
rgobj,tgobj,cgobj,cginfo,globtype,cgcpu;
{*****************************************************************************
FirstTypeConv
*****************************************************************************}
function tm68ktypeconvnode.first_int_to_real: tnode;
var
fname: string[19];
begin
{ In case we are in emulation mode, we must
always call the helpers
}
if (cs_fp_emulation in aktmoduleswitches) then
begin
result := inherited first_int_to_real;
exit;
end
else
{ converting a 64bit integer to a float requires a helper }
if is_64bitint(left.resulttype.def) then
begin
if is_signed(left.resulttype.def) then
fname := 'fpc_int64_to_double'
else
fname := 'fpc_qword_to_double';
result := ccallnode.createintern(fname,ccallparanode.create(
left,nil));
left:=nil;
firstpass(result);
exit;
end
else
{ other integers are supposed to be 32 bit }
begin
if is_signed(left.resulttype.def) then
inserttypeconv(left,s32bittype)
else
{ the fpu always considers 32-bit values as signed
therefore we need to call the helper in case of
a cardinal value.
}
begin
fname := 'fpc_cardinal_to_double';
result := ccallnode.createintern(fname,ccallparanode.create(
left,nil));
left:=nil;
firstpass(result);
exit;
end;
firstpass(left);
end;
result := nil;
if registersfpu<1 then
registersfpu:=1;
location.loc:=LOC_FPUREGISTER;
end;
{*****************************************************************************
SecondTypeConv
*****************************************************************************}
procedure tm68ktypeconvnode.second_int_to_real;
var
tempconst: trealconstnode;
ref: treference;
valuereg, tempreg, leftreg, tmpfpureg: tregister;
signed : boolean;
scratch_used : boolean;
opsize : tcgsize;
begin
scratch_used := false;
location_reset(location,LOC_FPUREGISTER,def_cgsize(resulttype.def));
signed := is_signed(left.resulttype.def);
opsize := def_cgsize(left.resulttype.def);
{ has to be handled by a helper }
if is_64bitint(left.resulttype.def) then
internalerror(200110011);
{ has to be handled by a helper }
if not signed then
internalerror(20020814);
location.register := rg.getregisterfpu(exprasmlist);
case left.location.loc of
LOC_REGISTER, LOC_CREGISTER:
begin
leftreg := left.location.register;
exprasmlist.concat(taicpu.op_reg_reg(A_FMOVE,TCGSize2OpSize[opsize],leftreg,
location.register));
end;
LOC_REFERENCE,LOC_CREFERENCE:
begin
exprasmlist.concat(taicpu.op_ref_reg(A_FMOVE,TCGSize2OpSize[opsize],
left.location.reference,location.register));
end
else
internalerror(200110012);
end;
end;
procedure tm68ktypeconvnode.second_int_to_bool;
var
hreg1,
hreg2 : tregister;
resflags : tresflags;
opsize : tcgsize;
begin
{ byte(boolean) or word(wordbool) or longint(longbool) must }
{ be accepted for var parameters }
if (nf_explizit in flags) and
(left.resulttype.def.size=resulttype.def.size) and
(left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
begin
location_copy(location,left.location);
exit;
end;
location_reset(location,LOC_REGISTER,def_cgsize(left.resulttype.def));
opsize := def_cgsize(left.resulttype.def);
case left.location.loc of
LOC_CREFERENCE,LOC_REFERENCE :
begin
{ can we optimize it, or do we need to fix the ref. ? }
if isvalidrefoffset(left.location.reference) then
begin
exprasmlist.concat(taicpu.op_ref(A_TST,TCGSize2OpSize[opsize],
left.location.reference));
end
else
begin
hreg2:=rg.getregisterint(exprasmlist);
cg.a_load_ref_reg(exprasmlist,opsize,
left.location.reference,hreg2);
exprasmlist.concat(taicpu.op_reg(A_TST,TCGSize2OpSize[opsize],hreg2));
rg.ungetregister(exprasmlist,hreg2);
end;
reference_release(exprasmlist,left.location.reference);
resflags:=F_NE;
hreg1 := rg.getregisterint(exprasmlist);
end;
LOC_REGISTER,LOC_CREGISTER :
begin
hreg2 := left.location.register;
exprasmlist.concat(taicpu.op_reg(A_TST,TCGSize2OpSize[opsize],hreg2));
rg.ungetregister(exprasmlist,hreg2);
hreg1 := rg.getregisterint(exprasmlist);
resflags:=F_NE;
end;
LOC_FLAGS :
begin
hreg1:=rg.getregisterint(exprasmlist);
resflags:=left.location.resflags;
end;
else
internalerror(10062);
end;
cg.g_flags2reg(exprasmlist,location.size,resflags,hreg1);
location.register := hreg1;
end;
procedure tm68ktypeconvnode.second_call_helper(c : tconverttype);
const
secondconvert : array[tconverttype] of pointer = (
@second_nothing, {equal}
@second_nothing, {not_possible}
@second_nothing, {second_string_to_string, handled in resulttype pass }
@second_char_to_string,
@second_nothing, {char_to_charray}
@second_nothing, { pchar_to_string, handled in resulttype pass }
@second_nothing, {cchar_to_pchar}
@second_cstring_to_pchar,
@second_ansistring_to_pchar,
@second_string_to_chararray,
@second_nothing, { chararray_to_string, handled in resulttype pass }
@second_array_to_pointer,
@second_pointer_to_array,
@second_int_to_int,
@second_int_to_bool,
@second_bool_to_int, { bool_to_bool }
@second_bool_to_int,
@second_real_to_real,
@second_int_to_real,
@second_proc_to_procvar,
@second_nothing, { arrayconstructor_to_set }
@second_nothing, { second_load_smallset, handled in first pass }
@second_cord_to_pointer,
@second_nothing, { interface 2 string }
@second_nothing, { interface 2 guid }
@second_class_to_intf,
@second_char_to_char,
@second_nothing, { normal_2_smallset }
@second_nothing { dynarray_2_openarray }
);
type
tprocedureofobject = procedure of object;
var
r : packed record
proc : pointer;
obj : pointer;
end;
begin
{ this is a little bit dirty but it works }
{ and should be quite portable too }
r.proc:=secondconvert[c];
r.obj:=self;
tprocedureofobject(r){$ifdef FPC}();{$endif FPC}
end;
procedure tm68ktypeconvnode.pass_2;
{$ifdef TESTOBJEXT2}
var
r : preference;
nillabel : plabel;
{$endif TESTOBJEXT2}
begin
{ this isn't good coding, I think tc_bool_2_int, shouldn't be }
{ type conversion (FK) }
if not(convtype in [tc_bool_2_int,tc_bool_2_bool]) then
begin
secondpass(left);
location_copy(location,left.location);
if codegenerror then
exit;
end;
second_call_helper(convtype);
end;
begin
ctypeconvnode:=tppctypeconvnode;
end.
{
$Log$
Revision 1.1 2002-08-14 19:16:34 carl
+ m68k type conversion nodes
+ started some mathematical nodes
* out of bound references should now be handled correctly
}

510
compiler/m68k/n68kmat.pas Normal file
View File

@ -0,0 +1,510 @@
{
$Id$
Copyright (c) 1998-2002 by Florian Klaempfl
Generate i386 assembler for math 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 ncgmat;
{$i fpcdefs.inc}
interface
uses
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
uses
globtype,systems,
cutils,verbose,globals,
symconst,symdef,aasmbase,aasmtai,aasmcpu,defbase,
cginfo,cgbase,pass_1,pass_2,
ncon,
cpubase,cpuinfo,
tgobj,ncgutil,cgobj,rgobj,rgcpu;
{*****************************************************************************
TI386MODDIVNODE
*****************************************************************************}
procedure tm68kmoddivnode.pass_2;
var
hreg1 : tregister;
hreg2 : tregister;
hdenom : 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,hreg,hl);
if power=1 then
cg.a_op_const_reg(exprasmlist,OP_ADD,OS_32,1,hreg1)
else
cg.a_op_const_reg(exprasmlist,OP_ADD,OS_32,
tordconstnode(right).value-1,hreg1);
cg.a_label(exprasmlist,hl);
cg.a_op_const_reg(exprasmlist,OP_SAR,OS_INT,power,hreg1);
End
Else { not signed }
Begin
cg.a_op_const_reg(exprasmlist,OP_SHR,OS_INT,power,hreg1);
end;
End
else
begin
{ bring denominator to D1 }
{ D1 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(hl1);
cg.a_cmp_const_reg_label(exprasmlist,OS_INT,OC_NE,0,hdenom,hl1);
cg.a_param_reg(exprasmlist,OS_S32,paramanager.getintparaloc(1));
cg.a_call_name('FPC_HANDLERROR');
cg.a_label(exprasmlist,hl1);
{ This should be moved to emit_moddiv_reg_reg }
if is_signed(left.resulttype.def) then
cg.a_op_reg_reg(exprasmlist,OS_INT,OP_IDIV,hdenom,hreg1)
else
cg.a_op_reg_reg(exprasmlist,OS_INT,OP_DIV,hdenom,hreg1);
if nodetype = modn then
begin
{$warning modnode should be tested}
{ multiply by denominator to get modulo }
cg.a_op_reg_reg(exprasmlist,OS_INT,OP_IMUL,hdenom,hreg1)
end;
end;
location_reset(location,LOC_REGISTER,OS_INT);
location.register:=hreg1;
end;
end;
{*****************************************************************************
TI386SHLRSHRNODE
*****************************************************************************}
procedure tm68kshlshrnode.pass_2;
var
hregister2,hregister3,
hregisterhigh,hregisterlow : tregister;
popecx : boolean;
op : tasmop;
l1,l2,l3 : tasmlabel;
pushedregs : tmaybesave;
begin
popecx:=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:=A_SHL;
shrn: op:=A_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);
hregisterhigh:=left.location.registerhigh;
hregisterlow:=left.location.registerlow;
{ shifting by a constant directly coded: }
if (right.nodetype=ordconstn) then
begin
{ shrd/shl works only for values <=31 !! }
if tordconstnode(right).value>31 then
begin
if nodetype=shln then
begin
emit_reg_reg(A_XOR,S_L,hregisterhigh,
hregisterhigh);
if ((tordconstnode(right).value and 31) <> 0) then
emit_const_reg(A_SHL,S_L,tordconstnode(right).value and 31,
hregisterlow);
end
else
begin
emit_reg_reg(A_XOR,S_L,hregisterlow,
hregisterlow);
if ((tordconstnode(right).value and 31) <> 0) then
emit_const_reg(A_SHR,S_L,tordconstnode(right).value and 31,
hregisterhigh);
end;
location.registerhigh:=hregisterlow;
location.registerlow:=hregisterhigh;
end
else
begin
if nodetype=shln then
begin
emit_const_reg_reg(A_SHLD,S_L,tordconstnode(right).value and 31,
hregisterlow,hregisterhigh);
emit_const_reg(A_SHL,S_L,tordconstnode(right).value and 31,
hregisterlow);
end
else
begin
emit_const_reg_reg(A_SHRD,S_L,tordconstnode(right).value and 31,
hregisterhigh,hregisterlow);
emit_const_reg(A_SHR,S_L,tordconstnode(right).value and 31,
hregisterhigh);
end;
location.registerlow:=hregisterlow;
location.registerhigh:=hregisterhigh;
end;
end
else
begin
{ load right operators in a register }
if right.location.loc<>LOC_REGISTER then
begin
if right.location.loc<>LOC_CREGISTER then
location_release(exprasmlist,right.location);
hregister2:=rg.getexplicitregisterint(exprasmlist,R_ECX);
cg.a_load_loc_reg(exprasmlist,right.location,hregister2);
end
else
hregister2:=right.location.register;
{ left operator is already in a register }
{ hence are both in a register }
{ is it in the case ECX ? }
if (hregisterlow=R_ECX) then
begin
{ then only swap }
emit_reg_reg(A_XCHG,S_L,hregisterlow,hregister2);
hregister3:=hregisterlow;
hregisterlow:=hregister2;
hregister2:=hregister3;
end
else if (hregisterhigh=R_ECX) then
begin
{ then only swap }
emit_reg_reg(A_XCHG,S_L,hregisterhigh,hregister2);
hregister3:=hregisterhigh;
hregisterhigh:=hregister2;
hregister2:=hregister3;
end
{ if second operator not in ECX ? }
else if (hregister2<>R_ECX) then
begin
{ ECX occupied then push it }
if not (R_ECX in rg.unusedregsint) then
begin
popecx:=true;
emit_reg(A_PUSH,S_L,R_ECX);
end
else
rg.getexplicitregisterint(exprasmlist,R_ECX);
emit_reg_reg(A_MOV,S_L,hregister2,R_ECX);
end;
if hregister2 <> R_ECX then
rg.ungetregisterint(exprasmlist,hregister2);
{ the damned shift instructions work only til a count of 32 }
{ so we've to do some tricks here }
if nodetype=shln then
begin
objectlibrary.getlabel(l1);
objectlibrary.getlabel(l2);
objectlibrary.getlabel(l3);
emit_const_reg(A_CMP,S_L,64,R_ECX);
emitjmp(C_L,l1);
emit_reg_reg(A_XOR,S_L,hregisterlow,hregisterlow);
emit_reg_reg(A_XOR,S_L,hregisterhigh,hregisterhigh);
cg.a_jmp_always(exprasmlist,l3);
cg.a_label(exprasmlist,l1);
emit_const_reg(A_CMP,S_L,32,R_ECX);
emitjmp(C_L,l2);
emit_const_reg(A_SUB,S_L,32,R_ECX);
emit_reg_reg(A_SHL,S_L,R_CL,
hregisterlow);
emit_reg_reg(A_MOV,S_L,hregisterlow,hregisterhigh);
emit_reg_reg(A_XOR,S_L,hregisterlow,hregisterlow);
cg.a_jmp_always(exprasmlist,l3);
cg.a_label(exprasmlist,l2);
emit_reg_reg_reg(A_SHLD,S_L,R_CL,
hregisterlow,hregisterhigh);
emit_reg_reg(A_SHL,S_L,R_CL,
hregisterlow);
cg.a_label(exprasmlist,l3);
end
else
begin
objectlibrary.getlabel(l1);
objectlibrary.getlabel(l2);
objectlibrary.getlabel(l3);
emit_const_reg(A_CMP,S_L,64,R_ECX);
emitjmp(C_L,l1);
emit_reg_reg(A_XOR,S_L,hregisterlow,hregisterlow);
emit_reg_reg(A_XOR,S_L,hregisterhigh,hregisterhigh);
cg.a_jmp_always(exprasmlist,l3);
cg.a_label(exprasmlist,l1);
emit_const_reg(A_CMP,S_L,32,R_ECX);
emitjmp(C_L,l2);
emit_const_reg(A_SUB,S_L,32,R_ECX);
emit_reg_reg(A_SHR,S_L,R_CL,
hregisterhigh);
emit_reg_reg(A_MOV,S_L,hregisterhigh,hregisterlow);
emit_reg_reg(A_XOR,S_L,hregisterhigh,hregisterhigh);
cg.a_jmp_always(exprasmlist,l3);
cg.a_label(exprasmlist,l2);
emit_reg_reg_reg(A_SHRD,S_L,R_CL,
hregisterhigh,hregisterlow);
emit_reg_reg(A_SHR,S_L,R_CL,
hregisterhigh);
cg.a_label(exprasmlist,l3);
end;
{ maybe put ECX back }
if popecx then
emit_reg(A_POP,S_L,R_ECX)
else
rg.ungetregisterint(exprasmlist,R_ECX);
location.registerlow:=hregisterlow;
location.registerhigh:=hregisterhigh;
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
}
emit_const_reg(op,S_L,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 }
if right.location.loc<>LOC_REGISTER then
begin
if right.location.loc<>LOC_CREGISTER then
location_release(exprasmlist,right.location);
hregister2:=rg.getexplicitregisterint(exprasmlist,R_ECX);
cg.a_load_loc_reg(exprasmlist,right.location,hregister2);
end
else
hregister2:=right.location.register;
{ left operator is already in a register }
{ hence are both in a register }
{ is it in the case ECX ? }
if (location.register=R_ECX) then
begin
{ then only swap }
emit_reg_reg(A_XCHG,S_L,location.register,hregister2);
hregister3:=location.register;
location.register:=hregister2;
hregister2:=hregister3;
end
{ if second operator not in ECX ? }
else if (hregister2<>R_ECX) then
begin
{ ECX occupied then push it }
if not (R_ECX in rg.unusedregsint) then
begin
popecx:=true;
emit_reg(A_PUSH,S_L,R_ECX);
end
else
rg.getexplicitregisterint(exprasmlist,R_ECX);
emit_reg_reg(A_MOV,S_L,hregister2,R_ECX);
end;
rg.ungetregisterint(exprasmlist,hregister2);
{ right operand is in ECX }
emit_reg_reg(op,S_L,R_CL,location.register);
{ maybe ECX back }
if popecx then
emit_reg(A_POP,S_L,R_ECX)
else
rg.ungetregisterint(exprasmlist,R_ECX);
end;
end;
*)
end;
{*****************************************************************************
TI386NOTNODE
*****************************************************************************}
procedure tm68knotnode.pass_2;
const
flagsinvers : array[F_E..F_BE] of tresflags =
(F_NE,F_E,F_LE,F_GE,F_L,F_G,F_NC,F_C,
F_BE,F_B,F_AE,F_A);
var
hl : tasmlabel;
opsize : topsize;
begin
if is_boolean(resulttype.def) then
begin
opsize:=def_opsize(resulttype.def);
{ the second pass could change the location of left }
{ if it is a register variable, so we've to do }
{ this before the case statement }
if left.location.loc<>LOC_JUMP then
secondpass(left);
case left.location.loc of
LOC_JUMP :
begin
location_reset(location,LOC_JUMP,OS_NO);
hl:=truelabel;
truelabel:=falselabel;
falselabel:=hl;
secondpass(left);
maketojumpbool(exprasmlist,left,lr_load_regvars);
hl:=truelabel;
truelabel:=falselabel;
falselabel:=hl;
end;
LOC_FLAGS :
begin
location_release(exprasmlist,left.location);
location_reset(location,LOC_FLAGS,OS_NO);
location.resflags:=flagsinvers[left.location.resflags];
end;
LOC_CONSTANT,
LOC_REGISTER,
LOC_CREGISTER,
LOC_REFERENCE,
LOC_CREFERENCE :
begin
location_force_reg(exprasmlist,left.location,def_cgsize(resulttype.def),true);
list.concat(taicpu.op_reg(A_TST,opsize,left.location.register));
location_release(exprasmlist,left.location);
location_reset(location,LOC_FLAGS,OS_NO);
location.resflags:=F_E;
end;
else
internalerror(200203224);
end;
end
else if is_64bitint(left.resulttype.def) then
begin
secondpass(left);
location_copy(location,left.location);
location_force_reg(exprasmlist,location,OS_64,false);
cg.a_op64_op_loc_reg(exprasmlist,A_NOT,OS_64,
location,joinreg64(l.registerlow,l.registerhigh));
end
else
begin
secondpass(left);
location_copy(location,left.location);
location_force_reg(exprasmlist,location,def_cgsize(resulttype.def),false);
opsize:=def_cgsize(resulttype.def);
cg.a_op_reg_reg(exprasmlist,OP_NOT,location.register,location.register);
end;
end;
begin
cmoddivnode:=tm68kmoddivnode;
cshlshrnode:=tm68kshlshrnode;
cnotnode:=tm68knotnode;
end.
{
$Log$
Revision 1.1 2002-08-14 19:16:34 carl
+ m68k type conversion nodes
+ started some mathematical nodes
* out of bound references should now be handled correctly
}