diff options
Diffstat (limited to 'compiler')
54 files changed, 1626 insertions, 1094 deletions
diff --git a/compiler/aggas.pas b/compiler/aggas.pas index 2a10185f75..5d2364df0b 100644 --- a/compiler/aggas.pas +++ b/compiler/aggas.pas @@ -763,7 +763,8 @@ implementation asmwrite(ReplaceForbiddenAsmSymbolChars(tai_datablock(hp).sym.name)); asmwrite(','); asmwrite(tostr(tai_datablock(hp).size)+','); - asmwrite('_data.bss_'); + asmwrite('_data.bss_,'); + asmwriteln(tostr(last_align)); end; end else diff --git a/compiler/arm/aoptcpu.pas b/compiler/arm/aoptcpu.pas index 229a63816f..4bb4299bf6 100644 --- a/compiler/arm/aoptcpu.pas +++ b/compiler/arm/aoptcpu.pas @@ -30,7 +30,7 @@ Unit aoptcpu; Interface -uses cgbase, cpubase, aasmtai, aasmcpu,aopt, aoptobj; +uses cgbase, cgutils, cpubase, aasmtai, aasmcpu,aopt, aoptobj; Type TCpuAsmOptimizer = class(TAsmOptimizer) @@ -49,7 +49,8 @@ Type change in program flow. If there is none, it returns false and sets p1 to nil } - Function GetNextInstructionUsingReg(Current: tai; Var Next: tai;reg : TRegister): Boolean; + Function GetNextInstructionUsingReg(Current: tai; Out Next: tai; reg: TRegister): Boolean; + Function GetNextInstructionUsingRef(Current: tai; Out Next: tai; const ref: TReference; StopOnStore: Boolean = true): Boolean; { outputs a debug message into the assembler file } procedure DebugMsg(const s: string; p: tai); @@ -79,7 +80,7 @@ Implementation cutils,verbose,globtype,globals, systems, cpuinfo, - cgobj,cgutils,procinfo, + cgobj,procinfo, aasmbase,aasmdata; function CanBeCond(p : tai) : boolean; @@ -317,15 +318,39 @@ Implementation RegLoadedWithNewValue(reg,p); end; - function TCpuAsmOptimizer.GetNextInstructionUsingReg(Current: tai; - var Next: tai; reg: TRegister): Boolean; + Out Next: tai; reg: TRegister): Boolean; + begin + Next:=Current; + repeat + Result:=GetNextInstruction(Next,Next); + until not (Result) or + not(cs_opt_level3 in current_settings.optimizerswitches) or + (Next.typ<>ait_instruction) or + RegInInstruction(reg,Next) or + is_calljmp(taicpu(Next).opcode) or + RegModifiedByInstruction(NR_PC,Next); + end; + + function TCpuAsmOptimizer.GetNextInstructionUsingRef(Current: tai; + Out Next: tai; const ref: TReference; StopOnStore: Boolean = true): Boolean; begin Next:=Current; repeat Result:=GetNextInstruction(Next,Next); - until not(cs_opt_level3 in current_settings.optimizerswitches) or not(Result) or (Next.typ<>ait_instruction) or (RegInInstruction(reg,Next)) or - (is_calljmp(taicpu(Next).opcode)) or (RegInInstruction(NR_PC,Next)); + if Result and + (Next.typ=ait_instruction) and + (taicpu(Next).opcode in [A_LDR, A_STR]) and + RefsEqual(taicpu(Next).oper[1]^.ref^,ref) then + {We've found an instruction LDR or STR with the same reference} + exit; + until not(Result) or + (Next.typ<>ait_instruction) or + not(cs_opt_level3 in current_settings.optimizerswitches) or + is_calljmp(taicpu(Next).opcode) or + (StopOnStore and (taicpu(Next).opcode in [A_STR, A_STM])) or + RegModifiedByInstruction(NR_PC,Next); + Result:=false; end; {$ifdef DEBUG_AOPTCPU} @@ -609,10 +634,13 @@ Implementation } if (taicpu(p).oper[1]^.ref^.addressmode=AM_OFFSET) and (taicpu(p).oppostfix=PF_None) and - GetNextInstruction(p,hp1) and - MatchInstruction(hp1, A_LDR, [taicpu(p).condition, C_None], [PF_None]) and - RefsEqual(taicpu(p).oper[1]^.ref^,taicpu(hp1).oper[1]^.ref^) and - (taicpu(hp1).oper[1]^.ref^.addressmode=AM_OFFSET) then + (taicpu(p).condition=C_None) and + GetNextInstructionUsingRef(p,hp1,taicpu(p).oper[1]^.ref^) and + MatchInstruction(hp1, A_LDR, [taicpu(p).condition], [PF_None]) and + (taicpu(hp1).oper[1]^.ref^.addressmode=AM_OFFSET) and + not(RegModifiedBetween(taicpu(p).oper[0]^.reg, p, hp1)) and + ((taicpu(hp1).oper[1]^.ref^.index=NR_NO) or not (RegModifiedBetween(taicpu(hp1).oper[1]^.ref^.index, p, hp1))) and + ((taicpu(hp1).oper[1]^.ref^.base=NR_NO) or not (RegModifiedBetween(taicpu(hp1).oper[1]^.ref^.base, p, hp1))) then begin if taicpu(hp1).oper[0]^.reg=taicpu(p).oper[0]^.reg then begin @@ -1583,13 +1611,14 @@ Implementation and reg1,reg0,2^n-1 mov reg2,reg1, lsl imm1 => - mov reg2,reg1, lsl imm1 + mov reg2,reg0, lsl imm1 if imm1>i } - else if i>32-taicpu(hp1).oper[2]^.shifterop^.shiftimm then + else if (i>32-taicpu(hp1).oper[2]^.shifterop^.shiftimm) and + not(RegModifiedBetween(taicpu(p).oper[1]^.reg, p, hp1)) then begin DebugMsg('Peephole AndLsl2Lsl done', p); - taicpu(hp1).oper[1]^.reg:=taicpu(p).oper[0]^.reg; + taicpu(hp1).oper[1]^.reg:=taicpu(p).oper[1]^.reg; GetNextInstruction(p, hp1); asml.Remove(p); p.free; @@ -2435,7 +2464,10 @@ Implementation { first instruction might not change the register used as index } ((taicpu(hp1).oper[1]^.ref^.index=NR_NO) or not(RegModifiedByInstruction(taicpu(hp1).oper[1]^.ref^.index,p)) - ) then + ) and + { if we modify the basereg AND the first instruction used that reg, we can not schedule } + ((taicpu(hp1).oper[1]^.ref^.addressmode = AM_OFFSET) or + not(instructionLoadsFromReg(taicpu(hp1).oper[1]^.ref^.base,p))) then begin hp3:=tai(p.Previous); hp5:=tai(p.next); diff --git a/compiler/arm/cgcpu.pas b/compiler/arm/cgcpu.pas index d8721b9ad8..a41aef9a0b 100644 --- a/compiler/arm/cgcpu.pas +++ b/compiler/arm/cgcpu.pas @@ -93,7 +93,6 @@ unit cgcpu; function handle_load_store(list:TAsmList;op: tasmop;oppostfix : toppostfix;reg:tregister;ref: treference):treference; virtual; procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override; - procedure g_stackpointer_alloc(list : TAsmList;size : longint);override; procedure a_loadmm_reg_reg(list: TAsmList; fromsize, tosize : tcgsize;reg1, reg2: tregister;shuffle : pmmshuffle); override; procedure a_loadmm_ref_reg(list: TAsmList; fromsize, tosize : tcgsize;const ref: treference; reg: tregister;shuffle : pmmshuffle); override; @@ -2896,12 +2895,6 @@ unit cgcpu; end; - procedure tbasecgarm.g_stackpointer_alloc(list: TAsmList; size: longint); - begin - internalerror(200807237); - end; - - function get_scalar_mm_op(fromsize,tosize : tcgsize) : tasmop; const convertop : array[OS_F32..OS_F128,OS_F32..OS_F128] of tasmop = ( diff --git a/compiler/arm/narmadd.pas b/compiler/arm/narmadd.pas index 7083067a42..426622c567 100644 --- a/compiler/arm/narmadd.pas +++ b/compiler/arm/narmadd.pas @@ -403,6 +403,8 @@ interface oldnodetype : tnodetype; dummyreg : tregister; l: tasmlabel; + const + lt_zero_swapped: array[boolean] of tnodetype = (ltn, gtn); begin unsigned:=not(is_signed(left.resultdef)) or not(is_signed(right.resultdef)); @@ -411,20 +413,34 @@ interface { pass_left_right moves possible consts to the right, the only remaining case with left consts (currency) can take this path too (KB) } - if (nodetype in [equaln,unequaln]) and - (right.nodetype=ordconstn) and (tordconstnode(right).value=0) then + if (right.nodetype=ordconstn) and + (tordconstnode(right).value=0) and + ((nodetype in [equaln,unequaln]) or + (not(GenerateThumbCode) and is_signed(left.resultdef) and (nodetype = lt_zero_swapped[nf_swapped in Flags])) + ) then begin location_reset(location,LOC_FLAGS,OS_NO); - location.resflags:=getresflags(unsigned); if not(left.location.loc in [LOC_CREGISTER,LOC_REGISTER]) then hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true); - dummyreg:=cg.getintregister(current_asmdata.CurrAsmList,location.size); - cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS); - if GenerateThumbCode then - cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,left.location.register64.reglo,left.location.register64.reghi,dummyreg) + cg.a_reg_alloc(current_asmdata.CurrAsmList,NR_DEFAULTFLAGS); + { Optimize for the common case of int64 < 0 } + if nodetype in [ltn, gtn] then + begin + {Just check for the MSB in reghi to be set or not, this is independed from nf_swapped} + location.resflags:=F_NE; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_const(A_TST,left.location.register64.reghi, $80000000)); + end else - current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ORR,dummyreg,left.location.register64.reglo,left.location.register64.reghi),PF_S)); + begin + location.resflags:=getresflags(unsigned); + dummyreg:=cg.getintregister(current_asmdata.CurrAsmList,location.size); + + if GenerateThumbCode then + cg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_OR,OS_32,left.location.register64.reglo,left.location.register64.reghi,dummyreg) + else + current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg_reg(A_ORR,dummyreg,left.location.register64.reglo,left.location.register64.reghi),PF_S)); + end; end else begin diff --git a/compiler/arm/rgcpu.pas b/compiler/arm/rgcpu.pas index dc669bda0c..6abb198ff8 100644 --- a/compiler/arm/rgcpu.pas +++ b/compiler/arm/rgcpu.pas @@ -290,6 +290,10 @@ unit rgcpu; if abs(spilltemp.offset)>4095 then exit; + { ldr can't set the flags } + if taicpu(instr).oppostfix=PF_S then + exit; + if GenerateThumbCode and (abs(spilltemp.offset)>1020) then exit; diff --git a/compiler/avr/cgcpu.pas b/compiler/avr/cgcpu.pas index 0eb03d18b1..7e0fe18a09 100644 --- a/compiler/avr/cgcpu.pas +++ b/compiler/avr/cgcpu.pas @@ -99,14 +99,12 @@ unit cgcpu; tmpreg : tregister) : treference; procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override; - procedure g_stackpointer_alloc(list : TAsmList;size : longint);override; procedure emit_mov(list: TAsmList;reg2: tregister; reg1: tregister); procedure a_adjust_sp(list: TAsmList; value: longint); function GetLoad(const ref : treference) : tasmop; function GetStore(const ref: treference): tasmop; - procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); override; protected procedure a_op_reg_reg_internal(list: TAsmList; Op: TOpCG; size: TCGSize; src, srchi, dst, dsthi: TRegister); procedure a_op_const_reg_internal(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; reg, reghi: TRegister); @@ -1378,12 +1376,6 @@ unit cgcpu; end; - procedure tcgavr.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); - begin - Comment(V_Error,'tcgarm.a_bit_scan_reg_reg method not implemented'); - end; - - procedure tcgavr.a_jmp_name(list : TAsmList;const s : string); var ai : taicpu; @@ -1883,12 +1875,6 @@ unit cgcpu; end; - procedure tcgavr.g_stackpointer_alloc(list: TAsmList; size: longint); - begin - internalerror(201201071); - end; - - procedure tcgavr.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint); begin //internalerror(2011021324); diff --git a/compiler/cclasses.pas b/compiler/cclasses.pas index 0930634cb4..7fda9b697c 100644 --- a/compiler/cclasses.pas +++ b/compiler/cclasses.pas @@ -508,14 +508,14 @@ type destructor Destroy; override; procedure Clear; { finds an entry by key } - function Find(Key: Pointer; KeyLen: Integer): PHashSetItem; + function Find(Key: Pointer; KeyLen: Integer): PHashSetItem;virtual; { finds an entry, creates one if not exists } function FindOrAdd(Key: Pointer; KeyLen: Integer; - var Found: Boolean): PHashSetItem; + var Found: Boolean): PHashSetItem;virtual; { finds an entry, creates one if not exists } - function FindOrAdd(Key: Pointer; KeyLen: Integer): PHashSetItem; + function FindOrAdd(Key: Pointer; KeyLen: Integer): PHashSetItem;virtual; { returns Data by given Key } - function Get(Key: Pointer; KeyLen: Integer): TObject; + function Get(Key: Pointer; KeyLen: Integer): TObject;virtual; { removes an entry, returns False if entry wasn't there } function Remove(Entry: PHashSetItem): Boolean; property Count: LongWord read FCount; diff --git a/compiler/cgobj.pas b/compiler/cgobj.pas index 9c6b49481f..96a5a008b2 100644 --- a/compiler/cgobj.pas +++ b/compiler/cgobj.pas @@ -248,7 +248,7 @@ unit cgobj; procedure a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);virtual; abstract; { bit scan instructions } - procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: tcgsize; src, dst: TRegister); virtual; abstract; + procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: tcgsize; src, dst: TRegister); virtual; { Multiplication with doubling result size. dstlo or dsthi may be NR_NO, in which case corresponding half of result is discarded. } @@ -413,7 +413,7 @@ unit cgobj; @param(size Number of bytes to allocate) } - procedure g_stackpointer_alloc(list : TAsmList;size : longint);virtual; abstract; + procedure g_stackpointer_alloc(list : TAsmList;size : longint);virtual; {# Emits instruction for allocating the locals in entry code of a routine. This is one of the first routine called in @var(genentrycode). @@ -2516,6 +2516,18 @@ implementation end; + procedure tcg.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: tcgsize; src, dst: TRegister); + begin + internalerror(2014070601); + end; + + + procedure tcg.g_stackpointer_alloc(list: TAsmList; size: longint); + begin + internalerror(2014070602); + end; + + procedure tcg.a_mul_reg_reg_pair(list: TAsmList; size: TCgSize; src1,src2,dstlo,dsthi: TRegister); begin internalerror(2014060801); diff --git a/compiler/defutil.pas b/compiler/defutil.pas index 16672641fc..ab84dfc00c 100644 --- a/compiler/defutil.pas +++ b/compiler/defutil.pas @@ -331,21 +331,6 @@ interface { returns true of def is a methodpointer } function is_methodpointer(def : tdef) : boolean; - {# returns the appropriate int type for pointer arithmetic with the given pointer type. - When adding or subtracting a number to/from a pointer, this function returns the - int type to which that number has to be converted, before the operation can be performed. - Normally, this is sinttype, except on i8086, where it takes into account the - special i8086 pointer types (near, far, huge). } - function get_int_type_for_pointer_arithmetic(p : tdef) : tdef; - -{$ifdef i8086} - {# Returns true if p is a far pointer def } - function is_farpointer(p : tdef) : boolean; - - {# Returns true if p is a huge pointer def } - function is_hugepointer(p : tdef) : boolean; -{$endif i8086} - implementation uses @@ -1440,29 +1425,4 @@ implementation result:=(def.typ=procvardef) and (po_methodpointer in tprocvardef(def).procoptions); end; - - function get_int_type_for_pointer_arithmetic(p : tdef) : tdef; - begin -{$ifdef i8086} - if is_hugepointer(p) then - result:=s32inttype - else -{$endif i8086} - result:=sinttype; - end; - -{$ifdef i8086} - { true if p is a far pointer def } - function is_farpointer(p : tdef) : boolean; - begin - result:=(p.typ=pointerdef) and (tcpupointerdef(p).x86pointertyp=x86pt_far); - end; - - { true if p is a huge pointer def } - function is_hugepointer(p : tdef) : boolean; - begin - result:=(p.typ=pointerdef) and (tcpupointerdef(p).x86pointertyp=x86pt_huge); - end; -{$endif i8086} - end. diff --git a/compiler/fmodule.pas b/compiler/fmodule.pas index c3e5dcea2a..8c14b847c8 100644 --- a/compiler/fmodule.pas +++ b/compiler/fmodule.pas @@ -44,7 +44,7 @@ interface uses cutils,cclasses,cfileutl, globtype,finput,ogbase, - symbase,symsym, + symbase,symconst,symsym,symcpu, wpobase, aasmbase,aasmtai,aasmdata; @@ -142,7 +142,7 @@ interface checkforwarddefs, deflist, symlist : TFPObjectList; - ptrdefs : THashSet; { list of pointerdefs created in this module so we can reuse them (not saved/restored) } + ptrdefs : tPtrDefHashSet; { list of pointerdefs created in this module so we can reuse them (not saved/restored) } arraydefs : THashSet; { list of single-element-arraydefs created in this module so we can reuse them (not saved/restored) } {$ifdef llvm} llvmdefs : THashSet; { defs added for llvm-specific reasons (not saved/restored) } @@ -570,7 +570,7 @@ implementation derefdataintflen:=0; deflist:=TFPObjectList.Create(false); symlist:=TFPObjectList.Create(false); - ptrdefs:=THashSet.Create(64,true,false); + ptrdefs:=cPtrDefHashSet.Create; arraydefs:=THashSet.Create(64,true,false); {$ifdef llvm} llvmdefs:=THashSet.Create(64,true,false); @@ -753,7 +753,7 @@ implementation symlist.free; symlist:=TFPObjectList.Create(false); ptrdefs.free; - ptrdefs:=THashSet.Create(64,true,false); + ptrdefs:=cPtrDefHashSet.Create; arraydefs.free; arraydefs:=THashSet.Create(64,true,false); {$ifdef llvm} diff --git a/compiler/i386/n386add.pas b/compiler/i386/n386add.pas index 3f42b639c8..257c897d4b 100644 --- a/compiler/i386/n386add.pas +++ b/compiler/i386/n386add.pas @@ -229,8 +229,7 @@ interface procedure ti386addnode.second_cmp64bit; var - hregister, - hregister2 : tregister; + hlab : tasmlabel; href : treference; unsigned : boolean; @@ -247,10 +246,12 @@ interface case nodetype of ltn,gtn: begin - cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrTrueLabel); + if (hlab<>current_procinfo.CurrTrueLabel) then + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrTrueLabel); { cheat a little bit for the negative test } toggleflag(nf_swapped); - cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrFalseLabel); + if (hlab<>current_procinfo.CurrFalseLabel) then + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrFalseLabel); toggleflag(nf_swapped); end; lten,gten: @@ -260,13 +261,15 @@ interface nodetype:=ltn else nodetype:=gtn; - cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrTrueLabel); + if (hlab<>current_procinfo.CurrTrueLabel) then + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrTrueLabel); { cheat for the negative test } if nodetype=ltn then nodetype:=gtn else nodetype:=ltn; - cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrFalseLabel); + if (hlab<>current_procinfo.CurrFalseLabel) then + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrFalseLabel); nodetype:=oldnodetype; end; equaln: @@ -309,24 +312,46 @@ interface ((right.resultdef.typ=orddef) and (torddef(right.resultdef).ordtype=u64bit)); + { we have LOC_JUMP as result } + location_reset(location,LOC_JUMP,OS_NO); + + { Relational compares against constants having low dword=0 can omit the + second compare based on the fact that any unsigned value is >=0 } + hlab:=nil; + if (right.location.loc=LOC_CONSTANT) and + (lo(right.location.value64)=0) then + begin + case getresflags(true) of + F_AE: hlab:=current_procinfo.CurrTrueLabel; + F_B: hlab:=current_procinfo.CurrFalseLabel; + end; + end; + + if (right.location.loc=LOC_CONSTANT) and + (left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then + begin + tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,left.location.reference); + href:=left.location.reference; + inc(href.offset,4); + emit_const_ref(A_CMP,S_L,aint(hi(right.location.value64)),href); + firstjmp64bitcmp; + if assigned(hlab) then + cg.a_jmp_always(current_asmdata.CurrAsmList,hlab) + else + begin + emit_const_ref(A_CMP,S_L,aint(lo(right.location.value64)),left.location.reference); + secondjmp64bitcmp; + end; + location_freetemp(current_asmdata.CurrAsmList,left.location); + exit; + end; + { left and right no register? } { then one must be demanded } - if (left.location.loc<>LOC_REGISTER) then + if not (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then begin - if (right.location.loc<>LOC_REGISTER) then - begin - { we can reuse a CREGISTER for comparison } - if (left.location.loc<>LOC_CREGISTER) then - begin - hregister:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); - hregister2:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); - cg64.a_load64_loc_reg(current_asmdata.CurrAsmList,left.location,joinreg64(hregister,hregister2)); - location_freetemp(current_asmdata.CurrAsmList,left.location); - location_reset(left.location,LOC_REGISTER,left.location.size); - left.location.register64.reglo:=hregister; - left.location.register64.reghi:=hregister2; - end; - end + if not (right.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then + hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true) else begin location_swap(left.location,right.location); @@ -334,51 +359,44 @@ interface end; end; - { at this point, left.location.loc should be LOC_REGISTER } - if right.location.loc=LOC_REGISTER then - begin - emit_reg_reg(A_CMP,S_L,right.location.register64.reghi,left.location.register64.reghi); - firstjmp64bitcmp; - emit_reg_reg(A_CMP,S_L,right.location.register64.reglo,left.location.register64.reglo); - secondjmp64bitcmp; - end + { at this point, left.location.loc should be LOC_[C]REGISTER } + case right.location.loc of + LOC_REGISTER, + LOC_CREGISTER : + begin + emit_reg_reg(A_CMP,S_L,right.location.register64.reghi,left.location.register64.reghi); + firstjmp64bitcmp; + emit_reg_reg(A_CMP,S_L,right.location.register64.reglo,left.location.register64.reglo); + secondjmp64bitcmp; + end; + LOC_CREFERENCE, + LOC_REFERENCE : + begin + tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,right.location.reference); + href:=right.location.reference; + inc(href.offset,4); + emit_ref_reg(A_CMP,S_L,href,left.location.register64.reghi); + firstjmp64bitcmp; + emit_ref_reg(A_CMP,S_L,right.location.reference,left.location.register64.reglo); + secondjmp64bitcmp; + location_freetemp(current_asmdata.CurrAsmList,right.location); + end; + LOC_CONSTANT : + begin + current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_CMP,S_L,aint(hi(right.location.value64)),left.location.register64.reghi)); + firstjmp64bitcmp; + if assigned(hlab) then + cg.a_jmp_always(current_asmdata.CurrAsmList,hlab) + else + begin + current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_CMP,S_L,aint(lo(right.location.value64)),left.location.register64.reglo)); + secondjmp64bitcmp; + end; + end; else - begin - case right.location.loc of - LOC_CREGISTER : - begin - emit_reg_reg(A_CMP,S_L,right.location.register64.reghi,left.location.register64.reghi); - firstjmp64bitcmp; - emit_reg_reg(A_CMP,S_L,right.location.register64.reglo,left.location.register64.reglo); - secondjmp64bitcmp; - end; - LOC_CREFERENCE, - LOC_REFERENCE : - begin - tcgx86(cg).make_simple_ref(current_asmdata.CurrAsmList,right.location.reference); - href:=right.location.reference; - inc(href.offset,4); - emit_ref_reg(A_CMP,S_L,href,left.location.register64.reghi); - firstjmp64bitcmp; - emit_ref_reg(A_CMP,S_L,right.location.reference,left.location.register64.reglo); - secondjmp64bitcmp; - cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel); - location_freetemp(current_asmdata.CurrAsmList,right.location); - end; - LOC_CONSTANT : - begin - current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_CMP,S_L,aint(hi(right.location.value64)),left.location.register64.reghi)); - firstjmp64bitcmp; - current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_CMP,S_L,aint(lo(right.location.value64)),left.location.register64.reglo)); - secondjmp64bitcmp; - end; - else - internalerror(200203282); - end; - end; + internalerror(200203282); + end; - { we have LOC_JUMP as result } - location_reset(location,LOC_JUMP,OS_NO) end; diff --git a/compiler/i386/symcpu.pas b/compiler/i386/symcpu.pas index 9fbc65bab5..9e88944f3e 100644 --- a/compiler/i386/symcpu.pas +++ b/compiler/i386/symcpu.pas @@ -207,5 +207,7 @@ begin cconstsym:=tcpuconstsym; cenumsym:=tcpuenumsym; csyssym:=tcpusyssym; + + cPtrDefHashSet:=tx86PtrDefHashSet; end. diff --git a/compiler/i8086/n8086add.pas b/compiler/i8086/n8086add.pas index 6987a9c0eb..6e99387d3e 100644 --- a/compiler/i8086/n8086add.pas +++ b/compiler/i8086/n8086add.pas @@ -39,11 +39,13 @@ interface function first_addhugepointer: tnode; function first_cmppointer: tnode; override; function first_cmphugepointer: tnode; + function first_cmpfarpointer: tnode; procedure second_addordinal; override; procedure second_add64bit;override; procedure second_addfarpointer; procedure second_cmp64bit;override; procedure second_cmp32bit; + procedure second_cmpfarpointer; procedure second_cmpordinal;override; procedure second_mul(unsigned: boolean); end; @@ -53,7 +55,7 @@ interface uses globtype,systems, cutils,verbose,globals,constexp,pass_1, - symconst,symdef,symtype,paramgr,defutil, + symconst,symdef,symtype,symcpu,paramgr,defutil, aasmbase,aasmtai,aasmdata,aasmcpu, cgbase,procinfo, ncal,ncon,nset,cgutils,tgobj, @@ -314,7 +316,7 @@ interface function ti8086addnode.first_addpointer: tnode; begin - if is_hugepointer(left.resultdef) xor is_hugepointer(right.resultdef) then + if is_hugepointer(left.resultdef) or is_hugepointer(right.resultdef) then result:=first_addhugepointer else result:=inherited; @@ -327,17 +329,22 @@ interface begin result:=nil; - case nodetype of - addn: - procname:='fpc_hugeptr_add_longint'; - subn: - procname:='fpc_hugeptr_sub_longint'; - else - internalerror(2014070301); - end; + if (nodetype=subn) and is_hugepointer(left.resultdef) and is_hugepointer(right.resultdef) then + procname:='fpc_hugeptr_sub_hugeptr' + else + begin + case nodetype of + addn: + procname:='fpc_hugeptr_add_longint'; + subn: + procname:='fpc_hugeptr_sub_longint'; + else + internalerror(2014070301); + end; - if cs_hugeptr_arithmetic_normalization in current_settings.localswitches then - procname:=procname+'_normalized'; + if cs_hugeptr_arithmetic_normalization in current_settings.localswitches then + procname:=procname+'_normalized'; + end; if is_hugepointer(left.resultdef) then result := ccallnode.createintern(procname, @@ -357,6 +364,8 @@ interface begin if is_hugepointer(left.resultdef) or is_hugepointer(right.resultdef) then result:=first_cmphugepointer + else if is_farpointer(left.resultdef) or is_farpointer(right.resultdef) then + result:=first_cmpfarpointer else result:=inherited; end; @@ -370,7 +379,7 @@ interface if not (cs_hugeptr_comparison_normalization in current_settings.localswitches) then begin - expectloc:=LOC_FLAGS; + expectloc:=LOC_JUMP; exit; end; @@ -400,6 +409,22 @@ interface end; + function ti8086addnode.first_cmpfarpointer: tnode; + begin + { = and <> are handled as a 32-bit comparison } + if nodetype in [equaln,unequaln] then + begin + result:=nil; + expectloc:=LOC_JUMP; + end + else + begin + result:=nil; + expectloc:=LOC_FLAGS; + end; + end; + + procedure ti8086addnode.second_addfarpointer; var tmpreg : tregister; @@ -786,7 +811,8 @@ interface unsigned:=((left.resultdef.typ=orddef) and (torddef(left.resultdef).ordtype=u32bit)) or ((right.resultdef.typ=orddef) and - (torddef(right.resultdef).ordtype=u32bit)); + (torddef(right.resultdef).ordtype=u32bit)) or + is_hugepointer(left.resultdef); { left and right no register? } { then one must be demanded } @@ -859,9 +885,60 @@ interface location_reset(location,LOC_JUMP,OS_NO) end; + + procedure ti8086addnode.second_cmpfarpointer; + begin + { handle = and <> as a 32-bit comparison } + if nodetype in [equaln,unequaln] then + begin + second_cmp32bit; + exit; + end; + + pass_left_right; + + { <, >, <= and >= compare the 16-bit offset only } + if (right.location.loc=LOC_CONSTANT) and + (left.location.loc in [LOC_REFERENCE, LOC_CREFERENCE]) + then + begin + emit_const_ref(A_CMP, S_W, word(right.location.value), left.location.reference); + location_freetemp(current_asmdata.CurrAsmList,left.location); + end + else + begin + { left location is not a register? } + if left.location.loc<>LOC_REGISTER then + begin + { if right is register then we can swap the locations } + if right.location.loc=LOC_REGISTER then + begin + location_swap(left.location,right.location); + toggleflag(nf_swapped); + end + else + begin + { maybe we can reuse a constant register when the + operation is a comparison that doesn't change the + value of the register } + hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,u16inttype,true); + end; + end; + + emit_generic_code(A_CMP,OS_16,true,false,false); + location_freetemp(current_asmdata.CurrAsmList,right.location); + location_freetemp(current_asmdata.CurrAsmList,left.location); + end; + location_reset(location,LOC_FLAGS,OS_NO); + location.resflags:=getresflags(true); + end; + + procedure ti8086addnode.second_cmpordinal; begin - if is_32bit(left.resultdef) or is_farpointer(left.resultdef) or is_hugepointer(left.resultdef) then + if is_farpointer(left.resultdef) then + second_cmpfarpointer + else if is_32bit(left.resultdef) or is_hugepointer(left.resultdef) then second_cmp32bit else inherited second_cmpordinal; diff --git a/compiler/i8086/n8086inl.pas b/compiler/i8086/n8086inl.pas index e369f53c7f..8329e6b6af 100644 --- a/compiler/i8086/n8086inl.pas +++ b/compiler/i8086/n8086inl.pas @@ -51,7 +51,7 @@ implementation symconst, defutil, aasmbase,aasmtai,aasmdata,aasmcpu, - symtype,symdef, + symtype,symdef,symcpu, cgbase,pass_2, cpuinfo,cpubase,paramgr, nbas,ncon,ncal,ncnv,nld,ncgutil, diff --git a/compiler/i8086/n8086mem.pas b/compiler/i8086/n8086mem.pas index 31c5c96f31..11cce91bc7 100644 --- a/compiler/i8086/n8086mem.pas +++ b/compiler/i8086/n8086mem.pas @@ -44,21 +44,23 @@ interface { tx86vecnode doesn't work for i8086, so we inherit tcgvecnode } ti8086vecnode = class(tcgvecnode) + protected + function first_arraydef: tnode;override; procedure update_reference_reg_mul(maybe_const_reg: tregister; regsize: tdef; l: aint);override; end; implementation uses - systems,globals, + systems,globals,constexp, cutils,verbose, - symbase,symconst,symdef,symtable,symsym,symcpu, + symbase,symconst,symdef,symtable,symsym,symx86,symcpu, parabase,paramgr, aasmtai,aasmdata, - nld,ncon,nadd, + nld,ncon,nadd,ncal,ncnv, cgutils,cgobj, defutil,hlcgobj, - pass_2,ncgutil; + pass_1,pass_2,ncgutil; {***************************************************************************** TI8086ADDRNODE @@ -171,6 +173,46 @@ implementation TI8086VECNODE *****************************************************************************} + function ti8086vecnode.first_arraydef: tnode; + var + arraydef: tcpuarraydef; + procname:string; + begin + if tcpuarraydef(left.resultdef).is_huge then + begin + arraydef:=tcpuarraydef(left.resultdef); + + if not (ado_IsConvertedPointer in arraydef.arrayoptions) then + internalerror(2014080701); + + if left.nodetype<>typeconvn then + internalerror(2014080702); + + procname:='fpc_hugeptr_add_longint'; + if cs_hugeptr_arithmetic_normalization in current_settings.localswitches then + procname:=procname+'_normalized'; + + if arraydef.elementdef.size>1 then + right:=caddnode.create(muln,right, + cordconstnode.create(arraydef.elementdef.size,s32inttype,true)); + + result:=ccallnode.createintern(procname, + ccallparanode.create(right, + ccallparanode.create(ttypeconvnode(left).left,nil))); + inserttypeconv_internal(result,getx86pointerdef(arraydef.elementdef,x86pt_huge)); + result:=cderefnode.create(result); + + ttypeconvnode(left).left:=nil; + ttypeconvnode(left).free; + left := nil; + right := nil; + firstpass(result); + end + else + result:=inherited; + end; + + procedure ti8086vecnode.update_reference_reg_mul(maybe_const_reg: tregister; regsize: tdef; l: aint); var saveseg: TRegister; diff --git a/compiler/i8086/n8086tcon.pas b/compiler/i8086/n8086tcon.pas index 988aac8dc2..86da1e432a 100644 --- a/compiler/i8086/n8086tcon.pas +++ b/compiler/i8086/n8086tcon.pas @@ -42,7 +42,7 @@ interface implementation uses - ncnv,defcmp,defutil,aasmtai; + ncnv,defcmp,defutil,aasmtai,symcpu; { ti8086typedconstbuilder } diff --git a/compiler/i8086/symcpu.pas b/compiler/i8086/symcpu.pas index bc16f8c2e6..9617a45160 100644 --- a/compiler/i8086/symcpu.pas +++ b/compiler/i8086/symcpu.pas @@ -57,6 +57,8 @@ type tcpupointerdef = class(tx86pointerdef) class function default_x86_data_pointer_type: tx86pointertyp; override; + function pointer_arithmetic_int_type:tdef; override; + function pointer_subtraction_result_type:tdef; override; end; tcpupointerdefclass = class of tcpupointerdef; @@ -76,7 +78,19 @@ type end; tcpuclassrefdefclass = class of tcpuclassrefdef; + { tcpuarraydef } + tcpuarraydef = class(tarraydef) + private + huge: Boolean; + protected + procedure ppuload_platform(ppufile: tcompilerppufile); override; + procedure ppuwrite_platform(ppufile: tcompilerppufile); override; + public + constructor create_from_pointer(def:tpointerdef);override; + function getcopy: tstoreddef; override; + function GetTypeName:string;override; + property is_huge: Boolean read huge write huge; end; tcpuarraydefclass = class of tcpuarraydef; @@ -196,11 +210,16 @@ const function is_proc_far(p: tabstractprocdef): boolean; + {# Returns true if p is a far pointer def } + function is_farpointer(p : tdef) : boolean; + + {# Returns true if p is a huge pointer def } + function is_hugepointer(p : tdef) : boolean; implementation uses - globals, cpuinfo, verbose; + globals, cpuinfo, verbose, fmodule; function is_proc_far(p: tabstractprocdef): boolean; @@ -213,6 +232,68 @@ implementation internalerror(2014041301); end; + { true if p is a far pointer def } + function is_farpointer(p : tdef) : boolean; + begin + result:=(p.typ=pointerdef) and (tcpupointerdef(p).x86pointertyp=x86pt_far); + end; + + { true if p is a huge pointer def } + function is_hugepointer(p : tdef) : boolean; + begin + result:=(p.typ=pointerdef) and (tcpupointerdef(p).x86pointertyp=x86pt_huge); + end; + +{**************************************************************************** + tcpuarraydef +****************************************************************************} + + constructor tcpuarraydef.create_from_pointer(def: tpointerdef); + begin + if tcpupointerdef(def).x86pointertyp=x86pt_huge then + begin + huge:=true; + { use -1 so that the elecount will not overflow } + self.create(0,high(asizeint)-1,s32inttype); + arrayoptions:=[ado_IsConvertedPointer]; + setelementdef(def.pointeddef); + end + else + begin + huge:=false; + inherited create_from_pointer(def); + end; + end; + + + function tcpuarraydef.getcopy: tstoreddef; + begin + result:=inherited; + tcpuarraydef(result).huge:=huge; + end; + + + function tcpuarraydef.GetTypeName: string; + begin + Result:=inherited; + if is_huge then + Result:='Huge '+Result; + end; + + + procedure tcpuarraydef.ppuload_platform(ppufile: tcompilerppufile); + begin + inherited; + huge:=(ppufile.getbyte<>0); + end; + + + procedure tcpuarraydef.ppuwrite_platform(ppufile: tcompilerppufile); + begin + inherited; + ppufile.putbyte(byte(huge)); + end; + {**************************************************************************** tcpuprocdef @@ -311,6 +392,28 @@ implementation end; + function tcpupointerdef.pointer_arithmetic_int_type:tdef; + begin + if x86pointertyp=x86pt_huge then + result:=s32inttype + else + result:=inherited; + end; + + + function tcpupointerdef.pointer_subtraction_result_type:tdef; + begin + case x86pointertyp of + x86pt_huge: + result:=s32inttype; + x86pt_far: + result:=u16inttype; + else + result:=inherited; + end; + end; + + {**************************************************************************** tcpuabsolutevarsym ****************************************************************************} @@ -367,5 +470,7 @@ begin cconstsym:=tcpuconstsym; cenumsym:=tcpuenumsym; csyssym:=tcpusyssym; + + cPtrDefHashSet:=tx86PtrDefHashSet; end. diff --git a/compiler/jvm/pjvm.pas b/compiler/jvm/pjvm.pas index fdda300bb6..1550e96a44 100644 --- a/compiler/jvm/pjvm.pas +++ b/compiler/jvm/pjvm.pas @@ -505,6 +505,7 @@ implementation methoddef:=tprocdef(tprocvardef(def).getcopyas(procdef,pc_bareproc)); finish_copied_procdef(methoddef,'invoke',pvclass.symtable,pvclass); insert_self_and_vmt_para(methoddef); + insert_funcret_para(methoddef); methoddef.synthetickind:=tsk_jvm_procvar_invoke; methoddef.calcparas; @@ -539,6 +540,7 @@ implementation methoddef:=tprocdef(tprocvardef(def).getcopyas(procdef,pc_bareproc)); finish_copied_procdef(methoddef,name+'Callback',pvintf.symtable,pvintf); insert_self_and_vmt_para(methoddef); + insert_funcret_para(methoddef); { can't be final/static/private/protected, and must be virtual since it's an interface method } methoddef.procoptions:=methoddef.procoptions-[po_staticmethod,po_finalmethod]; @@ -680,6 +682,7 @@ implementation { since it was a bare copy, insert the self parameter (we can't just copy the vmt parameter from the constructor, that's different) } insert_self_and_vmt_para(wrapperpd); + insert_funcret_para(wrapperpd); wrapperpd.calcparas; { implementation: call through to the constructor Exception: if the current class is abstract, do not call the diff --git a/compiler/m68k/cgcpu.pas b/compiler/m68k/cgcpu.pas index 7446f0aa9b..1edd342d3d 100644 --- a/compiler/m68k/cgcpu.pas +++ b/compiler/m68k/cgcpu.pas @@ -19,7 +19,6 @@ **************************************************************************** } -{$WARNINGS OFF} unit cgcpu; {$i fpcdefs.inc} @@ -109,6 +108,7 @@ unit cgcpu; tcg64f68k = class(tcg64f32) procedure a_op64_reg_reg(list : TAsmList;op:TOpCG; size: tcgsize; regsrc,regdst : tregister64);override; procedure a_op64_const_reg(list : TAsmList;op:TOpCG; size: tcgsize; value : int64;regdst : tregister64);override; + procedure a_op64_ref_reg(list : TAsmList;op:TOpCG;size : tcgsize;const ref : treference;reg : tregister64);override; end; { This function returns true if the reference+offset is valid. @@ -245,6 +245,7 @@ unit cgcpu; address_regs: array of TSuperRegister; begin inherited init_register_allocators; + address_regs:=nil; rg[R_INTREGISTER]:=trgcpu.create(R_INTREGISTER,R_SUBWHOLE, [RS_D0,RS_D1,RS_D2,RS_D3,RS_D4,RS_D5,RS_D6,RS_D7], first_int_imreg,[]); @@ -751,7 +752,11 @@ unit cgcpu; list.concat(taicpu.op_reg(A_CLR,S_L,register)) else begin - if (longint(a) >= low(shortint)) and (longint(a) <= high(shortint)) then + { Prefer MOV3Q if applicable, it allows replacement spilling for register } + if (current_settings.cputype in [cpu_isa_b,cpu_isa_c]) and + ((longint(a)=-1) or ((longint(a)>0) and (longint(a)<8))) then + list.concat(taicpu.op_const_reg(A_MOV3Q,S_L,longint(a),register)) + else if (longint(a) >= low(shortint)) and (longint(a) <= high(shortint)) then list.concat(taicpu.op_const_reg(A_MOVEQ,S_L,longint(a),register)) else begin @@ -786,11 +791,18 @@ unit cgcpu; hreg : tregister; href : treference; begin + a:=longint(a); href:=ref; fixref(list,href); + if (a=0) then + list.concat(taicpu.op_ref(A_CLR,tcgsize2opsize[tosize],href)) + else if (tcgsize2opsize[tosize]=S_L) and + (current_settings.cputype in [cpu_isa_b,cpu_isa_c]) and + ((a=-1) or ((a>0) and (a<8))) then + list.concat(taicpu.op_const_ref(A_MOV3Q,S_L,a,href)) { for coldfire we need to go through a temporary register if we have a offset, index or symbol given } - if (current_settings.cputype in cpu_coldfire) and + else if (current_settings.cputype in cpu_coldfire) and ( (href.offset<>0) or { TODO : check whether we really need this second condition } @@ -923,7 +935,7 @@ unit cgcpu; size:=tosize; list.concat(taicpu.op_ref_reg(A_MOVE,TCGSize2OpSize[size],href,register)); { extend the value in the register } - sign_extend(list, fromsize, register); + sign_extend(list, size, register); end; @@ -1398,6 +1410,13 @@ unit cgcpu; procedure tcg68k.a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); begin + if (current_settings.cputype in cpu_coldfire-[cpu_isa_b,cpu_isa_c]) then + begin + sign_extend(list,size,reg1); + sign_extend(list,size,reg2); + size:=OS_INT; + end; + list.concat(taicpu.op_reg_reg(A_CMP,tcgsize2opsize[size],reg1,reg2)); { emit the actual jump to the label } a_jmp_cond(list,cmp_op,l); @@ -1568,7 +1587,28 @@ unit cgcpu; end; procedure tcg68k.g_overflowcheck(list: TAsmList; const l:tlocation; def:tdef); + var + hl : tasmlabel; + ai : taicpu; + cond : TAsmCond; begin + if not(cs_check_overflow in current_settings.localswitches) then + exit; + current_asmdata.getjumplabel(hl); + if not ((def.typ=pointerdef) or + ((def.typ=orddef) and + (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar, + pasbool8,pasbool16,pasbool32,pasbool64]))) then + cond:=C_VC + else + cond:=C_CC; + ai:=Taicpu.Op_Sym(A_Bxx,S_NO,hl); + ai.SetCondition(cond); + ai.is_jmp:=true; + list.concat(ai); + + a_call_name(list,'FPC_OVERFLOW',false); + a_label(list,hl); end; procedure tcg68k.g_proc_entry(list: TAsmList; localsize: longint; nostackframe:boolean); @@ -1582,13 +1622,13 @@ unit cgcpu; if (localsize < 0) then internalerror(2006122601); - { Not to complicate the code generator too much, and since some } - { of the systems only support this format, the localsize cannot } - { exceed 32K in size. } if (localsize > high(smallint)) then - CGMessage(cg_e_localsize_too_big); - - list.concat(taicpu.op_reg_const(A_LINK,S_W,NR_FRAME_POINTER_REG,-localsize)); + begin + list.concat(taicpu.op_reg_const(A_LINK,S_W,NR_FRAME_POINTER_REG,0)); + list.concat(taicpu.op_const_reg(A_SUBA,S_L,localsize,NR_STACK_POINTER_REG)); + end + else + list.concat(taicpu.op_reg_const(A_LINK,S_W,NR_FRAME_POINTER_REG,-localsize)); end; end; @@ -1601,9 +1641,6 @@ unit cgcpu; if not nostackframe then begin list.concat(taicpu.op_reg(A_UNLK,S_NO,NR_FRAME_POINTER_REG)); - parasize := parasize - target_info.first_parm_offset; { i'm still not 100% confident that this is - correct here, but at least it looks less - hacky, and makes some sense (KB) } { if parasize is less than zero here, we probably have a cdecl function. According to the info here: http://www.makestuff.eu/wordpress/gcc-68000-abi/ @@ -1612,7 +1649,7 @@ unit cgcpu; caller side free, which looks like a PITA to support. We have to figure this out later. More info welcomed. (KB) } - if (parasize > 0) then + if (parasize > 0) and not (current_procinfo.procdef.proccalloption in clearstack_pocalls) then begin if current_settings.cputype=cpu_mc68020 then list.concat(taicpu.op_const(A_RTD,S_NO,parasize)) @@ -1727,9 +1764,16 @@ unit cgcpu; include(current_procinfo.flags,pi_has_saved_regs); { Copy registers to temp } + { NOTE: virtual registers allocated here won't be translated --> no higher-level stuff. } href:=current_procinfo.save_regs_ref; + if (href.offset<low(smallint)) and (current_settings.cputype in cpu_coldfire) then + begin + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,href.base,NR_A0)); + list.concat(taicpu.op_const_reg(A_ADDA,S_L,href.offset,NR_A0)); + reference_reset_base(href,NR_A0,0,sizeof(pint)); + end; if size = sizeof(aint) then - a_load_reg_ref(list, OS_32, OS_32, hreg, href) + list.concat(taicpu.op_reg_ref(A_MOVE,S_L,hreg,href)) else list.concat(taicpu.op_regset_ref(A_MOVEM,S_L,dataregs,addrregs,href)); end; @@ -1780,8 +1824,14 @@ unit cgcpu; { Restore registers from temp } href:=current_procinfo.save_regs_ref; + if (href.offset<low(smallint)) and (current_settings.cputype in cpu_coldfire) then + begin + list.concat(taicpu.op_reg_reg(A_MOVE,S_L,href.base,NR_A0)); + list.concat(taicpu.op_const_reg(A_ADDA,S_L,href.offset,NR_A0)); + reference_reset_base(href,NR_A0,0,sizeof(pint)); + end; if size = sizeof(aint) then - a_load_ref_reg(list, OS_32, OS_32, href, hreg) + list.concat(taicpu.op_ref_reg(A_MOVE,S_L,href,hreg)) else list.concat(taicpu.op_ref_regset(A_MOVEM,S_L,href,dataregs,addrregs)); @@ -1926,7 +1976,7 @@ unit cgcpu; begin { offset in the wrapper needs to be adjusted for the stored return address } - reference_reset_base(href,reference.index,reference.offset-sizeof(pint),sizeof(pint)); + reference_reset_base(href,reference.index,reference.offset+sizeof(pint),sizeof(pint)); { plain 68k could use SUBI on href directly, but this way it works on Coldfire too and it's probably smaller code for the majority of cases (if ioffset small, the load will use MOVEQ) (KB) } @@ -2100,6 +2150,34 @@ unit cgcpu; end; + procedure tcg64f68k.a_op64_ref_reg(list : TAsmList;op:TOpCG;size : tcgsize;const ref : treference;reg : tregister64); + var + tempref : treference; + begin + case op of + OP_NEG,OP_NOT: + begin + a_load64_ref_reg(list,ref,reg); + a_op64_reg_reg(list,op,size,reg,reg); + end; + + OP_AND,OP_OR: + begin + tempref:=ref; + tcg68k(cg).fixref(list,tempref); + inc(tempref.offset,4); + list.concat(taicpu.op_ref_reg(topcg2tasmop[op],S_L,tempref,reg.reglo)); + dec(tempref.offset,4); + list.concat(taicpu.op_ref_reg(topcg2tasmop[op],S_L,tempref,reg.reghi)); + end; + else + { XOR does not allow reference for source; ADD/SUB do not allow reference for + high dword, although low dword can still be handled directly. } + inherited a_op64_ref_reg(list,op,size,ref,reg); + end; + end; + + procedure tcg64f68k.a_op64_const_reg(list : TAsmList;op:TOpCG;size: tcgsize; value : int64;regdst : tregister64); var lowvalue : cardinal; diff --git a/compiler/m68k/cpupara.pas b/compiler/m68k/cpupara.pas index 7d57c4e117..56bab0e6d6 100644 --- a/compiler/m68k/cpupara.pas +++ b/compiler/m68k/cpupara.pas @@ -52,9 +52,8 @@ unit cpupara; function get_volatile_registers_address(calloption:tproccalloption):tcpuregisterset;override; private function parse_loc_string_to_register(var locreg: tregister; const s : string): boolean; - procedure init_values(var curintreg, curfloatreg: tsuperregister; var cur_stack_offset: aword); function create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist; - var curintreg, curfloatreg: tsuperregister; var cur_stack_offset: aword):longint; + var cur_stack_offset: aword):longint; end; implementation @@ -135,13 +134,6 @@ unit cpupara; end; end; - procedure tcpuparamanager.init_values(var curintreg, curfloatreg: tsuperregister; var cur_stack_offset: aword); - begin - cur_stack_offset:=8; - curintreg:=RS_D0; - curfloatreg:=RS_FP0; - end; - function tcpuparamanager.ret_in_param(def:tdef;pd:tabstractprocdef):boolean; begin if handle_common_ret_in_param(def,pd,result) then @@ -227,17 +219,15 @@ unit cpupara; function tcpuparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint; var cur_stack_offset: aword; - curintreg, curfloatreg: tsuperregister; begin - init_values(curintreg,curfloatreg,cur_stack_offset); - - result:=create_paraloc_info_intern(p,side,p.paras,curintreg,curfloatreg,cur_stack_offset); + cur_stack_offset:=0; + result:=create_paraloc_info_intern(p,side,p.paras,cur_stack_offset); create_funcretloc_info(p,side); end; function tcpuparamanager.create_paraloc_info_intern(p : tabstractprocdef; side: tcallercallee; paras: tparalist; - var curintreg, curfloatreg: tsuperregister; var cur_stack_offset: aword):longint; + var cur_stack_offset: aword):longint; var paraloc : pcgparalocation; hp : tparavarsym; @@ -245,12 +235,10 @@ unit cpupara; paralen : aint; paradef : tdef; i : longint; - stack_offset : longint; firstparaloc : boolean; begin result:=0; - stack_offset:=cur_stack_offset; for i:=0 to paras.count-1 do begin @@ -327,23 +315,24 @@ unit cpupara; else paraloc^.size:=int_cgsize(paralen); - paraloc^.reference.offset:=stack_offset; + paraloc^.reference.offset:=cur_stack_offset; if (side = callerside) then paraloc^.reference.index:=NR_STACK_POINTER_REG else begin paraloc^.reference.index:=NR_FRAME_POINTER_REG; + inc(paraloc^.reference.offset,target_info.first_parm_offset); { M68K is a big-endian target } if (paralen<tcgsize2size[OS_INT]) then inc(paraloc^.reference.offset,4-paralen); end; - inc(stack_offset,align(paralen,4)); + inc(cur_stack_offset,align(paralen,4)); paralen := 0; firstparaloc:=false; end; end; - result:=stack_offset; + result:=cur_stack_offset; end; @@ -402,14 +391,13 @@ unit cpupara; function tcpuparamanager.create_varargs_paraloc_info(p : tabstractprocdef; varargspara:tvarargsparalist):longint; var cur_stack_offset: aword; - curintreg, curfloatreg: tsuperregister; begin - init_values(curintreg,curfloatreg,cur_stack_offset); + cur_stack_offset:=0; - result:=create_paraloc_info_intern(p,callerside,p.paras,curintreg,curfloatreg,cur_stack_offset); + result:=create_paraloc_info_intern(p,callerside,p.paras,cur_stack_offset); if (p.proccalloption in cstylearrayofconst) then { just continue loading the parameters in the registers } - result:=create_paraloc_info_intern(p,callerside,varargspara,curintreg,curfloatreg,cur_stack_offset) + result:=create_paraloc_info_intern(p,callerside,varargspara,cur_stack_offset) else internalerror(200410231); end; diff --git a/compiler/m68k/n68kadd.pas b/compiler/m68k/n68kadd.pas index a812a2ee5e..24a1093dcd 100644 --- a/compiler/m68k/n68kadd.pas +++ b/compiler/m68k/n68kadd.pas @@ -32,23 +32,13 @@ interface type t68kaddnode = class(tcgaddnode) private - function cmp64_lt(left_reg,right_reg:tregister64):tregister; - function cmp64_le(left_reg,right_reg:tregister64):tregister; - function cmp64_eq(left_reg,right_reg:tregister64):tregister; - function cmp64_ne(left_reg,right_reg:tregister64):tregister; - function cmp64_ltu(left_reg,right_reg:tregister64):tregister; - function cmp64_leu(left_reg,right_reg:tregister64):tregister; - function getresflags(unsigned: boolean) : tresflags; - function getres64_register(unsigned:boolean;left_reg,right_reg:tregister64):tregister; protected procedure second_addfloat;override; procedure second_cmpfloat;override; procedure second_cmpordinal;override; procedure second_cmpsmallset;override; procedure second_cmp64bit;override; - public - function pass_1:tnode;override; end; @@ -62,198 +52,12 @@ implementation cpuinfo,pass_1,pass_2,regvars, cpupara,cgutils,procinfo, ncon,nset, - ncgutil,tgobj,rgobj,rgcpu,cgobj,hlcgobj,cg64f32; + ncgutil,tgobj,rgobj,rgcpu,cgobj,cgcpu,hlcgobj,cg64f32; {***************************************************************************** Helpers *****************************************************************************} - function t68kaddnode.cmp64_lt(left_reg,right_reg:tregister64):tregister; - var - labelcmp64_1,labelcmp64_2 : tasmlabel; - tmpreg : tregister; - begin - tmpreg:=cg.getintregister(current_asmdata.currasmlist,OS_INT); - - { load the value for "false" } - cg.a_load_const_reg(current_asmdata.currasmlist,OS_INT,0,tmpreg); - - current_asmdata.getjumplabel(labelcmp64_1); - current_asmdata.getjumplabel(labelcmp64_2); - - { check whether left_reg.reghi is less than right_reg.reghi } - current_asmdata.currasmlist.concat(taicpu.op_reg_reg(A_CMP,S_L,right_reg.reghi,left_reg.reghi)); - current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_LT,S_NO,labelcmp64_2)); - - { are left_reg.reghi and right_reg.reghi equal? } - current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_NE,S_NO,labelcmp64_1)); - - { is left_reg.reglo less than right_reg.reglo? } - current_asmdata.currasmlist.concat(taicpu.op_reg_reg(A_CMP,S_L,right_reg.reglo,left_reg.reglo)); - current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_CS,S_NO,labelcmp64_2)); - - current_asmdata.currasmlist.concat(Taicpu.op_sym(A_BRA,S_NO,labelcmp64_1)); - cg.a_label(current_asmdata.currasmlist,labelcmp64_2); - - { load the value for "true" } - cg.a_load_const_reg(current_asmdata.currasmlist,OS_INT,1,tmpreg); - - cg.a_label(current_asmdata.currasmlist,labelcmp64_1); - result:=tmpreg; - end; - - function t68kaddnode.cmp64_le(left_reg,right_reg:tregister64):tregister; - var - labelcmp64_1,labelcmp64_2 : tasmlabel; - tmpreg : tregister; - begin - tmpreg:=cg.getintregister(current_asmdata.currasmlist,OS_INT); - - { load the value for "false" } - cg.a_load_const_reg(current_asmdata.currasmlist,OS_INT,0,tmpreg); - - current_asmdata.getjumplabel(labelcmp64_1); - current_asmdata.getjumplabel(labelcmp64_2); - - { check whether right_reg.reghi is less than left_reg.reghi } - current_asmdata.currasmlist.concat(taicpu.op_reg_reg(A_CMP,S_L,left_reg.reghi,right_reg.reghi)); - current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_LT,S_NO,labelcmp64_1)); - - { are left_reg.reghi and right_reg.reghi equal? } - current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_NE,S_NO,labelcmp64_2)); - - { is right_reg.reglo less than left_reg.reglo? } - current_asmdata.currasmlist.concat(taicpu.op_reg_reg(A_CMP,S_L,left_reg.reglo,right_reg.reglo)); - current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_CS,S_NO,labelcmp64_1)); - - cg.a_label(current_asmdata.currasmlist,labelcmp64_2); - - { load the value for "true" } - cg.a_load_const_reg(current_asmdata.currasmlist,OS_INT,1,tmpreg); - - cg.a_label(current_asmdata.currasmlist,labelcmp64_1); - result:=tmpreg; - end; - - function t68kaddnode.cmp64_eq(left_reg,right_reg:tregister64):tregister; - var - labelcmp64 : tasmlabel; - tmpreg : tregister; - begin - tmpreg:=cg.getintregister(current_asmdata.currasmlist,OS_INT); - current_asmdata.getjumplabel(labelcmp64); - - { load the value for "false" } - cg.a_load_const_reg(current_asmdata.currasmlist,OS_INT,0,tmpreg); - - { is the high order longword equal? } - current_asmdata.currasmlist.concat(taicpu.op_reg_reg(A_CMP,S_L,left_reg.reghi,right_reg.reghi)); - current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_NE,S_NO,labelcmp64)); - - { is the low order longword equal? } - current_asmdata.currasmlist.concat(taicpu.op_reg_reg(A_CMP,S_L,left_reg.reglo,right_reg.reglo)); - current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_NE,S_NO,labelcmp64)); - - { load the value for "true" } - cg.a_load_const_reg(current_asmdata.currasmlist,OS_INT,1,tmpreg); - - cg.a_label(current_asmdata.currasmlist,labelcmp64); - result:=tmpreg; - end; - - function t68kaddnode.cmp64_ne(left_reg,right_reg:tregister64):tregister; - var - labelcmp64 : tasmlabel; - tmpreg : tregister; - begin - tmpreg:=cg.getintregister(current_asmdata.currasmlist,OS_INT); - current_asmdata.getjumplabel(labelcmp64); - - { load the value for "true" } - cg.a_load_const_reg(current_asmdata.currasmlist,OS_INT,1,tmpreg); - - { is the high order longword equal? } - current_asmdata.currasmlist.concat(taicpu.op_reg_reg(A_CMP,S_L,left_reg.reghi,right_reg.reghi)); - current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_NE,S_NO,labelcmp64)); - - { is the low order longword equal? } - current_asmdata.currasmlist.concat(taicpu.op_reg_reg(A_CMP,S_L,left_reg.reglo,right_reg.reglo)); - current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_NE,S_NO,labelcmp64)); - - { load the value for "false" } - cg.a_load_const_reg(current_asmdata.currasmlist,OS_INT,0,tmpreg); - - cg.a_label(current_asmdata.currasmlist,labelcmp64); - result:=tmpreg; - end; - - function t68kaddnode.cmp64_ltu(left_reg,right_reg:tregister64):tregister; - var - labelcmp64_1,labelcmp64_2 : tasmlabel; - tmpreg : tregister; - begin - tmpreg:=cg.getintregister(current_asmdata.currasmlist,OS_INT); - - { load the value for "false" } - cg.a_load_const_reg(current_asmdata.currasmlist,OS_INT,0,tmpreg); - - current_asmdata.getjumplabel(labelcmp64_1); - current_asmdata.getjumplabel(labelcmp64_2); - - { check whether left_reg.reghi is less than right_reg.reghi } - current_asmdata.currasmlist.concat(taicpu.op_reg_reg(A_CMP,S_L,right_reg.reghi,left_reg.reghi)); - current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_CS,S_NO,labelcmp64_2)); - - { are left_reg.reghi and right_reg.reghi equal? } - current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_NE,S_NO,labelcmp64_1)); - - { is left_reg.reglo less than right_reg.reglo? } - current_asmdata.currasmlist.concat(taicpu.op_reg_reg(A_CMP,S_L,right_reg.reglo,left_reg.reglo)); - current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_CS,S_NO,labelcmp64_2)); - - current_asmdata.currasmlist.concat(Taicpu.op_sym(A_BRA,S_NO,labelcmp64_1)); - cg.a_label(current_asmdata.currasmlist,labelcmp64_2); - - { load the value for "true" } - cg.a_load_const_reg(current_asmdata.currasmlist,OS_INT,1,tmpreg); - - cg.a_label(current_asmdata.currasmlist,labelcmp64_1); - result:=tmpreg; - end; - - function t68kaddnode.cmp64_leu(left_reg,right_reg:tregister64):tregister; - var - labelcmp64_1,labelcmp64_2 : tasmlabel; - tmpreg : tregister; - begin - tmpreg:=cg.getintregister(current_asmdata.currasmlist,OS_INT); - - { load the value for "false" } - cg.a_load_const_reg(current_asmdata.currasmlist,OS_INT,0,tmpreg); - - current_asmdata.getjumplabel(labelcmp64_1); - current_asmdata.getjumplabel(labelcmp64_2); - - { check whether right_reg.reghi is less than left_reg.reghi } - current_asmdata.currasmlist.concat(taicpu.op_reg_reg(A_CMP,S_L,left_reg.reghi,right_reg.reghi)); - current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_CS,S_NO,labelcmp64_1)); - - { are left_reg.reghi and right_reg.reghi equal? } - current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_NE,S_NO,labelcmp64_2)); - - { is right_reg.reglo less than left_reg.reglo? } - current_asmdata.currasmlist.concat(taicpu.op_reg_reg(A_CMP,S_L,left_reg.reglo,right_reg.reglo)); - current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_CS,S_NO,labelcmp64_1)); - - cg.a_label(current_asmdata.currasmlist,labelcmp64_2); - - { load the value for "true" } - cg.a_load_const_reg(current_asmdata.currasmlist,OS_INT,1,tmpreg); - - cg.a_label(current_asmdata.currasmlist,labelcmp64_1); - result:=tmpreg; - end; - function t68kaddnode.getresflags(unsigned : boolean) : tresflags; begin case nodetype of @@ -297,66 +101,6 @@ implementation end; end; - function t68kaddnode.getres64_register(unsigned:boolean;left_reg,right_reg:tregister64):tregister; - begin - case nodetype of - equaln: - result:=cmp64_eq(left_reg,right_reg); - unequaln: - result:=cmp64_ne(left_reg,right_reg); - else - if not unsigned then - begin - if nf_swapped in flags then - case nodetype of - ltn: - result:=cmp64_lt(right_reg,left_reg); - lten: - result:=cmp64_le(right_reg,left_reg); - gtn: - result:=cmp64_lt(left_reg,right_reg); - gten: - result:=cmp64_le(left_reg,right_reg); - end - else - case nodetype of - ltn: - result:=cmp64_lt(left_reg,right_reg); - lten: - result:=cmp64_le(left_reg,right_reg); - gtn: - result:=cmp64_lt(right_reg,left_reg); - gten: - result:=cmp64_le(right_reg,left_reg); - end; - end - else - begin - if nf_swapped in Flags then - case nodetype of - ltn: - result:=cmp64_ltu(right_reg,left_reg); - lten: - result:=cmp64_leu(right_reg,left_reg); - gtn: - result:=cmp64_ltu(left_reg,right_reg); - gten: - result:=cmp64_leu(left_reg,right_reg); - end - else - case nodetype of - ltn: - result:=cmp64_ltu(left_reg,right_reg); - lten: - result:=cmp64_leu(left_reg,right_reg); - gtn: - result:=cmp64_ltu(right_reg,left_reg); - gten: - result:=cmp64_leu(right_reg,left_reg); - end; - end; - end; - end; {***************************************************************************** AddFloat @@ -500,111 +244,92 @@ implementation procedure t68kaddnode.second_cmpordinal; var unsigned : boolean; - useconst : boolean; tmpreg : tregister; opsize : topsize; cmpsize : tcgsize; + href: treference; begin - pass_left_right; - { set result location } - location_reset(location,LOC_JUMP,OS_NO); - - { ToDo : set "allowconstants" to True, but this seems to upset Coldfire - a bit for the CMP instruction => check manual and implement - exception accordingly below } - { load values into registers (except constants) } - force_reg_left_right(true, false); - { determine if the comparison will be unsigned } unsigned:=not(is_signed(left.resultdef)) or not(is_signed(right.resultdef)); + { this puts constant operand (if any) to the right } + pass_left_right; + { tentatively assume left size (correct for possible TST, will fix later) } + cmpsize:=def_cgsize(left.resultdef); + opsize:=tcgsize2opsize[cmpsize]; - // get the constant on the right if there is one - if (left.location.loc = LOC_CONSTANT) then - swapleftright; - // can we use an immediate, or do we have to load the - // constant in a register first? - if (right.location.loc = LOC_CONSTANT) then - begin -{$ifdef extdebug} - if (right.location.size in [OS_64,OS_S64]) and (hi(right.location.value64)<>0) and ((hi(right.location.value64)<>-1) or unsigned) then - internalerror(2002080301); -{$endif extdebug} - if (nodetype in [equaln,unequaln]) then - if (unsigned and - (right.location.value > high(word))) or - (not unsigned and - (longint(right.location.value) < low(smallint)) or - (longint(right.location.value) > high(smallint))) then - { we can then maybe use a constant in the 'othersigned' case - (the sign doesn't matter for // equal/unequal)} - unsigned := not unsigned; - - if (unsigned and - ((right.location.value) <= high(word))) or - (not(unsigned) and - (longint(right.location.value) >= low(smallint)) and - (longint(right.location.value) <= high(smallint))) then - useconst := true - else - begin - useconst := false; - tmpreg := cg.getintregister(current_asmdata.CurrAsmList,OS_INT); - cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT, - aword(right.location.value),tmpreg); - end - end - else - useconst := false; - location.loc := LOC_FLAGS; - location.resflags := getresflags(unsigned); - if tcgsize2size[right.location.size]=tcgsize2size[left.location.size] then - cmpsize:=left.location.size - else - { ToDo : zero/sign extend??? } - if tcgsize2size[right.location.size]<tcgsize2size[left.location.size] then - cmpsize:=left.location.size - else - cmpsize:=right.location.size; - opsize:=tcgsize2opsize[cmpsize]; - if opsize=S_NO then - internalerror(2013090301); - { Attention: The RIGHT(!) operand is substracted from and must be a - register! } - if (right.location.loc = LOC_CONSTANT) then - if useconst then - current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_CMP,opsize, - longint(right.location.value),left.location.register)) - else - begin - current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,opsize, - tmpreg,left.location.register)); - end - else - current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,opsize, - right.location.register,left.location.register)); - end; + { set result location } + location_reset(location,LOC_FLAGS,OS_NO); + { see if we can optimize into TST } + if (right.location.loc=LOC_CONSTANT) and (right.location.value=0) then + begin + { Unsigned <0 or >=0 should not reach pass2, most likely } + case left.location.loc of + LOC_REFERENCE, + LOC_CREFERENCE: + begin + href:=left.location.reference; + tcg68k(cg).fixref(current_asmdata.CurrAsmList,href); + current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_TST,opsize,href)); + location_freetemp(current_asmdata.CurrAsmList,left.location); + end; + else + hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true); + current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,opsize,left.location.register)); + end; + location.resflags := getresflags(unsigned); + exit; + end; - function t68kaddnode.pass_1:tnode; - var - ld,rd : tdef; - begin - result:=inherited pass_1; + { Coldfire supports byte/word compares only starting with ISA_B, + !!see remark about Qemu weirdness in tcg68k.a_cmp_const_reg_label } + if (opsize<>S_L) and (current_settings.cputype in cpu_coldfire{-[cpu_isa_b,cpu_isa_c]}) then + begin + { 1) Extension is needed for LOC_REFERENCE, but what about LOC_REGISTER ? Perhaps after fixing cg we can assume + that high bits of registers are correct. + 2) Assuming that extension depends only on source signedness --> destination OS_32 is acceptable. } + hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,cgsize_orddef(OS_32),false); + if (right.location.loc<>LOC_CONSTANT) then + hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,cgsize_orddef(OS_32),false); + opsize:=S_L; + end + else if not (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then + begin + if not (right.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then + hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true) + else + begin + location_swap(left.location,right.location); + toggleflag(nf_swapped); + end; + end; + { left is now in register } + case right.location.loc of + LOC_CONSTANT: + current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_CMP,opsize, + longint(right.location.value),left.location.register)); + LOC_REFERENCE, + LOC_CREFERENCE: + begin + href:=right.location.reference; + tcg68k(cg).fixref(current_asmdata.CurrAsmList,href); + current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg(A_CMP,opsize,href, + left.location.register)); + end; + LOC_REGISTER, + LOC_CREGISTER: + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,opsize, + right.location.register,left.location.register)); + else + hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,right.resultdef,true); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,opsize, + right.location.register,left.location.register)); + end; - { for 64 bit operations we return the resulting value in a register } - if not assigned(result) then - begin - rd:=right.resultdef; - ld:=left.resultdef; - if (nodetype in [ltn,lten,gtn,gten,equaln,unequaln]) and - ( - ((ld.typ=orddef) and (torddef(ld).ordtype in [u64bit,s64bit,scurrency])) or - ((rd.typ=orddef) and (torddef(rd).ordtype in [u64bit,s64bit,scurrency])) - ) then - expectloc:=LOC_REGISTER; - end; - end; + { update location because sides could have been swapped } + location.resflags:=getresflags(unsigned); + end; {***************************************************************************** @@ -613,123 +338,167 @@ implementation procedure t68kaddnode.second_cmp64bit; var + hlab: tasmlabel; unsigned : boolean; - tmp_left_reg : tregister; + href: treference; + + procedure firstjmp64bitcmp; + var + oldnodetype : tnodetype; + begin + case nodetype of + ltn,gtn: + begin + if (hlab<>current_procinfo.CurrTrueLabel) then + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrTrueLabel); + { cheat a little bit for the negative test } + toggleflag(nf_swapped); + if (hlab<>current_procinfo.CurrFalseLabel) then + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrFalseLabel); + toggleflag(nf_swapped); + end; + lten,gten: + begin + oldnodetype:=nodetype; + if nodetype=lten then + nodetype:=ltn + else + nodetype:=gtn; + if (hlab<>current_procinfo.CurrTrueLabel) then + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrTrueLabel); + { cheat for the negative test } + if nodetype=ltn then + nodetype:=gtn + else + nodetype:=ltn; + if (hlab<>current_procinfo.CurrFalseLabel) then + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrFalseLabel); + nodetype:=oldnodetype; + end; + equaln: + cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NE,current_procinfo.CurrFalseLabel); + unequaln: + cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NE,current_procinfo.CurrTrueLabel); + end; + end; + + procedure secondjmp64bitcmp; + begin + case nodetype of + ltn,gtn,lten,gten: + begin + cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(true),current_procinfo.CurrTrueLabel); + cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel); + end; + equaln: + begin + cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NE,current_procinfo.CurrFalseLabel); + cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel); + end; + unequaln: + begin + cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NE,current_procinfo.CurrTrueLabel); + cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel); + end; + end; + end; + begin + { This puts constant operand (if any) to the right } pass_left_right; - force_reg_left_right(false,false); unsigned:=not(is_signed(left.resultdef)) or not(is_signed(right.resultdef)); - location_reset(location,LOC_REGISTER,OS_INT); - location.register:=getres64_register(unsigned,left.location.register64,right.location.register64); - - { keep the below code for now, as we could optimize the =/<> code later - on based on it } - - // writeln('second_cmp64bit'); -// pass_left_right; + location_reset(location,LOC_JUMP,OS_NO); + { Relational compares against constants having low dword=0 can omit the + second compare based on the fact that any unsigned value is >=0 } + hlab:=nil; + if (right.location.loc=LOC_CONSTANT) and + (lo(right.location.value64)=0) then + begin + case getresflags(true) of + F_AE: hlab:=current_procinfo.CurrTrueLabel; + F_B: hlab:=current_procinfo.CurrFalseLabel; + end; + end; -// load_left_right(true,false); -(* - case nodetype of - ltn,lten, - gtn,gten: - begin - emit_cmp64_hi; - firstjmp64bitcmp; - emit_cmp64_lo; - secondjmp64bitcmp; - end; - equaln,unequaln: - begin - // instead of doing a complicated compare, do - // (left.hi xor right.hi) or (left.lo xor right.lo) - // (somewhate optimized so that no superfluous 'mr's are - // generated) - if (left.location.loc = LOC_CONSTANT) then - swapleftright; - if (right.location.loc = LOC_CONSTANT) then - begin - if left.location.loc = LOC_REGISTER then - begin - tempreg64.reglo := left.location.register64.reglo; - tempreg64.reghi := left.location.register64.reghi; - end - else - begin - if (aword(right.location.valueqword) <> 0) then - tempreg64.reglo := cg.getintregister(current_asmdata.CurrAsmList) - else - tempreg64.reglo := left.location.register64.reglo; - if ((right.location.valueqword shr 32) <> 0) then - tempreg64.reghi := cg.getintregister(current_asmdata.CurrAsmList) - else - tempreg64.reghi := left.location.register64.reghi; - end; - - if (aword(right.location.valueqword) <> 0) then - { negative values can be handled using SUB, } - { positive values < 65535 using XOR. } - if (longint(right.location.valueqword) >= -32767) and - (longint(right.location.valueqword) < 0) then - cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT, - aword(right.location.valueqword), - left.location.register64.reglo,tempreg64.reglo) - else - cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_XOR,OS_INT, - aword(right.location.valueqword), - left.location.register64.reglo,tempreg64.reglo); - - if ((right.location.valueqword shr 32) <> 0) then - if (longint(right.location.valueqword shr 32) >= -32767) and - (longint(right.location.valueqword shr 32) < 0) then - cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT, - aword(right.location.valueqword shr 32), - left.location.register64.reghi,tempreg64.reghi) - else - cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_XOR,OS_INT, - aword(right.location.valueqword shr 32), - left.location.register64.reghi,tempreg64.reghi); - end - else - begin - tempreg64.reglo := cg.getintregister(current_asmdata.CurrAsmList); - tempreg64.reghi := cg.getintregister(current_asmdata.CurrAsmList); - cg64.a_op64_reg_reg_reg(current_asmdata.CurrAsmList,OP_XOR, - left.location.register64,right.location.register64, - tempreg64); - end; - - cg.a_reg_alloc(current_asmdata.CurrAsmList,R_0); - current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_OR_,R_0, - tempreg64.reglo,tempreg64.reghi)); - cg.a_reg_dealloc(current_asmdata.CurrAsmList,R_0); - if (tempreg64.reglo <> left.location.register64.reglo) then - cg.ungetregister(current_asmdata.CurrAsmList,tempreg64.reglo); - if (tempreg64.reghi <> left.location.register64.reghi) then - cg.ungetregister(current_asmdata.CurrAsmList,tempreg64.reghi); - - location_reset(location,LOC_FLAGS,OS_NO); - location.resflags := getresflags; + if (right.location.loc=LOC_CONSTANT) and (right.location.value64=0) and + (nodetype in [equaln,unequaln]) then + begin + case left.location.loc of + LOC_REFERENCE, + LOC_CREFERENCE: + begin + href:=left.location.reference; + tcg68k(cg).fixref(current_asmdata.CurrAsmList,href); + current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_TST,S_L,href)); + firstjmp64bitcmp; + inc(href.offset,4); + current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_TST,S_L,href)); + secondjmp64bitcmp; + location_freetemp(current_asmdata.CurrAsmList,left.location); end; - else - internalerror(2002072803); + else + hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true); + current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,S_L,left.location.register64.reglo)); + firstjmp64bitcmp; + current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,S_L,left.location.register64.reghi)); + secondjmp64bitcmp; end; + exit; + end; + { left and right no register? } + { then one must be demanded } + if not (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then + begin + if not (right.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then + hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true) + else + begin + location_swap(left.location,right.location); + toggleflag(nf_swapped); + end; + end; - { set result location } - { (emit_compare sets it to LOC_FLAGS for compares, so set the } - { real location only now) (JM) } - if cmpop and - not(nodetype in [equaln,unequaln]) then - location_reset(location,LOC_JUMP,OS_NO); -*) - // location_reset(location,LOC_JUMP,OS_NO); - // writeln('second_cmp64_exit'); - end; + { left is now in register } + case right.location.loc of + LOC_REGISTER,LOC_CREGISTER: + begin + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,S_L,right.location.register64.reghi,left.location.register64.reghi)); + firstjmp64bitcmp; + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,S_L,right.location.register64.reglo,left.location.register64.reglo)); + secondjmp64bitcmp; + end; + LOC_REFERENCE,LOC_CREFERENCE: + begin + href:=right.location.reference; + tcg68k(cg).fixref(current_asmdata.CurrAsmList,href); + current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg(A_CMP,S_L,href,left.location.register64.reghi)); + firstjmp64bitcmp; + inc(href.offset,4); + current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg(A_CMP,S_L,href,left.location.register64.reglo)); + secondjmp64bitcmp; + location_freetemp(current_asmdata.CurrAsmList,right.location); + end; + LOC_CONSTANT: + begin + current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_CMP,S_L,aint(hi(right.location.value64)),left.location.register64.reghi)); + firstjmp64bitcmp; + if assigned(hlab) then + cg.a_jmp_always(current_asmdata.CurrAsmList,hlab) + else + begin + current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_CMP,S_L,aint(lo(right.location.value64)),left.location.register64.reglo)); + secondjmp64bitcmp; + end; + end; + else + InternalError(2014072501); + end; + end; begin diff --git a/compiler/m68k/n68kcal.pas b/compiler/m68k/n68kcal.pas index 0e965a29f3..f31f0bef31 100644 --- a/compiler/m68k/n68kcal.pas +++ b/compiler/m68k/n68kcal.pas @@ -34,6 +34,7 @@ interface procedure gen_syscall_para(para: tcallparanode); override; public procedure do_syscall;override; + procedure pop_parasize(pop_size: longint);override; end; @@ -50,6 +51,13 @@ implementation cg64f32,cgcpu,cpupi,procinfo; + procedure tm68kcallnode.pop_parasize(pop_size: longint); + begin + if pop_size<>0 then + current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_ADD,S_L,pop_size,NR_SP)); + end; + + procedure tm68kcallnode.gen_syscall_para(para: tcallparanode); begin { lib parameter has no special type but proccalloptions must be a syscall } diff --git a/compiler/m68k/n68kmat.pas b/compiler/m68k/n68kmat.pas index 8314498f9b..623e5f18a6 100644 --- a/compiler/m68k/n68kmat.pas +++ b/compiler/m68k/n68kmat.pas @@ -70,8 +70,7 @@ implementation procedure tm68knotnode.second_boolean; var hreg: tregister; - opsize : tcgsize; - loc : tcgloc; + opsize : tcgsize; begin if not handle_locjump then begin @@ -154,10 +153,8 @@ implementation procedure tm68kmoddivnode.emit_mod_reg_reg(signed: boolean;denum,num : tregister); - var tmpreg : tregister; - continuelabel : tasmlabel; - signlabel : tasmlabel; - reg_d0,reg_d1 : tregister; + var + tmpreg : tregister; begin if current_settings.cputype=cpu_MC68020 then begin diff --git a/compiler/m68k/ra68kmot.pas b/compiler/m68k/ra68kmot.pas index 004c467c51..01d775ca7a 100644 --- a/compiler/m68k/ra68kmot.pas +++ b/compiler/m68k/ra68kmot.pas @@ -220,7 +220,7 @@ const if lower(s)='sp' then actasmregister:=NR_STACK_POINTER_REG; if lower(s)='fp' then - actasmregister:=NR_STACK_POINTER_REG; + actasmregister:=NR_FRAME_POINTER_REG; if actasmregister<>NR_NO then begin result:=true; @@ -1343,7 +1343,6 @@ const end; { // A constant expression, or a Variable ref. // } AS_ID: begin - Oper.InitRef; if actasmpattern[1] = '@' then { // Label or Special symbol reference // } begin @@ -1510,6 +1509,7 @@ const case actasmtoken of AS_REGISTER: begin + r:=actasmregister; if getregtype(r)=R_ADDRESSREGISTER then include(addrregset,getsupreg(r)) else if getregtype(r)=R_INTREGISTER then diff --git a/compiler/m68k/rgcpu.pas b/compiler/m68k/rgcpu.pas index a981d73a75..15942230c3 100644 --- a/compiler/m68k/rgcpu.pas +++ b/compiler/m68k/rgcpu.pas @@ -27,14 +27,150 @@ unit rgcpu; interface uses - aasmbase,aasmtai,aasmdata, - cpubase, + aasmbase,aasmtai,aasmdata,aasmsym,aasmcpu, + cgbase,cgutils,cpubase, rgobj; type trgcpu = class(trgobj) + procedure do_spill_read(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister); override; + procedure do_spill_written(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister); override; + function do_spill_replace(list : TAsmList;instr : tai_cpu_abstract_sym; orgreg : tsuperregister;const spilltemp : treference) : boolean; override; end; implementation + uses + cutils,cgobj,verbose,globtype,globals,cpuinfo; + + { returns True if source operand of MOVE can be replaced with spilltemp when its destination is ref^. } + function isvalidmovedest(ref: preference): boolean; inline; + begin + { The following is for Coldfire, for other CPUs it maybe can be relaxed. } + result:=(ref^.symbol=nil) and (ref^.scalefactor<=1) and + (ref^.index=NR_NO) and (ref^.base<>NR_NO) and (ref^.offset>=low(smallint)) and + (ref^.offset<=high(smallint)); + end; + + + procedure trgcpu.do_spill_read(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister); + var + helpins : tai; + tmpref : treference; + helplist : tasmlist; + hreg : tregister; + begin + if (abs(spilltemp.offset)>32767) and (current_settings.cputype in cpu_coldfire) then + begin + helplist:=tasmlist.create; + + if getregtype(tempreg)=R_INTREGISTER then + hreg:=tempreg + else + hreg:=cg.getintregister(helplist,OS_ADDR); +{$ifdef DEBUG_SPILLING} + helplist.concat(tai_comment.Create(strpnew('Spilling: Read, large offset'))); +{$endif} + + helplist.concat(taicpu.op_const_reg(A_MOVE,S_L,spilltemp.offset,hreg)); + reference_reset_base(tmpref,spilltemp.base,0,sizeof(aint)); + tmpref.index:=hreg; + + helpins:=spilling_create_load(tmpref,tempreg); + helplist.concat(helpins); + list.insertlistafter(pos,helplist); + helplist.free; + end + else + inherited; + end; + + + procedure trgcpu.do_spill_written(list: TAsmList; pos: tai; const spilltemp: treference; tempreg: tregister; orgsupreg: tsuperregister); + var + tmpref : treference; + helplist : tasmlist; + hreg : tregister; + begin + if (abs(spilltemp.offset)>32767) and (current_settings.cputype in cpu_coldfire) then + begin + helplist:=tasmlist.create; + + if getregtype(tempreg)=R_INTREGISTER then + hreg:=getregisterinline(helplist,[R_SUBWHOLE]) + else + hreg:=cg.getintregister(helplist,OS_ADDR); +{$ifdef DEBUG_SPILLING} + helplist.concat(tai_comment.Create(strpnew('Spilling: Write, large offset'))); +{$endif} + + helplist.concat(taicpu.op_const_reg(A_MOVE,S_L,spilltemp.offset,hreg)); + reference_reset_base(tmpref,spilltemp.base,0,sizeof(aint)); + tmpref.index:=hreg; + + helplist.concat(spilling_create_store(tempreg,tmpref)); + if getregtype(tempreg)=R_INTREGISTER then + ungetregisterinline(helplist,hreg); + + list.insertlistafter(pos,helplist); + helplist.free; + end + else + inherited; + end; + + + function trgcpu.do_spill_replace(list : TAsmList;instr : tai_cpu_abstract_sym; orgreg : tsuperregister;const spilltemp : treference) : boolean; + var + opidx: longint; + begin + result:=false; + opidx:=-1; + if (abs(spilltemp.offset)>32767) and (current_settings.cputype in cpu_coldfire) then + exit; + case instr.ops of + 1: + begin + if (instr.oper[0]^.typ=top_reg) and (getregtype(instr.oper[0]^.reg)=regtype) and + ((instr.opcode=A_TST) or (instr.opcode=A_CLR)) then + begin + if get_alias(getsupreg(instr.oper[0]^.reg))<>orgreg then + InternalError(2014080101); + opidx:=0; + end; + end; + 2: + begin + if (instr.oper[0]^.typ=top_reg) and (getregtype(instr.oper[0]^.reg)=regtype) and + (get_alias(getsupreg(instr.oper[0]^.reg))=orgreg) then + begin + { source can be replaced if dest is register... } + if ((instr.oper[1]^.typ=top_reg) and (instr.opcode in [A_MOVE,A_ADD,A_SUB,A_AND,A_OR,A_CMP])) or + {... or a "simple" reference in case of MOVE } + ((instr.opcode=A_MOVE) and (instr.oper[1]^.typ=top_ref) and isvalidmovedest(instr.oper[1]^.ref)) then + opidx:=0; + end + else if (instr.oper[1]^.typ=top_reg) and (getregtype(instr.oper[1]^.reg)=regtype) and + (get_alias(getsupreg(instr.oper[1]^.reg))=orgreg) and + ( + (instr.opcode in [A_MOVE,A_ADD,A_SUB,A_AND,A_OR]) and + (instr.oper[0]^.typ=top_reg) + ) or + (instr.opcode in [A_ADDQ,A_SUBQ,A_MOV3Q]) then + opidx:=1; + end; + end; + + if (opidx<0) then + exit; + instr.oper[opidx]^.typ:=top_ref; + new(instr.oper[opidx]^.ref); + instr.oper[opidx]^.ref^:=spilltemp; + case taicpu(instr).opsize of + S_B: inc(instr.oper[opidx]^.ref^.offset,3); + S_W: inc(instr.oper[opidx]^.ref^.offset,2); + end; + result:=true; + end; + end. diff --git a/compiler/mips/aoptcpu.pas b/compiler/mips/aoptcpu.pas index 8ae44180c2..6617e2c8e2 100644 --- a/compiler/mips/aoptcpu.pas +++ b/compiler/mips/aoptcpu.pas @@ -178,7 +178,7 @@ unit aoptcpu; Result:=GetNextInstruction(Next,Next); until {not(cs_opt_level3 in current_settings.optimizerswitches) or} not(Result) or (Next.typ<>ait_instruction) or (RegInInstruction(reg,Next)) or (is_calljmp(taicpu(Next).opcode)); - if Result and is_calljmp(taicpu(next).opcode) then + if Result and (next.typ=ait_instruction) and is_calljmp(taicpu(next).opcode) then begin result:=false; next:=nil; @@ -385,6 +385,7 @@ unit aoptcpu; TryRemoveMov(p,A_MOVE); end; + A_LB,A_LBU,A_LH,A_LHU,A_LW, A_ADD,A_ADDU, A_ADDI,A_ADDIU, A_SUB,A_SUBU, @@ -394,11 +395,13 @@ unit aoptcpu; A_AND,A_OR,A_XOR,A_ORI,A_XORI: TryRemoveMov(p,A_MOVE); + A_LWC1, A_ADD_s, A_SUB_s, A_MUL_s, A_DIV_s, A_ABS_s, A_NEG_s, A_SQRT_s, A_CVT_s_w, A_CVT_s_l, A_CVT_s_d: TryRemoveMov(p,A_MOV_s); + A_LDC1, A_ADD_d, A_SUB_d, A_MUL_d, A_DIV_d, A_ABS_d, A_NEG_d, A_SQRT_d, A_CVT_d_w, A_CVT_d_l, A_CVT_d_s: diff --git a/compiler/mips/cgcpu.pas b/compiler/mips/cgcpu.pas index 06134ff8c1..8bf8d47db3 100644 --- a/compiler/mips/cgcpu.pas +++ b/compiler/mips/cgcpu.pas @@ -88,9 +88,6 @@ type procedure g_intf_wrapper(list: tasmlist; procdef: tprocdef; const labelname: string; ioffset: longint); override; procedure g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string);override; procedure g_profilecode(list: TAsmList);override; - { Transform unsupported methods into Internal errors } - procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); override; - procedure g_stackpointer_alloc(list : TAsmList;localsize : longint);override; end; TCg64MPSel = class(tcg64f32) @@ -1239,7 +1236,7 @@ begin begin if reg in (rg[R_FPUREGISTER].used_in_proc-paramanager.get_volatile_registers_fpu(pocall_stdcall)) then begin - fmask:=fmask or (1 shl ord(reg)); + fmask:=fmask or (longword(1) shl ord(reg)); href.offset:=nextoffset; lastfpuoffset:=nextoffset; helplist.concat(taicpu.op_reg_ref(A_SWC1,newreg(R_FPUREGISTER,reg,R_SUBFS),href)); @@ -1269,7 +1266,7 @@ begin begin if reg in saveregs then begin - mask:=mask or (1 shl ord(reg)); + mask:=mask or (longword(1) shl ord(reg)); href.offset:=nextoffset; lastintoffset:=nextoffset; if (reg=RS_FRAME_POINTER_REG) then @@ -1285,8 +1282,8 @@ begin //list.concat(Taicpu.Op_reg_reg_const(A_ADDIU,NR_FRAME_POINTER_REG,NR_STACK_POINTER_REG,current_procinfo.para_stack_size)); list.concat(Taicpu.op_none(A_P_SET_NOMIPS16)); list.concat(Taicpu.op_reg_const_reg(A_P_FRAME,current_procinfo.framepointer,LocalSize,NR_R31)); - list.concat(Taicpu.op_const_const(A_P_MASK,mask,-(LocalSize-lastintoffset))); - list.concat(Taicpu.op_const_const(A_P_FMASK,Fmask,-(LocalSize-lastfpuoffset))); + list.concat(Taicpu.op_const_const(A_P_MASK,aint(mask),-(LocalSize-lastintoffset))); + list.concat(Taicpu.op_const_const(A_P_FMASK,aint(Fmask),-(LocalSize-lastfpuoffset))); list.concat(Taicpu.op_none(A_P_SET_NOREORDER)); if (cs_create_pic in current_settings.moduleswitches) and (pi_needs_got in current_procinfo.flags) then @@ -1763,15 +1760,6 @@ procedure TCGMIPS.g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: t InternalError(2013020102); end; -procedure TCGMIPS.g_stackpointer_alloc(list : TAsmList;localsize : longint); - begin - Comment(V_Error,'TCgMPSel.g_stackpointer_alloc method not implemented'); - end; - -procedure TCGMIPS.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); - begin - Comment(V_Error,'TCgMPSel.a_bit_scan_reg_reg method not implemented'); - end; {**************************************************************************** TCG64_MIPSel diff --git a/compiler/msg/errore.msg b/compiler/msg/errore.msg index 55db538478..0ca5fbdb3b 100644 --- a/compiler/msg/errore.msg +++ b/compiler/msg/errore.msg @@ -3418,6 +3418,7 @@ new features, etc.): # option_help_pages=11025_[ **0*_Put + after a boolean switch option to enable it, - to disable it +**1@<x>_Read compiler options from <x> in addition to the default fpc.cfg **1a_The compiler does not delete the generated assembler file **2al_List sourcecode lines in assembler file **2an_List node info in assembler file (-dEXTDEBUG compiler) @@ -3436,7 +3437,7 @@ option_help_pages=11025_[ 3*2Anasmelf_ELF32 (Linux) file using Nasm 3*2Anasmwin32_Win32 object file using Nasm 3*2Anasmwdosx_Win32/WDOSX object file using Nasm -3*2Anasmdarwin macho32 object file using Nasm (experimental) +3*2Anasmdarwin_macho32 object file using Nasm (experimental) 3*2Awasm_Obj file using Wasm (Watcom) 3*2Anasmobj_Obj file using Nasm 3*2Amasm_Obj file using Masm (Microsoft) @@ -3591,7 +3592,7 @@ J*2Cv_Var/out parameter copy-out checking F*1P<x>_Target CPU / compiler related options: F*2PB_Show default compiler binary F*2PP_Show default target cpu -F*2P<x>_Set target CPU (arm,i386,m68k,mips,mipsel,powerpc,powerpc64,sparc,x86_64 +F*2P<x>_Set target CPU (arm,i386,m68k,mips,mipsel,powerpc,powerpc64,sparc,x86_64) **1R<x>_Assembler reading style: **2Rdefault_Use default assembler for target 3*2Ratt_Read AT&T style assembler diff --git a/compiler/msgidx.inc b/compiler/msgidx.inc index 8b4a9af469..5cb8c96833 100644 --- a/compiler/msgidx.inc +++ b/compiler/msgidx.inc @@ -994,7 +994,7 @@ const option_info=11024; option_help_pages=11025; - MsgTxtSize = 71955; + MsgTxtSize = 72030; MsgIdxMax : array[1..20] of longint=( 26,99,339,123,89,57,126,27,202,64, diff --git a/compiler/msgtxt.inc b/compiler/msgtxt.inc index 5d9e98026e..a88223b68c 100644 --- a/compiler/msgtxt.inc +++ b/compiler/msgtxt.inc @@ -1,7 +1,7 @@ {$ifdef Delphi} -const msgtxt : array[0..000299] of string[240]=( +const msgtxt : array[0..000300] of string[240]=( {$else Delphi} -const msgtxt : array[0..000299,1..240] of char=( +const msgtxt : array[0..000300,1..240] of char=( {$endif Delphi} '01000_T_Compiler: $1'#000+ '01001_D_Compiler OS: $1'#000+ @@ -1257,399 +1257,401 @@ const msgtxt : array[0..000299,1..240] of char=( ' http://www.freepascal.org'#000+ '11025_**0*_Put + after a boolean switch option to enable it, - to',' di'+ 'sable it'#010+ + '**1@<x>_Read compiler options from <x> in addition to the default fpc.'+ + 'cfg'#010+ '**1a_The compiler does not delete the generated assembler file'#010+ '**2al_List sourcecode lines in assembler file'#010+ - '**2an_List node info in assembler file (-dEXTDEBUG compiler)'#010+ - '**2ao_Add an extra option to external assembler call (igno','red for in'+ - 'ternal)'#010+ + '**2an_List node info in assembler file (-dEXT','DEBUG compiler)'#010+ + '**2ao_Add an extra option to external assembler call (ignored for inte'+ + 'rnal)'#010+ '*L2ap_Use pipes instead of creating temporary assembler files'#010+ '**2ar_List register allocation/release info in assembler file'#010+ - '**2at_List temp allocation/release info in assembler file'#010+ + '**2at_List temp allocati','on/release info in assembler file'#010+ '**1A<x>_Output format:'#010+ - '**2Adefault_Use d','efault assembler'#010+ + '**2Adefault_Use default assembler'#010+ '3*2Aas_Assemble using GNU AS'#010+ '3*2Amacho_Mach-O (Darwin, Intel 32 bit) using internal writer'#010+ '8*2Anasm_Assemble using Nasm'#010+ - '8*2Anasmobj_Assemble using Nasm'#010+ + '8*2Anasmobj_Assemble using Na','sm'#010+ '3*2Anasm_Assemble using Nasm'#010+ - '3*2Anasmcoff_COFF (Go32v2) file using Nasm',#010+ + '3*2Anasmcoff_COFF (Go32v2) file using Nasm'#010+ '3*2Anasmelf_ELF32 (Linux) file using Nasm'#010+ '3*2Anasmwin32_Win32 object file using Nasm'#010+ '3*2Anasmwdosx_Win32/WDOSX object file using Nasm'#010+ - '3*2Anasmdarwin macho32 object file using Nasm (experimental)'#010+ + '3*2Anasmdarwin_macho32 object f','ile using Nasm (experimental)'#010+ '3*2Awasm_Obj file using Wasm (Watcom)'#010+ - '3*2Ana','smobj_Obj file using Nasm'#010+ + '3*2Anasmobj_Obj file using Nasm'#010+ '3*2Amasm_Obj file using Masm (Microsoft)'#010+ '3*2Atasm_Obj file using Tasm (Borland)'#010+ '3*2Aelf_ELF (Linux) using internal writer'#010+ - '3*2Acoff_COFF (Go32v2) using internal writer'#010+ - '3*2Apecoff_PE-COFF (Win32) using internal write','r'#010+ + '3*2Acoff_COFF (Go3','2v2) using internal writer'#010+ + '3*2Apecoff_PE-COFF (Win32) using internal writer'#010+ '3*2Ayasm_Assmeble using Yasm (experimental)'#010+ '4*2Aas_Assemble using GNU AS'#010+ '4*2Agas_Assemble using GNU GAS'#010+ '4*2Agas-darwin_Assemble darwin Mach-O64 using GNU GAS'#010+ - '4*2Amasm_Win64 object file using ml64 (Microsoft)'#010+ - '4*2Apecoff_PE-COFF (Win64) usi','ng internal writer'#010+ + '4*2Ama','sm_Win64 object file using ml64 (Microsoft)'#010+ + '4*2Apecoff_PE-COFF (Win64) using internal writer'#010+ '4*2Aelf_ELF (Linux-64bit) using internal writer'#010+ '4*2Ayasm_Assemble using Yasm (experimental)'#010+ '4*2Anasm_Assemble using Nasm (experimental)'#010+ - '4*2Anasmwin64_Assemble Win64 object file using Nasm (experimental)'#010+ - '4*2Anasmelf_Assem','ble Linux-64bit object file using Nasm (experimenta'+ - 'l)'#010+ + '4*2Anasmwi','n64_Assemble Win64 object file using Nasm (experimental)'#010+ + '4*2Anasmelf_Assemble Linux-64bit object file using Nasm (experimental)'+ + #010+ '4*2Anasmdarwin_Assemble darwin macho64 object file using Nasm (experim'+ 'ental)'#010+ '6*2Aas_Unix o-file using GNU AS'#010+ - '6*2Agas_GNU Motorola assembler'#010+ + '6*2','Agas_GNU Motorola assembler'#010+ '6*2Amit_MIT Syntax (old GAS)'#010+ - '6*2Amot_Standard ','Motorola assembler'#010+ + '6*2Amot_Standard Motorola assembler'#010+ 'A*2Aas_Assemble using GNU AS'#010+ 'P*2Aas_Assemble using GNU AS'#010+ 'S*2Aas_Assemble using GNU AS'#010+ '**1b_Generate browser info'#010+ - '**2bl_Generate local symbol info'#010+ + '**2bl_Generate local symbol info'#010, '**1B_Build all modules'#010+ '**1C<x>_Code generation options:'#010+ - '**2C3_Turn on ieee',' error checking for constants'#010+ + '**2C3_Turn on ieee error checking for constants'#010+ '**2Ca<x>_Select ABI, see fpc -i for possible values'#010+ '**2Cb_Generate code for a big-endian variant of the target architectur'+ 'e'#010+ - '**2Cc<x>_Set default calling convention to <x>'#010+ - '**2CD_Create also dynamic library (not ','supported)'#010+ + '**2Cc<x>_Set',' default calling convention to <x>'#010+ + '**2CD_Create also dynamic library (not supported)'#010+ '**2Ce_Compilation with emulated floating point opcodes'#010+ '**2Cf<x>_Select fpu instruction set to use, see fpc -i for possible va'+ 'lues'#010+ - '**2CF<x>_Minimal floating point constant precision (default, 32, 64)'#010+ + '**2CF<x>_Minimal floating',' point constant precision (default, 32, 64)'+ + #010+ '**2Cg_Generate PIC code'#010+ - '**2Ch<','n>_<n> bytes heap (between 1023 and 67107840)'#010+ + '**2Ch<n>_<n> bytes heap (between 1023 and 67107840)'#010+ '**2Ci_IO-checking'#010+ 'A*2CI<x>_Select instruction set on ARM: ARM or THUMB'#010+ '**2Cn_Omit linking stage'#010+ - 'P*2CN_Generate nil-pointer checks (AIX-only)'#010+ + 'P*2CN_Generate nil-point','er checks (AIX-only)'#010+ '**2Co_Check overflow of integer operations'#010+ - '**2CO_Chec','k for possible overflow of integer operations'#010+ + '**2CO_Check for possible overflow of integer operations'#010+ '**2Cp<x>_Select instruction set, see fpc -i for possible values'#010+ '**2CP<x>=<y>_ packing settings'#010+ - '**3CPPACKSET=<y>_ <y> set allocation: 0, 1 or DEFAULT or NORMAL, 2, 4 '+ - 'and 8'#010+ + '**3CPPACKSET=<y>_ <y> set',' allocation: 0, 1 or DEFAULT or NORMAL, 2, '+ + '4 and 8'#010+ '**2Cr_Range checking'#010+ - '**','2CR_Verify object method call validity'#010+ + '**2CR_Verify object method call validity'#010+ '**2Cs<n>_Set stack checking size to <n>'#010+ '**2Ct_Stack checking (for testing only, see manual)'#010+ - '8*2CT<x>_Target-specific code generation options'#010+ + '8*2CT<x>_Target-specific code gener','ation options'#010+ '3*2CT<x>_Target-specific code generation options'#010+ - '4*2CT<x>_Ta','rget-specific code generation options'#010+ + '4*2CT<x>_Target-specific code generation options'#010+ 'p*2CT<x>_Target-specific code generation options'#010+ 'P*2CT<x>_Target-specific code generation options'#010+ - 'J*2CT<x>_Target-specific code generation options'#010+ + 'J*2CT<x>_Target-specific code ','generation options'#010+ 'A*2CT<x>_Target-specific code generation options'#010+ - 'p*3CTs','malltoc_ Generate smaller TOCs at the expense of execution spe'+ - 'ed (AIX)'#010+ + 'p*3CTsmalltoc_ Generate smaller TOCs at the expense of execution speed'+ + ' (AIX)'#010+ 'P*3CTsmalltoc_ Generate smaller TOCs at the expense of execution speed'+ ' (AIX)'#010+ - 'J*3CTautogetterprefix=X_ Automatically create getters for properties '+ - 'with prefix X (empty s','tring disables)'#010+ + 'J*3CTautogetterpre','fix=X_ Automatically create getters for propertie'+ + 's with prefix X (empty string disables)'#010+ 'J*3CTautosetterprefix=X_ Automatically create setters for properties '+ 'with prefix X (empty string disables)'#010+ - '8*3CTcld_ Emit a CLD instruction before using the x86 '+ - 'string instructions'#010+ - '3*3CTcld_ ','Emit a CLD instruction before using the x8'+ + '8*3CTcld_ Emit a CLD instr','uction before using the x8'+ '6 string instructions'#010+ + '3*3CTcld_ Emit a CLD instruction before using the x86 '+ + 'string instructions'#010+ '4*3CTcld_ Emit a CLD instruction before using the x86 '+ 'string instructions'#010+ - 'J*3CTcompactintarrayinit_ Generate smaller (but potentially slower) co'+ - 'de for initializ','ing integer array constants'#010+ + 'J*3CTcompact','intarrayinit_ Generate smaller (but potentially slower) '+ + 'code for initializing integer array constants'#010+ 'J*3CTenumfieldinit_ Initialize enumeration fields in constructor'+ 's to enumtype(0), after calling inherited constructors'#010+ - 'J*3CTinitlocals_ Initialize local variables that trigger a JV'+ - 'M bytecode verifi','cation error if used uninitialized (slows down code'+ + 'J*3CTinitloca','ls_ Initialize local variables that trigger a '+ + 'JVM bytecode verification error if used uninitialized (slows down code'+ ')'#010+ 'J*3CTlowercaseprocstart_ Lowercase the first character of procedure/f'+ 'unction/method names'#010+ - 'A*3CTthumbinterworking_ Generate Thumb interworking-safe code if possi'+ - 'ble'#010+ - 'J*2Cv_Var/out paramete','r copy-out checking'#010+ + 'A*3CTthumbinterworking','_ Generate Thumb interworking-safe code if pos'+ + 'sible'#010+ + 'J*2Cv_Var/out parameter copy-out checking'#010+ '**2CX_Create also smartlinked library'#010+ '**1d<x>_Defines the symbol <x>'#010+ '**1D_Generate a DEF file'#010+ '**2Dd<x>_Set description to <x>'#010+ - '**2Dv<x>_Set DLL version to <x>'#010+ + '**2Dv<x>_Set DLL ver','sion to <x>'#010+ '*O2Dw_PM application'#010+ '**1e<x>_Set path to executable'#010+ - '**1E_Same ','as -Cn'#010+ + '**1E_Same as -Cn'#010+ '**1fPIC_Same as -Cg'#010+ '**1F<x>_Set file names and paths:'#010+ '**2Fa<x>[,y]_(for a program) load units <x> and [y] before uses is par'+ 'sed'#010+ - '**2Fc<x>_Set input codepage to <x>'#010+ + '**2Fc<x>_Set input codepage to ','<x>'#010+ '**2FC<x>_Set RC compiler binary name to <x>'#010+ - '**2Fd_Disable the compiler',#039's internal directory cache'#010+ + '**2Fd_Disable the compiler'#039's internal directory cache'#010+ '**2FD<x>_Set the directory where to search for compiler utilities'#010+ '**2Fe<x>_Redirect error output to <x>'#010+ - '**2Ff<x>_Add <x> to framework path (Darwin only)'#010+ + '**2Ff<x>_Add <x> to framework path',' (Darwin only)'#010+ '**2FE<x>_Set exe/unit output path to <x>'#010+ - '**2Fi<x>_Add <x> t','o include path'#010+ + '**2Fi<x>_Add <x> to include path'#010+ '**2Fl<x>_Add <x> to library path'#010+ '**2FL<x>_Use <x> as dynamic linker'#010+ '**2Fm<x>_Load unicode conversion table from <x>.txt in the compiler di'+ 'r'#010+ - '**2FM<x>_Set the directory where to search for unicode binary files'#010+ - '**2Fo<x>_Add <x> ','to object path'#010+ + '**2FM<x>_Se','t the directory where to search for unicode binary files'#010+ + '**2Fo<x>_Add <x> to object path'#010+ '**2Fr<x>_Load error message file <x>'#010+ '**2FR<x>_Set resource (.res) linker to <x>'#010+ '**2Fu<x>_Add <x> to unit path'#010+ - '**2FU<x>_Set unit output path to <x>, overrides -FE'#010+ - '**2FW<x>_Store generated whole-program optimization feedback in',' <x>'#010+ + '**2FU<x>_Set unit output path to <x>, ove','rrides -FE'#010+ + '**2FW<x>_Store generated whole-program optimization feedback in <x>'#010+ '**2Fw<x>_Load previously stored whole-program optimization feedback fr'+ 'om <x>'#010+ '*g1g_Generate debug information (default format for target)'#010+ - '*g2gc_Generate checks for pointers'#010+ - '*g2gh_Use heaptrace unit (for memory leak/corruption debugging)',#010+ + '*g2gc_Generate checks fo','r pointers'#010+ + '*g2gh_Use heaptrace unit (for memory leak/corruption debugging)'#010+ '*g2gl_Use line info unit (show more info with backtraces)'#010+ '*g2go<x>_Set debug information options'#010+ '*g3godwarfsets_ Enable DWARF '#039'set'#039' type debug information (bre'+ - 'aks gdb < 6.5)'#010+ - '*g3gostabsabsincludes_ Store absolute/full include file paths in ','Sta'+ - 'bs'#010+ + 'aks gd','b < 6.5)'#010+ + '*g3gostabsabsincludes_ Store absolute/full include file paths in Stabs'+ + #010+ '*g3godwarfmethodclassprefix_ Prefix method names in DWARF with class n'+ 'ame'#010+ '*g2gp_Preserve case in stabs symbol names'#010+ '*g2gs_Generate Stabs debug information'#010+ - '*g2gt_Trash local variables (to detect uninitialized uses)'#010+ - '*g2gv_Generates prog','rams traceable with Valgrind'#010+ + '*g2gt','_Trash local variables (to detect uninitialized uses)'#010+ + '*g2gv_Generates programs traceable with Valgrind'#010+ '*g2gw_Generate DWARFv2 debug information (same as -gw2)'#010+ '*g2gw2_Generate DWARFv2 debug information'#010+ - '*g2gw3_Generate DWARFv3 debug information'#010+ + '*g2gw3_Generate DWARFv3 debug informati','on'#010+ '*g2gw4_Generate DWARFv4 debug information (experimental)'#010+ - '**1i_Informati','on'#010+ + '**1i_Information'#010+ '**2iD_Return compiler date'#010+ '**2iV_Return short compiler version'#010+ '**2iW_Return full compiler version'#010+ '**2iSO_Return compiler OS'#010+ '**2iSP_Return compiler host processor'#010+ - '**2iTO_Return target OS'#010+ + '*','*2iTO_Return target OS'#010+ '**2iTP_Return target processor'#010+ - '**1I<x>_Add <x> to i','nclude path'#010+ + '**1I<x>_Add <x> to include path'#010+ '**1k<x>_Pass <x> to the linker'#010+ '**1l_Write logo'#010+ '**1M<x>_Set language mode to <x>'#010+ '**2Mfpc_Free Pascal dialect (default)'#010+ - '**2Mobjfpc_FPC mode with Object Pascal support'#010+ + '**2Mobjfpc_FPC mode with Object Pasc','al support'#010+ '**2Mdelphi_Delphi 7 compatibility mode'#010+ - '**2Mtp_TP/BP 7.0 compati','bility mode'#010+ + '**2Mtp_TP/BP 7.0 compatibility mode'#010+ '**2Mmacpas_Macintosh Pascal dialects compatibility mode'#010+ '**1n_Do not read the default config files'#010+ - '**1o<x>_Change the name of the executable produced to <x>'#010+ + '**1o<x>_Change the name of the executable produced to <x','>'#010+ '**1O<x>_Optimizations:'#010+ '**2O-_Disable optimizations'#010+ - '**2O1_Level 1 optimiz','ations (quick and debugger friendly)'#010+ + '**2O1_Level 1 optimizations (quick and debugger friendly)'#010+ '**2O2_Level 2 optimizations (-O1 + quick optimizations)'#010+ '**2O3_Level 3 optimizations (-O2 + slow optimizations)'#010+ - '**2O4_Level 4 optimizations (-O3 + optimizations which might have unex'+ - 'pected side effects)'#010+ - '*','*2Oa<x>=<y>_Set alignment'#010+ + '**2O4_Level 4 opti','mizations (-O3 + optimizations which might have un'+ + 'expected side effects)'#010+ + '**2Oa<x>=<y>_Set alignment'#010+ '**2Oo[NO]<x>_Enable or disable optimizations, see fpc -i for possible '+ 'values'#010+ - '**2Op<x>_Set target cpu for optimizing, see fpc -i for possible values'+ - #010+ - '**2OW<x>_Generate whole-program optimization feedback for optimiza','ti'+ - 'on <x>, see fpc -i for possible values'#010+ + '**2Op<x>_Set target cpu for optimizing, see fpc -i for possible',' valu'+ + 'es'#010+ + '**2OW<x>_Generate whole-program optimization feedback for optimization'+ + ' <x>, see fpc -i for possible values'#010+ '**2Ow<x>_Perform whole-program optimization <x>, see fpc -i for possib'+ 'le values'#010+ '**2Os_Optimize for size rather than speed'#010+ - '**1pg_Generate profile code for gprof (defines FPC_PROFILE)'#010+ - 'F*1P<x>_Target CP','U / compiler related options:'#010+ + '**1','pg_Generate profile code for gprof (defines FPC_PROFILE)'#010+ + 'F*1P<x>_Target CPU / compiler related options:'#010+ 'F*2PB_Show default compiler binary'#010+ 'F*2PP_Show default target cpu'#010+ 'F*2P<x>_Set target CPU (arm,i386,m68k,mips,mipsel,powerpc,powerpc64,sp'+ - 'arc,x86_64'#010+ + 'a','rc,x86_64)'#010+ '**1R<x>_Assembler reading style:'#010+ - '**2Rdefault_Use default assembl','er for target'#010+ + '**2Rdefault_Use default assembler for target'#010+ '3*2Ratt_Read AT&T style assembler'#010+ '3*2Rintel_Read Intel style assembler'#010+ '6*2RMOT_Read motorola style assembler'#010+ '**1S<x>_Syntax options:'#010+ - '**2S2_Same as -Mobjfpc'#010+ + '**2S2_Same as -Mob','jfpc'#010+ '**2Sc_Support operators like C (*=,+=,/= and -=)'#010+ - '**2Sa_Turn on asserti','ons'#010+ + '**2Sa_Turn on assertions'#010+ '**2Sd_Same as -Mdelphi'#010+ '**2Se<x>_Error options. <x> is a combination of the following:'#010+ '**3*_<n> : Compiler halts after the <n> errors (default is 1)'#010+ - '**3*_w : Compiler also halts after warnings'#010+ + '**3*_w : Comp','iler also halts after warnings'#010+ '**3*_n : Compiler also halts after notes'#010+ - '**3','*_h : Compiler also halts after hints'#010+ + '**3*_h : Compiler also halts after hints'#010+ '**2Sg_Enable LABEL and GOTO (default in -Mtp and -Mdelphi)'#010+ - '**2Sh_Use reference counted strings (ansistring by default) instead of'+ - ' shortstrings'#010+ - '**2Si_Turn on inlining of procedures/functions declared as ','"inline"'#010+ + '**2Sh_Use reference counted strings (ansistring by default) instead ','o'+ + 'f shortstrings'#010+ + '**2Si_Turn on inlining of procedures/functions declared as "inline"'#010+ '**2Sk_Load fpcylix unit'#010+ '**2SI<x>_Set interface style to <x>'#010+ '**3SIcom_COM compatible interface (default)'#010+ '**3SIcorba_CORBA compatible interface'#010+ - '**2Sm_Support macros like C (global)'#010+ + '**2Sm_Support ','macros like C (global)'#010+ '**2So_Same as -Mtp'#010+ - '**2Ss_Constructor name must be in','it (destructor must be done)'#010+ + '**2Ss_Constructor name must be init (destructor must be done)'#010+ '**2Sx_Enable exception keywords (default in Delphi/ObjFPC modes)'#010+ '**2Sy_@<pointer> returns a typed pointer, same as $T+'#010+ - '**1s_Do not call assembler and linker'#010+ + '**1s_Do not call ','assembler and linker'#010+ '**2sh_Generate script to link on host'#010+ - '**2st_Generate s','cript to link on target'#010+ + '**2st_Generate script to link on target'#010+ '**2sr_Skip register allocation phase (use with -alr)'#010+ '**1T<x>_Target operating system:'#010+ '3*2Tdarwin_Darwin/Mac OS X'#010+ - '3*2Temx_OS/2 via EMX (including EMX/RSX extender)'#010+ + '3*2Temx_OS/2 via EMX (includ','ing EMX/RSX extender)'#010+ '3*2Tfreebsd_FreeBSD'#010+ - '3*2Tgo32v2_Version 2 of DJ Delori','e DOS extender'#010+ + '3*2Tgo32v2_Version 2 of DJ Delorie DOS extender'#010+ '3*2Tiphonesim_ iPhoneSimulator from iOS SDK 3.2+ (older versions: -Tda'+ 'rwin)'#010+ '3*2Tlinux_Linux'#010+ '3*2Tnativent_Native NT API (experimental)'#010+ - '3*2Tnetbsd_NetBSD'#010+ + '3*2Tnetbsd_NetBS','D'#010+ '3*2Tnetware_Novell Netware Module (clib)'#010+ - '3*2Tnetwlibc_Novell Netware Modu','le (libc)'#010+ + '3*2Tnetwlibc_Novell Netware Module (libc)'#010+ '3*2Topenbsd_OpenBSD'#010+ '3*2Tos2_OS/2 / eComStation'#010+ '3*2Tsunos_SunOS/Solaris'#010+ '3*2Tsymbian_Symbian OS'#010+ '3*2Tsolaris_Solaris'#010+ - '3*2Twatcom_Watcom compatible DOS extender'#010+ + '3*2Twatcom_Watcom compatible DOS extender',#010+ '3*2Twdosx_WDOSX DOS extender'#010+ '3*2Twin32_Windows 32 Bit'#010+ - '3*2Twince_Windows CE',#010+ + '3*2Twince_Windows CE'#010+ '4*2Tdarwin_Darwin/Mac OS X'#010+ '4*2Tlinux_Linux'#010+ '4*2Twin64_Win64 (64 bit Windows systems)'#010+ '6*2Tamiga_Commodore Amiga'#010+ '6*2Tatari_Atari ST/STe/TT'#010+ '6*2Tlinux_Linux'#010+ - '6*2Tpalmos_PalmOS'#010+ + '6*2Tpalmos_P','almOS'#010+ 'A*2Tdarwin_Darwin/iPhoneOS/iOS'#010+ 'A*2Tlinux_Linux'#010+ 'A*2Twince_Windows CE'#010+ - 'P','*2Tamiga_AmigaOS'#010+ + 'P*2Tamiga_AmigaOS'#010+ 'P*2Tdarwin_Darwin/Mac OS X'#010+ 'P*2Tlinux_Linux'#010+ 'P*2Tmacos_Mac OS (classic)'#010+ 'P*2Tmorphos_MorphOS'#010+ 'S*2Tsolaris_Solaris'#010+ 'S*2Tlinux_Linux'#010+ - '**1u<x>_Undefines the symbol <x>'#010+ + '**1u<x>_Undefines the ','symbol <x>'#010+ '**1U_Unit options:'#010+ - '**2Un_Do not check where the unit name matche','s the file name'#010+ + '**2Un_Do not check where the unit name matches the file name'#010+ '**2Ur_Generate release unit files (never automatically recompiled)'#010+ '**2Us_Compile a system unit'#010+ - '**1v<x>_Be verbose. <x> is a combination of the following letters:'#010+ - '**2*_e : Show errors (default) 0 : Show nothing (except ','errors'+ - ')'#010+ + '**1v<x>_Be verbose. <x> is a combination of the follow','ing letters:'#010+ + '**2*_e : Show errors (default) 0 : Show nothing (except errors)'#010+ '**2*_w : Show warnings u : Show unit info'#010+ '**2*_n : Show notes t : Show tried/used files'#010+ - '**2*_h : Show hints c : Show conditionals'#010+ - '**2*_i : Show general info d : Show debug in','fo'#010+ + '**2*_h : Show hints c',' : Show conditionals'#010+ + '**2*_i : Show general info d : Show debug info'#010+ '**2*_l : Show linenumbers r : Rhide/GCC compatibility mode'#010+ '**2*_s : Show time stamps q : Show message numbers'#010+ - '**2*_a : Show everything x : Executable info (Win32 only)'#010+ - '**2*_b : Write file names messages ',' p : Write tree.log with parse t'+ - 'ree'#010+ + '**2*_a : Show everything ',' x : Executable info (Win32 only'+ + ')'#010+ + '**2*_b : Write file names messages p : Write tree.log with parse tre'+ + 'e'#010+ '**2*_ with full path v : Write fpcdebug.txt with'#010+ - '**2*_ lots of debugging info'#010+ + '**2*_ lots of debugging info',#010+ '**2*_m<x>,<y> : Do not show messages numbered <x> and <y>'#010+ - 'F*1V<x>_Append '#039,'-<x>'#039' to the used compiler binary name (e.g. '+ - 'for version)'#010+ + 'F*1V<x>_Append '#039'-<x>'#039' to the used compiler binary name (e.g. f'+ + 'or version)'#010+ '**1W<x>_Target-specific options (targets)'#010+ '3*2WA_Specify native type application (Windows)'#010+ - '4*2WA_Specify native type application (Windows)'#010+ - 'A*2WA_Specify native type application (Windo','ws)'#010+ + '4*2WA_Specify nat','ive type application (Windows)'#010+ + 'A*2WA_Specify native type application (Windows)'#010+ '3*2Wb_Create a bundle instead of a library (Darwin)'#010+ 'P*2Wb_Create a bundle instead of a library (Darwin)'#010+ 'p*2Wb_Create a bundle instead of a library (Darwin)'#010+ - 'A*2Wb_Create a bundle instead of a library (Darwin)'#010+ - '4*2Wb_Create a bundle instea','d of a library (Darwin)'#010+ + 'A*2Wb','_Create a bundle instead of a library (Darwin)'#010+ + '4*2Wb_Create a bundle instead of a library (Darwin)'#010+ '3*2WB_Create a relocatable image (Windows, Symbian)'#010+ '3*2WBxxxx_Set image base to xxxx (Windows, Symbian)'#010+ - '4*2WB_Create a relocatable image (Windows)'#010+ + '4*2WB_Create a relocatable image (Win','dows)'#010+ '4*2WBxxxx_Set image base to xxxx (Windows)'#010+ - 'A*2WB_Create a relocatable',' image (Windows, Symbian)'#010+ + 'A*2WB_Create a relocatable image (Windows, Symbian)'#010+ 'A*2WBxxxx_Set image base to xxxx (Windows, Symbian)'#010+ '3*2WC_Specify console type application (EMX, OS/2, Windows)'#010+ - '4*2WC_Specify console type application (EMX, OS/2, Windows)'#010+ - 'A*2WC_Specify console type application (Wi','ndows)'#010+ + '4*2WC_Specify console type ','application (EMX, OS/2, Windows)'#010+ + 'A*2WC_Specify console type application (Windows)'#010+ 'P*2WC_Specify console type application (Classic Mac OS)'#010+ '3*2WD_Use DEFFILE to export functions of DLL or EXE (Windows)'#010+ - '4*2WD_Use DEFFILE to export functions of DLL or EXE (Windows)'#010+ - 'A*2WD_Use DEFFILE to export functions of DLL or EXE (','Windows)'#010+ + '4*2WD_Use DEFFILE to export functions of',' DLL or EXE (Windows)'#010+ + 'A*2WD_Use DEFFILE to export functions of DLL or EXE (Windows)'#010+ '3*2We_Use external resources (Darwin)'#010+ '4*2We_Use external resources (Darwin)'#010+ 'A*2We_Use external resources (Darwin)'#010+ 'P*2We_Use external resources (Darwin)'#010+ - 'p*2We_Use external resources (Darwin)'#010+ - '3*2WF_Specify full-screen type applicatio','n (EMX, OS/2)'#010+ + 'p*2W','e_Use external resources (Darwin)'#010+ + '3*2WF_Specify full-screen type application (EMX, OS/2)'#010+ '3*2WG_Specify graphic type application (EMX, OS/2, Windows)'#010+ '4*2WG_Specify graphic type application (EMX, OS/2, Windows)'#010+ - 'A*2WG_Specify graphic type application (Windows)'#010+ + 'A*2WG_Specify graphic type appl','ication (Windows)'#010+ 'P*2WG_Specify graphic type application (Classic Mac OS)'#010+ - '3','*2Wi_Use internal resources (Darwin)'#010+ + '3*2Wi_Use internal resources (Darwin)'#010+ '4*2Wi_Use internal resources (Darwin)'#010+ 'A*2Wi_Use internal resources (Darwin)'#010+ 'P*2Wi_Use internal resources (Darwin)'#010+ - 'p*2Wi_Use internal resources (Darwin)'#010+ - '3*2WI_Turn on/off the usage of import sections (Win','dows)'#010+ + 'p*2Wi_Use inte','rnal resources (Darwin)'#010+ + '3*2WI_Turn on/off the usage of import sections (Windows)'#010+ '4*2WI_Turn on/off the usage of import sections (Windows)'#010+ 'A*2WI_Turn on/off the usage of import sections (Windows)'#010+ '8*2Wm<x>_Set memory model'#010+ - '8*3WmTiny_Tiny memory model'#010+ + '8*3WmTiny_Tiny memo','ry model'#010+ '8*3WmSmall_Small memory model (default)'#010+ - '8*3WmMedium_Medium memory ','model'#010+ + '8*3WmMedium_Medium memory model'#010+ '8*3WmCompact_Compact memory model'#010+ '8*3WmLarge_Large memory model'#010+ '3*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+ 'n)'#010+ - '4*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+ - 'n)'#010+ - 'p*2WM<x>_Minimum Mac OS ','X deployment version: 10.4, 10.5.1, ... (Dar'+ + '4*2WM<x>_Minimum Mac O','S X deployment version: 10.4, 10.5.1, ... (Dar'+ 'win)'#010+ + 'p*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+ + 'n)'#010+ 'P*2WM<x>_Minimum Mac OS X deployment version: 10.4, 10.5.1, ... (Darwi'+ 'n)'#010+ - '3*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+ - '4*2WN_Do not generate relocation code, needed fo','r debugging (Windows'+ + '3*2WN_Do not generate relocation code, need','ed for debugging (Windows'+ ')'#010+ + '4*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+ 'A*2WN_Do not generate relocation code, needed for debugging (Windows)'#010+ 'A*2Wpxxxx_Specify the controller type, see fpc -i for possible values'#010+ - 'V*2Wpxxxx_Specify the controller type, see fpc -i for possible values'#010+ - '3*2WP<x>','_Minimum iOS deployment version: 3.0, 5.0.1, ... (iphonesim)'+ - #010+ + 'V*2','Wpxxxx_Specify the controller type, see fpc -i for possible value'+ + 's'#010+ + '3*2WP<x>_Minimum iOS deployment version: 3.0, 5.0.1, ... (iphonesim)'#010+ 'A*2WP<x>_Minimum iOS deployment version: 3.0, 5.0.1, ... (Darwin)'#010+ - '3*2WR_Generate relocation code (Windows)'#010+ + '3*2WR_Generate relocation code (Window','s)'#010+ '4*2WR_Generate relocation code (Windows)'#010+ - 'A*2WR_Generate relocation code ','(Windows)'#010+ + 'A*2WR_Generate relocation code (Windows)'#010+ '8*2Wt<x>_Set the target executable format'#010+ '8*3Wtexe_Create a DOS .EXE file (default)'#010+ '8*3Wtcom_Create a DOS .COM file (requires tiny memory model)'#010+ - 'P*2WT_Specify MPW tool type application (Classic Mac OS)'#010+ - '**2WX_Enable executable stac','k (Linux)'#010+ + 'P*2WT_Spec','ify MPW tool type application (Classic Mac OS)'#010+ + '**2WX_Enable executable stack (Linux)'#010+ '**1X_Executable options:'#010+ '**2Xc_Pass --shared/-dynamic to the linker (BeOS, Darwin, FreeBSD, Lin'+ 'ux)'#010+ - '**2Xd_Do not search default library path (sometimes required for cross'+ - '-compiling when not using -XR)'#010+ + '**2Xd_Do not search default library path (sometimes requ','ired for cro'+ + 'ss-compiling when not using -XR)'#010+ '**2Xe_Use external linker'#010+ - '**2X','g_Create debuginfo in a separate file and add a debuglink sectio'+ - 'n to executable'#010+ + '**2Xg_Create debuginfo in a separate file and add a debuglink section '+ + 'to executable'#010+ '**2XD_Try to link units dynamically (defines FPC_LINK_DYNAMIC)'#010+ - '**2Xi_Use internal linker'#010+ + '**2Xi_Use interna','l linker'#010+ '**2Xm_Generate link map'#010+ - '**2XM<x>_Set the name of the '#039'main'#039' progra','m routine (default'+ - ' is '#039'main'#039')'#010+ + '**2XM<x>_Set the name of the '#039'main'#039' program routine (default i'+ + 's '#039'main'#039')'#010+ 'F*2Xp<x>_First search for the compiler binary in the directory <x>'#010+ '**2XP<x>_Prepend the binutils names with the prefix <x>'#010+ - '**2Xr<x>_Set the linker'#039's rlink-path to <x> (needed for cross comp'+ - 'ile, see the ld manua','l for more information) (BeOS, Linux)'#010+ + '**2Xr<x>_Set',' the linker'#039's rlink-path to <x> (needed for cross co'+ + 'mpile, see the ld manual for more information) (BeOS, Linux)'#010+ '**2XR<x>_Prepend <x> to all linker search paths (BeOS, Darwin, FreeBSD'+ ', Linux, Mac OS, Solaris)'#010+ - '**2Xs_Strip all symbols from executable'#010+ - '**2XS_Try to link units statically (default, defines FPC_LINK_STAT','IC'+ - ')'#010+ + '**2Xs_Strip all symbols from ex','ecutable'#010+ + '**2XS_Try to link units statically (default, defines FPC_LINK_STATIC)'#010+ '**2Xt_Link with static libraries (-static is passed to linker)'#010+ '**2XX_Try to smartlink units (defines FPC_LINK_SMART)'#010+ '**1*_'#010+ '**1?_Show this help'#010+ - '**1h_Shows this help without waiting' + '**1h_S','hows this help without waiting' ); diff --git a/compiler/nadd.pas b/compiler/nadd.pas index df41979b39..da5c15525d 100644 --- a/compiler/nadd.pas +++ b/compiler/nadd.pas @@ -73,6 +73,10 @@ interface { full 64 bit multiplies. } function use_generic_mul64bit: boolean; virtual; + { shall be overriden if the target cpu supports + an fma instruction + } + function use_fma : boolean; virtual; { This routine calls internal runtime library helpers for all floating point arithmetic in the case where the emulation switches is on. Otherwise @@ -80,18 +84,22 @@ interface the code generation phase. } function first_addfloat : tnode; virtual; - private - { checks whether a muln can be calculated as a 32bit } - { * 32bit -> 64 bit } - function try_make_mul32to64: boolean; - { Match against the ranges, i.e.: - var a:1..10; - begin - if a>0 then - ... - always evaluates to true. (DM) - } - function cmp_of_disjunct_ranges(var res : boolean) : boolean; + private + { checks whether a muln can be calculated as a 32bit } + { * 32bit -> 64 bit } + function try_make_mul32to64: boolean; + + { Match against the ranges, i.e.: + var a:1..10; + begin + if a>0 then + ... + always evaluates to true. (DM) + } + function cmp_of_disjunct_ranges(var res : boolean) : boolean; + + { tries to replace the current node by a fma node } + function try_fma(ld,rd : tdef) : tnode; end; taddnodeclass = class of taddnode; @@ -1013,6 +1021,14 @@ implementation change : boolean; {$endif} + function maybe_cast_ordconst(var n: tnode; adef: tdef): boolean; + begin + result:=(tordconstnode(n).value>=torddef(adef).low) and + (tordconstnode(n).value<=torddef(adef).high); + if result then + inserttypeconv(n,adef); + end; + begin result:=nil; rlow:=0; @@ -1420,6 +1436,18 @@ implementation inserttypeconv(right,nd); end; end + { don't extend (sign-mismatched) comparisons if either side is a constant + whose value is within range of opposite side } + else if is_integer(ld) and is_integer(rd) and + (nodetype in [equaln,unequaln,gtn,gten,ltn,lten]) and + (is_signed(ld)<>is_signed(rd)) and + ( + ((lt=ordconstn) and maybe_cast_ordconst(left,rd)) or + ((rt=ordconstn) and maybe_cast_ordconst(right,ld)) + ) then + begin + { done here } + end { is there a signed 64 bit type ? } else if ((torddef(rd).ordtype=s64bit) or (torddef(ld).ordtype=s64bit)) then begin @@ -1697,9 +1725,10 @@ implementation begin hp:=getcopy; include(hp.flags,nf_has_pointerdiv); - result:=cmoddivnode.create(divn,hp,cordconstnode.create(tpointerdef(rd).pointeddef.size,sinttype,false)); + result:=cmoddivnode.create(divn,hp, + cordconstnode.create(tpointerdef(rd).pointeddef.size,tpointerdef(rd).pointer_subtraction_result_type,false)); end; - resultdef:=sinttype; + resultdef:=tpointerdef(rd).pointer_subtraction_result_type; exit; end; else @@ -1966,9 +1995,11 @@ implementation end else resultdef:=right.resultdef; - inserttypeconv(left,get_int_type_for_pointer_arithmetic(rd)); + inserttypeconv(left,tpointerdef(right.resultdef).pointer_arithmetic_int_type); if nodetype=addn then begin + if (rt=niln) then + CGMessage3(type_e_operator_not_supported_for_types,node2opstr(nodetype),ld.typename,'NIL'); if not(cs_extsyntax in current_settings.moduleswitches) or (not (is_pchar(ld) or is_chararray(ld) or is_open_chararray(ld) or is_widechar(ld) or is_widechararray(ld) or is_open_widechararray(ld)) and not(cs_pointermath in current_settings.localswitches) and @@ -1978,7 +2009,7 @@ implementation (tpointerdef(rd).pointeddef.size>1) then begin left:=caddnode.create(muln,left, - cordconstnode.create(tpointerdef(rd).pointeddef.size,get_int_type_for_pointer_arithmetic(rd),true)); + cordconstnode.create(tpointerdef(rd).pointeddef.size,tpointerdef(right.resultdef).pointer_arithmetic_int_type,true)); typecheckpass(left); end; end @@ -1997,7 +2028,7 @@ implementation else resultdef:=left.resultdef; - inserttypeconv(right,get_int_type_for_pointer_arithmetic(ld)); + inserttypeconv(right,tpointerdef(left.resultdef).pointer_arithmetic_int_type); if nodetype in [addn,subn] then begin if (lt=niln) then @@ -2014,7 +2045,7 @@ implementation if (tpointerdef(ld).pointeddef.size>1) then begin right:=caddnode.create(muln,right, - cordconstnode.create(tpointerdef(ld).pointeddef.size,get_int_type_for_pointer_arithmetic(ld),true)); + cordconstnode.create(tpointerdef(ld).pointeddef.size,tpointerdef(left.resultdef).pointer_arithmetic_int_type,true)); typecheckpass(right); end end else @@ -2022,7 +2053,7 @@ implementation (tarraydef(ld).elementdef.size>1) then begin right:=caddnode.create(muln,right, - cordconstnode.create(tarraydef(ld).elementdef.size,get_int_type_for_pointer_arithmetic(ld),true)); + cordconstnode.create(tarraydef(ld).elementdef.size,tpointerdef(left.resultdef).pointer_arithmetic_int_type,true)); typecheckpass(right); end; end @@ -2589,6 +2620,127 @@ implementation end; + function taddnode.use_fma : boolean; + begin + result:=false; + end; + + + function taddnode.try_fma(ld,rd : tdef) : tnode; + var + inlinennr : Integer; + begin + result:=nil; + if (cs_opt_fastmath in current_settings.optimizerswitches) and + use_fma and + (nodetype in [addn,subn]) and + (rd.typ=floatdef) and (ld.typ=floatdef) and + (is_single(rd) or is_double(rd)) and + equal_defs(rd,ld) and + { transforming a*b+c into fma(a,b,c) makes only sense if c can be + calculated easily. Consider a*b+c*d which results in + + fmul + fmul + fadd + + and in + + fmul + fma + + when using the fma optimization. On a super scalar architecture, the first instruction + sequence requires clock_cycles(fmul)+clock_cycles(fadd) clock cycles because the fmuls can be executed in parallel. + The second sequence requires clock_cycles(fmul)+clock_cycles(fma) because the fma has to wait for the + result of the fmul. Since typically clock_cycles(fma)>clock_cycles(fadd) applies, the first sequence is better. + } + (((left.nodetype=muln) and (node_complexity(right)<3)) or + ((right.nodetype=muln) and (node_complexity(left)<3)) or + ((left.nodetype=inlinen) and + (tinlinenode(left).inlinenumber=in_sqr_real) and + (node_complexity(right)<3)) or + ((right.nodetype=inlinen) and + (tinlinenode(right).inlinenumber=in_sqr_real) and + (node_complexity(left)<3)) + ) then + begin + case tfloatdef(ld).floattype of + s32real: + inlinennr:=in_fma_single; + s64real: + inlinennr:=in_fma_double; + s80real: + inlinennr:=in_fma_extended; + s128real: + inlinennr:=in_fma_float128; + else + internalerror(2014042601); + end; + if left.nodetype=muln then + begin + if nodetype=subn then + result:=cinlinenode.create(inlinennr,false,ccallparanode.create(cunaryminusnode.create(right), + ccallparanode.create(taddnode(left).right, + ccallparanode.create(taddnode(left).left,nil + )))) + else + result:=cinlinenode.create(inlinennr,false,ccallparanode.create(right, + ccallparanode.create(taddnode(left).right, + ccallparanode.create(taddnode(left).left,nil + )))); + right:=nil; + taddnode(left).right:=nil; + taddnode(left).left:=nil; + end + else if right.nodetype=muln then + begin + if nodetype=subn then + result:=cinlinenode.create(inlinennr,false,ccallparanode.create(left, + ccallparanode.create(cunaryminusnode.create(taddnode(right).right), + ccallparanode.create(taddnode(right).left,nil + )))) + else + result:=cinlinenode.create(inlinennr,false,ccallparanode.create(left, + ccallparanode.create(taddnode(right).right, + ccallparanode.create(taddnode(right).left,nil + )))); + left:=nil; + taddnode(right).right:=nil; + taddnode(right).left:=nil; + end + else if (left.nodetype=inlinen) and (tinlinenode(left).inlinenumber=in_sqr_real) then + begin + if nodetype=subn then + result:=cinlinenode.create(inlinennr,false,ccallparanode.create(cunaryminusnode.create(right), + ccallparanode.create(tinlinenode(left).left.getcopy, + ccallparanode.create(tinlinenode(left).left.getcopy,nil + )))) + else + result:=cinlinenode.create(inlinennr,false,ccallparanode.create(right, + ccallparanode.create(tinlinenode(left).left.getcopy, + ccallparanode.create(tinlinenode(left).left.getcopy,nil + )))); + right:=nil; + end + { we get here only if right is a sqr node } + else if (right.nodetype=inlinen) and (tinlinenode(right).inlinenumber=in_sqr_real) then + begin + if nodetype=subn then + result:=cinlinenode.create(inlinennr,false,ccallparanode.create(left, + ccallparanode.create(cunaryminusnode.create(tinlinenode(right).left.getcopy), + ccallparanode.create(tinlinenode(right).left.getcopy,nil + )))) + else + result:=cinlinenode.create(inlinennr,false,ccallparanode.create(left, + ccallparanode.create(tinlinenode(right).left.getcopy, + ccallparanode.create(tinlinenode(right).left.getcopy,nil + )))); + left:=nil; + end; + end; + end; + + function taddnode.first_add64bitint: tnode; var procname: string[31]; @@ -3086,6 +3238,10 @@ implementation expectloc:=LOC_FPUREGISTER else expectloc:=LOC_FLAGS; + + result:=try_fma(ld,rd); + if assigned(result) then + exit; end { pointer comperation and subtraction } diff --git a/compiler/nbas.pas b/compiler/nbas.pas index fb12f8649f..da6e222a4c 100644 --- a/compiler/nbas.pas +++ b/compiler/nbas.pas @@ -258,7 +258,7 @@ interface { Create a blocknode and statement node for multiple statements generated internally by the parser } - function internalstatements(var laststatement:tstatementnode):tblocknode; + function internalstatements(out laststatement:tstatementnode):tblocknode; function laststatement(block:tblocknode):tstatementnode; procedure addstatement(var laststatement:tstatementnode;n:tnode); @@ -282,7 +282,7 @@ implementation Helpers *****************************************************************************} - function internalstatements(var laststatement:tstatementnode):tblocknode; + function internalstatements(out laststatement:tstatementnode):tblocknode; begin { create dummy initial statement } laststatement := cstatementnode.create(cnothingnode.create,nil); diff --git a/compiler/ncgcnv.pas b/compiler/ncgcnv.pas index ff6dec15d4..c0e6d0d539 100644 --- a/compiler/ncgcnv.pas +++ b/compiler/ncgcnv.pas @@ -120,12 +120,12 @@ interface { On targets without 8/16 bit register components, 8/16-bit operations always adjust high bits of result, see 'maybeadjustresult' method in respective cgcpu.pas. Therefore 8/16-bit locations are valid as larger - ones (except OS_S8->OS_16 which still needs high 16 bits cleared). } + ones (except signed->unsigned, which still needs high bits cleared). } else if (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) and - (tcgsize2size[(reg_cgsize(left.location.register))]=sizeof(aint)) and - (ressize>leftsize) and - (newsize in [OS_32,OS_S32,OS_16,OS_S16]) and - not ((newsize=OS_16) and (def_cgsize(left.resultdef)=OS_S8)) then + (tcgsize2size[(reg_cgsize(left.location.register))]=sizeof(aint)) and + (ressize>leftsize) and + (newsize in [OS_32,OS_S32,OS_16,OS_S16]) and + (not is_signed(left.resultdef) or is_signed(resultdef)) then location.size:=newsize {$endif} else diff --git a/compiler/ncgcon.pas b/compiler/ncgcon.pas index b6e050f9c7..64ded98177 100644 --- a/compiler/ncgcon.pas +++ b/compiler/ncgcon.pas @@ -498,7 +498,7 @@ implementation end else begin - location.value:=swapendian(Pcardinal(value_set)^); + location.value:=aint(swapendian(Pcardinal(value_set)^)); location.value:=aint( reverse_byte (location.value and $ff) or (reverse_byte((location.value shr 8) and $ff) shl 8) or diff --git a/compiler/nflw.pas b/compiler/nflw.pas index 5197d5130d..1909f04207 100644 --- a/compiler/nflw.pas +++ b/compiler/nflw.pas @@ -460,7 +460,7 @@ implementation if hp.resultdef.typ<>pointerdef then internalerror(2010061904); inserttypeconv(hp, - carraydef.create_from_pointer(tpointerdef(hp.resultdef).pointeddef)); + carraydef.create_from_pointer(tpointerdef(hp.resultdef))); hp:=cvecnode.create(hp,ctemprefnode.create(innerloopcounter)); addstatement(innerloopbodystatement, cassignmentnode.create(hloopvar,hp)); diff --git a/compiler/nmem.pas b/compiler/nmem.pas index c2bd94fce0..c629119ceb 100644 --- a/compiler/nmem.pas +++ b/compiler/nmem.pas @@ -106,6 +106,9 @@ interface tsubscriptnodeclass = class of tsubscriptnode; tvecnode = class(tbinarynode) + protected + function first_arraydef: tnode; virtual; + public constructor create(l,r : tnode);virtual; function pass_1 : tnode;override; function pass_typecheck:tnode;override; @@ -833,7 +836,7 @@ implementation function tvecnode.pass_typecheck:tnode; var hightree: tnode; - htype,elementdef : tdef; + htype,elementdef,elementptrdef : tdef; newordtyp: tordtype; valid : boolean; begin @@ -946,8 +949,10 @@ implementation else {Convert indexes into dynamically allocated strings to aword.} inserttypeconv(right,uinttype); + pointerdef: + inserttypeconv(right,tpointerdef(left.resultdef).pointer_arithmetic_int_type); else - {Others, i.e. pointer indexes to aint.} + {Others, (are there any?) indexes to aint.} inserttypeconv(right,sinttype); end; @@ -1014,7 +1019,7 @@ implementation ) then begin { convert pointer to array } - htype:=carraydef.create_from_pointer(tpointerdef(left.resultdef).pointeddef); + htype:=carraydef.create_from_pointer(tpointerdef(left.resultdef)); inserttypeconv(left,htype); if right.nodetype=rangen then resultdef:=htype @@ -1029,19 +1034,23 @@ implementation case tstringdef(left.resultdef).stringtype of st_unicodestring, st_widestring : - elementdef:=cwidechartype; - st_ansistring : - elementdef:=cansichartype; - st_longstring : - elementdef:=cansichartype; + begin + elementdef:=cwidechartype; + elementptrdef:=widecharpointertype; + end; + st_ansistring, + st_longstring, st_shortstring : - elementdef:=cansichartype; + begin + elementdef:=cansichartype; + elementptrdef:=charpointertype; + end; else internalerror(2013112902); end; if right.nodetype=rangen then begin - htype:=carraydef.create_from_pointer(elementdef); + htype:=carraydef.create_from_pointer(tpointerdef(elementptrdef)); resultdef:=htype; end else @@ -1100,17 +1109,32 @@ implementation tcallnode.gen_high_tree } if (right.nodetype=rangen) then CGMessagePos(right.fileinfo,parser_e_illegal_expression) - else if (not is_packed_array(left.resultdef)) or - ((tarraydef(left.resultdef).elepackedbitsize mod 8) = 0) then - if left.expectloc=LOC_CREFERENCE then - expectloc:=LOC_CREFERENCE - else - expectloc:=LOC_REFERENCE + else if left.resultdef.typ=arraydef then + result:=first_arraydef else - if left.expectloc=LOC_CREFERENCE then - expectloc:=LOC_CSUBSETREF - else - expectloc:=LOC_SUBSETREF; + begin + if left.expectloc=LOC_CREFERENCE then + expectloc:=LOC_CREFERENCE + else + expectloc:=LOC_REFERENCE + end; + end; + + + function tvecnode.first_arraydef: tnode; + begin + result:=nil; + if (not is_packed_array(left.resultdef)) or + ((tarraydef(left.resultdef).elepackedbitsize mod 8) = 0) then + if left.expectloc=LOC_CREFERENCE then + expectloc:=LOC_CREFERENCE + else + expectloc:=LOC_REFERENCE + else + if left.expectloc=LOC_CREFERENCE then + expectloc:=LOC_CSUBSETREF + else + expectloc:=LOC_SUBSETREF; end; diff --git a/compiler/options.pas b/compiler/options.pas index 258695620e..a5199fd47e 100644 --- a/compiler/options.pas +++ b/compiler/options.pas @@ -374,8 +374,11 @@ procedure Toption.WriteHelpPages; function PadEnd(s:string;i:longint):string; begin - while (length(s)<i) do - s:=s+' '; + if length(s) >= i then + S := S + ' ' + else + while (length(s)<i) do + s:=s+' '; PadEnd:=s; end; @@ -492,7 +495,7 @@ begin if opt='*' then opt:='' else - if opt=' ' then + if (opt=' ') or (opt[1]='@') then opt:=PadEnd(opt,outline) else opt:=PadEnd('-'+opt,outline); diff --git a/compiler/pgenutil.pas b/compiler/pgenutil.pas index 5b12b97ff7..2b0a3e3acf 100644 --- a/compiler/pgenutil.pas +++ b/compiler/pgenutil.pas @@ -590,6 +590,8 @@ uses found:=searchsym_in_class(tobjectdef(genericdef.owner.defowner),tobjectdef(genericdef.owner.defowner),ugenname,srsym,st,[]) else found:=searchsym_in_record(tabstractrecorddef(genericdef.owner.defowner),ugenname,srsym,st); + if not found then + found:=searchsym(ugenname,srsym,st); end else found:=searchsym(ugenname,srsym,st); diff --git a/compiler/ppcgen/cgppc.pas b/compiler/ppcgen/cgppc.pas index 088346bdca..5a5c11be3c 100644 --- a/compiler/ppcgen/cgppc.pas +++ b/compiler/ppcgen/cgppc.pas @@ -33,7 +33,6 @@ unit cgppc; type tcgppcgen = class(tcg) - procedure a_load_const_cgpara(list: TAsmList; size: tcgsize; a: tcgint; const paraloc : tcgpara); override; procedure a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const paraloc : tcgpara); override; procedure a_call_reg(list : TAsmList;reg: tregister); override; @@ -63,10 +62,6 @@ unit cgppc; procedure g_maybe_got_init(list: TAsmList); override; - { Transform unsupported methods into Internal errors } - procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); override; - procedure g_stackpointer_alloc(list : TAsmList;localsize : longint);override; - procedure get_aix_toc_sym(list: TAsmList; const symname: string; const flags: tindsymflags; out ref: treference; force_direct_toc: boolean); procedure g_load_check_simple(list: TAsmList; const ref: treference; size: aint); procedure g_external_wrapper(list: TAsmList; pd: TProcDef; const externalname: string); override; @@ -195,29 +190,6 @@ unit cgppc; end; - procedure tcgppcgen.a_load_const_cgpara(list: TAsmList; size: tcgsize; a: tcgint; const - paraloc: tcgpara); - var - ref: treference; - begin - paraloc.check_simple_location; - paramanager.allocparaloc(list,paraloc.location); - case paraloc.location^.loc of - LOC_REGISTER, LOC_CREGISTER: - a_load_const_reg(list, size, a, paraloc.location^.register); - LOC_REFERENCE: - begin - reference_reset(ref,paraloc.alignment); - ref.base := paraloc.location^.reference.index; - ref.offset := paraloc.location^.reference.offset; - a_load_const_ref(list, size, a, ref); - end; - else - internalerror(2002081101); - end; - end; - - procedure tcgppcgen.a_loadaddr_ref_cgpara(list : TAsmList;const r : treference;const paraloc : tcgpara); var ref: treference; @@ -603,17 +575,6 @@ unit cgppc; end; - procedure tcgppcgen.g_stackpointer_alloc(list : TAsmList;localsize : longint); - begin - Comment(V_Error,'tcgppcgen.g_stackpointer_alloc method not implemented'); - end; - - procedure tcgppcgen.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); - begin - Comment(V_Error,'tcgppcgen.a_bit_scan_reg_reg method not implemented'); - end; - - procedure tcgppcgen.g_overflowcheck(list: TAsmList; const l: tlocation; def: tdef); var hl : tasmlabel; diff --git a/compiler/ppu.pas b/compiler/ppu.pas index 141227eeaa..eebe8fd350 100644 --- a/compiler/ppu.pas +++ b/compiler/ppu.pas @@ -43,7 +43,7 @@ type {$endif Test_Double_checksum} const - CurrentPPUVersion = 170; + CurrentPPUVersion = 171; { buffer sizes } maxentrysize = 1024; diff --git a/compiler/rgobj.pas b/compiler/rgobj.pas index 1544ea03ab..e2173c3fbc 100644 --- a/compiler/rgobj.pas +++ b/compiler/rgobj.pas @@ -2191,7 +2191,7 @@ unit rgobj; if not spilled then exit; -{$if defined(x86) or defined(mips) or defined(sparc) or defined(arm)} +{$if defined(x86) or defined(mips) or defined(sparc) or defined(arm) or defined(m68k)} { Try replacing the register with the spilltemp. This is useful only for the i386,x86_64 that support memory locations for several instructions @@ -2206,7 +2206,7 @@ unit rgobj; mustbespilled:=false; end; end; -{$endif defined(x86) or defined(mips) or defined(sparc) or defined(arm)} +{$endif defined(x86) or defined(mips) or defined(sparc) or defined(arm) or defined(m68k)} { There are registers that need are spilled. We generate the diff --git a/compiler/sparc/cgcpu.pas b/compiler/sparc/cgcpu.pas index 1ff64c6f6c..ba3ac18a6d 100644 --- a/compiler/sparc/cgcpu.pas +++ b/compiler/sparc/cgcpu.pas @@ -90,9 +90,6 @@ interface procedure g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: tcgint);override; procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override; procedure g_external_wrapper(list : TAsmList; procdef: tprocdef; const externalname: string);override; - { Transform unsupported methods into Internal errors } - procedure a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); override; - procedure g_stackpointer_alloc(list : TAsmList;localsize : longint);override; private use_unlimited_pic_mode : boolean; end; @@ -1362,16 +1359,6 @@ implementation end; - procedure tcgsparc.g_stackpointer_alloc(list : TAsmList;localsize : longint); - begin - Comment(V_Error,'tcgsparc.g_stackpointer_alloc method not implemented'); - end; - - procedure tcgsparc.a_bit_scan_reg_reg(list: TAsmList; reverse: boolean; size: TCGSize; src, dst: TRegister); - begin - Comment(V_Error,'tcgsparc.a_bit_scan_reg_reg method not implemented'); - end; - {**************************************************************************** TCG64Sparc ****************************************************************************} diff --git a/compiler/symcreat.pas b/compiler/symcreat.pas index 2a387b9d3d..5631821f69 100644 --- a/compiler/symcreat.pas +++ b/compiler/symcreat.pas @@ -1037,7 +1037,8 @@ implementation i: longint; begin { add generic flag if required } - if df_generic in newstruct.defoptions then + if assigned(newstruct) and + (df_generic in newstruct.defoptions) then include(pd.defoptions,df_generic); { associate the procdef with a procsym in the owner } if not(pd.proctypeoption in [potype_class_constructor,potype_class_destructor]) then diff --git a/compiler/symdef.pas b/compiler/symdef.pas index 7745110f97..75cc529678 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -227,6 +227,16 @@ interface override ppuwrite_platform instead } procedure ppuwrite(ppufile:tcompilerppufile);override;final; function GetTypeName:string;override; + {# returns the appropriate int type for pointer arithmetic with the given pointer type. + When adding or subtracting a number to/from a pointer, this function returns the + int type to which that number has to be converted, before the operation can be performed. + Normally, this is sinttype, except on i8086, where it takes into account the + special i8086 pointer types (near, far, huge). } + function pointer_arithmetic_int_type:tdef;virtual; + {# returns the int type produced when subtracting two pointers of the given type. + Normally, this is sinttype, except on i8086, where it takes into account the + special i8086 pointer types (near, far, huge). } + function pointer_subtraction_result_type:tdef;virtual; end; tpointerdefclass = class of tpointerdef; @@ -249,6 +259,8 @@ interface constructor ppuload(dt:tdeftyp;ppufile:tcompilerppufile); procedure ppuwrite(ppufile:tcompilerppufile);override; destructor destroy; override; + procedure buildderefimpl;override; + procedure derefimpl;override; procedure check_forwards; virtual; function find_procdef_bytype(pt:tproctypeoption): tprocdef; function GetSymtable(t:tGetSymtable):TSymtable;override; @@ -294,7 +306,6 @@ interface override ppuwrite_platform instead } procedure ppuwrite(ppufile:tcompilerppufile);override;final; procedure buildderef;override; - procedure buildderefimpl;override; procedure deref;override; function size:asizeint;override; function alignment : shortint;override; @@ -401,7 +412,6 @@ interface function GetTypeName:string;override; procedure buildderef;override; procedure deref;override; - procedure buildderefimpl;override; procedure derefimpl;override; procedure resetvmtentries; procedure copyvmtentries(objdef:tobjectdef); @@ -470,7 +480,7 @@ interface function elesize : asizeint; function elepackedbitsize : asizeint; function elecount : asizeuint; - constructor create_from_pointer(def:tdef);virtual; + constructor create_from_pointer(def:tpointerdef);virtual; constructor create(l,h:asizeint;def:tdef);virtual; constructor ppuload(ppufile:tcompilerppufile); destructor destroy; override; @@ -3170,6 +3180,18 @@ implementation end; + function tpointerdef.pointer_arithmetic_int_type:tdef; + begin + result:=ptrsinttype; + end; + + + function tpointerdef.pointer_subtraction_result_type:tdef; + begin + result:=ptrsinttype; + end; + + {**************************************************************************** TCLASSREFDEF ****************************************************************************} @@ -3390,12 +3412,12 @@ implementation inherited; end; - constructor tarraydef.create_from_pointer(def:tdef); + constructor tarraydef.create_from_pointer(def:tpointerdef); begin { use -1 so that the elecount will not overflow } self.create(0,high(asizeint)-1,ptrsinttype); arrayoptions:=[ado_IsConvertedPointer]; - setelementdef(def); + setelementdef(def.pointeddef); end; @@ -3687,6 +3709,23 @@ implementation inherited destroy; end; + + procedure tabstractrecorddef.buildderefimpl; + begin + inherited buildderefimpl; + if not (df_copied_def in defoptions) then + tstoredsymtable(symtable).buildderefimpl; + end; + + + procedure tabstractrecorddef.derefimpl; + begin + inherited derefimpl; + if not (df_copied_def in defoptions) then + tstoredsymtable(symtable).derefimpl; + end; + + procedure tabstractrecorddef.check_forwards; begin { the defs of a copied def are defined for the original type only } @@ -4043,14 +4082,6 @@ implementation end; - procedure trecorddef.buildderefimpl; - begin - inherited buildderefimpl; - if not (df_copied_def in defoptions) then - tstoredsymtable(symtable).buildderefimpl; - end; - - procedure trecorddef.deref; begin inherited deref; @@ -4494,7 +4525,7 @@ implementation { in case of bare proc, don't copy self, vmt or framepointer parameters } if (copytyp=pc_bareproc) and - (([vo_is_self,vo_is_vmt,vo_is_parentfp,vo_is_result]*pvs.varoptions)<>[]) then + (([vo_is_self,vo_is_vmt,vo_is_parentfp,vo_is_result,vo_is_funcret]*pvs.varoptions)<>[]) then continue; npvs:=cparavarsym.create(pvs.realname,pvs.paranr,pvs.varspez, pvs.vardef,pvs.varoptions); @@ -5229,24 +5260,29 @@ implementation tprocdef(result).deprecatedmsg:=stringdup(deprecatedmsg^); { will have to be associated with appropriate procsym } tprocdef(result).procsym:=nil; + { don't create aliases for bare copies, nor copy the funcretsym as + the function result parameter will be inserted again if necessary + (e.g. if the calling convention is changed) } if copytyp<>pc_bareproc then - tprocdef(result).aliasnames.concatListcopy(aliasnames); - if assigned(funcretsym) then begin - if funcretsym.owner=parast then - begin - j:=parast.symlist.indexof(funcretsym); - if j<0 then - internalerror(2011040606); - tprocdef(result).funcretsym:=tsym(tprocdef(result).parast.symlist[j]); - end - else if funcretsym.owner=localst then + tprocdef(result).aliasnames.concatListcopy(aliasnames); + if assigned(funcretsym) then begin - { nothing to do, will be inserted for the new procdef while - parsing its body (by pdecsub.insert_funcret_local) } - end - else - internalerror(2011040605); + if funcretsym.owner=parast then + begin + j:=parast.symlist.indexof(funcretsym); + if j<0 then + internalerror(2011040606); + tprocdef(result).funcretsym:=tsym(tprocdef(result).parast.symlist[j]); + end + else if funcretsym.owner=localst then + begin + { nothing to do, will be inserted for the new procdef while + parsing its body (by pdecsub.insert_funcret_local) } + end + else + internalerror(2011040605); + end; end; { will have to be associated with a new struct } tprocdef(result).struct:=nil; @@ -6207,19 +6243,9 @@ implementation end; - procedure tobjectdef.buildderefimpl; - begin - inherited buildderefimpl; - if not (df_copied_def in defoptions) then - tstoredsymtable(symtable).buildderefimpl; - end; - - procedure tobjectdef.derefimpl; begin inherited derefimpl; - if not (df_copied_def in defoptions) then - tstoredsymtable(symtable).derefimpl; { the procdefs are not owned by the class helper procsyms, so they are not stored/restored either -> re-add them here } if (objecttype=odt_objcclass) or diff --git a/compiler/symsym.pas b/compiler/symsym.pas index 6f079bd9b4..1681391ce1 100644 --- a/compiler/symsym.pas +++ b/compiler/symsym.pas @@ -444,6 +444,14 @@ interface function GetCopy:tmacro; end; + { tPtrDefHashSet } + + tPtrDefHashSet = class(THashSet) + public + constructor Create;virtual; + end; + tPtrDefHashSetClass = class of tPtrDefHashSet; + var generrorsym : tsym; @@ -461,6 +469,7 @@ interface cconstsym: tconstsymclass; cenumsym: tenumsymclass; csyssym: tsyssymclass; + cPtrDefHashSet : tPtrDefHashSetClass = tPtrDefHashSet; { generate internal static field name based on regular field name } function internal_static_field_name(const fieldname: TSymStr): TSymStr; @@ -2699,4 +2708,14 @@ implementation Result:=p; end; + +{**************************************************************************** + tPtrDefHashSet + ****************************************************************************} + + constructor tPtrDefHashSet.Create; + begin + inherited Create(64,true,false); + end; + end. diff --git a/compiler/symtable.pas b/compiler/symtable.pas index 9c1f93c062..5bad798177 100644 --- a/compiler/symtable.pas +++ b/compiler/symtable.pas @@ -3329,7 +3329,9 @@ implementation end; end; { now search in the extended type itself } - if classh.extendeddef.typ in [recorddef,objectdef] then + { Note: the extendeddef might be Nil if we are currently parsing the + extended type itself and the identifier was not found } + if assigned(classh.extendeddef) and (classh.extendeddef.typ in [recorddef,objectdef]) then begin srsymtable:=tabstractrecorddef(classh.extendeddef).symtable; srsym:=tsym(srsymtable.FindWithHash(hashedid)); @@ -3472,7 +3474,7 @@ implementation sym:=tsym(systemunit.Find(s)); if not assigned(sym) or (sym.typ<>typesym) then - cgmessage1(cg_f_unknown_system_type,s); + message1(cg_f_unknown_system_type,s); result:=ttypesym(sym); end; @@ -3487,7 +3489,7 @@ implementation else begin if sym.typ<>typesym then - cgmessage1(cg_f_unknown_system_type,s); + message1(cg_f_unknown_system_type,s); result:=ttypesym(sym); end; end; @@ -3503,7 +3505,7 @@ implementation srsym:=tsym(systemunit.Find(upper(s))); if not assigned(srsym) or (srsym.typ<>procsym) then - cgmessage1(cg_f_unknown_compilerproc,s); + message1(cg_f_unknown_compilerproc,s); result:=tprocdef(tprocsym(srsym).procdeflist[0]); end; @@ -3523,7 +3525,7 @@ implementation else begin if throwerror then - cgmessage2(cg_f_unknown_type_in_unit,typename,unitname); + message2(cg_f_unknown_type_in_unit,typename,unitname); result:=nil; end; end; diff --git a/compiler/systems/i_linux.pas b/compiler/systems/i_linux.pas index 502d05c755..00e0f4d33b 100644 --- a/compiler/systems/i_linux.pas +++ b/compiler/systems/i_linux.pas @@ -170,6 +170,7 @@ unit i_linux; name : 'Linux for m68k'; shortname : 'Linux'; flags : [tf_needs_symbol_size,tf_needs_symbol_type,tf_files_case_sensitive, + tf_smartlink_sections, tf_requires_proper_alignment, { Coldfire seems to need this at least (KB) } tf_smartlink_library,tf_has_winlike_resources]; cpu : cpu_m68k; diff --git a/compiler/systems/t_linux.pas b/compiler/systems/t_linux.pas index 2e73b88361..dd43499fd3 100644 --- a/compiler/systems/t_linux.pas +++ b/compiler/systems/t_linux.pas @@ -151,8 +151,7 @@ begin end; {$ifdef m68k} - { experimental, is this correct? } - const defdynlinker='/lib/ld-linux.so.2'; + const defdynlinker='/lib/ld.so.1'; {$endif m68k} {$ifdef i386} diff --git a/compiler/systems/t_nds.pas b/compiler/systems/t_nds.pas index 16eab29b5e..52950c057a 100644 --- a/compiler/systems/t_nds.pas +++ b/compiler/systems/t_nds.pas @@ -243,20 +243,19 @@ begin begin if apptype=app_arm9 then //ARM9 begin - add('OUTPUT_FORMAT("elf32-littlearm", "elf32-bigarm", "elf32-littlearm")'); - add('OUTPUT_ARCH(arm)'); - add('ENTRY(_start)'); - add(''); add('MEMORY {'); - add(''); add(' rom : ORIGIN = 0x08000000, LENGTH = 32M'); add(' ewram : ORIGIN = 0x02000000, LENGTH = 4M - 4k'); add(' dtcm : ORIGIN = 0x0b000000, LENGTH = 16K'); - add(' vectors : ORIGIN = 0x01000000, LENGTH = 256'); - add(' itcm : ORIGIN = 0x01000100, LENGTH = 32K - 256'); + add(' vectors : ORIGIN = 0x01000000, LENGTH = 256'); + add(' itcm : ORIGIN = 0x01000100, LENGTH = 32K - 256'); add('}'); add(''); - add('__vectors_start = ORIGIN(vectors);'); + add('OUTPUT_ARCH(arm)'); + add('OUTPUT_FORMAT("elf32-littlearm", "elf32-bigarm", "elf32-littlearm")'); + add('ENTRY(_start)'); + add(''); + add('__vectors_start = ORIGIN(vectors);'); add('__itcm_start = ORIGIN(itcm);'); add('__ewram_end = ORIGIN(ewram) + LENGTH(ewram);'); add('__eheap_end = ORIGIN(ewram) + LENGTH(ewram);'); @@ -276,7 +275,7 @@ begin add(' __text_start = . ;'); add(' KEEP (*(.init))'); add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); - add(' } >ewram = 0xff'); + add(' } >ewram = 0xff'); add(''); add(' .plt : { *(.plt) } >ewram = 0xff'); add(''); @@ -312,36 +311,40 @@ begin add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); add(' } >ewram = 0xff'); add(''); - add(' .ARM.extab : { *(.ARM.extab* .gnu.linkonce.armextab.*) } >ewram'); - add(' __exidx_start = .;'); - add(' .ARM.exidx : { *(.ARM.exidx* .gnu.linkonce.armexidx.*) } >ewram'); - add(' __exidx_end = .;'); - add(' /* Ensure the __preinit_array_start label is properly aligned. We'); - add(' could instead move the label definition inside the section, but'); - add(' the linker would then create the section even if it turns out to'); - add(' be empty, which isn''t pretty. */'); - add(' . = ALIGN(32 / 8);'); - add(' PROVIDE (__preinit_array_start = .);'); - add(' .preinit_array : { KEEP (*(.preinit_array)) } >ewram = 0xff'); - add(' PROVIDE (__preinit_array_end = .);'); - add(' PROVIDE (__init_array_start = .);'); - add(' .init_array :'); - add(' {'); - add(' KEEP (*(SORT(.init_array.*)))'); - add(' KEEP (*(.init_array))'); - add(' } >ewram = 0xff'); - add(' PROVIDE (__init_array_end = .);'); - add(' PROVIDE (__fini_array_start = .);'); - add(' .fini_array :'); - add(' {'); - add(' KEEP (*(.fini_array))'); - add(' KEEP (*(SORT(.fini_array.*)))'); - add(' } >ewram = 0xff'); - add(' PROVIDE (__fini_array_end = .);'); + add(' .ARM.extab : { *(.ARM.extab* .gnu.linkonce.armextab.*) } >ewram'); + add(' __exidx_start = .;'); + add(' ARM.exidx : { *(.ARM.exidx* .gnu.linkonce.armexidx.*) } >ewram'); + add(' __exidx_end = .;'); + add(''); + add(' /* Ensure the __preinit_array_start label is properly aligned. We'); + add(' could instead move the label definition inside the section, but'); + add(' the linker would then create the section even if it turns out to'); + add(' be empty, which isn''t pretty. */'); + add(''); + add(' . = ALIGN(32 / 8);'); + add(''); + add(' PROVIDE (__preinit_array_start = .);'); + add(' .preinit_array : { KEEP (*(.preinit_array)) } >ewram = 0xff'); + add(' PROVIDE (__preinit_array_end = .);'); + add(' PROVIDE (__init_array_start = .);'); + add(' .init_array :'); + add(' {'); + add(' KEEP (*(SORT(.init_array.*)))'); + add(' KEEP (*(.init_array))'); + add(' } >ewram = 0xff'); + add(' PROVIDE (__init_array_end = .);'); + add(' PROVIDE (__fini_array_start = .);'); + add(' .fini_array :'); + add(' {'); + add(' KEEP (*(.fini_array))'); + add(' KEEP (*(SORT(.fini_array.*)))'); + add(' } >ewram = 0xff'); + add(''); + add(' PROVIDE (__fini_array_end = .);'); add(''); add(' .ctors :'); add(' {'); - add(' /* gcc uses crtbegin.o to find the start of the constructors, so'); + add(' /* gcc uses crtbegin.o to find the start of the constructors, so'); add(' we make sure it is first. Because this is a wildcard, it'); add(' doesn''t matter if the user does not actually link against'); add(' crtbegin.o; the linker won''t look for a file to match a'); @@ -392,7 +395,6 @@ begin add(' *(.data)'); add(' *(.data.*)'); add(' *(.gnu.linkonce.d*)'); - add(' *(.fpc*)'); add(' CONSTRUCTORS'); add(' . = ALIGN(4);'); add(' __data_end = ABSOLUTE(.) ;'); @@ -408,7 +410,7 @@ begin add(' *(.dtcm.*)'); add(' . = ALIGN(4);'); add(' __dtcm_end = ABSOLUTE(.);'); - add(' } >dtcm = 0xff'); + add(' } >dtcm = 0xff'); add(''); add(''); add(' __itcm_lma = __dtcm_lma + SIZEOF(.dtcm);'); @@ -420,29 +422,27 @@ begin add(' . = ALIGN(4);'); add(' __itcm_end = ABSOLUTE(.);'); add(' } >itcm = 0xff'); + add(' '); + add(' __vectors_lma = __itcm_lma + SIZEOF(.itcm);'); add(''); - - add(' __vectors_lma = __itcm_lma + SIZEOF(.itcm);'); - add(' .vectors __vectors_start : AT (__vectors_lma)'); - add(' {'); - add(' *(.vectors)'); - add(' *vectors.*(.text)'); - add(' . = ALIGN(4);'); - add(' __vectors_end = ABSOLUTE(.);'); - add(' } >vectors = 0xff'); - add(''); - add(' .sbss __dtcm_end (NOLOAD):'); + add(' .vectors __vectors_start : AT (__vectors_lma)'); + add(' {'); + add(' *(.vectors)'); + add(' *vectors.*(.text)'); + add(' . = ALIGN(4);'); + add(' __vectors_end = ABSOLUTE(.);'); + add(' } >vectors = 0xff'); + add(' '); + add(' .sbss __dtcm_end (NOLOAD): '); add(' {'); add(' __sbss_start = ABSOLUTE(.);'); add(' __sbss_start__ = ABSOLUTE(.);'); add(' *(.sbss)'); add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); add(' __sbss_end = ABSOLUTE(.);'); - add(' } >dtcm'); - add(''); - add(''); + add(' } >dtcm '); add(''); - add(' .bss __bss_vma (NOLOAD):'); + add(' .bss __bss_vma (NOLOAD): '); add(' {'); add(' __bss_start = ABSOLUTE(.);'); add(' __bss_start__ = ABSOLUTE(.);'); @@ -453,7 +453,8 @@ begin add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); add(' __bss_end__ = ABSOLUTE(.) ;'); add(' __end__ = ABSOLUTE(.) ;'); - add(' } AT>ewram'); + add(' } AT>ewram '); + add(''); add(''); add(''); add(' /* Stabs debugging sections. */'); @@ -492,6 +493,7 @@ begin add(' .stack 0x80000 : { _stack = .; *(.stack) }'); add(' /* These must appear regardless of . */'); add('}'); + add(''); end; if apptype=app_arm7 then begin @@ -501,12 +503,13 @@ begin add(''); add('MEMORY {'); add(''); - add(' rom : ORIGIN = 0x08000000, LENGTH = 32M'); - add(' iwram : ORIGIN = 0x037f8000, LENGTH = 96K'); + add(' rom : ORIGIN = 0x08000000, LENGTH = 32M'); + add(' iwram : ORIGIN = 0x037f8000, LENGTH = 96K '); add('}'); add(''); add('__iwram_start = ORIGIN(iwram);'); add('__iwram_top = ORIGIN(iwram)+ LENGTH(iwram);'); + add(''); add('__sp_irq = __iwram_top - 0x100;'); add('__sp_svc = __sp_irq - 0x100;'); add('__sp_usr = __sp_svc - 0x100;'); @@ -527,9 +530,8 @@ begin add(''); add(' .text : /* ALIGN (4): */'); add(' {'); - add(''); - add(' *(.text .stub .text.* .gnu.linkonce.t.*)'); - add(' KEEP (*(.text.*personality*))'); + add(' *(.text .stub .text.* .gnu.linkonce.t.*)'); + add(' KEEP (*(.text.*personality*))'); add(' /* .gnu.warning sections are handled specially by elf32.em. */'); add(' *(.gnu.warning)'); add(' *(.glue_7t) *(.glue_7) *(.vfp11_veneer)'); @@ -612,30 +614,16 @@ begin add(' .jcr : { KEEP (*(.jcr)) } >iwram = 0'); add(' .got : { *(.got.plt) *(.got) } >iwram = 0'); add(''); - add(''); - add(' .iwram ALIGN(4) :'); - add(' {'); - add(' __iwram_start = ABSOLUTE(.) ;'); - add(' *(.iwram)'); - add(' *iwram.*(.text)'); - add(' . = ALIGN(4); /* REQUIRED. LD is flaky without it. */'); - add(' __iwram_end = ABSOLUTE(.) ;'); - add(' } >iwram = 0xff'); - add(''); - add(''); add(' .data ALIGN(4) : {'); add(' __data_start = ABSOLUTE(.);'); add(' *(.data)'); add(' *(.data.*)'); add(' *(.gnu.linkonce.d*)'); - add(' *(.fpc*)'); add(' CONSTRUCTORS'); add(' . = ALIGN(4);'); add(' __data_end = ABSOLUTE(.) ;'); add(' } >iwram = 0xff'); add(''); - add(''); - add(''); add(' .bss ALIGN(4) :'); add(' {'); add(' __bss_start = ABSOLUTE(.);'); diff --git a/compiler/utils/ppuutils/ppudump.pp b/compiler/utils/ppuutils/ppudump.pp index 1038d5c542..e336731ca0 100644 --- a/compiler/utils/ppuutils/ppudump.pp +++ b/compiler/utils/ppuutils/ppudump.pp @@ -2865,6 +2865,8 @@ begin writeln([space,' Range : ',arrdef.RangeLow,' to ',arrdef.RangeHigh]); write ([space,' Options : ']); readarraydefoptions(arrdef); + if tsystemcpu(ppufile.header.cpu)=cpu_i8086 then + writeln([space,' Huge : ',(getbyte<>0)]); readsymtable('symbols', arrdef); end; diff --git a/compiler/wpoinfo.pas b/compiler/wpoinfo.pas index 15ea2c2b01..72a9677016 100644 --- a/compiler/wpoinfo.pas +++ b/compiler/wpoinfo.pas @@ -142,7 +142,7 @@ implementation begin { load start of definition section, which holds the amount of defs } if ppufile.readentry<>ibcreatedobjtypes then - cgmessage(unit_f_ppu_read_error); + message(unit_f_ppu_read_error); { don't load the wpo info from the units if we are not generating a wpo feedback file (that would just take time and memory) diff --git a/compiler/x86/nx86add.pas b/compiler/x86/nx86add.pas index 1f147bec76..41be991e0d 100644 --- a/compiler/x86/nx86add.pas +++ b/compiler/x86/nx86add.pas @@ -47,6 +47,7 @@ unit nx86add; procedure second_addfloatsse; procedure second_addfloatavx; public + function use_fma : boolean;override; procedure second_addfloat;override; {$ifndef i8086} procedure second_addsmallset;override; @@ -273,6 +274,15 @@ unit nx86add; procedure tx86addnode.prepare_x87_locations(out refnode: tnode); begin refnode:=nil; + + { later on, no mm registers are allowed, so transfer everything to memory here + below it is loaded into an fpu register if neede } + if left.location.loc in [LOC_CMMREGISTER,LOC_MMREGISTER] then + hlcg.location_force_mem(current_asmdata.CurrAsmList,left.location,left.resultdef); + + if right.location.loc in [LOC_CMMREGISTER,LOC_MMREGISTER] then + hlcg.location_force_mem(current_asmdata.CurrAsmList,right.location,right.resultdef); + case ord(left.location.loc=LOC_FPUREGISTER)+ord(right.location.loc=LOC_FPUREGISTER) of 0: begin @@ -1072,6 +1082,18 @@ unit nx86add; end; + function tx86addnode.use_fma : boolean; + begin +{$ifndef i8086} + { test if the result stays in an xmm register, fiddeling with fpu registers and fma makes no sense } + Result:=use_vectorfpu(resultdef) and + ((cpu_capabilities[current_settings.cputype]*[CPUX86_HAS_FMA,CPUX86_HAS_FMA4])<>[]); +{$else i8086} + Result:=inherited use_fma; +{$endif i8086} + end; + + procedure tx86addnode.second_cmpfloatvector; var op : tasmop; diff --git a/compiler/x86/symx86.pas b/compiler/x86/symx86.pas index 45c93a8cd3..500e4443c7 100644 --- a/compiler/x86/symx86.pas +++ b/compiler/x86/symx86.pas @@ -26,7 +26,7 @@ unit symx86; interface uses - globtype, + globtype, cclasses, symconst, symtype,symdef,symsym; type @@ -45,10 +45,62 @@ type end; tx86pointerdefclass = class of tx86pointerdef; + tx86PtrDefKey = packed record + def: tdef; + x86typ:tx86pointertyp; + end; + + { tx86PtrDefHashSet } + + tx86PtrDefHashSet = class(TPtrDefHashSet) + private + class procedure Key2FullKey(Key: Pointer; out FullKey: tx86PtrDefKey); + public + function Find(Key: Pointer; KeyLen: Integer): PHashSetItem;override; + function FindOrAdd(Key: Pointer; KeyLen: Integer; + var Found: Boolean): PHashSetItem;override; + function FindOrAdd(Key: Pointer; KeyLen: Integer): PHashSetItem;override; + function Get(Key: Pointer; KeyLen: Integer): TObject;override; + end; + + { returns a pointerdef for def, reusing an existing one in case it exists + in the current module } + function getx86pointerdef(def: tdef;x86typ:tx86pointertyp): tpointerdef; + implementation uses - globals, verbose; + globals, verbose, + symbase, fmodule; + + function getx86pointerdef(def: tdef;x86typ:tx86pointertyp): tpointerdef; + var + res: PHashSetItem; + oldsymtablestack: tsymtablestack; + key: tx86PtrDefKey; + begin + if not assigned(current_module) then + internalerror(2011071101); + key.def:=def; + key.x86typ:=x86typ; + res:=current_module.ptrdefs.FindOrAdd(@key,sizeof(key)); + if not assigned(res^.Data) then + begin + { since these pointerdefs can be reused anywhere in the current + unit, add them to the global/staticsymtable } + oldsymtablestack:=symtablestack; + { do not simply push/pop current_module.localsymtable, because + that can have side-effects (e.g., it removes helpers) } + symtablestack:=nil; + res^.Data:=tx86pointerdefclass(cpointerdef).createx86(def,x86typ); + if assigned(current_module.localsymtable) then + current_module.localsymtable.insertdef(tdef(res^.Data)) + else + current_module.globalsymtable.insertdef(tdef(res^.Data)); + symtablestack:=oldsymtablestack; + end; + result:=tpointerdef(res^.Data); + end; {**************************************************************************** tx86pointerdef @@ -136,5 +188,69 @@ implementation end; +{**************************************************************************** + tx86PtrDefHashSet +****************************************************************************} + + class procedure tx86PtrDefHashSet.Key2FullKey(Key: Pointer; out FullKey: tx86PtrDefKey); + type + pdef=^tdef; + begin + FullKey.def:=pdef(Key)^; + FullKey.x86typ:=tx86pointerdefclass(cpointerdef).default_x86_data_pointer_type; + end; + + function tx86PtrDefHashSet.Find(Key: Pointer; KeyLen: Integer): PHashSetItem; + var + FullKey: tx86PtrDefKey; + begin + if KeyLen=SizeOf(tdef) then + begin + Key2FullKey(Key, FullKey); + Result:=inherited Find(@FullKey, SizeOf(FullKey)); + end + else + Result:=inherited Find(Key, KeyLen); + end; + + function tx86PtrDefHashSet.FindOrAdd(Key: Pointer; KeyLen: Integer; var Found: Boolean): PHashSetItem; + var + FullKey: tx86PtrDefKey; + begin + if KeyLen=SizeOf(tdef) then + begin + Key2FullKey(Key, FullKey); + Result:=inherited FindOrAdd(@FullKey, SizeOf(FullKey), Found); + end + else + Result:=inherited FindOrAdd(Key, KeyLen, Found); + end; + + function tx86PtrDefHashSet.FindOrAdd(Key: Pointer; KeyLen: Integer): PHashSetItem; + var + FullKey: tx86PtrDefKey; + begin + if KeyLen=SizeOf(tdef) then + begin + Key2FullKey(Key, FullKey); + Result:=inherited FindOrAdd(@FullKey, SizeOf(FullKey)); + end + else + Result:=inherited FindOrAdd(Key, KeyLen); + end; + + function tx86PtrDefHashSet.Get(Key: Pointer; KeyLen: Integer): TObject; + var + FullKey: tx86PtrDefKey; + begin + if KeyLen=SizeOf(tdef) then + begin + Key2FullKey(Key, FullKey); + Result:=inherited Get(@FullKey, SizeOf(FullKey)); + end + else + Result:=inherited Get(Key, KeyLen); + end; + end. diff --git a/compiler/x86_64/symcpu.pas b/compiler/x86_64/symcpu.pas index 4e33d0ceb9..195634520c 100644 --- a/compiler/x86_64/symcpu.pas +++ b/compiler/x86_64/symcpu.pas @@ -207,5 +207,7 @@ begin cconstsym:=tcpuconstsym; cenumsym:=tcpuenumsym; csyssym:=tcpusyssym; + + cPtrDefHashSet:=tx86PtrDefHashSet; end. |