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

*** empty log message ***

Browse Source
This commit is contained in:
mazen 2002-08-21 13:30:07 +00:00
parent 7285a1b74c
commit ab508fa44f
8 changed files with 4291 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1195
compiler/sparc/aasmcpu.pas Normal file
View File

File diff suppressed because it is too large Load Diff

1066
compiler/sparc/cgcpu.pas Normal file
View File

File diff suppressed because it is too large Load Diff

598
compiler/sparc/cpubase.pas Normal file
View File

@ -0,0 +1,598 @@
{*****************************************************************************}
{ File : cpubase.pas }
{ Author : Mazen NEIFER }
{ Project : Free Pascal Compiler (FPC) }
{ Creation date : 2002\04\26 }
{ Last modification date : 2002\08\20 }
{ Licence : GPL }
{ Bug report : mazen.neifer.01@supaero.org }
{*****************************************************************************}
{ $Id$
Copyright (c) 1998-2000 by Florian Klaempfl and Peter Vreman
Contains the base types for the i386
* This code was inspired by the NASM sources
The Netwide Assembler is copyright (C) 1996 Simon Tatham and
Julian Hall. All rights reserved.
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 cpuBase;
{$INCLUDE fpcdefs.inc}
INTERFACE
USES globals,cutils,cclasses,aasmbase,cpuinfo,cginfo;
CONST
{Size of the instruction table converted by nasmconv.pas}
maxinfolen = 8;
{Defines the default address size for a processor}
OS_ADDR=OS_32;{$WARNING "OS_ADDR" was set to "OS_32" but not verified!}
{the natural int size for a processor}
OS_INT=OS_32;{$WARNING "OS_INT" was set to "OS_32" but not verified!}
{the maximum float size for a processor}
OS_FLOAT=OS_F80;{$WARNING "OS_FLOAT" was set to "OS_F80" but not verified!}
{the size of a vector register for a processor}
OS_VECTOR=OS_M64;{$WARNING "OS_VECTOR" was set to "OS_M64" but not verified!}
{By default we want everything}
{$DEFINE ATTOP}
{$DEFINE ATTREG}
{$DEFINE ATTSUF}
{We Don't need the intel style opcodes as we are coding for SPARC architecture}
{$DEFINE NORA386INT}
{$DEFINE NOAG386NSM}
{$DEFINE NOAG386INT}
CONST
{Operand types}
OT_NONE = $00000000;
OT_BITS8 = $00000001; { size, and other attributes, of the operand }
OT_BITS16 = $00000002;
OT_BITS32 = $00000004;
OT_BITS64 = $00000008; { FPU only }
OT_BITS80 = $00000010;
OT_FAR = $00000020; { this means 16:16 or 16:32, like in CALL/JMP }
OT_NEAR = $00000040;
OT_SHORT = $00000080;
OT_SIZE_MASK = $000000FF; { all the size attributes }
OT_NON_SIZE = LongInt(not OT_SIZE_MASK);
OT_SIGNED = $00000100; { the operand need to be signed -128-127 }
OT_TO = $00000200; { operand is followed by a colon }
{ reverse effect in FADD, FSUB &c }
OT_COLON = $00000400;
OT_REGISTER = $00001000;
OT_IMMEDIATE = $00002000;
OT_IMM8 = $00002001;
OT_IMM16 = $00002002;
OT_IMM32 = $00002004;
OT_IMM64 = $00002008;
OT_IMM80 = $00002010;
OT_REGMEM = $00200000; { for r/m, ie EA, operands }
OT_REGNORM = $00201000; { 'normal' reg, qualifies as EA }
OT_REG8 = $00201001;
OT_REG16 = $00201002;
OT_REG32 = $00201004;
OT_MMXREG = $00201008; { MMX registers }
OT_XMMREG = $00201010; { Katmai registers }
OT_MEMORY = $00204000; { register number in 'basereg' }
OT_MEM8 = $00204001;
OT_MEM16 = $00204002;
OT_MEM32 = $00204004;
OT_MEM64 = $00204008;
OT_MEM80 = $00204010;
OT_FPUREG = $01000000; { floating point stack registers }
OT_FPU0 = $01000800; { FPU stack register zero }
OT_REG_SMASK = $00070000; { special register operands: these may be treated differently }
{ a mask for the following }
OT_REG_ACCUM = $00211000; { accumulator: AL, AX or EAX }
OT_REG_AL = $00211001; { REG_ACCUM | BITSxx }
OT_REG_AX = $00211002; { ditto }
OT_REG_EAX = $00211004; { and again }
OT_REG_COUNT = $00221000; { counter: CL, CX or ECX }
OT_REG_CL = $00221001; { REG_COUNT | BITSxx }
OT_REG_CX = $00221002; { ditto }
OT_REG_ECX = $00221004; { another one }
OT_REG_DX = $00241002;
OT_REG_SREG = $00081002; { any segment register }
OT_REG_CS = $01081002; { CS }
OT_REG_DESS = $02081002; { DS, ES, SS (non-CS 86 registers) }
OT_REG_FSGS = $04081002; { FS, GS (386 extENDed registers) }
OT_REG_CDT = $00101004; { CRn, DRn and TRn }
OT_REG_CREG = $08101004; { CRn }
OT_REG_CR4 = $08101404; { CR4 (Pentium only) }
OT_REG_DREG = $10101004; { DRn }
OT_REG_TREG = $20101004; { TRn }
OT_MEM_OFFS = $00604000; { special type of EA }
{ simple [address] offset }
OT_ONENESS = $00800000; { special type of immediate operand }
{ so UNITY == IMMEDIATE | ONENESS }
OT_UNITY = $00802000; { for shift/rotate instructions }
{Instruction flags }
IF_NONE = $00000000;
IF_SM = $00000001; { size match first two operands }
IF_SM2 = $00000002;
IF_SB = $00000004; { unsized operands can't be non-byte }
IF_SW = $00000008; { unsized operands can't be non-word }
IF_SD = $00000010; { unsized operands can't be nondword }
IF_AR0 = $00000020; { SB, SW, SD applies to argument 0 }
IF_AR1 = $00000040; { SB, SW, SD applies to argument 1 }
IF_AR2 = $00000060; { SB, SW, SD applies to argument 2 }
IF_ARMASK = $00000060; { mask for unsized argument spec }
IF_PRIV = $00000100; { it's a privileged instruction }
IF_SMM = $00000200; { it's only valid in SMM }
IF_PROT = $00000400; { it's protected mode only }
IF_UNDOC = $00001000; { it's an undocumented instruction }
IF_FPU = $00002000; { it's an FPU instruction }
IF_MMX = $00004000; { it's an MMX instruction }
IF_3DNOW = $00008000; { it's a 3DNow! instruction }
IF_SSE = $00010000; { it's a SSE (KNI, MMX2) instruction }
IF_PMASK =
LongInt($FF000000); { the mask for processor types }
IF_PFMASK =
LongInt($F001FF00); { the mask for disassembly "prefer" }
IF_8086 = $00000000; { 8086 instruction }
IF_186 = $01000000; { 186+ instruction }
IF_286 = $02000000; { 286+ instruction }
IF_386 = $03000000; { 386+ instruction }
IF_486 = $04000000; { 486+ instruction }
IF_PENT = $05000000; { Pentium instruction }
IF_P6 = $06000000; { P6 instruction }
IF_KATMAI = $07000000; { Katmai instructions }
IF_CYRIX = $10000000; { Cyrix-specific instruction }
IF_AMD = $20000000; { AMD-specific instruction }
{ added flags }
IF_PRE = $40000000; { it's a prefix instruction }
IF_PASS2 =LongInt($80000000);{if the instruction can change in a second pass}
TYPE
TAttSuffix=(
AttSufNONE, {No suffix is needed}
AttSufINT, {Integer operation suffix is needed}
AttSufFPU, {}
AttSufFPUint{}
);
{$WARNING CPU32 opcodes do not fully include the Ultra SPRAC instruction set.}
TAsmOp=({$INCLUDE opcode.inc});
op2strtable=ARRAY[TAsmOp]OF STRING[11];
CONST
FirstOp=Low(TAsmOp);
LastOp=High(TAsmOp);
{$IFDEF ATTSUF}
att_needsuffix:ARRAY[tasmop]OF TAttSuffix=({$INCLUDE sparcatts.inc});
{$ENDIF ATTSUF}
std_op2str:op2strtable=({$INCLUDE attinstr.inc});
{*****************************************************************************
Operand Sizes
*****************************************************************************}
TYPE
{ S_NO = No Size of operand }
{ S_B = Byte size operand }
{ S_W = Word size operand }
{ S_L = DWord size operand }
{ USED FOR conversions in x86}
{ S_BW = Byte to word }
{ S_BL = Byte to long }
{ S_WL = Word to long }
{ Floating point types }
{ S_FS = single type (32 bit) }
{ S_FL = double/64bit integer }
{ S_FX = ExtENDed type }
{ S_IS = integer on 16 bits }
{ S_IL = integer on 32 bits }
{ S_IQ = integer on 64 bits }
TOpSize=(S_NO,
S_B,
S_W,
S_L,
S_BW,
S_BL,
S_WL,
S_IS,
S_IL,
S_IQ,
S_FS,
S_FL,
S_FX,
S_D,
S_Q,
S_FV,
S_NEAR,
S_FAR,
S_SHORT);
CONST
{ Intel style operands ! }
opsize_2_type:ARRAY[0..2,topsize] of LongInt=(
(OT_NONE,
OT_BITS8,OT_BITS16,OT_BITS32,OT_BITS16,OT_BITS32,OT_BITS32,
OT_BITS16,OT_BITS32,OT_BITS64,
OT_BITS32,OT_BITS64,OT_BITS80,OT_BITS64,OT_BITS64,OT_BITS64,
OT_NEAR,OT_FAR,OT_SHORT
),
(OT_NONE,
OT_BITS8,OT_BITS16,OT_BITS32,OT_BITS8,OT_BITS8,OT_BITS16,
OT_BITS16,OT_BITS32,OT_BITS64,
OT_BITS32,OT_BITS64,OT_BITS80,OT_BITS64,OT_BITS64,OT_BITS64,
OT_NEAR,OT_FAR,OT_SHORT
),
(OT_NONE,
OT_BITS8,OT_BITS16,OT_BITS32,OT_NONE,OT_NONE,OT_NONE,
OT_BITS16,OT_BITS32,OT_BITS64,
OT_BITS32,OT_BITS64,OT_BITS80,OT_BITS64,OT_BITS64,OT_BITS64,
OT_NEAR,OT_FAR,OT_SHORT
)
);
{$IFDEF ATTOP}
att_opsize2str : ARRAY[topsize] of string[2] = ('',
'b','w','l','bw','bl','wl',
's','l','q',
's','l','t','d','q','v',
'','',''
);
{$ENDIF}
{*****************************************************************************
Conditions
*****************************************************************************}
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
cond2str:ARRAY[TAsmCond] of string[3]=('',
'a','ae','b','be','c','e','g','ge','l','le','na','nae',
'nb','nbe','nc','ne','ng','nge','nl','nle','no','np',
'ns','nz','o','p','pe','po','s','z'
);
inverse_cond:ARRAY[TAsmCond] of TAsmCond=(C_None,
C_NA,C_NAE,C_NB,C_NBE,C_NC,C_NE,C_NG,C_NGE,C_NL,C_NLE,C_A,C_AE,
C_B,C_BE,C_C,C_E,C_G,C_GE,C_L,C_LE,C_O,C_P,
C_S,C_Z,C_NO,C_NP,C_NP,C_P,C_NS,C_NZ
);
CONST
CondAsmOps=3;
CondAsmOp:ARRAY[0..CondAsmOps-1] of TAsmOp=(A_FCMPd, A_JMPL, A_FCMPs);
CondAsmOpStr:ARRAY[0..CondAsmOps-1] of string[4]=('FCMPd','JMPL','FCMPs');
{*****************************************************************************
Registers
*****************************************************************************}
TYPE
{ enumeration for registers, don't change the order }
{ it's used by the register size conversions }
TRegister=({$INCLUDE registers.inc});
TRegister64=PACKED RECORD
{A type to store register locations for 64 Bit values.}
RegLo,RegHi:TRegister;
END;
treg64=tregister64;{alias for compact code}
TRegisterSet=SET OF TRegister;
reg2strtable=ARRAY[tregister] OF STRING[6];
CONST
firstreg = low(tregister);
lastreg = high(tregister);
{$ifdef ATTREG}
std_reg2str:reg2strtable=({$INCLUDE strregs.inc});
{$ENDif ATTREG}
{*****************************************************************************
Flags
*****************************************************************************}
TYPE
TResFlags=(
F_E, {Equal}
F_NE, {Not Equal}
F_G, {Greater}
F_L, {Less}
F_GE, {Greater or Equal}
F_LE, {Less or Equal}
F_C, {Carry}
F_NC, {Not Carry}
F_A, {Above}
F_AE, {Above or Equal}
F_B, {Below}
F_BE {Below or Equal}
);
{*****************************************************************************
Reference
*****************************************************************************}
TYPE
trefoptions=(ref_none,ref_parafixup,ref_localfixup,ref_selffixup);
{ immediate/reference record }
poperreference = ^treference;
treference = packed record
segment,
base,
index : tregister;
scalefactor : byte;
offset : LongInt;
symbol : tasmsymbol;
offsetfixup : LongInt;
options : trefoptions;
{$ifdef newcg}
alignment : byte;
{$ENDif newcg}
END;
{ reference record }
PParaReference=^TParaReference;
TParaReference=PACKED RECORD
Index:TRegister;
Offset:longint;
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:poperreference);
top_CONST : (val:aword);
top_symbol : (sym:tasmsymbol;symofs:LongInt);
END;
{*****************************************************************************
Argument Classification
*****************************************************************************}
TYPE
TArgClass = (
{ the following classes should be defined by all processor implemnations }
AC_NOCLASS,
AC_MEMORY,
AC_INTEGER,
AC_FPU,
{ the following argument classes are i386 specific }
AC_FPUUP,
AC_SSE,
AC_SSEUP);
{*****************************************************************************
Generic Location
*****************************************************************************}
TYPE
TLoc=( {information about the location of an operand}
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 }
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_MMXREGISTER, { MMX register }
LOC_CMMXREGISTER, { MMX register variable }
LOC_MMREGISTER,
LOC_CMMREGISTER
);
{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);
);
{ it's only for better handling }
LOC_MMXREGISTER,LOC_CMMXREGISTER : (mmxreg : tregister);
END;
TLocation=PACKED RECORD
loc : TLoc;
size : TCGSize;
case TLoc of
LOC_FLAGS : (resflags : tresflags);
LOC_CONSTANT : (
case longint of
1 : (value : AWord);
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);
);
{ it's only for better handling }
LOC_MMXREGISTER,LOC_CMMXREGISTER : (mmxreg : tregister);
end;
{*****************************************************************************
Constants
*****************************************************************************}
CONST
general_registers = [R_G0..R_I7];
{ legEND: }
{ xxxregs = set of all possibly used registers of that type in the code }
{ generator }
{ usableregsxxx = set of all 32bit components of registers that can be }
{ possible allocated to a regvar or using getregisterxxx (this }
{ excludes registers which can be only used for parameter }
{ passing on ABI's that define this) }
{ c_countusableregsxxx = amount of registers in the usableregsxxx set }
intregs = [R_G0..R_I7];
usableregsint = general_registers;
c_countusableregsint = 4;
fpuregs = [R_F0..R_F31];
usableregsfpu = [];
c_countusableregsfpu = 0;
mmregs = [R_G0..R_G7];
usableregsmm = [R_G0..R_G7];
c_countusableregsmm = 8;
firstsaveintreg = R_G0;
lastsaveintreg = R_I7;
firstsavefpureg = R_F0;
lastsavefpureg = R_F31;
firstsavemmreg = R_G0;
lastsavemmreg = R_I7;
lowsavereg = R_G0;
highsavereg = R_I7;
ALL_REGISTERS = [lowsavereg..highsavereg];
lvaluelocations = [LOC_REFERENCE,LOC_CFPUREGISTER,
LOC_CREGISTER,LOC_MMXREGISTER,LOC_CMMXREGISTER];
{
registers_saved_on_cdecl = [R_ESI,R_EDI,R_EBX];}
{ generic register names }
stack_pointer_reg=R_O6;
frame_pointer_reg=R_I6;
self_pointer_reg=R_G5;
accumulator = R_G0;
accumulatorhigh = R_I7;
{ WARNING: don't change to R_ST0!! See comments above implementation of }
{ a_loadfpu* methods in rgcpu (JM) }
fpu_result_reg=R_F0;
mmresultreg=R_G0;
{*****************************************************************************}
{ GCC /ABI linking information }
{*****************************************************************************}
{# 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=[R_O6];
{# 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=4;
{# Registers which are defined as scratch and no need to save across routine
calls or in assembler blocks.}
ScratchRegsCount=3;
scratch_regs:ARRAY[1..ScratchRegsCount]OF TRegister=(R_O4,R_O5,R_I7);
{$WARNING FIXME : Scratch registers list has to be verified}
{ low and high of the available maximum width integer general purpose }
{ registers }
LoGPReg = R_G0;
HiGPReg = R_I7;
{ low and high of every possible width general purpose register (same as }
{ above on most architctures apart from the 80x86) }
LoReg = R_G0;
HiReg = R_I7;
cpuflags = [];
{ sizes }
pointersize = 4;
extENDed_size = 8;{SPARC architecture uses IEEE floating point numbers}
mmreg_size = 8;
sizepostfix_pointer = S_L;
{*****************************************************************************
Instruction table
*****************************************************************************}
{$ifndef NOAG386BIN}
TYPE
tinsentry=packed record
opcode : tasmop;
ops : byte;
optypes : ARRAY[0..2] of LongInt;
code : ARRAY[0..maxinfolen] of char;
flags : LongInt;
END;
pinsentry=^tinsentry;
TInsTabCache=ARRAY[TasmOp] of LongInt;
PInsTabCache=^TInsTabCache;
VAR
InsTabCache : PInsTabCache;
{$ENDif NOAG386BIN}
{*****************************************************************************
Helpers
*****************************************************************************}
CONST
maxvarregs=30;
VarRegs:ARRAY[1..maxvarregs]OF TRegister=(
R_G0,R_G1,R_G2,R_G3,R_G4,R_G5,R_G6,R_G7,
R_O0,R_O1,R_O2,R_O3,R_O4,R_O5,{R_R14=R_SP}R_O7,
R_L0,R_L1,R_L2,R_L3,R_L4,R_L5,R_L6,R_L7,
R_I0,R_I1,R_I2,R_I3,R_I4,R_I5,{R_R30=R_FP}R_I7
);
maxfpuvarregs = 8;
max_operands = 3;
maxintregs = maxvarregs;
maxfpuregs = maxfpuvarregs;
FUNCTION reg2str(r:tregister):string;
FUNCTION is_calljmp(o:tasmop):boolean;
FUNCTION flags_to_cond(CONST f:TResFlags):TAsmCond;
IMPLEMENTATION
FUNCTION reg2str(r:tregister):string;
TYPE
TStrReg=ARRAY[TRegister]OF STRING[5];
CONST
StrReg:TStrReg=({$INCLUDE strregs.inc});
BEGIN
reg2str:=StrReg[r];
END;
FUNCTION is_calljmp(o:tasmop):boolean;
BEGIN
CASE o OF
A_CALL,A_JMPL:
is_calljmp:=true;
ELSE
is_calljmp:=false;
END;
END;
FUNCTION flags_to_cond(CONST f:TResFlags):TAsmCond;
CONST
flags_2_cond:ARRAY[TResFlags]OF TAsmCond=(C_E,C_NE,C_G,C_L,C_GE,C_LE,C_C,C_NC,C_A,C_AE,C_B,C_BE);
BEGIN
result:=flags_2_cond[f];
END;
END.

318
compiler/sparc/cpugas.pas Normal file
View File

@ -0,0 +1,318 @@
{*****************************************************************************}
{ File : cpugas.pas }
{ Author : Mazen NEIFER }
{ Project : Free Pascal Compiler (FPC) }
{ Creation date : 2002\05\01 }
{ Last modification date : 2002\08\20 }
{ Licence : GPL }
{ Bug report : mazen.neifer.01@supaero.org }
{*****************************************************************************}
{ $Id$
Copyright (c) 1998-2000 by Florian Klaempfl
This unit implements an asmoutput class for SPARC AT&T syntax
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 CpuGas;
{$INCLUDE fpcdefs.inc}
INTERFACE
USES
cclasses,cpubase,
globals,
aasmbase,aasmtai,aasmcpu,assemble,aggas;
TYPE
TGasSPARC=class(TGnuAssembler)
PROCEDURE WriteInstruction(hp:Tai);OVERRIDE;
END;
IMPLEMENTATION
USES
strings,
dos,
globtype,
fmodule,finput,
cutils,systems,
verbose;
CONST
line_length = 70;
VAR
{$ifdef GDB}
n_line : byte; { different types of source lines }
linecount,
includecount : longint;
funcname : pchar;
stabslastfileinfo : tfileposinfo;
{$endif}
lastsec : tsection; { last section type written }
lastfileinfo : tfileposinfo;
infile,
lastinfile : tinputfile;
symendcount : longint;
function fixline(s:string):string;
{
return s with all leading and ending spaces and tabs removed
}
var
i,j,k : longint;
begin
i:=length(s);
while (i>0) and (s[i] in [#9,' ']) do
dec(i);
j:=1;
while (j<i) and (s[j] in [#9,' ']) do
inc(j);
for k:=j to i do
if s[k] in [#0..#31,#127..#255] then
s[k]:='.';
fixline:=Copy(s,j,i-j+1);
end;
function single2str(d : single) : string;
var
hs : string;
begin
str(d,hs);
{ replace space with + }
if hs[1]=' ' then
hs[1]:='+';
single2str:='0d'+hs
end;
function double2str(d : double) : string;
var
hs : string;
begin
str(d,hs);
{ replace space with + }
if hs[1]=' ' then
hs[1]:='+';
double2str:='0d'+hs
end;
function extended2str(e : extended) : string;
var
hs : string;
begin
str(e,hs);
{ replace space with + }
if hs[1]=' ' then
hs[1]:='+';
extended2str:='0d'+hs
end;
function getreferencestring(var ref : treference) : string;
var
s : string;
begin
with ref do
begin
inc(offset,offsetfixup);
offsetfixup:=0;
{ have we a segment prefix ? }
{ These are probably not correctly handled under GAS }
{ should be replaced by coding the segment override }
{ directly! - DJGPP FAQ }
if segment<>R_NO then
s:=std_reg2str[segment]+':'
else
s:='';
if assigned(symbol) then
s:=s+symbol.name;
if offset<0 then
s:=s+tostr(offset)
else
if (offset>0) then
begin
if assigned(symbol) then
s:=s+'+'+tostr(offset)
else
s:=s+tostr(offset);
end
else if (index=R_NO) and (base=R_NO) and not assigned(symbol) then
s:=s+'0';
if (index<>R_NO) and (base=R_NO) then
begin
s:=s+'(,'+std_reg2str[index];
if scalefactor<>0 then
s:=s+','+tostr(scalefactor)+')'
else
s:=s+')';
end
else
if (index=R_NO) and (base<>R_NO) then
s:=s+'('+std_reg2str[base]+')'
else
if (index<>R_NO) and (base<>R_NO) then
begin
s:=s+'('+std_reg2str[base]+','+std_reg2str[index];
if scalefactor<>0 then
s:=s+','+tostr(scalefactor)+')'
else
s := s+')';
end;
end;
getreferencestring:=s;
end;
function getopstr(const o:toper) : string;
var
hs : string;
begin
case o.typ of
top_reg :
getopstr:=std_reg2str[o.reg];
top_ref :
getopstr:=getreferencestring(o.ref^);
top_const :
getopstr:='$'+tostr(longint(o.val));
top_symbol :
begin
if assigned(o.sym) then
hs:='$'+o.sym.name
else
hs:='$';
if o.symofs>0 then
hs:=hs+'+'+tostr(o.symofs)
else
if o.symofs<0 then
hs:=hs+tostr(o.symofs)
else
if not(assigned(o.sym)) then
hs:=hs+'0';
getopstr:=hs;
end;
else
internalerror(10001);
end;
end;
function getopstr_jmp(const o:toper) : string;
var
hs : string;
begin
case o.typ of
top_reg :
getopstr_jmp:='*'+std_reg2str[o.reg];
top_ref :
getopstr_jmp:='*'+getreferencestring(o.ref^);
top_const :
getopstr_jmp:=tostr(longint(o.val));
top_symbol :
begin
hs:=o.sym.name;
if o.symofs>0 then
hs:=hs+'+'+tostr(o.symofs)
else
if o.symofs<0 then
hs:=hs+tostr(o.symofs);
getopstr_jmp:=hs;
end;
else
internalerror(10001);
end;
end;
{****************************************************************************
TISPARCATTASMOUTPUT
****************************************************************************}
const
ait_const2str : array[ait_const_32bit..ait_const_8bit] of string[8]=
(#9'.long'#9,#9'.short'#9,#9'.byte'#9);
PROCEDURE TGasSPARC.WriteInstruction(hp:Tai);
VAR
Op:TAsmOp;
s:STRING;
i:Integer;
sep:STRING[3];
BEGIN
IF hp.typ<>ait_instruction
THEN
Exit;
taicpu(hp).SetOperandOrder(op_att);
op:=taicpu(hp).opcode;
{ call maybe not translated to call }
s:=#9+std_op2str[op]+cond2str[taicpu(hp).condition];
IF is_CallJmp(op)
THEN
{ call and jmp need an extra handling }
{ this code is only called if jmp isn't a labeled instruction }
{ quick hack to overcome a problem with manglednames=255 chars }
BEGIN
{ IF op<>A_JMPl
THEN
s:=cond2str(op,taicpu(hp).condition)+','
ELSE}
s:=#9'b'#9;
s:=s+getopstr_jmp(taicpu(hp).oper[0]);
END
ELSE
BEGIN {process operands}
s:=#9+std_op2str[op];
IF taicpu(hp).ops<>0
THEN
BEGIN
{
if not is_calljmp(op) then
sep:=','
else
}
sep:=#9;
FOR i:=0 TO taicpu(hp).ops-1 DO
BEGIN
s:=s+sep+getopstr(taicpu(hp).oper[i]);
sep:=',';
END;
END;
END;
AsmWriteLn(s);
END;
{*****************************************************************************
Initialize
*****************************************************************************}
CONST
as_SPARC_as_info:TAsmInfo=(
id : as_gas;
idtxt : 'AS';
asmbin : 'as';
asmcmd : '-o $OBJ $ASM';
supported_target : system_any;
outputbinary: false;
allowdirect : true;
needar : true;
labelprefix_only_inside_procedure : false;
labelprefix : '.L';
comment : '# ';
secnames : ({sec_none}'', {no section}
{sec_code}'.text', {executable code}
{sec_data}'.data', {initialized R/W data}
{sec_bss}'.bss', {uninitialized R/W data}
{sec_idata2}'.comment', {comments}
{sec_idata4}'.debug', {debugging information}
{sec_idata5}'.rodata', {RO data}
{sec_idata6}'.line', {line numbers info for symbolic debug}
{sec_idata7}'.init', {runtime intialization code}
{sec_edata}'.fini', {runtime finalization code}
{sec_stab}'.stab',
{sec_stabstr} '.stabstr',
{sec_common}'.note') {note info}
);
INITIALIZATION
RegisterAssembler(as_SPARC_as_info,TGasSPARC);
END.

68
compiler/sparc/cpuinfo.pas Normal file
View File

@ -0,0 +1,68 @@
{*****************************************************************************}
{ File : cpuinfo.pas }
{ Author : Mazen NEIFER }
{ Project : Free Pascal Compiler (FPC) }
{ Creation date : 2002\26\26 }
{ Last modification date : 2002\08\20 }
{ Licence : GPL }
{ Bug report : mazen.neifer.01@supaero.org }
{*****************************************************************************}
{
$Id$
Copyright (c) 1998-2000 by Florian Klaempfl
Basic Processor information
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 cpuinfo;
{$INCLUDE fpcdefs.inc}
INTERFACE
TYPE
{# Natural integer register type and size for the target machine }
AWord=Cardinal;
PAWord=^AWord;
{ the ordinal type used when evaluating constant integer expressions }
TConstExprInt=int64;
{ 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=cardinal;
bestreal = extended;
ts32real = single;
ts64real = double;
ts80real = extended;
ts64comp = extended;
pbestreal=^bestreal;
{ possible supported processors for this target }
tprocessors=(no_processor,SPARC_V8,SPARC_V9);
CONST
{# Size of native extended floating point type }
extended_size = 10;
{# Size of a pointer }
pointer_size = 4;
{# Size of a multimedia register }
mmreg_size = 8;
{ target cpu string (used by compiler options) }
target_cpu_string = 'SPARC';
{ 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
END.

151
compiler/sparc/cpupara.pas Normal file
View File

@ -0,0 +1,151 @@
{*****************************************************************************}
{ File : cpupara.pas }
{ Author : Mazen NEIFER }
{ Project : Free Pascal Compiler (FPC) }
{ Creation date : 2002\07\13 }
{ Last modification date : 2002\08\20 }
{ Licence : GPL }
{ Bug report : mazen.neifer.01@supaero.org }
{*****************************************************************************}
{
$Id$
Copyright (c) 2002 by Florian Klaempfl
PowerPC 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.
****************************************************************************}
UNIT cpupara;
{SPARC specific calling conventions are handled by this unit}
{$INCLUDE fpcdefs.inc}
INTERFACE
USES
cpubase,
symconst,symbase,symdef,paramgr;
TYPE
TSparcParaManager=CLASS(TParaManager)
FUNCTION getintparaloc(nr:longint):tparalocation;OVERRIDE;
PROCEDURE create_param_loc_info(p:tabstractprocdef);OVERRIDE;
FUNCTION GetSelfLocation(p:tabstractprocdef):tparalocation;OVERRIDE;
end;
IMPLEMENTATION
USES
verbose,
cpuinfo,
symtype;
FUNCTION TSparcParaManager.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_O0)+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
case p.deftype of
orddef:
getparaloc:=LOC_REGISTER;
floatdef:
getparaloc:=LOC_FPUREGISTER;
enumdef:
getparaloc:=LOC_REGISTER;
pointerdef:
getparaloc:=LOC_REGISTER;
else
internalerror(2002071001);
end;
end;
PROCEDURE TSparcParaManager.create_param_loc_info(p : tabstractprocdef);
var
nextintreg,nextfloatreg,nextmmreg : tregister;
stack_offset : aword;
hp : tparaitem;
loc : tloc;
BEGIN
nextintreg:=R_G3;
nextfloatreg:=R_F1;
nextmmreg:=R_L1;
stack_offset:=0;
{ pointer for structured results ? }
{ !!!nextintreg:=R_4; }
{ frame pointer for nested procedures? }
{ inc(nextintreg); }
{ constructor? }
{ destructor? }
hp:=tparaitem(p.para.last);
while assigned(hp) do
BEGIN
loc:=getparaloc(hp.paratype.def);
case loc of
LOC_REGISTER:
BEGIN
if nextintreg<=R_I7 then
BEGIN
hp.paraloc.loc:=LOC_REGISTER;
hp.paraloc.register:=nextintreg;
inc(nextintreg);
end
else
BEGIN
{!!!!!!!}
internalerror(2002071003);
end;
end;
else
internalerror(2002071002);
end;
hp:=tparaitem(hp.previous);
end;
end;
FUNCTION TSparcParaManager.GetSelfLocation(p:tabstractprocdef):tparalocation;
BEGIN
getselflocation.loc:=LOC_REFERENCE;
getselflocation.reference.index:=R_G3{R_ESP};
getselflocation.reference.offset:=4;
END;
BEGIN
paramanager:=TSparcParaManager.create;
end.
{
$Log$
Revision 1.1 2002-08-21 13:30:07 mazen
*** empty log message ***
Revision 1.2 2002/07/11 14:41:34 florian
* start of the new generic parameter handling
Revision 1.1 2002/07/07 09:44:32 florian
* powerpc target fixed, very simple units can be compiled
}

557
compiler/sparc/psystem.pas Normal file
View File

@ -0,0 +1,557 @@
{
$Id$
Copyright (c) 1998-2002 by Florian Klaempfl
Load the system unit, create required defs for systemunit
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 psystem;
{$i fpcdefs.inc}
interface
uses
symbase;
procedure insertinternsyms(p : tsymtable);
procedure insert_intern_types(p : tsymtable);
procedure readconstdefs;
procedure createconstdefs;
procedure registernodes;
procedure registertais;
implementation
uses
globals,globtype,
symconst,symtype,symsym,symdef,symtable,
aasmtai,aasmcpu,
{$ifdef GDB}
gdb,
{$endif GDB}
node,nbas,nflw,nset,ncon,ncnv,nld,nmem,ncal,nmat,nadd,ninl,nopt;
procedure insertinternsyms(p : tsymtable);
{
all intern procedures for the system unit
}
begin
p.insert(tsyssym.create('Concat',in_concat_x));
p.insert(tsyssym.create('Write',in_write_x));
p.insert(tsyssym.create('WriteLn',in_writeln_x));
p.insert(tsyssym.create('Assigned',in_assigned_x));
p.insert(tsyssym.create('Read',in_read_x));
p.insert(tsyssym.create('ReadLn',in_readln_x));
p.insert(tsyssym.create('Ofs',in_ofs_x));
p.insert(tsyssym.create('SizeOf',in_sizeof_x));
p.insert(tsyssym.create('TypeOf',in_typeof_x));
p.insert(tsyssym.create('Low',in_low_x));
p.insert(tsyssym.create('High',in_high_x));
p.insert(tsyssym.create('Seg',in_seg_x));
p.insert(tsyssym.create('Ord',in_ord_x));
p.insert(tsyssym.create('Pred',in_pred_x));
p.insert(tsyssym.create('Succ',in_succ_x));
p.insert(tsyssym.create('Exclude',in_exclude_x_y));
p.insert(tsyssym.create('Include',in_include_x_y));
p.insert(tsyssym.create('Break',in_break));
p.insert(tsyssym.create('Exit',in_exit));
p.insert(tsyssym.create('Continue',in_continue));
p.insert(tsyssym.create('Dec',in_dec_x));
p.insert(tsyssym.create('Inc',in_inc_x));
p.insert(tsyssym.create('Str',in_str_x_string));
p.insert(tsyssym.create('Assert',in_assert_x_y));
p.insert(tsyssym.create('Val',in_val_x));
p.insert(tsyssym.create('Addr',in_addr_x));
p.insert(tsyssym.create('TypeInfo',in_typeinfo_x));
p.insert(tsyssym.create('SetLength',in_setlength_x));
p.insert(tsyssym.create('Finalize',in_finalize_x));
p.insert(tsyssym.create('Length',in_length_x));
p.insert(tsyssym.create('New',in_new_x));
p.insert(tsyssym.create('Dispose',in_dispose_x));
end;
procedure insert_intern_types(p : tsymtable);
{
all the types inserted into the system unit
}
function addtype(const s:string;const t:ttype):ttypesym;
begin
result:=ttypesym.create(s,t);
p.insert(result);
{ add init/final table if required }
if t.def.needs_inittable then
generate_inittable(result);
end;
procedure adddef(const s:string;def:tdef);
var
t : ttype;
begin
t.setdef(def);
p.insert(ttypesym.create(s,t));
end;
var
{ several defs to simulate more or less C++ objects for GDB }
vmttype,
vmtarraytype : ttype;
vmtsymtable : tsymtable;
begin
{ Normal types }
if (cs_fp_emulation in aktmoduleswitches) then
begin
addtype('Single',s32floattype);
{ extended size is the best real type for the target }
addtype('Real',s32floattype);
pbestrealtype:=@s32floattype;
end
else
begin
addtype('Single',s32floattype);
addtype('Double',s64floattype);
{ extended size is the best real type for the target }
addtype('Extended',pbestrealtype^);
addtype('Real',s64floattype);
end;
{$ifdef x86}
adddef('Comp',tfloatdef.create(s64comp));
{$endif x86}
addtype('Currency',s64currencytype);
addtype('Pointer',voidpointertype);
addtype('FarPointer',voidfarpointertype);
addtype('ShortString',cshortstringtype);
addtype('LongString',clongstringtype);
addtype('AnsiString',cansistringtype);
addtype('WideString',cwidestringtype);
addtype('Boolean',booltype);
addtype('ByteBool',booltype);
adddef('WordBool',torddef.create(bool16bit,0,1));
adddef('LongBool',torddef.create(bool32bit,0,1));
addtype('Char',cchartype);
addtype('WideChar',cwidechartype);
adddef('Text',tfiledef.createtext);
addtype('Cardinal',u32bittype);
addtype('QWord',cu64bittype);
addtype('Int64',cs64bittype);
adddef('TypedFile',tfiledef.createtyped(voidtype));
addtype('Variant',cvarianttype);
{ Internal types }
addtype('$formal',cformaltype);
addtype('$void',voidtype);
addtype('$byte',u8bittype);
addtype('$word',u16bittype);
addtype('$ulong',u32bittype);
addtype('$longint',s32bittype);
addtype('$qword',cu64bittype);
addtype('$int64',cs64bittype);
addtype('$char',cchartype);
addtype('$widechar',cwidechartype);
addtype('$shortstring',cshortstringtype);
addtype('$longstring',clongstringtype);
addtype('$ansistring',cansistringtype);
addtype('$widestring',cwidestringtype);
addtype('$openshortstring',openshortstringtype);
addtype('$boolean',booltype);
addtype('$void_pointer',voidpointertype);
addtype('$char_pointer',charpointertype);
addtype('$void_farpointer',voidfarpointertype);
addtype('$openchararray',openchararraytype);
addtype('$file',cfiletype);
addtype('$variant',cvarianttype);
addtype('$s32real',s32floattype);
addtype('$s64real',s64floattype);
addtype('$s80real',s80floattype);
addtype('$s64currency',s64currencytype);
{ Add a type for virtual method tables }
vmtsymtable:=trecordsymtable.create;
vmttype.setdef(trecorddef.create(vmtsymtable));
pvmttype.setdef(tpointerdef.create(vmttype));
vmtsymtable.insert(tvarsym.create('$parent',pvmttype));
vmtsymtable.insert(tvarsym.create('$length',s32bittype));
vmtsymtable.insert(tvarsym.create('$mlength',s32bittype));
vmtarraytype.setdef(tarraydef.create(0,1,s32bittype));
tarraydef(vmtarraytype.def).elementtype:=voidpointertype;
vmtsymtable.insert(tvarsym.create('$__pfn',vmtarraytype));
addtype('$__vtbl_ptr_type',vmttype);
addtype('$pvmt',pvmttype);
vmtarraytype.setdef(tarraydef.create(0,1,s32bittype));
tarraydef(vmtarraytype.def).elementtype:=pvmttype;
addtype('$vtblarray',vmtarraytype);
{ Add functions that require compiler magic }
insertinternsyms(p);
end;
procedure readconstdefs;
{
Load all default definitions for consts from the system unit
}
begin
globaldef('byte',u8bittype);
globaldef('word',u16bittype);
globaldef('ulong',u32bittype);
globaldef('longint',s32bittype);
globaldef('qword',cu64bittype);
globaldef('int64',cs64bittype);
globaldef('formal',cformaltype);
globaldef('void',voidtype);
globaldef('char',cchartype);
globaldef('widechar',cwidechartype);
globaldef('shortstring',cshortstringtype);
globaldef('longstring',clongstringtype);
globaldef('ansistring',cansistringtype);
globaldef('widestring',cwidestringtype);
globaldef('openshortstring',openshortstringtype);
globaldef('openchararray',openchararraytype);
globaldef('s32real',s32floattype);
globaldef('s64real',s64floattype);
globaldef('s80real',s80floattype);
globaldef('s64currency',s64currencytype);
globaldef('boolean',booltype);
globaldef('void_pointer',voidpointertype);
globaldef('char_pointer',charpointertype);
globaldef('void_farpointer',voidfarpointertype);
globaldef('file',cfiletype);
globaldef('pvmt',pvmttype);
globaldef('variant',cvarianttype);
{$ifdef i386}
ordpointertype:=u32bittype;
{$endif i386}
{$ifdef x86_64}
ordpointertype:=cu64bittype;
{$endif x86_64}
{$ifdef powerpc}
ordpointertype:=u32bittype;
{$endif powerpc}
{$ifdef sparc}
ordpointertype:=u32bittype;
{$endif sparc}
{$ifdef m68k}
ordpointertype:=u32bittype;
{$endif}
end;
procedure createconstdefs;
{
Create all default definitions for consts for the system unit
}
var
oldregisterdef : boolean;
begin
{ create definitions for constants }
oldregisterdef:=registerdef;
registerdef:=false;
cformaltype.setdef(tformaldef.create);
voidtype.setdef(torddef.create(uvoid,0,0));
u8bittype.setdef(torddef.create(u8bit,0,255));
u16bittype.setdef(torddef.create(u16bit,0,65535));
u32bittype.setdef(torddef.create(u32bit,0,high(cardinal)));
s32bittype.setdef(torddef.create(s32bit,low(longint),high(longint)));
cu64bittype.setdef(torddef.create(u64bit,low(qword),TConstExprInt(high(qword))));
cs64bittype.setdef(torddef.create(s64bit,low(int64),high(int64)));
booltype.setdef(torddef.create(bool8bit,0,1));
cchartype.setdef(torddef.create(uchar,0,255));
cwidechartype.setdef(torddef.create(uwidechar,0,65535));
cshortstringtype.setdef(tstringdef.createshort(255));
{ should we give a length to the default long and ansi string definition ?? }
clongstringtype.setdef(tstringdef.createlong(-1));
cansistringtype.setdef(tstringdef.createansi(-1));
cwidestringtype.setdef(tstringdef.createwide(-1));
{ length=0 for shortstring is open string (needed for readln(string) }
openshortstringtype.setdef(tstringdef.createshort(0));
openchararraytype.setdef(tarraydef.create(0,-1,s32bittype));
tarraydef(openchararraytype.def).elementtype:=cchartype;
{$ifdef x86}
{$ifdef i386}
ordpointertype:=u32bittype;
{$endif i386}
{$ifdef x86_64}
ordpointertype:=cu64bittype;
{$endif x86_64}
s32floattype.setdef(tfloatdef.create(s32real));
s64floattype.setdef(tfloatdef.create(s64real));
s80floattype.setdef(tfloatdef.create(s80real));
{$endif x86}
{$ifdef powerpc}
ordpointertype:=u32bittype;
s32floattype.setdef(tfloatdef.create(s32real));
s64floattype.setdef(tfloatdef.create(s64real));
s80floattype.setdef(tfloatdef.create(s80real));
{$endif powerpc}
{$ifdef sparc}
ordpointertype:=u32bittype;
s32floattype.setdef(tfloatdef.create(s32real));
s64floattype.setdef(tfloatdef.create(s64real));
s80floattype.setdef(tfloatdef.create(s80real));
{$endif sparc}
{$ifdef m68k}
ordpointertype:=u32bittype;
s32floattype.setdef(tfloatdef.create(s32real));
s64floattype.setdef(tfloatdef.create(s64real));
s80floattype.setdef(tfloatdef.create(s80real));
{$endif}
s64currencytype.setdef(tfloatdef.create(s64currency));
{ some other definitions }
voidpointertype.setdef(tpointerdef.create(voidtype));
charpointertype.setdef(tpointerdef.create(cchartype));
voidfarpointertype.setdef(tpointerdef.createfar(voidtype));
cfiletype.setdef(tfiledef.createuntyped);
cvarianttype.setdef(tvariantdef.create);
registerdef:=oldregisterdef;
end;
procedure registernodes;
{
Register all possible nodes in the nodeclass array that
will be used for loading the nodes from a ppu
}
begin
nodeclass[addn]:=caddnode;
nodeclass[muln]:=caddnode;
nodeclass[subn]:=caddnode;
nodeclass[divn]:=cmoddivnode;
nodeclass[symdifn]:=caddnode;
nodeclass[modn]:=cmoddivnode;
nodeclass[assignn]:=cassignmentnode;
nodeclass[loadn]:=cloadnode;
nodeclass[rangen]:=crangenode;
nodeclass[ltn]:=caddnode;
nodeclass[lten]:=caddnode;
nodeclass[gtn]:=caddnode;
nodeclass[gten]:=caddnode;
nodeclass[equaln]:=caddnode;
nodeclass[unequaln]:=caddnode;
nodeclass[inn]:=cinnode;
nodeclass[orn]:=caddnode;
nodeclass[xorn]:=caddnode;
nodeclass[shrn]:=cshlshrnode;
nodeclass[shln]:=cshlshrnode;
nodeclass[slashn]:=caddnode;
nodeclass[andn]:=caddnode;
nodeclass[subscriptn]:=csubscriptnode;
nodeclass[derefn]:=cderefnode;
nodeclass[addrn]:=caddrnode;
nodeclass[doubleaddrn]:=cdoubleaddrnode;
nodeclass[ordconstn]:=cordconstnode;
nodeclass[typeconvn]:=ctypeconvnode;
nodeclass[calln]:=ccallnode;
nodeclass[callparan]:=ccallparanode;
nodeclass[realconstn]:=crealconstnode;
nodeclass[unaryminusn]:=cunaryminusnode;
nodeclass[asmn]:=casmnode;
nodeclass[vecn]:=cvecnode;
nodeclass[pointerconstn]:=cpointerconstnode;
nodeclass[stringconstn]:=cstringconstnode;
nodeclass[funcretn]:=cfuncretnode;
nodeclass[selfn]:=cselfnode;
nodeclass[notn]:=cnotnode;
nodeclass[inlinen]:=cinlinenode;
nodeclass[niln]:=cnilnode;
nodeclass[errorn]:=cerrornode;
nodeclass[typen]:=ctypenode;
nodeclass[hnewn]:=chnewnode;
nodeclass[hdisposen]:=chdisposenode;
nodeclass[setelementn]:=csetelementnode;
nodeclass[setconstn]:=csetconstnode;
nodeclass[blockn]:=cblocknode;
nodeclass[statementn]:=cstatementnode;
nodeclass[ifn]:=cifnode;
nodeclass[breakn]:=cbreaknode;
nodeclass[continuen]:=ccontinuenode;
nodeclass[whilerepeatn]:=cwhilerepeatnode;
nodeclass[forn]:=cfornode;
nodeclass[exitn]:=cexitnode;
nodeclass[withn]:=cwithnode;
nodeclass[casen]:=ccasenode;
nodeclass[labeln]:=clabelnode;
nodeclass[goton]:=cgotonode;
nodeclass[tryexceptn]:=ctryexceptnode;
nodeclass[raisen]:=craisenode;
nodeclass[tryfinallyn]:=ctryfinallynode;
nodeclass[onn]:=connode;
nodeclass[isn]:=cisnode;
nodeclass[asn]:=casnode;
nodeclass[caretn]:=caddnode;
nodeclass[failn]:=cfailnode;
nodeclass[starstarn]:=caddnode;
nodeclass[procinlinen]:=cprocinlinenode;
nodeclass[arrayconstructorn]:=carrayconstructornode;
nodeclass[arrayconstructorrangen]:=carrayconstructorrangenode;
nodeclass[tempcreaten]:=ctempcreatenode;
nodeclass[temprefn]:=ctemprefnode;
nodeclass[tempdeleten]:=ctempdeletenode;
nodeclass[addoptn]:=caddnode;
nodeclass[nothingn]:=cnothingnode;
nodeclass[loadvmtn]:=cloadvmtnode;
nodeclass[guidconstn]:=cguidconstnode;
nodeclass[rttin]:=crttinode;
end;
procedure registertais;
{
Register all possible tais in the taiclass array that
will be used for loading the tais from a ppu
}
begin
aiclass[ait_none]:=nil;
aiclass[ait_align]:=tai_align;
aiclass[ait_section]:=tai_section;
aiclass[ait_comment]:=tai_comment;
aiclass[ait_direct]:=tai_direct;
aiclass[ait_string]:=tai_string;
aiclass[ait_instruction]:=taicpu;
aiclass[ait_datablock]:=tai_datablock;
aiclass[ait_symbol]:=tai_symbol;
aiclass[ait_symbol_end]:=tai_symbol_end;
aiclass[ait_label]:=tai_label;
aiclass[ait_const_32bit]:=tai_const;
aiclass[ait_const_16bit]:=tai_const;
aiclass[ait_const_8bit]:=tai_const;
aiclass[ait_const_symbol]:=tai_const_symbol;
aiclass[ait_const_rva]:=tai_const_symbol;
aiclass[ait_real_32bit]:=tai_real_32bit;
aiclass[ait_real_64bit]:=tai_real_64bit;
aiclass[ait_real_80bit]:=tai_real_80bit;
aiclass[ait_comp_64bit]:=tai_comp_64bit;
{$ifdef GDB}
aiclass[ait_stabn]:=tai_stabn;
aiclass[ait_stabs]:=tai_stabs;
aiclass[ait_force_line]:=tai_force_line;
aiclass[ait_stab_function_name]:=tai_stab_function_name;
{$endif GDB}
{$ifdef alpha}
{ the follow is for the DEC Alpha }
aiclass[ait_frame]:=tai_frame;
aiclass[ait_ent]:=tai_ent;
{$endif alpha}
{$ifdef m68k}
{$warning FIXME: tai_labeled_instruction doesn't exists}
// aiclass[ait_labeled_instruction]:=tai_labeled_instruction;
{$endif m68k}
{$ifdef ia64}
aiclass[ait_bundle]:=tai_bundle;
aiclass[ait_stop]:=tai_stop;
{$endif ia64}
{$ifdef SPARC}
{$WARNING FIXME: tai_labeled_instruction doesn't exists}
// aiclass[ait_labeled_instruction]:=tai_labeled_instruction;
{$endif SPARC}
aiclass[ait_cut]:=tai_cut;
aiclass[ait_regalloc]:=tai_regalloc;
aiclass[ait_tempalloc]:=tai_tempalloc;
aiclass[ait_marker]:=tai_marker;
end;
end.
{
$Log$
Revision 1.1 2002-08-21 13:30:07 mazen
*** empty log message ***
Revision 1.37 2002/08/18 20:06:25 peter
* inlining is now also allowed in interface
* renamed write/load to ppuwrite/ppuload
* tnode storing in ppu
* nld,ncon,nbas are already updated for storing in ppu
Revision 1.36 2002/08/15 19:10:35 peter
* first things tai,tnode storing in ppu
Revision 1.35 2002/08/14 19:14:39 carl
+ fpu emulation support (generic and untested)
Revision 1.34 2002/08/13 18:01:52 carl
* rename swatoperands to swapoperands
+ m68k first compilable version (still needs a lot of testing):
assembler generator, system information , inline
assembler reader.
Revision 1.33 2002/08/11 15:28:00 florian
+ support of explicit type case <any ordinal type>->pointer
(delphi mode only)
Revision 1.32 2002/07/25 17:54:24 carl
+ Extended is now CPU dependant (equal to bestrealtype)
Revision 1.30 2002/07/07 09:52:32 florian
* powerpc target fixed, very simple units can be compiled
* some basic stuff for better callparanode handling, far from being finished
Revision 1.29 2002/07/06 20:18:47 carl
+ more SPARC patches from Mazen
Revision 1.28 2002/07/04 20:43:02 florian
* first x86-64 patches
Revision 1.27 2002/07/01 16:23:54 peter
* cg64 patch
* basics for currency
* asnode updates for class and interface (not finished)
Revision 1.26 2002/05/18 13:34:16 peter
* readded missing revisions
Revision 1.25 2002/05/16 19:46:44 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.23 2002/05/12 16:53:09 peter
* moved entry and exitcode to ncgutil and cgobj
* foreach gets extra argument for passing local data to the
iterator function
* -CR checks also class typecasts at runtime by changing them
into as
* fixed compiler to cycle with the -CR option
* fixed stabs with elf writer, finally the global variables can
be watched
* removed a lot of routines from cga unit and replaced them by
calls to cgobj
* u32bit-s32bit updates for and,or,xor nodes. When one element is
u32bit then the other is typecasted also to u32bit without giving
a rangecheck warning/error.
* fixed pascal calling method with reversing also the high tree in
the parast, detected by tcalcst3 test
Revision 1.22 2002/01/24 12:33:53 jonas
* adapted ranges of native types to int64 (e.g. high cardinal is no
longer longint($ffffffff), but just $fffffff in psystem)
* small additional fix in 64bit rangecheck code generation for 32 bit
processors
* adaption of ranges required the matching talgorithm used for selecting
which overloaded procedure to call to be adapted. It should now always
select the closest match for ordinal parameters.
+ inttostr(qword) in sysstr.inc/sysstrh.inc
+ abs(int64), sqr(int64), sqr(qword) in systemh.inc/generic.inc (previous
fixes were required to be able to add them)
* is_in_limit() moved from ncal to types unit, should always be used
instead of direct comparisons of low/high values of orddefs because
qword is a special case
}

338
compiler/sparc/rgcpu.pas Normal file
View File

@ -0,0 +1,338 @@
{*****************************************************************************}
{ File : rgcpu.pas }
{ Author : Mazen NEIFER }
{ Project : Free Pascal Compiler (FPC) }
{ Creation date : 2002\26\26 }
{ Last modification date : 2002\08\20 }
{ Licence : GPL }
{ Bug report : mazen.neifer.01@supaero.org }
{*****************************************************************************}
{
$Id$
Copyright (c) 1998-2002 by Florian Klaempfl
This unit implements the i386 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;
{$INCLUDE fpcdefs.inc}
interface
uses
cpubase,
cpuinfo,
aasmcpu,
aasmtai,
cclasses,globtype,cgbase,aasmbase,rgobj;
type
trgcpu = class(trgobj)
{ to keep the same allocation order as with the old routines }
function getregisterint(list: taasmoutput): tregister; override;
procedure ungetregisterint(list: taasmoutput; r : tregister); override;
function getexplicitregisterint(list: taasmoutput; r : tregister) : tregister; override;
function getregisterfpu(list: taasmoutput) : tregister; override;
procedure ungetregisterfpu(list: taasmoutput; r : tregister); override;
procedure ungetreference(list: taasmoutput; const ref : treference); override;
{ pushes and restores registers }
procedure pushusedregisters(list: taasmoutput;
var pushed : tpushedsaved;const s: tregisterset);
procedure popusedregisters(list: taasmoutput;
const pushed : tpushedsaved);
procedure resetusableregisters;override;
{ corrects the fpu stack register by ofs }
function correct_fpuregister(r : tregister;ofs : byte) : tregister;
fpuvaroffset : byte;
end;
implementation
uses
systems,
globals,verbose,node,
cgobj,tgobj,cga;
function trgcpu.getregisterint(list: taasmoutput): tregister;
begin
if countunusedregsint=0 then
internalerror(10);(*
{$ifdef TEMPREGDEBUG}
if curptree^.usableregsint-countunusedregsint>curptree^.registers32 then
internalerror(10);
{$endif TEMPREGDEBUG}
{$ifdef EXTTEMPREGDEBUG}
if curptree^.usableregs-countunusedregistersint>curptree^^.reallyusedregs then
curptree^.reallyusedregs:=curptree^^.usableregs-countunusedregistersint;
{$endif EXTTEMPREGDEBUG}
dec(countunusedregsint);
if R_EAX in unusedregsint then
begin
exclude(unusedregsint,R_EAX);
include(usedinproc,R_EAX);
getregisterint:=R_EAX;
{$ifdef TEMPREGDEBUG}
reg_user[R_EAX]:=curptree^;
{$endif TEMPREGDEBUG}
exprasmlist.concat(tairegalloc.alloc(R_EAX));
end
else if R_EDX in unusedregsint then
begin
exclude(unusedregsint,R_EDX);
include(usedinproc,R_EDX);
getregisterint:=R_EDX;
{$ifdef TEMPREGDEBUG}
reg_user[R_EDX]:=curptree^;
{$endif TEMPREGDEBUG}
exprasmlist.concat(tairegalloc.alloc(R_EDX));
end
else if R_EBX in unusedregsint then
begin
exclude(unusedregsint,R_EBX);
include(usedinproc,R_EBX);
getregisterint:=R_EBX;
{$ifdef TEMPREGDEBUG}
reg_user[R_EBX]:=curptree^;
{$endif TEMPREGDEBUG}
exprasmlist.concat(tairegalloc.alloc(R_EBX));
end
else if R_ECX in unusedregsint then
begin
exclude(unusedregsint,R_ECX);
include(usedinproc,R_ECX);
getregisterint:=R_ECX;
{$ifdef TEMPREGDEBUG}
reg_user[R_ECX]:=curptree^;
{$endif TEMPREGDEBUG}
exprasmlist.concat(tairegalloc.alloc(R_ECX));
end
else internalerror(10);
{$ifdef TEMPREGDEBUG}
testregisters;
{$endif TEMPREGDEBUG}*)
end;
procedure trgcpu.ungetregisterint(list: taasmoutput; r : tregister);
begin
{ if (r = R_EDI) or
((not assigned(procinfo^._class)) and (r = R_ESI)) then
begin
list.concat(Tairegalloc.DeAlloc(r));
exit;
end;
if not(r in [R_EAX,R_EBX,R_ECX,R_EDX]) then
exit;
inherited ungetregisterint(list,r);}
end;
function trgcpu.getexplicitregisterint(list: taasmoutput; r : tregister) : tregister;
begin
{ if r in [R_ESI,R_EDI] then
begin
list.concat(Tairegalloc.Alloc(r));
getexplicitregisterint := r;
exit;
end;}
result := inherited getexplicitregisterint(list,r);
end;
function trgcpu.getregisterfpu(list: taasmoutput) : tregister;
begin
{ note: don't return R_ST0, see comments above implementation of }
{ a_loadfpu_* methods in cgcpu (JM) }
// result := R_ST;
end;
procedure trgcpu.ungetregisterfpu(list : taasmoutput; r : tregister);
begin
{ nothing to do, fpu stack management is handled by the load/ }
{ store operations in cgcpu (JM) }
end;
procedure trgcpu.ungetreference(list: taasmoutput; const ref : treference);
begin
ungetregisterint(list,ref.base);
ungetregisterint(list,ref.index);
end;
procedure trgcpu.pushusedregisters(list: taasmoutput;
var pushed : tpushedsaved; const s: tregisterset);
var
r: tregister;
hr: treference;
begin
usedinproc:=usedinproc + s;
(* for r:=R_EAX to R_EBX do
begin
pushed[r].pushed:=false;
{ if the register is used by the calling subroutine }
if not is_reg_var[r] and
(r in s) and
{ and is present in use }
not(r in unusedregsint) then
begin
{ then save it }
list.concat(Taicpu.Op_reg(A_PUSH,S_L,r));
include(unusedregsint,r);
inc(countunusedregsint);
pushed[r].pushed:=true;
end;
end;*)
{$ifdef SUPPORT_MMX}
(*for r:=R_MM0 to R_MM6 do
begin
pushed[r].pushed:=false;
{ if the register is used by the calling subroutine }
if not is_reg_var[r] and
(r in s) and
{ and is present in use }
not(r in unusedregsmm) then
begin
list.concat(Taicpu.Op_const_reg(A_SUB,S_L,8,R_ESP));
reference_reset_base(hr,R_ESP,0);
list.concat(Taicpu.Op_reg_ref(A_MOVQ,S_NO,r,hr));
include(unusedregsmm,r);
inc(countunusedregsmm);
pushed[r].pushed:=true;
end;
end;*)
{$endif SUPPORT_MMX}
{$ifdef TEMPREGDEBUG}
testregisters;
{$endif TEMPREGDEBUG}
end;
procedure trgcpu.popusedregisters(list: taasmoutput;
const pushed : tpushedsaved);
var
r : tregister;
{$ifdef SUPPORT_MMX}
hr : treference;
{$endif SUPPORT_MMX}
begin
{ restore in reverse order: }
{$ifdef SUPPORT_MMX}
for r:=R_MM6 downto R_MM0 do
if pushed[r].pushed then
begin
reference_reset_base(hr,R_ESP,0);
list.concat(Taicpu.Op_ref_reg(
A_MOVQ,S_NO,hr,r));
list.concat(Taicpu.Op_const_reg(
A_ADD,S_L,8,R_ESP));
if not (r in unusedregsmm) then
{ internalerror(10)
in cg386cal we always restore regs
that appear as used
due to a unused tmep storage PM }
else
dec(countunusedregsmm);
exclude(unusedregsmm,r);
end;
{$endif SUPPORT_MMX}
(* for r:=R_EBX downto R_EAX do
if pushed[r].pushed then
begin
list.concat(Taicpu.Op_reg(A_POP,S_L,r));
if not (r in unusedregsint) then
{ internalerror(10)
in cg386cal we always restore regs
that appear as used
due to a unused tmep storage PM }
else
dec(countunusedregsint);
exclude(unusedregsint,r);
end;*)
{$ifdef TEMPREGDEBUG}
testregisters;
{$endif TEMPREGDEBUG}
end;
procedure trgcpu.resetusableregisters;
begin
inherited resetusableregisters;
fpuvaroffset := 0;
end;
function trgcpu.correct_fpuregister(r : tregister;ofs : byte) : tregister;
begin
correct_fpuregister:=tregister(longint(r)+ofs);
end;
initialization
rg := trgcpu.create;
end.
{
$Log$
Revision 1.1 2002-08-21 13:30:07 mazen
*** empty log message ***
Revision 1.2 2002/04/02 17:11:39 peter
* tlocation,treference update
* LOC_CONSTANT added for better constant handling
* secondadd splitted in multiple routines
* location_force_reg added for loading a location to a register
of a specified size
* secondassignment parses now first the right and then the left node
(this is compatible with Kylix). This saves a lot of push/pop especially
with string operations
* adapted some routines to use the new cg methods
Revision 1.1 2002/03/31 20:26:40 jonas
+ a_loadfpu_* and a_loadmm_* methods in tcg
* register allocation is now handled by a class and is mostly processor
independent (+rgobj.pas and i386/rgcpu.pas)
* temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
* some small improvements and fixes to the optimizer
* some register allocation fixes
* some fpuvaroffset fixes in the unary minus node
* fixed and optimized register saving/restoring for new/dispose nodes
* LOC_FPU locations now also require their "register" field to be set to
R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
- list field removed of the tnode class because it's not used currently
and can cause hard-to-find bugs
}