paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-15 20:09:20 +02:00
Code Issues Packages Projects Releases Wiki Activity

* changed all flow control structures (except for exception handling

Browse Source 
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
This commit is contained in:
Jonas Maebe 2001-09-28 20:39:32 +00:00
parent 8e70f9aaf8
commit b374bec6fb
7 changed files with 1882 additions and 337 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

89
compiler/cgbase.pas
View File

@ -37,6 +37,15 @@ unit cgbase;
aasm,cpubase aasm,cpubase
; ;
type
TOpCg = (OP_ADD,OP_AND,OP_DIV,OP_IDIV,OP_IMUL,OP_MUL,OP_NEG,OP_NOT,
OP_OR,OP_SAR,OP_SHL,OP_SHR,OP_SUB,OP_XOR);
TOpCmp = (OC_NONE,OC_EQ,OC_GT,OC_LT,OC_GTE,OC_LTE,OC_NE,OC_BE,OC_B,
OC_AE,OC_A);
TCgSize = (OS_NO,OS_8,OS_16,OS_32,OS_64,OS_S8,OS_S16,OS_S32,OS_S64);
const const
pi_uses_asm = $1; { set, if the procedure uses asm } pi_uses_asm = $1; { set, if the procedure uses asm }
pi_is_global = $2; { set, if the procedure is exported by an unit } pi_is_global = $2; { set, if the procedure is exported by an unit }
@ -49,6 +58,26 @@ unit cgbase;
=> don't optimize} => don't optimize}
pi_needs_implicit_finally = $80; { set, if the procedure contains data which } pi_needs_implicit_finally = $80; { set, if the procedure contains data which }
{ needs to be finalized } { needs to be finalized }
{ defines the default address size for a processor }
{ and defines the natural int size for a processor }
{$ifdef i386}
OS_ADDR = OS_32;
OS_INT = OS_32;
{$endif i386}
{$ifdef alpha}
OS_ADDR = OS_64;
OS_INT = OS_64;
{$endif alpha}
{$ifdef powerpc}
OS_ADDR = OS_32;
OS_INT = OS_32;
{$endif powercc}
{$ifdef ia64}
OS_ADDR = OS_64;
OS_INT = OS_64;
{$endif ia64}
type type
pprocinfo = ^tprocinfo; pprocinfo = ^tprocinfo;
tprocinfo = object tprocinfo = object
@ -154,11 +183,22 @@ unit cgbase;
procedure codegen_newmodule; procedure codegen_newmodule;
procedure codegen_newprocedure; procedure codegen_newprocedure;
function def_cgsize(const p1: tdef): tcgsize;
{ return the inverse condition of opcmp }
function inverse_opcmp(opcmp: topcmp): topcmp;
{ return whether op is commutative }
function commutativeop(op: topcg): boolean;
implementation implementation
uses uses
systems, systems,
cresstr cresstr,
types
{$ifdef fixLeaksOnError} {$ifdef fixLeaksOnError}
,comphook ,comphook
{$endif fixLeaksOnError} {$endif fixLeaksOnError}
@ -402,6 +442,41 @@ implementation
ResourceStrings.free; ResourceStrings.free;
end; end;
function def_cgsize(const p1: tdef): tcgsize;
begin
case p1.size of
1: result := OS_8;
2: result := OS_16;
4: result := OS_32;
else
internalerror(2001092311);
end;
if is_signed(p1) then
result := tcgsize(ord(result)+(ord(OS_S8)-ord(OS_8)));
end;
function inverse_opcmp(opcmp: topcmp): topcmp;
const
list: array[TOpCmp] of TOpCmp =
(OC_NONE,OC_NE,OC_LTE,OC_GTE,OC_LT,OC_GT,OC_EQ,OC_A,OC_AE,
OC_B,OC_BE);
begin
inverse_opcmp := list[opcmp];
end;
function commutativeop(op: topcg): boolean;
const
list: array[topcg] of boolean =
(true,true,false,false,true,true,false,false,
true,false,false,false,false,true);
begin
commutativeop := list[op];
end;
{$ifdef fixLeaksOnError} {$ifdef fixLeaksOnError}
procedure hcodegen_do_stop; procedure hcodegen_do_stop;
var p: pprocinfo; var p: pprocinfo;
@ -425,7 +500,17 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.1 2001-08-26 13:36:36 florian Revision 1.2 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
Revision 1.1 2001/08/26 13:36:36 florian
* some cg reorganisation * some cg reorganisation
* some PPC updates * some PPC updates

775
compiler/cgobj.pas
View File

File diff suppressed because it is too large Load Diff

683
compiler/i386/cgcpu.pas Normal file
View File

@ -0,0 +1,683 @@
{
$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;
{ 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);
begin
runerror(211);
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
{ how can we create asmsymbols which contain a name and an offset? }
{ (JM) }
runerror(211);
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
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,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(reg1),op,s);
if (reg1 = 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,S_L,255,makereg32(reg1)));
exit;
end;
OS_16:
begin
list.concat(taicpu.op_const_reg(A_AND,S_L,65535,reg2));
exit;
end;
end;
list.concat(taicpu.op_reg_reg(op,s,reg1,reg2));
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,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.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
}

15
compiler/i386/cpubase.pas
View File

@ -528,14 +528,13 @@ const
frame_pointer = R_EBP; frame_pointer = R_EBP;
self_pointer = R_ESI; self_pointer = R_ESI;
accumulator = R_EAX; accumulator = R_EAX;
accumulatorhigh = R_EDX;
{ the register where the vmt offset is passed to the destructor } { the register where the vmt offset is passed to the destructor }
{ helper routine } { helper routine }
vmt_offset_reg = R_EDI; vmt_offset_reg = R_EDI;
scratch_regs : array[1..1] of tregister = (R_EDI); scratch_regs : array[1..1] of tregister = (R_EDI);
max_scratch_regs = 1;
{ low and high of the available maximum width integer general purpose } { low and high of the available maximum width integer general purpose }
{ registers } { registers }
LoGPReg = R_EAX; LoGPReg = R_EAX;
@ -926,7 +925,17 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.5 2001-05-18 23:01:13 peter Revision 1.6 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
Revision 1.5 2001/05/18 23:01:13 peter
* portable constants * portable constants
Revision 1.4 2001/04/13 01:22:18 peter Revision 1.4 2001/04/13 01:22:18 peter

14
compiler/i386/cpunode.pas
View File

@ -29,7 +29,7 @@ unit cpunode;
implementation implementation
uses uses
ncgbas, ncgbas,ncgflw,
n386ld,n386add,n386cal,n386con,n386flw,n386mat,n386mem, n386ld,n386add,n386cal,n386con,n386flw,n386mat,n386mem,
n386set,n386inl,n386opt, n386set,n386inl,n386opt,
{ this not really a node } { this not really a node }
@ -38,7 +38,17 @@ unit cpunode;
end. end.
{ {
$Log$ $Log$
Revision 1.4 2001-05-18 22:31:06 peter Revision 1.5 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
Revision 1.4 2001/05/18 22:31:06 peter
* tasmnode.pass_2 is independent of cpu, moved to ncgbas * tasmnode.pass_2 is independent of cpu, moved to ncgbas
* include ncgbas for independent nodes * include ncgbas for independent nodes

22
compiler/i386/n386flw.pas
View File

@ -30,6 +30,7 @@ interface
node,nflw; node,nflw;
type type
(*
ti386whilerepeatnode = class(twhilerepeatnode) ti386whilerepeatnode = class(twhilerepeatnode)
procedure pass_2;override; procedure pass_2;override;
end; end;
@ -61,6 +62,7 @@ interface
ti386labelnode = class(tlabelnode) ti386labelnode = class(tlabelnode)
procedure pass_2;override; procedure pass_2;override;
end; end;
*)
ti386raisenode = class(traisenode) ti386raisenode = class(traisenode)
procedure pass_2;override; procedure pass_2;override;
@ -92,6 +94,10 @@ implementation
pass_1,nld,ncon, pass_1,nld,ncon,
cga,tgcpu,n386util,regvars; cga,tgcpu,n386util,regvars;
(*
all implemented in ncgflw now (JM)
{***************************************************************************** {*****************************************************************************
Second_While_RepeatN Second_While_RepeatN
*****************************************************************************} *****************************************************************************}
@ -655,6 +661,8 @@ do_jmp:
secondpass(left); secondpass(left);
end; end;
*)
{***************************************************************************** {*****************************************************************************
SecondRaise SecondRaise
@ -1324,6 +1332,7 @@ do_jmp:
begin begin
(*
cwhilerepeatnode:=ti386whilerepeatnode; cwhilerepeatnode:=ti386whilerepeatnode;
cifnode:=ti386ifnode; cifnode:=ti386ifnode;
cfornode:=ti386fornode; cfornode:=ti386fornode;
@ -1332,6 +1341,7 @@ begin
ccontinuenode:=ti386continuenode; ccontinuenode:=ti386continuenode;
cgotonode:=ti386gotonode; cgotonode:=ti386gotonode;
clabelnode:=ti386labelnode; clabelnode:=ti386labelnode;
*)
craisenode:=ti386raisenode; craisenode:=ti386raisenode;
ctryexceptnode:=ti386tryexceptnode; ctryexceptnode:=ti386tryexceptnode;
ctryfinallynode:=ti386tryfinallynode; ctryfinallynode:=ti386tryfinallynode;
@ -1340,7 +1350,17 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.15 2001-08-26 13:36:58 florian Revision 1.16 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
Revision 1.15 2001/08/26 13:36:58 florian
* some cg reorganisation * some cg reorganisation
* some PPC updates * some PPC updates

613
compiler/ncgflw.pas Normal file
View File

@ -0,0 +1,613 @@
{
$Id$
Copyright (c) 1998-2000 by Florian Klaempfl
Generate assembler for nodes that influence the flow which are
the same for all (most?) processors
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 ncgflw;
{$i defines.inc}
interface
uses
node,nflw;
type
tcgwhilerepeatnode = class(twhilerepeatnode)
procedure pass_2;override;
end;
tcgifnode = class(tifnode)
procedure pass_2;override;
end;
tcgfornode = class(tfornode)
procedure pass_2;override;
end;
tcgexitnode = class(texitnode)
procedure pass_2;override;
end;
tcgbreaknode = class(tbreaknode)
procedure pass_2;override;
end;
tcgcontinuenode = class(tcontinuenode)
procedure pass_2;override;
end;
tcggotonode = class(tgotonode)
procedure pass_2;override;
end;
tcglabelnode = class(tlabelnode)
procedure pass_2;override;
end;
implementation
uses
verbose,globtype,globals,systems,
symconst,symdef,symsym,aasm,types,
cgbase,temp_gen,pass_2,
cpubase,cpuasm,
pass_1,nld,ncon,
cga,tgcpu,
{$ifdef i386}
n386util,
{$endif}
regvars,cgobj,cgcpu;
{*****************************************************************************
Second_While_RepeatN
*****************************************************************************}
procedure tcgwhilerepeatnode.pass_2;
var
lcont,lbreak,lloop,
oldclabel,oldblabel : tasmlabel;
otlabel,oflabel : tasmlabel;
begin
getlabel(lloop);
getlabel(lcont);
getlabel(lbreak);
{ arrange continue and breaklabels: }
oldclabel:=aktcontinuelabel;
oldblabel:=aktbreaklabel;
load_all_regvars(exprasmlist);
{ handling code at the end as it is much more efficient, and makes
while equal to repeat loop, only the end true/false is swapped (PFV) }
if nodetype=whilen then
cg.a_jmp_cond(exprasmlist,OC_None,lcont);
{ align loop target }
exprasmList.concat(Tai_align.Create(aktalignment.loopalign));
cg.a_label(exprasmlist,lloop);
aktcontinuelabel:=lcont;
aktbreaklabel:=lbreak;
cleartempgen;
if assigned(right) then
secondpass(right);
load_all_regvars(exprasmlist);
cg.a_label(exprasmlist,lcont);
otlabel:=truelabel;
oflabel:=falselabel;
if nodetype=whilen then
begin
truelabel:=lloop;
falselabel:=lbreak;
end
{ repeatn }
else
begin
truelabel:=lbreak;
falselabel:=lloop;
end;
cleartempgen;
secondpass(left);
load_all_regvars(exprasmlist);
maketojumpbool(left);
cg.a_label(exprasmlist,lbreak);
truelabel:=otlabel;
falselabel:=oflabel;
aktcontinuelabel:=oldclabel;
aktbreaklabel:=oldblabel;
{ a break/continue in a while/repeat block can't be seen outside }
flowcontrol:=flowcontrol-[fc_break,fc_continue];
end;
{*****************************************************************************
tcgIFNODE
*****************************************************************************}
procedure tcgifnode.pass_2;
var
hl,otlabel,oflabel : tasmlabel;
begin
otlabel:=truelabel;
oflabel:=falselabel;
getlabel(truelabel);
getlabel(falselabel);
cleartempgen;
secondpass(left);
load_all_regvars(exprasmlist);
maketojumpbool(left);
if assigned(right) then
begin
cg.a_label(exprasmlist,truelabel);
cleartempgen;
secondpass(right);
{ automatically done for blocks, but not for statements (JM) }
load_all_regvars(exprasmlist);
end;
if assigned(t1) then
begin
if assigned(right) then
begin
getlabel(hl);
{ do go back to if line !! }
aktfilepos:=exprasmList.getlasttaifilepos^;
cg.a_jmp_cond(exprasmlist,OC_None,hl);
end;
cg.a_label(exprasmlist,falselabel);
cleartempgen;
secondpass(t1);
load_all_regvars(exprasmlist);
if assigned(right) then
cg.a_label(exprasmlist,hl);
end
else
begin
cg.a_label(exprasmlist,falselabel);
end;
if not(assigned(right)) then
begin
cg.a_label(exprasmlist,truelabel);
end;
truelabel:=otlabel;
falselabel:=oflabel;
end;
{*****************************************************************************
SecondFor
*****************************************************************************}
procedure tcgfornode.pass_2;
var
l3,oldclabel,oldblabel : tasmlabel;
omitfirstcomp,temptovalue : boolean;
hs : byte;
temp1 : treference;
hop : topcg;
hcond : topcmp;
opsize : tcgsize;
count_var_is_signed : boolean;
begin
oldclabel:=aktcontinuelabel;
oldblabel:=aktbreaklabel;
getlabel(aktcontinuelabel);
getlabel(aktbreaklabel);
getlabel(l3);
{ could we spare the first comparison ? }
omitfirstcomp:=false;
if right.nodetype=ordconstn then
if tassignmentnode(left).right.nodetype=ordconstn then
omitfirstcomp:=((nf_backward in flags) and
(tordconstnode(tassignmentnode(left).right).value>=tordconstnode(right).value))
or (not(nf_backward in flags) and
(tordconstnode(tassignmentnode(left).right).value<=tordconstnode(right).value));
{ only calculate reference }
cleartempgen;
secondpass(t2);
hs := t2.resulttype.def.size;
opsize := def_cgsize(t2.resulttype.def);
{ first set the to value
because the count var can be in the expression !! }
cleartempgen;
secondpass(right);
{ calculate pointer value and check if changeable and if so }
{ load into temporary variable }
if right.nodetype<>ordconstn then
begin
temp1.symbol:=nil;
gettempofsizereference(hs,temp1);
temptovalue:=true;
if (right.location.loc=LOC_REGISTER) or
(right.location.loc=LOC_CREGISTER) then
begin
cg.a_load_reg_ref(exprasmlist,opsize,
right.location.register,temp1);
ungetregister(right.location.register);
end
else
cg.g_concatcopy(exprasmlist,right.location.reference,temp1,
hs,true,false);
end
else
temptovalue:=false;
{ produce start assignment }
cleartempgen;
secondpass(left);
count_var_is_signed:=is_signed(torddef(t2.resulttype.def));
if nf_backward in flags then
if count_var_is_signed then
hcond:=OC_LT
else
hcond:=OC_B
else
if count_var_is_signed then
hcond:=OC_GT
else
hcond:=OC_A;
load_all_regvars(exprasmlist);
if temptovalue then
begin
cg.a_cmp_ref_loc_label(exprasmlist,opsize,hcond,
temp1,t2.location,aktbreaklabel);
end
else
begin
if not(omitfirstcomp) then
begin
cg.a_cmp_const_loc_label(exprasmlist,opsize,hcond,
tordconstnode(right).value,t2.location,aktbreaklabel);
end;
end;
{ align loop target }
exprasmList.concat(Tai_align.Create(aktalignment.loopalign));
cg.a_label(exprasmlist,l3);
{ help register must not be in instruction block }
cleartempgen;
if assigned(t1) then
begin
secondpass(t1);
load_all_regvars(exprasmlist);
end;
cg.a_label(exprasmlist,aktcontinuelabel);
{ makes no problems there }
cleartempgen;
if nf_backward in flags then
if count_var_is_signed then
hcond:=OC_LTE
else
hcond:=OC_BE
else
if count_var_is_signed then
hcond:=OC_GTE
else
hcond:=OC_AE;
load_all_regvars(exprasmlist);
{ produce comparison and the corresponding }
{ jump }
if temptovalue then
begin
cg.a_cmp_ref_loc_label(exprasmlist,opsize,hcond,temp1,
t2.location,aktbreaklabel);
end
else
begin
cg.a_cmp_const_loc_label(exprasmlist,opsize,hcond,
tordconstnode(right).value,t2.location,aktbreaklabel);
end;
{ according to count direction DEC or INC... }
{ must be after the test because of 0 to 255 for bytes !! }
if nf_backward in flags then
hop:=OP_SUB
else
hop:=OP_ADD;
cg.a_op_const_loc(exprasmlist,hop,opsize,1,t2.location);
cg.a_jmp_cond(exprasmlist,OC_None,l3);
if temptovalue then
ungetiftemp(temp1);
{ this is the break label: }
cg.a_label(exprasmlist,aktbreaklabel);
aktcontinuelabel:=oldclabel;
aktbreaklabel:=oldblabel;
{ a break/continue in a for block can't be seen outside }
flowcontrol:=flowcontrol-[fc_break,fc_continue];
end;
{*****************************************************************************
SecondExitN
*****************************************************************************}
procedure tcgexitnode.pass_2;
var
{op : tasmop;
s : topsize;}
otlabel,oflabel : tasmlabel;
r : treference;
is_mem,
allocated_acc,
allocated_acchigh: boolean;
procedure cleanleft;
begin
if is_mem then
begin
del_reference(left.location.reference);
ungetiftemp(left.location.reference);
end
else
begin
ungetregister(left.location.register);
if left.location.registerhigh <> R_NO then
ungetregister(left.location.registerhigh);
end;
end;
label
do_jmp;
begin
load_all_regvars(exprasmlist);
include(flowcontrol,fc_exit);
if assigned(left) then
if left.nodetype=assignn then
begin
{ just do a normal assignment followed by exit }
secondpass(left);
cg.a_jmp_cond(exprasmlist,OC_NONE,aktexitlabel);
end
else
begin
allocated_acc := false;
allocated_acchigh := false;
otlabel:=truelabel;
oflabel:=falselabel;
getlabel(truelabel);
getlabel(falselabel);
secondpass(left);
case left.location.loc of
LOC_FPU : goto do_jmp;
LOC_MEM,
LOC_REFERENCE : is_mem:=true;
LOC_CREGISTER,
LOC_REGISTER : is_mem:=false;
LOC_FLAGS : begin
cg.a_reg_alloc(exprasmlist,accumulator);
allocated_acc := true;
cg.g_flags2reg(exprasmlist,left.location.resflags,accumulator);
goto do_jmp;
end;
LOC_JUMP : begin
exprasmlist.concat(tairegalloc.alloc(accumulator));
allocated_acc := true;
cg.a_label(exprasmlist,truelabel);
cg.a_load_const_reg(exprasmlist,OS_8,1,
makereg8(accumulator));
cg.a_jmp_cond(exprasmlist,OC_NONE,aktexit2label);
cg.a_label(exprasmlist,falselabel);
cg.a_load_const_reg(exprasmlist,OS_8,0,
makereg8(accumulator));
goto do_jmp;
end;
else
internalerror(2001);
end;
case aktprocsym.definition.rettype.def.deftype of
pointerdef,
procvardef : begin
cleanleft;
cg.a_reg_alloc(exprasmlist,accumulator);
allocated_acc := true;
if is_mem then
cg.a_load_ref_reg(exprasmlist,OS_ADDR,
left.location.reference,accumulator)
else
cg.a_load_reg_reg(exprasmlist,OS_ADDR,
left.location.register,accumulator);
end;
floatdef : begin
cleanleft;
if is_mem then
floatload(tfloatdef(aktprocsym.definition.rettype.def).typ,left.location.reference);
end;
{ orddef,
enumdef : }
else
{ it can be anything shorter than 4 bytes PM
this caused form bug 711 }
begin
cleanleft;
cg.a_reg_alloc(exprasmlist,accumulator);
allocated_acc := true;
case aktprocsym.definition.rettype.def.size of
{ it can be a qword/int64 too ... }
8 :
if is_mem then
begin
cg.a_load_ref_reg(exprasmlist,OS_32,
left.location.reference,accumulator);
r:=left.location.reference;
inc(r.offset,4);
cg.a_reg_alloc(exprasmlist,accumulatorhigh);
allocated_acchigh := true;
cg.a_load_ref_reg(exprasmlist,OS_32,r,accumulatorhigh);
end
else
begin
cg.a_load_reg_reg(exprasmlist,OS_32,left.location.registerlow,accumulator);
cg.a_reg_alloc(exprasmlist,accumulatorhigh);
allocated_acchigh := true;
cg.a_load_reg_reg(exprasmlist,OS_32,left.location.registerhigh,accumulatorhigh);
end;
{ if its 3 bytes only we can still
copy one of garbage ! PM }
4,3 :
cg.a_load_loc_reg(exprasmlist,OS_32,left.location,
accumulator);
2 :
cg.a_load_loc_reg(exprasmlist,OS_16,left.location,
makereg16(accumulator));
1 :
cg.a_load_loc_reg(exprasmlist,OS_8,left.location,
makereg8(accumulator));
else internalerror(605001);
end;
end;
end;
do_jmp:
truelabel:=otlabel;
falselabel:=oflabel;
cg.a_jmp_cond(exprasmlist,OC_None,aktexit2label);
if allocated_acc then
cg.a_reg_dealloc(exprasmlist,accumulator);
if allocated_acchigh then
cg.a_reg_dealloc(exprasmlist,accumulator);
end
else
cg.a_jmp_cond(exprasmlist,OC_None,aktexitlabel);
end;
{*****************************************************************************
SecondBreakN
*****************************************************************************}
procedure tcgbreaknode.pass_2;
begin
include(flowcontrol,fc_break);
if aktbreaklabel<>nil then
begin
load_all_regvars(exprasmlist);
cg.a_jmp_cond(exprasmlist,OC_None,aktbreaklabel)
end
else
CGMessage(cg_e_break_not_allowed);
end;
{*****************************************************************************
SecondContinueN
*****************************************************************************}
procedure tcgcontinuenode.pass_2;
begin
include(flowcontrol,fc_continue);
if aktcontinuelabel<>nil then
begin
load_all_regvars(exprasmlist);
cg.a_jmp_cond(exprasmlist,OC_None,aktcontinuelabel)
end
else
CGMessage(cg_e_continue_not_allowed);
end;
{*****************************************************************************
SecondGoto
*****************************************************************************}
procedure tcggotonode.pass_2;
begin
load_all_regvars(exprasmlist);
cg.a_jmp_cond(exprasmlist,OC_None,labelnr)
end;
{*****************************************************************************
SecondLabel
*****************************************************************************}
procedure tcglabelnode.pass_2;
begin
load_all_regvars(exprasmlist);
cg.a_label(exprasmlist,labelnr);
cleartempgen;
secondpass(left);
end;
begin
cwhilerepeatnode:=tcgwhilerepeatnode;
cifnode:=tcgifnode;
cfornode:=tcgfornode;
cexitnode:=tcgexitnode;
cbreaknode:=tcgbreaknode;
ccontinuenode:=tcgcontinuenode;
cgotonode:=tcggotonode;
clabelnode:=tcglabelnode;
end.
{
$Log$
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
Revision 1.4 2001/09/09 17:10:25 jonas
* some more things implemented
Revision 1.3 2001/09/06 15:25:55 jonas
* changed type of tcg from object to class -> abstract methods are now
a lot cleaner :)
+ more updates: load_*_loc methods, op_*_* methods, g_flags2reg method
(if possible with geenric implementation and necessary ppc
implementations)
* worked a bit further on cgflw, now working on exitnode
Revision 1.2 2001/09/05 20:21:03 jonas
* new cgflow based on n386flw with all nodes until forn "translated"
+ a_cmp_*_loc_label methods for tcg
+ base implementatino for a_cmp_ref_*_label methods
* small bugfixes to powerpc cg
}