paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 04:39:28 +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;
{$endif ia64}
function inverse_opcmp(opcmp: topcmp): topcmp;
function commutativeop(op: topcg): boolean;
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.
{
$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
* some changes for widestrings
Revision 1.1 2000/07/13 06:30:07 michael
+ 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));
end
else
cgcpu.concatcopy(exprasmlist,right.location.reference,temp1,
cgcpu.g_concatcopy(exprasmlist,right.location.reference,temp1,
hs,false,false);
end
else
@ -385,8 +385,8 @@ implementation
otlabel,oflabel : tasmlabel;
r : preference;
is_mem,
allocated_eax,
allocated_edx: boolean;
allocated_acc,
allocated_acchigh: boolean;
procedure cleanleft;
begin
@ -413,12 +413,12 @@ implementation
begin
{ just do a normal assignment followed by exit }
secondpass(left);
emitjmp(C_None,aktexitlabel);
cgcpu.a_jmp_cond(exprasmlist,C_None,aktexitlabel);
end
else
begin
allocated_eax := false;
allocated_edx := false;
allocated_acc := false;
allocated_acchigh := false;
otlabel:=truelabel;
oflabel:=falselabel;
getlabel(truelabel);
@ -431,19 +431,19 @@ implementation
LOC_CREGISTER,
LOC_REGISTER : is_mem:=false;
LOC_FLAGS : begin
exprasmlist.concat(tairegalloc.alloc(R_EAX));
allocated_eax := true;
emit_flag2reg(left.location.resflags,R_AL);
exprasmlist.concat(tairegalloc.alloc(accumulator));
allocated_acc := true;
cgcpu.g_flag2reg(left.location.resflags,accumulator);
goto do_jmp;
end;
LOC_JUMP : begin
exprasmlist.concat(tairegalloc.alloc(R_EAX));
allocated_eax := true;
emitlab(truelabel);
emit_const_reg(A_MOV,S_B,1,R_AL);
emitjmp(C_None,aktexit2label);
emitlab(falselabel);
emit_reg_reg(A_XOR,S_B,R_AL,R_AL);
exprasmlist.concat(tairegalloc.alloc(accumulator));
allocated_acc := true;
cgcpu.a_label(exprasmlist,truelabel);
cgcpu.a_load_const_reg(exprasmlist,OS_8,1,acc);
cgcpu.a_jmp_cond(exprasmlist,C_None,aktexit2label);
cgcpu.a_label(exprasmlist,falselabel);
cgcpu.a_load_const_reg(exprasmlist,OS_8,0,acc);
goto do_jmp;
end;
else
@ -453,14 +453,14 @@ implementation
pointerdef,
procvardef : begin
cleanleft;
exprasmlist.concat(tairegalloc.alloc(R_EAX));
allocated_eax := true;
exprasmlist.concat(tairegalloc.alloc(accumulator));
allocated_acc := true;
if is_mem then
emit_ref_reg(A_MOV,S_L,
newreference(left.location.reference),R_EAX)
cgcpu.a_load_ref_reg(exprasmlist,OS_ADDR,
left.location.reference,accumulator)
else
emit_reg_reg(A_MOV,S_L,
left.location.register,R_EAX);
gcpu.a_load_reg_reg(exprasmlist,A_MOV,OS_ADDR,
left.location.register,accumulator);
end;
floatdef : begin
cleanleft;
@ -1273,9 +1273,17 @@ begin
end.
{
$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"
+ a_cmp_loc_*_label methods for tcg
+ a_cmp_*_loc_label methods for tcg
+ base implementatino for a_cmp_ref_*_label methods
* small bugfixes to powerpc cg

561
compiler/new/cgobj.pas
View File

@ -32,28 +32,26 @@ unit cgobj;
type
talignment = (AM_NATURAL,AM_NONE,AM_2BYTE,AM_4BYTE,AM_8BYTE);
pcg = ^tcg;
tcg = object
tcg = class
scratch_register_array_pointer : aword;
unusedscratchregisters : tregisterset;
alignment : talignment;
{************************************************}
{ basic routines }
constructor init;
destructor done;virtual;
constructor create;
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 }
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}
procedure a_reg_dealloc(list : paasmoutput;r : tregister);
procedure a_reg_dealloc(list : taasmoutput;r : tregister);
{ 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 }
procedure free_scratch_reg(list : paasmoutput;r : tregister);
procedure free_scratch_reg(list : taasmoutput;r : tregister);
{************************************************}
{ code generation for subroutine entry/exit code }
@ -61,42 +59,42 @@ unit cgobj;
{ initilizes data of type t }
{ if is_already_ref is true then the routines assumes }
{ 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 }
{ if is_already_ref is true then the routines assumes }
{ 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 }
procedure g_initialize_data(list : paasmoutput;p : psym);
procedure g_incr_data(list : paasmoutput;p : psym);
procedure g_finalize_data(list : paasmoutput;p : pnamedindexobject);
procedure g_copyvalueparas(list : paasmoutput;p : pnamedindexobject);
procedure g_finalizetempansistrings(list : paasmoutput);
procedure g_initialize_data(list : taasmoutput;p : psym);
procedure g_incr_data(list : taasmoutput;p : psym);
procedure g_finalize_data(list : taasmoutput;p : pnamedindexobject);
procedure g_copyvalueparas(list : taasmoutput;p : pnamedindexobject);
procedure g_finalizetempansistrings(list : taasmoutput);
procedure g_entrycode(list : paasmoutput;
procedure g_entrycode(list : taasmoutput;
const proc_names : tstringcontainer;make_global : boolean;
stackframe : longint;var parasize : longint;
var nostackframe : boolean;inlined : boolean);
procedure g_exitcode(list : paasmoutput;parasize : longint;
procedure g_exitcode(list : taasmoutput;parasize : longint;
nostackframe,inlined : boolean);
{ 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 }
{ 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 : paasmoutput;size : tcgsize;r : tregister;nr : longint);virtual;
procedure a_param_const(list : paasmoutput;size : tcgsize;a : aword;nr : longint);virtual;
procedure a_param_ref(list : paasmoutput;size : tcgsize;const r : treference;nr : longint);virtual;
procedure a_paramaddr_ref(list : paasmoutput;const r : treference;nr : longint);virtual;
procedure a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;nr : longint);virtual; abstract;
procedure a_param_const(list : taasmoutput;size : tcgsize;a : aword;nr : longint);virtual;
procedure a_param_ref(list : taasmoutput;size : tcgsize;const r : treference;nr : longint);virtual;
procedure a_paramaddr_ref(list : taasmoutput;const r : treference;nr : longint);virtual;
{**********************************}
{ these methods must be overriden: }
@ -118,63 +116,81 @@ unit cgobj;
second the destination
}
procedure a_call_name(list : paasmoutput;const s : string;
procedure a_call_name(list : taasmoutput;const s : string;
offset : longint);virtual;
{ move instructions }
procedure a_load_const_reg(list : paasmoutput;size : tcgsize;a : aword;register : tregister);virtual;
procedure a_load_const_ref(list : paasmoutput;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_ref_reg(list : paasmoutput;size : tcgsize;const ref : treference;register : tregister);virtual;
procedure a_load_reg_reg(list : paasmoutput;size : tcgsize;reg1,reg2 : tregister);virtual;
procedure a_load_const_reg(list : taasmoutput;size : tcgsize;a : aword;register : tregister);virtual; abstract;
procedure a_load_const_ref(list : taasmoutput;size : tcgsize;a : aword;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 : taasmoutput;size : tcgsize;const ref : treference;register : tregister);virtual; abstract;
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 }
procedure a_cmp_const_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
l : pasmlabel);virtual;
procedure a_cmp_reg_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : pasmlabel); virtual;
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;
procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
l : pasmlabel);virtual; abstract;
procedure a_cmp_const_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;const ref : treference;
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;
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_stackframe_entry(list : paasmoutput;localsize : longint);virtual;
procedure g_flags2reg(list: taasmoutput; const f: TAsmCond; reg: TRegister); abstract;
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 }
{ 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 }
{ a procedure, so we need to maintain an extra stack for the }
{ result values of setjmp in exception code }
{ this two procedures are for pushing an exception value, }
{ they can use the scratch registers }
procedure g_push_exception_value_reg(list : paasmoutput;reg : tregister);virtual;
procedure g_push_exception_value_const(list : paasmoutput;reg : tregister);virtual;
procedure g_push_exception_value_reg(list : taasmoutput;reg : tregister);virtual; abstract;
procedure g_push_exception_value_const(list : taasmoutput;reg : tregister);virtual; abstract;
{ that procedure pops a exception value }
procedure g_pop_exception_value_reg(list : paasmoutput;reg : tregister);virtual;
procedure g_return_from_proc(list : paasmoutput;parasize : aword);virtual;
procedure g_pop_exception_value_reg(list : taasmoutput;reg : tregister);virtual; abstract;
procedure g_return_from_proc(list : taasmoutput;parasize : aword);virtual; abstract;
{********************************************************}
{ these methods can be overriden for extra functionality }
{ the following methods do nothing: }
procedure g_interrupt_stackframe_entry(list : paasmoutput);virtual;
procedure g_interrupt_stackframe_exit(list : paasmoutput);virtual;
procedure g_interrupt_stackframe_entry(list : taasmoutput);virtual;
procedure g_interrupt_stackframe_exit(list : taasmoutput);virtual;
procedure g_profilecode(list : paasmoutput);virtual;
procedure g_stackcheck(list : paasmoutput;stackframesize : longint);virtual;
procedure g_profilecode(list : taasmoutput);virtual; abstract;
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 }
{ loadref is true, it assumes that it first must load }
{ the source address from the memory location where }
{ 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 }
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;
var
@ -193,7 +209,7 @@ unit cgobj;
basic functionallity
******************************************************************************}
constructor tcg.init;
constructor tcg.create;
var
i : longint;
@ -204,30 +220,25 @@ unit cgobj;
include(unusedscratchregisters,scratch_regs[i]);
end;
destructor tcg.done;
begin
end;
procedure tcg.a_reg_alloc(list : paasmoutput;r : tregister);
procedure tcg.a_reg_alloc(list : taasmoutput;r : tregister);
begin
list^.concat(new(pairegalloc,alloc(r)));
end;
procedure tcg.a_reg_dealloc(list : paasmoutput;r : tregister);
procedure tcg.a_reg_dealloc(list : taasmoutput;r : tregister);
begin
list^.concat(new(pairegalloc,dealloc(r)));
end;
procedure tcg.a_label(list : paasmoutput;l : pasmlabel);
procedure tcg.a_label(list : taasmoutput;l : pasmlabel);
begin
list^.concat(new(pai_label,init(l)));
end;
function tcg.get_scratch_reg(list : paasmoutput) : tregister;
function tcg.get_scratch_reg(list : taasmoutput) : tregister;
var
r : tregister;
@ -252,7 +263,7 @@ unit cgobj;
get_scratch_reg:=r;
end;
procedure tcg.free_scratch_reg(list : paasmoutput;r : tregister);
procedure tcg.free_scratch_reg(list : taasmoutput;r : tregister);
begin
include(unusedscratchregisters,r);
@ -263,17 +274,17 @@ unit cgobj;
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
end;
procedure tcg.g_interrupt_stackframe_exit(list : paasmoutput);
procedure tcg.g_interrupt_stackframe_exit(list : taasmoutput);
begin
end;
procedure tcg.g_profilecode(list : paasmoutput);
procedure tcg.g_profilecode(list : taasmoutput);
begin
end;
@ -282,7 +293,7 @@ unit cgobj;
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
hr : tregister;
@ -294,7 +305,7 @@ unit cgobj;
free_scratch_reg(list,hr);
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
hr : tregister;
@ -306,7 +317,7 @@ unit cgobj;
free_scratch_reg(list,hr);
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
hr : tregister;
@ -318,14 +329,14 @@ unit cgobj;
free_scratch_reg(list,hr);
end;
procedure tcg.g_stackcheck(list : paasmoutput;stackframesize : longint);
procedure tcg.g_stackcheck(list : taasmoutput;stackframesize : longint);
begin
a_param_const(list,OS_32,stackframesize,1);
a_call_name(list,'FPC_STACKCHECK',0);
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
hr : tregister;
@ -338,18 +349,12 @@ unit cgobj;
end;
procedure tcg.g_concatcopy(list : paasmoutput;const source,dest : treference;len : aword;loadref : boolean);
begin
abstract;
end;
{*****************************************************************************
String helper routines
*****************************************************************************}
procedure tcg.g_removetemps(list : paasmoutput;p : plinkedlist);
procedure tcg.g_removetemps(list : taasmoutput;p : plinkedlist);
var
hp : ptemptodestroy;
@ -372,7 +377,7 @@ unit cgobj;
tg.popusedregisters(pushedregs);
end;
procedure tcg.g_decrstrref(list : paasmoutput;const ref : treference;t : pdef);
procedure tcg.g_decrstrref(list : taasmoutput;const ref : treference;t : pdef);
var
pushedregs : tpushed;
@ -395,7 +400,7 @@ unit cgobj;
{ initilizes data of type t }
{ if is_already_ref is true then the routines assumes }
{ 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
hr : treference;
@ -417,7 +422,7 @@ unit cgobj;
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
r : treference;
@ -442,7 +447,7 @@ unit cgobj;
end;
{ 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
hr : treference;
@ -493,7 +498,7 @@ unit cgobj;
{ 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
hr : treference;
@ -540,7 +545,7 @@ unit cgobj;
{ 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
hr : treference;
@ -611,13 +616,13 @@ unit cgobj;
{ 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
runerror(255);
end;
var
_list : paasmoutput;
_list : taasmoutput;
{ wrappers for the methods, because TP doesn't know procedures }
{ of objects }
@ -630,7 +635,7 @@ unit cgobj;
end;
{$ENDIF NEWST}
procedure tcg.g_finalizetempansistrings(list : paasmoutput);
procedure tcg.g_finalizetempansistrings(list : taasmoutput);
var
hp : ptemprecord;
@ -691,7 +696,7 @@ unit cgobj;
{$ENDIF NEWST}
{ 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;
inlined : boolean);
@ -950,7 +955,7 @@ unit cgobj;
{$endif GDB}
end;
procedure tcg.g_exitcode(list : paasmoutput;parasize:longint;nostackframe,inlined:boolean);
procedure tcg.g_exitcode(list : taasmoutput;parasize:longint;nostackframe,inlined:boolean);
var
{$ifdef GDB}
@ -1193,112 +1198,112 @@ unit cgobj;
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
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;
procedure tcg.g_stackframe_entry(list : paasmoutput;localsize : longint);
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);
procedure tcg.a_op_const_ref(list : taasmoutput; Op: TOpCG; size: TCGSize; a: AWord; const ref: TReference);
var
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);
a_op_const_reg(list,op,size,a,tmpreg);
a_load_reg_ref(list,size,tmpreg,ref);
free_scratch_reg(tmpreg);
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);
var
@ -1311,65 +1316,67 @@ unit cgobj;
free_scratch_reg(tmpreg);
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);
begin
case loc.loc of
LOC_REGISTER,LOC_CREGISTER:
!!!!!! 64bit locations -> two registers!!
a_cmp_const_reg_label(list,size,cmp_op,a,loc.register,l);
LOC_REFERENCE,LOC_MEM:
a_cmp_const_ref_label(list,size,cmp_op,a,loc.reference,l);
else
internalerror(200109061);
end;
end;
procedure tcg.a_cmp_ref_loc_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;const ref: treference;const loc : tlocation;
l : pasmlabel);
procedure tcg.a_cmp_ref_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp; const ref: treference; reg : tregister; l : pasmlabel);
var
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
case loc.loc of
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:
begin
tmpreg := get_scratch_reg(list);
a_load_ref_reg(size,location.reference,tmpreg);
a_cmp_ref_reg(list,size,cmp_op,ref,tmpreg,l);
a_load_ref_reg(size,reftmpreg);
a_cmp_reg_ref(list,size,cmp_op,tmpreg,location.reference,l);
free_scratch_reg(list,tmpreg);
end;
else
internalerror(200109061);
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.
{
$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"
+ a_cmp_loc_*_label methods for tcg
+ base implementatino for a_cmp_ref_*_label methods
@ -1382,134 +1389,4 @@ end.
Revision 1.1 2000/07/13 06:30:07 michael
+ 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 }
{ register, if the cpu supports register calling }
{ conventions }
procedure a_param_reg(list : paasmoutput;size : tcgsize;r : tregister;nr : longint);virtual;
procedure a_param_const(list : paasmoutput;size : tcgsize;a : aword;nr : longint);virtual;
procedure a_param_ref(list : paasmoutput;size : tcgsize;const r : treference;nr : longint);virtual;
procedure a_paramaddr_ref(list : paasmoutput;const r : treference;nr : longint);virtual;
procedure a_param_reg(list : taasmoutput;size : tcgsize;r : tregister;nr : longint);virtual;
procedure a_param_const(list : taasmoutput;size : tcgsize;a : aword;nr : longint);virtual;
procedure a_param_ref(list : taasmoutput;size : tcgsize;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;
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 }
procedure a_load_const_reg(list : paasmoutput; 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_ref_reg(list : paasmoutput;size : tcgsize;const Ref2 : treference;reg : tregister);virtual;
procedure a_load_reg_reg(list : paasmoutput;size : tcgsize;reg1,reg2 : tregister);virtual;
procedure a_load_const_reg(list : taasmoutput; size: tcgsize; a : aword;reg : tregister);virtual;
procedure a_load_reg_ref(list : taasmoutput; size: tcgsize; reg : tregister;const ref2 : treference);virtual;
procedure a_load_ref_reg(list : taasmoutput;size : tcgsize;const Ref2 : treference;reg : tregister);virtual;
procedure a_load_reg_reg(list : taasmoutput;size : tcgsize;reg1,reg2 : tregister);virtual;
{ 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;
procedure a_cmp_reg_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : pasmlabel);
procedure a_jmp_cond(list : paasmoutput;cond : TOpCmp;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 : 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_mac(list : paasmoutput;localsize : longint);
procedure g_stackframe_entry(list : paasmoutput;localsize : longint);virtual;
procedure g_restore_frame_pointer(list : paasmoutput);virtual;
procedure g_return_from_proc(list : paasmoutput;parasize : aword); virtual;
procedure g_return_from_proc_sysv(list : paasmoutput;parasize : aword);
procedure g_return_from_proc_mac(list : paasmoutput;parasize : aword);
procedure g_stackframe_entry_sysv(list : taasmoutput;localsize : longint);
procedure g_stackframe_entry_mac(list : taasmoutput;localsize : longint);
procedure g_stackframe_entry(list : taasmoutput;localsize : longint);virtual;
procedure g_restore_frame_pointer(list : taasmoutput);virtual;
procedure g_return_from_proc(list : taasmoutput;parasize : aword); virtual;
procedure g_return_from_proc_sysv(list : taasmoutput;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
@ -79,19 +82,19 @@ unit cgcpu;
{ OpLo reg1, reg2, (a and $ffff) and/or }
{ OpHi reg1, reg2, (a shr 16) }
{ 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);
{ Make sure ref is a valid reference for the PowerPC and sets the }
{ base to the value of the index if (base = R_NO). }
procedure fixref(var ref: treference);
{ 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);
{ creates the correct branch instruction for a given combination }
{ of asmcondflags and destination addressing mode }
procedure a_jmp(list: paasmoutput; op: tasmop;
procedure a_jmp(list: taasmoutput; op: tasmop;
c: tasmcondflags; l: pasmlabel);
end;
@ -128,7 +131,7 @@ const
{ parameter passing... Still needs extra support from the processor }
{ 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;
@ -147,7 +150,7 @@ const
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;
@ -166,7 +169,7 @@ const
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;
tmpreg: tregister;
@ -189,7 +192,7 @@ const
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;
tmpreg: tregister;
@ -213,36 +216,36 @@ const
{ 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);
begin
{ save our RTOC register value. Only necessary when doing pointer based }
{ calls or cross TOC calls, but currently done always }
list^.concat(new(paicpu,op_reg_ref(A_STW,R_RTOC,
new_reference(stack_pointer,LA_RTOC))));
list^.concat(new(paicpu,op_sym(A_BL,newasmsymbol(s))));
list^.concat(new(paicpu,op_reg_ref(A_LWZ,R_RTOC,
new_reference(stack_pointer,LA_RTOC))));
list.concat(taicpu.op_reg_ref(A_STW,R_RTOC,
new_reference(stack_pointer,LA_RTOC)));
list.concat(taicpu.op_sym(A_BL,newasmsymbol(s)));
list.concat(taicpu.op_reg_ref(A_LWZ,R_RTOC,
new_reference(stack_pointer,LA_RTOC)));
end;
{********************** 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
If (a and $ffff) <> 0 Then
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
list^.concat(new(paicpu,op_reg_const(A_ADDIS,reg,
(a shr 16)+ord(smallint(a and $ffff) < 0))))
list.concat(taicpu.op_reg_const(A_ADDIS,reg,
(a shr 16)+ord(smallint(a and $ffff) < 0)))
End
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;
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
op: TAsmOp;
@ -255,7 +258,7 @@ const
a_load_store(list,op,reg,ref);
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
op: TAsmOp;
@ -269,13 +272,13 @@ const
a_load_store(list,op,reg,ref);
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
list^.concat(new(paicpu,op_reg_reg(A_MR,reg2,reg1)));
list.concat(taicpu.op_reg_reg(A_MR,reg2,reg1));
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;
@ -284,13 +287,13 @@ const
OP_DIV, OP_IDIV, OP_IMUL, OP_MUL:
If (Op = OP_IMUL) And (longint(a) >= -32768) And
(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
Begin
scratch_register := get_scratch_reg(list);
a_load_const_reg(list, OS_32, a, scratch_register);
list^.concat(new(paicpu,op_reg_reg_reg(TOpCG2AsmOpLo[Op],
reg,reg,scratch_register)));
list.concat(taicpu.op_reg_reg_reg(TOpCG2AsmOpLo[Op],
reg,reg,scratch_register));
free_scratch_reg(list,scratch_register);
End;
OP_ADD, OP_AND, OP_OR, OP_SUB,OP_XOR:
@ -299,8 +302,8 @@ const
OP_SHL,OP_SHR,OP_SAR:
Begin
if (a and 31) <> 0 Then
list^.concat(new(paicpu,op_reg_reg_const(
TOpCG2AsmOpLo[Op],reg,reg,a and 31)));
list.concat(taicpu.op_reg_reg_const(
TOpCG2AsmOpLo[Op],reg,reg,a and 31));
If (a shr 5) <> 0 Then
InternalError(68991);
End
@ -308,10 +311,24 @@ const
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 ****************}
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);
var p: paicpu;
@ -322,29 +339,29 @@ const
signed := cmp_op in [OC_GT,OC_LT,OC_GTE,OC_LTE];
If signed 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
begin
scratch_register := get_scratch_reg(list);
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);
end
else
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
begin
scratch_register := get_scratch_reg(list);
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);
end;
a_jmp(list,A_BC,TOpCmp2AsmCond[cmp_op],l);
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);
var p: paicpu;
@ -354,19 +371,70 @@ const
if cmp_op in [OC_GT,OC_LT,OC_GTE,OC_LTE] then
op := A_CMP
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);
end;
procedure tcgppc.a_jmp_cond(list : paasmoutput;cond : TOpCmp;l: pasmlabel);
procedure tcgppc.a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: pasmlabel);
begin
a_jmp(list,A_BC,TOpCmp2AsmCond[cond],l);
end;
begin
a_jmp(list,A_BC,TOpCmp2AsmCond[cond],l);
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 ************ }
procedure tcgppc.g_stackframe_entry(list : paasmoutput;localsize : longint);
procedure tcgppc.g_stackframe_entry(list : taasmoutput;localsize : longint);
begin
case target_os.id of
os_powerpc_macos:
@ -379,7 +447,7 @@ const
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 }
{ 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 }
@ -398,47 +466,47 @@ const
for regcounter := R_3 to R_10 do
a_reg_alloc(list,regcounter);
{ 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 }
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_alloc(list,R_11);
{ 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);
{ 0 or 8 based on SP alignment }
list^.concat(new(paicpu,op_reg_reg_const_const_const(A_RLWINM,
R_12,STACK_POINTER,0,28,28)));
list.concat(taicpu.op_reg_reg_const_const_const(A_RLWINM,
R_12,STACK_POINTER,0,28,28));
{ add in stack length }
list^.concat(new(paicpu,op_reg_reg_const(A_SUBFIC,R_12,R_12,
-localsize)));
list.concat(taicpu.op_reg_reg_const(A_SUBFIC,R_12,R_12,
-localsize));
{ 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);
{ save floating-point registers }
{ !!! 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 }
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 }
{ !!! 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);
{ 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 ) }
{ still need to find out where this has to be done for SystemV
a_reg_alloc(list,R_0);
list^.concat(new(paicpu,op_reg_reg(A_MFSPR,R_0,R_CR);
list^.concat(new(paicpu,op_reg_ref(A_STW,scratch_register,
new_reference(stack_pointer,LA_CR))));
list.concat(taicpu.op_reg_reg(A_MFSPR,R_0,R_CR);
list.concat(taicpu.op_reg_ref(A_STW,scratch_register,
new_reference(stack_pointer,LA_CR)));
a_reg_dealloc(list,R_0); }
{ 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 !!! }
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 }
{ 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 }
@ -457,45 +525,45 @@ const
for regcounter := R_3 to R_10 do
a_reg_alloc(list,regcounter);
{ 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 }
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);
{ save floating-point registers }
{ !!! 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 }
{ !!! 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 ) }
a_reg_alloc(list,R_0);
list^.concat(new(paicpu,op_reg_reg(A_MFSPR,R_0,R_CR)));
list^.concat(new(paicpu,op_reg_ref(A_STW,R_0,
new_reference(stack_pointer,LA_CR))));
list.concat(taicpu.op_reg_reg(A_MFSPR,R_0,R_CR));
list.concat(taicpu.op_reg_ref(A_STW,R_0,
new_reference(stack_pointer,LA_CR)));
a_reg_dealloc(list,R_0);
{ 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);
{ 0 or 8 based on SP alignment }
list^.concat(new(paicpu,op_reg_reg_const_const_const(A_RLWINM,
R_12,STACK_POINTER,0,28,28)));
list.concat(taicpu.op_reg_reg_const_const_const(A_RLWINM,
R_12,STACK_POINTER,0,28,28));
{ add in stack length }
list^.concat(new(paicpu,op_reg_reg_const(A_SUBFIC,R_12,R_12,
-localsize)));
list.concat(taicpu.op_reg_reg_const(A_SUBFIC,R_12,R_12,
-localsize));
{ 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);
{ now comes the AltiVec context save, not yet implemented !!! }
end;
procedure tcgppc.g_restore_frame_pointer(list : paasmoutput);
procedure tcgppc.g_restore_frame_pointer(list : taasmoutput);
begin
{ no frame pointer on the PowerPC (maybe there is one in the SystemV ABI?)}
end;
procedure tcgppc.g_return_from_proc(list : paasmoutput;parasize : aword);
procedure tcgppc.g_return_from_proc(list : taasmoutput;parasize : aword);
begin
case target_os.id of
os_powerpc_macos:
@ -508,7 +576,7 @@ const
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;
@ -519,16 +587,16 @@ const
{ AltiVec context restore, not yet implemented !!! }
{ 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 }
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 }
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 }
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;
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;
@ -539,16 +607,16 @@ const
{ AltiVec context restore, not yet implemented !!! }
{ 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 }
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 ... }
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 }
list^.concat(new(paicpu,op_sym_ofs(A_B,newasmsymbol('_restf14'),0)));
list.concat(taicpu.op_sym_ofs(A_B,newasmsymbol('_restf14'),0));
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;
ref, tmpref: treference;
@ -566,17 +634,17 @@ const
tmpref.symaddr := refs_ha;
tmpref.is_immediate := true;
if ref.base <> R_NO then
list^.concat(new(paicpu,op_reg_reg_ref(A_ADDIS,tmpreg,
ref.base,newreference(tmpref))))
list.concat(taicpu.op_reg_reg_ref(A_ADDIS,tmpreg,
ref.base,newreference(tmpref)))
else
list^.concat(new(paicpu,op_reg_ref(A_LIS,tmpreg,
newreference(tmpref))));
list.concat(taicpu.op_reg_ref(A_LIS,tmpreg,
newreference(tmpref)));
ref.base := tmpreg;
ref.symaddr := refs_l;
{ can be folded with one of the next instructions by the }
{ optimizer probably }
list^.concat(new(paicpu,op_reg_reg_ref(A_ADDI,tmpreg,tmpreg,
newreference(tmpref))));
list.concat(taicpu.op_reg_reg_ref(A_ADDI,tmpreg,tmpreg,
newreference(tmpref)));
end;
if ref.offset <> 0 Then
if ref.base <> R_NO then
@ -586,8 +654,8 @@ const
else a_load_const_reg(list, OS_32, ref.offset, r)
else
if ref.index <> R_NO Then
list^.concat(new(paicpu,op_reg_reg_reg(A_ADD,r,ref.base,ref.index)))
else list^.concat(new(paicpu,op_reg_reg(A_MR,r,ref.base)));
list.concat(taicpu.op_reg_reg_reg(A_ADD,r,ref.base,ref.index))
else list.concat(taicpu.op_reg_reg(A_MR,r,ref.base));
if assigned(ref.symbol) then
free_scratch_reg(list,tmpreg);
end;
@ -595,7 +663,7 @@ const
{ ************* 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
p: paicpu;
@ -641,11 +709,11 @@ const
a_reg_alloc(list,R_0);
getlabel(lab);
a_label(list, lab);
list^.concat(new(paicpu,op_reg_ref(A_LWZU,tempreg,
newreference(src))));
list.concat(taicpu.op_reg_ref(A_LWZU,tempreg,
newreference(src)));
a_op_reg_reg_const32(list,A_CMPI,A_NONE,R_CR0,countreg,0);
list^.concat(new(paicpu,op_reg_ref(A_STWU,tempreg,
newreference(dst))));
list.concat(taicpu.op_reg_ref(A_STWU,tempreg,
newreference(dst)));
a_op_reg_reg_const32(list,A_SUBI,A_NONE,countreg,countreg,1);
a_jmp(list,A_BC,CF_NE,lab);
free_scratch_reg(list,countreg);
@ -698,17 +766,17 @@ const
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);
begin
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
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;
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 tmpreg: tregister;
@ -723,32 +791,40 @@ const
tmpref.symaddr := refs_ha;
tmpref.is_immediate := true;
if ref.base <> R_NO then
list^.concat(new(paicpu,op_reg_reg_ref(A_ADDIS,tmpreg,
ref.base,newreference(tmpref))))
list.concat(taicpu.op_reg_reg_ref(A_ADDIS,tmpreg,
ref.base,newreference(tmpref)))
else
list^.concat(new(paicpu,op_reg_ref(A_LIS,tmpreg,
newreference(tmpref))));
list.concat(taicpu.op_reg_ref(A_LIS,tmpreg,
newreference(tmpref)));
ref.base := tmpreg;
ref.symaddr := refs_l;
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
free_scratch_reg(list,tmpreg);
end;
procedure tcgppc.a_jmp(list: paasmoutput; op: tasmop; c: tasmcondflags;
procedure tcgppc.a_jmp(list: taasmoutput; op: tasmop; c: tasmcondflags;
l: pasmlabel);
var p: paicpu;
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);
list^.concat(p)
list.concat(p)
end;
end.
{
$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"
+ a_cmp_loc_*_label methods for tcg
+ base implementatino for a_cmp_ref_*_label methods

41
compiler/powerpc/cpubase.pas
View File

@ -226,20 +226,22 @@ type
C_None: ();
{ specifies in which part of the cr the bit has to be }
{ 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_NS,C_UN,C_NU: (cr: R_CR0..R_CR7);
C_LT..C_NU: (cr: R_CR0..R_CR7);
{ 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)
);
end;
const
{ AsmCondFlag2BO: Array[TAsmCondFlags] of Byte =
(0,12,4,12,4,12,4,4,4,12,4,12,4,
);
AsmCondFlag2BI: Array[TAsmCondFlags] of Byte =
(0,0,1,2,0,1,0,2,1,3,3,3,3);}
AsmCondFlag2BO: Array[C_T..C_DZF] of Byte =
(12,4,16,8,0,18,10,2);
AsmCondFlag2BI: Array[C_LR..C_NU] of Byte =
(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}'',
{ conditions when not using ctr decrement etc}
@ -394,12 +396,13 @@ const
registers_saved_on_cdecl = [R_13..R_29];
{ generic register names }
stack_pointer = R_1;
R_RTOC = R_2;
frame_pointer = stack_pointer;
self_pointer = R_9;
accumulator = R_3;
vmt_offset_reg = R_0;
stack_pointer = R_1;
R_RTOC = R_2;
frame_pointer = stack_pointer;
self_pointer = R_9;
accumulator = R_3;
accumulatorhigh = R_4;
vmt_offset_reg = R_0;
max_scratch_regs = 3;
scratch_regs: Array[1..max_scratch_regs] of TRegister = (R_11,R_12,R_30);
@ -599,7 +602,15 @@ implementation
end.
{
$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 PPC updates