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

* alpha compiles again, changes to common code not yet commited

Browse Source
This commit is contained in:
florian 2002-09-29 23:54:12 +00:00
parent 64b520176a
commit 1abddbb7f7
6 changed files with 543 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

108
compiler/alpha/aasmcpu.pas
View File

@ -27,63 +27,66 @@ unit aasmcpu;
{$i fpcdefs.inc} {$i fpcdefs.inc}
interface interface
uses uses
aasmbase,globals,verbose, aasmbase,globals,verbose,
cpubase,aasmtai; cpubase,aasmtai;
type type
tai_frame = class(tai) tai_frame = class(tai)
G,R : TRegister; G,R : TRegister;
LS,LU : longint; LS,LU : longint;
Constructor Create (GP : Tregister; Localsize : Longint; RA : TRegister; L : longint); Constructor Create (GP : Tregister; Localsize : Longint; RA : TRegister; L : longint);
end; end;
tai_ent = class(tai) tai_ent = class(tai)
Name : string; Name : string;
Constructor Create (const ProcName : String); Constructor Create (const ProcName : String);
end; end;
taicpu = class(taicpu_abstract) taicpu = class(taicpu_abstract)
constructor op_none(op : tasmop); constructor op_none(op : tasmop);
constructor op_reg(op : tasmop;_op1 : tregister); constructor op_reg(op : tasmop;_op1 : tregister);
constructor op_const(op : tasmop;_op1 : longint); constructor op_const(op : tasmop;_op1 : longint);
constructor op_ref(op : tasmop;_op1 : preference); constructor op_ref(op : tasmop;_op1 : preference);
constructor op_reg_reg(op : tasmop;_op1,_op2 : tregister); constructor op_reg_reg(op : tasmop;_op1,_op2 : tregister);
constructor op_reg_ref(op : tasmop;_op1 : tregister;_op2 : preference); constructor op_reg_ref(op : tasmop;_op1 : tregister;_op2 : preference);
constructor op_reg_const(op:tasmop; _op1: tregister; _op2: longint); constructor op_reg_const(op:tasmop; _op1: tregister; _op2: longint);
constructor op_const_reg(op : tasmop;_op1 : longint;_op2 : tregister); constructor op_const_reg(op : tasmop;_op1 : longint;_op2 : tregister);
constructor op_const_const(op : tasmop;_op1,_op2 : longint); constructor op_const_const(op : tasmop;_op1,_op2 : longint);
constructor op_const_ref(op : tasmop;_op1 : longint;_op2 : preference); constructor op_const_ref(op : tasmop;_op1 : longint;_op2 : preference);
constructor op_ref_reg(op : tasmop;_op1 : preference;_op2 : tregister); constructor op_ref_reg(op : tasmop;_op1 : preference;_op2 : tregister);
{ this is only allowed if _op1 is an int value (_op1^.isintvalue=true) } { this is only allowed if _op1 is an int value (_op1^.isintvalue=true) }
constructor op_ref_ref(op : tasmop;_op1,_op2 : preference); constructor op_ref_ref(op : tasmop;_op1,_op2 : preference);
constructor op_reg_reg_reg(op : tasmop;_op1,_op2,_op3 : tregister); constructor op_reg_reg_reg(op : tasmop;_op1,_op2,_op3 : tregister);
constructor op_reg_const_reg(op : tasmop;_op1 : tregister;_op2 : longint;_op3 : tregister); constructor op_reg_const_reg(op : tasmop;_op1 : tregister;_op2 : longint;_op3 : tregister);
constructor op_const_ref_reg(op : tasmop;_op1 : longint;_op2 : preference;_op3 : tregister); constructor op_const_ref_reg(op : tasmop;_op1 : longint;_op2 : preference;_op3 : tregister);
constructor op_reg_reg_ref(op : tasmop;_op1,_op2 : tregister; _op3 : preference); constructor op_reg_reg_ref(op : tasmop;_op1,_op2 : tregister; _op3 : preference);
constructor op_const_reg_ref(op : tasmop;_op1 : longint;_op2 : tregister;_op3 : preference); constructor op_const_reg_ref(op : tasmop;_op1 : longint;_op2 : tregister;_op3 : preference);
constructor op_reg_ref_const(op : tasmop;_op1 : tregister;_op2 : preference;_op3 : longint); constructor op_reg_ref_const(op : tasmop;_op1 : tregister;_op2 : preference;_op3 : longint);
{ this is for Jmp instructions } { this is for Jmp instructions }
constructor op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol); constructor op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol);
constructor op_sym(op : tasmop;_op1 : tasmsymbol); constructor op_sym(op : tasmop;_op1 : tasmsymbol);
constructor op_sym_ofs(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint); constructor op_sym_ofs(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint);
constructor op_sym_ofs_reg(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister); constructor op_sym_ofs_reg(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister);
constructor op_sym_ofs_ref(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;_op2 : preference); constructor op_sym_ofs_ref(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;_op2 : preference);
end; end;
tai_align = class(tai_align_abstract) tai_align = class(tai_align_abstract)
{ nothing to add } { nothing to add }
end; end;
procedure InitAsm;
procedure DoneAsm;
implementation implementation
@ -266,10 +269,23 @@ implementation
Name:=ProcName; Name:=ProcName;
end; end;
end. procedure InitAsm;
begin
end;
procedure DoneAsm;
begin
end;
end.
{ {
$Log$ $Log$
Revision 1.2 2002-09-29 23:42:45 florian Revision 1.3 2002-09-29 23:54:12 florian
* alpha compiles again, changes to common code not yet commited
Revision 1.2 2002/09/29 23:42:45 florian
* several fixes to get forward with alpha compilation * several fixes to get forward with alpha compilation
Revision 1.1 2002/09/29 22:34:17 florian Revision 1.1 2002/09/29 22:34:17 florian

25
compiler/alpha/cpubase.pas
View File

@ -193,11 +193,29 @@ unit cpubase;
max_scratch_regs = 2; max_scratch_regs = 2;
scratch_regs : array[1..max_scratch_regs] of tregister = (R_1,R_2); scratch_regs : array[1..max_scratch_regs] of tregister = (R_1,R_2);
type {*****************************************************************************
GDB Information
*****************************************************************************}
{ Register indexes for stabs information, when some
parameters or variables are stored in registers.
}
stab_regindex : array[tregister] of shortint =
(0,
0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,
0,0,
0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,
0,0
);
{***************************************************************************** {*****************************************************************************
Flags Flags
*****************************************************************************} *****************************************************************************}
type
{ The Alpha doesn't have flags but some generic code depends on this type. } { The Alpha doesn't have flags but some generic code depends on this type. }
TResFlags = (F_NO); TResFlags = (F_NO);
@ -432,7 +450,10 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.3 2002-09-29 23:42:45 florian Revision 1.4 2002-09-29 23:54:12 florian
* alpha compiles again, changes to common code not yet commited
Revision 1.3 2002/09/29 23:42:45 florian
* several fixes to get forward with alpha compilation * several fixes to get forward with alpha compilation
Revision 1.2 2002/09/07 15:25:10 peter Revision 1.2 2002/09/07 15:25:10 peter

7
compiler/alpha/cpunode.pas
View File

@ -33,7 +33,7 @@ unit cpunode;
uses uses
{ generic nodes } { generic nodes }
ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon,ncgcal,ncgset,ncginl, ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon,ncgcal,ncgset,ncginl
{ to be able to only parts of the generic code, { to be able to only parts of the generic code,
the processor specific nodes must be included the processor specific nodes must be included
after the generic one (FK) after the generic one (FK)
@ -55,6 +55,9 @@ unit cpunode;
end. end.
{ {
$Log$ $Log$
Revision 1.1 2002-08-18 09:13:02 florian Revision 1.2 2002-09-29 23:54:12 florian
* alpha compiles again, changes to common code not yet commited
Revision 1.1 2002/08/18 09:13:02 florian
* small fixes to the alpha stuff * small fixes to the alpha stuff
} }

345
compiler/alpha/cpupara.pas Normal file
View File

@ -0,0 +1,345 @@
{
$Id$
Copyright (c) 2002 by Florian Klaempfl
Alpha specific calling conventions
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.
****************************************************************************
}
{ Alpha specific calling conventions are handled by this unit
}
unit cpupara;
{$i fpcdefs.inc}
interface
uses
cpubase,
symconst,symbase,symtype,symdef,paramgr;
type
talphaparamanager = class(tparamanager)
function getintparaloc(nr : longint) : tparalocation;override;
procedure create_param_loc_info(p : tabstractprocdef);override;
function getfuncretparaloc(p : tabstractprocdef) : tparalocation;override;
end;
implementation
uses
verbose,
globtype,
cpuinfo,cginfo,cgbase,
defbase;
function talphaparamanager.getintparaloc(nr : longint) : tparalocation;
begin
fillchar(result,sizeof(tparalocation),0);
if nr<1 then
internalerror(2002070801)
else if nr<=8 then
begin
result.loc:=LOC_REGISTER;
result.register:=tregister(longint(R_2)+nr);
end
else
begin
result.loc:=LOC_REFERENCE;
result.reference.index:=stack_pointer_reg;
result.reference.offset:=(nr-8)*4;
end;
end;
function getparaloc(p : tdef) : tloc;
begin
{ Later, the LOC_REFERENCE is in most cases changed into LOC_REGISTER
if push_addr_param for the def is true
}
case p.deftype of
orddef:
getparaloc:=LOC_REGISTER;
floatdef:
getparaloc:=LOC_FPUREGISTER;
enumdef:
getparaloc:=LOC_REGISTER;
pointerdef:
getparaloc:=LOC_REGISTER;
formaldef:
getparaloc:=LOC_REGISTER;
classrefdef:
getparaloc:=LOC_REGISTER;
recorddef:
getparaloc:=LOC_REFERENCE;
objectdef:
if is_object(p) then
getparaloc:=LOC_REFERENCE
else
getparaloc:=LOC_REGISTER;
stringdef:
if is_shortstring(p) or is_longstring(p) then
getparaloc:=LOC_REFERENCE
else
getparaloc:=LOC_REGISTER;
procvardef:
if (po_methodpointer in tprocvardef(p).procoptions) then
getparaloc:=LOC_REFERENCE
else
getparaloc:=LOC_REGISTER;
filedef:
getparaloc:=LOC_REGISTER;
arraydef:
getparaloc:=LOC_REFERENCE;
setdef:
if is_smallset(p) then
getparaloc:=LOC_REGISTER
else
getparaloc:=LOC_REFERENCE;
variantdef:
getparaloc:=LOC_REFERENCE;
{ avoid problems with errornous definitions }
errordef:
getparaloc:=LOC_REGISTER;
else
internalerror(2002071001);
end;
end;
procedure talphaparamanager.create_param_loc_info(p : tabstractprocdef);
var
nextintreg,nextfloatreg,nextmmreg : tregister;
stack_offset : aword;
hp : tparaitem;
loc : tloc;
is_64bit: boolean;
begin
nextintreg:=R_3;
nextfloatreg:=R_F1;
// nextmmreg:=R_M1;
stack_offset:=0;
{ pointer for structured results ? }
if not is_void(p.rettype.def) then
begin
if not(ret_in_reg(p.rettype.def)) then
inc(nextintreg);
end;
{ frame pointer for nested procedures? }
{ inc(nextintreg); }
{ constructor? }
{ destructor? }
hp:=tparaitem(p.para.last);
while assigned(hp) do
begin
loc:=getparaloc(hp.paratype.def);
hp.paraloc.sp_fixup:=0;
case loc of
LOC_REGISTER:
begin
hp.paraloc.size := def_cgsize(hp.paratype.def);
{ for things like formaldef }
if hp.paraloc.size = OS_NO then
hp.paraloc.size := OS_ADDR;
is_64bit := hp.paraloc.size in [OS_64,OS_S64];
if nextintreg<=tregister(ord(R_10)-ord(is_64bit)) then
begin
hp.paraloc.loc:=LOC_REGISTER;
hp.paraloc.registerlow:=nextintreg;
inc(nextintreg);
if is_64bit then
begin
hp.paraloc.registerhigh:=nextintreg;
inc(nextintreg);
end;
end
else
begin
nextintreg := R_11;
hp.paraloc.loc:=LOC_REFERENCE;
hp.paraloc.reference.index:=stack_pointer_reg;
hp.paraloc.reference.offset:=stack_offset;
if not is_64bit then
inc(stack_offset,4)
else
inc(stack_offset,8);
end;
end;
LOC_FPUREGISTER:
begin
if hp.paratyp in [vs_var,vs_out] then
begin
if nextintreg<=R_10 then
begin
hp.paraloc.size:=OS_ADDR;
hp.paraloc.loc:=LOC_REGISTER;
hp.paraloc.register:=nextintreg;
inc(nextintreg);
end
else
begin
{!!!!!!!}
hp.paraloc.size:=def_cgsize(hp.paratype.def);
internalerror(2002071006);
end;
end
else if nextfloatreg<=R_F10 then
begin
hp.paraloc.size:=def_cgsize(hp.paratype.def);
hp.paraloc.loc:=LOC_FPUREGISTER;
hp.paraloc.register:=nextfloatreg;
inc(nextfloatreg);
end
else
begin
{!!!!!!!}
hp.paraloc.size:=def_cgsize(hp.paratype.def);
internalerror(2002071004);
end;
end;
LOC_REFERENCE:
begin
hp.paraloc.size:=OS_ADDR;
if push_addr_param(hp.paratype.def,p.proccalloption in [pocall_cdecl,pocall_cppdecl]) or (hp.paratyp in [vs_var,vs_out]) then
begin
if nextintreg<=R_10 then
begin
hp.paraloc.loc:=LOC_REGISTER;
hp.paraloc.register:=nextintreg;
inc(nextintreg);
end
else
begin
hp.paraloc.loc:=LOC_REFERENCE;
hp.paraloc.reference.index:=stack_pointer_reg;
hp.paraloc.reference.offset:=stack_offset;
inc(stack_offset,4);
end;
end
else
begin
hp.paraloc.loc:=LOC_REFERENCE;
hp.paraloc.reference.index:=stack_pointer_reg;
hp.paraloc.reference.offset:=stack_offset;
inc(stack_offset,hp.paratype.def.size);
end;
end;
else
internalerror(2002071002);
end;
hp:=tparaitem(hp.previous);
end;
end;
function talphaparamanager.getfuncretparaloc(p : tabstractprocdef) : tparalocation;
begin
case p.rettype.def.deftype of
orddef,
enumdef:
begin
getfuncretparaloc.loc:=LOC_REGISTER;
getfuncretparaloc.register:=R_3;
getfuncretparaloc.size:=def_cgsize(p.rettype.def);
if getfuncretparaloc.size in [OS_S64,OS_64] then
getfuncretparaloc.registerhigh:=R_4;
end;
floatdef:
begin
getfuncretparaloc.loc:=LOC_FPUREGISTER;
getfuncretparaloc.register:=R_F1;
getfuncretparaloc.size:=def_cgsize(p.rettype.def);
end;
pointerdef,
formaldef,
classrefdef,
recorddef,
objectdef,
stringdef,
procvardef,
filedef,
arraydef,
errordef:
begin
getfuncretparaloc.loc:=LOC_REGISTER;
getfuncretparaloc.register:=R_3;
getfuncretparaloc.size:=OS_ADDR;
end;
else
internalerror(2002090903);
end;
end;
begin
paramanager:=talphaparamanager.create;
end.
{
$Log$
Revision 1.1 2002-09-29 23:54:12 florian
* alpha compiles again, changes to common code not yet commited
Revision 1.14 2002/09/28 21:27:16 florian
+ getparaloc supports now sets and variants
Revision 1.13 2002/09/10 21:28:05 jonas
* int64 paras are now handled correctly (until the registers are used up
anyway :)
* the return location is now initialized correctly
* fixed bug where ret_in_reg() was called for the procdefinition instead
of for the result of the procedure
Revision 1.12 2002/09/09 09:11:37 florian
- removed passes_parameters_in_reg
Revision 1.11 2002/09/07 17:54:59 florian
* first part of PowerPC fixes
Revision 1.10 2002/09/01 21:04:49 florian
* several powerpc related stuff fixed
Revision 1.9 2002/08/31 12:43:31 florian
* ppc compilation fixed
Revision 1.8 2002/08/18 10:42:38 florian
* remaining assembler writer bugs fixed, the errors in the
system unit are inline assembler problems
Revision 1.7 2002/08/17 22:09:47 florian
* result type handling in tcgcal.pass_2 overhauled
* better tnode.dowrite
* some ppc stuff fixed
Revision 1.6 2002/08/13 21:40:58 florian
* more fixes for ppc calling conventions
Revision 1.5 2002/07/30 20:50:44 florian
* the code generator knows now if parameters are in registers
Revision 1.4 2002/07/28 20:45:22 florian
+ added direct assembler reader for PowerPC
Revision 1.3 2002/07/26 22:22:10 florian
* several PowerPC related fixes to get forward with system unit compilation
Revision 1.2 2002/07/11 14:41:34 florian
* start of the new generic parameter handling
Revision 1.1 2002/07/07 09:44:32 florian
* powerpc target fixed, very simple units can be compiled
}

51
compiler/alpha/cpupi.pas Normal file
View File

@ -0,0 +1,51 @@
{
$Id$
Copyright (c) 2002 by Florian Klaempfl
This unit contains the CPU specific part of tprocinfo
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.
****************************************************************************
}
{
This unit contains the CPU specific part of tprocinfo.
}
unit cpupi;
{$i fpcdefs.inc}
interface
uses
cgbase;
type
talphaprocinfo = class(tprocinfo)
end;
implementation
begin
cprocinfo:=talphaprocinfo;
end.
{
$Log$
Revision 1.1 2002-09-29 23:54:12 florian
* alpha compiles again, changes to common code not yet commited
}

57
compiler/alpha/cputarg.pas Normal file
View File

@ -0,0 +1,57 @@
{
$Id$
Copyright (c) 2001-2002 by Peter Vreman
Includes the powerpc dependent target units
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 cputarg;
{$i fpcdefs.inc}
interface
implementation
uses
systems { prevent a syntax error when nothing is included }
{**************************************
Targets
**************************************}
{$ifndef NOTARGETLINUX}
,t_linux
{$endif}
{**************************************
Assemblers
**************************************}
{$ifndef NOAGAXPGAS}
,agaxpgas
{$endif}
;
end.
{
$Log$
Revision 1.1 2002-09-29 23:54:13 florian
* alpha compiles again, changes to common code not yet commited
}