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

* changed type of tcg from object to class -> abstract methods are now

Browse Source 
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
This commit is contained in:
Jonas Maebe 2001-09-06 15:25:55 +00:00
parent ca27b25d5e
commit bea3bf8717
5 changed files with 515 additions and 580 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

97
compiler/new/cgbase.pas
View File

@ -53,83 +53,46 @@ unit cgbase;
OS_INT = OS_64; OS_INT = OS_64;
{$endif ia64} {$endif ia64}
function inverse_opcmp(opcmp: topcmp): topcmp;
function commutativeop(op: topcg): boolean;
implementation implementation
function inverse_opcmp(opcmp: topcmp): topcmp;
const
list: array[TOpCg] of TOpCmp =
(OC_NONE,OC_NE,OC_LE,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;
end. end.
{ {
$Log$ $Log$
Revision 1.2 2000-11-29 00:30:51 florian 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 2000/11/29 00:30:51 florian
* unused units removed from uses clause * unused units removed from uses clause
* some changes for widestrings * some changes for widestrings
Revision 1.1 2000/07/13 06:30:07 michael Revision 1.1 2000/07/13 06:30:07 michael
+ Initial import + Initial import
Revision 1.19 2000/03/11 21:11:24 daniel
* Ported hcgdata to new symtable.
* Alignment code changed as suggested by Peter
+ Usage of my is operator replacement, is_object
Revision 1.18 2000/02/28 17:23:58 daniel
* Current work of symtable integration committed. The symtable can be
activated by defining 'newst', but doesn't compile yet. Changes in type
checking and oop are completed. What is left is to write a new
symtablestack and adapt the parser to use it.
Revision 1.17 2000/02/20 20:49:46 florian
* newcg is compiling
* fixed the dup id problem reported by Paul Y.
Revision 1.16 2000/02/17 14:48:36 florian
* updated to use old firstpass
Revision 1.15 2000/01/07 01:14:52 peter
* updated copyright to 2000
Revision 1.14 1999/12/24 22:47:42 jonas
* added OC_NONE to the compare forms (to allow unconditional jumps)
Revision 1.13 1999/12/01 12:42:33 peter
* fixed bug 698
* removed some notes about unused vars
Revision 1.12 1999/11/05 13:15:00 florian
* some fixes to get the new cg compiling again
Revision 1.11 1999/10/14 14:57:54 florian
- removed the hcodegen use in the new cg, use cgbase instead
Revision 1.10 1999/10/12 21:20:46 florian
* new codegenerator compiles again
Revision 1.9 1999/09/10 18:48:11 florian
* some bug fixes (e.g. must_be_valid and procinfo.funcret_is_valid)
* most things for stored properties fixed
Revision 1.8 1999/08/06 13:26:49 florian
* more changes ...
Revision 1.7 1999/08/05 14:58:10 florian
* some fixes for the floating point registers
* more things for the new code generator
Revision 1.6 1999/08/04 00:23:51 florian
* renamed i386asm and i386base to cpuasm and cpubase
Revision 1.5 1999/08/01 18:22:32 florian
* made it again compilable
Revision 1.4 1999/01/23 23:29:45 florian
* first running version of the new code generator
* when compiling exceptions under Linux fixed
Revision 1.3 1999/01/06 22:58:48 florian
+ some stuff for the new code generator
Revision 1.2 1998/12/26 15:20:28 florian
+ more changes for the new version
Revision 1.1 1998/12/15 22:18:55 florian
* some code added
} }

56
compiler/new/cgflw.pas
View File

@ -270,7 +270,7 @@ implementation
right.location.register,newreference(temp1)); right.location.register,newreference(temp1));
end end
else else
cgcpu.concatcopy(exprasmlist,right.location.reference,temp1, cgcpu.g_concatcopy(exprasmlist,right.location.reference,temp1,
hs,false,false); hs,false,false);
end end
else else
@ -385,8 +385,8 @@ implementation
otlabel,oflabel : tasmlabel; otlabel,oflabel : tasmlabel;
r : preference; r : preference;
is_mem, is_mem,
allocated_eax, allocated_acc,
allocated_edx: boolean; allocated_acchigh: boolean;
procedure cleanleft; procedure cleanleft;
begin begin
@ -413,12 +413,12 @@ implementation
begin begin
{ just do a normal assignment followed by exit } { just do a normal assignment followed by exit }
secondpass(left); secondpass(left);
emitjmp(C_None,aktexitlabel); cgcpu.a_jmp_cond(exprasmlist,C_None,aktexitlabel);
end end
else else
begin begin
allocated_eax := false; allocated_acc := false;
allocated_edx := false; allocated_acchigh := false;
otlabel:=truelabel; otlabel:=truelabel;
oflabel:=falselabel; oflabel:=falselabel;
getlabel(truelabel); getlabel(truelabel);
@ -431,19 +431,19 @@ implementation
LOC_CREGISTER, LOC_CREGISTER,
LOC_REGISTER : is_mem:=false; LOC_REGISTER : is_mem:=false;
LOC_FLAGS : begin LOC_FLAGS : begin
exprasmlist.concat(tairegalloc.alloc(R_EAX)); exprasmlist.concat(tairegalloc.alloc(accumulator));
allocated_eax := true; allocated_acc := true;
emit_flag2reg(left.location.resflags,R_AL); cgcpu.g_flag2reg(left.location.resflags,accumulator);
goto do_jmp; goto do_jmp;
end; end;
LOC_JUMP : begin LOC_JUMP : begin
exprasmlist.concat(tairegalloc.alloc(R_EAX)); exprasmlist.concat(tairegalloc.alloc(accumulator));
allocated_eax := true; allocated_acc := true;
emitlab(truelabel); cgcpu.a_label(exprasmlist,truelabel);
emit_const_reg(A_MOV,S_B,1,R_AL); cgcpu.a_load_const_reg(exprasmlist,OS_8,1,acc);
emitjmp(C_None,aktexit2label); cgcpu.a_jmp_cond(exprasmlist,C_None,aktexit2label);
emitlab(falselabel); cgcpu.a_label(exprasmlist,falselabel);
emit_reg_reg(A_XOR,S_B,R_AL,R_AL); cgcpu.a_load_const_reg(exprasmlist,OS_8,0,acc);
goto do_jmp; goto do_jmp;
end; end;
else else
@ -453,14 +453,14 @@ implementation
pointerdef, pointerdef,
procvardef : begin procvardef : begin
cleanleft; cleanleft;
exprasmlist.concat(tairegalloc.alloc(R_EAX)); exprasmlist.concat(tairegalloc.alloc(accumulator));
allocated_eax := true; allocated_acc := true;
if is_mem then if is_mem then
emit_ref_reg(A_MOV,S_L, cgcpu.a_load_ref_reg(exprasmlist,OS_ADDR,
newreference(left.location.reference),R_EAX) left.location.reference,accumulator)
else else
emit_reg_reg(A_MOV,S_L, gcpu.a_load_reg_reg(exprasmlist,A_MOV,OS_ADDR,
left.location.register,R_EAX); left.location.register,accumulator);
end; end;
floatdef : begin floatdef : begin
cleanleft; cleanleft;
@ -1273,9 +1273,17 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.2 2001-09-05 20:21:03 jonas 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" * new cgflow based on n386flw with all nodes until forn "translated"
+ a_cmp_loc_*_label methods for tcg + a_cmp_*_loc_label methods for tcg
+ base implementatino for a_cmp_ref_*_label methods + base implementatino for a_cmp_ref_*_label methods
* small bugfixes to powerpc cg * small bugfixes to powerpc cg

561
compiler/new/cgobj.pas
View File

@ -32,28 +32,26 @@ unit cgobj;
type type
talignment = (AM_NATURAL,AM_NONE,AM_2BYTE,AM_4BYTE,AM_8BYTE); talignment = (AM_NATURAL,AM_NONE,AM_2BYTE,AM_4BYTE,AM_8BYTE);
pcg = ^tcg; tcg = class
tcg = object
scratch_register_array_pointer : aword; scratch_register_array_pointer : aword;
unusedscratchregisters : tregisterset; unusedscratchregisters : tregisterset;
alignment : talignment; alignment : talignment;
{************************************************} {************************************************}
{ basic routines } { basic routines }
constructor init; constructor create;
destructor done;virtual;
procedure a_label(list : paasmoutput;l : pasmlabel);virtual; procedure a_label(list : taasmoutput;l : pasmlabel);virtual;
{ allocates register r by inserting a pai_realloc record } { allocates register r by inserting a pai_realloc record }
procedure a_reg_alloc(list : paasmoutput;r : tregister); procedure a_reg_alloc(list : taasmoutput;r : tregister);
{ deallocates register r by inserting a pa_regdealloc record} { deallocates register r by inserting a pa_regdealloc record}
procedure a_reg_dealloc(list : paasmoutput;r : tregister); procedure a_reg_dealloc(list : taasmoutput;r : tregister);
{ returns a register for use as scratch register } { returns a register for use as scratch register }
function get_scratch_reg(list : paasmoutput) : tregister; function get_scratch_reg(list : taasmoutput) : tregister;
{ releases a scratch register } { releases a scratch register }
procedure free_scratch_reg(list : paasmoutput;r : tregister); procedure free_scratch_reg(list : taasmoutput;r : tregister);
{************************************************} {************************************************}
{ code generation for subroutine entry/exit code } { code generation for subroutine entry/exit code }
@ -61,42 +59,42 @@ unit cgobj;
{ initilizes data of type t } { initilizes data of type t }
{ if is_already_ref is true then the routines assumes } { if is_already_ref is true then the routines assumes }
{ that r points to the data to initialize } { that r points to the data to initialize }
procedure g_initialize(list : paasmoutput;t : pdef;const ref : treference;is_already_ref : boolean); procedure g_initialize(list : taasmoutput;t : pdef;const ref : treference;is_already_ref : boolean);
{ finalizes data of type t } { finalizes data of type t }
{ if is_already_ref is true then the routines assumes } { if is_already_ref is true then the routines assumes }
{ that r points to the data to finalizes } { that r points to the data to finalizes }
procedure g_finalize(list : paasmoutput;t : pdef;const ref : treference;is_already_ref : boolean); procedure g_finalize(list : taasmoutput;t : pdef;const ref : treference;is_already_ref : boolean);
{ helper routines } { helper routines }
procedure g_initialize_data(list : paasmoutput;p : psym); procedure g_initialize_data(list : taasmoutput;p : psym);
procedure g_incr_data(list : paasmoutput;p : psym); procedure g_incr_data(list : taasmoutput;p : psym);
procedure g_finalize_data(list : paasmoutput;p : pnamedindexobject); procedure g_finalize_data(list : taasmoutput;p : pnamedindexobject);
procedure g_copyvalueparas(list : paasmoutput;p : pnamedindexobject); procedure g_copyvalueparas(list : taasmoutput;p : pnamedindexobject);
procedure g_finalizetempansistrings(list : paasmoutput); procedure g_finalizetempansistrings(list : taasmoutput);
procedure g_entrycode(list : paasmoutput; procedure g_entrycode(list : taasmoutput;
const proc_names : tstringcontainer;make_global : boolean; const proc_names : tstringcontainer;make_global : boolean;
stackframe : longint;var parasize : longint; stackframe : longint;var parasize : longint;
var nostackframe : boolean;inlined : boolean); var nostackframe : boolean;inlined : boolean);
procedure g_exitcode(list : paasmoutput;parasize : longint; procedure g_exitcode(list : taasmoutput;parasize : longint;
nostackframe,inlined : boolean); nostackframe,inlined : boolean);
{ string helper routines } { string helper routines }
procedure g_decrstrref(list : paasmoutput;const ref : treference;t : pdef); procedure g_decrstrref(list : taasmoutput;const ref : treference;t : pdef);
procedure g_removetemps(list : paasmoutput;p : plinkedlist); procedure g_removetemps(list : taasmoutput;p : plinkedlist);
{ passing parameters, per default the parameter is pushed } { passing parameters, per default the parameter is pushed }
{ nr gives the number of the parameter (enumerated from } { nr gives the number of the parameter (enumerated from }
{ left to right), this allows to move the parameter to } { left to right), this allows to move the parameter to }
{ register, if the cpu supports register calling } { register, if the cpu supports register calling }
{ conventions } { conventions }
procedure a_param_reg(list : paasmoutput;size : tcgsize;r : tregister;nr : longint);virtual; procedure a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;nr : longint);virtual; abstract;
procedure a_param_const(list : paasmoutput;size : tcgsize;a : aword;nr : longint);virtual; procedure a_param_const(list : taasmoutput;size : tcgsize;a : aword;nr : longint);virtual;
procedure a_param_ref(list : paasmoutput;size : tcgsize;const r : treference;nr : longint);virtual; procedure a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;nr : longint);virtual;
procedure a_paramaddr_ref(list : paasmoutput;const r : treference;nr : longint);virtual; procedure a_paramaddr_ref(list : taasmoutput;const r : treference;nr : longint);virtual;
{**********************************} {**********************************}
{ these methods must be overriden: } { these methods must be overriden: }
@ -118,63 +116,81 @@ unit cgobj;
second the destination second the destination
} }
procedure a_call_name(list : paasmoutput;const s : string; procedure a_call_name(list : taasmoutput;const s : string;
offset : longint);virtual; offset : longint);virtual;
{ move instructions } { move instructions }
procedure a_load_const_reg(list : paasmoutput;size : tcgsize;a : aword;register : tregister);virtual; procedure a_load_const_reg(list : taasmoutput;size : tcgsize;a : aword;register : tregister);virtual; abstract;
procedure a_load_const_ref(list : paasmoutput;size : tcgsize;a : aword;const ref : treference);virtual; procedure a_load_const_ref(list : taasmoutput;size : tcgsize;a : aword;const ref : treference);virtual;
procedure a_load_reg_ref(list : paasmoutput;size : tcgsize;register : tregister;const ref : treference);virtual; procedure a_load_reg_ref(list : taasmoutput;size : tcgsize;register : tregister;const ref : treference);virtual; abstract;
procedure a_load_ref_reg(list : paasmoutput;size : tcgsize;const ref : treference;register : tregister);virtual; procedure a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref : treference;register : tregister);virtual; abstract;
procedure a_load_reg_reg(list : paasmoutput;size : tcgsize;reg1,reg2 : tregister);virtual; procedure a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister);virtual; abstract;
{ basic arithmetic operations }
{ note: for operators which require only one argument (not, neg), use }
{ the op_reg_reg, op_reg_reg or op_reg_loc methods and keep in mind }
{ that in this case the *second* operand is used as both source and }
{ destination (JM) }
procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; reg: TRegister); virtual; abstract;
procedure a_op_const_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; const ref: TReference); virtual;
procedure a_op_const_loc(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; const loc: tloocation); virtual;
procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister); virtual; abstract;
procedure a_op_reg_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; reg: TRegister; const ref: TReference); virtual;
procedure a_op_ref_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); virtual;
procedure a_op_reg_loc(list : taasmoutput; Op: TOpCG; size: TCGSize; const ref: TReference; const loc: tloocation); virtual;
procedure a_op_ref_loc(list : taasmoutput; Op: TOpCG; size: TCGSize; const ref: TReference; const loc: tloocation); virtual;
{ comparison operations } { comparison operations }
procedure a_cmp_const_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister; procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
l : pasmlabel);virtual; l : pasmlabel);virtual; abstract;
procedure a_cmp_reg_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : pasmlabel); virtual; procedure a_cmp_const_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const ref : treference;
procedure a_cmp_reg_ref_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;reg : tregister; const ref: treference; l : pasmlabel); virtual;
procedure a_cmp_const_ref_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const ref : treference;
l : pasmlabel); virtual; l : pasmlabel); virtual;
procedure a_cmp_const_loc_label(list: paasmoutput; size: tcgsiwe;cmp_op: topcmp; const loc: tlocation; procedure a_cmp_const_loc_label(list: taasmoutput; size: tcgsiwe;cmp_op: topcmp; a: aword; const loc: tlocation;
l : pasmlabel); virtual;
procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : pasmlabel); virtual; abstract;
procedure a_cmp_reg_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg : tregister; const ref: treference; l : pasmlabel); virtual;
procedure a_cmp_ref_loc_label(list: taasmoutput; size: tcgsiwe;cmp_op: topcmp; const ref: treference; const loc: tlocation;
l : pasmlabel); virtual; l : pasmlabel); virtual;
procedure a_jmp_cond(list : paasmoutput;cond : TOpCmp;l: pasmlabel); procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: pasmlabel); abstract;
procedure a_loadaddress_ref_reg(list : paasmoutput;const ref : treference;r : tregister);virtual; procedure g_flags2reg(list: taasmoutput; const f: TAsmCond; reg: TRegister); abstract;
procedure g_stackframe_entry(list : paasmoutput;localsize : longint);virtual;
procedure a_loadaddress_ref_reg(list : taasmoutput;const ref : treference;r : tregister);virtual; abstract;
procedure g_stackframe_entry(list : taasmoutput;localsize : longint);virtual; abstract;
{ restores the frame pointer at procedure exit, for the } { restores the frame pointer at procedure exit, for the }
{ i386 it generates a simple leave } { i386 it generates a simple leave }
procedure g_restore_frame_pointer(list : paasmoutput);virtual; procedure g_restore_frame_pointer(list : taasmoutput);virtual; abstract;
{ some processors like the PPC doesn't allow to change the stack in } { some processors like the PPC doesn't allow to change the stack in }
{ a procedure, so we need to maintain an extra stack for the } { a procedure, so we need to maintain an extra stack for the }
{ result values of setjmp in exception code } { result values of setjmp in exception code }
{ this two procedures are for pushing an exception value, } { this two procedures are for pushing an exception value, }
{ they can use the scratch registers } { they can use the scratch registers }
procedure g_push_exception_value_reg(list : paasmoutput;reg : tregister);virtual; procedure g_push_exception_value_reg(list : taasmoutput;reg : tregister);virtual; abstract;
procedure g_push_exception_value_const(list : paasmoutput;reg : tregister);virtual; procedure g_push_exception_value_const(list : taasmoutput;reg : tregister);virtual; abstract;
{ that procedure pops a exception value } { that procedure pops a exception value }
procedure g_pop_exception_value_reg(list : paasmoutput;reg : tregister);virtual; procedure g_pop_exception_value_reg(list : taasmoutput;reg : tregister);virtual; abstract;
procedure g_return_from_proc(list : paasmoutput;parasize : aword);virtual; procedure g_return_from_proc(list : taasmoutput;parasize : aword);virtual; abstract;
{********************************************************} {********************************************************}
{ these methods can be overriden for extra functionality } { these methods can be overriden for extra functionality }
{ the following methods do nothing: } { the following methods do nothing: }
procedure g_interrupt_stackframe_entry(list : paasmoutput);virtual; procedure g_interrupt_stackframe_entry(list : taasmoutput);virtual;
procedure g_interrupt_stackframe_exit(list : paasmoutput);virtual; procedure g_interrupt_stackframe_exit(list : taasmoutput);virtual;
procedure g_profilecode(list : paasmoutput);virtual; procedure g_profilecode(list : taasmoutput);virtual; abstract;
procedure g_stackcheck(list : paasmoutput;stackframesize : longint);virtual; procedure g_stackcheck(list : taasmoutput;stackframesize : longint);virtual; abstract;
procedure g_maybe_loadself(list : paasmoutput);virtual; procedure g_maybe_loadself(list : taasmoutput);virtual; abstract;
{ copies len bytes from the source to destination, if } { copies len bytes from the source to destination, if }
{ loadref is true, it assumes that it first must load } { loadref is true, it assumes that it first must load }
{ the source address from the memory location where } { the source address from the memory location where }
{ source points to } { source points to }
procedure g_concatcopy(list : paasmoutput;const source,dest : treference;len : aword;loadref : boolean);virtual; procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword;loadref : boolean);virtual; abstract;
{ uses the addr of ref as param, was emitpushreferenceaddr } { uses the addr of ref as param, was emitpushreferenceaddr }
procedure a_param_ref_addr(list : paasmoutput;r : treference;nr : longint);virtual; procedure a_param_ref_addr(list : taasmoutput;r : treference;nr : longint);virtual; abstract;
end; end;
var var
@ -193,7 +209,7 @@ unit cgobj;
basic functionallity basic functionallity
******************************************************************************} ******************************************************************************}
constructor tcg.init; constructor tcg.create;
var var
i : longint; i : longint;
@ -204,30 +220,25 @@ unit cgobj;
include(unusedscratchregisters,scratch_regs[i]); include(unusedscratchregisters,scratch_regs[i]);
end; end;
destructor tcg.done; procedure tcg.a_reg_alloc(list : taasmoutput;r : tregister);
begin
end;
procedure tcg.a_reg_alloc(list : paasmoutput;r : tregister);
begin begin
list^.concat(new(pairegalloc,alloc(r))); list^.concat(new(pairegalloc,alloc(r)));
end; end;
procedure tcg.a_reg_dealloc(list : paasmoutput;r : tregister); procedure tcg.a_reg_dealloc(list : taasmoutput;r : tregister);
begin begin
list^.concat(new(pairegalloc,dealloc(r))); list^.concat(new(pairegalloc,dealloc(r)));
end; end;
procedure tcg.a_label(list : paasmoutput;l : pasmlabel); procedure tcg.a_label(list : taasmoutput;l : pasmlabel);
begin begin
list^.concat(new(pai_label,init(l))); list^.concat(new(pai_label,init(l)));
end; end;
function tcg.get_scratch_reg(list : paasmoutput) : tregister; function tcg.get_scratch_reg(list : taasmoutput) : tregister;
var var
r : tregister; r : tregister;
@ -252,7 +263,7 @@ unit cgobj;
get_scratch_reg:=r; get_scratch_reg:=r;
end; end;
procedure tcg.free_scratch_reg(list : paasmoutput;r : tregister); procedure tcg.free_scratch_reg(list : taasmoutput;r : tregister);
begin begin
include(unusedscratchregisters,r); include(unusedscratchregisters,r);
@ -263,17 +274,17 @@ unit cgobj;
this methods must be overridden for extra functionality this methods must be overridden for extra functionality
******************************************************************************} ******************************************************************************}
procedure tcg.g_interrupt_stackframe_entry(list : paasmoutput); procedure tcg.g_interrupt_stackframe_entry(list : taasmoutput);
begin begin
end; end;
procedure tcg.g_interrupt_stackframe_exit(list : paasmoutput); procedure tcg.g_interrupt_stackframe_exit(list : taasmoutput);
begin begin
end; end;
procedure tcg.g_profilecode(list : paasmoutput); procedure tcg.g_profilecode(list : taasmoutput);
begin begin
end; end;
@ -282,7 +293,7 @@ unit cgobj;
for better code generation these methods should be overridden for better code generation these methods should be overridden
******************************************************************************} ******************************************************************************}
procedure tcg.a_param_const(list : paasmoutput;size : tcgsize;a : aword;nr : longint); procedure tcg.a_param_const(list : taasmoutput;size : tcgsize;a : aword;nr : longint);
var var
hr : tregister; hr : tregister;
@ -294,7 +305,7 @@ unit cgobj;
free_scratch_reg(list,hr); free_scratch_reg(list,hr);
end; end;
procedure tcg.a_param_ref(list : paasmoutput;size : tcgsize;const r : treference;nr : longint); procedure tcg.a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;nr : longint);
var var
hr : tregister; hr : tregister;
@ -306,7 +317,7 @@ unit cgobj;
free_scratch_reg(list,hr); free_scratch_reg(list,hr);
end; end;
procedure tcg.a_param_ref_addr(list : paasmoutput;r : treference;nr : longint); procedure tcg.a_param_ref_addr(list : taasmoutput;r : treference;nr : longint);
var var
hr : tregister; hr : tregister;
@ -318,14 +329,14 @@ unit cgobj;
free_scratch_reg(list,hr); free_scratch_reg(list,hr);
end; end;
procedure tcg.g_stackcheck(list : paasmoutput;stackframesize : longint); procedure tcg.g_stackcheck(list : taasmoutput;stackframesize : longint);
begin begin
a_param_const(list,OS_32,stackframesize,1); a_param_const(list,OS_32,stackframesize,1);
a_call_name(list,'FPC_STACKCHECK',0); a_call_name(list,'FPC_STACKCHECK',0);
end; end;
procedure tcg.a_load_const_ref(list : paasmoutput;size : tcgsize;a : aword;const ref : treference); procedure tcg.a_load_const_ref(list : taasmoutput;size : tcgsize;a : aword;const ref : treference);
var var
hr : tregister; hr : tregister;
@ -338,18 +349,12 @@ unit cgobj;
end; end;
procedure tcg.g_concatcopy(list : paasmoutput;const source,dest : treference;len : aword;loadref : boolean);
begin
abstract;
end;
{***************************************************************************** {*****************************************************************************
String helper routines String helper routines
*****************************************************************************} *****************************************************************************}
procedure tcg.g_removetemps(list : paasmoutput;p : plinkedlist); procedure tcg.g_removetemps(list : taasmoutput;p : plinkedlist);
var var
hp : ptemptodestroy; hp : ptemptodestroy;
@ -372,7 +377,7 @@ unit cgobj;
tg.popusedregisters(pushedregs); tg.popusedregisters(pushedregs);
end; end;
procedure tcg.g_decrstrref(list : paasmoutput;const ref : treference;t : pdef); procedure tcg.g_decrstrref(list : taasmoutput;const ref : treference;t : pdef);
var var
pushedregs : tpushed; pushedregs : tpushed;
@ -395,7 +400,7 @@ unit cgobj;
{ initilizes data of type t } { initilizes data of type t }
{ if is_already_ref is true then the routines assumes } { if is_already_ref is true then the routines assumes }
{ that r points to the data to initialize } { that r points to the data to initialize }
procedure tcg.g_initialize(list : paasmoutput;t : pdef;const ref : treference;is_already_ref : boolean); procedure tcg.g_initialize(list : taasmoutput;t : pdef;const ref : treference;is_already_ref : boolean);
var var
hr : treference; hr : treference;
@ -417,7 +422,7 @@ unit cgobj;
end; end;
end; end;
procedure tcg.g_finalize(list : paasmoutput;t : pdef;const ref : treference;is_already_ref : boolean); procedure tcg.g_finalize(list : taasmoutput;t : pdef;const ref : treference;is_already_ref : boolean);
var var
r : treference; r : treference;
@ -442,7 +447,7 @@ unit cgobj;
end; end;
{ generates the code for initialisation of local data } { generates the code for initialisation of local data }
procedure tcg.g_initialize_data(list : paasmoutput;p : psym); procedure tcg.g_initialize_data(list : taasmoutput;p : psym);
var var
hr : treference; hr : treference;
@ -493,7 +498,7 @@ unit cgobj;
{ generates the code for incrementing the reference count of parameters } { generates the code for incrementing the reference count of parameters }
procedure tcg.g_incr_data(list : paasmoutput;p : psym); procedure tcg.g_incr_data(list : taasmoutput;p : psym);
var var
hr : treference; hr : treference;
@ -540,7 +545,7 @@ unit cgobj;
{ generates the code for finalisation of local data } { generates the code for finalisation of local data }
procedure tcg.g_finalize_data(list : paasmoutput;p : pnamedindexobject); procedure tcg.g_finalize_data(list : taasmoutput;p : pnamedindexobject);
var var
hr : treference; hr : treference;
@ -611,13 +616,13 @@ unit cgobj;
{ generates the code to make local copies of the value parameters } { generates the code to make local copies of the value parameters }
procedure tcg.g_copyvalueparas(list : paasmoutput;p : pnamedindexobject); procedure tcg.g_copyvalueparas(list : taasmoutput;p : pnamedindexobject);
begin begin
runerror(255); runerror(255);
end; end;
var var
_list : paasmoutput; _list : taasmoutput;
{ wrappers for the methods, because TP doesn't know procedures } { wrappers for the methods, because TP doesn't know procedures }
{ of objects } { of objects }
@ -630,7 +635,7 @@ unit cgobj;
end; end;
{$ENDIF NEWST} {$ENDIF NEWST}
procedure tcg.g_finalizetempansistrings(list : paasmoutput); procedure tcg.g_finalizetempansistrings(list : taasmoutput);
var var
hp : ptemprecord; hp : ptemprecord;
@ -691,7 +696,7 @@ unit cgobj;
{$ENDIF NEWST} {$ENDIF NEWST}
{ generates the entry code for a procedure } { generates the entry code for a procedure }
procedure tcg.g_entrycode(list : paasmoutput;const proc_names:Tstringcontainer;make_global:boolean; procedure tcg.g_entrycode(list : taasmoutput;const proc_names:Tstringcontainer;make_global:boolean;
stackframe:longint;var parasize:longint;var nostackframe:boolean; stackframe:longint;var parasize:longint;var nostackframe:boolean;
inlined : boolean); inlined : boolean);
@ -950,7 +955,7 @@ unit cgobj;
{$endif GDB} {$endif GDB}
end; end;
procedure tcg.g_exitcode(list : paasmoutput;parasize:longint;nostackframe,inlined:boolean); procedure tcg.g_exitcode(list : taasmoutput;parasize:longint;nostackframe,inlined:boolean);
var var
{$ifdef GDB} {$ifdef GDB}
@ -1193,112 +1198,112 @@ unit cgobj;
end; end;
{***************************************************************************** {*****************************************************************************
some abstract definitions some generic implementations
****************************************************************************} ****************************************************************************}
procedure tcg.a_call_name(list : paasmoutput;const s : string;
offset : longint);
procedure tcg.a_load_const_ref(list : taasmoutput;size : tcgsize;a : aword;const ref : treference);
var
tmpreg: tregister;
begin begin
abstract; tmpreg := get_scratch_reg(list);
a_load_const_reg(list,size,a,tmpreg);
a_load_reg_ref(list,size,tmpref,ref);
free_scratch_reg(list,tmpreg);
end; end;
procedure tcg.g_stackframe_entry(list : paasmoutput;localsize : longint);
procedure tcg.a_op_const_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; const ref: TReference);
begin
abstract;
end;
procedure tcg.g_maybe_loadself(list : paasmoutput);
begin
abstract;
end;
procedure tcg.g_restore_frame_pointer(list : paasmoutput);
begin
abstract;
end;
procedure g_return_from_proc(list : paasmoutput;parasize : aword);
begin
abstract;
end;
procedure tcg.a_loadaddress_ref_reg(list : paasmoutput;const ref : treference;r : tregister);
begin
abstract;
end;
procedure tcg.g_push_exception_value_reg(list : paasmoutput;reg : tregister);
begin
abstract;
end;
procedure tcg.g_push_exception_value_const(list : paasmoutput;reg : tregister);
begin
abstract;
end;
procedure tcg.g_pop_exception_value_reg(list : paasmoutput;reg : tregister);
begin
abstract;
end;
procedure tcg.a_load_const_reg(list : paasmoutput;size : tcgsize;a : aword;register : tregister);
begin
abstract;
end;
procedure tcg.a_load_reg_ref(list : paasmoutput;size : tcgsize;register : tregister;const ref : treference);
begin
abstract;
end;
procedure tcg.a_load_ref_reg(list : paasmoutput;size : tcgsize;const ref : treference;register : tregister);
begin
abstract;
end;
procedure tcg.a_load_reg_reg(list : paasmoutput;size : tcgsize;reg1,reg2 : tregister);
begin
abstract;
end;
procedure tcg.a_cmp_const_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
l : pasmlabel);
begin
abstract;
end;
procedure tcg.a_cmp_reg_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : pasmlabel);
begin
abstract;
end;
procedure tcg.a_cmp_ref_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp; const ref: treference; reg : tregister; l : pasmlabel);
var var
tmpreg: tregister; tmpreg: tregister;
begin begin
tmpreg := get_scratch_reg(list); tmpreg := get_scratch_reg(list);
a_load_ref_reg(list,size,ref,tmpreg); a_load_ref_reg(list,size,ref,tmpreg);
a_cmp_reg_reg_label(list,size,cmp_op,a,tmpreg,l); a_op_const_reg(list,op,size,a,tmpreg);
a_load_reg_ref(list,size,tmpreg,ref);
free_scratch_reg(tmpreg); free_scratch_reg(tmpreg);
end; end;
procedure tcg.a_cmp_const_ref_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const ref : treference;
procedure tcg.a_op_const_loc(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; const loc: tloocation);
begin
case loc.loc of
LOC_REGISTER, LOC_CREGISTER:
a_op_const_reg(list,op,size,a,loc.register);
LOC_REFERENCE, LOC_MEM:
a_op_const_reg(list,op,size,a,loc.reference);
else
internalerror(200109061);
end;
procedure tcg.a_op_reg_ref(list : taasmoutput; Op: TOpCG; size: TCGSize;reg: TRegister; const ref: TReference);
var
tmpreg: tregister;
begin
tmpreg := get_scratch_reg(list);
a_load_ref_reg(list,size,ref,tmpreg);
a_op_reg_reg(list,op,size,reg,tmpreg);
a_load_reg_ref(list,size,tmpreg,ref);
free_scratch_reg(tmpreg);
end;
procedure tcg.a_op_ref_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); virtual;
var
tmpreg: tregister;
begin
tmpreg := get_scratch_reg(list);
a_load_ref_reg(list,size,ref,tmpreg);
a_op_reg_reg(list,op,size,tmpreg,reg);
free_scratch_reg(tmpreg);
end;
procedure tcg.a_op_reg_loc(list : taasmoutput; Op: TOpCG; size: TCGSize; const ref: TReference; const loc: tloocation);
begin
case loc.loc of
LOC_REGISTER, LOC_CREGISTER:
a_op_reg_reg(list,op,size,a,loc.register);
LOC_REFERENCE, LOC_MEM:
a_op_reg_ref(list,op,size,a,loc.reference);
else
internalerror(200109061);
end;
procedure tcg.a_op_ref_loc(list : taasmoutput; Op: TOpCG; size: TCGSize; const ref: TReference; const loc: tloocation);
var
tmpreg: tregister;
begin
case loc.loc of
LOC_REGISTER,LOC_CREGISTER:
a_op_ref_reg(list,op,size,ref,loc.register,l);
LOC_REFERENCE,LOC_MEM:
begin
tmpreg := get_scratch_reg(list);
a_load_ref_reg(size,reftmpreg);
a_op_reg_ref(list,op,size,tmpreg,location.reference);
free_scratch_reg(list,tmpreg);
end;
else
internalerror(200109061);
end;
end;
procedure tcg.a_cmp_const_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const ref : treference;
l : pasmlabel); l : pasmlabel);
var var
@ -1311,65 +1316,67 @@ unit cgobj;
free_scratch_reg(tmpreg); free_scratch_reg(tmpreg);
end; end;
procedure tcg.a_cmp_const_loc_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const loc : tlocation; procedure tcg.a_cmp_const_loc_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const loc : tlocation;
l : pasmlabel); l : pasmlabel);
begin begin
case loc.loc of case loc.loc of
LOC_REGISTER,LOC_CREGISTER: LOC_REGISTER,LOC_CREGISTER:
!!!!!! 64bit locations -> two registers!!
a_cmp_const_reg_label(list,size,cmp_op,a,loc.register,l); a_cmp_const_reg_label(list,size,cmp_op,a,loc.register,l);
LOC_REFERENCE,LOC_MEM: LOC_REFERENCE,LOC_MEM:
a_cmp_const_ref_label(list,size,cmp_op,a,loc.reference,l); a_cmp_const_ref_label(list,size,cmp_op,a,loc.reference,l);
else
internalerror(200109061);
end; end;
end; end;
procedure tcg.a_cmp_ref_loc_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;const ref: treference;const loc : tlocation; procedure tcg.a_cmp_ref_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp; const ref: treference; reg : tregister; l : pasmlabel);
l : pasmlabel);
var var
tmpreg: tregister; tmpreg: tregister;
begin
tmpreg := get_scratch_reg(list);
a_load_ref_reg(list,size,ref,tmpreg);
a_cmp_reg_reg_label(list,size,cmp_op,a,tmpreg,l);
free_scratch_reg(tmpreg);
end;
procedure tcg.a_cmp_ref_loc_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;const ref: treference;const loc : tlocation;
l : pasmlabel);
var
tmpreg: tregister;
begin begin
case loc.loc of case loc.loc of
LOC_REGISTER,LOC_CREGISTER: LOC_REGISTER,LOC_CREGISTER:
a_cmp_ref_reg_label(list,size,cmp_op,ref,loc.register,l); { we reverse the operands, so also do the inverse comparison }
a_cmp_reg_ref_label(list,size,inverse_opcmp(cmp_op),loc.register,ref,l);
LOC_REFERENCE,LOC_MEM: LOC_REFERENCE,LOC_MEM:
begin begin
tmpreg := get_scratch_reg(list); tmpreg := get_scratch_reg(list);
a_load_ref_reg(size,location.reference,tmpreg); a_load_ref_reg(size,reftmpreg);
a_cmp_ref_reg(list,size,cmp_op,ref,tmpreg,l); a_cmp_reg_ref(list,size,cmp_op,tmpreg,location.reference,l);
free_scratch_reg(list,tmpreg); free_scratch_reg(list,tmpreg);
end; end;
else
internalerror(200109061);
end; end;
end; end;
procedure tcg.a_jmp_cond(list : paasmoutput;cond : TOpCmp;l: pasmlabel);
begin
abstract;
end;
procedure tcg.g_return_from_proc(list : paasmoutput;parasize : aword);
begin
abstract;
end;
procedure tcg.a_param_reg(list : paasmoutput;size : tcgsize;r : tregister;nr : longint);
begin
abstract;
end;
procedure tcg.a_paramaddr_ref(list : paasmoutput;const r : treference;nr : longint);
begin
abstract;
end;
end. end.
{ {
$Log$ $Log$
Revision 1.3 2001-09-05 20:21:03 jonas Revision 1.4 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.3 2001/09/05 20:21:03 jonas
* new cgflow based on n386flw with all nodes until forn "translated" * new cgflow based on n386flw with all nodes until forn "translated"
+ a_cmp_loc_*_label methods for tcg + a_cmp_loc_*_label methods for tcg
+ base implementatino for a_cmp_ref_*_label methods + base implementatino for a_cmp_ref_*_label methods
@ -1382,134 +1389,4 @@ end.
Revision 1.1 2000/07/13 06:30:07 michael Revision 1.1 2000/07/13 06:30:07 michael
+ Initial import + Initial import
Revision 1.38 2000/04/29 09:01:06 jonas
* nmem compiles again (at least for powerpc)
Revision 1.37 2000/04/22 14:25:03 jonas
* aasm.pas: pai_align instead of pai_align_abstract if cpu <> i386
+ systems.pas: info for macos/ppc
* new/cgobj.pas: compiles again without newst define
* new/powerpc/cgcpu: generate different entry/exit code depending on
whether target_os is MacOs or Linux
Revision 1.36 2000/03/11 21:11:24 daniel
* Ported hcgdata to new symtable.
* Alignment code changed as suggested by Peter
+ Usage of my is operator replacement, is_object
Revision 1.35 2000/03/01 15:36:13 florian
* some new stuff for the new cg
Revision 1.34 2000/02/20 20:49:46 florian
* newcg is compiling
* fixed the dup id problem reported by Paul Y.
Revision 1.33 2000/01/07 01:14:53 peter
* updated copyright to 2000
Revision 1.32 1999/12/01 12:42:33 peter
* fixed bug 698
* removed some notes about unused vars
Revision 1.31 1999/11/05 13:15:00 florian
* some fixes to get the new cg compiling again
Revision 1.30 1999/11/05 07:05:56 jonas
+ a_jmp_cond()
Revision 1.29 1999/10/21 16:41:41 florian
* problems with readln fixed: esi wasn't restored correctly when
reading ordinal fields of objects futher the register allocation
didn't take care of the extra register when reading ordinal values
* enumerations can now be used in constant indexes of properties
Revision 1.28 1999/10/12 21:20:46 florian
* new codegenerator compiles again
Revision 1.27 1999/09/29 11:46:20 florian
* fixed bug 292 from bugs directory
Revision 1.26 1999/09/14 11:16:09 florian
* only small updates to work with the current compiler
Revision 1.25 1999/09/03 13:09:09 jonas
* fixed typo regarding scratchregs pointer
Revision 1.24 1999/08/26 14:51:54 jonas
* changed get_scratch_reg so it actually uses the
scratch_reg_array_pointer
Revision 1.23 1999/08/25 12:00:11 jonas
* changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu)
Revision 1.22 1999/08/18 17:05:55 florian
+ implemented initilizing of data for the new code generator
so it should compile now simple programs
Revision 1.21 1999/08/07 14:21:08 florian
* some small problems fixed
Revision 1.20 1999/08/06 18:05:52 florian
* implemented some stuff for assignments
Revision 1.19 1999/08/06 17:00:54 florian
+ definition of concatcopy
Revision 1.18 1999/08/06 16:37:45 jonas
* completed bugfix done by Florian o I wouldn't get conflicts :)
Revision 1.17 1999/08/06 16:27:26 florian
* for Jonas: else he will get conflicts
Revision 1.16 1999/08/06 16:04:05 michael
+ introduced tainstruction
Revision 1.15 1999/08/06 15:53:50 florian
* made the alpha version compilable
Revision 1.14 1999/08/06 14:15:51 florian
* made the alpha version compilable
Revision 1.13 1999/08/06 13:26:50 florian
* more changes ...
Revision 1.12 1999/08/05 17:10:56 florian
* some more additions, especially procedure
exit code generation
Revision 1.11 1999/08/05 14:58:11 florian
* some fixes for the floating point registers
* more things for the new code generator
Revision 1.10 1999/08/04 00:23:52 florian
* renamed i386asm and i386base to cpuasm and cpubase
Revision 1.9 1999/08/02 23:13:21 florian
* more changes to compile for the Alpha
Revision 1.8 1999/08/02 17:14:07 florian
+ changed the temp. generator to an object
Revision 1.7 1999/08/01 23:05:55 florian
* changes to compile with FPC
Revision 1.6 1999/08/01 18:22:33 florian
* made it again compilable
Revision 1.5 1999/01/23 23:29:46 florian
* first running version of the new code generator
* when compiling exceptions under Linux fixed
Revision 1.4 1999/01/13 22:52:36 florian
+ YES, finally the new code generator is compilable, but it doesn't run yet :(
Revision 1.3 1998/12/26 15:20:30 florian
+ more changes for the new version
Revision 1.2 1998/12/15 22:18:55 florian
* some code added
Revision 1.1 1998/12/15 16:32:58 florian
+ first version, derived from old routines
} }

340
compiler/powerpc/cgcpu.pas
View File

@ -36,41 +36,44 @@ unit cgcpu;
{ left to right), this allows to move the parameter to } { left to right), this allows to move the parameter to }
{ register, if the cpu supports register calling } { register, if the cpu supports register calling }
{ conventions } { conventions }
procedure a_param_reg(list : paasmoutput;size : tcgsize;r : tregister;nr : longint);virtual; procedure a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;nr : longint);virtual;
procedure a_param_const(list : paasmoutput;size : tcgsize;a : aword;nr : longint);virtual; procedure a_param_const(list : taasmoutput;size : tcgsize;a : aword;nr : longint);virtual;
procedure a_param_ref(list : paasmoutput;size : tcgsize;const r : treference;nr : longint);virtual; procedure a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;nr : longint);virtual;
procedure a_paramaddr_ref(list : paasmoutput;const r : treference;nr : longint);virtual; procedure a_paramaddr_ref(list : taasmoutput;const r : treference;nr : longint);virtual;
procedure a_call_name(list : paasmoutput;const s : string; procedure a_call_name(list : taasmoutput;const s : string;
offset : longint);virtual; offset : longint);virtual;
procedure a_op_reg_const(list : paasmoutput; Op: TOpCG; size: TCGSize; reg: TRegister; a: AWord); virtual; procedure a_op_const_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; reg: TRegister); virtual;
procedure a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister); virtual;
{ move instructions } { move instructions }
procedure a_load_const_reg(list : paasmoutput; size: tcgsize; a : aword;reg : tregister);virtual; procedure a_load_const_reg(list : taasmoutput; size: tcgsize; a : aword;reg : tregister);virtual;
procedure a_load_reg_ref(list : paasmoutput; size: tcgsize; reg : tregister;const ref2 : treference);virtual; procedure a_load_reg_ref(list : taasmoutput; size: tcgsize; reg : tregister;const ref2 : treference);virtual;
procedure a_load_ref_reg(list : paasmoutput;size : tcgsize;const Ref2 : treference;reg : tregister);virtual; procedure a_load_ref_reg(list : taasmoutput;size : tcgsize;const Ref2 : treference;reg : tregister);virtual;
procedure a_load_reg_reg(list : paasmoutput;size : tcgsize;reg1,reg2 : tregister);virtual; procedure a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister);virtual;
{ comparison operations } { comparison operations }
procedure a_cmp_const_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister; procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
l : pasmlabel);virtual; l : pasmlabel);virtual;
procedure a_cmp_reg_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : pasmlabel); procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : pasmlabel);
procedure a_jmp_cond(list : paasmoutput;cond : TOpCmp;l: pasmlabel);
procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: pasmlabel);
procedure g_flags2reg(const f: TAsmCond; reg: TRegister); abstract;
procedure g_stackframe_entry_sysv(list : paasmoutput;localsize : longint); procedure g_stackframe_entry_sysv(list : taasmoutput;localsize : longint);
procedure g_stackframe_entry_mac(list : paasmoutput;localsize : longint); procedure g_stackframe_entry_mac(list : taasmoutput;localsize : longint);
procedure g_stackframe_entry(list : paasmoutput;localsize : longint);virtual; procedure g_stackframe_entry(list : taasmoutput;localsize : longint);virtual;
procedure g_restore_frame_pointer(list : paasmoutput);virtual; procedure g_restore_frame_pointer(list : taasmoutput);virtual;
procedure g_return_from_proc(list : paasmoutput;parasize : aword); virtual; procedure g_return_from_proc(list : taasmoutput;parasize : aword); virtual;
procedure g_return_from_proc_sysv(list : paasmoutput;parasize : aword); procedure g_return_from_proc_sysv(list : taasmoutput;parasize : aword);
procedure g_return_from_proc_mac(list : paasmoutput;parasize : aword); procedure g_return_from_proc_mac(list : taasmoutput;parasize : aword);
procedure a_loadaddress_ref_reg(list : paasmoutput;const ref2 : treference;r : tregister);virtual; procedure a_loadaddress_ref_reg(list : taasmoutput;const ref2 : treference;r : tregister);virtual;
procedure g_concatcopy(list : paasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean);virtual; procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean);virtual;
private private
@ -79,19 +82,19 @@ unit cgcpu;
{ OpLo reg1, reg2, (a and $ffff) and/or } { OpLo reg1, reg2, (a and $ffff) and/or }
{ OpHi reg1, reg2, (a shr 16) } { OpHi reg1, reg2, (a shr 16) }
{ depending on the value of a } { depending on the value of a }
procedure a_op_reg_reg_const32(list: paasmOutPut; oplo, ophi: tasmop; procedure a_op_reg_reg_const32(list: taasmoutput; oplo, ophi: tasmop;
reg1, reg2: tregister; a: aword); reg1, reg2: tregister; a: aword);
{ Make sure ref is a valid reference for the PowerPC and sets the } { Make sure ref is a valid reference for the PowerPC and sets the }
{ base to the value of the index if (base = R_NO). } { base to the value of the index if (base = R_NO). }
procedure fixref(var ref: treference); procedure fixref(var ref: treference);
{ contains the common code of a_load_reg_ref and a_load_ref_reg } { contains the common code of a_load_reg_ref and a_load_ref_reg }
procedure a_load_store(list:paasmoutput;op: tasmop;reg:tregister; procedure a_load_store(list:taasmoutput;op: tasmop;reg:tregister;
var ref: treference); var ref: treference);
{ creates the correct branch instruction for a given combination } { creates the correct branch instruction for a given combination }
{ of asmcondflags and destination addressing mode } { of asmcondflags and destination addressing mode }
procedure a_jmp(list: paasmoutput; op: tasmop; procedure a_jmp(list: taasmoutput; op: tasmop;
c: tasmcondflags; l: pasmlabel); c: tasmcondflags; l: pasmlabel);
end; end;
@ -128,7 +131,7 @@ const
{ parameter passing... Still needs extra support from the processor } { parameter passing... Still needs extra support from the processor }
{ independent code generator } { independent code generator }
procedure tcgppc.a_param_reg(list : paasmoutput;size : tcgsize;r : tregister;nr : longint); procedure tcgppc.a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;nr : longint);
var ref: treference; var ref: treference;
@ -147,7 +150,7 @@ const
end; end;
procedure tcgppc.a_param_const(list : paasmoutput;size : tcgsize;a : aword;nr : longint); procedure tcgppc.a_param_const(list : taasmoutput;size : tcgsize;a : aword;nr : longint);
var ref: treference; var ref: treference;
@ -166,7 +169,7 @@ const
end; end;
procedure tcgppc.a_param_ref(list : paasmoutput;size : tcgsize;const r : treference;nr : longint); procedure tcgppc.a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;nr : longint);
var ref: treference; var ref: treference;
tmpreg: tregister; tmpreg: tregister;
@ -189,7 +192,7 @@ const
end; end;
procedure tcgppc.a_paramaddr_ref(list : paasmoutput;const r : treference;nr : longint); procedure tcgppc.a_paramaddr_ref(list : taasmoutput;const r : treference;nr : longint);
var ref: treference; var ref: treference;
tmpreg: tregister; tmpreg: tregister;
@ -213,36 +216,36 @@ const
{ calling a code fragment by name } { calling a code fragment by name }
procedure tcgppc.a_call_name(list : paasmoutput;const s : string; procedure tcgppc.a_call_name(list : taasmoutput;const s : string;
offset : longint); offset : longint);
begin begin
{ save our RTOC register value. Only necessary when doing pointer based } { save our RTOC register value. Only necessary when doing pointer based }
{ calls or cross TOC calls, but currently done always } { calls or cross TOC calls, but currently done always }
list^.concat(new(paicpu,op_reg_ref(A_STW,R_RTOC, list.concat(taicpu.op_reg_ref(A_STW,R_RTOC,
new_reference(stack_pointer,LA_RTOC)))); new_reference(stack_pointer,LA_RTOC)));
list^.concat(new(paicpu,op_sym(A_BL,newasmsymbol(s)))); list.concat(taicpu.op_sym(A_BL,newasmsymbol(s)));
list^.concat(new(paicpu,op_reg_ref(A_LWZ,R_RTOC, list.concat(taicpu.op_reg_ref(A_LWZ,R_RTOC,
new_reference(stack_pointer,LA_RTOC)))); new_reference(stack_pointer,LA_RTOC)));
end; end;
{********************** load instructions ********************} {********************** load instructions ********************}
procedure tcgppc.a_load_const_reg(list : paasmoutput; size: TCGSize; a : aword; reg : TRegister); procedure tcgppc.a_load_const_reg(list : taasmoutput; size: TCGSize; a : aword; reg : TRegister);
begin begin
If (a and $ffff) <> 0 Then If (a and $ffff) <> 0 Then
Begin Begin
list^.concat(new(paicpu,op_reg_const(A_LI,reg,a and $ffff))); list.concat(taicpu.op_reg_const(A_LI,reg,a and $ffff));
If (a shr 16) <> 0 Then If (a shr 16) <> 0 Then
list^.concat(new(paicpu,op_reg_const(A_ADDIS,reg, list.concat(taicpu.op_reg_const(A_ADDIS,reg,
(a shr 16)+ord(smallint(a and $ffff) < 0)))) (a shr 16)+ord(smallint(a and $ffff) < 0)))
End End
Else Else
list^.concat(new(paicpu,op_reg_const(A_LIS,reg,a shr 16))); list.concat(taicpu.op_reg_const(A_LIS,reg,a shr 16));
end; end;
procedure tcgppc.a_load_reg_ref(list : paasmoutput; size: TCGSize; reg : tregister;const ref2 : treference); procedure tcgppc.a_load_reg_ref(list : taasmoutput; size: TCGSize; reg : tregister;const ref2 : treference);
Var Var
op: TAsmOp; op: TAsmOp;
@ -255,7 +258,7 @@ const
a_load_store(list,op,reg,ref); a_load_store(list,op,reg,ref);
End; End;
procedure tcgppc.a_load_ref_reg(list : paasmoutput;size : tcgsize;const ref2: treference;reg : tregister); procedure tcgppc.a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref2: treference;reg : tregister);
Var Var
op: TAsmOp; op: TAsmOp;
@ -269,13 +272,13 @@ const
a_load_store(list,op,reg,ref); a_load_store(list,op,reg,ref);
end; end;
procedure tcgppc.a_load_reg_reg(list : paasmoutput;size : tcgsize;reg1,reg2 : tregister); procedure tcgppc.a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister);
begin begin
list^.concat(new(paicpu,op_reg_reg(A_MR,reg2,reg1))); list.concat(taicpu.op_reg_reg(A_MR,reg2,reg1));
end; end;
procedure tcgppc.a_op_reg_const(list : paasmoutput; Op: TOpCG; size: TCGSize; reg: TRegister; a: AWord); procedure tcgppc.a_op_const_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; reg: TRegister);
var scratch_register: TRegister; var scratch_register: TRegister;
@ -284,13 +287,13 @@ const
OP_DIV, OP_IDIV, OP_IMUL, OP_MUL: OP_DIV, OP_IDIV, OP_IMUL, OP_MUL:
If (Op = OP_IMUL) And (longint(a) >= -32768) And If (Op = OP_IMUL) And (longint(a) >= -32768) And
(longint(a) <= 32767) Then (longint(a) <= 32767) Then
list^.concat(new(paicpu,op_reg_reg_const(A_MULLI,reg,reg,a))) list.concat(taicpu.op_reg_reg_const(A_MULLI,reg,reg,a))
Else Else
Begin Begin
scratch_register := get_scratch_reg(list); scratch_register := get_scratch_reg(list);
a_load_const_reg(list, OS_32, a, scratch_register); a_load_const_reg(list, OS_32, a, scratch_register);
list^.concat(new(paicpu,op_reg_reg_reg(TOpCG2AsmOpLo[Op], list.concat(taicpu.op_reg_reg_reg(TOpCG2AsmOpLo[Op],
reg,reg,scratch_register))); reg,reg,scratch_register));
free_scratch_reg(list,scratch_register); free_scratch_reg(list,scratch_register);
End; End;
OP_ADD, OP_AND, OP_OR, OP_SUB,OP_XOR: OP_ADD, OP_AND, OP_OR, OP_SUB,OP_XOR:
@ -299,8 +302,8 @@ const
OP_SHL,OP_SHR,OP_SAR: OP_SHL,OP_SHR,OP_SAR:
Begin Begin
if (a and 31) <> 0 Then if (a and 31) <> 0 Then
list^.concat(new(paicpu,op_reg_reg_const( list.concat(taicpu.op_reg_reg_const(
TOpCG2AsmOpLo[Op],reg,reg,a and 31))); TOpCG2AsmOpLo[Op],reg,reg,a and 31));
If (a shr 5) <> 0 Then If (a shr 5) <> 0 Then
InternalError(68991); InternalError(68991);
End End
@ -308,10 +311,24 @@ const
end; end;
end; end;
procedure tcgppc.a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister);
const
op_reg_reg_opcg2asmop: array[TOpCG] of tasmop =
(A_ADD,A_AND,A_DIVWU,A_DIVW,A_MULLW,A_MULLW,A_NEG,A_NOT,A_OR,
A_SRAW,A_SLW,A_SRW,A_SUB,A_XOR)
begin
Case Op of
OP_NEG,OP_NOT:
list.concat(taicpu.op_reg_reg(op_reg_reg_opcg2asmop[op],size,reg2,reg2));
else
list.concat(taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop[op],size,reg2,reg1,reg2));
end;
{*************** compare instructructions ****************} {*************** compare instructructions ****************}
procedure tcgppc.a_cmp_const_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister; procedure tcgppc.a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
l : pasmlabel); l : pasmlabel);
var p: paicpu; var p: paicpu;
@ -322,29 +339,29 @@ const
signed := cmp_op in [OC_GT,OC_LT,OC_GTE,OC_LTE]; signed := cmp_op in [OC_GT,OC_LT,OC_GTE,OC_LTE];
If signed Then If signed Then
If (longint(a) >= -32768) and (longint(a) <= 32767) Then If (longint(a) >= -32768) and (longint(a) <= 32767) Then
list^.concat(new(paicpu,op_const_reg_const(A_CMPI,0,reg,a))) list.concat(taicpu.op_const_reg_const(A_CMPI,0,reg,a))
else else
begin begin
scratch_register := get_scratch_reg(list); scratch_register := get_scratch_reg(list);
a_load_const_reg(list,OS_32,a,scratch_register); a_load_const_reg(list,OS_32,a,scratch_register);
list^.concat(new(paicpu,op_const_reg_reg(A_CMP,0,reg,scratch_register))); list.concat(taicpu.op_const_reg_reg(A_CMP,0,reg,scratch_register));
free_scratch_reg(list,scratch_register); free_scratch_reg(list,scratch_register);
end end
else else
if (a <= $ffff) then if (a <= $ffff) then
list^.concat(new(paicpu,op_const_reg_const(A_CMPLI,0,reg,a))) list.concat(taicpu.op_const_reg_const(A_CMPLI,0,reg,a))
else else
begin begin
scratch_register := get_scratch_reg(list); scratch_register := get_scratch_reg(list);
a_load_const_reg(list,OS_32,a,scratch_register); a_load_const_reg(list,OS_32,a,scratch_register);
list^.concat(new(paicpu,op_const_reg_reg(A_CMPL,0,reg,scratch_register))); list.concat(taicpu.op_const_reg_reg(A_CMPL,0,reg,scratch_register));
free_scratch_reg(list,scratch_register); free_scratch_reg(list,scratch_register);
end; end;
a_jmp(list,A_BC,TOpCmp2AsmCond[cmp_op],l); a_jmp(list,A_BC,TOpCmp2AsmCond[cmp_op],l);
end; end;
procedure tcgppc.a_cmp_reg_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp; procedure tcgppc.a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;
reg1,reg2 : tregister;l : pasmlabel); reg1,reg2 : tregister;l : pasmlabel);
var p: paicpu; var p: paicpu;
@ -354,19 +371,70 @@ const
if cmp_op in [OC_GT,OC_LT,OC_GTE,OC_LTE] then if cmp_op in [OC_GT,OC_LT,OC_GTE,OC_LTE] then
op := A_CMP op := A_CMP
else op := A_CMPL; else op := A_CMPL;
list^.concat(new(paicpu,op_const_reg_reg(op,0,reg1,reg2))); list.concat(taicpu.op_const_reg_reg(op,0,reg1,reg2));
a_jmp(list,A_BC,TOpCmp2AsmCond[cmp_op],l); a_jmp(list,A_BC,TOpCmp2AsmCond[cmp_op],l);
end; end;
procedure tcgppc.a_jmp_cond(list : paasmoutput;cond : TOpCmp;l: pasmlabel); procedure tcgppc.a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: pasmlabel);
begin begin
a_jmp(list,A_BC,TOpCmp2AsmCond[cond],l); a_jmp(list,A_BC,TOpCmp2AsmCond[cond],l);
end; end;
procedure tcgppc.g_flags2reg(list: taasmoutput; const f: TAsmCond; reg: TRegister);
var
testbit: byte;
bitvalue: boolean;
begin
{ get the bit to extract from the conditional register + its }
{ requested value (0 or 1) }
case simple of
false:
begin
{ we don't generate this in the compiler }
internalerror(200109062);
end;
true:
case f.cond of
C_None:
internalerror(200109063);
C_LT..C_NU:
begin
testbit := (ord(f.cr) - ord(R_CR0))*4;
inc(testbit,AsmCondFlag2BI[f.cond]);
bitvalue := AsmCondFlagTF[f.cond];
end;
C_T,C_F,C_DNZT,C_DNZF,C_DZT,C_DZF:
begin
testbit := f.crbit
bitvalue := AsmCondFlagTF[f.cond];
end;
else
internalerror(200109064);
end;
end;
{ load thge conditional register in the destination reg }
list.concat(taicpu.create(op_reg_reg(A_MFCR,reg)));
{ we will move the bit that has to be tested to bit 0 -> rotate }
{ left by bitpos+1 (remember, this is big-endian!) }
if bitpos <> 31 then
inc(bitpos)
else
bitpos := 0;
{ extract bit }
list.concat(taicpu.create(op_reg_reg_const_const_const(
A_RLWINM,reg,reg,bitpos,31,31)));
{ if we need the inverse, xor with 1 }
if not bitvalue then
list.concat(taicpu.create(op_reg_reg_const(A_XORI,reg,reg,1)));
end;
{ *********** entry/exit code and address loading ************ } { *********** entry/exit code and address loading ************ }
procedure tcgppc.g_stackframe_entry(list : paasmoutput;localsize : longint); procedure tcgppc.g_stackframe_entry(list : taasmoutput;localsize : longint);
begin begin
case target_os.id of case target_os.id of
os_powerpc_macos: os_powerpc_macos:
@ -379,7 +447,7 @@ const
end; end;
procedure tcgppc.g_stackframe_entry_sysv(list : paasmoutput;localsize : longint); procedure tcgppc.g_stackframe_entry_sysv(list : taasmoutput;localsize : longint);
{ generated the entry code of a procedure/function. Note: localsize is the } { generated the entry code of a procedure/function. Note: localsize is the }
{ sum of the size necessary for local variables and the maximum possible } { sum of the size necessary for local variables and the maximum possible }
{ combined size of ALL the parameters of a procedure called by the current } { combined size of ALL the parameters of a procedure called by the current }
@ -398,47 +466,47 @@ const
for regcounter := R_3 to R_10 do for regcounter := R_3 to R_10 do
a_reg_alloc(list,regcounter); a_reg_alloc(list,regcounter);
{ save return address... } { save return address... }
list^.concat(new(paicpu,op_reg_reg(A_MFSPR,R_0,R_LR))); list.concat(taicpu.op_reg_reg(A_MFSPR,R_0,R_LR));
{ ... in caller's frame } { ... in caller's frame }
list^.concat(new(paicpu,op_reg_ref(A_STW,R_0,new_reference(STACK_POINTER,4)))); list.concat(taicpu.op_reg_ref(A_STW,R_0,new_reference(STACK_POINTER,4)));
a_reg_dealloc(list,R_0); a_reg_dealloc(list,R_0);
a_reg_alloc(list,R_11); a_reg_alloc(list,R_11);
{ save end of fpr save area } { save end of fpr save area }
list^.concat(new(paicpu,op_reg_reg_const(A_ORI,R_11,STACK_POINTER,0))); list.concat(taicpu.op_reg_reg_const(A_ORI,R_11,STACK_POINTER,0));
a_reg_alloc(list,R_12); a_reg_alloc(list,R_12);
{ 0 or 8 based on SP alignment } { 0 or 8 based on SP alignment }
list^.concat(new(paicpu,op_reg_reg_const_const_const(A_RLWINM, list.concat(taicpu.op_reg_reg_const_const_const(A_RLWINM,
R_12,STACK_POINTER,0,28,28))); R_12,STACK_POINTER,0,28,28));
{ add in stack length } { add in stack length }
list^.concat(new(paicpu,op_reg_reg_const(A_SUBFIC,R_12,R_12, list.concat(taicpu.op_reg_reg_const(A_SUBFIC,R_12,R_12,
-localsize))); -localsize));
{ establish new alignment } { establish new alignment }
list^.concat(new(paicpu,op_reg_reg_reg(A_STWUX,STACK_POINTER,STACK_POINTER,R_12))); list.concat(taicpu.op_reg_reg_reg(A_STWUX,STACK_POINTER,STACK_POINTER,R_12));
a_reg_dealloc(list,R_12); a_reg_dealloc(list,R_12);
{ save floating-point registers } { save floating-point registers }
{ !!! has to be optimized: only save registers that are used } { !!! has to be optimized: only save registers that are used }
list^.concat(new(paicpu,op_sym_ofs(A_BL,newasmsymbol('_savefpr_14'),0))); list.concat(taicpu.op_sym_ofs(A_BL,newasmsymbol('_savefpr_14'),0));
{ compute end of gpr save area } { compute end of gpr save area }
list^.concat(new(paicpu,op_reg_reg_const(A_ADDI,R_11,R_11,-144))); list.concat(taicpu.op_reg_reg_const(A_ADDI,R_11,R_11,-144));
{ save gprs and fetch GOT pointer } { save gprs and fetch GOT pointer }
{ !!! has to be optimized: only save registers that are used } { !!! has to be optimized: only save registers that are used }
list^.concat(new(paicpu,op_sym_ofs(A_BL,newasmsymbol('_savegpr_14_go'),0))); list.concat(taicpu.op_sym_ofs(A_BL,newasmsymbol('_savegpr_14_go'),0));
a_reg_alloc(list,R_31); a_reg_alloc(list,R_31);
{ place GOT ptr in r31 } { place GOT ptr in r31 }
list^.concat(new(paicpu,op_reg_reg(A_MFSPR,R_31,R_LR))); list.concat(taicpu.op_reg_reg(A_MFSPR,R_31,R_LR));
{ save the CR if necessary ( !!! always done currently ) } { save the CR if necessary ( !!! always done currently ) }
{ still need to find out where this has to be done for SystemV { still need to find out where this has to be done for SystemV
a_reg_alloc(list,R_0); a_reg_alloc(list,R_0);
list^.concat(new(paicpu,op_reg_reg(A_MFSPR,R_0,R_CR); list.concat(taicpu.op_reg_reg(A_MFSPR,R_0,R_CR);
list^.concat(new(paicpu,op_reg_ref(A_STW,scratch_register, list.concat(taicpu.op_reg_ref(A_STW,scratch_register,
new_reference(stack_pointer,LA_CR)))); new_reference(stack_pointer,LA_CR)));
a_reg_dealloc(list,R_0); } a_reg_dealloc(list,R_0); }
{ save pointer to incoming arguments } { save pointer to incoming arguments }
list^.concat(new(paicpu,op_reg_reg_const(A_ADDI,R_30,R_11,144))); list.concat(taicpu.op_reg_reg_const(A_ADDI,R_30,R_11,144));
{ now comes the AltiVec context save, not yet implemented !!! } { now comes the AltiVec context save, not yet implemented !!! }
end; end;
procedure tcgppc.g_stackframe_entry_mac(list : paasmoutput;localsize : longint); procedure tcgppc.g_stackframe_entry_mac(list : taasmoutput;localsize : longint);
{ generated the entry code of a procedure/function. Note: localsize is the } { generated the entry code of a procedure/function. Note: localsize is the }
{ sum of the size necessary for local variables and the maximum possible } { sum of the size necessary for local variables and the maximum possible }
{ combined size of ALL the parameters of a procedure called by the current } { combined size of ALL the parameters of a procedure called by the current }
@ -457,45 +525,45 @@ const
for regcounter := R_3 to R_10 do for regcounter := R_3 to R_10 do
a_reg_alloc(list,regcounter); a_reg_alloc(list,regcounter);
{ save return address... } { save return address... }
list^.concat(new(paicpu,op_reg_reg(A_MFSPR,R_0,R_LR))); list.concat(taicpu.op_reg_reg(A_MFSPR,R_0,R_LR));
{ ... in caller's frame } { ... in caller's frame }
list^.concat(new(paicpu,op_reg_ref(A_STW,R_0,new_reference(STACK_POINTER,8)))); list.concat(taicpu.op_reg_ref(A_STW,R_0,new_reference(STACK_POINTER,8)));
a_reg_dealloc(list,R_0); a_reg_dealloc(list,R_0);
{ save floating-point registers } { save floating-point registers }
{ !!! has to be optimized: only save registers that are used } { !!! has to be optimized: only save registers that are used }
list^.concat(new(paicpu,op_sym_ofs(A_BL,newasmsymbol('_savef14'),0))); list.concat(taicpu.op_sym_ofs(A_BL,newasmsymbol('_savef14'),0));
{ save gprs in gpr save area } { save gprs in gpr save area }
{ !!! has to be optimized: only save registers that are used } { !!! has to be optimized: only save registers that are used }
list^.concat(new(paicpu,op_reg_ref(A_STMW,R_13,new_reference(STACK_POINTER,-220)))); list.concat(taicpu.op_reg_ref(A_STMW,R_13,new_reference(STACK_POINTER,-220)));
{ save the CR if necessary ( !!! always done currently ) } { save the CR if necessary ( !!! always done currently ) }
a_reg_alloc(list,R_0); a_reg_alloc(list,R_0);
list^.concat(new(paicpu,op_reg_reg(A_MFSPR,R_0,R_CR))); list.concat(taicpu.op_reg_reg(A_MFSPR,R_0,R_CR));
list^.concat(new(paicpu,op_reg_ref(A_STW,R_0, list.concat(taicpu.op_reg_ref(A_STW,R_0,
new_reference(stack_pointer,LA_CR)))); new_reference(stack_pointer,LA_CR)));
a_reg_dealloc(list,R_0); a_reg_dealloc(list,R_0);
{ save pointer to incoming arguments } { save pointer to incoming arguments }
list^.concat(new(paicpu,op_reg_reg_const(A_ORI,R_31,STACK_POINTER,0))); list.concat(taicpu.op_reg_reg_const(A_ORI,R_31,STACK_POINTER,0));
a_reg_alloc(list,R_12); a_reg_alloc(list,R_12);
{ 0 or 8 based on SP alignment } { 0 or 8 based on SP alignment }
list^.concat(new(paicpu,op_reg_reg_const_const_const(A_RLWINM, list.concat(taicpu.op_reg_reg_const_const_const(A_RLWINM,
R_12,STACK_POINTER,0,28,28))); R_12,STACK_POINTER,0,28,28));
{ add in stack length } { add in stack length }
list^.concat(new(paicpu,op_reg_reg_const(A_SUBFIC,R_12,R_12, list.concat(taicpu.op_reg_reg_const(A_SUBFIC,R_12,R_12,
-localsize))); -localsize));
{ establish new alignment } { establish new alignment }
list^.concat(new(paicpu,op_reg_reg_reg(A_STWUX,STACK_POINTER,STACK_POINTER,R_12))); list.concat(taicpu.op_reg_reg_reg(A_STWUX,STACK_POINTER,STACK_POINTER,R_12));
a_reg_dealloc(list,R_12); a_reg_dealloc(list,R_12);
{ now comes the AltiVec context save, not yet implemented !!! } { now comes the AltiVec context save, not yet implemented !!! }
end; end;
procedure tcgppc.g_restore_frame_pointer(list : paasmoutput); procedure tcgppc.g_restore_frame_pointer(list : taasmoutput);
begin begin
{ no frame pointer on the PowerPC (maybe there is one in the SystemV ABI?)} { no frame pointer on the PowerPC (maybe there is one in the SystemV ABI?)}
end; end;
procedure tcgppc.g_return_from_proc(list : paasmoutput;parasize : aword); procedure tcgppc.g_return_from_proc(list : taasmoutput;parasize : aword);
begin begin
case target_os.id of case target_os.id of
os_powerpc_macos: os_powerpc_macos:
@ -508,7 +576,7 @@ const
end; end;
procedure tcgppc.g_return_from_proc_sysv(list : paasmoutput;parasize : aword); procedure tcgppc.g_return_from_proc_sysv(list : taasmoutput;parasize : aword);
var regcounter: TRegister; var regcounter: TRegister;
@ -519,16 +587,16 @@ const
{ AltiVec context restore, not yet implemented !!! } { AltiVec context restore, not yet implemented !!! }
{ address of gpr save area to r11 } { address of gpr save area to r11 }
list^.concat(new(paicpu,op_reg_reg_const(A_ADDI,R_11,R_31,-144))); list.concat(taicpu.op_reg_reg_const(A_ADDI,R_11,R_31,-144));
{ restore gprs } { restore gprs }
list^.concat(new(paicpu,op_sym_ofs(A_BL,newasmsymbol('_restgpr_14'),0))); list.concat(taicpu.op_sym_ofs(A_BL,newasmsymbol('_restgpr_14'),0));
{ address of fpr save area to r11 } { address of fpr save area to r11 }
list^.concat(new(paicpu,op_reg_reg_const(A_ADDI,R_11,R_11,144))); list.concat(taicpu.op_reg_reg_const(A_ADDI,R_11,R_11,144));
{ restore fprs and return } { restore fprs and return }
list^.concat(new(paicpu,op_sym_ofs(A_BL,newasmsymbol('_restfpr_14_x'),0))); list.concat(taicpu.op_sym_ofs(A_BL,newasmsymbol('_restfpr_14_x'),0));
end; end;
procedure tcgppc.g_return_from_proc_mac(list : paasmoutput;parasize : aword); procedure tcgppc.g_return_from_proc_mac(list : taasmoutput;parasize : aword);
var regcounter: TRegister; var regcounter: TRegister;
@ -539,16 +607,16 @@ const
{ AltiVec context restore, not yet implemented !!! } { AltiVec context restore, not yet implemented !!! }
{ restore SP } { restore SP }
list^.concat(new(paicpu,op_reg_reg_const(A_ORI,STACK_POINTER,R_31,0))); list.concat(taicpu.op_reg_reg_const(A_ORI,STACK_POINTER,R_31,0));
{ restore gprs } { restore gprs }
list^.concat(new(paicpu,op_reg_ref(A_LMW,R_13,new_reference(STACK_POINTER,-220)))); list.concat(taicpu.op_reg_ref(A_LMW,R_13,new_reference(STACK_POINTER,-220)));
{ restore return address ... } { restore return address ... }
list^.concat(new(paicpu,op_reg_ref(A_LWZ,R_0,new_reference(STACK_POINTER,8)))); list.concat(taicpu.op_reg_ref(A_LWZ,R_0,new_reference(STACK_POINTER,8)));
{ ... and return from _restf14 } { ... and return from _restf14 }
list^.concat(new(paicpu,op_sym_ofs(A_B,newasmsymbol('_restf14'),0))); list.concat(taicpu.op_sym_ofs(A_B,newasmsymbol('_restf14'),0));
end; end;
procedure tcgppc.a_loadaddress_ref_reg(list : paasmoutput;const ref2 : treference;r : tregister); procedure tcgppc.a_loadaddress_ref_reg(list : taasmoutput;const ref2 : treference;r : tregister);
var tmpreg: tregister; var tmpreg: tregister;
ref, tmpref: treference; ref, tmpref: treference;
@ -566,17 +634,17 @@ const
tmpref.symaddr := refs_ha; tmpref.symaddr := refs_ha;
tmpref.is_immediate := true; tmpref.is_immediate := true;
if ref.base <> R_NO then if ref.base <> R_NO then
list^.concat(new(paicpu,op_reg_reg_ref(A_ADDIS,tmpreg, list.concat(taicpu.op_reg_reg_ref(A_ADDIS,tmpreg,
ref.base,newreference(tmpref)))) ref.base,newreference(tmpref)))
else else
list^.concat(new(paicpu,op_reg_ref(A_LIS,tmpreg, list.concat(taicpu.op_reg_ref(A_LIS,tmpreg,
newreference(tmpref)))); newreference(tmpref)));
ref.base := tmpreg; ref.base := tmpreg;
ref.symaddr := refs_l; ref.symaddr := refs_l;
{ can be folded with one of the next instructions by the } { can be folded with one of the next instructions by the }
{ optimizer probably } { optimizer probably }
list^.concat(new(paicpu,op_reg_reg_ref(A_ADDI,tmpreg,tmpreg, list.concat(taicpu.op_reg_reg_ref(A_ADDI,tmpreg,tmpreg,
newreference(tmpref)))); newreference(tmpref)));
end; end;
if ref.offset <> 0 Then if ref.offset <> 0 Then
if ref.base <> R_NO then if ref.base <> R_NO then
@ -586,8 +654,8 @@ const
else a_load_const_reg(list, OS_32, ref.offset, r) else a_load_const_reg(list, OS_32, ref.offset, r)
else else
if ref.index <> R_NO Then if ref.index <> R_NO Then
list^.concat(new(paicpu,op_reg_reg_reg(A_ADD,r,ref.base,ref.index))) list.concat(taicpu.op_reg_reg_reg(A_ADD,r,ref.base,ref.index))
else list^.concat(new(paicpu,op_reg_reg(A_MR,r,ref.base))); else list.concat(taicpu.op_reg_reg(A_MR,r,ref.base));
if assigned(ref.symbol) then if assigned(ref.symbol) then
free_scratch_reg(list,tmpreg); free_scratch_reg(list,tmpreg);
end; end;
@ -595,7 +663,7 @@ const
{ ************* concatcopy ************ } { ************* concatcopy ************ }
procedure tcgppc.g_concatcopy(list : paasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean); procedure tcgppc.g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean);
var var
p: paicpu; p: paicpu;
@ -641,11 +709,11 @@ const
a_reg_alloc(list,R_0); a_reg_alloc(list,R_0);
getlabel(lab); getlabel(lab);
a_label(list, lab); a_label(list, lab);
list^.concat(new(paicpu,op_reg_ref(A_LWZU,tempreg, list.concat(taicpu.op_reg_ref(A_LWZU,tempreg,
newreference(src)))); newreference(src)));
a_op_reg_reg_const32(list,A_CMPI,A_NONE,R_CR0,countreg,0); a_op_reg_reg_const32(list,A_CMPI,A_NONE,R_CR0,countreg,0);
list^.concat(new(paicpu,op_reg_ref(A_STWU,tempreg, list.concat(taicpu.op_reg_ref(A_STWU,tempreg,
newreference(dst)))); newreference(dst)));
a_op_reg_reg_const32(list,A_SUBI,A_NONE,countreg,countreg,1); a_op_reg_reg_const32(list,A_SUBI,A_NONE,countreg,countreg,1);
a_jmp(list,A_BC,CF_NE,lab); a_jmp(list,A_BC,CF_NE,lab);
free_scratch_reg(list,countreg); free_scratch_reg(list,countreg);
@ -698,17 +766,17 @@ const
end end
end; end;
procedure tcgppc.a_op_reg_reg_const32(list: paasmoutput; oplo, ophi: procedure tcgppc.a_op_reg_reg_const32(list: taasmoutput; oplo, ophi:
tasmop; reg1, reg2: tregister; a: aword); tasmop; reg1, reg2: tregister; a: aword);
begin begin
if (a and $ffff) <> 0 Then if (a and $ffff) <> 0 Then
list^.concat(new(paicpu,op_reg_reg_const(OpLo,reg1,reg2,a and $ffff))); list.concat(taicpu.op_reg_reg_const(OpLo,reg1,reg2,a and $ffff));
If (a shr 16) <> 0 Then If (a shr 16) <> 0 Then
list^.concat(new(paicpu,op_reg_reg_const(OpHi,reg1,reg1,a shr 16))) list.concat(taicpu.op_reg_reg_const(OpHi,reg1,reg1,a shr 16))
end; end;
procedure tcgppc.a_load_store(list:paasmoutput;op: tasmop;reg:tregister; procedure tcgppc.a_load_store(list:taasmoutput;op: tasmop;reg:tregister;
var ref: treference); var ref: treference);
var tmpreg: tregister; var tmpreg: tregister;
@ -723,32 +791,40 @@ const
tmpref.symaddr := refs_ha; tmpref.symaddr := refs_ha;
tmpref.is_immediate := true; tmpref.is_immediate := true;
if ref.base <> R_NO then if ref.base <> R_NO then
list^.concat(new(paicpu,op_reg_reg_ref(A_ADDIS,tmpreg, list.concat(taicpu.op_reg_reg_ref(A_ADDIS,tmpreg,
ref.base,newreference(tmpref)))) ref.base,newreference(tmpref)))
else else
list^.concat(new(paicpu,op_reg_ref(A_LIS,tmpreg, list.concat(taicpu.op_reg_ref(A_LIS,tmpreg,
newreference(tmpref)))); newreference(tmpref)));
ref.base := tmpreg; ref.base := tmpreg;
ref.symaddr := refs_l; ref.symaddr := refs_l;
end; end;
list^.concat(new(paicpu,op_reg_ref(op,reg,newreference(ref)))); list.concat(taicpu.op_reg_ref(op,reg,newreference(ref)));
if assigned(ref.symbol) then if assigned(ref.symbol) then
free_scratch_reg(list,tmpreg); free_scratch_reg(list,tmpreg);
end; end;
procedure tcgppc.a_jmp(list: paasmoutput; op: tasmop; c: tasmcondflags; procedure tcgppc.a_jmp(list: taasmoutput; op: tasmop; c: tasmcondflags;
l: pasmlabel); l: pasmlabel);
var p: paicpu; var p: paicpu;
begin begin
p := new(paicpu,op_sym(op,newasmsymbol(l^.name))); p := taicpu.op_sym(op,newasmsymbol(l^.name));
create_cond_norm(c,0,p^.condition); create_cond_norm(c,0,p^.condition);
list^.concat(p) list.concat(p)
end; end;
end. end.
{ {
$Log$ $Log$
Revision 1.2 2001-09-05 20:21:03 jonas 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" * new cgflow based on n386flw with all nodes until forn "translated"
+ a_cmp_loc_*_label methods for tcg + a_cmp_loc_*_label methods for tcg
+ base implementatino for a_cmp_ref_*_label methods + base implementatino for a_cmp_ref_*_label methods

41
compiler/powerpc/cpubase.pas
View File

@ -226,20 +226,22 @@ type
C_None: (); C_None: ();
{ specifies in which part of the cr the bit has to be } { specifies in which part of the cr the bit has to be }
{ tested for blt,bgt,beq etc. } { tested for blt,bgt,beq etc. }
C_LT,C_LE,C_EQ,C_GE,C_GT,C_NL,C_NE,C_NG,C_SO, C_LT..C_NU: (cr: R_CR0..R_CR7);
C_NS,C_UN,C_NU: (cr: R_CR0..R_CR7);
{ specifies the bit to test for bt,bf,bdz etc. } { specifies the bit to test for bt,bf,bdz etc. }
C_T,C_F,C_DNZ,C_DNZT,C_DNZF,C_DZ,C_DZT,C_DZF: C_T..C_DZF:
(crbit: byte) (crbit: byte)
); );
end; end;
const const
{ AsmCondFlag2BO: Array[TAsmCondFlags] of Byte = AsmCondFlag2BO: Array[C_T..C_DZF] of Byte =
(0,12,4,12,4,12,4,4,4,12,4,12,4, (12,4,16,8,0,18,10,2);
); AsmCondFlag2BI: Array[C_LR..C_NU] of Byte =
AsmCondFlag2BI: Array[TAsmCondFlags] of Byte = (0,1,2,0,1,0,2,1,3,3,3,3);
(0,0,1,2,0,1,0,2,1,3,3,3,3);} AsmCondFlagTF: Array[TAsmCondFlags] of Boolean =
(false,true,false,true,false,true,false,false,false,true,false,true,false,
true,false,false,true,false,false,true,false);
AsmCondFlag2Str: Array[tasmcondflags] of string[2] = ({cf_none}'', AsmCondFlag2Str: Array[tasmcondflags] of string[2] = ({cf_none}'',
{ conditions when not using ctr decrement etc} { conditions when not using ctr decrement etc}
@ -394,12 +396,13 @@ const
registers_saved_on_cdecl = [R_13..R_29]; registers_saved_on_cdecl = [R_13..R_29];
{ generic register names } { generic register names }
stack_pointer = R_1; stack_pointer = R_1;
R_RTOC = R_2; R_RTOC = R_2;
frame_pointer = stack_pointer; frame_pointer = stack_pointer;
self_pointer = R_9; self_pointer = R_9;
accumulator = R_3; accumulator = R_3;
vmt_offset_reg = R_0; accumulatorhigh = R_4;
vmt_offset_reg = R_0;
max_scratch_regs = 3; max_scratch_regs = 3;
scratch_regs: Array[1..max_scratch_regs] of TRegister = (R_11,R_12,R_30); scratch_regs: Array[1..max_scratch_regs] of TRegister = (R_11,R_12,R_30);
@ -599,7 +602,15 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.2 2001-08-26 13:31:04 florian Revision 1.3 2001-09-06 15:25:56 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/08/26 13:31:04 florian
* some cg reorganisation * some cg reorganisation
* some PPC updates * some PPC updates