summaryrefslogtreecommitdiff
path: root/compiler/alpha
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/alpha')
-rw-r--r--compiler/alpha/aasmcpu.pas281
-rw-r--r--compiler/alpha/agaxpgas.pas126
-rw-r--r--compiler/alpha/aoptcpu.pas38
-rw-r--r--compiler/alpha/aoptcpub.pas115
-rw-r--r--compiler/alpha/aoptcpuc.pas38
-rw-r--r--compiler/alpha/aoptcpud.pas39
-rw-r--r--compiler/alpha/cgcpu.pas160
-rw-r--r--compiler/alpha/cpubase.pas457
-rw-r--r--compiler/alpha/cpuinfo.pas68
-rw-r--r--compiler/alpha/cpunode.pas54
-rw-r--r--compiler/alpha/cpupara.pas290
-rw-r--r--compiler/alpha/cpupi.pas43
-rw-r--r--compiler/alpha/cpuswtch.pas121
-rw-r--r--compiler/alpha/cputarg.pas51
-rw-r--r--compiler/alpha/radirect.pas313
-rw-r--r--compiler/alpha/rasm.pas65
-rw-r--r--compiler/alpha/rgcpu.pas69
-rw-r--r--compiler/alpha/tgcpu.pas42
18 files changed, 2370 insertions, 0 deletions
diff --git a/compiler/alpha/aasmcpu.pas b/compiler/alpha/aasmcpu.pas
new file mode 100644
index 0000000000..10f02190f9
--- /dev/null
+++ b/compiler/alpha/aasmcpu.pas
@@ -0,0 +1,281 @@
+{
+ Copyright (c) 1998-2000 by Florian Klaempfl
+
+ 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
+ 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.
+
+ ****************************************************************************
+}
+{
+ Implements the assembler classes specific for the Alpha.
+}
+unit aasmcpu;
+
+{$i fpcdefs.inc}
+
+ interface
+
+ uses
+ aasmbase,globals,verbose,
+ cpubase,aasmtai;
+
+ type
+ tai_frame = class(tai)
+ G,R : TRegister;
+ LS,LU : longint;
+ Constructor Create (GP : Tregister; Localsize : Longint; RA : TRegister; L : longint);
+ end;
+
+ tai_ent = class(tai)
+ Name : string;
+ Constructor Create (const ProcName : String);
+ end;
+
+
+ taicpu = class(taicpu_abstract)
+ constructor op_none(op : tasmop);
+
+ constructor op_reg(op : tasmop;_op1 : tregister);
+ constructor op_const(op : tasmop;_op1 : longint);
+ constructor op_ref(op : tasmop;_op1 : preference);
+
+ constructor op_reg_reg(op : tasmop;_op1,_op2 : tregister);
+ constructor op_reg_ref(op : tasmop;_op1 : tregister;_op2 : preference);
+ constructor op_reg_const(op:tasmop; _op1: tregister; _op2: longint);
+
+ constructor op_const_reg(op : tasmop;_op1 : longint;_op2 : tregister);
+ constructor op_const_const(op : tasmop;_op1,_op2 : longint);
+ constructor op_const_ref(op : tasmop;_op1 : longint;_op2 : preference);
+
+ constructor op_ref_reg(op : tasmop;_op1 : preference;_op2 : tregister);
+ { this is only allowed if _op1 is an int value (_op1^.isintvalue=true) }
+ constructor op_ref_ref(op : tasmop;_op1,_op2 : preference);
+
+ 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_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_const_reg_ref(op : tasmop;_op1 : longint;_op2 : tregister;_op3 : preference);
+ 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 : tasmsymbol);
+
+ 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;
+
+ procedure InitAsm;
+ procedure DoneAsm;
+
+implementation
+
+
+{*****************************************************************************
+ taicpu Constructors
+*****************************************************************************}
+
+
+ constructor taicpu.op_none(op : tasmop);
+ begin
+ inherited create(op);
+ end;
+
+
+ constructor taicpu.op_reg(op : tasmop;_op1 : tregister);
+ begin
+ inherited create(op);
+ ops:=1;
+ end;
+
+
+ constructor taicpu.op_const(op : tasmop;_op1 : longint);
+ begin
+ inherited create(op);
+ ops:=1;
+ end;
+
+
+ constructor taicpu.op_ref(op : tasmop;_op1 : preference);
+ begin
+ inherited create(op);
+ ops:=1;
+ end;
+
+
+ constructor taicpu.op_reg_reg(op : tasmop;_op1,_op2 : tregister);
+ begin
+ inherited create(op);
+ ops:=2;
+ end;
+
+
+ constructor taicpu.op_reg_const(op:tasmop; _op1: tregister; _op2: longint);
+ begin
+ inherited create(op);
+ ops:=2;
+ end;
+
+
+ constructor taicpu.op_reg_ref(op : tasmop;_op1 : tregister;_op2 : preference);
+ begin
+ inherited create(op);
+ ops:=2;
+ end;
+
+
+ constructor taicpu.op_const_reg(op : tasmop;_op1 : longint;_op2 : tregister);
+ begin
+ inherited create(op);
+ ops:=2;
+ end;
+
+
+ constructor taicpu.op_const_const(op : tasmop;_op1,_op2 : longint);
+ begin
+ inherited create(op);
+ ops:=2;
+ end;
+
+
+ constructor taicpu.op_const_ref(op : tasmop;_op1 : longint;_op2 : preference);
+ begin
+ inherited create(op);
+ ops:=2;
+ end;
+
+ constructor taicpu.op_ref_reg(op : tasmop;_op1 : preference;_op2 : tregister);
+ begin
+ inherited create(op);
+ ops:=2;
+ end;
+
+
+ constructor taicpu.op_ref_ref(op : tasmop;_op1,_op2 : preference);
+ begin
+ inherited create(op);
+ ops:=2;
+ end;
+
+
+ constructor taicpu.op_reg_reg_reg(op : tasmop;_op1,_op2,_op3 : tregister);
+ begin
+ inherited create(op);
+ ops:=3;
+ end;
+
+ constructor taicpu.op_reg_const_reg(op : tasmop;_op1 : tregister;_op2 : longint;_op3 : tregister);
+ begin
+ inherited create(op);
+ ops:=3;
+ end;
+
+ constructor taicpu.op_reg_reg_ref(op : tasmop;_op1,_op2 : tregister;_op3 : preference);
+ begin
+ inherited create(op);
+ ops:=3;
+ end;
+
+ constructor taicpu.op_const_ref_reg(op : tasmop;_op1 : longint;_op2 : preference;_op3 : tregister);
+ begin
+ inherited create(op);
+ ops:=3;
+ end;
+
+ constructor taicpu.op_const_reg_ref(op : tasmop;_op1 : longint;_op2 : tregister;_op3 : preference);
+ begin
+ inherited create(op);
+ ops:=3;
+ end;
+
+ constructor taicpu.op_reg_ref_const(op : tasmop;_op1 : tregister;_op2 : preference;_op3 : longint);
+ begin
+ inherited create(op);
+ ops:=3;
+ end;
+
+
+ constructor taicpu.op_cond_sym(op : tasmop;cond:TAsmCond;_op1 : tasmsymbol);
+ begin
+ inherited create(op);
+ condition:=cond;
+ ops:=1;
+ end;
+
+
+ constructor taicpu.op_sym(op : tasmop;_op1 : tasmsymbol);
+ begin
+ inherited create(op);
+ ops:=1;
+ end;
+
+
+ constructor taicpu.op_sym_ofs(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint);
+ begin
+ inherited create(op);
+ ops:=1;
+ end;
+
+
+ constructor taicpu.op_sym_ofs_reg(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;_op2 : tregister);
+ begin
+ inherited create(op);
+ ops:=2;
+ end;
+
+
+ constructor taicpu.op_sym_ofs_ref(op : tasmop;_op1 : tasmsymbol;_op1ofs:longint;_op2 : preference);
+ begin
+ inherited create(op);
+ ops:=2;
+ end;
+
+ Constructor tai_frame.create (GP : Tregister; Localsize : Longint; RA : TRegister; L : longint);
+
+ begin
+ Inherited Create;
+ typ:=ait_frame;
+ G:=GP;
+ R:=RA;
+ LS:=LocalSize;
+ LU:=L;
+ end;
+
+ Constructor tai_ent.Create (const ProcName : String);
+
+ begin
+ Inherited Create;
+ typ:=ait_ent;
+ Name:=ProcName;
+ end;
+
+ procedure InitAsm;
+ begin
+ end;
+
+
+ procedure DoneAsm;
+ begin
+ end;
+
+
+ end.
diff --git a/compiler/alpha/agaxpgas.pas b/compiler/alpha/agaxpgas.pas
new file mode 100644
index 0000000000..9757226278
--- /dev/null
+++ b/compiler/alpha/agaxpgas.pas
@@ -0,0 +1,126 @@
+{
+ Copyright (c) 1998-2000 by Florian Klaempfl
+
+ This unit implements an asm for the DEC 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
+ 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 agaxpgas;
+
+ {$i fpcdefs.inc}
+
+ interface
+
+ uses
+ globals,systems,aasmbase,aasmtai,
+ aggas,cpubase;
+
+ type
+ TAXPGNUAssembler=class(TGNUAssembler)
+ procedure WriteInstruction(hp : tai);override;
+ end;
+
+ const
+ gas_reg2str : array[tregister] of string[4] = (
+ '',
+ '','','','','','','','','','',
+ '','','','','','','','','','',
+ '','','','','','','','','','',
+ '','',
+ '','','','','','','','','','',
+ '','','','','','','','','','',
+ '','','','','','','','','','',
+ '',''
+ );
+
+ implementation
+
+ const
+ op2str : array[tasmop] of string[14] = (
+ 'addf','addg','addl','addq',
+ 'adds','addt','amask','and','beq','bge',
+ 'bgt','bic','bis','blbc','blbs','ble',
+ 'blt','bne','br','bsr','call_pal','cmoveq',
+ 'cmovge','cmovgt','cmovlbc','cmovlbs','cmovle','cmovlt',
+ 'cmovne','cmpbge','cmpeq','cmpgeq','cmpgle','cmpglt',
+ 'cmple','cmplt','cmpteq','cmptle','cmptlt','cmptun',
+ 'cmpule','cmpult','cpys','cpyse','cpysn','ctlz',
+ 'ctpop','cttz','cvtdg','cvtgd','cvtgf','cvtgq',
+ 'cvtlq','cvtqf','cvtqg','cvtql','cvtqs','cvtqt',
+ 'cvtst','cvttq','cvtts','divf','divg','divs',
+ 'divt','ecb','eqv','excb','extbl','extlh',
+ 'extll','extqh','extql','extwh','extwl','fbeq',
+ 'fbge','fbgt','fble','fblt','fbne','fcmoveq',
+ 'fcmovge','fcmovgt','fcmovle','fcmovlt','fcmovne','fetch',
+ 'fetch_m','ftois','ftoit','implver','insbl','inslh',
+ 'insll','insqh','insql','inswh','inswl','itoff',
+ 'itofs','itoft','jmp','jsr','jsr_coroutine','lda',
+ 'ldah','ldbu','ldwu','ldf','ldg','ldl',
+ 'ldl_l','ldq','ldq_l','ldq_u','lds','ldt',
+ 'maxsb8','maxsw4','maxub8','maxuw4','mb','mf_fpcr',
+ 'minsb8','minsw4','minub8','minuw4','mskbl','msklh',
+ 'mskll','mskqh','mskql','mskwh','mskwl','mt_fpcr',
+ 'mulf','mulg','mull','mulq',
+ 'muls','mult','ornot','perr','pklb','pkwb',
+ 'rc','ret','rpcc','rs','s4addl','s4addq',
+ 's4subl','s4subq','s8addl','s8addq','s8subl','s8subq',
+ 'sextb','sextw','sll','sqrtf','sqrtg','sqrts',
+ 'sqrtt','sra','srl','stb','stf','stg',
+ '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',
+ 'ldgp');
+
+ procedure TAXPGNUAssembler.WriteInstruction (hp : tai);
+ begin
+(*
+ op:=paicpu(hp)^.opcode;
+ calljmp:=is_calljmp(op);
+ { call maybe not translated to calll }
+ s:=#9+att_op2str[op]+cond2str[paicpu(hp)^.condition];
+ if (not calljmp) and
+ (not att_nosuffix[op]) and
+ not(
+ (paicpu(hp)^.oper[0].typ=top_reg) and
+ (paicpu(hp)^.oper[0].reg in [R_ST..R_ST7])
+ ) then
+ s:=s+att_opsize2str[paicpu(hp)^.opsize];
+ { process operands }
+ if paicpu(hp)^.ops<>0 then
+ begin
+ { call and jmp need an extra handling }
+ { this code is only called if jmp isn't a labeled instruction }
+ if calljmp then
+ s:=s+#9+getopstr_jmp(paicpu(hp)^.oper[0])
+ else
+ begin
+ for i:=0to paicpu(hp)^.ops-1 do
+ begin
+ if i=0 then
+ sep:=#9
+ else
+ sep:=',';
+ s:=s+sep+getopstr(paicpu(hp)^.oper[i])
+ end;
+ end;
+ end;
+ AsmWriteLn(s);
+*)
+ end;
+
+end.
diff --git a/compiler/alpha/aoptcpu.pas b/compiler/alpha/aoptcpu.pas
new file mode 100644
index 0000000000..494edf948c
--- /dev/null
+++ b/compiler/alpha/aoptcpu.pas
@@ -0,0 +1,38 @@
+{
+ Copyright (c) 1998-2000 by Jonas Maebe, member of the Free Pascal
+ Development Team
+
+ This unit implements the Alpha optimizer object
+
+ 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 aoptcpu;
+
+Interface
+
+uses cpubase, aoptobj, aoptcpub;
+
+Type
+ TAOptCpu = Object(TAoptObj)
+ { uses the same constructor as TAopObj }
+ End;
+
+Implementation
+
+End.
diff --git a/compiler/alpha/aoptcpub.pas b/compiler/alpha/aoptcpub.pas
new file mode 100644
index 0000000000..aaad2910c3
--- /dev/null
+++ b/compiler/alpha/aoptcpub.pas
@@ -0,0 +1,115 @@
+ {
+ Copyright (c) 1998-2000 by Jonas Maebe, member of the Free Pascal
+ Development Team
+
+ This unit contains several types and constants necessary for the
+ optimizer to work on the 80x86 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
+ 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 aoptcpub; { Assembler OPTimizer CPU specific Base }
+
+{ enable the following define if memory references can have both a base and }
+{ index register in 1 operand }
+
+{$define RefsHaveIndexReg}
+
+{ enable the following define if memory references can have a scaled index }
+
+{$define RefsHaveScale}
+
+{ enable the following define if memory references can have a segment }
+{ override }
+
+{ define RefsHaveSegment}
+
+Interface
+
+Uses
+ CPUAsm,AOptBase;
+
+Type
+
+{ type of a normal instruction }
+ TInstr = Taicpu;
+ PInstr = ^TInstr;
+
+{ ************************************************************************* }
+{ **************************** TCondRegs ********************************** }
+{ ************************************************************************* }
+{ Info about the conditional registers }
+ TCondRegs = Object
+ Constructor Init;
+ Destructor Done;
+ End;
+
+{ ************************************************************************* }
+{ **************************** TAoptBaseCpu ******************************* }
+{ ************************************************************************* }
+
+ TAoptBaseCpu = Object(TAoptBase)
+ End;
+
+
+{ ************************************************************************* }
+{ ******************************* Constants ******************************* }
+{ ************************************************************************* }
+Const
+
+{ the maximum number of things (registers, memory, ...) a single instruction }
+{ changes }
+
+ MaxCh = 3;
+
+{ the maximum number of operands an instruction has }
+
+ MaxOps = 3;
+
+{Oper index of operand that contains the source (reference) with a load }
+{instruction }
+
+ LoadSrc = 0;
+
+{Oper index of operand that contains the destination (register) with a load }
+{instruction }
+
+ LoadDst = 1;
+
+{Oper index of operand that contains the source (register) with a store }
+{instruction }
+
+ StoreSrc = 0;
+
+{Oper index of operand that contains the destination (reference) with a load }
+{instruction }
+
+ StoreDst = 1;
+
+Implementation
+
+{ ************************************************************************* }
+{ **************************** TCondRegs ********************************** }
+{ ************************************************************************* }
+Constructor TCondRegs.init;
+Begin
+End;
+
+Destructor TCondRegs.Done; {$ifdef inl} inline; {$endif inl}
+Begin
+End;
+
+End.
diff --git a/compiler/alpha/aoptcpuc.pas b/compiler/alpha/aoptcpuc.pas
new file mode 100644
index 0000000000..121a45370f
--- /dev/null
+++ b/compiler/alpha/aoptcpuc.pas
@@ -0,0 +1,38 @@
+ {
+ Copyright (c) 1998-2000 by Jonas Maebe, member of the Free Pascal
+ Development Team
+
+ This unit contains the processor specific implementation of the
+ assembler optimizer common subexpression elimination object.
+
+ 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 aoptcpuc;
+
+Interface
+
+Uses
+ AOptCs;
+
+Type
+ TRegInfoCpu = Object(TRegInfo)
+ End;
+
+
+Implementation
+
+End.
diff --git a/compiler/alpha/aoptcpud.pas b/compiler/alpha/aoptcpud.pas
new file mode 100644
index 0000000000..c3ea9fe5f9
--- /dev/null
+++ b/compiler/alpha/aoptcpud.pas
@@ -0,0 +1,39 @@
+{
+ Copyright (c) 1998-2000 by Jonas Maebe, member of the Free Pascal
+ Development Team
+
+ This unit contains the processor specific implementation of the
+ assembler optimizer data flow analyzer.
+
+ 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 aoptcpud;
+
+Interface
+
+uses
+ AOptDA;
+
+Type
+ PAOptDFACpu = ^TAOptDFACpu;
+ TAOptDFACpu = Object(TAOptDFA)
+ End;
+
+Implementation
+
+
+End.
diff --git a/compiler/alpha/cgcpu.pas b/compiler/alpha/cgcpu.pas
new file mode 100644
index 0000000000..07f3a9d92f
--- /dev/null
+++ b/compiler/alpha/cgcpu.pas
@@ -0,0 +1,160 @@
+{
+ Copyright (c) 1998-2000 by Florian Klaempfl
+
+ 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
+ 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 implements the code generator for the Alpha.
+}
+unit cgcpu;
+
+{$i fpcdefs.inc}
+
+interface
+
+uses
+ cgbase,cgobj,aasmbase,aasmtai,aasmcpu,cginfo,cpubase,cpuinfo;
+
+type
+pcgalpha = ^tcgalpha;
+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
+
+uses
+ globtype,globals;
+
+procedure tcgalpha.g_stackframe_entry(list : taasmoutput;localsize : longint);
+
+begin
+ 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 : taasmoutput;parasize : longint; nostackframe,inlined : boolean);
+
+begin
+ { 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 (paiend,init(''));
+ }
+end;
+
+procedure tcgalpha.a_call_name(list : taasmoutput;const s : string);
+
+ begin
+ { list^.concat(taicpu,op_sym(A_CALL,S_NO,newasmsymbol(s,AB_EXTERNAL,AT_FUNCTION)))); }
+ {!!!!!!!!!1 offset is ignored }
+ abstract;
+ end;
+
+procedure tcgalpha.a_load_const_reg(list : taasmoutput;size : tcgsize;a : aword;register : tregister);
+
+begin
+end;
+
+
+procedure tcgalpha.a_load_reg_ref(list : taasmoutput;size : tcgsize;register : tregister;const ref : treference);
+
+begin
+end;
+
+
+procedure tcgalpha.a_load_ref_reg(list : taasmoutput;size : tcgsize;const ref : treference;register : tregister);
+
+begin
+end;
+
+
+procedure tcgalpha.a_load_reg_reg(list : taasmoutput;fromsize, tosize : tcgsize;reg1,reg2 : tregister);
+
+begin
+end;
+
+
+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 : taasmoutput;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel);
+
+begin
+end;
+
+
+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 : taasmoutput;size : tcgsize;cmp_op : topcmp;a : aword;
+ reg : tregister; l : tasmlabel);
+
+begin
+end;
+
+
+procedure tcgalpha.a_loadaddr_ref_reg(list : taasmoutput;const ref : treference;r : tregister);
+
+begin
+end;
+
+
+procedure tcgalpha.g_maybe_loadself(list : taasmoutput);
+
+begin
+end;
+
+
+procedure tcgalpha.g_restore_frame_pointer(list : taasmoutput);
+
+begin
+end;
+
+
+end.
diff --git a/compiler/alpha/cpubase.pas b/compiler/alpha/cpubase.pas
new file mode 100644
index 0000000000..e4ccede6f6
--- /dev/null
+++ b/compiler/alpha/cpubase.pas
@@ -0,0 +1,457 @@
+{
+ Copyright (C) 1998-2000 by Florian Klaempfl
+
+ 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
+ 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 implements an asmlistitem class for the Alpha architecture.
+}
+unit cpubase;
+
+{$i fpcdefs.inc}
+
+ interface
+
+ uses
+ cutils,cclasses,globals,aasmbase,cpuinfo,cginfo;
+
+ 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);
+
+ 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);
+
+ const
+ firstop = low(tasmop);
+ lastop = high(tasmop);
+
+ std_reg2str : array[tregister] of string[4] = (
+ '',
+ '','','','','','','','','','',
+ '','','','','','','','','','',
+ '','','','','','','','','','',
+ '','',
+ '','','','','','','','','','',
+ '','','','','','','','','','',
+ '','','','','','','','','','',
+ '',''
+ );
+
+
+ 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
+ );
+
+ TRegisterset = Set of TRegister;
+
+ tregister64 = tregister;
+
+ Const
+ Firstreg = R_0;
+ LastReg = R_F31;
+
+
+{*****************************************************************************
+ Default generic sizes
+*****************************************************************************}
+
+ { 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;
+
+ stack_pointer_reg = R_30;
+ frame_pointer_reg = R_15;
+ self_pointer_reg = R_16;
+ accumulator = R_0;
+ {the return_result_reg, is used inside the called function to store its return
+ value when that is a scalar value otherwise a pointer to the address of the
+ result is placed inside it}
+ return_result_reg = accumulator;
+
+ {the function_result_reg contains the function result after a call to a scalar
+ function othewise it contains a pointer to the returned result}
+ function_result_reg = accumulator;
+ 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 the available maximum width integer general purpose }
+ { registers }
+ LoGPReg = R_0;
+ HiGPReg = R_31;
+
+ { 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;
+
+ { Constant defining possibly all registers which might require saving }
+ ALL_REGISTERS = [firstreg..lastreg];
+
+ general_registers = [R_0..R_31];
+
+ 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;
+
+ maxfpuregs = 32;
+ fpuregs = [R_F0..R_F31];
+ usableregsfpu = [];
+ c_countusableregsfpu = 31;
+
+ mmregs = [];
+ usableregsmm = [];
+ c_countusableregsmm = 0;
+
+ max_operands = 4;
+
+ registers_saved_on_cdecl = [R_9..R_14,R_F2..R_F9];
+
+ firstsaveintreg = R_NO;
+ lastsaveintreg = R_NO;
+ firstsavefpureg = R_NO;
+ lastsavefpureg = R_NO;
+ firstsavemmreg = R_NO;
+ lastsavemmreg = R_NO;
+ maxvarregs = 6;
+
+ varregs : Array [1..maxvarregs] of Tregister =
+ (R_9,R_10,R_11,R_12,R_13,R_14);
+
+ 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);
+
+{*****************************************************************************
+ 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
+*****************************************************************************}
+ type
+ { 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,register64.reghi : tregister);
+ { overlay a register64.reglo }
+ 2 : (register64.reglo : 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,register64.reghi,segment : tregister);
+ { overlay a register64.reglo }
+ 2 : (register64.reglo : 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);
+
+ 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
+ { 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.
+
+ 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 }
+
+
+{*****************************************************************************
+ Opcode propeties (needed for optimizer)
+*****************************************************************************}
+
+{$ifndef NOOPT}
+Type
+{What an instruction can change}
+ TInsChange = (Ch_None);
+{$endif}
+
+
+{ resets all values of ref to defaults }
+procedure reset_reference(var ref : treference);
+{ set mostly used values of a new reference }
+function new_reference(base : tregister;offset : longint) : preference;
+function newreference(const r : treference) : preference;
+procedure disposereference(var r : preference);
+
+function reg2str(r : tregister) : string;
+
+{*****************************************************************************
+ Init/Done
+*****************************************************************************}
+
+ procedure InitCpu;
+ procedure DoneCpu;
+
+implementation
+
+uses
+ verbose;
+
+function reg2str(r : tregister) : string;
+
+ begin
+ if r in [R_0..R_31] then
+ reg2str:='R'+tostr(longint(r)-longint(R_0))
+ else if r in [R_F0..R_F31] then
+ reg2str:='F'+tostr(longint(r)-longint(R_F0))
+ else internalerror(38991);
+ end;
+
+procedure reset_reference(var ref : treference);
+begin
+ FillChar(ref,sizeof(treference),0);
+end;
+
+
+function new_reference(base : tregister;offset : longint) : preference;
+var
+ r : preference;
+begin
+ new(r);
+ FillChar(r^,sizeof(treference),0);
+ r^.offset:=offset;
+ r^.alignment:=8;
+ new_reference:=r;
+end;
+
+function newreference(const r : treference) : preference;
+
+var
+ p : preference;
+begin
+ new(p);
+ p^:=r;
+ newreference:=p;
+end;
+
+procedure disposereference(var r : preference);
+
+begin
+ dispose(r);
+ r:=Nil;
+end;
+
+{*****************************************************************************
+ Init/Done
+*****************************************************************************}
+
+ procedure InitCpu;
+ begin
+ end;
+
+ procedure DoneCpu;
+ begin
+ end;
+
+end.
diff --git a/compiler/alpha/cpuinfo.pas b/compiler/alpha/cpuinfo.pas
new file mode 100644
index 0000000000..cd02692320
--- /dev/null
+++ b/compiler/alpha/cpuinfo.pas
@@ -0,0 +1,68 @@
+{
+ This file is part of the Free Pascal run time library.
+ Copyright (c) 1998-2000 by the Free Pascal development team
+
+ Basic Processor information about the Alpha
+
+ See the file COPYING.FPC, included in this distribution,
+ for details about the copyright.
+
+ 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.
+
+ **********************************************************************}
+{
+ Basic Processor information about the Alpha
+}
+Unit CPUInfo;
+
+{$i fpcdefs.inc}
+
+Interface
+
+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 }
+ sizeof(aint) = 8;
+ {# Size of a multimedia register }
+ mmreg_size = 8;
+
+ { target cpu string (used by compiler options) }
+ target_cpu_string = 'alpha';
+
+Implementation
+
+end.
diff --git a/compiler/alpha/cpunode.pas b/compiler/alpha/cpunode.pas
new file mode 100644
index 0000000000..c62bc9c303
--- /dev/null
+++ b/compiler/alpha/cpunode.pas
@@ -0,0 +1,54 @@
+{
+ Copyright (c) 2000-2002 by Florian Klaempfl
+
+ Imports the Alpha code generator
+
+ 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 imports the Alpha code generator.
+}
+unit cpunode;
+
+{$i fpcdefs.inc}
+
+ interface
+
+ implementation
+
+ uses
+ { generic nodes }
+ ncgbas,ncgld,ncgflw,ncgcnv,ncgmem,ncgcon,ncgcal,ncgset,ncginl
+ { to be able to only parts of the generic code,
+ the processor specific nodes must be included
+ after the generic one (FK)
+ }
+// naxpadd,
+// naxpcal,
+// naxpcon,
+// naxpflw,
+// naxpmem,
+// naxpset,
+// naxpinl,
+// nppcopt,
+ { this not really a node }
+// naxpobj,
+// naxpmat,
+// naxpcnv
+ ;
+
+end.
diff --git a/compiler/alpha/cpupara.pas b/compiler/alpha/cpupara.pas
new file mode 100644
index 0000000000..ff19c1648c
--- /dev/null
+++ b/compiler/alpha/cpupara.pas
@@ -0,0 +1,290 @@
+{
+ 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.register64.reglo:=nextintreg;
+ inc(nextintreg);
+ if is_64bit then
+ begin
+ hp.paraloc.register64.reghi:=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.register64.reghi:=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.
diff --git a/compiler/alpha/cpupi.pas b/compiler/alpha/cpupi.pas
new file mode 100644
index 0000000000..6b1470cde0
--- /dev/null
+++ b/compiler/alpha/cpupi.pas
@@ -0,0 +1,43 @@
+{
+ 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.
diff --git a/compiler/alpha/cpuswtch.pas b/compiler/alpha/cpuswtch.pas
new file mode 100644
index 0000000000..b84dca877d
--- /dev/null
+++ b/compiler/alpha/cpuswtch.pas
@@ -0,0 +1,121 @@
+{
+ 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.
diff --git a/compiler/alpha/cputarg.pas b/compiler/alpha/cputarg.pas
new file mode 100644
index 0000000000..f7e38332c7
--- /dev/null
+++ b/compiler/alpha/cputarg.pas
@@ -0,0 +1,51 @@
+{
+ 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.
diff --git a/compiler/alpha/radirect.pas b/compiler/alpha/radirect.pas
new file mode 100644
index 0000000000..68f56bc747
--- /dev/null
+++ b/compiler/alpha/radirect.pas
@@ -0,0 +1,313 @@
+{
+ 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.
diff --git a/compiler/alpha/rasm.pas b/compiler/alpha/rasm.pas
new file mode 100644
index 0000000000..0d715b5d87
--- /dev/null
+++ b/compiler/alpha/rasm.pas
@@ -0,0 +1,65 @@
+{
+ 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.
diff --git a/compiler/alpha/rgcpu.pas b/compiler/alpha/rgcpu.pas
new file mode 100644
index 0000000000..23a1ca06e5
--- /dev/null
+++ b/compiler/alpha/rgcpu.pas
@@ -0,0 +1,69 @@
+{
+ 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 getcpuregisterint(list: taasmoutput; reg: tregister): tregister; override;
+ procedure ungetregisterint(list: taasmoutput; reg: tregister); override;
+ end;
+
+ implementation
+
+ uses
+ cgobj;
+
+ function trgcpu.getcpuregisterint(list: taasmoutput; reg: tregister): tregister;
+
+ begin
+ if reg = R_0 then
+ begin
+ cg.a_reg_alloc(list,reg);
+ result := reg;
+ end
+ else result := inherited getcpuregisterint(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.
diff --git a/compiler/alpha/tgcpu.pas b/compiler/alpha/tgcpu.pas
new file mode 100644
index 0000000000..90c4ac5175
--- /dev/null
+++ b/compiler/alpha/tgcpu.pas
@@ -0,0 +1,42 @@
+{
+ Copyright (C) 1998-2000 by Florian Klaempfl
+
+ This unit handles the temporary variables stuff for 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
+ 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 handles the temporary variables stuff for Alpha.
+}
+unit tgcpu;
+
+{$i fpcdefs.inc}
+
+ interface
+
+ uses
+ tgobj;
+
+ type
+ ttgalpha = class(ttgobj)
+ end;
+
+implementation
+
+begin
+ tg:=ttgalpha.create;
+end.
View Lorry Controller Status