* powerpc/cgcpu.pas compiles :)

* several powerpc-related fixes
  * cpuasm unit is now based on common tainst unit
  + nppcmat unit for powerpc (almost complete)
This commit is contained in:
Jonas Maebe 2001-12-29 15:28:57 +00:00
parent 928493e3ba
commit 91f567bb66
25 changed files with 1314 additions and 674 deletions

128
compiler/cg64f32.pas Normal file
View File

@ -0,0 +1,128 @@
{
$Id$
Copyright (c) 1998-2000 by Florian Klaempfl
Member of the Free Pascal development team
This unit implements the code generation for 64 bit int
arithmethics on 32 bit processors
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
unit cg64f32;
{$i defines.inc}
interface
uses
aasm, cgobj, cpubase;
type
tcg64f32 = class(tcg)
procedure a_load64_reg_ref(list : taasmoutput;reglo, reghi : tregister;const ref : treference);
procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reglo,reghi : tregister);
procedure a_load64_reg_reg(list : taasmoutput;reglosrc,reghisrc,reglodst,reghidst : tregister);
procedure a_load64_loc_reg(list : taasmoutput;const l : tlocation;reglo,reghi : tregister);
end;
implementation
uses
globals,systems,cgbase,verbose;
procedure tcg64f32.a_load64_reg_ref(list : taasmoutput;reglo, reghi : tregister;const ref : treference);
var
tmpreg: tregister;
tmpref: treference;
begin
if target_info.endian = endian_big then
begin
tmpreg := reglo;
reglo := reghi;
reghi := tmpreg;
end;
a_load_reg_ref(list,OS_32,reglo,ref);
tmpref := ref;
inc(tmpref.offset,4);
a_load_reg_ref(list,OS_32,reghi,tmpref);
end;
procedure tcg64f32.a_load64_ref_reg(list : taasmoutput;const ref : treference;reglo,reghi : tregister);
var
tmpreg: tregister;
tmpref: treference;
begin
if target_info.endian = endian_big then
begin
tmpreg := reglo;
reglo := reghi;
reghi := tmpreg;
end;
a_load_ref_reg(list,OS_32,ref,reglo);
tmpref := ref;
inc(tmpref.offset,4);
a_load_ref_reg(list,OS_32,tmpref,reghi);
end;
procedure tcg64f32.a_load64_reg_reg(list : taasmoutput;reglosrc,reghisrc,reglodst,reghidst : tregister);
begin
a_load_reg_reg(list,OS_32,reglosrc,reglodst);
a_load_reg_reg(list,OS_32,reghisrc,reghidst);
end;
procedure tcg64f32.a_load64_loc_reg(list : taasmoutput;const l : tlocation;reglo,reghi : tregister);
begin
case l.loc of
LOC_REFERENCE, LOC_MEM:
a_load64_ref_reg(list,l.reference,reglo,reghi);
LOC_REGISTER,LOC_CREGISTER:
a_load64_reg_reg(list,l.registerlow,l.registerhigh,reglo,reghi);
else
internalerror(200112292);
end;
end;
(*
procedure int64f32_assignment_int64_reg(p : passignmentnode);
begin
end;
begin
p2_assignment:=@int64f32_assignement_int64;
*)
end.
{
$Log$
Revision 1.1 2001-12-29 15:29:58 jonas
* powerpc/cgcpu.pas compiles :)
* several powerpc-related fixes
* cpuasm unit is now based on common tainst unit
+ nppcmat unit for powerpc (almost complete)
Revision 1.1 2000/07/13 06:30:07 michael
+ Initial import
Revision 1.1 2000/03/01 15:36:13 florian
* some new stuff for the new cg
}

View File

@ -209,7 +209,7 @@ unit cgobj;
uses uses
strings,globals,globtype,options,{files,}gdb,systems, strings,globals,globtype,options,{files,}gdb,systems,
ppu,verbose,types,{tgobj,}tgcpu,symdef,symsym,cga; ppu,verbose,types,{tgobj,}tgcpu,symdef,symsym,cga,tainst;
const const
max_scratch_regs = high(scratch_regs) - low(scratch_regs) + 1; max_scratch_regs = high(scratch_regs) - low(scratch_regs) + 1;
@ -275,7 +275,11 @@ unit cgobj;
procedure tcg.free_scratch_reg(list : taasmoutput;r : tregister); procedure tcg.free_scratch_reg(list : taasmoutput;r : tregister);
begin begin
{$ifdef i386}
include(unusedscratchregisters,makereg32(r)); include(unusedscratchregisters,makereg32(r));
{$else i386}
include(unusedscratchregisters,r);
{$endif i386}
a_reg_dealloc(list,r); a_reg_dealloc(list,r);
end; end;
@ -1280,7 +1284,13 @@ finalization
end. end.
{ {
$Log$ $Log$
Revision 1.4 2001-09-30 21:26:42 peter Revision 1.5 2001-12-29 15:28:58 jonas
* powerpc/cgcpu.pas compiles :)
* several powerpc-related fixes
* cpuasm unit is now based on common tainst unit
+ nppcmat unit for powerpc (almost complete)
Revision 1.4 2001/09/30 21:26:42 peter
* removed obsolete newst defines * removed obsolete newst defines
Revision 1.3 2001/09/30 16:17:17 jonas Revision 1.3 2001/09/30 16:17:17 jonas

View File

@ -52,7 +52,7 @@ interface
dos, dos,
{$endif Delphi} {$endif Delphi}
cutils,globtype,systems, cutils,globtype,systems,
fmodule,finput,verbose,cpubase,cpuasm fmodule,finput,verbose,cpubase,cpuasm,tainst
{$ifdef GDB} {$ifdef GDB}
,gdb ,gdb
{$endif GDB} {$endif GDB}
@ -949,7 +949,13 @@ initialization
end. end.
{ {
$Log$ $Log$
Revision 1.11 2001-09-17 21:29:13 peter Revision 1.12 2001-12-29 15:29:58 jonas
* powerpc/cgcpu.pas compiles :)
* several powerpc-related fixes
* cpuasm unit is now based on common tainst unit
+ nppcmat unit for powerpc (almost complete)
Revision 1.11 2001/09/17 21:29:13 peter
* merged netbsd, fpu-overflow from fixes branch * merged netbsd, fpu-overflow from fixes branch
Revision 1.10 2001/08/30 20:57:10 peter Revision 1.10 2001/08/30 20:57:10 peter

View File

@ -43,7 +43,7 @@ interface
sysutils, sysutils,
{$endif} {$endif}
cutils,globtype,globals,systems,cclasses, cutils,globtype,globals,systems,cclasses,
fmodule,finput,verbose,cpubase,cpuasm fmodule,finput,verbose,cpubase,cpuasm,tainst
; ;
const const
@ -867,7 +867,13 @@ initialization
end. end.
{ {
$Log$ $Log$
Revision 1.11 2001-05-06 17:13:23 jonas Revision 1.12 2001-12-29 15:29:58 jonas
* powerpc/cgcpu.pas compiles :)
* several powerpc-related fixes
* cpuasm unit is now based on common tainst unit
+ nppcmat unit for powerpc (almost complete)
Revision 1.11 2001/05/06 17:13:23 jonas
* completed incomplete typed constant records * completed incomplete typed constant records
Revision 1.10 2001/04/21 15:33:03 peter Revision 1.10 2001/04/21 15:33:03 peter

View File

@ -162,7 +162,7 @@ implementation
globtype,systems,globals,verbose, globtype,systems,globals,verbose,
fmodule, fmodule,
symbase,symsym,symtable,types, symbase,symsym,symtable,types,
tgcpu,temp_gen,cgbase,regvars tainst,tgcpu,temp_gen,cgbase,regvars
{$ifdef GDB} {$ifdef GDB}
,gdb ,gdb
{$endif} {$endif}
@ -2976,7 +2976,13 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.11 2001-11-18 18:59:59 peter Revision 1.12 2001-12-29 15:28:58 jonas
* powerpc/cgcpu.pas compiles :)
* several powerpc-related fixes
* cpuasm unit is now based on common tainst unit
+ nppcmat unit for powerpc (almost complete)
Revision 1.11 2001/11/18 18:59:59 peter
* changed aktprocsym to aktprocdef for stabs generation * changed aktprocsym to aktprocdef for stabs generation
Revision 1.10 2001/11/06 16:39:02 jonas Revision 1.10 2001/11/06 16:39:02 jonas

View File

@ -109,7 +109,7 @@ unit cgcpu;
implementation implementation
uses uses
globtype,globals,verbose,systems,cutils,cga; globtype,globals,verbose,systems,cutils,cga,tgcpu;
{ we implement the following routines because otherwise we can't } { we implement the following routines because otherwise we can't }
@ -395,19 +395,73 @@ unit cgcpu;
procedure tcg386.a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister); procedure tcg386.a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister);
var var
regloadsize: tcgsize;
dstsize: topsize; dstsize: topsize;
tmpreg : tregister;
popecx : boolean;
begin begin
dstsize := makeregsize(dst,size); dstsize := makeregsize(dst,size);
case op of case op of
OP_NEG,OP_NOT: OP_NEG,OP_NOT:
begin begin
if src <> R_NO then
internalerror(200112291);
list.concat(taicpu.op_reg(TOpCG2AsmOp[op],dstsize,dst)); list.concat(taicpu.op_reg(TOpCG2AsmOp[op],dstsize,dst));
end; end;
OP_MUL,OP_DIV,OP_IDIV: OP_MUL,OP_DIV,OP_IDIV:
{ special stuff, needs separate handling inside code } { special stuff, needs separate handling inside code }
{ generator } { generator }
internalerror(200109233); internalerror(200109233);
OP_SHR,OP_SHL,OP_SAR:
begin
tmpreg := R_NO;
{ we need cl to hold the shift count, so if the destination }
{ is ecx, save it to a temp for now }
if dst in [R_ECX,R_CX,R_CL] then
begin
case regsize(dst) of
S_B: regloadsize := OS_8;
S_W: regloadsize := OS_16;
else regloadsize := OS_32;
end;
tmpreg := get_scratch_reg(list);
a_load_reg_reg(list,regloadsize,src,tmpreg);
end;
if not(src in [R_ECX,R_CX,R_CL]) then
begin
{ is ecx still free (it's also free if it was allocated }
{ to dst, since we've moved dst somewhere else already) }
if not((dst = R_ECX) or
((R_ECX in unused) and
{ this will always be true, it's just here to }
{ allocate ecx }
(getexplicitregister32(R_ECX) = R_ECX))) then
begin
list.concat(taicpu.op_reg(A_PUSH,S_L,R_ECX));
popecx := true;
end;
a_load_reg_reg(list,OS_8,makereg8(src),R_CL);
end
else
src := R_CL;
{ do the shift }
if tmpreg = R_NO then
list.concat(taicpu.op_reg_reg(TOpCG2AsmOp[op],dstsize,
R_CL,dst))
else
begin
list.concat(taicpu.op_reg_reg(TOpCG2AsmOp[op],S_L,
R_CL,tmpreg));
{ move result back to the destination }
a_load_reg_reg(list,OS_32,tmpreg,R_ECX);
free_scratch_reg(list,tmpreg);
end;
if popecx then
list.concat(taicpu.op_reg(A_POP,S_L,R_ECX))
else if not (dst in [R_ECX,R_CX,R_CL]) then
ungetregister32(R_ECX);
end;
else else
begin begin
if regsize(src) <> dstsize then if regsize(src) <> dstsize then
@ -708,7 +762,13 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.4 2001-10-04 14:33:28 jonas Revision 1.5 2001-12-29 15:29:59 jonas
* powerpc/cgcpu.pas compiles :)
* several powerpc-related fixes
* cpuasm unit is now based on common tainst unit
+ nppcmat unit for powerpc (almost complete)
Revision 1.4 2001/10/04 14:33:28 jonas
* fixed range check errors * fixed range check errors
Revision 1.3 2001/09/30 16:17:18 jonas Revision 1.3 2001/09/30 16:17:18 jonas

View File

@ -40,7 +40,7 @@ unit cpuasm;
interface interface
uses uses
cclasses, cclasses,tainst,
aasm,globals,verbose, aasm,globals,verbose,
cpubase; cpubase;
@ -50,13 +50,6 @@ const
type type
TOperandOrder = (op_intel,op_att); TOperandOrder = (op_intel,op_att);
tairegalloc = class(tai)
allocation : boolean;
reg : tregister;
constructor alloc(r : tregister);
constructor dealloc(r : tregister);
end;
{ alignment for operator } { alignment for operator }
tai_align = class(tai_align_abstract) tai_align = class(tai_align_abstract)
reg : tregister; reg : tregister;
@ -65,13 +58,8 @@ type
function getfillbuf:pchar; function getfillbuf:pchar;
end; end;
taicpu = class(tai) taicpu = class(tainstruction)
is_jmp : boolean; { is this instruction a jump? (needed for optimizer) }
opcode : tasmop;
opsize : topsize; opsize : topsize;
condition : TAsmCond;
ops : longint;
oper : array[0..2] of toper;
constructor op_none(op : tasmop;_size : topsize); constructor op_none(op : tasmop;_size : topsize);
constructor op_reg(op : tasmop;_size : topsize;_op1 : tregister); constructor op_reg(op : tasmop;_size : topsize;_op1 : tregister);
@ -104,22 +92,13 @@ type
constructor op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister); constructor op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister);
constructor op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : preference); constructor op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : preference);
procedure loadconst(opidx:longint;l:longint);
procedure loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
procedure loadref(opidx:longint;p:preference);
procedure loadreg(opidx:longint;r:tregister);
procedure loadoper(opidx:longint;o:toper);
procedure changeopsize(siz:topsize); procedure changeopsize(siz:topsize);
procedure SetCondition(c:TAsmCond);
destructor destroy;override;
function getcopy:tlinkedlistitem;override;
function GetString:string; function GetString:string;
procedure CheckNonCommutativeOpcodes; procedure CheckNonCommutativeOpcodes;
private private
segprefix : tregister;
FOperandOrder : TOperandOrder; FOperandOrder : TOperandOrder;
procedure init(op : tasmop;_size : topsize); { this need to be called by all constructor } procedure init(_size : topsize); { this need to be called by all constructor }
{$ifndef NOAG386BIN} {$ifndef NOAG386BIN}
public public
{ the next will reset all instructions that can change in pass 2 } { the next will reset all instructions that can change in pass 2 }
@ -151,27 +130,6 @@ uses
cutils, cutils,
ogbase; ogbase;
{*****************************************************************************
TaiRegAlloc
*****************************************************************************}
constructor tairegalloc.alloc(r : tregister);
begin
inherited create;
typ:=ait_regalloc;
allocation:=true;
reg:=r;
end;
constructor tairegalloc.dealloc(r : tregister);
begin
inherited create;
typ:=ait_regalloc;
allocation:=false;
reg:=r;
end;
{**************************************************************************** {****************************************************************************
TAI_ALIGN TAI_ALIGN
@ -226,113 +184,18 @@ uses
Taicpu Constructors Taicpu Constructors
*****************************************************************************} *****************************************************************************}
procedure taicpu.loadconst(opidx:longint;l:longint);
begin
if opidx>=ops then
ops:=opidx+1;
with oper[opidx] do
begin
if typ=top_ref then
disposereference(ref);
val:=l;
typ:=top_const;
end;
end;
procedure taicpu.loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
begin
if opidx>=ops then
ops:=opidx+1;
with oper[opidx] do
begin
if typ=top_ref then
disposereference(ref);
sym:=s;
symofs:=sofs;
typ:=top_symbol;
end;
{ Mark the symbol as used }
if assigned(s) then
inc(s.refs);
end;
procedure taicpu.loadref(opidx:longint;p:preference);
begin
if opidx>=ops then
ops:=opidx+1;
with oper[opidx] do
begin
if typ=top_ref then
disposereference(ref);
if p^.is_immediate then
begin
{$ifdef REF_IMMEDIATE_WARN}
Comment(V_Warning,'Reference immediate');
{$endif}
val:=p^.offset;
disposereference(p);
typ:=top_const;
end
else
begin
ref:=p;
if not(ref^.segment in [R_DS,R_NO]) then
segprefix:=ref^.segment;
typ:=top_ref;
{ mark symbol as used }
if assigned(ref^.symbol) then
inc(ref^.symbol.refs);
end;
end;
end;
procedure taicpu.loadreg(opidx:longint;r:tregister);
begin
if opidx>=ops then
ops:=opidx+1;
with oper[opidx] do
begin
if typ=top_ref then
disposereference(ref);
reg:=r;
typ:=top_reg;
end;
end;
procedure taicpu.loadoper(opidx:longint;o:toper);
begin
if opidx>=ops then
ops:=opidx+1;
if oper[opidx].typ=top_ref then
disposereference(oper[opidx].ref);
oper[opidx]:=o;
{ copy also the reference }
if oper[opidx].typ=top_ref then
oper[opidx].ref:=newreference(o.ref^);
end;
procedure taicpu.changeopsize(siz:topsize); procedure taicpu.changeopsize(siz:topsize);
begin begin
opsize:=siz; opsize:=siz;
end; end;
procedure taicpu.init(op : tasmop;_size : topsize); procedure taicpu.init(_size : topsize);
begin begin
typ:=ait_instruction;
is_jmp:=false;
{ default order is att } { default order is att }
FOperandOrder:=op_att; FOperandOrder:=op_att;
segprefix:=R_NO; segprefix:=R_NO;
opcode:=op;
opsize:=_size; opsize:=_size;
ops:=0;
condition:=c_none;
fillchar(oper,sizeof(oper),0);
{$ifndef NOAG386BIN} {$ifndef NOAG386BIN}
insentry:=nil; insentry:=nil;
LastInsOffset:=-1; LastInsOffset:=-1;
@ -344,15 +207,15 @@ uses
constructor taicpu.op_none(op : tasmop;_size : topsize); constructor taicpu.op_none(op : tasmop;_size : topsize);
begin begin
inherited create; inherited create(op);
init(op,_size); init(_size);
end; end;
constructor taicpu.op_reg(op : tasmop;_size : topsize;_op1 : tregister); constructor taicpu.op_reg(op : tasmop;_size : topsize;_op1 : tregister);
begin begin
inherited create; inherited create(op);
init(op,_size); init(_size);
ops:=1; ops:=1;
loadreg(0,_op1); loadreg(0,_op1);
end; end;
@ -360,8 +223,8 @@ uses
constructor taicpu.op_const(op : tasmop;_size : topsize;_op1 : longint); constructor taicpu.op_const(op : tasmop;_size : topsize;_op1 : longint);
begin begin
inherited create; inherited create(op);
init(op,_size); init(_size);
ops:=1; ops:=1;
loadconst(0,_op1); loadconst(0,_op1);
end; end;
@ -369,8 +232,8 @@ uses
constructor taicpu.op_ref(op : tasmop;_size : topsize;_op1 : preference); constructor taicpu.op_ref(op : tasmop;_size : topsize;_op1 : preference);
begin begin
inherited create; inherited create(op);
init(op,_size); init(_size);
ops:=1; ops:=1;
loadref(0,_op1); loadref(0,_op1);
end; end;
@ -378,8 +241,8 @@ uses
constructor taicpu.op_reg_reg(op : tasmop;_size : topsize;_op1,_op2 : tregister); constructor taicpu.op_reg_reg(op : tasmop;_size : topsize;_op1,_op2 : tregister);
begin begin
inherited create; inherited create(op);
init(op,_size); init(_size);
ops:=2; ops:=2;
loadreg(0,_op1); loadreg(0,_op1);
loadreg(1,_op2); loadreg(1,_op2);
@ -388,8 +251,8 @@ uses
constructor taicpu.op_reg_const(op:tasmop; _size: topsize; _op1: tregister; _op2: longint); constructor taicpu.op_reg_const(op:tasmop; _size: topsize; _op1: tregister; _op2: longint);
begin begin
inherited create; inherited create(op);
init(op,_size); init(_size);
ops:=2; ops:=2;
loadreg(0,_op1); loadreg(0,_op1);
loadconst(1,_op2); loadconst(1,_op2);
@ -398,8 +261,8 @@ uses
constructor taicpu.op_reg_ref(op : tasmop;_size : topsize;_op1 : tregister;_op2 : preference); constructor taicpu.op_reg_ref(op : tasmop;_size : topsize;_op1 : tregister;_op2 : preference);
begin begin
inherited create; inherited create(op);
init(op,_size); init(_size);
ops:=2; ops:=2;
loadreg(0,_op1); loadreg(0,_op1);
loadref(1,_op2); loadref(1,_op2);
@ -408,8 +271,8 @@ uses
constructor taicpu.op_const_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister); constructor taicpu.op_const_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister);
begin begin
inherited create; inherited create(op);
init(op,_size); init(_size);
ops:=2; ops:=2;
loadconst(0,_op1); loadconst(0,_op1);
loadreg(1,_op2); loadreg(1,_op2);
@ -418,8 +281,8 @@ uses
constructor taicpu.op_const_const(op : tasmop;_size : topsize;_op1,_op2 : longint); constructor taicpu.op_const_const(op : tasmop;_size : topsize;_op1,_op2 : longint);
begin begin
inherited create; inherited create(op);
init(op,_size); init(_size);
ops:=2; ops:=2;
loadconst(0,_op1); loadconst(0,_op1);
loadconst(1,_op2); loadconst(1,_op2);
@ -428,8 +291,8 @@ uses
constructor taicpu.op_const_ref(op : tasmop;_size : topsize;_op1 : longint;_op2 : preference); constructor taicpu.op_const_ref(op : tasmop;_size : topsize;_op1 : longint;_op2 : preference);
begin begin
inherited create; inherited create(op);
init(op,_size); init(_size);
ops:=2; ops:=2;
loadconst(0,_op1); loadconst(0,_op1);
loadref(1,_op2); loadref(1,_op2);
@ -438,8 +301,8 @@ uses
constructor taicpu.op_ref_reg(op : tasmop;_size : topsize;_op1 : preference;_op2 : tregister); constructor taicpu.op_ref_reg(op : tasmop;_size : topsize;_op1 : preference;_op2 : tregister);
begin begin
inherited create; inherited create(op);
init(op,_size); init(_size);
ops:=2; ops:=2;
loadref(0,_op1); loadref(0,_op1);
loadreg(1,_op2); loadreg(1,_op2);
@ -448,8 +311,8 @@ uses
constructor taicpu.op_ref_ref(op : tasmop;_size : topsize;_op1,_op2 : preference); constructor taicpu.op_ref_ref(op : tasmop;_size : topsize;_op1,_op2 : preference);
begin begin
inherited create; inherited create(op);
init(op,_size); init(_size);
ops:=2; ops:=2;
loadref(0,_op1); loadref(0,_op1);
loadref(1,_op2); loadref(1,_op2);
@ -458,8 +321,8 @@ uses
constructor taicpu.op_reg_reg_reg(op : tasmop;_size : topsize;_op1,_op2,_op3 : tregister); constructor taicpu.op_reg_reg_reg(op : tasmop;_size : topsize;_op1,_op2,_op3 : tregister);
begin begin
inherited create; inherited create(op);
init(op,_size); init(_size);
ops:=3; ops:=3;
loadreg(0,_op1); loadreg(0,_op1);
loadreg(1,_op2); loadreg(1,_op2);
@ -468,8 +331,8 @@ uses
constructor taicpu.op_const_reg_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister;_op3 : tregister); constructor taicpu.op_const_reg_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister;_op3 : tregister);
begin begin
inherited create; inherited create(op);
init(op,_size); init(_size);
ops:=3; ops:=3;
loadconst(0,_op1); loadconst(0,_op1);
loadreg(1,_op2); loadreg(1,_op2);
@ -478,8 +341,8 @@ uses
constructor taicpu.op_reg_reg_ref(op : tasmop;_size : topsize;_op1,_op2 : tregister;_op3 : preference); constructor taicpu.op_reg_reg_ref(op : tasmop;_size : topsize;_op1,_op2 : tregister;_op3 : preference);
begin begin
inherited create; inherited create(op);
init(op,_size); init(_size);
ops:=3; ops:=3;
loadreg(0,_op1); loadreg(0,_op1);
loadreg(1,_op2); loadreg(1,_op2);
@ -489,8 +352,8 @@ uses
constructor taicpu.op_const_ref_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : preference;_op3 : tregister); constructor taicpu.op_const_ref_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : preference;_op3 : tregister);
begin begin
inherited create; inherited create(op);
init(op,_size); init(_size);
ops:=3; ops:=3;
loadconst(0,_op1); loadconst(0,_op1);
loadref(1,_op2); loadref(1,_op2);
@ -500,8 +363,8 @@ uses
constructor taicpu.op_const_reg_ref(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister;_op3 : preference); constructor taicpu.op_const_reg_ref(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister;_op3 : preference);
begin begin
inherited create; inherited create(op);
init(op,_size); init(_size);
ops:=3; ops:=3;
loadconst(0,_op1); loadconst(0,_op1);
loadreg(1,_op2); loadreg(1,_op2);
@ -511,8 +374,8 @@ uses
constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_size : topsize;_op1 : tasmsymbol); constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_size : topsize;_op1 : tasmsymbol);
begin begin
inherited create; inherited create(op);
init(op,_size); init(_size);
condition:=cond; condition:=cond;
ops:=1; ops:=1;
loadsymbol(0,_op1,0); loadsymbol(0,_op1,0);
@ -521,8 +384,8 @@ uses
constructor taicpu.op_sym(op : tasmop;_size : topsize;_op1 : tasmsymbol); constructor taicpu.op_sym(op : tasmop;_size : topsize;_op1 : tasmsymbol);
begin begin
inherited create; inherited create(op);
init(op,_size); init(_size);
ops:=1; ops:=1;
loadsymbol(0,_op1,0); loadsymbol(0,_op1,0);
end; end;
@ -530,8 +393,8 @@ uses
constructor taicpu.op_sym_ofs(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint); constructor taicpu.op_sym_ofs(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint);
begin begin
inherited create; inherited create(op);
init(op,_size); init(_size);
ops:=1; ops:=1;
loadsymbol(0,_op1,_op1ofs); loadsymbol(0,_op1,_op1ofs);
end; end;
@ -539,8 +402,8 @@ uses
constructor taicpu.op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister); constructor taicpu.op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister);
begin begin
inherited create; inherited create(op);
init(op,_size); init(_size);
ops:=2; ops:=2;
loadsymbol(0,_op1,_op1ofs); loadsymbol(0,_op1,_op1ofs);
loadreg(1,_op2); loadreg(1,_op2);
@ -549,74 +412,13 @@ uses
constructor taicpu.op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : preference); constructor taicpu.op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : preference);
begin begin
inherited create; inherited create(op);
init(op,_size); init(_size);
ops:=2; ops:=2;
loadsymbol(0,_op1,_op1ofs); loadsymbol(0,_op1,_op1ofs);
loadref(1,_op2); loadref(1,_op2);
end; end;
destructor taicpu.destroy;
begin
{ unrolled for speed }
if (ops>0) then
begin
case oper[0].typ of
top_ref:
dispose(oper[0].ref);
top_symbol:
dec(tasmsymbol(oper[0].sym).refs);
end;
if (ops>1) then
begin
if (oper[1].typ=top_ref) then
dispose(oper[1].ref);
if (ops>2) and (oper[2].typ=top_ref) then
dispose(oper[2].ref);
end;
end;
inherited destroy;
end;
function taicpu.getcopy:tlinkedlistitem;
var
p : taicpu;
begin
p:=taicpu(inherited getcopy);
{ make a copy of the references, unrolled for speed }
if ops>0 then
begin
if (p.oper[0].typ=top_ref) then
begin
new(p.oper[0].ref);
p.oper[0].ref^:=oper[0].ref^;
end;
if ops>1 then
begin
if (p.oper[1].typ=top_ref) then
begin
new(p.oper[1].ref);
p.oper[1].ref^:=oper[1].ref^;
end;
if (ops>2) and (p.oper[2].typ=top_ref) then
begin
new(p.oper[2].ref);
p.oper[2].ref^:=oper[2].ref^;
end;
end;
end;
getcopy:=p;
end;
procedure taicpu.SetCondition(c:TAsmCond);
begin
condition:=c;
end;
function taicpu.GetString:string; function taicpu.GetString:string;
var var
i : longint; i : longint;
@ -1773,7 +1575,13 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.15 2001-04-21 12:13:15 peter Revision 1.16 2001-12-29 15:29:59 jonas
* powerpc/cgcpu.pas compiles :)
* several powerpc-related fixes
* cpuasm unit is now based on common tainst unit
+ nppcmat unit for powerpc (almost complete)
Revision 1.15 2001/04/21 12:13:15 peter
* restore correct pass2 handling bug 1425 (merged) * restore correct pass2 handling bug 1425 (merged)
Revision 1.14 2001/04/13 01:22:18 peter Revision 1.14 2001/04/13 01:22:18 peter

View File

@ -706,6 +706,7 @@ const
procedure set_location(var destloc,sourceloc : tlocation); procedure set_location(var destloc,sourceloc : tlocation);
procedure swap_location(var destloc,sourceloc : tlocation); procedure swap_location(var destloc,sourceloc : tlocation);
procedure inverse_flags(var f: TResFlags);
implementation implementation
@ -933,6 +934,15 @@ begin
{$endif NOAG386BIN} {$endif NOAG386BIN}
end; end;
procedure inverse_flags(var f: TResFlags);
const
flagsinvers : array[F_E..F_BE] of tresflags =
(F_NE,F_E,F_LE,F_GE,F_L,F_G,F_NC,F_C,
F_BE,F_B,F_AE,F_A);
begin
f := flagsinvers[f];
end;
procedure InitCpu; procedure InitCpu;
begin begin
@ -945,7 +955,13 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.7 2001-12-06 17:57:40 florian Revision 1.8 2001-12-29 15:29:59 jonas
* powerpc/cgcpu.pas compiles :)
* several powerpc-related fixes
* cpuasm unit is now based on common tainst unit
+ nppcmat unit for powerpc (almost complete)
Revision 1.7 2001/12/06 17:57:40 florian
+ parasym to tparaitem added + parasym to tparaitem added
Revision 1.6 2001/09/28 20:39:33 jonas Revision 1.6 2001/09/28 20:39:33 jonas

View File

@ -226,7 +226,7 @@ Var
Implementation Implementation
Uses Uses
globals, systems, verbose, cgbase, symconst, symsym, tgcpu; globals, systems, verbose, cgbase, symconst, symsym, tainst, tgcpu;
Type Type
TRefCompare = function(const r1, r2: TReference): Boolean; TRefCompare = function(const r1, r2: TReference): Boolean;
@ -2591,7 +2591,13 @@ End.
{ {
$Log$ $Log$
Revision 1.24 2001-11-02 22:58:09 peter Revision 1.25 2001-12-29 15:29:59 jonas
* powerpc/cgcpu.pas compiles :)
* several powerpc-related fixes
* cpuasm unit is now based on common tainst unit
+ nppcmat unit for powerpc (almost complete)
Revision 1.24 2001/11/02 22:58:09 peter
* procsym definition rewrite * procsym definition rewrite
Revision 1.23 2001/10/27 10:20:43 jonas Revision 1.23 2001/10/27 10:20:43 jonas

View File

@ -49,7 +49,7 @@ interface
cgbase,temp_gen,pass_2,regvars, cgbase,temp_gen,pass_2,regvars,
cpuasm, cpuasm,
ncon,nset, ncon,nset,
cga,n386util,tgcpu; tainst,cga,n386util,tgcpu;
function ti386addnode.getresflags(unsigned : boolean) : tresflags; function ti386addnode.getresflags(unsigned : boolean) : tresflags;
@ -1863,8 +1863,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.26 2001-12-02 16:19:17 jonas Revision 1.27 2001-12-29 15:29:58 jonas
* less unnecessary regvar loading with if-statements * powerpc/cgcpu.pas compiles :)
* several powerpc-related fixes
* cpuasm unit is now based on common tainst unit
+ nppcmat unit for powerpc (almost complete)
Revision 1.25 2001/10/12 13:51:51 jonas Revision 1.25 2001/10/12 13:51:51 jonas
* fixed internalerror(10) due to previous fpu overflow fixes ("merged") * fixed internalerror(10) due to previous fpu overflow fixes ("merged")

View File

@ -63,7 +63,7 @@ implementation
cgbase,temp_gen,pass_2, cgbase,temp_gen,pass_2,
cpubase,cpuasm, cpubase,cpuasm,
nmem,nld, nmem,nld,
cga,tgcpu,n386ld,n386util,regvars; tainst,cga,tgcpu,n386ld,n386util,regvars;
{***************************************************************************** {*****************************************************************************
TI386CALLPARANODE TI386CALLPARANODE
@ -1498,7 +1498,7 @@ implementation
inlineprocdef.parast.symtabletype:=inlineparasymtable; inlineprocdef.parast.symtabletype:=inlineparasymtable;
{ Here we must include the para and local symtable info } { Here we must include the para and local symtable info }
tprocsym(inlineprocdef.procsym).concatstabto(withdebuglist); inlineprocdef.concatstabto(withdebuglist);
{ set it back for safety } { set it back for safety }
inlineprocdef.localst.symtabletype:=localsymtable; inlineprocdef.localst.symtabletype:=localsymtable;
@ -1593,7 +1593,13 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.38 2001-11-18 00:00:34 florian Revision 1.39 2001-12-29 15:32:13 jonas
* powerpc/cgcpu.pas compiles :)
* several powerpc-related fixes
* cpuasm unit is now based on common tainst unit
+ nppcmat unit for powerpc (almost complete)
Revision 1.38 2001/11/18 00:00:34 florian
* handling of ansi- and widestring results improved * handling of ansi- and widestring results improved
Revision 1.37 2001/11/02 23:24:40 peter Revision 1.37 2001/11/02 23:24:40 peter

View File

@ -59,7 +59,7 @@ implementation
cgbase,temp_gen,pass_2, cgbase,temp_gen,pass_2,
cpubase,cpuasm, cpubase,cpuasm,
nld,ncon, nld,ncon,
cga,tgcpu; tainst,cga,tgcpu;
{***************************************************************************** {*****************************************************************************
SecondRaise SecondRaise
@ -737,8 +737,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.18 2001-09-30 16:16:28 jonas Revision 1.19 2001-12-29 15:29:58 jonas
- removed unused units form uses-clause and unused local vars * powerpc/cgcpu.pas compiles :)
* several powerpc-related fixes
* cpuasm unit is now based on common tainst unit
+ nppcmat unit for powerpc (almost complete)
Revision 1.17 2001/09/29 21:34:04 jonas Revision 1.17 2001/09/29 21:34:04 jonas
- removed unused code (replaced by processor independent code) - removed unused code (replaced by processor independent code)

View File

@ -41,7 +41,7 @@ Uses
{$ifdef finaldestdebug} {$ifdef finaldestdebug}
cobjects, cobjects,
{$endif finaldestdebug} {$endif finaldestdebug}
cpubase,cpuasm,DAOpt386,tgcpu; tainst,cpubase,cpuasm,DAOpt386,tgcpu;
Function RegUsedAfterInstruction(Reg: TRegister; p: Tai; Var UsedRegs: TRegSet): Boolean; Function RegUsedAfterInstruction(Reg: TRegister; p: Tai; Var UsedRegs: TRegSet): Boolean;
Begin Begin
@ -2025,7 +2025,13 @@ End.
{ {
$Log$ $Log$
Revision 1.16 2001-10-12 13:53:24 jonas Revision 1.17 2001-12-29 15:29:59 jonas
* powerpc/cgcpu.pas compiles :)
* several powerpc-related fixes
* cpuasm unit is now based on common tainst unit
+ nppcmat unit for powerpc (almost complete)
Revision 1.16 2001/10/12 13:53:24 jonas
* fixed small crashing bug ("merged") * fixed small crashing bug ("merged")
* some more optimizations are now only done once at the end of the optimizing * some more optimizations are now only done once at the end of the optimizing
cycle instead of every iteration cycle instead of every iteration

View File

@ -129,7 +129,7 @@ interface
implementation implementation
uses uses
globtype,temp_gen,regvars; globtype,temp_gen,tainst,regvars;
procedure incrementregisterpushed(b : byte); procedure incrementregisterpushed(b : byte);
@ -488,7 +488,7 @@ implementation
begin begin
isaddressregister := true; isaddressregister := true;
end; end;
procedure del_reference(const ref : treference); procedure del_reference(const ref : treference);
begin begin
@ -690,8 +690,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.6 2001-09-30 16:17:18 jonas Revision 1.7 2001-12-29 15:29:59 jonas
* made most constant and mem handling processor independent * powerpc/cgcpu.pas compiles :)
* several powerpc-related fixes
* cpuasm unit is now based on common tainst unit
+ nppcmat unit for powerpc (almost complete)
Revision 1.5 2001/08/26 13:37:03 florian Revision 1.5 2001/08/26 13:37:03 florian
* some cg reorganisation * some cg reorganisation

View File

@ -75,7 +75,7 @@ implementation
{$ifdef i386} {$ifdef i386}
n386util, n386util,
{$endif} {$endif}
regvars,cgobj,cgcpu; tainst,regvars,cgobj,cgcpu;
{***************************************************************************** {*****************************************************************************
Second_While_RepeatN Second_While_RepeatN
@ -651,8 +651,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.5 2001-12-02 16:19:17 jonas Revision 1.6 2001-12-29 15:28:57 jonas
* less unnecessary regvar loading with if-statements * powerpc/cgcpu.pas compiles :)
* several powerpc-related fixes
* cpuasm unit is now based on common tainst unit
+ nppcmat unit for powerpc (almost complete)
Revision 1.4 2001/11/02 22:58:01 peter Revision 1.4 2001/11/02 22:58:01 peter
* procsym definition rewrite * procsym definition rewrite

View File

@ -1,54 +0,0 @@
{
$Id$
Copyright (c) 1998-2000 by Florian Klaempfl
Member of the Free Pascal development team
This unit implements the code generation for 64 bit int
arithmethics on 32 bit processors
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
unit cgi64f32;
interface
uses
cgobj;
implementation
uses
nmem;
procedure int64f32_assignment_int64_reg(p : passignmentnode);
begin
end;
begin
p2_assignment:=@int64f32_assignement_int64;
end.
{
$Log$
Revision 1.1 2000-07-13 06:30:07 michael
+ Initial import
Revision 1.1 2000/03/01 15:36:13 florian
* some new stuff for the new cg
}

View File

@ -1,4 +1,4 @@
{ {
$Id$ $Id$
Copyright (c) 1998-2000 by Florian Klaempfl Copyright (c) 1998-2000 by Florian Klaempfl
@ -22,13 +22,15 @@
} }
unit cgcpu; unit cgcpu;
{$i defines.inc}
interface interface
uses uses
cgbase,cgobj,aasm,cpuasm,cpubase,cpuinfo; cgbase,cgobj,aasm,cpuasm,cpubase,cpuinfo,cg64f32;
type type
tcgppc = class(tcg) tcgppc = class(tcg64f32)
{ 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 }
@ -55,11 +57,11 @@ unit cgcpu;
{ comparison operations } { comparison operations }
procedure a_cmp_const_reg_label(list : taasmoutput;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);override; l : tasmlabel);override;
procedure a_cmp_reg_reg_label(list : taasmoutput;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 : tasmlabel); override;
procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: pasmlabel); procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel); override;
procedure g_flags2reg(list: taasmoutput; const f: TAsmCond; reg: TRegister); override; procedure g_flags2reg(list: taasmoutput; const f: TResFlags; reg: TRegister); override;
procedure g_stackframe_entry_sysv(list : taasmoutput;localsize : longint); procedure g_stackframe_entry_sysv(list : taasmoutput;localsize : longint);
@ -72,21 +74,25 @@ unit cgcpu;
procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean);override; procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean);override;
{ find out whether a is of the form 11..00..11b or 00..11...00. If }
{ that's the case, we can use rlwinm to do an AND operation }
function get_rlwi_const(a: longint; var l1, l2: longint): boolean;
procedure a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
a: aword; src, dst: tregister);
procedure a_op_reg_reg_reg(list: taasmoutput; op: TOpCg; src1, src2,
dst: tregister);
private private
procedure g_return_from_proc_sysv(list : taasmoutput;parasize : aword); procedure g_return_from_proc_sysv(list : taasmoutput;parasize : aword);
procedure g_return_from_proc_mac(list : taasmoutput;parasize : aword); procedure g_return_from_proc_mac(list : taasmoutput;parasize : aword);
procedure a_op_reg_reg_const32(list: taasmoutput; op: TOpCg;
dst, src: tregister; a: aword);
procedure a_op_reg_reg_reg(list: taasmoutput; op: TOpCg; dst, src1,
src2: tregister);
{ 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(list: taasmoutput; 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:taasmoutput;op: tasmop;reg:tregister; procedure a_load_store(list:taasmoutput;op: tasmop;reg:tregister;
@ -95,7 +101,7 @@ unit cgcpu;
{ 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: taasmoutput; op: tasmop; procedure a_jmp(list: taasmoutput; op: tasmop;
c: tasmcondflags; l: pasmlabel); c: tasmcondflag; l: tasmlabel);
end; end;
@ -113,8 +119,8 @@ const
A_DIVWU,A_DIVW, A_MULLW,A_MULLW,A_NONE,A_NONE, A_DIVWU,A_DIVW, A_MULLW,A_MULLW,A_NONE,A_NONE,
A_ORIS,A_NONE, A_NONE,A_NONE,A_SUBIS,A_XORIS); A_ORIS,A_NONE, A_NONE,A_NONE,A_SUBIS,A_XORIS);
TOpCmp2AsmCond: Array[topcmp] of TAsmCondFlags = (CF_NONE,CF_EQ,CF_GT, TOpCmp2AsmCond: Array[topcmp] of TAsmCondFlag = (C_NONE,C_EQ,C_GT,
CF_LT,CF_GE,CF_LE,CF_NE,CF_LE,CF_NG,CF_GE,CF_NL); C_LT,C_GE,C_LE,C_NE,C_LE,C_NG,C_GE,C_NL);
LoadInstr: Array[OS_8..OS_S32,boolean, boolean] of TAsmOp = LoadInstr: Array[OS_8..OS_S32,boolean, boolean] of TAsmOp =
{ indexed? updating?} { indexed? updating?}
@ -138,7 +144,7 @@ const
implementation implementation
uses uses
globtype,globals,verbose,systems,cutils; globtype,globals,verbose,systems,cutils, tgcpu;
{ parameter passing... Still needs extra support from the processor } { parameter passing... Still needs extra support from the processor }
{ independent code generator } { independent code generator }
@ -271,7 +277,7 @@ const
begin begin
ref2 := ref; ref2 := ref;
FixRef(ref2); FixRef(list,ref2);
if size in [OS_S8..OS_S16] then if size in [OS_S8..OS_S16] then
{ storing is the same for signed and unsigned values } { storing is the same for signed and unsigned values }
size := tcgsize(ord(size)-(ord(OS_S8)-ord(OS_8))); size := tcgsize(ord(size)-(ord(OS_S8)-ord(OS_8)));
@ -296,7 +302,7 @@ const
else else
begin begin
ref2 := ref; ref2 := ref;
fixref(ref2); fixref(list,ref2);
op := loadinstr[size,ref2.index<>R_NO,false]; op := loadinstr[size,ref2.index<>R_NO,false];
a_load_store(list,op,reg,ref2); a_load_store(list,op,reg,ref2);
{ sign extend shortint if necessary, since there is no } { sign extend shortint if necessary, since there is no }
@ -313,6 +319,12 @@ const
list.concat(taicpu.op_reg_reg(A_MR,reg2,reg1)); list.concat(taicpu.op_reg_reg(A_MR,reg2,reg1));
end; end;
procedure tcgppc.a_load_sym_ofs_reg(list: taasmoutput; const sym: tasmsymbol; ofs: longint; reg: tregister);
begin
{ can't use op_sym_ofs_reg because sym+ofs can be > 32767!! }
internalerror(200112293);
end;
procedure tcgppc.a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister); procedure tcgppc.a_op_const_reg(list : taasmoutput; Op: TOpCG; a: AWord; reg: TRegister);
@ -334,7 +346,7 @@ const
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:
a_op_reg_reg_const32(list,op,reg,reg,a) a_op_const_reg_reg(list,op,a,reg,reg);
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
@ -351,13 +363,13 @@ const
procedure tcgppc.a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister); procedure tcgppc.a_op_reg_reg(list : taasmoutput; Op: TOpCG; size: TCGSize; src, dst: TRegister);
begin begin
a_op_reg_reg_reg(list,op,dst,src,dst); a_op_reg_reg_reg(list,op,src,dst,dst);
end; end;
{*************** compare instructructions ****************} {*************** compare instructructions ****************}
procedure tcgppc.a_cmp_const_reg_label(list : taasmoutput;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 : tasmlabel);
var var
p: taicpu; p: taicpu;
@ -391,9 +403,10 @@ const
procedure tcgppc.a_cmp_reg_reg_label(list : taasmoutput;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 : tasmlabel);
var p: paicpu; var
p: taicpu;
op: tasmop; op: tasmop;
begin begin
@ -405,13 +418,53 @@ const
end; end;
procedure tcgppc.a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: pasmlabel); procedure tcgppc.a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
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: TResFlags; reg: TRegister);
var
testbit: byte;
bitvalue: boolean;
begin
{ get the bit to extract from the conditional register + its }
{ requested value (0 or 1) }
testbit := (f.cr * 4);
case f.flag of
F_EQ,F_NE:
bitvalue := f.flag = F_EQ;
F_LT,F_GE:
begin
inc(testbit);
bitvalue := f.flag = F_LT;
end;
F_GT,F_LE:
begin
inc(testbit,2);
bitvalue := f.flag = F_GT;
end;
else
internalerror(200112261);
end;
{ load the conditional register in the destination reg }
list.concat(taicpu.op_reg(A_MFCR,reg));
{ we will move the bit that has to be tested to bit 31 -> rotate }
{ left by bitpos+1 (remember, this is big-endian!) }
testbit := (testbit + 1) and 31;
{ extract bit }
list.concat(taicpu.op_reg_reg_const_const_const(
A_RLWINM,reg,reg,testbit,31,31));
{ if we need the inverse, xor with 1 }
if not bitvalue then
list.concat(taicpu.op_reg_reg_const(A_XORI,reg,reg,1));
end;
(*
procedure tcgppc.g_flags2reg(list: taasmoutput; const f: TAsmCond; reg: TRegister); procedure tcgppc.g_flags2reg(list: taasmoutput; const f: TAsmCond; reg: TRegister);
var var
@ -421,7 +474,7 @@ const
begin begin
{ get the bit to extract from the conditional register + its } { get the bit to extract from the conditional register + its }
{ requested value (0 or 1) } { requested value (0 or 1) }
case simple of case f.simple of
false: false:
begin begin
{ we don't generate this in the compiler } { we don't generate this in the compiler }
@ -447,7 +500,7 @@ const
end; end;
end; end;
{ load the conditional register in the destination reg } { load the conditional register in the destination reg }
list.concat(taicpu.create(op_reg_reg(A_MFCR,reg))); list.concat(taicpu.op_reg_reg(A_MFCR,reg));
{ we will move the bit that has to be tested to bit 31 -> rotate } { we will move the bit that has to be tested to bit 31 -> rotate }
{ left by bitpos+1 (remember, this is big-endian!) } { left by bitpos+1 (remember, this is big-endian!) }
if bitpos <> 31 then if bitpos <> 31 then
@ -455,23 +508,23 @@ const
else else
bitpos := 0; bitpos := 0;
{ extract bit } { extract bit }
list.concat(taicpu.create(op_reg_reg_const_const_const( list.concat(taicpu.op_reg_reg_const_const_const(
A_RLWINM,reg,reg,bitpos,31,31))); A_RLWINM,reg,reg,bitpos,31,31));
{ if we need the inverse, xor with 1 } { if we need the inverse, xor with 1 }
if not bitvalue then if not bitvalue then
list.concat(taicpu.create(op_reg_reg_const(A_XORI,reg,reg,1))); list.concat(taicpu.op_reg_reg_const(A_XORI,reg,reg,1));
end; end;
*)
{ *********** entry/exit code and address loading ************ } { *********** entry/exit code and address loading ************ }
procedure tcgppc.g_stackframe_entry(list : taasmoutput;localsize : longint); procedure tcgppc.g_stackframe_entry(list : taasmoutput;localsize : longint);
begin begin
case target_os.id of case target_info.target of
os_powerpc_macos: target_powerpc_macos:
g_stackframe_entry_mac(list,localsize); g_stackframe_entry_mac(list,localsize);
os_powerpc_linux: target_powerpc_linux:
g_stackframe_entry_sysv(list,localsize) g_stackframe_entry_sysv(list,localsize)
else else
internalerror(2204001); internalerror(2204001);
@ -600,10 +653,10 @@ const
procedure tcgppc.g_return_from_proc(list : taasmoutput;parasize : aword); procedure tcgppc.g_return_from_proc(list : taasmoutput;parasize : aword);
begin begin
case target_os.id of case target_info.target of
os_powerpc_macos: target_powerpc_macos:
g_return_from_proc_mac(list,parasize); g_return_from_proc_mac(list,parasize);
os_powerpc_linux: target_powerpc_linux:
g_return_from_proc_sysv(list,parasize) g_return_from_proc_sysv(list,parasize)
else else
internalerror(2204001); internalerror(2204001);
@ -618,7 +671,7 @@ const
begin begin
ref := ref2; ref := ref2;
FixRef(ref); FixRef(list,ref);
if assigned(ref.symbol) then if assigned(ref.symbol) then
{ add the symbol's value to the base of the reference, and if the } { add the symbol's value to the base of the reference, and if the }
{ reference doesn't have a base, create one } { reference doesn't have a base, create one }
@ -643,7 +696,7 @@ const
end; end;
if ref.offset <> 0 Then if ref.offset <> 0 Then
if ref.base <> R_NO then if ref.base <> R_NO then
a_op_reg_reg_const32(list,OP_ADD,r,ref.base,ref.offset) a_op_const_reg_reg(list,OP_ADD,ref.offset,ref.base,r)
{ FixRef makes sure that "(ref.index <> R_NO) and (ref.offset <> 0)" never} { FixRef makes sure that "(ref.index <> R_NO) and (ref.offset <> 0)" never}
{ occurs, so now only ref.offset has to be loaded } { occurs, so now only ref.offset has to be loaded }
else a_load_const_reg(list, OS_32, ref.offset, r) else a_load_const_reg(list, OS_32, ref.offset, r)
@ -662,18 +715,18 @@ const
procedure tcgppc.g_concatcopy(list : taasmoutput;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; t: taicpu;
countreg, tempreg: TRegister; countreg, tempreg: TRegister;
src, dst: TReference; src, dst: TReference;
lab: PAsmLabel; lab: tasmlabel;
count, count2: aword; count, count2: aword;
begin begin
{ make sure source and dest are valid } { make sure source and dest are valid }
src := source; src := source;
fixref(src); fixref(list,src);
dst := dest; dst := dest;
fixref(dst); fixref(list,dst);
reset_reference(src); reset_reference(src);
reset_reference(dst); reset_reference(dst);
{ load the address of source into src.base } { load the address of source into src.base }
@ -682,7 +735,7 @@ const
a_load_ref_reg(list,OS_32,source,src.base) a_load_ref_reg(list,OS_32,source,src.base)
else a_loadaddress_ref_reg(list,source,src.base); else a_loadaddress_ref_reg(list,source,src.base);
if delsource then if delsource then
del_reference(list,source); del_reference(source);
{ load the address of dest into dst.base } { load the address of dest into dst.base }
dst.base := get_scratch_reg(list); dst.base := get_scratch_reg(list);
a_loadaddress_ref_reg(list,dest,dst.base); a_loadaddress_ref_reg(list,dest,dst.base);
@ -711,7 +764,7 @@ const
list.concat(taicpu.op_reg_reg_const(A_CMPI,R_CR0,countreg,0)); list.concat(taicpu.op_reg_reg_const(A_CMPI,R_CR0,countreg,0));
list.concat(taicpu.op_reg_ref(A_STWU,tempreg,newreference(dst))); list.concat(taicpu.op_reg_ref(A_STWU,tempreg,newreference(dst)));
list.concat(taicpu.op_reg_reg_const(A_SUBI,countreg,countreg,1)); list.concat(taicpu.op_reg_reg_const(A_SUBI,countreg,countreg,1));
a_jmp(list,A_BC,CF_NE,lab); a_jmp(list,A_BC,C_NE,lab);
free_scratch_reg(list,countreg); free_scratch_reg(list,countreg);
end end
else else
@ -802,12 +855,14 @@ const
(cardinal(ref.offset-low(smallint)) <= (cardinal(ref.offset-low(smallint)) <=
high(smallint)-low(smallint)) then high(smallint)-low(smallint)) then
begin begin
list.concat(A_ADDI,ref.base,ref.base,ref.offset); list.concat(taicpu.op_reg_reg_const(
A_ADDI,ref.base,ref.base,ref.offset));
ref.offset := 0; ref.offset := 0;
end end
else else
begin begin
list.concat(A_ADD,ref.base,ref.base,ref.index); list.concat(taicpu.op_reg_reg_reg(
A_ADD,ref.base,ref.base,ref.index));
ref.index := R_NO; ref.index := R_NO;
end; end;
end end
@ -820,75 +875,75 @@ const
end; end;
procedure tcgppc.a_op_reg_reg_const32(list: taasmoutput; op: TOpCg; { find out whether a is of the form 11..00..11b or 00..11...00. If }
dst, src: tregister; a: aword): boolean; { that's the case, we can use rlwinm to do an AND operation }
function tcgppc.get_rlwi_const(a: longint; var l1, l2: longint): boolean;
var
temp, testbit: longint;
compare: boolean;
begin
get_rlwi_const := false;
{ start with the lowest bit }
testbit := 1;
{ check its value }
compare := boolean(a and testbit);
{ find out how long the run of bits with this value is }
{ (it's impossible that all bits are 1 or 0, because in that case }
{ this function wouldn't have been called) }
l1 := 31;
while (((a and testbit) <> 0) = compare) do
begin
testbit := testbit shl 1;
dec(l1);
end;
{ check the length of the run of bits that comes next }
compare := not compare;
l2 := l1;
while (((a and testbit) <> 0) = compare) and
(l2 >= 0) do
begin
testbit := testbit shl 1;
dec(l2);
end;
{ and finally the check whether the rest of the bits all have the }
{ same value }
compare := not compare;
temp := l2;
if temp >= 0 then
if (a shr (31-temp)) <> ((-ord(compare)) shr (31-temp)) then
exit;
{ we have done "not(not(compare))", so compare is back to its }
{ initial value. If the lowest bit was 0, a is of the form }
{ 00..11..00 and we need "rlwinm reg,reg,0,l2+1,l1", (+1 }
{ because l2 now contains the position of the last zero of the }
{ first run instead of that of the first 1) so switch l1 and l2 }
{ in that case (we will generate "rlwinm reg,reg,0,l1,l2") }
if not compare then
begin
temp := l1;
l1 := l2+1;
l2 := temp;
end
else
{ otherwise, l1 currently contains the position of the last }
{ zero instead of that of the first 1 of the second run -> +1 }
inc(l1);
{ the following is the same as "if l1 = -1 then l1 := 31;" }
l1 := l1 and 31;
l2 := l2 and 31;
get_rlwi_const := true;
end;
procedure tcgppc.a_op_const_reg_reg(list: taasmoutput; op: TOpCg;
a: aword; src, dst: tregister);
var var
l1,l2: longint; l1,l2: longint;
{ find out whether a is of the form 11..00..11b or 00..11...00. If }
{ that's the case, we can use rlwinm to do an AND operation }
function get_rlwi_const: boolean;
var
temp, testbit: longint;
compare: boolean;
begin
get_rlwi_const := false;
{ start with the lowest bit }
testbit := 1;
{ check its value }
compare := boolean(a and testbit);
{ find out how long the run of bits with this value is }
{ (it's impossible that all bits are 1 or 0, because in that case }
{ this function wouldn't have been called) }
l1 := 31;
while (((a and testbit) <> 0) = compare) do
begin
testbit := testbit shl 1;
dec(l1);
end;
{ check the length of the run of bits that comes next }
compare := not compare;
l2 := l1;
while (((a and testbit) <> 0) = compare) and
(l2 >= 0) do
begin
testbit := testbit shl 1;
dec(l2);
end;
{ and finally the check whether the rest of the bits all have the }
{ same value }
compare := not compare;
temp := l2;
if temp >= 0 then
if (a shr (31-temp)) <> ((-ord(compare)) shr (31-temp)) then
exit;
{ we have done "not(not(compare))", so compare is back to its }
{ initial value. If the lowest bit was 0, a is of the form }
{ 00..11..00 and we need "rlwinm reg,reg,0,l2+1,l1", (+1 }
{ because l2 now contains the position of the last zero of the }
{ first run instead of that of the first 1) so switch l1 and l2 }
{ in that case (we will generate "rlwinm reg,reg,0,l1,l2") }
if not compare then
begin
temp := l1;
l1 := l2+1;
l2 := temp;
end
else
{ otherwise, l1 currently contains the position of the last }
{ zero instead of that of the first 1 of the second run -> +1 }
inc(l1);
{ the following is the same as "if l1 = -1 then l1 := 31;" }
l1 := l1 and 31;
l2 := l2 and 31;
get_rlwi_const := true;
end;
var var
oplo, ophi: tasmop; oplo, ophi: tasmop;
scratchreg: tregister; scratchreg: tregister;
@ -903,15 +958,15 @@ const
if (longint(a) >= low(smallint)) and if (longint(a) >= low(smallint)) and
(longint(a) <= high(smallint)) then (longint(a) <= high(smallint)) then
begin begin
list.concat(taicpu.op_reg_reg_const(oplo,reg1,reg2,a)); list.concat(taicpu.op_reg_reg_const(oplo,dst,src,a));
exit; exit;
end; end;
{ all basic constant instructions also have a shifted form that } { all basic constant instructions also have a shifted form that }
{ works only on the highest 16bits, so if low(a) is 0, we can } { works only on the highest 16bits, so if low(a) is 0, we can }
{ use that one } { use that one }
if (low(a) = 0) then if (lo(a) = 0) then
begin begin
list.concat(taicpu.op_reg_reg(ophi,reg1,reg2,high(a))); list.concat(taicpu.op_reg_reg_const(ophi,dst,src,hi(a)));
exit; exit;
end; end;
{ otherwise, the instructions we can generate depend on the } { otherwise, the instructions we can generate depend on the }
@ -920,29 +975,29 @@ const
case op of case op of
OP_ADD,OP_SUB: OP_ADD,OP_SUB:
begin begin
list.concat(taicpu.op_reg_reg_const(oplo,reg1,reg2,low(a))); list.concat(taicpu.op_reg_reg_const(oplo,dst,src,low(a)));
list.concat(taicpu.op_reg_reg_const(ophi,reg1,reg1, list.concat(taicpu.op_reg_reg_const(ophi,dst,dst,
high(a) + ord(smallint(a) < 0))); high(a) + ord(smallint(a) < 0)));
end; end;
OP_OR: OP_OR:
{ try to use rlwimi } { try to use rlwimi }
if get_rlwi_const then if get_rlwi_const(a,l1,l2) then
begin begin
if reg1 <> reg2 then if src <> dst then
list.concat(taicpu.op_reg_reg(A_MR,reg1,reg2)); list.concat(taicpu.op_reg_reg(A_MR,dst,src));
scratch_reg := get_scratch_reg(list); scratchreg := get_scratch_reg(list);
list.concat(taicpu.op_reg_const(A_LI,scratch_reg,-1)); list.concat(taicpu.op_reg_const(A_LI,scratchreg,-1));
list.concat(taicpu.op_reg_reg_const_const_const(A_RLWIMI,reg1, list.concat(taicpu.op_reg_reg_const_const_const(A_RLWIMI,dst,
reg2,0,l1,l2)); scratchreg,0,l1,l2));
free_scratch_reg(list,scratch_reg); free_scratch_reg(list,scratchreg);
end end
else else
useReg := true; useReg := true;
OP_AND: OP_AND:
{ try to use rlwinm } { try to use rlwinm }
if get_rlwi_const then if get_rlwi_const(a,l1,l2) then
list.concat(taicpu.op_reg_reg_const_const_const(A_RLWINM,reg1, list.concat(taicpu.op_reg_reg_const_const_const(A_RLWINM,dst,
reg2,0,l1,l2)) src,0,l1,l2))
else else
useReg := true; useReg := true;
OP_XOR: OP_XOR:
@ -956,26 +1011,27 @@ const
begin begin
scratchreg := get_scratch_reg(list); scratchreg := get_scratch_reg(list);
a_load_const_reg(list,OS_32,a,scratchreg); a_load_const_reg(list,OS_32,a,scratchreg);
a_op_reg_reg_reg(list,op,reg1,scratchreg,reg2); a_op_reg_reg_reg(list,op,scratchreg,src,dst);
free_scratch_reg(list,scratchreg); free_scratch_reg(list,scratchreg);
end; end;
end; end;
procedure tcgppc.a_op_reg_reg_reg(list: taasmoutput; op: TOpCg; procedure tcgppc.a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
dst, src1, src2: tregister); src1, src2, dst: tregister);
const const
op_reg_reg_opcg2asmop: array[TOpCG] of tasmop = 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_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) A_SRAW,A_SLW,A_SRW,A_SUB,A_XOR);
begin begin
Case Op of case op of
OP_NEG,OP_NOT: OP_NEG,OP_NOT:
list.concat(taicpu.op_reg_reg(op_reg_reg_opcg2asmop[op],size,dst,dst)); list.concat(taicpu.op_reg_reg(op_reg_reg_opcg2asmop[op],dst,dst));
else else
list.concat(taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop[op],size,dst,src1,src2)); list.concat(taicpu.op_reg_reg_reg(op_reg_reg_opcg2asmop[op],dst,src2,src1));
end;
end; end;
@ -1009,10 +1065,10 @@ const
end; end;
procedure tcgppc.a_jmp(list: taasmoutput; op: tasmop; c: tasmcondflags; procedure tcgppc.a_jmp(list: taasmoutput; op: tasmop; c: tasmcondflag;
l: pasmlabel); l: tasmlabel);
var var
p: paicpu; p: taicpu;
begin begin
p := taicpu.op_sym(op,newasmsymbol(l.name)); p := taicpu.op_sym(op,newasmsymbol(l.name));
@ -1020,10 +1076,18 @@ const
list.concat(p) list.concat(p)
end; end;
begin
cg := tcgppc.create;
end. end.
{ {
$Log$ $Log$
Revision 1.8 2001-10-28 14:16:49 jonas Revision 1.9 2001-12-29 15:28:58 jonas
* powerpc/cgcpu.pas compiles :)
* several powerpc-related fixes
* cpuasm unit is now based on common tainst unit
+ nppcmat unit for powerpc (almost complete)
Revision 1.8 2001/10/28 14:16:49 jonas
* small fixes * small fixes
Revision 1.7 2001/09/29 21:33:30 jonas Revision 1.7 2001/09/29 21:33:30 jonas

View File

@ -22,11 +22,13 @@
} }
unit cpuasm; unit cpuasm;
{$i defines.inc}
interface interface
uses uses
cclasses, cclasses,tainst,
aasm,globals,verbose,tainst, aasm,globals,verbose,
cpubase; cpubase;
type type
@ -411,7 +413,13 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.2 2001-08-26 13:31:04 florian Revision 1.3 2001-12-29 15:28:58 jonas
* powerpc/cgcpu.pas compiles :)
* several powerpc-related fixes
* cpuasm unit is now based on common tainst unit
+ nppcmat unit for powerpc (almost complete)
Revision 1.2 2001/08/26 13:31:04 florian
* some cg reorganisation * some cg reorganisation
* some PPC updates * some PPC updates

View File

@ -209,7 +209,7 @@ type
{$ifndef tp} {$ifndef tp}
{$minenumsize 1} {$minenumsize 1}
{$endif tp} {$endif tp}
TAsmCondFlags = (C_None { unconditional junps }, TAsmCondFlag = (C_None { unconditional junps },
{ conditions when not using ctr decrement etc } { conditions when not using ctr decrement 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, C_LT,C_LE,C_EQ,C_GE,C_GT,C_NL,C_NE,C_NG,C_SO,C_NS,C_UN,C_NU,
{ conditions when using ctr decrement etc } { conditions when using ctr decrement etc }
@ -222,28 +222,28 @@ type
case simple: boolean of case simple: boolean of
false: (BO, BI: byte); false: (BO, BI: byte);
true: ( true: (
case cond: TAsmCondFlags of cond: TAsmCondFlag;
C_None: (); case byte of
0: ();
{ 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,..,bnu }
C_LT..C_NU: (cr: R_CR0..R_CR7); 1: (cr: R_CR0..R_CR7);
{ specifies the bit to test for bt,bf,bdz etc. } { specifies the bit to test for bt,bf,bdz,..,bdzf }
C_T..C_DZF: 2: (crbit: byte)
(crbit: byte)
); );
end; end;
const const
AsmCondFlag2BO: Array[C_T..C_DZF] of Byte = AsmCondFlag2BO: Array[C_T..C_DZF] of Byte =
(12,4,16,8,0,18,10,2); (12,4,16,8,0,18,10,2);
AsmCondFlag2BI: Array[C_LR..C_NU] of Byte = AsmCondFlag2BI: Array[C_LT..C_NU] of Byte =
(0,1,2,0,1,0,2,1,3,3,3,3); (0,1,2,0,1,0,2,1,3,3,3,3);
AsmCondFlagTF: Array[TAsmCondFlags] of Boolean = AsmCondFlagTF: Array[TAsmCondFlag] of Boolean =
(false,true,false,true,false,true,false,false,false,true,false,true,false, (false,true,false,true,false,true,false,false,false,true,false,true,false,
true,false,false,true,false,false,true,false); true,false,false,true,false,false,true,false);
AsmCondFlag2Str: Array[tasmcondflags] of string[2] = ({cf_none}'', AsmCondFlag2Str: Array[TAsmCondFlag] of string[4] = ({cf_none}'',
{ conditions when not using ctr decrement etc} { conditions when not using ctr decrement etc}
'lt','le','eq','ge','gt','nl','ne','ng','so','ns','un','nu', 'lt','le','eq','ge','gt','nl','ne','ng','so','ns','un','nu',
't','f','dnz','dzt','dnzf','dz','dzt','dzf'); 't','f','dnz','dzt','dnzf','dz','dzt','dzf');
@ -266,12 +266,13 @@ type
flag: TResFlagsEnum; flag: TResFlagsEnum;
end; end;
(*
const const
{ arrays for boolean location conversions } { arrays for boolean location conversions }
{
flag_2_cond : array[TResFlags] of TAsmCond = flag_2_cond : array[TResFlags] of TAsmCond =
(C_E,C_NE,C_LT,C_LE,C_GT,C_GE,???????????????); (C_E,C_NE,C_LT,C_LE,C_GT,C_GE,???????????????);
} *)
{***************************************************************************** {*****************************************************************************
Reference Reference
@ -459,9 +460,10 @@ const
function is_calljmp(o:tasmop):boolean; function is_calljmp(o:tasmop):boolean;
procedure inverse_flags(var f: TResFlags);
procedure inverse_cond(c: TAsmCond;var r : TAsmCond); procedure inverse_cond(c: TAsmCond;var r : TAsmCond);
procedure create_cond_imm(BO,BI:byte;var r : TAsmCond); procedure create_cond_imm(BO,BI:byte;var r : TAsmCond);
procedure create_cond_norm(cond: TAsmCondFlags; cr: byte;var r : TasmCond); procedure create_cond_norm(cond: TAsmCondFlag; cr: byte;var r : TasmCond);
procedure clear_location(var loc : tlocation); procedure clear_location(var loc : tlocation);
procedure set_location(var destloc,sourceloc : tlocation); procedure set_location(var destloc,sourceloc : tlocation);
@ -533,10 +535,17 @@ implementation
new_reference:=r; new_reference:=r;
end; end;
procedure inverse_flags(var f: TResFlags);
const
flagsinvers : array[F_EQ..F_GE] of tresflagsenum =
(F_NE,F_EQ,F_GE,F_GT,F_LE,F_LT);
begin
f.flag := flagsinvers[f.flag];
end;
procedure inverse_cond(c: TAsmCond;var r : TAsmCond); procedure inverse_cond(c: TAsmCond;var r : TAsmCond);
const const
inv_condflags:array[TAsmCondFlags] of TAsmCondFlags=(C_None, inv_condflags:array[TAsmCondFlag] of TAsmCondFlag=(C_None,
C_GE,C_GT,C_NE,C_LT,C_LE,C_LT,C_EQ,C_GT,C_NS,C_SO,C_NU,C_UN, C_GE,C_GT,C_NE,C_LT,C_LE,C_LT,C_EQ,C_GT,C_NS,C_SO,C_NU,C_UN,
C_F,C_T,C_DNZ,C_DNZF,C_DNZT,C_DZ,C_DZF,C_DZT); C_F,C_T,C_DNZ,C_DNZF,C_DNZT,C_DZ,C_DZF,C_DZT);
begin begin
@ -545,27 +554,23 @@ implementation
end; end;
procedure create_cond_imm(BO,BI:byte;var r : TAsmCond); procedure create_cond_imm(BO,BI:byte;var r : TAsmCond);
var c: tasmcond;
begin begin
c.simple := false; r.simple := false;
c.bo := bo; r.bo := bo;
c.bi := bi; r.bi := bi;
r := c
end; end;
procedure create_cond_norm(cond: TAsmCondFlags; cr: byte;var r : TasmCond); procedure create_cond_norm(cond: TAsmCondFlag; cr: byte;var r : TasmCond);
const cr2reg: array[0..7] of tregister = const cr2reg: array[0..7] of tregister =
(R_CR0,R_CR1,R_CR2,R_CR3,R_CR4,R_CR5,R_CR6,R_CR7); (R_CR0,R_CR1,R_CR2,R_CR3,R_CR4,R_CR5,R_CR6,R_CR7);
var c: tasmcond;
begin begin
c.simple := true; r.simple := true;
c.cond := cond; r.cond := cond;
case cond of case cond of
C_NONE:; C_NONE:;
C_T..C_DZF: c.crbit := cr C_T..C_DZF: r.crbit := cr
else c.cr := cr2reg[cr]; else r.cr := cr2reg[cr];
end; end;
r := c;
end; end;
procedure clear_location(var loc : tlocation); procedure clear_location(var loc : tlocation);
@ -607,7 +612,13 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.4 2001-09-28 20:40:05 jonas Revision 1.5 2001-12-29 15:28:58 jonas
* powerpc/cgcpu.pas compiles :)
* several powerpc-related fixes
* cpuasm unit is now based on common tainst unit
+ nppcmat unit for powerpc (almost complete)
Revision 1.4 2001/09/28 20:40:05 jonas
* several additions, almost complete (only some problems with resflags left) * several additions, almost complete (only some problems with resflags left)
Revision 1.3 2001/09/06 15:25:56 jonas Revision 1.3 2001/09/06 15:25:56 jonas

View File

@ -34,7 +34,7 @@ Type
{ pointer(-1) will result in a pointer with the value } { pointer(-1) will result in a pointer with the value }
{ $fffffffffffffff on a 32bit machine if the compiler uses } { $fffffffffffffff on a 32bit machine if the compiler uses }
{ int64 constants internally (JM) } { int64 constants internally (JM) }
TPointerOrd = DWord; TConstPtrUInt = DWord;
Const Const
{ Size of native extended type } { Size of native extended type }
@ -45,7 +45,13 @@ Implementation
end. end.
{ {
$Log$ $Log$
Revision 1.1 2001-08-26 13:31:04 florian Revision 1.2 2001-12-29 15:28:58 jonas
* powerpc/cgcpu.pas compiles :)
* several powerpc-related fixes
* cpuasm unit is now based on common tainst unit
+ nppcmat unit for powerpc (almost complete)
Revision 1.1 2001/08/26 13:31:04 florian
* some cg reorganisation * some cg reorganisation
* some PPC updates * some PPC updates

View File

@ -129,7 +129,7 @@ implementation
if location = LOC_REGISTER then if location = LOC_REGISTER then
location.register:= left.location.register location.register:= left.location.register
else else
location.register := getregister32; location.register := getregisterint;
case opsize of case opsize of
OS_8: OS_8:
exprasmlist.concat(taicpu.op_reg_reg_const_const_const( exprasmlist.concat(taicpu.op_reg_reg_const_const_const(
@ -172,7 +172,7 @@ implementation
LOC_REFERENCE,LOC_MEM: LOC_REFERENCE,LOC_MEM:
begin begin
del_reference(left.location.reference); del_reference(left.location.reference);
location.register := getregister32; location.register := getregisterint;
if not (opsize in [OS_64,OS_S64]) then if not (opsize in [OS_64,OS_S64]) then
tempsize := pred(opsize) tempsize := pred(opsize)
else else
@ -188,7 +188,7 @@ implementation
{ instructions as appropriate, the source will contain } { instructions as appropriate, the source will contain }
{ the correct value already, so simply copy it } { the correct value already, so simply copy it }
begin begin
location.register := getregister32; location.register := getregisterint;
exprasmlist.concat(taicpu.op_reg_reg(A_MR,location.register, exprasmlist.concat(taicpu.op_reg_reg(A_MR,location.register,
left.location.register)); left.location.register));
end; end;
@ -198,7 +198,7 @@ implementation
{ sign extend even further if necessary } { sign extend even further if necessary }
if opsize in [OS_64,OS_S64] then if opsize in [OS_64,OS_S64] then
begin begin
location.registerhigh := getregister32; location.registerhigh := getregisterint;
if (opsize = OS_64) or if (opsize = OS_64) or
not (is_signed(left.resulttype.def)) then not (is_signed(left.resulttype.def)) then
cg.a_load_const_reg(exprasmlist,OS_32,0, cg.a_load_const_reg(exprasmlist,OS_32,0,
@ -349,13 +349,13 @@ implementation
if left.location.loc in [LOC_MEM,LOC_REFERENCE] then if left.location.loc in [LOC_MEM,LOC_REFERENCE] then
begin begin
del_reference(left.location); del_reference(left.location);
hreg2:=getregister32; hreg2:=getregisterint;
cg.a_load_ref_reg(exprasmlist,opsize, cg.a_load_ref_reg(exprasmlist,opsize,
left.location.reference,hreg2); left.location.reference,hreg2);
end end
else else
hreg2 := left.location.register; hreg2 := left.location.register;
hreg1 := getregister32; hreg1 := getregisterint;
exprasmlist.concat(taicpu.op_reg_reg_const(A_SUBIC,hreg1, exprasmlist.concat(taicpu.op_reg_reg_const(A_SUBIC,hreg1,
hreg2,1); hreg2,1);
exprasmlist.concat(taicpu.op_reg_reg_reg(A_SUBFE,hreg1,hreg1, exprasmlist.concat(taicpu.op_reg_reg_reg(A_SUBFE,hreg1,hreg1,
@ -364,7 +364,7 @@ implementation
end; end;
LOC_FLAGS : LOC_FLAGS :
begin begin
hreg1:=getregister32; hreg1:=getregisterint;
resflags:=left.location.resflags; resflags:=left.location.resflags;
emit_flag2reg(resflags,hreg1); emit_flag2reg(resflags,hreg1);
end; end;
@ -379,7 +379,13 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.3 2001-10-28 14:17:10 jonas Revision 1.4 2001-12-29 15:28:58 jonas
* powerpc/cgcpu.pas compiles :)
* several powerpc-related fixes
* cpuasm unit is now based on common tainst unit
+ nppcmat unit for powerpc (almost complete)
Revision 1.3 2001/10/28 14:17:10 jonas
+ second_int_to_real for cardinal, int64 and qword + second_int_to_real for cardinal, int64 and qword
Revision 1.2 2001/10/01 12:17:26 jonas Revision 1.2 2001/10/01 12:17:26 jonas

View File

@ -0,0 +1,490 @@
{
$Id$
Copyright (c) 1998-2000 by Florian Klaempfl
Generate PowerPC assembler for math nodes
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
****************************************************************************
}
unit nppcmat;
{$i defines.inc}
interface
uses
node,nmat;
type
tppcmoddivnode = class(tmoddivnode)
procedure pass_2;override;
end;
tppcshlshrnode = class(tshlshrnode)
procedure pass_2;override;
end;
tppcunaryminusnode = class(tunaryminusnode)
procedure pass_2;override;
end;
tppcnotnode = class(tnotnode)
procedure pass_2;override;
end;
implementation
uses
globtype,systems,
cutils,verbose,globals,
symconst,symdef,aasm,types,
cgbase,cgobj,temp_gen,pass_1,pass_2,
ncon,
cpubase,
cga,tgcpu,nppcutil,cgcpu;
{*****************************************************************************
TPPCMODDIVNODE
*****************************************************************************}
procedure tppcmoddivnode.pass_2;
const
{ signed overflow }
divops: array[boolean, boolean] of tasmop =
((A_DIVWU,A_DIVWUO),(A_DIVW,A_DIVWO));
var
power,
l1, l2 : longint;
op : tasmop;
numerator,
divider,
resultreg : tregister;
saved : boolean;
begin
secondpass(left);
saved:=maybe_savetotemp(right.registers32,left,is_64bitint(left.resulttype.def));
secondpass(right);
if saved then
restorefromtemp(left,is_64bitint(left.resulttype.def));
set_location(location,left.location);
resultreg := R_NO;
{ put numerator in register }
if (left.location.loc in [LOC_REFERENCE,LOC_MEM]) then
begin
del_reference(left.location.reference);
numerator := getregisterint;
{ OS_32 because everything is always converted to longint/ }
{ cardinal in the resulttype pass (JM) }
cg.a_load_ref_reg(expraslist,OS_32,left.location.reference,
numerator);
resultreg := numerator;
end
else
begin
numerator := left.location.register;
if left.location.loc = LOC_CREGISTER then
resultreg := getregisterint
else
resultreg := numerator;
end;
if (nodetype = divn) and
(right.nodetype = ordconstn) and
ispowerof2(tordconstnode(right).value,power) then
begin
{ From 'The PowerPC Compiler Writer's Guide": }
{ This code uses the fact that, in the PowerPC architecture, }
{ the shift right algebraic instructions set the Carry bit if }
{ the source register contains a negative number and one or }
{ more 1-bits are shifted out. Otherwise, the carry bit is }
{ cleared. The addze instruction corrects the quotient, if }
{ necessary, when the dividend is negative. For example, if }
{ n = -13, (0xFFFF_FFF3), and k = 2, after executing the srawi }
{ instruction, q = -4 (0xFFFF_FFFC) and CA = 1. After executing }
{ the addze instruction, q = -3, the correct quotient. }
cg.a_op_reg_reg_reg(OP_SAR,power,numerator,resultreg);
exprasmlist.concat(taicpu.op_reg_reg(A_ADDZE,resultreg,resultreg));
end
else
begin
{ load divider in a register if necessary }
case right.location.loc of
LOC_CREGISTER, LOC_REGISTER:
divider := right.location.register;
LOC_REFERENCE, LOC_MEM:
begin
divider := cg.get_scratch_reg(exprasmlist);
cg.a_load_ref_reg(exprasmlist,OS_32,
right.location.reference,divider);
del_reference(right.location.reference);
end;
end;
{ needs overflow checking, (-maxlongint-1) div (-1) overflows! }
{ (JM) }
op := divops[is_signed(right.resulttype.def),
cs_check_overflow in aktlocalswitches];
exprasmlist(taicpu.op_reg_reg_reg(op,resultreg,numerator,
divider))
end;
{ free used registers }
if right.location.loc in [LOC_REFERENCE,LOC_MEM] then
cg.free_scratch_reg(exprasmlist,divider)
else
ungetregister(divider);
if numerator <> resultreg then
ungetregisterint(numerator);
{ set result location }
location.loc:=LOC_REGISTER;
location.register:=resultreg;
emitoverflowcheck(self);
end;
{*****************************************************************************
TPPCSHLRSHRNODE
*****************************************************************************}
procedure tppcshlshrnode.pass_2;
var
resultreg, hregister1,hregister2,hregister3,
hregisterhigh,hregisterlow : tregister;
op : topcg;
saved : boolean;
begin
secondpass(left);
saved:=maybe_savetotemp(right.registers32,left,is_64bitint(left.resulttype.def));
secondpass(right);
if saved then
restorefromtemp(left,is_64bitint(left.resulttype.def));
if is_64bitint(left.resulttype.def) then
begin
{ see green book appendix E, still needs to be implemented }
end
else
begin
{ load left operators in a register }
if (left.location.loc in [LOC_REFERENCE,LOC_MEM]) then
begin
del_reference(left.location.reference);
hregister1 := getregisterint;
{ OS_32 because everything is always converted to longint/ }
{ cardinal in the resulttype pass (JM) }
cg.a_load_ref_reg(expraslist,OS_32,left.location.reference,
hregister1);
resultreg := hregister1;
end
else
begin
hregister1 := left.location.register;
if left.location.loc = LOC_CREGISTER then
resultreg := getregisterint
else
resultreg := hregister1;
end;
{ determine operator }
if nodetype=shln then
op:=OP_SHL
else
op:=OP_SHR;
{ shifting by a constant directly coded: }
if (right.nodetype=ordconstn) then
cg.a_op_reg_reg_const(exprasmlist,op,OS_32,resultreg,
hregister1,tordconstnode(right).value and 31)
else
begin
{ load shift count in a register if necessary }
case right.location.loc of
LOC_CREGISTER, LOC_REGISTER:
hregister2 := right.location.register;
LOC_REFERENCE, LOC_MEM:
begin
hregister2 := cg.get_scratch_reg(exprasmlist);
cg.a_load_ref_reg(exprasmlist,OS_32,
right.location.reference,hregister2);
del_reference(right.location.reference);
end;
end;
tcgppc(cg).a_op_reg_reg_reg(exprasmlist,op,hregister1,
hregister2,resultreg);
if right.location.loc in [LOC_REFERENCE,LOC_MEM] then
cg.free_scratch_reg(exprasmlist,hregister2)
else
ungetregister(hregister2);
end;
{ set result location }
location.loc:=LOC_REGISTER;
location.register:=resultreg;
end;
end;
{*****************************************************************************
TPPCUNARYMINUSNODE
*****************************************************************************}
procedure tppcunaryminusnode.pass_2;
var
src1, src2, tmp: tregister;
op: tasmop;
begin
secondpass(left);
if is_64bitint(left.resulttype.def) then
begin
clear_location(location);
location.loc:=LOC_REGISTER;
case left.location.loc of
LOC_REGISTER, LOC_CREGISTER :
begin
src1 := left.location.registerlow;
src2 := left.location.registerhigh;
if left.location.loc = LOC_REGISTER then
begin
location.registerlow:=src1;
location.registerhigh:=src2;
end
else
begin
location.registerlow := getregisterint;
location.registerhigh := getregisterint;
end;
end;
LOC_REFERENCE,LOC_MEM :
begin
del_reference(left.location.reference);
location.registerlow:=getregisterint;
src1 := location.registerlow;
location.registerhigh:=getregisterint;
src2 := location.registerhigh;
tcg64f32(cg).a_load64_ref_reg(exprasmlist,left.location.reference,
location.registerlow,
location.registerhigh);
end;
end;
exprasmlist.concat(taicpu.op_reg_reg(A_NEG,location.registerlow,
src1));
cg.a_op_reg_reg(OP_NOT,OS_32,src2,location.registerhigh);
tmp := cg.get_scratch_reg(exprasmlist);
tcgppc(cg).a_op_const_reg_reg(OP_SAR,31,location.registerlow,tmp);
if not(cs_check_overflow in aktlocalswitches) then
cg.a_op_reg_reg(OP_ADD,OS_32,location.registerhigh,tmp)
else
exprasmlist.concat(taicpu.op_reg_reg_reg(A_ADDO,tmp,
location.registerhigh,tmp));
cg.free_scratch_reg(exprasmlist,tmp);
end
else
begin
location.loc:=LOC_REGISTER;
case left.location.loc of
LOC_FPU, LOC_REGISTER:
begin
src1 := left.location.register;
location.register := src1;
end;
LOC_CFPUREGISTER, LOC_CREGISTER:
begin
src1 := left.location.register;
if left.location.loc = LOC_CREGISTER then
location.register := getregisterint
else
location.register := getregisterfpu;
end;
LOC_REFERENCE,LOC_MEM:
begin
del_reference(left.location.reference);
if (left.resulttype.def.deftype=floatdef) then
begin
src1 := getregisterfpu;
location.register := src1;
floatload(tfloatdef(left.resulttype.def).typ,
left.location.reference,src1);
end
else
begin
src1 := getregisterint;
location.register:= src1;
cg.a_load_ref_reg(exprasmlist,OS_32,
left.location.reference,src1);
end;
end;
end;
{ choose appropriate operand }
if left.resulttype.def <> floatdef then
if not(cs_check_overflow in aktlocalswitches) then
op := A_NEG
else
op := A_NEGO
else
op := A_FNEG;
{ emit operation }
eprasmlist.concat(taicpu.op_reg_reg(op,location.register,src1));
end;
{ Here was a problem... }
{ Operand to be negated always }
{ seems to be converted to signed }
{ 32-bit before doing neg!! }
{ So this is useless... }
{ that's not true: -2^31 gives an overflow error if it is negated (FK) }
emitoverflowcheck(self);
end;
{*****************************************************************************
TPPCNOTNODE
*****************************************************************************}
procedure tppcnotnode.pass_2;
var
hl : tasmlabel;
regl, regh: tregister;
begin
if is_boolean(resulttype.def) then
begin
{ the second pass could change the location of left }
{ if it is a register variable, so we've to do }
{ this before the case statement }
if left.location.loc in [LOC_REFERENCE,LOC_MEM,
LOC_FLAGS,LOC_REGISTER,LOC_CREGISTER] then
secondpass(left);
case left.location.loc of
LOC_JUMP :
begin
hl:=truelabel;
truelabel:=falselabel;
falselabel:=hl;
secondpass(left);
maketojumpbool(left,lr_load_regvars);
hl:=truelabel;
truelabel:=falselabel;
falselabel:=hl;
end;
LOC_FLAGS :
location.resflags:=inverse_flags(left.location.resflags);
LOC_REGISTER, LOC_CREGISTER, LOC_REFERENCE, LOC_MEM :
begin
if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
regl := left.location.register
else
begin
regl := getregisterint;
cg.a_load_ref_reg(exprasmlist,def_cgsize(left.resulttype.def),
left.location.reference,regl);
end;
location.loc:=LOC_FLAGS;
location.resflags.cr:=0;
location.resflags.flag:=F_EQ;
exprasmlist.concat(taicpu.op_reg_const(A_CMPWI,regl,0));
ungetregister(regl);
end;
end;
end
else if is_64bitint(left.resulttype.def) then
begin
secondpass(left);
clear_location(location);
location.loc:=LOC_REGISTER;
{ make sure left is in a register and set the dest register }
case left.location.loc of
LOC_REFERENCE, LOC_MEM, LOC_CREGISTER:
begin
location.registerlow := getregisterint;
location.registerhigh := getregisterint;
if left.location.loc <> LOC_CREGISTER then
begin
tcg64f32(cg).a_load64_ref_reg(exprasmlist,
left.location.reference,location.registerlow,
location.registerhigh);
regl := location.registerlow;
regh := location.registerhigh;
end
else
begin
regl := left.location.registerlow;
regh := left.location.registerhigh;
end;
end;
LOC_REGISTER:
begin
regl := left.location.registerlow;
location.registerlow := regl;
regh := left.location.registerhigh;
location.registerhigh := regh;
end;
end;
{ perform the NOT operation }
exprasmlist.concat(taicpu.op_reg_reg(A_NOT,location.registerhigh,
regh);
exprasmlist.concat(taicpu.op_reg_reg(A_NOT,location.registerlow,
regl);
end
else
begin
secondpass(left);
clear_location(location);
location.loc:=LOC_REGISTER;
{ make sure left is in a register and set the dest register }
case left.location.loc of
LOC_REFERENCE, LOC_MEM, LOC_CREGISTER:
begin
location.register := getregisterint;
if left.location.loc <> LOC_CREGISTER then
begin
cg.a_load_ref_reg(exprasmlist,left.location.reference,
location.register);
regl := location.register;
end
else
regl := left.location.register;
end;
LOC_REGISTER:
regl := left.location.register;
end;
{ perform the NOT operation }
exprasmlist.concat(taicpu.op_reg_reg(A_NOT,location.register,
regl);
{ release the source reg if it wasn't reused }
if regl <> location.register then
ungetregisterint(regl);
end;
end;
begin
cmoddivnode:=tppcmoddivnode;
cshlshrnode:=tppcshlshrnode;
cunaryminusnode:=tppcunaryminusnode;
cnotnode:=tppcnotnode;
end.
{
$Log$
Revision 1.1 2001-12-29 15:28:58 jonas
* powerpc/cgcpu.pas compiles :)
* several powerpc-related fixes
* cpuasm unit is now based on common tainst unit
+ nppcmat unit for powerpc (almost complete)
}

View File

@ -47,6 +47,9 @@ unit tgcpu;
{ tries to allocate the passed register, if possible } { tries to allocate the passed register, if possible }
function getexplicitregisterint(r : tregister) : tregister; function getexplicitregisterint(r : tregister) : tregister;
function getregisterfpu : tregister;
function ungetregisterfpu : tregister;
procedure ungetregister(r : tregister); procedure ungetregister(r : tregister);
procedure cleartempgen; procedure cleartempgen;
@ -76,8 +79,7 @@ unit tgcpu;
var var
unused,usableregs : tregisterset; unused,usableregs : tregisterset;
{ uses only 1 byte while a set uses in FPC 32 bytes } usedinproc : set of TREGISTER;
usedinproc : byte;
{ count, how much a register must be pushed if it is used as register } { count, how much a register must be pushed if it is used as register }
{ variable } { variable }
@ -104,6 +106,14 @@ implementation
begin begin
end; end;
function getregisterfpu : tregister;
begin
end;
function ungetregisterfpu : tregister;
begin
end;
procedure ungetregister(r : tregister); procedure ungetregister(r : tregister);
begin begin
end; end;
@ -160,7 +170,13 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.1 2001-08-26 13:31:04 florian Revision 1.2 2001-12-29 15:28:58 jonas
* powerpc/cgcpu.pas compiles :)
* several powerpc-related fixes
* cpuasm unit is now based on common tainst unit
+ nppcmat unit for powerpc (almost complete)
Revision 1.1 2001/08/26 13:31:04 florian
* some cg reorganisation * some cg reorganisation
* some PPC updates * some PPC updates

View File

@ -49,7 +49,7 @@ implementation
globtype,systems,comphook, globtype,systems,comphook,
cutils,cclasses,verbose,globals, cutils,cclasses,verbose,globals,
symconst,symbase,symtype,symdef,types, symconst,symbase,symtype,symdef,types,
cgbase,cpuasm,cgobj,cgcpu,cga; tainst,cgbase,cpuasm,cgobj,cgcpu,cga;
var var
parasym : boolean; parasym : boolean;
@ -463,7 +463,13 @@ end.
{ {
$Log$ $Log$
Revision 1.21 2001-12-03 12:17:02 jonas Revision 1.22 2001-12-29 15:32:13 jonas
* powerpc/cgcpu.pas compiles :)
* several powerpc-related fixes
* cpuasm unit is now based on common tainst unit
+ nppcmat unit for powerpc (almost complete)
Revision 1.21 2001/12/03 12:17:02 jonas
* forgot to commit yesterday :( (less unnecessary loading of regvars with * forgot to commit yesterday :( (less unnecessary loading of regvars with
if-statements) if-statements)

View File

@ -22,34 +22,39 @@
} }
Unit tainst; Unit tainst;
{$i defines.inc}
interface interface
Uses aasm,cpubase,cpuinfo,cclasses; Uses aasm,cpubase,cpuinfo,cclasses;
Type Type
tairegalloc = class(tai) tairegalloc = class(tai)
allocation : boolean; allocation : boolean;
reg : tregister; reg : tregister;
constructor alloc(r : tregister); constructor alloc(r : tregister);
constructor dealloc(r : tregister); constructor dealloc(r : tregister);
end; end;
tainstruction = class(tai) tainstruction = class(tai)
is_jmp : boolean; { is this instruction a jump? (needed for optimizer) } condition : TAsmCond;
opcode : tasmop; ops : longint;
condition : TAsmCond; oper : array[0..max_operands-1] of toper;
ops : longint; opcode : tasmop;
oper : array[0..max_operands-1] of toper; {$ifdef i386}
Constructor Create(op : tasmop); segprefix : tregister;
Destructor Destroy;override; {$endif i386}
function getcopy:tlinkedlistitem;virtual; is_jmp : boolean; { is this instruction a jump? (needed for optimizer) }
procedure loadconst(opidx:longint;l:longint); Constructor Create(op : tasmop);
procedure loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint); Destructor Destroy;override;
procedure loadref(opidx:longint;p:preference); function getcopy:tlinkedlistitem;override;
procedure loadreg(opidx:longint;r:tregister); procedure loadconst(opidx:longint;l:longint);
procedure loadoper(opidx:longint;o:toper); procedure loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
procedure SetCondition(c:TAsmCond); procedure loadref(opidx:longint;p:preference);
procedure loadreg(opidx:longint;r:tregister);
procedure loadoper(opidx:longint;o:toper);
procedure SetCondition(const c:TAsmCond);
end; end;
implementation implementation
@ -58,22 +63,22 @@ implementation
TaiRegAlloc TaiRegAlloc
*****************************************************************************} *****************************************************************************}
constructor tairegalloc.alloc(r : tregister); constructor tairegalloc.alloc(r : tregister);
begin begin
inherited create; inherited create;
typ:=ait_regalloc; typ:=ait_regalloc;
allocation:=true; allocation:=true;
reg:=r; reg:=r;
end; end;
constructor tairegalloc.dealloc(r : tregister); constructor tairegalloc.dealloc(r : tregister);
begin begin
inherited create; inherited create;
typ:=ait_regalloc; typ:=ait_regalloc;
allocation:=false; allocation:=false;
reg:=r; reg:=r;
end; end;
{ --------------------------------------------------------------------- { ---------------------------------------------------------------------
TaInstruction Constructor/Destructor TaInstruction Constructor/Destructor
@ -81,30 +86,34 @@ constructor tairegalloc.dealloc(r : tregister);
Constructor tainstruction.Create(op : tasmop); constructor Tainstruction.Create(op : tasmop);
begin begin
inherited create; inherited create;
typ:=ait_instruction; typ:=ait_instruction;
is_jmp:=false; is_jmp:=false;
opcode:=op; opcode:=op;
ops:=0; ops:=0;
fillchar(condition,sizeof(condition),0); fillchar(condition,sizeof(condition),0);
fillchar(oper,sizeof(oper),0); fillchar(oper,sizeof(oper),0);
end; end;
Destructor Tainstruction.Destroy; destructor Tainstruction.Destroy;
Var i : longint; var
i : longint;
begin begin
for i:=1 to ops do for i:=0 to ops-1 do
if (oper[i-1].typ=top_ref) then case oper[i].typ of
dispose(oper[i-1].ref); top_ref:
inherited destroy; dispose(oper[i].ref);
end; top_symbol:
dec(tasmsymbol(oper[0].sym).refs);
end;
inherited destroy;
end;
@ -114,134 +123,141 @@ end;
procedure tainstruction.loadconst(opidx:longint;l:longint); procedure tainstruction.loadconst(opidx:longint;l:longint);
begin
begin if opidx>=ops then
if opidx>=ops then ops:=opidx+1;
ops:=opidx+1; with oper[opidx] do
with oper[opidx] do begin
begin if typ=top_ref then
if typ=top_ref then disposereference(ref);
disposereference(ref); val:=l;
val:=l; typ:=top_const;
typ:=top_const; end;
end; end;
end;
procedure tainstruction.loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint); procedure tainstruction.loadsymbol(opidx:longint;s:tasmsymbol;sofs:longint);
begin begin
if opidx>=ops then if opidx>=ops then
ops:=opidx+1; ops:=opidx+1;
with oper[opidx] do with oper[opidx] do
begin begin
if typ=top_ref then if typ=top_ref then
disposereference(ref); disposereference(ref);
sym:=s; sym:=s;
symofs:=sofs; symofs:=sofs;
typ:=top_symbol; typ:=top_symbol;
end; end;
{ Mark the symbol as used } { Mark the symbol as used }
if assigned(s) then if assigned(s) then
inc(s.refs); inc(s.refs);
end; end;
procedure tainstruction.loadref(opidx:longint;p:preference); procedure tainstruction.loadref(opidx:longint;p:preference);
begin begin
if opidx>=ops then if opidx>=ops then
ops:=opidx+1; ops:=opidx+1;
with oper[opidx] do with oper[opidx] do
begin begin
if typ=top_ref then if typ=top_ref then
disposereference(ref); disposereference(ref);
if p^.is_immediate then if p^.is_immediate then
begin begin
val:=p^.offset; {$ifdef REF_IMMEDIATE_WARN}
disposereference(p); Comment(V_Warning,'Reference immediate');
typ:=top_const;
end
else
begin
ref:=p;
{ We allow this exception for i386, since overloading this would be
too much of a a speed penalty}
{$ifdef i386}
if not(ref^.segment in [R_DS,R_NO]) then
segprefix:=ref^.segment;
{$endif} {$endif}
typ:=top_ref; val:=p^.offset;
{ mark symbol as used } disposereference(p);
if assigned(ref^.symbol) then typ:=top_const;
inc(ref^.symbol.refs); end
end; else
end; begin
end; ref:=p;
{ We allow this exception for i386, since overloading this would be
too much of a a speed penalty}
{$ifdef i386}
if not(ref^.segment in [R_DS,R_NO]) then
segprefix:=ref^.segment;
{$endif}
typ:=top_ref;
{ mark symbol as used }
if assigned(ref^.symbol) then
inc(ref^.symbol.refs);
end;
end;
end;
procedure tainstruction.loadreg(opidx:longint;r:tregister); procedure tainstruction.loadreg(opidx:longint;r:tregister);
begin begin
if opidx>=ops then if opidx>=ops then
ops:=opidx+1; ops:=opidx+1;
with oper[opidx] do with oper[opidx] do
begin begin
if typ=top_ref then if typ=top_ref then
disposereference(ref); disposereference(ref);
reg:=r; reg:=r;
typ:=top_reg; typ:=top_reg;
end; end;
end; end;
procedure tainstruction.loadoper(opidx:longint;o:toper); procedure tainstruction.loadoper(opidx:longint;o:toper);
begin begin
if opidx>=ops then if opidx>=ops then
ops:=opidx+1; ops:=opidx+1;
if oper[opidx].typ=top_ref then if oper[opidx].typ=top_ref then
disposereference(oper[opidx].ref); disposereference(oper[opidx].ref);
oper[opidx]:=o; oper[opidx]:=o;
{ copy also the reference } { copy also the reference }
if oper[opidx].typ=top_ref then if oper[opidx].typ=top_ref then
oper[opidx].ref:=newreference(o.ref^); oper[opidx].ref:=newreference(o.ref^);
end; end;
{ --------------------------------------------------------------------- { ---------------------------------------------------------------------
Miscellaneous methods. Miscellaneous methods.
---------------------------------------------------------------------} ---------------------------------------------------------------------}
procedure tainstruction.SetCondition(c:TAsmCond); procedure tainstruction.SetCondition(const c:TAsmCond);
begin begin
condition:=c; condition:=c;
end; end;
Function tainstruction.getcopy:tlinkedlistitem; Function tainstruction.getcopy:tlinkedlistitem;
var
var i : longint;
i : longint; p : tlinkedlistitem;
p : tlinkedlistitem; begin
begin p:=inherited getcopy;
p:=inherited getcopy; { make a copy of the references }
{ make a copy of the references } for i:=1 to ops do
for i:=1 to ops do if (tainstruction(p).oper[i-1].typ=top_ref) then
if (tainstruction(p).oper[i-1].typ=top_ref) then begin
begin new(tainstruction(p).oper[i-1].ref);
new(tainstruction(p).oper[i-1].ref); tainstruction(p).oper[i-1].ref^:=oper[i-1].ref^;
tainstruction(p).oper[i-1].ref^:=oper[i-1].ref^; end;
end; getcopy:=p;
getcopy:=p; end;
end;
end. end.
{ {
$Log$ $Log$
Revision 1.1 2001-08-26 13:36:52 florian Revision 1.2 2001-12-29 15:28:57 jonas
* powerpc/cgcpu.pas compiles :)
* several powerpc-related fixes
* cpuasm unit is now based on common tainst unit
+ nppcmat unit for powerpc (almost complete)
Revision 1.1 2001/08/26 13:36:52 florian
* some cg reorganisation * some cg reorganisation
* some PPC updates * some PPC updates
@ -256,7 +272,8 @@ end.
* most things for stored properties fixed * most things for stored properties fixed
Revision 1.4 1999/09/03 13:10:11 jonas Revision 1.4 1999/09/03 13:10:11 jonas
* condition is now zeroed using fillchar\n because on powerpc it's a record now * condition is now zeroed using fillchar
because on powerpc it's a record now
Revision 1.3 1999/08/26 14:52:59 jonas Revision 1.3 1999/08/26 14:52:59 jonas
* added segprefix field for i386 in tainstruction object * added segprefix field for i386 in tainstruction object