paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2026-01-08 11:22:15 +01:00
Code Issues Packages Projects Releases Wiki Activity

* several fixes to get forward with alpha compilation

Browse Source
This commit is contained in:
florian 2002-09-29 23:42:45 +00:00
parent 739af6f57d
commit 64b520176a
10 changed files with 1111 additions and 336 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

129
compiler/alpha/aasmcpu.pas
View File

@ -2,7 +2,7 @@
$Id$
Copyright (c) 1998-2000 by Florian Klaempfl
Contains the assembler object for the Alpha
Implements the assembler classes specific for the Alpha
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
@ -20,32 +20,33 @@
****************************************************************************
}
unit cpuasm;
{
Implements the assembler classes specific for the Alpha.
}
unit aasmcpu;
{$i fpcdefs.inc}
interface
uses
cobjects,
aasm,globals,verbose,
cpubase,tainst;
aasmbase,globals,verbose,
cpubase,aasmtai;
type
paiframe = ^taiframe;
taiframe = object(tai)
tai_frame = class(tai)
G,R : TRegister;
LS,LU : longint;
Constructor init (GP : Tregister; Localsize : Longint; RA : TRegister; L : longint);
Constructor Create (GP : Tregister; Localsize : Longint; RA : TRegister; L : longint);
end;
paient = ^taient;
taient = object(tai)
tai_ent = class(tai)
Name : string;
Constructor Init (ProcName : String);
Constructor Create (const ProcName : String);
end;
paicpu = ^taicpu;
taicpu = object(tainstruction)
taicpu = class(taicpu_abstract)
constructor op_none(op : tasmop);
constructor op_reg(op : tasmop;_op1 : tregister);
@ -72,18 +73,17 @@ type
constructor op_reg_ref_const(op : tasmop;_op1 : tregister;_op2 : preference;_op3 : longint);
{ this is for Jmp instructions }
constructor op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : pasmsymbol);
constructor op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol);
constructor op_sym(op : tasmop;_op1 : pasmsymbol);
constructor op_sym_ofs(op : tasmop;_op1 : pasmsymbol;_op1ofs:longint);
constructor op_sym_ofs_reg(op : tasmop;_op1 : pasmsymbol;_op1ofs:longint;_op2 : tregister);
constructor op_sym_ofs_ref(op : tasmop;_op1 : pasmsymbol;_op1ofs:longint;_op2 : preference);
function getcopy:plinkedlist_item;virtual;
private
segprefix : tregister;
constructor op_sym(op : tasmop;_op1 : tasmsymbol);
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_ref(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;_op2 : preference);
end;
tai_align = class(tai_align_abstract)
{ nothing to add }
end;
implementation
@ -95,178 +95,162 @@ implementation
constructor taicpu.op_none(op : tasmop);
begin
inherited init(op);
inherited create(op);
end;
constructor taicpu.op_reg(op : tasmop;_op1 : tregister);
begin
inherited init(op);
inherited create(op);
ops:=1;
end;
constructor taicpu.op_const(op : tasmop;_op1 : longint);
begin
inherited init(op);
inherited create(op);
ops:=1;
end;
constructor taicpu.op_ref(op : tasmop;_op1 : preference);
begin
inherited init(op);
inherited create(op);
ops:=1;
end;
constructor taicpu.op_reg_reg(op : tasmop;_op1,_op2 : tregister);
begin
inherited init(op);
inherited create(op);
ops:=2;
end;
constructor taicpu.op_reg_const(op:tasmop; _op1: tregister; _op2: longint);
begin
inherited init(op);
inherited create(op);
ops:=2;
end;
constructor taicpu.op_reg_ref(op : tasmop;_op1 : tregister;_op2 : preference);
begin
inherited init(op);
inherited create(op);
ops:=2;
end;
constructor taicpu.op_const_reg(op : tasmop;_op1 : longint;_op2 : tregister);
begin
inherited init(op);
inherited create(op);
ops:=2;
end;
constructor taicpu.op_const_const(op : tasmop;_op1,_op2 : longint);
begin
inherited init(op);
inherited create(op);
ops:=2;
end;
constructor taicpu.op_const_ref(op : tasmop;_op1 : longint;_op2 : preference);
begin
inherited init(op);
inherited create(op);
ops:=2;
end;
constructor taicpu.op_ref_reg(op : tasmop;_op1 : preference;_op2 : tregister);
begin
inherited init(op);
inherited create(op);
ops:=2;
end;
constructor taicpu.op_ref_ref(op : tasmop;_op1,_op2 : preference);
begin
inherited init(op);
inherited create(op);
ops:=2;
end;
constructor taicpu.op_reg_reg_reg(op : tasmop;_op1,_op2,_op3 : tregister);
begin
inherited init(op);
inherited create(op);
ops:=3;
end;
constructor taicpu.op_reg_const_reg(op : tasmop;_op1 : tregister;_op2 : longint;_op3 : tregister);
begin
inherited init(op);
inherited create(op);
ops:=3;
end;
constructor taicpu.op_reg_reg_ref(op : tasmop;_op1,_op2 : tregister;_op3 : preference);
begin
inherited init(op);
inherited create(op);
ops:=3;
end;
constructor taicpu.op_const_ref_reg(op : tasmop;_op1 : longint;_op2 : preference;_op3 : tregister);
begin
inherited init(op);
inherited create(op);
ops:=3;
end;
constructor taicpu.op_const_reg_ref(op : tasmop;_op1 : longint;_op2 : tregister;_op3 : preference);
begin
inherited init(op);
inherited create(op);
ops:=3;
end;
constructor taicpu.op_reg_ref_const(op : tasmop;_op1 : tregister;_op2 : preference;_op3 : longint);
begin
inherited init(op);
inherited create(op);
ops:=3;
end;
constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : pasmsymbol);
constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol);
begin
inherited init(op);
inherited create(op);
condition:=cond;
ops:=1;
end;
constructor taicpu.op_sym(op : tasmop;_op1 : pasmsymbol);
constructor taicpu.op_sym(op : tasmop;_op1 : tasmsymbol);
begin
inherited init(op);
inherited create(op);
ops:=1;
end;
constructor taicpu.op_sym_ofs(op : tasmop;_op1 : pasmsymbol;_op1ofs:longint);
constructor taicpu.op_sym_ofs(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint);
begin
inherited init(op);
inherited create(op);
ops:=1;
end;
constructor taicpu.op_sym_ofs_reg(op : tasmop;_op1 : pasmsymbol;_op1ofs:longint;_op2 : tregister);
constructor taicpu.op_sym_ofs_reg(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister);
begin
inherited init(op);
inherited create(op);
ops:=2;
end;
constructor taicpu.op_sym_ofs_ref(op : tasmop;_op1 : pasmsymbol;_op1ofs:longint;_op2 : preference);
constructor taicpu.op_sym_ofs_ref(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;_op2 : preference);
begin
inherited init(op);
inherited create(op);
ops:=2;
end;
function taicpu.getcopy:plinkedlist_item;
var
i : longint;
p : plinkedlist_item;
begin
p:=inherited getcopy;
{ make a copy of the references }
for i:=1 to ops do
if (paicpu(p)^.oper[i-1].typ=top_ref) then
begin
new(paicpu(p)^.oper[i-1].ref);
paicpu(p)^.oper[i-1].ref^:=oper[i-1].ref^;
end;
getcopy:=p;
end;
Constructor taiframe.init (GP : Tregister; Localsize : Longint; RA : TRegister; L : longint);
Constructor tai_frame.create (GP : Tregister; Localsize : Longint; RA : TRegister; L : longint);
begin
Inherited Init;
Inherited Create;
typ:=ait_frame;
G:=GP;
R:=RA;
@ -274,10 +258,10 @@ implementation
LU:=L;
end;
Constructor taient.Init (ProcName : String);
Constructor tai_ent.Create (const ProcName : String);
begin
Inherited init;
Inherited Create;
typ:=ait_ent;
Name:=ProcName;
end;
@ -285,7 +269,10 @@ implementation
end.
{
$Log$
Revision 1.1 2002-09-29 22:34:17 florian
Revision 1.2 2002-09-29 23:42:45 florian
* several fixes to get forward with alpha compilation
Revision 1.1 2002/09/29 22:34:17 florian
* cpuasm renamed to aasmcpu
Revision 1.2 2002/09/07 15:25:10 peter

36
compiler/alpha/agas.pas → compiler/alpha/agaxpgas.pas
View File

@ -20,20 +20,34 @@
****************************************************************************
}
unit agas;
unit agaxpgas;
{$i fpcdefs.inc}
interface
uses
globals,systems,cobjects,aasm,strings,files
agatt,cpubase;
globals,systems,aasmbase,aasmtai,
aggas,cpubase;
type
palphaattasmlist=^talphaattasmlist;
talphaattasmlist=object(tattasmlist)
procedure WriteInstruction(P : PAI);virtual;
TAXPGNUAssembler=class(TGNUAssembler)
procedure WriteInstruction(hp : tai);override;
end;
const
gas_reg2str : array[tregister] of string[4] = (
'',
'','','','','','','','','','',
'','','','','','','','','','',
'','','','','','','','','','',
'','',
'','','','','','','','','','',
'','','','','','','','','','',
'','','','','','','','','','',
'',''
);
implementation
const
@ -70,9 +84,10 @@ unit agas;
'sts','stl','stl_c','stq','stq_c','stq_u',
'stt','stw','subf','subg','subl',
'subq','subs','subt','trapb','umulh','unpkbl',
'unpkbw','wh64','wmb','xor','zap','zapnot');
'unpkbw','wh64','wmb','xor','zap','zapnot',
'ldgp');
procedure tAlphaattasmlist.WriteInstruction (P : PAi);
procedure TAXPGNUAssembler.WriteInstruction (hp : tai);
begin
(*
op:=paicpu(hp)^.opcode;
@ -113,7 +128,10 @@ end.
{
$Log$
Revision 1.2 2002-09-07 15:25:10 peter
Revision 1.1 2002-09-29 23:42:45 florian
* several fixes to get forward with alpha compilation
Revision 1.2 2002/09/07 15:25:10 peter
* old logs removed and tabs fixed
Revision 1.1 2002/08/18 09:06:54 florian

150
compiler/alpha/cgcpu.pas
View File

@ -2,7 +2,7 @@
$Id$
Copyright (c) 1998-2000 by Florian Klaempfl
This unit implements the code generator for the DEC Alpha
This unit implements the code generator for the Alpha
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
@ -20,37 +20,36 @@
****************************************************************************
}
{
This unit implements the code generator for the Alpha.
}
unit cgcpu;
{$i fpcdefs.inc}
interface
uses
cgbase,cgobj,aasm,cpuasm,cpubase,cpuinfo;
cgbase,cgobj,aasmbase,aasmtai,aasmcpu,cginfo,cpubase,cpuinfo;
type
pcgalpha = ^tcgalpha;
tcgalpha = object(tcg)
procedure a_push_reg(list : paasmoutput;r : tregister);virtual;
procedure a_call_name(list : paasmoutput;const s : string;
offset : longint);virtual;
procedure a_load_const_reg(list : paasmoutput;size : tcgsize;a : aword;register : tregister);virtual;
procedure a_load_reg_ref(list : paasmoutput;size : tcgsize;register : tregister;const ref : treference);virtual;
procedure a_load_ref_reg(list : paasmoutput;size : tcgsize;const ref : treference;register : tregister);virtual;
procedure a_load_reg_reg(list : paasmoutput;size : tcgsize;reg1,reg2 : tregister);virtual;
procedure a_cmp_reg_const_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;
reg : tregister; l : pasmlabel);virtual;
procedure a_cmp_reg_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : pasmlabel);
procedure a_cmp_reg_ref_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;reg : tregister;l : pasmlabel);
procedure a_cmp_ref_const_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;
reg : tregister; l : pasmlabel);
procedure a_loadaddress_ref_reg(list : paasmoutput;const ref : treference;r : tregister);virtual;
procedure g_stackframe_entry(list : paasmoutput;localsize : longint);virtual;
procedure g_maybe_loadself(list : paasmoutput);virtual;
procedure g_restore_frame_pointer(list : paasmoutput);virtual;
procedure g_push_exception_value_reg(list : paasmoutput;reg : tregister);virtual;
procedure g_push_exception_value_const(list : paasmoutput;reg : tregister);virtual;
procedure g_pop_exception_value_reg(list : paasmoutput;reg : tregister);virtual;
constructor init;
tcgalpha = class(tcg)
procedure a_call_name(list : taasmoutput;const s : string);override;
procedure a_load_const_reg(list : taasmoutput;size : tcgsize;a : aword;register : tregister);override;
procedure a_load_reg_ref(list : taasmoutput;size : tcgsize;register : tregister;const ref : treference);override;
procedure a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref : treference;register : tregister);override;
procedure a_load_reg_reg(list : taasmoutput;fromsize, tosize : tcgsize;reg1,reg2 : tregister);override;
procedure a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;
reg : tregister; l : tasmlabel);override;
procedure a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel);
procedure a_cmp_reg_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg : tregister;l : tasmlabel);
procedure a_cmp_ref_const_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;
reg : tregister; l : tasmlabel);
procedure a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);override;
procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override;
procedure g_maybe_loadself(list : taasmoutput);override;
procedure g_restore_frame_pointer(list : taasmoutput);override;
end;
implementation
@ -58,140 +57,102 @@ implementation
uses
globtype,globals;
constructor tcgalpha.init;
begin
inherited init;
end;
procedure tcgalpha.g_stackframe_entry(list : paasmoutput;localsize : longint);
procedure tcgalpha.g_stackframe_entry(list : taasmoutput;localsize : longint);
begin
With List^ do
begin
concat(new(paicpu,op_reg_ref(A_LDGP,Global_pointer,new_reference(R_27,0))));
concat(new(paicpu,op_reg_ref(A_LDA,Stack_Pointer,new_reference(Stack_pointer,-LocalSize))));
If LocalSize<>0 then
concat(new(paiframe,Init(Global_pointer,LocalSize,R_27,0)));
{ Always generate a frame pointer. }
concat(new(paicpu,op_reg_reg_reg(A_BIS,Stack_pointer,Stack_pointer,Frame_pointer)))
end;
list.concat(taicpu.op_reg_ref(A_LDGP,Global_pointer,new_reference(R_27,0)));
list.concat(taicpu.op_reg_ref(A_LDA,stack_pointer_reg,new_reference(stack_pointer_reg,-LocalSize)));
If LocalSize<>0 then
list.concat(tai_frame.create(Global_pointer,LocalSize,R_27,0));
{ Always generate a frame pointer. }
list.concat(taicpu.op_reg_reg_reg(A_BIS,stack_pointer_reg,stack_pointer_reg,frame_pointer_reg));
end;
procedure g_exitcode(list : paasmoutput;parasize : longint; nostackframe,inlined : boolean);
procedure g_exitcode(list : taasmoutput;parasize : longint; nostackframe,inlined : boolean);
begin
With List^ do
begin
{ Restore stack pointer from frame pointer }
Concat (new(paicpu,op_reg_reg_reg(A_BIS,Frame_Pointer,Frame_Pointer,Stack_Pointer)));
{ Restore previous stack position}
Concat (new(paicpu,op_reg_const_reg(A_ADDQ,Stack_Pointer,Parasize,Stack_pointer)));
{ return... }
Concat (new(paicpu,op_reg_ref_const(A_RET,Stack_pointer,new_reference(Return_pointer,0),1)));
{ Restore stack pointer from frame pointer }
list.Concat (taicpu.op_reg_reg_reg(A_BIS,frame_pointer_reg,frame_pointer_reg,stack_pointer_reg));
{ Restore previous stack position}
list.Concat (taicpu.op_reg_const_reg(A_ADDQ,stack_pointer_reg,Parasize,stack_pointer_reg));
{ return... }
list.Concat(taicpu.op_reg_ref_const(A_RET,stack_pointer_reg,new_reference(Return_pointer,0),1));
{ end directive
Concat (new(paiend,init(''));
Concat (paiend,init(''));
}
end;
end;
procedure tcgalpha.a_call_name(list : paasmoutput;const s : string; offset : longint);
procedure tcgalpha.a_call_name(list : taasmoutput;const s : string);
begin
{ list^.concat(new(paicpu,op_sym(A_CALL,S_NO,newasmsymbol(s)))); }
{ list^.concat(taicpu,op_sym(A_CALL,S_NO,newasmsymbol(s)))); }
{!!!!!!!!!1 offset is ignored }
abstract;
end;
procedure tcgalpha.a_push_reg(list : paasmoutput;r : tregister);
begin
{ list^.concat(new(paicpu,op_reg(A_PUSH,regsize(r),r))); }
abstract;
end;
procedure tcgalpha.a_load_const_reg(list : paasmoutput;size : tcgsize;a : aword;register : tregister);
procedure tcgalpha.a_load_const_reg(list : taasmoutput;size : tcgsize;a : aword;register : tregister);
begin
end;
procedure tcgalpha.a_load_reg_ref(list : paasmoutput;size : tcgsize;register : tregister;const ref : treference);
procedure tcgalpha.a_load_reg_ref(list : taasmoutput;size : tcgsize;register : tregister;const ref : treference);
begin
end;
procedure tcgalpha.a_load_ref_reg(list : paasmoutput;size : tcgsize;const ref : treference;register : tregister);
procedure tcgalpha.a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref : treference;register : tregister);
begin
end;
procedure tcgalpha.a_load_reg_reg(list : paasmoutput;size : tcgsize;reg1,reg2 : tregister);
procedure tcgalpha.a_load_reg_reg(list : taasmoutput;fromsize, tosize : tcgsize;reg1,reg2 : tregister);
begin
end;
procedure tcgalpha.a_cmp_reg_const_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
l : pasmlabel);
procedure tcgalpha.a_cmp_const_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;reg : tregister;
l : tasmlabel);
begin
end;
procedure tcgalpha.a_cmp_reg_reg_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : pasmlabel);
procedure tcgalpha.a_cmp_reg_reg_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel);
begin
end;
procedure tcgalpha.a_cmp_reg_ref_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;reg : tregister;l : pasmlabel);
procedure tcgalpha.a_cmp_reg_ref_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;reg : tregister;l : tasmlabel);
begin
end;
procedure tcgalpha.a_cmp_ref_const_label(list : paasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;
reg : tregister; l : pasmlabel);
procedure tcgalpha.a_cmp_ref_const_label(list : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;
reg : tregister; l : tasmlabel);
begin
end;
procedure tcgalpha.a_loadaddress_ref_reg(list : paasmoutput;const ref : treference;r : tregister);
procedure tcgalpha.a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);
begin
end;
procedure tcgalpha.g_maybe_loadself(list : paasmoutput);
procedure tcgalpha.g_maybe_loadself(list : taasmoutput);
begin
end;
procedure tcgalpha.g_restore_frame_pointer(list : paasmoutput);
begin
end;
procedure tcgalpha.g_push_exception_value_reg(list : paasmoutput;reg : tregister);
begin
end;
procedure tcgalpha.g_push_exception_value_const(list : paasmoutput;reg : tregister);
begin
end;
procedure tcgalpha.g_pop_exception_value_reg(list : paasmoutput;reg : tregister);
procedure tcgalpha.g_restore_frame_pointer(list : taasmoutput);
begin
end;
@ -200,7 +161,10 @@ end;
end.
{
$Log$
Revision 1.2 2002-09-07 15:25:10 peter
Revision 1.3 2002-09-29 23:42:45 florian
* several fixes to get forward with alpha compilation
Revision 1.2 2002/09/07 15:25:10 peter
* old logs removed and tabs fixed
Revision 1.1 2002/08/18 09:06:54 florian

438
compiler/alpha/cpubase.pas
View File

@ -2,7 +2,7 @@
$Id$
Copyright (C) 1998-2000 by Florian Klaempfl
this unit implements an asmlistitem class for the DEC Alpha
This unit implements an asmlistitem class for the Alpha architecture.
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
@ -20,196 +20,325 @@
****************************************************************************
}
{
This unit implements an asmlistitem class for the Alpha architecture.
}
unit cpubase;
{$i fpcdefs.inc}
interface
uses
strings,systems,cobjects,globals,aasm,cpuinfo;
cutils,cclasses,globals,aasmbase,cpuinfo,cginfo;
type
tasmop = (A_ADDF,A_ADDG,A_ADDL,A_ADDQ,
A_ADDS,A_ADDT,A_AMASK,A_AND,A_BEQ,A_BGE,
A_BGT,A_BIC,A_BIS,A_BLBC,A_BLBS,A_BLE,
A_BLT,A_BNE,A_BR,A_BSR,A_CALL_PAL,A_CMOVEQ,
A_CMOVGE,A_CMOVGT,A_CMOVLBC,A_CMOVLBS,A_CMOVLE,A_CMOVLT,
A_CMOVNE,A_CMPBGE,A_CMPEQ,A_CMPGEQ,A_CMPGLE,A_CMPGLT,
A_CMPLE,A_CMPLT,A_CMPTEQ,A_CMPTLE,A_CMPTLT,A_CMPTUN,
A_CMPULE,A_CMPULT,A_CPYS,A_CPYSE,A_CPYSN,A_CTLZ,
A_CTPOP,A_CTTZ,A_CVTDG,A_CVTGD,A_CVTGF,A_CVTGQ,
A_CVTLQ,A_CVTQF,A_CVTQG,A_CVTQL,A_CVTQS,A_CVTQT,
A_CVTST,A_CVTTQ,A_CVTTS,A_DIVF,A_DIVG,A_DIVS,
A_DIVT,A_ECB,A_EQV,A_EXCB,A_EXTBL,A_EXTLH,
A_EXTLL,A_EXTQH,A_EXTQL,A_EXTWH,A_EXTWL,A_FBEQ,
A_FBGE,A_FBGT,A_FBLE,A_FBLT,A_FBNE,A_FCMOVEQ,
A_FCMOVGE,A_FCMOVGT,A_FCMOVLE,A_FCMOVLT,A_FCMOVNE,A_FETCH,
A_FETCH_M,A_FTOIS,A_FTOIT,A_IMPLVER,A_INSBL,A_INSLH,
A_INSLL,A_INSQH,A_INSQL,A_INSWH,A_INSWL,A_ITOFF,
A_ITOFS,A_ITOFT,A_JMP,A_JSR,A_JSR_COROUTINE,A_LDA,
A_LDAH,A_LDBU,A_LDWU,A_LDF,A_LDG,A_LDL,
A_LDL_L,A_LDQ,A_LDQ_L,A_LDQ_U,A_LDS,A_LDT,
A_MAXSB8,A_MAXSW4,A_MAXUB8,A_MAXUW4,A_MB,A_MF_FPCR,
A_MINSB8,A_MINSW4,A_MINUB8,A_MINUW4,A_MSKBL,A_MSKLH,
A_MSKLL,A_MSKQH,A_MSKQL,A_MSKWH,A_MSKWL,A_MT_FPCR,
A_MULF,A_MULG,A_MULL,A_MULQ,
A_MULS,A_MULT,A_ORNOT,A_PERR,A_PKLB,A_PKWB,
A_RC,A_RET,A_RPCC,A_RS,A_S4ADDL,A_S4ADDQ,
A_S4SUBL,A_S4SUBQ,A_S8ADDL,A_S8ADDQ,A_S8SUBL,A_S8SUBQ,
A_SEXTB,A_SEXTW,A_SLL,A_SQRTF,A_SQRTG,A_SQRTS,
A_SQRTT,A_SRA,A_SRL,A_STB,A_STF,A_STG,
A_STS,A_STL,A_STL_C,A_STQ,A_STQ_C,A_STQ_U,
A_STT,A_STW,A_SUBF,A_SUBG,A_SUBL,
A_SUBQ,A_SUBS,A_SUBT,A_TRAPB,A_UMULH,
A_UNPKBL,A_UNPKBW,A_WH64,A_WMB,A_XOR,A_ZAP,
A_ZAPNOT
{ Psuedo code understood by the gnu assembler }
,A_LDGP);
type
{ all registers }
TRegister = (R_NO, { R_NO is Mandatory, signifies no register }
R_0,R_1,R_2,R_3,R_4,R_5,R_6,R_7,R_8,R_9,
R_10,R_11,R_12,R_13,R_14,R_15,R_16,R_17,R_18,R_19,
R_20,R_21,R_22,R_23,R_24,R_25,R_26,R_27,R_28,R_29,
R_30,R_31,
R_F0,R_F1,R_F2,R_F3,R_F4,R_F5,R_F6,R_F7,R_F8,R_F9,
R_F10,R_F11,R_F12,R_F13,R_F14,R_F15,R_F16,R_F17,R_F18,R_F19,
R_F20,R_F21,R_F22,R_F23,R_F24,R_F25,R_F26,R_F27,R_F28,R_F29,
R_F30,R_F31);
Const
firstop = low(tasmop);
lastop = high(tasmop);
tasmop = (A_ADDF,A_ADDG,A_ADDL,A_ADDQ,
A_ADDS,A_ADDT,A_AMASK,A_AND,A_BEQ,A_BGE,
A_BGT,A_BIC,A_BIS,A_BLBC,A_BLBS,A_BLE,
A_BLT,A_BNE,A_BR,A_BSR,A_CALL_PAL,A_CMOVEQ,
A_CMOVGE,A_CMOVGT,A_CMOVLBC,A_CMOVLBS,A_CMOVLE,A_CMOVLT,
A_CMOVNE,A_CMPBGE,A_CMPEQ,A_CMPGEQ,A_CMPGLE,A_CMPGLT,
A_CMPLE,A_CMPLT,A_CMPTEQ,A_CMPTLE,A_CMPTLT,A_CMPTUN,
A_CMPULE,A_CMPULT,A_CPYS,A_CPYSE,A_CPYSN,A_CTLZ,
A_CTPOP,A_CTTZ,A_CVTDG,A_CVTGD,A_CVTGF,A_CVTGQ,
A_CVTLQ,A_CVTQF,A_CVTQG,A_CVTQL,A_CVTQS,A_CVTQT,
A_CVTST,A_CVTTQ,A_CVTTS,A_DIVF,A_DIVG,A_DIVS,
A_DIVT,A_ECB,A_EQV,A_EXCB,A_EXTBL,A_EXTLH,
A_EXTLL,A_EXTQH,A_EXTQL,A_EXTWH,A_EXTWL,A_FBEQ,
A_FBGE,A_FBGT,A_FBLE,A_FBLT,A_FBNE,A_FCMOVEQ,
A_FCMOVGE,A_FCMOVGT,A_FCMOVLE,A_FCMOVLT,A_FCMOVNE,A_FETCH,
A_FETCH_M,A_FTOIS,A_FTOIT,A_IMPLVER,A_INSBL,A_INSLH,
A_INSLL,A_INSQH,A_INSQL,A_INSWH,A_INSWL,A_ITOFF,
A_ITOFS,A_ITOFT,A_JMP,A_JSR,A_JSR_COROUTINE,A_LDA,
A_LDAH,A_LDBU,A_LDWU,A_LDF,A_LDG,A_LDL,
A_LDL_L,A_LDQ,A_LDQ_L,A_LDQ_U,A_LDS,A_LDT,
A_MAXSB8,A_MAXSW4,A_MAXUB8,A_MAXUW4,A_MB,A_MF_FPCR,
A_MINSB8,A_MINSW4,A_MINUB8,A_MINUW4,A_MSKBL,A_MSKLH,
A_MSKLL,A_MSKQH,A_MSKQL,A_MSKWH,A_MSKWL,A_MT_FPCR,
A_MULF,A_MULG,A_MULL,A_MULQ,
A_MULS,A_MULT,A_ORNOT,A_PERR,A_PKLB,A_PKWB,
A_RC,A_RET,A_RPCC,A_RS,A_S4ADDL,A_S4ADDQ,
A_S4SUBL,A_S4SUBQ,A_S8ADDL,A_S8ADDQ,A_S8SUBL,A_S8SUBQ,
A_SEXTB,A_SEXTW,A_SLL,A_SQRTF,A_SQRTG,A_SQRTS,
A_SQRTT,A_SRA,A_SRL,A_STB,A_STF,A_STG,
A_STS,A_STL,A_STL_C,A_STQ,A_STQ_C,A_STQ_U,
A_STT,A_STW,A_SUBF,A_SUBG,A_SUBL,
A_SUBQ,A_SUBS,A_SUBT,A_TRAPB,A_UMULH,
A_UNPKBL,A_UNPKBW,A_WH64,A_WMB,A_XOR,A_ZAP,
A_ZAPNOT
{ Psuedo code understood by the gnu assembler }
,A_LDGP);
type
TAsmCond =
(
C_None,C_A,C_AE,C_B,C_BE,C_C,C_E,C_G,C_GE,C_L,C_LE,C_NA,C_NAE,
C_NB,C_NBE,C_NC,C_NE,C_NG,C_NGE,C_NL,C_NLE,C_NO,C_NP,C_NS,C_NZ,C_O,C_P,
C_PE,C_PO,C_S,C_Z
);
const
firstop = low(tasmop);
lastop = high(tasmop);
std_reg2str : array[tregister] of string[4] = (
'',
'','','','','','','','','','',
'','','','','','','','','','',
'','','','','','','','','','',
'','',
'','','','','','','','','','',
'','','','','','','','','','',
'','','','','','','','','','',
'',''
);
Type
type
TAsmCond =
(
C_None,C_A,C_AE,C_B,C_BE,C_C,C_E,C_G,C_GE,C_L,C_LE,C_NA,C_NAE,
C_NB,C_NBE,C_NC,C_NE,C_NG,C_NGE,C_NL,C_NLE,C_NO,C_NP,C_NS,C_NZ,C_O,C_P,
C_PE,C_PO,C_S,C_Z
);
{ ALL registers }
TRegister = (R_NO, { R_NO is Mandatory, signifies no register }
R_0,R_1,R_2,R_3,R_4,R_5,R_6,R_7,R_8,R_9,
R_10,R_11,R_12,R_13,R_14,R_15,R_16,R_17,R_18,R_19,
R_20,R_21,R_22,R_23,R_24,R_25,R_26,R_27,R_28,R_29,
R_30,R_31,
R_F0,R_F1,R_F2,R_F3,R_F4,R_F5,R_F6,R_F7,R_F8,R_F9,
R_F10,R_F11,R_F12,R_F13,R_F14,R_F15,R_F16,R_F17,R_F18,R_F19,
R_F20,R_F21,R_F22,R_F23,R_F24,R_F25,R_F26,R_F27,R_F28,R_F29,
R_F30,R_F31);
TRegisterset = Set of TRegister;
TRegisterset = Set of TRegister;
tregister64 = tregister;
{ Constants describing the registers }
Const
Firstreg = R_0;
LastReg = R_F31;
Const
Firstreg = R_0;
LastReg = R_F31;
stack_pointer = R_30;
frame_pointer = R_15;
self_pointer = R_16;
accumulator = R_0;
global_pointer = R_29;
return_pointer = R_26;
{ it is used to pass the offset to the destructor helper routine }
vmt_offset_reg = R_1;
{*****************************************************************************
Default generic sizes
*****************************************************************************}
max_scratch_regs = 2;
scratch_regs : array[1..max_scratch_regs] of tregister = (R_1,R_2);
{ Defines the default address size for a processor, }
OS_ADDR = OS_64;
{ the natural int size for a processor, }
OS_INT = OS_64;
{ the maximum float size for a processor, }
OS_FLOAT = OS_F80;
{ the size of a vector register for a processor }
OS_VECTOR = OS_M64;
{ low and high of the available maximum width integer general purpose }
{ registers }
LoGPReg = R_0;
HiGPReg = R_31;
stack_pointer_reg = R_30;
frame_pointer_reg = R_15;
self_pointer_reg = R_16;
accumulator = R_0;
fpu_result_reg = R_F0;
global_pointer = R_29;
return_pointer = R_26;
{ it is used to pass the offset to the destructor helper routine }
vmt_offset_reg = R_1;
{ low and high of every possible width general purpose register (same as }
{ above on most architctures apart from the 80x86) }
LoReg = R_0;
HiReg = R_31;
{ low and high of the available maximum width integer general purpose }
{ registers }
LoGPReg = R_0;
HiGPReg = R_31;
cpuflags = [cf_64bitaddr];
{ low and high of every possible width general purpose register (same as
above on most architctures apart from the 80x86) }
LoReg = R_0;
HiReg = R_31;
{ sizes }
pointersize = 8;
extended_size = 16;
{ Constant defining possibly all registers which might require saving }
ALL_REGISTERS = [firstreg..lastreg];
general_registers = [R_0..R_31];
general_registers = [R_0..R_31];
intregs = [R_0..R_31];
fpuregs = [R_F0..R_F31];
mmregs = [];
availabletempregsint = [R_0..R_14,R_16..R_25,R_28];
availabletempregsfpu = [R_F0..R_F30];
availabletempregsmm = [];
availabletempregsint = [R_0..R_14,R_16..R_25,R_28];
availabletempregsfpu = [R_F0..R_F30];
availabletempregsmm = [];
intregs = [R_0..R_31];
usableregsint = [];
c_countusableregsint = 26;
c_countusableregsint = 26;
c_countusableregsfpu = 31;
c_countusableregsmm = 0;
maxfpuregs = 32;
fpuregs = [R_F0..R_F31];
usableregsfpu = [];
c_countusableregsfpu = 31;
max_operands = 4;
mmregs = [];
usableregsmm = [];
c_countusableregsmm = 0;
registers_saved_on_cdecl = [R_9..R_14,R_F2..R_F9];
maxvarregs = 6;
max_operands = 4;
varregs : Array [1..maxvarregs] of Tregister =
(R_9,R_10,R_11,R_12,R_13,R_14);
registers_saved_on_cdecl = [R_9..R_14,R_F2..R_F9];
Type
TReference = record
offset : aword;
symbol : pasmsymbol;
base : tregister;
is_immediate : boolean;
offsetfixup : word; {needed for inline}
{ the boundary to which the reference is surely aligned }
alignment : byte;
end;
PReference = ^TReference;
firstsaveintreg = R_NO;
lastsaveintreg = R_NO;
firstsavefpureg = R_NO;
lastsavefpureg = R_NO;
firstsavemmreg = R_NO;
lastsavemmreg = R_NO;
maxvarregs = 6;
tloc = (LOC_INVALID,
LOC_REGISTER,
LOC_MEM,
LOC_REFERENCE,
LOC_JUMP,
{ the alpha doesn't have flags, but this }
{ avoid some conditional compiling }
{ DON'T USE for the alpha }
LOC_FLAGS,
LOC_CREGISTER,
LOC_CONST);
varregs : Array [1..maxvarregs] of Tregister =
(R_9,R_10,R_11,R_12,R_13,R_14);
tlocation = record
case loc : tloc of
LOC_REFERENCE,LOC_MEM : (reference : treference);
LOC_REGISTER : (register : tregister);
end;
maxfpuvarregs = 8;
{ Registers which are defined as scratch and no need to save across
routine calls or in assembler blocks.
}
max_scratch_regs = 2;
scratch_regs : array[1..max_scratch_regs] of tregister = (R_1,R_2);
type
{*****************************************************************************
Flags
*****************************************************************************}
{ The Alpha doesn't have flags but some generic code depends on this type. }
TResFlags = (F_NO);
{ reference record }
pparareference = ^tparareference;
tparareference = packed record
index : tregister;
offset : longint;
end;
trefoptions=(ref_none,ref_parafixup,ref_localfixup,ref_selffixup);
TReference = record
offset : aword;
symbol : tasmsymbol;
base : tregister;
{ The index isn't used by the alpha port, but some generic code depends on it }
index : tregister;
is_immediate : boolean;
offsetfixup : word; {needed for inline}
options : trefoptions;
{ the boundary to which the reference is surely aligned }
alignment : byte;
end;
PReference = ^TReference;
TLoc=(
LOC_INVALID, { added for tracking problems}
LOC_CONSTANT, { constant value }
LOC_JUMP, { boolean results only, jump to false or true label }
LOC_FLAGS, { boolean results only, flags are set }
LOC_CREFERENCE, { in memory constant value reference (cannot change) }
LOC_REFERENCE, { in memory value }
LOC_REGISTER, { in a processor register }
LOC_CREGISTER, { Constant register which shouldn't be modified }
LOC_FPUREGISTER, { FPU stack }
LOC_CFPUREGISTER, { if it is a FPU register variable on the fpu stack }
LOC_SSEREGISTER,
LOC_CSSEREGISTER,
LOC_CMMREGISTER,
LOC_MMREGISTER
);
{ tparamlocation describes where a parameter for a procedure is stored.
References are given from the caller's point of view. The usual
TLocation isn't used, because contains a lot of unnessary fields.
}
tparalocation = packed record
size : TCGSize;
loc : TLoc;
sp_fixup : longint;
case TLoc of
LOC_REFERENCE : (reference : tparareference);
{ segment in reference at the same place as in loc_register }
LOC_REGISTER,LOC_CREGISTER : (
case longint of
1 : (register,registerhigh : tregister);
{ overlay a registerlow }
2 : (registerlow : tregister);
{ overlay a 64 Bit register type }
3 : (reg64 : tregister64);
4 : (register64 : tregister64);
);
end;
tlocation = packed record
loc : TLoc;
size : TCGSize;
case TLoc of
LOC_CONSTANT : (
case longint of
1 : (value : AWord);
{ can't do this, this layout depends on the host cpu. Use }
{ lo(valueqword)/hi(valueqword) instead (JM) }
{ 2 : (valuelow, valuehigh:AWord); }
{ overlay a complete 64 Bit value }
3 : (valueqword : qword);
);
LOC_CREFERENCE,
LOC_REFERENCE : (reference : treference);
{ segment in reference at the same place as in loc_register }
LOC_REGISTER,LOC_CREGISTER : (
case longint of
1 : (register,registerhigh,segment : tregister);
{ overlay a registerlow }
2 : (registerlow : tregister);
{ overlay a 64 Bit register type }
3 : (reg64 : tregister64);
4 : (register64 : tregister64);
);
end;
{*****************************************************************************
Operands
*****************************************************************************}
{ Types of operand }
toptype=(top_none,top_reg,top_ref,top_const,top_symbol);
{ Types of operand }
toptype=(top_none,top_reg,top_ref,top_const,top_symbol);
toper=record
ot : longint;
case typ : toptype of
top_none : ();
top_reg : (reg:tregister);
top_ref : (ref:preference);
top_const : (val:longint);
top_symbol : (sym:pasmsymbol;symofs:longint);
end;
toper=record
ot : longint;
case typ : toptype of
top_none : ();
top_reg : (reg:tregister);
top_ref : (ref:preference);
top_const : (val:longint);
top_symbol : (sym:tasmsymbol;symofs:longint);
end;
Const
{ offsets for the integer and floating point registers }
INT_REG = 0;
FLOAT_REG = 32;
const
{ Registers which must be saved when calling a routine declared as
cppdecl, cdecl, stdcall, safecall, palmossyscall. The registers
saved should be the ones as defined in the target ABI and / or GCC.
{ operator qualifiers }
OQ_CHOPPED_ROUNDING = $01; { /C }
OQ_ROUNDING_MODE_DYNAMIC = $02; { /D }
OQ_ROUND_TOWARD_MINUS_INFINITY = $04; { /M }
OQ_INEXACT_RESULT_ENABLE = $08; { /I }
OQ_SOFTWARE_COMPLETION_ENABLE = $10; { /S }
OQ_FLOATING_UNDERFLOW_ENABLE = $20; { /U }
OQ_INTEGER_OVERFLOW_ENABLE = $40; { /V }
This value can be deduced from the CALLED_USED_REGISTERS array in the
GCC source.
}
std_saved_registers = [];
{ Required parameter alignment when calling a routine declared as
stdcall and cdecl. The alignment value should be the one defined
by GCC or the target ABI.
The value of this constant is equal to the constant
PARM_BOUNDARY / BITS_PER_UNIT in the GCC source.
}
std_param_align = 8;
{ offsets for the integer and floating point registers }
INT_REG = 0;
FLOAT_REG = 32;
{ operator qualifiers }
OQ_CHOPPED_ROUNDING = $01; { /C }
OQ_ROUNDING_MODE_DYNAMIC = $02; { /D }
OQ_ROUND_TOWARD_MINUS_INFINITY = $04; { /M }
OQ_INEXACT_RESULT_ENABLE = $08; { /I }
OQ_SOFTWARE_COMPLETION_ENABLE = $10; { /S }
OQ_FLOATING_UNDERFLOW_ENABLE = $20; { /U }
OQ_INTEGER_OVERFLOW_ENABLE = $40; { /V }
{*****************************************************************************
@ -303,7 +432,10 @@ end;
end.
{
$Log$
Revision 1.2 2002-09-07 15:25:10 peter
Revision 1.3 2002-09-29 23:42:45 florian
* several fixes to get forward with alpha compilation
Revision 1.2 2002/09/07 15:25:10 peter
* old logs removed and tabs fixed
Revision 1.1 2002/08/18 09:06:54 florian

45
compiler/alpha/cpuinfo.pas
View File

@ -3,7 +3,7 @@
This file is part of the Free Pascal run time library.
Copyright (c) 1998-2000 by the Free Pascal development team
Basic Processor information
Basic Processor information about the Alpha
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
@ -13,22 +13,61 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{
Basic Processor information about the Alpha
}
Unit CPUInfo;
{$i fpcdefs.inc}
Interface
Type
{ Architecture word - Native unsigned type }
{ Natural integer register type and size for the target machine }
{$ifdef FPC}
AWord = Qword;
{$else FPC}
AWord = Longint;
{$endif FPC}
PAWord = ^AWord;
{ This must be an ordinal type with the same size as a pointer
Note: Must be unsigned! Otherwise, ugly code like
pointer(-1) will result in a pointer with the value
$fffffffffffffff on a 32bit machine if the compiler uses
int64 constants internally (JM) }
TConstPtrUInt = qword;
bestreal = extended;
ts32real = single;
ts64real = double;
ts80real = extended;
ts64comp = extended;
pbestreal=^bestreal;
{ possible supported processors for this target }
tprocessors =
(no_processor,
ClassEV7,
ClassEV8
);
Const
{ Size of native extended type }
extended_size = 16;
{# Size of a pointer }
pointer_size = 8;
{# Size of a multimedia register }
mmreg_size = 8;
{ target cpu string (used by compiler options) }
target_cpu_string = 'alpha';
{ size of the buffer used for setjump/longjmp
the size of this buffer is deduced from the
jmp_buf structure in setjumph.inc file
}
jmp_buf_size = 24;
Implementation

127
compiler/alpha/cpuswtch.pas Normal file
View File

@ -0,0 +1,127 @@
{
$Id$
Copyright (c) 1998-2002 by Florian Klaempfl, Pierre Muller
This units interprets the commandline options which are Alpha specific.
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 units interprets the commandline options which are Alpha specific.
}
unit cpuswtch;
{$i fpcdefs.inc}
interface
uses
options;
type
toptionalpha = class(toption)
procedure interpret_proc_specific_options(const opt:string);override;
end;
implementation
uses
cutils,globtype,systems,globals;
procedure toptionalpha.interpret_proc_specific_options(const opt:string);
var
more: string;
j: longint;
begin
More:=Upper(copy(opt,3,length(opt)-2));
case opt[2] of
'O' : Begin
j := 3;
While (j <= Length(Opt)) Do
Begin
case opt[j] of
'-' :
begin
initglobalswitches:=initglobalswitches-[cs_optimize,cs_fastoptimize,cs_slowoptimize,cs_littlesize,
cs_regalloc,cs_uncertainopts];
FillChar(ParaAlignment,sizeof(ParaAlignment),0);
end;
'a' :
begin
UpdateAlignmentStr(Copy(Opt,j+1,255),ParaAlignment);
j:=length(Opt);
end;
'g' : initglobalswitches:=initglobalswitches+[cs_littlesize];
'G' : initglobalswitches:=initglobalswitches-[cs_littlesize];
'r' :
begin
initglobalswitches:=initglobalswitches+[cs_regalloc];
Simplify_ppu:=false;
end;
'u' : initglobalswitches:=initglobalswitches+[cs_uncertainopts];
'1' : initglobalswitches:=initglobalswitches-[cs_fastoptimize,cs_slowoptimize]+[cs_optimize];
'2' : initglobalswitches:=initglobalswitches-[cs_slowoptimize]+[cs_optimize,cs_fastoptimize];
'3' : initglobalswitches:=initglobalswitches+[cs_optimize,cs_fastoptimize,cs_slowoptimize];
{$ifdef dummy}
'p' :
Begin
If j < Length(Opt) Then
Begin
Case opt[j+1] Of
'1': initoptprocessor := Class386;
'2': initoptprocessor := ClassP5;
'3': initoptprocessor := ClassP6
Else IllegalPara(Opt)
End;
Inc(j);
End
Else IllegalPara(opt)
End;
{$endif dummy}
else IllegalPara(opt);
End;
Inc(j)
end;
end;
{$ifdef dummy}
'R' : begin
if More='GAS' then
initasmmode:=asmmode_ppc_gas
else
if More='MOTOROLA' then
initasmmode:=asmmode_ppc_motorola
else
if More='DIRECT' then
initasmmode:=asmmode_direct
else
IllegalPara(opt);
end;
{$endif dummy}
else
IllegalPara(opt);
end;
end;
initialization
coption:=toptionalpha;
end.
{
$Log$
Revision 1.1 2002-09-29 23:42:45 florian
* several fixes to get forward with alpha compilation
}

344
compiler/alpha/radirect.pas Normal file
View File

@ -0,0 +1,344 @@
{
$Id$
Copyright (c) 1998-2002 by Florian Klaempfl
Reads inline Alpha assembler and writes the lines direct to the output
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 reads Alpha inline assembler and writes the lines direct to the output file.
}
unit radirect;
{$i fpcdefs.inc}
interface
uses
node;
function assemble : tnode;
implementation
uses
{ common }
cutils,
{ global }
globals,verbose,
systems,
{ aasm }
aasmbase,aasmtai,aasmcpu,
{ symtable }
symconst,symbase,symtype,symsym,symtable,defbase,
{ pass 1 }
nbas,
{ parser }
scanner,
{ codegen }
cgbase,
{ constants }
agaxpgas,
cpubase
;
function assemble : tnode;
var
retstr,s,hs : string;
c : char;
ende : boolean;
srsym,sym : tsym;
srsymtable : tsymtable;
code : TAAsmoutput;
i,l : longint;
procedure writeasmline;
var
i : longint;
begin
i:=length(s);
while (i>0) and (s[i] in [' ',#9]) do
dec(i);
s[0]:=chr(i);
if s<>'' then
code.concat(Tai_direct.Create(strpnew(s)));
{ consider it set function set if the offset was loaded }
if assigned(aktprocdef.funcretsym) and
(pos(retstr,upper(s))>0) then
tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
s:='';
end;
begin
ende:=false;
s:='';
if assigned(aktprocdef.funcretsym) and
is_fpu(aktprocdef.rettype.def) then
tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
{ !!!!!
if (not is_void(aktprocdef.rettype.def)) then
retstr:=upper(tostr(procinfo^.return_offset)+'('+gas_reg2str[procinfo^.framepointer]+')')
else
}
retstr:='';
c:=current_scanner.asmgetchar;
code:=TAAsmoutput.Create;
while not(ende) do
begin
{ wrong placement
current_scanner.gettokenpos; }
case c of
'A'..'Z','a'..'z','_':
begin
current_scanner.gettokenpos;
i:=0;
hs:='';
while ((ord(c)>=ord('A')) and (ord(c)<=ord('Z')))
or ((ord(c)>=ord('a')) and (ord(c)<=ord('z')))
or ((ord(c)>=ord('0')) and (ord(c)<=ord('9')))
or (c='_') do
begin
inc(i);
hs[i]:=c;
c:=current_scanner.asmgetchar;
end;
hs[0]:=chr(i);
if upper(hs)='END' then
ende:=true
else
begin
if c=':' then
begin
searchsym(upper(hs),srsym,srsymtable);
if srsym<>nil then
if (srsym.typ = labelsym) then
Begin
hs:=tlabelsym(srsym).lab.name;
tlabelsym(srsym).lab.is_set:=true;
end
else
Message(asmr_w_using_defined_as_local);
end
else
{ access to local variables }
if assigned(aktprocdef) then
begin
{ I don't know yet, what the ppc port requires }
{ we'll see how things settle down }
{ is the last written character an special }
{ char ? }
{ !!!
if (s[length(s)]='%') and
ret_in_acc(aktprocdef.rettype.def) and
((pos('AX',upper(hs))>0) or
(pos('AL',upper(hs))>0)) then
tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
}
if ((s[length(s)]<>'0') or (hs[1]<>'x')) then
begin
if assigned(aktprocdef.localst) and
(lexlevel >= normal_function_level) then
sym:=tsym(aktprocdef.localst.search(upper(hs)))
else
sym:=nil;
if assigned(sym) then
begin
if (sym.typ=labelsym) then
Begin
hs:=tlabelsym(sym).lab.name;
end
else if sym.typ=varsym then
begin
if (vo_is_external in tvarsym(sym).varoptions) then
hs:=tvarsym(sym).mangledname
else
begin
if (tvarsym(sym).reg<>R_NO) then
hs:=gas_reg2str[procinfo.framepointer]
else
hs:=tostr(tvarsym(sym).address)+
'('+gas_reg2str[procinfo.framepointer]+')';
end;
end
else
{ call to local function }
if (sym.typ=procsym) and (pos('BL',upper(s))>0) then
hs:=tprocsym(sym).first_procdef.mangledname;
end
else
begin
if assigned(aktprocdef.parast) then
sym:=tsym(aktprocdef.parast.search(upper(hs)))
else
sym:=nil;
if assigned(sym) then
begin
if sym.typ=varsym then
begin
l:=tvarsym(sym).address;
{ set offset }
inc(l,aktprocdef.parast.address_fixup);
hs:=tostr(l)+'('+gas_reg2str[procinfo.framepointer]+')';
if pos(',',s) > 0 then
tvarsym(sym).varstate:=vs_used;
end;
end
{ I added that but it creates a problem in line.ppi
because there is a local label wbuffer and
a static variable WBUFFER ...
what would you decide, florian ?}
else
begin
searchsym(upper(hs),sym,srsymtable);
if assigned(sym) and (sym.owner.symtabletype in [globalsymtable,staticsymtable]) then
begin
case sym.typ of
varsym :
begin
Message2(asmr_h_direct_global_to_mangled,hs,tvarsym(sym).mangledname);
hs:=tvarsym(sym).mangledname;
inc(tvarsym(sym).refs);
end;
typedconstsym :
begin
Message2(asmr_h_direct_global_to_mangled,hs,ttypedconstsym(sym).mangledname);
hs:=ttypedconstsym(sym).mangledname;
end;
procsym :
begin
{ procs can be called or the address can be loaded }
if (pos('BL',upper(s))>0) {or (pos('LEA',upper(s))>0))} then
begin
if Tprocsym(sym).procdef_count>1 then
Message1(asmr_w_direct_global_is_overloaded_func,hs);
Message2(asmr_h_direct_global_to_mangled,hs,tprocsym(sym).first_procdef.mangledname);
hs:=tprocsym(sym).first_procdef.mangledname;
end;
end;
else
Message(asmr_e_wrong_sym_type);
end;
end
{$ifdef dummy}
else if upper(hs)='__SELF' then
begin
if assigned(procinfo^._class) then
hs:=tostr(procinfo^.selfpointer_offset)+
'('+gas_reg2str[procinfo^.framepointer]+')'
else
Message(asmr_e_cannot_use_SELF_outside_a_method);
end
else if upper(hs)='__RESULT' then
begin
if (not is_void(aktprocdef.rettype.def)) then
hs:=retstr
else
Message(asmr_e_void_function);
end
{ implement old stack/frame pointer access for nested procedures }
{!!!!
else if upper(hs)='__OLDSP' then
begin
{ complicate to check there }
{ we do it: }
if lexlevel>normal_function_level then
hs:=tostr(procinfo^.framepointer_offset)+
'('+gas_reg2str[procinfo^.framepointer]+')'
else
Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
end;
}
end;
{$endif dummy}
end;
end;
end;
end;
s:=s+hs;
end;
end;
'{',';',#10,#13:
begin
if pos(retstr,s) > 0 then
tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
writeasmline;
c:=current_scanner.asmgetchar;
end;
#26:
Message(scan_f_end_of_file);
else
begin
current_scanner.gettokenpos;
inc(byte(s[0]));
s[length(s)]:=c;
c:=current_scanner.asmgetchar;
end;
end;
end;
writeasmline;
assemble:=casmnode.create(code);
end;
{*****************************************************************************
Initialize
*****************************************************************************}
const
asmmode_ppc_direct_info : tasmmodeinfo =
(
id : asmmode_direct;
idtxt : 'DIRECT'
);
initialization
RegisterAsmMode(asmmode_ppc_direct_info);
end.
{
$Log$
Revision 1.1 2002-09-29 23:42:45 florian
* several fixes to get forward with alpha compilation
Revision 1.5 2002/09/03 19:04:18 daniel
* Fixed PowerPC & M68000 compilation
Revision 1.4 2002/09/03 16:26:28 daniel
* Make Tprocdef.defs protected
Revision 1.3 2002/08/31 15:59:31 florian
+ HEAP* stuff must be generated for Linux/PPC as well
+ direct assembler reader searches now global and static symtables as well
Revision 1.2 2002/08/18 21:36:42 florian
+ handling of local variables in direct reader implemented
Revision 1.1 2002/08/10 14:52:52 carl
+ moved target_cpu_string to cpuinfo
* renamed asmmode enum.
* assembler reader has now less ifdef's
* move from nppcmem.pas -> ncgmem.pas vec. node.
Revision 1.2 2002/07/28 20:45:23 florian
+ added direct assembler reader for PowerPC
Revision 1.1 2002/07/11 14:41:34 florian
* start of the new generic parameter handling
}

71
compiler/alpha/rasm.pas Normal file
View File

@ -0,0 +1,71 @@
{
$Id$
Copyright (c) 1998-2002 by The Free Pascal Team
This unit does the parsing process for the inline assembler
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 does the parsing process for the inline assembler.
}
Unit Rasm;
{$i fpcdefs.inc}
Interface
uses
node;
{
This routine is called to parse the instructions in assembler
blocks. It returns a complete list of directive and instructions
}
function assemble: tnode;
Implementation
uses
{ common }
cutils,cclasses,
{ global }
globtype,globals,verbose,
systems,
{ aasm }
cpubase,aasmbase,aasmtai,aasmcpu,
{ symtable }
symconst,symbase,symtype,symsym,symtable,
{ pass 1 }
nbas,
{ parser }
scanner
// ,rautils
;
function assemble : tnode;
begin
end;
Begin
end.
{
$Log$
Revision 1.1 2002-09-29 23:42:45 florian
* several fixes to get forward with alpha compilation
}

89
compiler/alpha/rgcpu.pas Normal file
View File

@ -0,0 +1,89 @@
{
$Id$
Copyright (c) 1998-2002 by Florian Klaempfl
This unit implements the powerpc specific class for the register
allocator
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 rgcpu;
{$i fpcdefs.inc}
interface
uses
aasmbase,aasmtai,
cpubase,
rgobj;
type
trgcpu = class(trgobj)
function getexplicitregisterint(list: taasmoutput; reg: tregister): tregister; override;
procedure ungetregisterint(list: taasmoutput; reg: tregister); override;
end;
implementation
uses
cgobj;
function trgcpu.getexplicitregisterint(list: taasmoutput; reg: tregister): tregister;
begin
if reg = R_0 then
begin
cg.a_reg_alloc(list,reg);
result := reg;
end
else result := inherited getexplicitregisterint(list,reg);
end;
procedure trgcpu.ungetregisterint(list: taasmoutput; reg: tregister);
begin
if reg = R_0 then
cg.a_reg_dealloc(list,reg)
else
inherited ungetregisterint(list,reg);
end;
initialization
rg := trgcpu.create;
end.
{
$Log$
Revision 1.1 2002-09-29 23:42:45 florian
* several fixes to get forward with alpha compilation
Revision 1.3 2002/07/07 09:44:32 florian
* powerpc target fixed, very simple units can be compiled
Revision 1.2 2002/05/16 19:46:53 carl
+ defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
+ try to fix temp allocation (still in ifdef)
+ generic constructor calls
+ start of tassembler / tmodulebase class cleanup
Revision 1.1 2002/04/06 18:13:02 jonas
* several powerpc-related additions and fixes
}

18
compiler/alpha/tgcpu.pas
View File

@ -20,29 +20,33 @@
****************************************************************************
}
{
This unit handles the temporary variables stuff for Alpha.
}
unit tgcpu;
{$i fpcdefs.inc}
interface
uses
tgobj;
type
ttgalpha = Object(ttgobj)
ttgalpha = class(ttgobj)
end;
var
tg : ttgalpha;
implementation
begin
tg.init;
tg:=ttgalpha.create;
end.
{
$Log$
Revision 1.2 2002-09-07 15:25:10 peter
Revision 1.3 2002-09-29 23:42:46 florian
* several fixes to get forward with alpha compilation
Revision 1.2 2002/09/07 15:25:10 peter
* old logs removed and tabs fixed
Revision 1.1 2002/08/18 09:06:54 florian