paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 17:47:56 +02:00
Code Issues Packages Projects Releases Wiki Activity

* some fpu emulation code from arm to generic code generator moved

Browse Source 
* several m68k fixes

git-svn-id: trunk@5218 -
This commit is contained in:
florian 2006-11-04 10:23:35 +00:00
parent c465b95bdf
commit 4cbb67aa00
13 changed files with 117 additions and 131 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
compiler/arm/narmcnv.pas
View File

@ -77,74 +77,7 @@ implementation
fname: string[19];
begin
if cs_fp_emulation in current_settings.moduleswitches then
begin
if target_info.system in system_wince then
begin
{ converting a 64bit integer to a float requires a helper }
if is_64bitint(left.resultdef) or
is_currency(left.resultdef) then
begin
{ hack to avoid double division by 10000, as it's
already done by typecheckpass.resultdef_int_to_real }
if is_currency(left.resultdef) then
left.resultdef := s64inttype;
if is_signed(left.resultdef) then
fname:='I64TOD'
else
fname:='UI64TOD';
end
else
{ other integers are supposed to be 32 bit }
begin
if is_signed(left.resultdef) then
fname:='ITOD'
else
fname:='UTOD';
firstpass(left);
end;
result:=ccallnode.createintern(fname,ccallparanode.create(
left,nil));
left:=nil;
firstpass(result);
exit;
end
else
begin
{ converting a 64bit integer to a float requires a helper }
if is_64bitint(left.resultdef) or
is_currency(left.resultdef) then
begin
{ hack to avoid double division by 10000, as it's
already done by typecheckpass.resultdef_int_to_real }
if is_currency(left.resultdef) then
left.resultdef := s64inttype;
if is_signed(left.resultdef) then
fname:='int64_to_'
else
{ we can't do better currently }
fname:='int64_to_';
end
else
{ other integers are supposed to be 32 bit }
begin
if is_signed(left.resultdef) then
fname:='int32_to_'
else
{ we can't do better currently }
fname:='int32_to_';
firstpass(left);
end;
if tfloatdef(resultdef).floattype=s64real then
fname:=fname+'float64'
else
fname:=fname+'float32';
result:=ctypeconvnode.create_internal(ccallnode.createintern(fname,ccallparanode.create(
left,nil)),resultdef);
left:=nil;
firstpass(result);
exit;
end;
end
result:=inherited first_int_to_real
else
begin
{ converting a 64bit integer to a float requires a helper }

8
compiler/m68k/aasmcpu.pas
View File

@ -112,8 +112,8 @@ type
gas_op2str:op2strtable=
{ warning: CPU32 opcodes are not fully compatible with the MC68020. }
{ 68000 only opcodes }
('abcd',
'add','adda','addi','addq','addx','and','andi',
( '',
'abcd','add','adda','addi','addq','addx','and','andi',
'asl','asr','bcc','bcs','beq','bge','bgt','bhi',
'ble','bls','blt','bmi','bne','bpl','bvc','bvs',
'bchg','bclr','bra','bset','bsr','btst','chk',
@ -159,7 +159,7 @@ type
{ (this may include 68040 mmu instructions) }
'frestore','fsave','pflush','pflusha','pload','pmove','ptest',
{ useful for assembly language output }
'label','none','db','s','b','fb');
'label','db','s','b','fb');
{*****************************************************************************
@ -543,7 +543,7 @@ type
// no need to handle sizes here
result:=taicpu.op_ref_reg(A_FMOVE,S_FS,ref,r);
else
internalerror(200602011);
internalerror(200602011);
end;
end;

8
compiler/m68k/ag68kgas.pas
View File

@ -44,8 +44,8 @@ interface
gas_op2str:op2strtable=
{ warning: CPU32 opcodes are not fully compatible with the MC68020. }
{ 68000 only opcodes }
('abcd',
'add','adda','addi','addq','addx','and','andi',
( '',
'abcd','add','adda','addi','addq','addx','and','andi',
'asl','asr','bcc','bcs','beq','bge','bgt','bhi',
'ble','bls','blt','bmi','bne','bpl','bvc','bvs',
'bchg','bclr','bra','bset','bsr','btst','chk',
@ -91,7 +91,7 @@ interface
{ (this may include 68040 mmu instructions) }
'frestore','fsave','pflush','pflusha','pload','pmove','ptest',
{ useful for assembly language output }
'label','none','db','s','b','fb');
'label','db','s','b','fb');
gas_opsize2str : array[topsize] of string[2] =
@ -114,7 +114,7 @@ interface
cgbase,cgutils,
verbose,itcpugas;
{****************************************************************************}
{ GNU m68k Assembler writer }
{****************************************************************************}

8
compiler/m68k/cgcpu.pas
View File

@ -1358,13 +1358,13 @@ unit cgcpu;
end;
OP_AND :
begin
{ should already be optimized out }
internalerror(2002081801);
list.concat(taicpu.op_const_reg(A_AND,S_L,lowvalue,regdst.reglo));
list.concat(taicpu.op_const_reg(A_AND,S_L,highvalue,regdst.reglo));
end;
OP_OR :
begin
{ should already be optimized out }
internalerror(2002081802);
list.concat(taicpu.op_const_reg(A_OR,S_L,lowvalue,regdst.reglo));
list.concat(taicpu.op_const_reg(A_OR,S_L,highvalue,regdst.reglo));
end;
{ this is handled in 1st pass for 32-bit cpu's (helper call) }
OP_IDIV,OP_DIV,

6
compiler/m68k/cpubase.pas
View File

@ -38,8 +38,8 @@ unit cpubase;
type
{ warning: CPU32 opcodes are not fully compatible with the MC68020. }
{ 68000 only opcodes }
tasmop = (a_abcd,
a_add,a_adda,a_addi,a_addq,a_addx,a_and,a_andi,
tasmop = (a_none,
a_abcd,a_add,a_adda,a_addi,a_addq,a_addx,a_and,a_andi,
a_asl,a_asr,a_bcc,a_bcs,a_beq,a_bge,a_bgt,a_bhi,
a_ble,a_bls,a_blt,a_bmi,a_bne,a_bpl,a_bvc,a_bvs,
a_bchg,a_bclr,a_bra,a_bset,a_bsr,a_btst,a_chk,
@ -85,7 +85,7 @@ unit cpubase;
{ (this may include 68040 mmu instructions) }
a_frestore,a_fsave,a_pflush,a_pflusha,a_pload,a_pmove,a_ptest,
{ useful for assembly language output }
a_label,a_none,a_dbxx,a_sxx,a_bxx,a_fbxx);
a_label,a_dbxx,a_sxx,a_bxx,a_fbxx);
{# This should define the array of instructions as string }
op2strtable=array[tasmop] of string[11];

6
compiler/m68k/itcpugas.pas
View File

@ -32,8 +32,8 @@ interface
gas_op2str : op2strtable=
{ warning: CPU32 opcodes are not fully compatible with the MC68020. }
{ 68000 only opcodes }
('abcd',
'add','adda','addi','addq','addx','and','andi',
( '',
'abcd','add','adda','addi','addq','addx','and','andi',
'asl','asr','bcc','bcs','beq','bge','bgt','bhi',
'ble','bls','blt','bmi','bne','bpl','bvc','bvs',
'bchg','bclr','bra','bset','bsr','btst','chk',
@ -79,7 +79,7 @@ interface
{ (this may include 68040 mmu instructions) }
'frestore','fsave','pflush','pflusha','pload','pmove','ptest',
{ useful for assembly language output }
'label','none','db','s','b','fb');
'label','db','s','b','fb');
function gas_regnum_search(const s:string):Tregister;
function gas_regname(r:Tregister):string;

6
compiler/m68k/ra68kmot.pas
View File

@ -1764,9 +1764,9 @@ const
begin
instr:=TM68kInstruction.Create(tm68koperand);
BuildOpcode(instr);
{ instr.AddReferenceSizes;}
{ instr.SetInstructionOpsize;}
{ instr.CheckOperandSizes;}
// instr.AddReferenceSizes;
// instr.SetInstructionOpsize;
// instr.CheckOperandSizes;
if instr.labeled then
instr.ConcatLabeledInstr(curlist)
else begin

72
compiler/ncnv.pas
View File

@ -1934,37 +1934,69 @@ implementation
function ttypeconvnode.first_int_to_real: tnode;
var
fname: string[32];
typname : string[12];
begin
{ Get the type name }
{ Normally the typename should be one of the following:
single, double - carl
}
typname := lower(pbestrealtype^.GetTypeName);
{ converting a 64bit integer to a float requires a helper }
if is_64bit(left.resultdef) then
if target_info.system in system_wince then
begin
if is_signed(left.resultdef) then
fname := 'fpc_int64_to_'+typname
{ converting a 64bit integer to a float requires a helper }
if is_64bitint(left.resultdef) or
is_currency(left.resultdef) then
begin
{ hack to avoid double division by 10000, as it's
already done by typecheckpass.resultdef_int_to_real }
if is_currency(left.resultdef) then
left.resultdef := s64inttype;
if is_signed(left.resultdef) then
fname:='I64TOD'
else
fname:='UI64TOD';
end
else
{$warning generic conversion from int to float does not support unsigned integers}
fname := 'fpc_int64_to_'+typname;
result := ccallnode.createintern(fname,ccallparanode.create(
{ other integers are supposed to be 32 bit }
begin
if is_signed(left.resultdef) then
fname:='ITOD'
else
fname:='UTOD';
firstpass(left);
end;
result:=ccallnode.createintern(fname,ccallparanode.create(
left,nil));
left:=nil;
firstpass(result);
exit;
end
else
{ other integers are supposed to be 32 bit }
begin
{$warning generic conversion from int to float does not support unsigned integers}
if is_signed(left.resultdef) then
fname := 'fpc_longint_to_'+typname
{ converting a 64bit integer to a float requires a helper }
if is_64bitint(left.resultdef) or
is_currency(left.resultdef) then
begin
{ hack to avoid double division by 10000, as it's
already done by typecheckpass.resultdef_int_to_real }
if is_currency(left.resultdef) then
left.resultdef := s64inttype;
if is_signed(left.resultdef) then
fname:='int64_to_'
else
{ we can't do better currently }
fname:='int64_to_';
end
else
fname := 'fpc_longint_to_'+typname;
result := ccallnode.createintern(fname,ccallparanode.create(
left,nil));
{ other integers are supposed to be 32 bit }
begin
if is_signed(left.resultdef) then
fname:='int32_to_'
else
{ we can't do better currently }
fname:='int32_to_';
firstpass(left);
end;
if tfloatdef(resultdef).floattype=s64real then
fname:=fname+'float64'
else
fname:=fname+'float32';
result:=ctypeconvnode.create_internal(ccallnode.createintern(fname,ccallparanode.create(
left,nil)),resultdef);
left:=nil;
firstpass(result);
exit;

5
compiler/options.pas
View File

@ -1899,6 +1899,9 @@ begin
def_system_macro('CPU68K');
def_system_macro('CPUM68K');
def_system_macro('CPU32');
def_system_macro('FPC_HAS_TYPE_DOUBLE');
def_system_macro('FPC_HAS_TYPE_SINGLE');
def_system_macro('FPC_INCLUDE_SOFTWARE_INT64_TO_DOUBLE');
def_system_macro('FPC_CURRENCY_IS_INT64');
def_system_macro('FPC_COMP_IS_INT64');
{$endif}
@ -2179,7 +2182,7 @@ begin
exclude(init_settings.globalswitches,cs_link_strip);
{ force fpu emulation on arm/wince and arm/gba }
if target_info.system in [system_arm_wince,system_arm_gba] then
if target_info.system in [system_arm_wince,system_arm_gba,system_m68k_amiga] then
include(init_settings.moduleswitches,cs_fp_emulation);
{ Section smartlinking conflicts with import sections on Windows }

8
compiler/systems/t_amiga.pas
View File

@ -242,12 +242,12 @@ end;
*****************************************************************************}
initialization
{$ifdef cpu68}
{$ifdef m68k}
{$warning No executable creation support for m68k yet!}
RegisterTarget(system_m68k_Amiga_info);
{$endif cpu68}
{$ifdef cpupowerpc}
{$endif m68k}
{$ifdef powerpc}
RegisterExternalLinker(system_powerpc_Amiga_info,TLinkerAmiga);
RegisterTarget(system_powerpc_Amiga_info);
{$endif cpupowerpc}
{$endif powerpc}
end.

37
rtl/amiga/system.pp
View File

@ -24,6 +24,12 @@ interface
{$I systemh.inc}
{$ifdef cpum68k}
{$define fpc_softfpu_interface}
{$i softfpu.pp}
{$undef fpc_softfpu_interface}
{$endif cpum68k}
const
LineEnding = #10;
LFNSupport = True;
@ -32,7 +38,7 @@ const
PathSeparator = ';';
maxExitCode = 255;
MaxPathLen = 256;
const
UnusedHandle : LongInt = -1;
StdInputHandle : LongInt = 0;
@ -74,6 +80,25 @@ var
implementation
{$ifdef cpum68k}
{$define fpc_softfpu_implementation}
{$i softfpu.pp}
{$undef fpc_softfpu_implementation}
{ we get these functions and types from the softfpu code }
{$define FPC_SYSTEM_HAS_float64}
{$define FPC_SYSTEM_HAS_float32}
{$define FPC_SYSTEM_HAS_flag}
{$define FPC_SYSTEM_HAS_extractFloat64Frac0}
{$define FPC_SYSTEM_HAS_extractFloat64Frac1}
{$define FPC_SYSTEM_HAS_extractFloat64Exp}
{$define FPC_SYSTEM_HAS_extractFloat64Frac}
{$define FPC_SYSTEM_HAS_extractFloat64Sign}
{$define FPC_SYSTEM_HAS_ExtractFloat32Frac}
{$define FPC_SYSTEM_HAS_extractFloat32Exp}
{$define FPC_SYSTEM_HAS_extractFloat32Sign}
{$endif cpum68k}
{$I system.inc}
{$IFDEF MOSFPC_FILEDEBUG}
@ -164,7 +189,7 @@ begin
argc:=0;
exit;
end;
{ Handle the other args }
count:=0;
{ first index is one }
@ -182,7 +207,7 @@ begin
inc(localindex);
end;
end;
argc:=localindex;
argc:=localindex;
end;
function GetProgDir: String;
@ -214,7 +239,7 @@ var
begin
GetProgramName:='';
FillChar(s1,255,#0);
if GetProgramName(@s1[1],255) then begin
{ now check out and assign the length of the string }
counter := 1;
@ -292,7 +317,7 @@ begin
iDOS := GetInterface(AOS_DOSBase,'main',1,nil);
iUtility := GetInterface(AOS_UtilityBase,'main',1,nil);
{$ENDIF}
{ Creating the memory pool for growing heap }
AOS_heapPool:=CreatePool(MEMF_FAST,growheapsize2,growheapsize1);
if AOS_heapPool=nil then Halt(1);
@ -318,7 +343,7 @@ begin
OpenStdIO(StdOut,fmOutput,StdOutputHandle);
{ * AmigaOS doesn't have a separate stderr * }
StdErrorHandle:=StdOutputHandle;
//OpenStdIO(StdErr,fmOutput,StdErrorHandle);
//OpenStdIO(ErrOutput,fmOutput,StdErrorHandle);

4
rtl/inc/softfpu.pp
View File

@ -1560,9 +1560,9 @@ function float64_is_nan(a: float64): flag;
*----------------------------------------------------------------------------*)
function float64_is_signaling_nan( a:float64): flag;
begin
float64_is_signaling_nan := flag
float64_is_signaling_nan := flag(
( ( ( a.high shr 19 ) and $FFF ) = $FFE )
and ( (a.low<>0) or ( boolean(( a.high and $0007FFFF )<>0)) );
and ( (a.low<>0) or ( ( a.high and $0007FFFF )<>0) ));
end;

11
rtl/inc/systemh.inc
View File

@ -110,15 +110,8 @@ Type
ValReal = Real;
{$define SUPPORT_SINGLE}
{$IFDEF Unix}
{ Linux FPU emulator will be used }
{$define SUPPORT_DOUBLE}
{$ENDIF}
{$IFOPT E-}
{ If not compiling with emulation }
{ then support double type. }
{$define SUPPORT_DOUBLE}
{$ENDIF}
{$define SUPPORT_DOUBLE}
{ Comp type does not exist on fpu }
Comp = int64;
PComp = ^Comp;