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

* powerpc/cgcpu.pas compiles :)

Browse Source 
* 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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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
}

14
compiler/cgobj.pas
View File

@ -209,7 +209,7 @@ unit cgobj;
uses
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
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);
begin
{$ifdef i386}
include(unusedscratchregisters,makereg32(r));
{$else i386}
include(unusedscratchregisters,r);
{$endif i386}
a_reg_dealloc(list,r);
end;
@ -1280,7 +1284,13 @@ finalization
end.
{
$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
Revision 1.3 2001/09/30 16:17:17 jonas

10
compiler/i386/ag386att.pas
View File

@ -52,7 +52,7 @@ interface
dos,
{$endif Delphi}
cutils,globtype,systems,
fmodule,finput,verbose,cpubase,cpuasm
fmodule,finput,verbose,cpubase,cpuasm,tainst
{$ifdef GDB}
,gdb
{$endif GDB}
@ -949,7 +949,13 @@ initialization
end.
{
$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
Revision 1.10 2001/08/30 20:57:10 peter

10
compiler/i386/ag386nsm.pas
View File

@ -43,7 +43,7 @@ interface
sysutils,
{$endif}
cutils,globtype,globals,systems,cclasses,
fmodule,finput,verbose,cpubase,cpuasm
fmodule,finput,verbose,cpubase,cpuasm,tainst
;
const
@ -867,7 +867,13 @@ initialization
end.
{
$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
Revision 1.10 2001/04/21 15:33:03 peter

10
compiler/i386/cga.pas
View File

@ -162,7 +162,7 @@ implementation
globtype,systems,globals,verbose,
fmodule,
symbase,symsym,symtable,types,
tgcpu,temp_gen,cgbase,regvars
tainst,tgcpu,temp_gen,cgbase,regvars
{$ifdef GDB}
,gdb
{$endif}
@ -2976,7 +2976,13 @@ implementation
end.
{
$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
Revision 1.10 2001/11/06 16:39:02 jonas

64
compiler/i386/cgcpu.pas
View File

@ -109,7 +109,7 @@ unit cgcpu;
implementation
uses
globtype,globals,verbose,systems,cutils,cga;
globtype,globals,verbose,systems,cutils,cga,tgcpu;
{ 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);
var
regloadsize: tcgsize;
dstsize: topsize;
tmpreg : tregister;
popecx : boolean;
begin
dstsize := makeregsize(dst,size);
case op of
OP_NEG,OP_NOT:
begin
if src <> R_NO then
internalerror(200112291);
list.concat(taicpu.op_reg(TOpCG2AsmOp[op],dstsize,dst));
end;
OP_MUL,OP_DIV,OP_IDIV:
{ special stuff, needs separate handling inside code }
{ generator }
internalerror(200109233);
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
begin
if regsize(src) <> dstsize then
@ -708,7 +762,13 @@ begin
end.
{
$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
Revision 1.3 2001/09/30 16:17:18 jonas

302
compiler/i386/cpuasm.pas
View File

@ -40,7 +40,7 @@ unit cpuasm;
interface
uses
cclasses,
cclasses,tainst,
aasm,globals,verbose,
cpubase;
@ -50,13 +50,6 @@ const
type
TOperandOrder = (op_intel,op_att);
tairegalloc = class(tai)
allocation : boolean;
reg : tregister;
constructor alloc(r : tregister);
constructor dealloc(r : tregister);
end;
{ alignment for operator }
tai_align = class(tai_align_abstract)
reg : tregister;
@ -65,13 +58,8 @@ type
function getfillbuf:pchar;
end;
taicpu = class(tai)
is_jmp : boolean; { is this instruction a jump? (needed for optimizer) }
opcode : tasmop;
taicpu = class(tainstruction)
opsize : topsize;
condition : TAsmCond;
ops : longint;
oper : array[0..2] of toper;
constructor op_none(op : tasmop;_size : topsize);
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_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 SetCondition(c:TAsmCond);
destructor destroy;override;
function getcopy:tlinkedlistitem;override;
function GetString:string;
procedure CheckNonCommutativeOpcodes;
private
segprefix : tregister;
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}
public
{ the next will reset all instructions that can change in pass 2 }
@ -151,27 +130,6 @@ uses
cutils,
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
@ -226,113 +184,18 @@ uses
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);
begin
opsize:=siz;
end;
procedure taicpu.init(op : tasmop;_size : topsize);
procedure taicpu.init(_size : topsize);
begin
typ:=ait_instruction;
is_jmp:=false;
{ default order is att }
FOperandOrder:=op_att;
segprefix:=R_NO;
opcode:=op;
opsize:=_size;
ops:=0;
condition:=c_none;
fillchar(oper,sizeof(oper),0);
{$ifndef NOAG386BIN}
insentry:=nil;
LastInsOffset:=-1;
@ -344,15 +207,15 @@ uses
constructor taicpu.op_none(op : tasmop;_size : topsize);
begin
inherited create;
init(op,_size);
inherited create(op);
init(_size);
end;
constructor taicpu.op_reg(op : tasmop;_size : topsize;_op1 : tregister);
begin
inherited create;
init(op,_size);
inherited create(op);
init(_size);
ops:=1;
loadreg(0,_op1);
end;
@ -360,8 +223,8 @@ uses
constructor taicpu.op_const(op : tasmop;_size : topsize;_op1 : longint);
begin
inherited create;
init(op,_size);
inherited create(op);
init(_size);
ops:=1;
loadconst(0,_op1);
end;
@ -369,8 +232,8 @@ uses
constructor taicpu.op_ref(op : tasmop;_size : topsize;_op1 : preference);
begin
inherited create;
init(op,_size);
inherited create(op);
init(_size);
ops:=1;
loadref(0,_op1);
end;
@ -378,8 +241,8 @@ uses
constructor taicpu.op_reg_reg(op : tasmop;_size : topsize;_op1,_op2 : tregister);
begin
inherited create;
init(op,_size);
inherited create(op);
init(_size);
ops:=2;
loadreg(0,_op1);
loadreg(1,_op2);
@ -388,8 +251,8 @@ uses
constructor taicpu.op_reg_const(op:tasmop; _size: topsize; _op1: tregister; _op2: longint);
begin
inherited create;
init(op,_size);
inherited create(op);
init(_size);
ops:=2;
loadreg(0,_op1);
loadconst(1,_op2);
@ -398,8 +261,8 @@ uses
constructor taicpu.op_reg_ref(op : tasmop;_size : topsize;_op1 : tregister;_op2 : preference);
begin
inherited create;
init(op,_size);
inherited create(op);
init(_size);
ops:=2;
loadreg(0,_op1);
loadref(1,_op2);
@ -408,8 +271,8 @@ uses
constructor taicpu.op_const_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister);
begin
inherited create;
init(op,_size);
inherited create(op);
init(_size);
ops:=2;
loadconst(0,_op1);
loadreg(1,_op2);
@ -418,8 +281,8 @@ uses
constructor taicpu.op_const_const(op : tasmop;_size : topsize;_op1,_op2 : longint);
begin
inherited create;
init(op,_size);
inherited create(op);
init(_size);
ops:=2;
loadconst(0,_op1);
loadconst(1,_op2);
@ -428,8 +291,8 @@ uses
constructor taicpu.op_const_ref(op : tasmop;_size : topsize;_op1 : longint;_op2 : preference);
begin
inherited create;
init(op,_size);
inherited create(op);
init(_size);
ops:=2;
loadconst(0,_op1);
loadref(1,_op2);
@ -438,8 +301,8 @@ uses
constructor taicpu.op_ref_reg(op : tasmop;_size : topsize;_op1 : preference;_op2 : tregister);
begin
inherited create;
init(op,_size);
inherited create(op);
init(_size);
ops:=2;
loadref(0,_op1);
loadreg(1,_op2);
@ -448,8 +311,8 @@ uses
constructor taicpu.op_ref_ref(op : tasmop;_size : topsize;_op1,_op2 : preference);
begin
inherited create;
init(op,_size);
inherited create(op);
init(_size);
ops:=2;
loadref(0,_op1);
loadref(1,_op2);
@ -458,8 +321,8 @@ uses
constructor taicpu.op_reg_reg_reg(op : tasmop;_size : topsize;_op1,_op2,_op3 : tregister);
begin
inherited create;
init(op,_size);
inherited create(op);
init(_size);
ops:=3;
loadreg(0,_op1);
loadreg(1,_op2);
@ -468,8 +331,8 @@ uses
constructor taicpu.op_const_reg_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister;_op3 : tregister);
begin
inherited create;
init(op,_size);
inherited create(op);
init(_size);
ops:=3;
loadconst(0,_op1);
loadreg(1,_op2);
@ -478,8 +341,8 @@ uses
constructor taicpu.op_reg_reg_ref(op : tasmop;_size : topsize;_op1,_op2 : tregister;_op3 : preference);
begin
inherited create;
init(op,_size);
inherited create(op);
init(_size);
ops:=3;
loadreg(0,_op1);
loadreg(1,_op2);
@ -489,8 +352,8 @@ uses
constructor taicpu.op_const_ref_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : preference;_op3 : tregister);
begin
inherited create;
init(op,_size);
inherited create(op);
init(_size);
ops:=3;
loadconst(0,_op1);
loadref(1,_op2);
@ -500,8 +363,8 @@ uses
constructor taicpu.op_const_reg_ref(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister;_op3 : preference);
begin
inherited create;
init(op,_size);
inherited create(op);
init(_size);
ops:=3;
loadconst(0,_op1);
loadreg(1,_op2);
@ -511,8 +374,8 @@ uses
constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_size : topsize;_op1 : tasmsymbol);
begin
inherited create;
init(op,_size);
inherited create(op);
init(_size);
condition:=cond;
ops:=1;
loadsymbol(0,_op1,0);
@ -521,8 +384,8 @@ uses
constructor taicpu.op_sym(op : tasmop;_size : topsize;_op1 : tasmsymbol);
begin
inherited create;
init(op,_size);
inherited create(op);
init(_size);
ops:=1;
loadsymbol(0,_op1,0);
end;
@ -530,8 +393,8 @@ uses
constructor taicpu.op_sym_ofs(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint);
begin
inherited create;
init(op,_size);
inherited create(op);
init(_size);
ops:=1;
loadsymbol(0,_op1,_op1ofs);
end;
@ -539,8 +402,8 @@ uses
constructor taicpu.op_sym_ofs_reg(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister);
begin
inherited create;
init(op,_size);
inherited create(op);
init(_size);
ops:=2;
loadsymbol(0,_op1,_op1ofs);
loadreg(1,_op2);
@ -549,74 +412,13 @@ uses
constructor taicpu.op_sym_ofs_ref(op : tasmop;_size : topsize;_op1 : tasmsymbol;_op1ofs:longint;_op2 : preference);
begin
inherited create;
init(op,_size);
inherited create(op);
init(_size);
ops:=2;
loadsymbol(0,_op1,_op1ofs);
loadref(1,_op2);
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;
var
i : longint;
@ -1773,7 +1575,13 @@ end;
end.
{
$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)
Revision 1.14 2001/04/13 01:22:18 peter

18
compiler/i386/cpubase.pas
View File

@ -706,6 +706,7 @@ const
procedure set_location(var destloc,sourceloc : tlocation);
procedure swap_location(var destloc,sourceloc : tlocation);
procedure inverse_flags(var f: TResFlags);
implementation
@ -933,6 +934,15 @@ begin
{$endif NOAG386BIN}
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;
begin
@ -945,7 +955,13 @@ end;
end.
{
$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
Revision 1.6 2001/09/28 20:39:33 jonas

10
compiler/i386/daopt386.pas
View File

@ -226,7 +226,7 @@ Var
Implementation
Uses
globals, systems, verbose, cgbase, symconst, symsym, tgcpu;
globals, systems, verbose, cgbase, symconst, symsym, tainst, tgcpu;
Type
TRefCompare = function(const r1, r2: TReference): Boolean;
@ -2591,7 +2591,13 @@ End.
{
$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
Revision 1.23 2001/10/27 10:20:43 jonas

9
compiler/i386/n386add.pas
View File

@ -49,7 +49,7 @@ interface
cgbase,temp_gen,pass_2,regvars,
cpuasm,
ncon,nset,
cga,n386util,tgcpu;
tainst,cga,n386util,tgcpu;
function ti386addnode.getresflags(unsigned : boolean) : tresflags;
@ -1863,8 +1863,11 @@ begin
end.
{
$Log$
Revision 1.26 2001-12-02 16:19:17 jonas
* less unnecessary regvar loading with if-statements
Revision 1.27 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.25 2001/10/12 13:51:51 jonas
* fixed internalerror(10) due to previous fpu overflow fixes ("merged")

12
compiler/i386/n386cal.pas
View File

@ -63,7 +63,7 @@ implementation
cgbase,temp_gen,pass_2,
cpubase,cpuasm,
nmem,nld,
cga,tgcpu,n386ld,n386util,regvars;
tainst,cga,tgcpu,n386ld,n386util,regvars;
{*****************************************************************************
TI386CALLPARANODE
@ -1498,7 +1498,7 @@ implementation
inlineprocdef.parast.symtabletype:=inlineparasymtable;
{ Here we must include the para and local symtable info }
tprocsym(inlineprocdef.procsym).concatstabto(withdebuglist);
inlineprocdef.concatstabto(withdebuglist);
{ set it back for safety }
inlineprocdef.localst.symtabletype:=localsymtable;
@ -1593,7 +1593,13 @@ begin
end.
{
$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
Revision 1.37 2001/11/02 23:24:40 peter

9
compiler/i386/n386flw.pas
View File

@ -59,7 +59,7 @@ implementation
cgbase,temp_gen,pass_2,
cpubase,cpuasm,
nld,ncon,
cga,tgcpu;
tainst,cga,tgcpu;
{*****************************************************************************
SecondRaise
@ -737,8 +737,11 @@ begin
end.
{
$Log$
Revision 1.18 2001-09-30 16:16:28 jonas
- removed unused units form uses-clause and unused local vars
Revision 1.19 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.17 2001/09/29 21:34:04 jonas
- removed unused code (replaced by processor independent code)

10
compiler/i386/popt386.pas
View File

@ -41,7 +41,7 @@ Uses
{$ifdef finaldestdebug}
cobjects,
{$endif finaldestdebug}
cpubase,cpuasm,DAOpt386,tgcpu;
tainst,cpubase,cpuasm,DAOpt386,tgcpu;
Function RegUsedAfterInstruction(Reg: TRegister; p: Tai; Var UsedRegs: TRegSet): Boolean;
Begin
@ -2025,7 +2025,13 @@ End.
{
$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")
* some more optimizations are now only done once at the end of the optimizing
cycle instead of every iteration

11
compiler/i386/tgcpu.pas
View File

@ -129,7 +129,7 @@ interface
implementation
uses
globtype,temp_gen,regvars;
globtype,temp_gen,tainst,regvars;
procedure incrementregisterpushed(b : byte);
@ -488,7 +488,7 @@ implementation
begin
isaddressregister := true;
end;
procedure del_reference(const ref : treference);
begin
@ -690,8 +690,11 @@ begin
end.
{
$Log$
Revision 1.6 2001-09-30 16:17:18 jonas
* made most constant and mem handling processor independent
Revision 1.7 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.5 2001/08/26 13:37:03 florian
* some cg reorganisation

9
compiler/ncgflw.pas
View File

@ -75,7 +75,7 @@ implementation
{$ifdef i386}
n386util,
{$endif}
regvars,cgobj,cgcpu;
tainst,regvars,cgobj,cgcpu;
{*****************************************************************************
Second_While_RepeatN
@ -651,8 +651,11 @@ begin
end.
{
$Log$
Revision 1.5 2001-12-02 16:19:17 jonas
* less unnecessary regvar loading with if-statements
Revision 1.6 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.4 2001/11/02 22:58:01 peter
* procsym definition rewrite

54
compiler/new/cg64f32.pas
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
}

342
compiler/powerpc/cgcpu.pas
View File

@ -1,4 +1,4 @@
{
{
$Id$
Copyright (c) 1998-2000 by Florian Klaempfl
@ -22,13 +22,15 @@
}
unit cgcpu;
{$i defines.inc}
interface
uses
cgbase,cgobj,aasm,cpuasm,cpubase,cpuinfo;
cgbase,cgobj,aasm,cpuasm,cpubase,cpuinfo,cg64f32;
type
tcgppc = class(tcg)
tcgppc = class(tcg64f32)
{ passing parameters, per default the parameter is pushed }
{ nr gives the number of the parameter (enumerated from }
{ left to right), this allows to move the parameter to }
@ -55,11 +57,11 @@ unit cgcpu;
{ comparison operations }
procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
l : pasmlabel);override;
procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : pasmlabel);
l : tasmlabel);override;
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 g_flags2reg(list: taasmoutput; const f: TAsmCond; reg: TRegister); override;
procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel); override;
procedure g_flags2reg(list: taasmoutput; const f: TResFlags; reg: TRegister); override;
procedure g_stackframe_entry_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;
{ 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
procedure g_return_from_proc_sysv(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 }
{ 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 }
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 }
{ of asmcondflags and destination addressing mode }
procedure a_jmp(list: taasmoutput; op: tasmop;
c: tasmcondflags; l: pasmlabel);
c: tasmcondflag; l: tasmlabel);
end;
@ -113,8 +119,8 @@ const
A_DIVWU,A_DIVW, A_MULLW,A_MULLW,A_NONE,A_NONE,
A_ORIS,A_NONE, A_NONE,A_NONE,A_SUBIS,A_XORIS);
TOpCmp2AsmCond: Array[topcmp] of TAsmCondFlags = (CF_NONE,CF_EQ,CF_GT,
CF_LT,CF_GE,CF_LE,CF_NE,CF_LE,CF_NG,CF_GE,CF_NL);
TOpCmp2AsmCond: Array[topcmp] of TAsmCondFlag = (C_NONE,C_EQ,C_GT,
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 =
{ indexed? updating?}
@ -138,7 +144,7 @@ const
implementation
uses
globtype,globals,verbose,systems,cutils;
globtype,globals,verbose,systems,cutils, tgcpu;
{ parameter passing... Still needs extra support from the processor }
{ independent code generator }
@ -271,7 +277,7 @@ const
begin
ref2 := ref;
FixRef(ref2);
FixRef(list,ref2);
if size in [OS_S8..OS_S16] then
{ storing is the same for signed and unsigned values }
size := tcgsize(ord(size)-(ord(OS_S8)-ord(OS_8)));
@ -296,7 +302,7 @@ const
else
begin
ref2 := ref;
fixref(ref2);
fixref(list,ref2);
op := loadinstr[size,ref2.index<>R_NO,false];
a_load_store(list,op,reg,ref2);
{ sign extend shortint if necessary, since there is no }
@ -313,6 +319,12 @@ const
list.concat(taicpu.op_reg_reg(A_MR,reg2,reg1));
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);
@ -334,7 +346,7 @@ const
free_scratch_reg(list,scratch_register);
End;
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:
Begin
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);
begin
a_op_reg_reg_reg(list,op,dst,src,dst);
a_op_reg_reg_reg(list,op,src,dst,dst);
end;
{*************** compare instructructions ****************}
procedure tcgppc.a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
l : pasmlabel);
l : tasmlabel);
var
p: taicpu;
@ -391,9 +403,10 @@ const
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;
begin
@ -405,13 +418,53 @@ const
end;
procedure tcgppc.a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: pasmlabel);
procedure tcgppc.a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
begin
a_jmp(list,A_BC,TOpCmp2AsmCond[cond],l);
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);
var
@ -421,7 +474,7 @@ const
begin
{ get the bit to extract from the conditional register + its }
{ requested value (0 or 1) }
case simple of
case f.simple of
false:
begin
{ we don't generate this in the compiler }
@ -447,7 +500,7 @@ const
end;
end;
{ 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 }
{ left by bitpos+1 (remember, this is big-endian!) }
if bitpos <> 31 then
@ -455,23 +508,23 @@ const
else
bitpos := 0;
{ extract bit }
list.concat(taicpu.create(op_reg_reg_const_const_const(
A_RLWINM,reg,reg,bitpos,31,31)));
list.concat(taicpu.op_reg_reg_const_const_const(
A_RLWINM,reg,reg,bitpos,31,31));
{ if we need the inverse, xor with 1 }
if not bitvalue then
list.concat(taicpu.create(op_reg_reg_const(A_XORI,reg,reg,1)));
list.concat(taicpu.op_reg_reg_const(A_XORI,reg,reg,1));
end;
*)
{ *********** entry/exit code and address loading ************ }
procedure tcgppc.g_stackframe_entry(list : taasmoutput;localsize : longint);
begin
case target_os.id of
os_powerpc_macos:
case target_info.target of
target_powerpc_macos:
g_stackframe_entry_mac(list,localsize);
os_powerpc_linux:
target_powerpc_linux:
g_stackframe_entry_sysv(list,localsize)
else
internalerror(2204001);
@ -600,10 +653,10 @@ const
procedure tcgppc.g_return_from_proc(list : taasmoutput;parasize : aword);
begin
case target_os.id of
os_powerpc_macos:
case target_info.target of
target_powerpc_macos:
g_return_from_proc_mac(list,parasize);
os_powerpc_linux:
target_powerpc_linux:
g_return_from_proc_sysv(list,parasize)
else
internalerror(2204001);
@ -618,7 +671,7 @@ const
begin
ref := ref2;
FixRef(ref);
FixRef(list,ref);
if assigned(ref.symbol) then
{ add the symbol's value to the base of the reference, and if the }
{ reference doesn't have a base, create one }
@ -643,7 +696,7 @@ const
end;
if ref.offset <> 0 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}
{ occurs, so now only ref.offset has to be loaded }
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);
var
p: paicpu;
t: taicpu;
countreg, tempreg: TRegister;
src, dst: TReference;
lab: PAsmLabel;
lab: tasmlabel;
count, count2: aword;
begin
{ make sure source and dest are valid }
src := source;
fixref(src);
fixref(list,src);
dst := dest;
fixref(dst);
fixref(list,dst);
reset_reference(src);
reset_reference(dst);
{ load the address of source into src.base }
@ -682,7 +735,7 @@ const
a_load_ref_reg(list,OS_32,source,src.base)
else a_loadaddress_ref_reg(list,source,src.base);
if delsource then
del_reference(list,source);
del_reference(source);
{ load the address of dest into dst.base }
dst.base := get_scratch_reg(list);
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_ref(A_STWU,tempreg,newreference(dst)));
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);
end
else
@ -802,12 +855,14 @@ const
(cardinal(ref.offset-low(smallint)) <=
high(smallint)-low(smallint)) then
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;
end
else
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;
end;
end
@ -820,75 +875,75 @@ const
end;
procedure tcgppc.a_op_reg_reg_const32(list: taasmoutput; op: TOpCg;
dst, src: tregister; a: aword): boolean;
{ 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 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
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
oplo, ophi: tasmop;
scratchreg: tregister;
@ -903,15 +958,15 @@ const
if (longint(a) >= low(smallint)) and
(longint(a) <= high(smallint)) then
begin
list.concat(taicpu.op_reg_reg_const(oplo,reg1,reg2,a));
list.concat(taicpu.op_reg_reg_const(oplo,dst,src,a));
exit;
end;
{ all basic constant instructions also have a shifted form that }
{ works only on the highest 16bits, so if low(a) is 0, we can }
{ use that one }
if (low(a) = 0) then
if (lo(a) = 0) then
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;
end;
{ otherwise, the instructions we can generate depend on the }
@ -920,29 +975,29 @@ const
case op of
OP_ADD,OP_SUB:
begin
list.concat(taicpu.op_reg_reg_const(oplo,reg1,reg2,low(a)));
list.concat(taicpu.op_reg_reg_const(ophi,reg1,reg1,
list.concat(taicpu.op_reg_reg_const(oplo,dst,src,low(a)));
list.concat(taicpu.op_reg_reg_const(ophi,dst,dst,
high(a) + ord(smallint(a) < 0)));
end;
OP_OR:
{ try to use rlwimi }
if get_rlwi_const then
if get_rlwi_const(a,l1,l2) then
begin
if reg1 <> reg2 then
list.concat(taicpu.op_reg_reg(A_MR,reg1,reg2));
scratch_reg := get_scratch_reg(list);
list.concat(taicpu.op_reg_const(A_LI,scratch_reg,-1));
list.concat(taicpu.op_reg_reg_const_const_const(A_RLWIMI,reg1,
reg2,0,l1,l2));
free_scratch_reg(list,scratch_reg);
if src <> dst then
list.concat(taicpu.op_reg_reg(A_MR,dst,src));
scratchreg := get_scratch_reg(list);
list.concat(taicpu.op_reg_const(A_LI,scratchreg,-1));
list.concat(taicpu.op_reg_reg_const_const_const(A_RLWIMI,dst,
scratchreg,0,l1,l2));
free_scratch_reg(list,scratchreg);
end
else
useReg := true;
OP_AND:
{ try to use rlwinm }
if get_rlwi_const then
list.concat(taicpu.op_reg_reg_const_const_const(A_RLWINM,reg1,
reg2,0,l1,l2))
if get_rlwi_const(a,l1,l2) then
list.concat(taicpu.op_reg_reg_const_const_const(A_RLWINM,dst,
src,0,l1,l2))
else
useReg := true;
OP_XOR:
@ -956,26 +1011,27 @@ const
begin
scratchreg := get_scratch_reg(list);
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);
end;
end;
procedure tcgppc.a_op_reg_reg_reg(list: taasmoutput; op: TOpCg;
dst, src1, src2: tregister);
src1, src2, dst: tregister);
const
op_reg_reg_opcg2asmop: array[TOpCG] of tasmop =
(A_ADD,A_AND,A_DIVWU,A_DIVW,A_MULLW,A_MULLW,A_NEG,A_NOT,A_OR,
A_SRAW,A_SLW,A_SRW,A_SUB,A_XOR)
A_SRAW,A_SLW,A_SRW,A_SUB,A_XOR);
begin
Case Op of
case op of
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
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;
@ -1009,10 +1065,10 @@ const
end;
procedure tcgppc.a_jmp(list: taasmoutput; op: tasmop; c: tasmcondflags;
l: pasmlabel);
procedure tcgppc.a_jmp(list: taasmoutput; op: tasmop; c: tasmcondflag;
l: tasmlabel);
var
p: paicpu;
p: taicpu;
begin
p := taicpu.op_sym(op,newasmsymbol(l.name));
@ -1020,10 +1076,18 @@ const
list.concat(p)
end;
begin
cg := tcgppc.create;
end.
{
$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
Revision 1.7 2001/09/29 21:33:30 jonas

14
compiler/powerpc/cpuasm.pas
View File

@ -22,11 +22,13 @@
}
unit cpuasm;
{$i defines.inc}
interface
uses
cclasses,
aasm,globals,verbose,tainst,
cclasses,tainst,
aasm,globals,verbose,
cpubase;
type
@ -411,7 +413,13 @@ implementation
end.
{
$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 PPC updates

67
compiler/powerpc/cpubase.pas
View File

@ -209,7 +209,7 @@ type
{$ifndef tp}
{$minenumsize 1}
{$endif tp}
TAsmCondFlags = (C_None { unconditional junps },
TAsmCondFlag = (C_None { unconditional junps },
{ 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,
{ conditions when using ctr decrement etc }
@ -222,28 +222,28 @@ type
case simple: boolean of
false: (BO, BI: byte);
true: (
case cond: TAsmCondFlags of
C_None: ();
cond: TAsmCondFlag;
case byte of
0: ();
{ specifies in which part of the cr the bit has to be }
{ tested for blt,bgt,beq etc. }
C_LT..C_NU: (cr: R_CR0..R_CR7);
{ specifies the bit to test for bt,bf,bdz etc. }
C_T..C_DZF:
(crbit: byte)
{ tested for blt,bgt,beq,..,bnu }
1: (cr: R_CR0..R_CR7);
{ specifies the bit to test for bt,bf,bdz,..,bdzf }
2: (crbit: byte)
);
end;
const
AsmCondFlag2BO: Array[C_T..C_DZF] of Byte =
(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);
AsmCondFlagTF: Array[TAsmCondFlags] of Boolean =
AsmCondFlagTF: Array[TAsmCondFlag] of Boolean =
(false,true,false,true,false,true,false,false,false,true,false,true,false,
true,false,false,true,false,false,true,false);
AsmCondFlag2Str: Array[tasmcondflags] of string[2] = ({cf_none}'',
AsmCondFlag2Str: Array[TAsmCondFlag] of string[4] = ({cf_none}'',
{ conditions when not using ctr decrement etc}
'lt','le','eq','ge','gt','nl','ne','ng','so','ns','un','nu',
't','f','dnz','dzt','dnzf','dz','dzt','dzf');
@ -266,12 +266,13 @@ type
flag: TResFlagsEnum;
end;
(*
const
{ arrays for boolean location conversions }
{
flag_2_cond : array[TResFlags] of TAsmCond =
(C_E,C_NE,C_LT,C_LE,C_GT,C_GE,???????????????);
}
*)
{*****************************************************************************
Reference
@ -459,9 +460,10 @@ const
function is_calljmp(o:tasmop):boolean;
procedure inverse_flags(var f: TResFlags);
procedure inverse_cond(c: TAsmCond;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 set_location(var destloc,sourceloc : tlocation);
@ -533,10 +535,17 @@ implementation
new_reference:=r;
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);
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_F,C_T,C_DNZ,C_DNZF,C_DNZT,C_DZ,C_DZF,C_DZT);
begin
@ -545,27 +554,23 @@ implementation
end;
procedure create_cond_imm(BO,BI:byte;var r : TAsmCond);
var c: tasmcond;
begin
c.simple := false;
c.bo := bo;
c.bi := bi;
r := c
r.simple := false;
r.bo := bo;
r.bi := bi;
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 =
(R_CR0,R_CR1,R_CR2,R_CR3,R_CR4,R_CR5,R_CR6,R_CR7);
var c: tasmcond;
begin
c.simple := true;
c.cond := cond;
r.simple := true;
r.cond := cond;
case cond of
C_NONE:;
C_T..C_DZF: c.crbit := cr
else c.cr := cr2reg[cr];
C_T..C_DZF: r.crbit := cr
else r.cr := cr2reg[cr];
end;
r := c;
end;
procedure clear_location(var loc : tlocation);
@ -607,7 +612,13 @@ implementation
end.
{
$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)
Revision 1.3 2001/09/06 15:25:56 jonas

10
compiler/powerpc/cpuinfo.pas
View File

@ -34,7 +34,7 @@ Type
{ pointer(-1) will result in a pointer with the value }
{ $fffffffffffffff on a 32bit machine if the compiler uses }
{ int64 constants internally (JM) }
TPointerOrd = DWord;
TConstPtrUInt = DWord;
Const
{ Size of native extended type }
@ -45,7 +45,13 @@ Implementation
end.
{
$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 PPC updates

22
compiler/powerpc/nppccnv.pas
View File

@ -129,7 +129,7 @@ implementation
if location = LOC_REGISTER then
location.register:= left.location.register
else
location.register := getregister32;
location.register := getregisterint;
case opsize of
OS_8:
exprasmlist.concat(taicpu.op_reg_reg_const_const_const(
@ -172,7 +172,7 @@ implementation
LOC_REFERENCE,LOC_MEM:
begin
del_reference(left.location.reference);
location.register := getregister32;
location.register := getregisterint;
if not (opsize in [OS_64,OS_S64]) then
tempsize := pred(opsize)
else
@ -188,7 +188,7 @@ implementation
{ instructions as appropriate, the source will contain }
{ the correct value already, so simply copy it }
begin
location.register := getregister32;
location.register := getregisterint;
exprasmlist.concat(taicpu.op_reg_reg(A_MR,location.register,
left.location.register));
end;
@ -198,7 +198,7 @@ implementation
{ sign extend even further if necessary }
if opsize in [OS_64,OS_S64] then
begin
location.registerhigh := getregister32;
location.registerhigh := getregisterint;
if (opsize = OS_64) or
not (is_signed(left.resulttype.def)) then
cg.a_load_const_reg(exprasmlist,OS_32,0,
@ -349,13 +349,13 @@ implementation
if left.location.loc in [LOC_MEM,LOC_REFERENCE] then
begin
del_reference(left.location);
hreg2:=getregister32;
hreg2:=getregisterint;
cg.a_load_ref_reg(exprasmlist,opsize,
left.location.reference,hreg2);
end
else
hreg2 := left.location.register;
hreg1 := getregister32;
hreg1 := getregisterint;
exprasmlist.concat(taicpu.op_reg_reg_const(A_SUBIC,hreg1,
hreg2,1);
exprasmlist.concat(taicpu.op_reg_reg_reg(A_SUBFE,hreg1,hreg1,
@ -364,7 +364,7 @@ implementation
end;
LOC_FLAGS :
begin
hreg1:=getregister32;
hreg1:=getregisterint;
resflags:=left.location.resflags;
emit_flag2reg(resflags,hreg1);
end;
@ -379,7 +379,13 @@ begin
end.
{
$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
Revision 1.2 2001/10/01 12:17:26 jonas

490
compiler/powerpc/nppcmat.pas Normal file
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)
}

22
compiler/powerpc/tgcpu.pas
View File

@ -47,6 +47,9 @@ unit tgcpu;
{ tries to allocate the passed register, if possible }
function getexplicitregisterint(r : tregister) : tregister;
function getregisterfpu : tregister;
function ungetregisterfpu : tregister;
procedure ungetregister(r : tregister);
procedure cleartempgen;
@ -76,8 +79,7 @@ unit tgcpu;
var
unused,usableregs : tregisterset;
{ uses only 1 byte while a set uses in FPC 32 bytes }
usedinproc : byte;
usedinproc : set of TREGISTER;
{ count, how much a register must be pushed if it is used as register }
{ variable }
@ -104,6 +106,14 @@ implementation
begin
end;
function getregisterfpu : tregister;
begin
end;
function ungetregisterfpu : tregister;
begin
end;
procedure ungetregister(r : tregister);
begin
end;
@ -160,7 +170,13 @@ begin
end.
{
$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 PPC updates

10
compiler/regvars.pas
View File

@ -49,7 +49,7 @@ implementation
globtype,systems,comphook,
cutils,cclasses,verbose,globals,
symconst,symbase,symtype,symdef,types,
cgbase,cpuasm,cgobj,cgcpu,cga;
tainst,cgbase,cpuasm,cgobj,cgcpu,cga;
var
parasym : boolean;
@ -463,7 +463,13 @@ end.
{
$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
if-statements)

331
compiler/tainst.pas
View File

@ -22,34 +22,39 @@
}
Unit tainst;
{$i defines.inc}
interface
Uses aasm,cpubase,cpuinfo,cclasses;
Type
tairegalloc = class(tai)
allocation : boolean;
reg : tregister;
constructor alloc(r : tregister);
constructor dealloc(r : tregister);
end;
tairegalloc = class(tai)
allocation : boolean;
reg : tregister;
constructor alloc(r : tregister);
constructor dealloc(r : tregister);
end;
tainstruction = class(tai)
is_jmp : boolean; { is this instruction a jump? (needed for optimizer) }
opcode : tasmop;
condition : TAsmCond;
ops : longint;
oper : array[0..max_operands-1] of toper;
Constructor Create(op : tasmop);
Destructor Destroy;override;
function getcopy:tlinkedlistitem;virtual;
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 SetCondition(c:TAsmCond);
tainstruction = class(tai)
condition : TAsmCond;
ops : longint;
oper : array[0..max_operands-1] of toper;
opcode : tasmop;
{$ifdef i386}
segprefix : tregister;
{$endif i386}
is_jmp : boolean; { is this instruction a jump? (needed for optimizer) }
Constructor Create(op : tasmop);
Destructor Destroy;override;
function getcopy:tlinkedlistitem;override;
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 SetCondition(const c:TAsmCond);
end;
implementation
@ -58,22 +63,22 @@ implementation
TaiRegAlloc
*****************************************************************************}
constructor tairegalloc.alloc(r : tregister);
begin
inherited create;
typ:=ait_regalloc;
allocation:=true;
reg:=r;
end;
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;
constructor tairegalloc.dealloc(r : tregister);
begin
inherited create;
typ:=ait_regalloc;
allocation:=false;
reg:=r;
end;
{ ---------------------------------------------------------------------
TaInstruction Constructor/Destructor
@ -81,30 +86,34 @@ constructor tairegalloc.dealloc(r : tregister);
Constructor tainstruction.Create(op : tasmop);
constructor Tainstruction.Create(op : tasmop);
begin
inherited create;
typ:=ait_instruction;
is_jmp:=false;
opcode:=op;
ops:=0;
fillchar(condition,sizeof(condition),0);
fillchar(oper,sizeof(oper),0);
end;
begin
inherited create;
typ:=ait_instruction;
is_jmp:=false;
opcode:=op;
ops:=0;
fillchar(condition,sizeof(condition),0);
fillchar(oper,sizeof(oper),0);
end;
Destructor Tainstruction.Destroy;
destructor Tainstruction.Destroy;
Var i : longint;
begin
for i:=1 to ops do
if (oper[i-1].typ=top_ref) then
dispose(oper[i-1].ref);
inherited destroy;
end;
var
i : longint;
begin
for i:=0 to ops-1 do
case oper[i].typ of
top_ref:
dispose(oper[i].ref);
top_symbol:
dec(tasmsymbol(oper[0].sym).refs);
end;
inherited destroy;
end;
@ -114,134 +123,141 @@ end;
procedure tainstruction.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 tainstruction.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 tainstruction.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 tainstruction.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 tainstruction.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
val:=p^.offset;
disposereference(p);
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;
procedure tainstruction.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}
typ:=top_ref;
{ mark symbol as used }
if assigned(ref^.symbol) then
inc(ref^.symbol.refs);
end;
end;
end;
val:=p^.offset;
disposereference(p);
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}
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);
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 tainstruction.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 tainstruction.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 tainstruction.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;
{ ---------------------------------------------------------------------
Miscellaneous methods.
---------------------------------------------------------------------}
procedure tainstruction.SetCondition(c:TAsmCond);
begin
condition:=c;
end;
procedure tainstruction.SetCondition(const c:TAsmCond);
begin
condition:=c;
end;
Function tainstruction.getcopy:tlinkedlistitem;
var
i : longint;
p : tlinkedlistitem;
begin
p:=inherited getcopy;
{ make a copy of the references }
for i:=1 to ops do
if (tainstruction(p).oper[i-1].typ=top_ref) then
begin
new(tainstruction(p).oper[i-1].ref);
tainstruction(p).oper[i-1].ref^:=oper[i-1].ref^;
end;
getcopy:=p;
end;
Function tainstruction.getcopy:tlinkedlistitem;
var
i : longint;
p : tlinkedlistitem;
begin
p:=inherited getcopy;
{ make a copy of the references }
for i:=1 to ops do
if (tainstruction(p).oper[i-1].typ=top_ref) then
begin
new(tainstruction(p).oper[i-1].ref);
tainstruction(p).oper[i-1].ref^:=oper[i-1].ref^;
end;
getcopy:=p;
end;
end.
{
$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 PPC updates
@ -256,7 +272,8 @@ end.
* most things for stored properties fixed
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
* added segprefix field for i386 in tainstruction object