paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-14 14:29:14 +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_restore_standard_registers(list : taasmoutput);override;
procedure g_save_all_registers(list : taasmoutput);override; procedure g_save_all_registers(list : taasmoutput);override;
procedure g_restore_all_registers(list : taasmoutput;selfused,accused,acchiused:boolean);override; procedure g_restore_all_registers(list : taasmoutput;selfused,accused,acchiused:boolean);override;
protected
function fixref(list: taasmoutput; var ref: treference): boolean;
private private
{ # Sign or zero extend the register to a full 32-bit value. { # Sign or zero extend the register to a full 32-bit value.
The new value is left in the same register. The new value is left in the same register.
} }
procedure sign_extend(list: taasmoutput;_oldsize : tcgsize; reg: tregister); procedure sign_extend(list: taasmoutput;_oldsize : tcgsize; reg: tregister);
procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel); procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
end; end;
Implementation
uses { This function returns true if the reference+offset is valid.
globtype,globals,verbose,systems,cutils, Otherwise extra code must be generated to solve the reference.
symdef,symsym,defbase,paramgr,
rgobj,tgobj,rgcpu; 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 const
TCGSize2OpSize: Array[tcgsize] of topsize = 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); 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 } { opcode table lookup }
topcg2tasmop: Array[topcg] of tasmop = 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); 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); procedure tcg68k.a_call_ref(list : taasmoutput;const ref : treference);
var
href : treference;
begin 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; end;
@ -164,7 +237,7 @@ const
list.concat(taicpu.op_reg(A_CLR,S_L,register)) list.concat(taicpu.op_reg(A_CLR,S_L,register))
else else
begin 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)) list.concat(taicpu.op_const_reg(A_MOVEQ,S_L,a,register))
else else
list.concat(taicpu.op_const_reg(A_MOVE,S_L,a,register)) list.concat(taicpu.op_const_reg(A_MOVE,S_L,a,register))
@ -172,9 +245,13 @@ const
end; end;
procedure tcg68k.a_load_reg_ref(list : taasmoutput;size : tcgsize;register : tregister;const ref : treference); procedure tcg68k.a_load_reg_ref(list : taasmoutput;size : tcgsize;register : tregister;const ref : treference);
var
href : treference;
begin begin
href := ref;
fixref(list,href);
{ move to destination reference } { 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; end;
procedure tcg68k.a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister); procedure tcg68k.a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister);
@ -186,8 +263,12 @@ const
end; end;
procedure tcg68k.a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref : treference;register : tregister); procedure tcg68k.a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref : treference;register : tregister);
var
href : treference;
begin 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 } { extend the value in the register }
sign_extend(list, size, register); sign_extend(list, size, register);
end; end;
@ -198,12 +279,16 @@ const
end; end;
procedure tcg68k.a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister); procedure tcg68k.a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);
var
href : treference;
begin begin
if (not rg.isaddressregister(r)) then if (not rg.isaddressregister(r)) then
begin begin
internalerror(2002072901); internalerror(2002072901);
end; 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; end;
procedure tcg68k.a_loadfpu_reg_reg(list: taasmoutput; reg1, reg2: tregister); 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); procedure tcg68k.a_loadfpu_ref_reg(list: taasmoutput; size: tcgsize; const ref: treference; reg: tregister);
var var
opsize : topsize; opsize : topsize;
href : treference;
begin begin
opsize := tcgsize2opsize[size]; opsize := tcgsize2opsize[size];
{ extended is not supported, since it is not available on Coldfire } { extended is not supported, since it is not available on Coldfire }
if opsize = S_FX then if opsize = S_FX then
internalerror(20020729); 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; end;
procedure tcg68k.a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference); procedure tcg68k.a_loadfpu_reg_ref(list: taasmoutput; size: tcgsize; reg: tregister; const ref: treference);
@ -261,6 +348,9 @@ const
scratch_reg2: tregister; scratch_reg2: tregister;
opcode : tasmop; opcode : tasmop;
begin begin
{ need to emit opcode? }
if not optimize_const_reg(op, a) then
exit;
opcode := topcg2tasmop[op]; opcode := topcg2tasmop[op];
case op of case op of
OP_ADD : OP_ADD :
@ -288,7 +378,7 @@ const
end; end;
OP_IMUL : OP_IMUL :
Begin Begin
if aktoptprocessor = MC68000 then if aktoptprocessor = MC68000 then
begin begin
rg.getexplicitregisterint(list,R_D0); rg.getexplicitregisterint(list,R_D0);
rg.getexplicitregisterint(list,R_D1); rg.getexplicitregisterint(list,R_D1);
@ -751,8 +841,8 @@ const
{ move a dword x times } { move a dword x times }
for i:=1 to helpsize do for i:=1 to helpsize do
begin begin
list.concat(taicpu.op_ref_reg(A_MOVE,S_L,srcref,hregister)); a_load_ref_reg(list,OS_INT,srcref,hregister);
list.concat(taicpu.op_reg_ref(A_MOVE,S_L,hregister,dstref)); a_load_reg_ref(list,OS_INT,hregister,dstref);
inc(srcref.offset,4); inc(srcref.offset,4);
inc(dstref.offset,4); inc(dstref.offset,4);
dec(len,4); dec(len,4);
@ -760,8 +850,8 @@ const
{ move a word } { move a word }
if len>1 then if len>1 then
begin begin
list.concat(taicpu.op_ref_reg(A_MOVE,S_W,srcref,hregister)); a_load_ref_reg(list,OS_16,srcref,hregister);
list.concat(taicpu.op_reg_ref(A_MOVE,S_W,hregister,dstref)); a_load_reg_ref(list,OS_16,hregister,dstref);
inc(srcref.offset,2); inc(srcref.offset,2);
inc(dstref.offset,2); inc(dstref.offset,2);
dec(len,2); dec(len,2);
@ -769,8 +859,8 @@ const
{ move a single byte } { move a single byte }
if len>0 then if len>0 then
begin begin
list.concat(taicpu.op_ref_reg(A_MOVE,S_B,srcref,hregister)); a_load_ref_reg(list,OS_8,srcref,hregister);
list.concat(taicpu.op_reg_ref(A_MOVE,S_B,hregister,dstref)); a_load_reg_ref(list,OS_8,hregister,dstref);
end end
end end
@ -789,11 +879,11 @@ const
{ jregister = destination } { jregister = destination }
if loadref then 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 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 } { double word move only on 68020+ machines }
{ because of possible alignment problems } { because of possible alignment problems }
@ -865,7 +955,7 @@ const
{ Not to complicate the code generator too much, and since some } { Not to complicate the code generator too much, and since some }
{ of the systems only support this format, the localsize cannot } { of the systems only support this format, the localsize cannot }
{ exceed 32K in size. } { 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); CGMessage(cg_e_stacklimit_in_local_routine);
list.concat(taicpu.op_reg_const(A_LINK,S_W,frame_pointer_reg,-localsize)); list.concat(taicpu.op_reg_const(A_LINK,S_W,frame_pointer_reg,-localsize));
end { endif localsize <> 0 } end { endif localsize <> 0 }
@ -1012,7 +1102,12 @@ end.
{ {
$Log$ $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 * rename swatoperands to swapoperands
+ m68k first compilable version (still needs a lot of testing): + m68k first compilable version (still needs a lot of testing):
assembler generator, system information , inline assembler generator, system information , inline

11
compiler/m68k/cpunode.pas
View File

@ -30,7 +30,7 @@ unit cpunode;
uses uses
{ generic nodes } { 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, { to be able to only parts of the generic code,
the processor specific nodes must be included the processor specific nodes must be included
after the generic one (FK) after the generic one (FK)
@ -46,13 +46,18 @@ unit cpunode;
{ this not really a node } { this not really a node }
// nppcobj, // nppcobj,
// nppcmat, // nppcmat,
// nppccnv ,n68kcnv
; ;
end. end.
{ {
$Log$ $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 * rename swatoperands to swapoperands
+ m68k first compilable version (still needs a lot of testing): + m68k first compilable version (still needs a lot of testing):
assembler generator, system information , inline 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
}