paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-10 08:58:24 +02:00
Code Issues Packages Projects Releases Wiki Activity
e45bb82d81
fpc/compiler/i386/cgcpu.pas
Jonas Maebe bdf2593265 * fixed range check errors
2001-10-04 14:33:28 +00:00

731 lines
24 KiB
ObjectPascal
Raw Blame History

{
$Id$
Copyright (c) 1998-2000 by Florian Klaempfl
This unit implements the code generator for the i386
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 cgcpu;
{$i defines.inc}
interface
uses
cgbase,cgobj,aasm,cpuasm,cpubase,cpuinfo;
type
tcg386 = class(tcg)
{ passing parameters, per default the parameter is pushed }
{ nr gives the number of the parameter (enumerated from }
{ left to right), this allows to move the parameter to }
{ register, if the cpu supports register calling }
{ conventions }
procedure a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;nr : longint);override;
procedure a_param_const(list : taasmoutput;size : tcgsize;a : aword;nr : longint);override;
procedure a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;nr : longint);override;
procedure a_paramaddr_ref(list : taasmoutput;const r : treference;nr : longint);override;
procedure a_call_name(list : taasmoutput;const s : string;
offset : longint);override;
procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister); override;
procedure a_op_const_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; const ref: TReference); override;
procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister); override;
procedure a_op_ref_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); override;
procedure a_op_reg_ref(list : taasmoutput; Op: TOpCG; size: TCGSize;reg: TRegister; const ref: TReference); override;
{ move instructions }
procedure a_load_const_reg(list : taasmoutput; size: tcgsize; a : aword;reg : tregister);override;
procedure a_load_const_ref(list : taasmoutput; size: tcgsize; a : aword;const ref : treference);override;
procedure a_load_reg_ref(list : taasmoutput; size: tcgsize; reg : tregister;const ref : treference);override;
procedure a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref : treference;reg : tregister);override;
procedure a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister);override;
procedure a_load_sym_ofs_reg(list: taasmoutput; const sym: tasmsymbol; ofs: longint; reg: tregister); override;
{ comparison operations }
procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
l : tasmlabel);override;
procedure a_cmp_const_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const ref : treference;
l : tasmlabel);override;
procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); override;
procedure a_cmp_ref_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;const ref: treference; reg : tregister; l : tasmlabel); override;
procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel); override;
procedure g_flags2reg(list: taasmoutput; const f: tresflags; reg: TRegister); override;
procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override;
procedure g_restore_frame_pointer(list : taasmoutput);override;
procedure g_push_exception_value_reg(list : taasmoutput;reg : tregister);override;
procedure g_push_exception_value_const(list : taasmoutput;reg : tregister);override;
procedure g_pop_exception_value_reg(list : taasmoutput;reg : tregister);override;
procedure g_return_from_proc(list : taasmoutput;parasize : aword); override;
procedure a_loadaddress_ref_reg(list : taasmoutput;const ref : treference;r : tregister);override;
procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean);override;
function makeregsize(var reg: tregister; size: tcgsize): topsize; override;
private
procedure sizes2load(s1: tcgsize; s2: topsize; var op: tasmop; var s3: topsize);
end;
const
TOpCG2AsmOp: Array[topcg] of TAsmOp = (A_ADD,A_AND,A_DIV,
A_IDIV,A_MUL, A_IMUL, A_NEG,A_NOT,A_OR,
A_SAR,A_SHL,A_SHR,A_SUB,A_XOR);
TOpCmp2AsmCond: Array[topcmp] of TAsmCond = (C_NONE,C_E,C_G,
C_L,C_GE,C_LE,C_NE,C_BE,C_B,C_AE,C_A);
TCGSize2OpSize: Array[tcgsize] of topsize = (S_NO,S_B,S_W,S_L,S_L,
S_B,S_W,S_L,S_L);
implementation
uses
globtype,globals,verbose,systems,cutils,cga;
{ we implement the following routines because otherwise we can't }
{ instantiate the class since it's abstract }
procedure tcg386.a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;nr : longint);
begin
runerror(211);
end;
procedure tcg386.a_param_const(list : taasmoutput;size : tcgsize;a : aword;nr : longint);
begin
runerror(211);
end;
procedure tcg386.a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;nr : longint);
var
tmpreg: tregister;
begin
case size of
OS_8,OS_S8,OS_16,OS_S16:
begin
tmpreg := get_scratch_reg(list);
a_load_ref_reg(list,size,r,tmpreg);
if target_info.alignment.paraalign = 2 then
list.concat(taicpu.op_reg(A_PUSH,S_W,makereg16(tmpreg)))
else
list.concat(taicpu.op_reg(A_PUSH,S_L,tmpreg));
end;
OS_32,OS_S32:
list.concat(taicpu.op_ref(A_PUSH,S_L,newreference(r)));
else
internalerror(200109301);
end;
end;
procedure tcg386.a_paramaddr_ref(list : taasmoutput;const r : treference;nr : longint);
begin
runerror(211);
end;
procedure tcg386.a_call_name(list : taasmoutput;const s : string;
offset : longint);
begin
list.concat(taicpu.op_sym_ofs(A_CALL,S_NO,newasmsymbol(s),offset));
end;
{********************** load instructions ********************}
procedure tcg386.a_load_const_reg(list : taasmoutput; size: TCGSize; a : aword; reg : TRegister);
begin
{ the optimizer will change it to "xor reg,reg" when loading zero, }
{ no need to do it here too (JM) }
list.concat(taicpu.op_const_reg(A_MOV,TCGSize2OpSize[size],
longint(a),reg))
end;
procedure tcg386.a_load_const_ref(list : taasmoutput; size: tcgsize; a : aword;const ref : treference);
begin
{ zero is often used several times in succession -> load it in a }
{ register and then store it to memory, so the optimizer can then }
{ remove the unnecessary loads of registers and you get smaller }
{ (and faster) code }
if (a = 0) and
(size in [OS_32,OS_S32]) then
inherited a_load_const_ref(list,size,a,ref)
else
list.concat(taicpu.op_const_ref(A_MOV,TCGSize2OpSize[size],
longint(a),newreference(ref)));
end;
procedure tcg386.a_load_reg_ref(list : taasmoutput; size: TCGSize; reg : tregister;const ref : treference);
begin
list.concat(taicpu.op_reg_ref(A_MOV,TCGSize2OpSize[size],reg,
newreference(ref)));
End;
procedure tcg386.a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref: treference;reg : tregister);
var
op: tasmop;
s: topsize;
begin
if ref.is_immediate then
a_load_const_reg(list,size,aword(ref.offset),reg)
else
begin
sizes2load(size,regsize(reg),op,s);
list.concat(taicpu.op_ref_reg(op,s,newreference(ref),reg));
end;
end;
procedure tcg386.a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister);
var
op: tasmop;
s: topsize;
begin
sizes2load(size,regsize(reg2),op,s);
if (makereg32(reg1) = makereg32(reg2)) then
{ "mov reg1, reg1" doesn't make sense }
if op = A_MOV then
exit
else if (op = A_MOVZX) then
case size of
OS_8:
begin
list.concat(taicpu.op_const_reg(A_AND,regsize(reg2),255,reg2));
exit;
end;
OS_16:
begin
list.concat(taicpu.op_const_reg(A_AND,S_L,65535,reg1));
exit;
end;
end;
list.concat(taicpu.op_reg_reg(op,s,reg1,reg2));
end;
procedure tcg386.a_load_sym_ofs_reg(list: taasmoutput; const sym: tasmsymbol; ofs: longint; reg: tregister);
begin
list.concat(taicpu.op_sym_ofs_reg(A_MOV,S_L,sym,ofs,reg));
end;
procedure tcg386.a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister);
var
opcode: tasmop;
power: longint;
scratch_register: TRegister;
begin
Case Op of
OP_DIV, OP_IDIV:
Begin
if ispowerof2(longint(a),power) then
begin
case op of
OP_DIV:
opcode := A_SHR;
OP_IDIV:
opcode := A_SAR;
end;
list.concat(taicpu.op_const_reg(opcode,regsize(reg),power,
reg));
exit;
end;
{ the rest should be handled specifically in the code }
{ generator because of the silly register usage restraints }
internalerror(200109224);
End;
OP_MUL,OP_IMUL:
begin
if not(cs_check_overflow in aktlocalswitches) and
ispowerof2(longint(a),power) then
begin
list.concat(taicpu.op_const_reg(A_SHL,regsize(reg),power,
reg));
exit;
end;
if op = OP_IMUL then
list.concat(taicpu.op_const_reg(A_IMUL,regsize(reg),
longint(a),reg))
else
{ OP_MUL should be handled specifically in the code }
{ generator because of the silly register usage restraints }
internalerror(200109225);
end;
OP_ADD, OP_AND, OP_OR, OP_SUB, OP_XOR:
if (a = 1) and
(op in [OP_ADD,OP_SUB]) then
if op = OP_ADD then
list.concat(taicpu.op_reg(A_INC,regsize(reg),reg))
else
list.concat(taicpu.op_reg(A_DEC,regsize(reg),reg))
else
list.concat(taicpu.op_const_reg(TOpCG2AsmOp[op],regsize(reg),
longint(a),reg));
OP_SHL,OP_SHR,OP_SAR:
begin
if (a and 31) <> 0 Then
list.concat(taicpu.op_const_reg(
TOpCG2AsmOp[op],regsize(reg),a and 31,reg));
if (a shr 5) <> 0 Then
internalerror(68991);
end
else internalerror(68992);
end;
end;
procedure tcg386.a_op_const_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; const ref: TReference);
var
opcode: tasmop;
power: longint;
scratch_register: TRegister;
begin
Case Op of
OP_DIV, OP_IDIV:
Begin
if ispowerof2(longint(a),power) then
begin
case op of
OP_DIV:
opcode := A_SHR;
OP_IDIV:
opcode := A_SAR;
end;
list.concat(taicpu.op_const_ref(opcode,
TCgSize2OpSize[size],power,newreference(ref)));
exit;
end;
{ the rest should be handled specifically in the code }
{ generator because of the silly register usage restraints }
internalerror(200109231);
End;
OP_MUL,OP_IMUL:
begin
if not(cs_check_overflow in aktlocalswitches) and
ispowerof2(longint(a),power) then
begin
list.concat(taicpu.op_const_ref(A_SHL,TCgSize2OpSize[size],
power,newreference(ref)));
exit;
end;
{ can't multiply a memory location directly with a constant }
if op = OP_IMUL then
inherited a_op_const_ref(list,op,size,a,ref)
else
{ OP_MUL should be handled specifically in the code }
{ generator because of the silly register usage restraints }
internalerror(200109232);
end;
OP_ADD, OP_AND, OP_OR, OP_SUB, OP_XOR:
if (a = 1) and
(op in [OP_ADD,OP_SUB]) then
if op = OP_ADD then
list.concat(taicpu.op_ref(A_INC,TCgSize2OpSize[size],
newreference(ref)))
else
list.concat(taicpu.op_ref(A_DEC,TCgSize2OpSize[size],
newreference(ref)))
else
list.concat(taicpu.op_const_ref(TOpCG2AsmOp[op],
TCgSize2OpSize[size],longint(a),newreference(ref)));
OP_SHL,OP_SHR,OP_SAR:
begin
if (a and 31) <> 0 Then
list.concat(taicpu.op_const_ref(
TOpCG2AsmOp[op],TCgSize2OpSize[size],a and 31,newreference(ref)));
if (a shr 5) <> 0 Then
internalerror(68991);
end
else internalerror(68992);
end;
end;
procedure tcg386.a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister);
var
dstsize: topsize;
begin
dstsize := makeregsize(dst,size);
case op of
OP_NEG,OP_NOT:
begin
list.concat(taicpu.op_reg(TOpCG2AsmOp[op],dstsize,dst));
end;
OP_MUL,OP_DIV,OP_IDIV:
{ special stuff, needs separate handling inside code }
{ generator }
internalerror(200109233);
else
begin
if regsize(src) <> dstsize then
internalerror(200109226);
list.concat(taicpu.op_reg_reg(TOpCG2AsmOp[op],dstsize,
src,dst));
end;
end;
end;
procedure tcg386.a_op_ref_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister);
var
opsize: topsize;
begin
if ref.is_immediate then
a_op_const_reg(list,op,aword(ref.offset),reg)
else
begin
case op of
OP_NEG,OP_NOT,OP_IMUL:
begin
inherited a_op_ref_reg(list,op,size,ref,reg);
end;
OP_MUL,OP_DIV,OP_IDIV:
{ special stuff, needs separate handling inside code }
{ generator }
internalerror(200109239);
else
begin
opsize := makeregsize(reg,size);
list.concat(taicpu.op_ref_reg(TOpCG2AsmOp[op],opsize,
newreference(ref),reg));
end;
end;
end;
end;
procedure tcg386.a_op_reg_ref(list : taasmoutput; Op: TOpCG; size: TCGSize;reg: TRegister; const ref: TReference);
var
opsize: topsize;
begin
case op of
OP_NEG,OP_NOT:
begin
if reg <> R_NO then
internalerror(200109237);
list.concat(taicpu.op_ref(TOpCG2AsmOp[op],tcgsize2opsize[size],
newreference(ref)));
end;
OP_IMUL:
begin
{ this one needs a load/imul/store, which is the default }
inherited a_op_ref_reg(list,op,size,ref,reg);
end;
OP_MUL,OP_DIV,OP_IDIV:
{ special stuff, needs separate handling inside code }
{ generator }
internalerror(200109238);
else
begin
opsize := tcgsize2opsize[size];
list.concat(taicpu.op_reg_ref(TOpCG2AsmOp[op],opsize,reg,
newreference(ref)));
end;
end;
end;
{*************** compare instructructions ****************}
procedure tcg386.a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
l : tasmlabel);
begin
if a <> 0 then
list.concat(taicpu.op_const_reg(A_CMP,regsize(reg),longint(a),
reg))
else
list.concat(taicpu.op_reg_reg(A_TEST,regsize(reg),reg,reg));
a_jmp_cond(list,cmp_op,l);
end;
procedure tcg386.a_cmp_const_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const ref : treference;
l : tasmlabel);
begin
list.concat(taicpu.op_const_ref(A_CMP,TCgSize2OpSize[size],
longint(a),newreference(ref)));
a_jmp_cond(list,cmp_op,l);
end;
procedure tcg386.a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;
reg1,reg2 : tregister;l : tasmlabel);
begin
if regsize(reg1) <> regsize(reg2) then
internalerror(200109226);
list.concat(taicpu.op_reg_reg(A_CMP,regsize(reg1),reg1,reg2));
a_jmp_cond(list,cmp_op,l);
end;
procedure tcg386.a_cmp_ref_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;const ref: treference; reg : tregister;l : tasmlabel);
var
opsize: topsize;
begin
opsize := makeregsize(reg,size);
list.concat(taicpu.op_ref_reg(A_CMP,opsize,newreference(ref),reg));
a_jmp_cond(list,cmp_op,l);
end;
procedure tcg386.a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
var
ai : taicpu;
begin
if cond=OC_None then
ai := Taicpu.Op_sym(A_JMP,S_NO,l)
else
begin
ai:=Taicpu.Op_sym(A_Jcc,S_NO,l);
ai.SetCondition(TOpCmp2AsmCond[cond]);
end;
ai.is_jmp:=true;
list.concat(ai);
end;
procedure tcg386.g_flags2reg(list: taasmoutput; const f: tresflags; reg: TRegister);
var
ai : taicpu;
hreg : tregister;
begin
hreg := makereg8(reg);
ai:=Taicpu.Op_reg(A_Setcc,S_B,hreg);
ai.SetCondition(flag_2_cond[f]);
list.concat(ai);
if hreg<>reg then
begin
if reg in regset16bit then
emit_to_reg16(hreg)
else
emit_to_reg32(hreg);
end;
end;
{ *********** entry/exit code and address loading ************ }
procedure tcg386.g_stackframe_entry(list : taasmoutput;localsize : longint);
begin
runerror(211);
end;
procedure tcg386.g_restore_frame_pointer(list : taasmoutput);
begin
runerror(211);
end;
procedure tcg386.g_push_exception_value_reg(list : taasmoutput;reg : tregister);
begin
runerror(211);
end;
procedure tcg386.g_push_exception_value_const(list : taasmoutput;reg : tregister);
begin
runerror(211);
end;
procedure tcg386.g_pop_exception_value_reg(list : taasmoutput;reg : tregister);
begin
runerror(211);
end;
procedure tcg386.g_return_from_proc(list : taasmoutput;parasize : aword);
begin
runerror(211);
end;
procedure tcg386.a_loadaddress_ref_reg(list : taasmoutput;const ref : treference;r : tregister);
begin
list.concat(taicpu.op_ref_reg(A_LEA,S_L,newreference(ref),r));
end;
function tcg386.makeregsize(var reg: tregister; size: tcgsize): topsize;
begin
{ this function only allows downsizing a register, because otherwise }
{ we may start working with garbage (JM) }
case size of
OS_32,OS_S32:
begin
if not (reg in [R_EAX..R_EDI]) then
internalerror(2001092313);
result := S_L;
end;
OS_8,OS_S8:
begin
reg := makereg8(reg);
result := S_B;
end;
OS_16,OS_S16:
begin
if reg in [R_AL..R_BH] then
internalerror(2001092314);
reg := makereg16(reg);
result := S_W;
end;
else
internalerror(2001092312);
end;
end;
{ ************* concatcopy ************ }
procedure tcg386.g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean);
{ temp implementation, until it's permanenty moved here from cga.pas }
var
oldlist: taasmoutput;
begin
if list <> exprasmlist then
begin
oldlist := exprasmlist;
exprasmlist := list;
end;
cga.concatcopy(source,dest,len,delsource,loadref);
if list <> exprasmlist then
list := oldlist;
end;
{***************** This is private property, keep out! :) *****************}
procedure tcg386.sizes2load(s1: tcgsize; s2: topsize; var op: tasmop; var s3: topsize);
begin
case s2 of
S_B:
if S1 in [OS_8,OS_S8] then
s3 := S_B
else internalerror(200109221);
S_W:
case s1 of
OS_8,OS_S8:
s3 := S_BW;
OS_16,OS_S16:
s3 := S_W;
else internalerror(200109222);
end;
S_L:
case s1 of
OS_8,OS_S8:
s3 := S_BL;
OS_16,OS_S16:
s3 := S_WL;
OS_32,OS_S32:
s3 := S_L;
else internalerror(200109223);
end;
else internalerror(200109227);
end;
if s3 in [S_B,S_W,S_L] then
op := A_MOV
else if s1 in [OS_8,OS_16,OS_32] then
op := A_MOVZX
else
op := A_MOVSX;
end;
begin
cg := tcg386.create;
end.
{
$Log$
Revision 1.4 2001-10-04 14:33:28 jonas
* fixed range check errors
Revision 1.3 2001/09/30 16:17:18 jonas
* made most constant and mem handling processor independent
Revision 1.2 2001/09/29 21:32:19 jonas
* fixed bug in a_load_reg_reg + implemented a_call
Revision 1.1 2001/09/28 20:39:33 jonas
* changed all flow control structures (except for exception handling
related things) to processor independent code (in new ncgflw unit)
+ generic cgobj unit which contains lots of code generator helpers with
global "cg" class instance variable
+ cgcpu unit for i386 (implements processor specific routines of the above
unit)
* updated cgbase and cpubase for the new code generator units
* include ncgflw unit in cpunode unit
}
Reference in New Issue View Git Blame Copy Permalink