diff options
Diffstat (limited to 'compiler')
61 files changed, 1531 insertions, 654 deletions
diff --git a/compiler/aasmtai.pas b/compiler/aasmtai.pas index 0e5bfe8310..8c53024f9f 100644 --- a/compiler/aasmtai.pas +++ b/compiler/aasmtai.pas @@ -230,6 +230,7 @@ interface {$ifdef m68k} { m68k only } ,top_regset + ,top_realconst {$endif m68k} {$ifdef jvm} { jvm only} @@ -419,7 +420,8 @@ interface top_conditioncode : (cc : TAsmCond); {$endif defined(arm) or defined(aarch64)} {$ifdef m68k} - top_regset : (dataregset,addrregset,fpuregset:^tcpuregisterset); + top_regset : (dataregset,addrregset,fpuregset: tcpuregisterset); + top_realconst : (val_real:bestreal); {$endif m68k} {$ifdef jvm} top_single : (sval:single); @@ -2686,14 +2688,6 @@ implementation top_regset: dispose(regset); {$endif ARM} -{$ifdef m68k} - top_regset: - begin - dispose(dataregset); - dispose(addrregset); - dispose(fpuregset); - end; -{$endif m68k} {$ifdef jvm} top_string: freemem(pcval); diff --git a/compiler/aoptbase.pas b/compiler/aoptbase.pas index 0d52bb3583..9c4678e020 100644 --- a/compiler/aoptbase.pas +++ b/compiler/aoptbase.pas @@ -101,6 +101,10 @@ unit aoptbase; { returns true if hp loads a value from reg } function InstructionLoadsFromReg(const reg : TRegister; const hp : tai) : boolean; Virtual; + + { compares reg1 and reg2 having the same type and being the same super registers + so the register size is neglected } + function SuperRegistersEqual(reg1,reg2 : TRegister) : Boolean; end; function labelCanBeSkipped(p: tai_label): boolean; @@ -305,6 +309,12 @@ unit aoptbase; end; + function TAOptBase.SuperRegistersEqual(reg1,reg2 : TRegister) : Boolean; + Begin + Result:=(getregtype(reg1) = getregtype(reg2)) and + (getsupreg(reg1) = getsupreg(Reg2)); + end; + { ******************* Processor dependent stuff *************************** } Function TAOptBase.RegMaxSize(Reg: TRegister): TRegister; diff --git a/compiler/aoptobj.pas b/compiler/aoptobj.pas index 2576d9158a..0511bc534d 100644 --- a/compiler/aoptobj.pas +++ b/compiler/aoptobj.pas @@ -346,7 +346,9 @@ Unit AoptObj; { processor dependent methods } // if it returns true, perform a "continue" + function PrePeepHoleOptsCpu(var p: tai): boolean; virtual; function PeepHoleOptPass1Cpu(var p: tai): boolean; virtual; + function PeepHoleOptPass2Cpu(var p: tai): boolean; virtual; function PostPeepHoleOptsCpu(var p: tai): boolean; virtual; End; @@ -1080,8 +1082,7 @@ Unit AoptObj; (StartPai.typ = ait_regAlloc) Then Begin if (tai_regalloc(StartPai).ratype=ra_alloc) and - (getregtype(tai_regalloc(StartPai).Reg) = getregtype(Reg)) and - (getsupreg(tai_regalloc(StartPai).Reg) = getsupreg(Reg)) then + SuperRegistersEqual(tai_regalloc(StartPai).Reg,Reg) then begin Result:=tai_regalloc(StartPai); exit; @@ -1178,7 +1179,7 @@ Unit AoptObj; {$push} {$r-} - function tAOptObj.getlabelwithsym(sym: tasmlabel): tai; + function TAOptObj.getlabelwithsym(sym: tasmlabel): tai; begin if (int64(sym.labelnr) >= int64(labelinfo^.lowlabel)) and (int64(sym.labelnr) <= int64(labelinfo^.highlabel)) then { range check, a jump can go past an assembler block! } @@ -1342,7 +1343,19 @@ Unit AoptObj; procedure TAOptObj.PrePeepHoleOpts; + var + p: tai; begin + p := BlockStart; + ClearUsedRegs; + while (p <> BlockEnd) Do + begin + UpdateUsedRegs(tai(p.next)); + if PrePeepHoleOptsCpu(p) then + continue; + UpdateUsedRegs(p); + p:=tai(p.next); + end; end; @@ -1400,10 +1413,10 @@ Unit AoptObj; no-line-info-start/end etc } if hp1.typ<>ait_marker then begin - {$if defined(SPARC) or defined(MIPS) } +{$if defined(SPARC) or defined(MIPS) } if (hp1.typ=ait_instruction) and (taicpu(hp1).is_jmp) then RemoveDelaySlot(hp1); - {$endif SPARC or MIPS } +{$endif SPARC or MIPS } asml.remove(hp1); hp1.free; stoploop:=false; @@ -1423,9 +1436,9 @@ Unit AoptObj; (p<>blockstart) then begin tasmlabel(JumpTargetOp(taicpu(p))^.ref^.symbol).decrefs; - {$if defined(SPARC) or defined(MIPS)} +{$if defined(SPARC) or defined(MIPS)} RemoveDelaySlot(p); - {$endif SPARC or MIPS} +{$endif SPARC or MIPS} hp2:=tai(hp1.next); asml.remove(p); p.free; @@ -1451,15 +1464,15 @@ Unit AoptObj; FindLabel(tasmlabel(JumpTargetOp(taicpu(p))^.ref^.symbol), hp2) then begin if (taicpu(p).opcode=aopt_condjmp) - {$if defined(arm) or defined(aarch64)} +{$if defined(arm) or defined(aarch64)} and (taicpu(p).condition<>C_None) - {$endif arm or aarch64} - {$if defined(aarch64)} +{$endif arm or aarch64} +{$if defined(aarch64)} { can't have conditional branches to global labels on AArch64, because the offset may become too big } and (tasmlabel(JumpTargetOp(taicpu(hp1))^.ref^.symbol).bind=AB_LOCAL) - {$endif aarch64} +{$endif aarch64} then begin taicpu(p).condition:=inverse_cond(taicpu(p).condition); @@ -1470,9 +1483,9 @@ Unit AoptObj; taicpu(p).oper[0]^.ref^.symbol.increfs; } - {$if defined(SPARC) or defined(MIPS)} +{$if defined(SPARC) or defined(MIPS)} RemoveDelaySlot(hp1); - {$endif SPARC or MIPS} +{$endif SPARC or MIPS} asml.remove(hp1); hp1.free; stoploop:=false; @@ -1504,7 +1517,19 @@ Unit AoptObj; procedure TAOptObj.PeepHoleOptPass2; + var + p: tai; begin + p := BlockStart; + ClearUsedRegs; + while (p <> BlockEnd) Do + begin + UpdateUsedRegs(tai(p.next)); + if PeepHoleOptPass2Cpu(p) then + continue; + UpdateUsedRegs(p); + p:=tai(p.next); + end; end; @@ -1525,12 +1550,24 @@ Unit AoptObj; end; + function TAOptObj.PrePeepHoleOptsCpu(var p : tai) : boolean; + begin + result := false; + end; + + function TAOptObj.PeepHoleOptPass1Cpu(var p: tai): boolean; begin result := false; end; + function TAOptObj.PeepHoleOptPass2Cpu(var p : tai) : boolean; + begin + result := false; + end; + + function TAOptObj.PostPeepHoleOptsCpu(var p: tai): boolean; begin result := false; diff --git a/compiler/avr/aoptcpu.pas b/compiler/avr/aoptcpu.pas index 5a7860996a..95fba6b87c 100644 --- a/compiler/avr/aoptcpu.pas +++ b/compiler/avr/aoptcpu.pas @@ -800,7 +800,7 @@ Implementation mov rX,... mov rX,... } - else if taicpu(hp1).opcode=A_MOV then + else if (hp1.typ=ait_instruction) and (taicpu(hp1).opcode=A_MOV) then while (hp1.typ=ait_instruction) and (taicpu(hp1).opcode=A_MOV) and MatchOperand(taicpu(p).oper[0]^, taicpu(hp1).oper[0]^) and { don't remove the first mov if the second is a mov rX,rX } diff --git a/compiler/dbgdwarf.pas b/compiler/dbgdwarf.pas index d6be6c70b7..4b8626bcd6 100644 --- a/compiler/dbgdwarf.pas +++ b/compiler/dbgdwarf.pas @@ -1683,8 +1683,8 @@ implementation procedure TDebugInfoDwarf.appenddef_array(list:TAsmList;def:tarraydef); var - size : aint; - elesize : aint; + size : PInt; + elesize : PInt; elestrideattr : tdwarf_attribute; labsym: tasmlabel; begin @@ -2461,14 +2461,14 @@ implementation { This is only a minimal change to at least be able to get a value in only one thread is present PM 2014-11-21, like for stabs format } templist.concat(tai_const.create_8bit(ord(DW_OP_addr))); - templist.concat(tai_const.Create_type_name(aitconst_ptr,sym.mangledname, + templist.concat(tai_const.Create_type_name(aitconst_ptr_unaligned,sym.mangledname, offset+sizeof(pint))); blocksize:=1+sizeof(puint); end else begin templist.concat(tai_const.create_8bit(ord(DW_OP_addr))); - templist.concat(tai_const.Create_type_name(aitconst_ptr,sym.mangledname,offset)); + templist.concat(tai_const.Create_type_name(aitconst_ptr_unaligned,sym.mangledname,offset)); blocksize:=1+sizeof(puint); end; end; @@ -2929,7 +2929,7 @@ implementation toasm : begin templist.concat(tai_const.create_8bit(3)); - templist.concat(tai_const.create_type_name(aitconst_ptr,sym.mangledname,0)); + templist.concat(tai_const.create_type_name(aitconst_ptr_unaligned,sym.mangledname,0)); blocksize:=1+sizeof(puint); end; tovar: diff --git a/compiler/fmodule.pas b/compiler/fmodule.pas index e8f271eddd..32d7a2c22f 100644 --- a/compiler/fmodule.pas +++ b/compiler/fmodule.pas @@ -195,6 +195,9 @@ interface non-generic typename and the data is a TFPObjectList of tgenericdummyentry instances whereby the last one is the current top most one } genericdummysyms: TFPHashObjectList; + { contains a list of specializations for which the method bodies need + to be generated } + pendingspecializations : TFPHashObjectList; { this contains a list of units that needs to be waited for until the unit can be finished (code generated, etc.); this is needed to handle @@ -585,6 +588,7 @@ implementation checkforwarddefs:=TFPObjectList.Create(false); extendeddefs:=TFPHashObjectList.Create(true); genericdummysyms:=tfphashobjectlist.create(true); + pendingspecializations:=tfphashobjectlist.create(false); waitingforunit:=tfpobjectlist.create(false); waitingunits:=tfpobjectlist.create(false); globalsymtable:=nil; @@ -677,6 +681,7 @@ implementation FImportLibraryList.Free; extendeddefs.Free; genericdummysyms.free; + pendingspecializations.free; waitingforunit.free; waitingunits.free; stringdispose(asmprefix); @@ -774,6 +779,8 @@ implementation wpoinfo:=nil; checkforwarddefs.free; checkforwarddefs:=TFPObjectList.Create(false); + unitimportsyms.free; + unitimportsyms:=TFPObjectList.Create(false); derefdata.free; derefdata:=TDynamicArray.Create(1024); if assigned(unitmap) then @@ -806,6 +813,8 @@ implementation dependent_units:=TLinkedList.Create; resourcefiles.Free; resourcefiles:=TCmdStrList.Create; + pendingspecializations.free; + pendingspecializations:=tfphashobjectlist.create(false); linkunitofiles.Free; linkunitofiles:=TLinkContainer.Create; linkunitstaticlibs.Free; @@ -1049,10 +1058,6 @@ implementation macrosymtablestack.free; macrosymtablestack:=nil; end; - extendeddefs.free; - extendeddefs:=nil; - genericdummysyms.free; - genericdummysyms:=nil; waitingforunit.free; waitingforunit:=nil; localmacrosymtable.free; diff --git a/compiler/hlcgobj.pas b/compiler/hlcgobj.pas index 1b690e2ad1..e25ea9682d 100644 --- a/compiler/hlcgobj.pas +++ b/compiler/hlcgobj.pas @@ -598,15 +598,8 @@ unit hlcgobj; protected { helpers called by gen_initialize_code/gen_finalize_code } procedure inittempvariables(list:TAsmList);virtual; - procedure initialize_data(p:TObject;arg:pointer);virtual; procedure finalizetempvariables(list:TAsmList);virtual; procedure initialize_regvars(p:TObject;arg:pointer);virtual; - procedure finalize_sym(asmlist:TAsmList;sym:tsym);virtual; - { generates the code for finalisation of local variables } - procedure finalize_local_vars(p:TObject;arg:pointer);virtual; - { generates the code for finalization of static symtable and - all local (static) typed consts } - procedure finalize_static_data(p:TObject;arg:pointer);virtual; { generates the code for decrementing the reference count of parameters } procedure final_paras(p:TObject;arg:pointer); public @@ -674,7 +667,7 @@ implementation fmodule,export, verbose,defutil,paramgr, symtable, - nbas,ncon,nld,ncgrtti,pass_1,pass_2, + nbas,ncon,nld,ncgrtti,pass_2, cpuinfo,cgobj,cutils,procinfo, {$ifdef x86} cgx86, @@ -4515,26 +4508,12 @@ implementation procedure thlcgobj.gen_initialize_code(list: TAsmList); begin - { initialize local data like ansistrings } + { initialize register variables } case current_procinfo.procdef.proctypeoption of potype_unitinit: - begin - { this is also used for initialization of variables in a - program which does not have a globalsymtable } - if assigned(current_module.globalsymtable) then - TSymtable(current_module.globalsymtable).SymList.ForEachCall(@initialize_data,list); - TSymtable(current_module.localsymtable).SymList.ForEachCall(@initialize_data,list); - TSymtable(current_module.localsymtable).SymList.ForEachCall(@initialize_regvars,list); - end; - { units have seperate code for initilization and finalization } - potype_unitfinalize: ; - { program init/final is generated in separate procedure } + TSymtable(current_module.localsymtable).SymList.ForEachCall(@initialize_regvars,list); potype_proginit: - begin - TSymtable(current_module.localsymtable).SymList.ForEachCall(@initialize_regvars,list); - end; - else - current_procinfo.procdef.localst.SymList.ForEachCall(@initialize_data,list); + TSymtable(current_module.localsymtable).SymList.ForEachCall(@initialize_regvars,list); end; { initialises temp. ansi/wide string data } @@ -4565,24 +4544,6 @@ implementation { finalize temporary data } finalizetempvariables(list); - { finalize local data like ansistrings} - case current_procinfo.procdef.proctypeoption of - potype_unitfinalize: - begin - { this is also used for initialization of variables in a - program which does not have a globalsymtable } - if assigned(current_module.globalsymtable) then - TSymtable(current_module.globalsymtable).SymList.ForEachCall(@finalize_static_data,list); - TSymtable(current_module.localsymtable).SymList.ForEachCall(@finalize_static_data,list); - end; - { units/progs have separate code for initialization and finalization } - potype_unitinit: ; - { program init/final is generated in separate procedure } - potype_proginit: ; - else - current_procinfo.procdef.localst.SymList.ForEachCall(@finalize_local_vars,list); - end; - { finalize paras data } if assigned(current_procinfo.procdef.parast) and not(po_assembler in current_procinfo.procdef.procoptions) then @@ -4682,35 +4643,6 @@ implementation end; end; - procedure thlcgobj.initialize_data(p: TObject; arg: pointer); - var - OldAsmList : TAsmList; - hp : tnode; - begin - if (tsym(p).typ = localvarsym) and - { local (procedure or unit) variables only need initialization if - they are used } - ((tabstractvarsym(p).refs>0) or - { managed return symbols must be inited } - ((tsym(p).typ=localvarsym) and (vo_is_funcret in tlocalvarsym(p).varoptions)) - ) and - not(vo_is_typed_const in tabstractvarsym(p).varoptions) and - not(vo_is_external in tabstractvarsym(p).varoptions) and - not(vo_is_default_var in tabstractvarsym(p).varoptions) and - (is_managed_type(tabstractvarsym(p).vardef) or - ((m_iso in current_settings.modeswitches) and (tabstractvarsym(p).vardef.typ=filedef)) - ) then - begin - OldAsmList:=current_asmdata.CurrAsmList; - current_asmdata.CurrAsmList:=TAsmList(arg); - hp:=cnodeutils.initialize_data_node(cloadnode.create(tsym(p),tsym(p).owner),false); - firstpass(hp); - secondpass(hp); - hp.free; - current_asmdata.CurrAsmList:=OldAsmList; - end; - end; - procedure thlcgobj.finalizetempvariables(list: TAsmList); var hp : ptemprecord; @@ -4777,80 +4709,6 @@ implementation end; end; - procedure thlcgobj.finalize_sym(asmlist: TAsmList; sym: tsym); - var - hp : tnode; - OldAsmList : TAsmList; - begin - include(current_procinfo.flags,pi_needs_implicit_finally); - OldAsmList:=current_asmdata.CurrAsmList; - current_asmdata.CurrAsmList:=asmlist; - hp:=cloadnode.create(sym,sym.owner); - if (sym.typ=staticvarsym) and (vo_force_finalize in tstaticvarsym(sym).varoptions) then - include(tloadnode(hp).loadnodeflags,loadnf_isinternal_ignoreconst); - hp:=cnodeutils.finalize_data_node(hp); - firstpass(hp); - secondpass(hp); - hp.free; - current_asmdata.CurrAsmList:=OldAsmList; - end; - - procedure thlcgobj.finalize_local_vars(p: TObject; arg: pointer); - begin - if (tsym(p).typ=localvarsym) and - (tlocalvarsym(p).refs>0) and - not(vo_is_external in tlocalvarsym(p).varoptions) and - not(vo_is_funcret in tlocalvarsym(p).varoptions) and - not(vo_is_default_var in tabstractvarsym(p).varoptions) and - is_managed_type(tlocalvarsym(p).vardef) then - finalize_sym(TAsmList(arg),tsym(p)); - end; - - procedure thlcgobj.finalize_static_data(p: TObject; arg: pointer); - var - i : longint; - pd : tprocdef; - begin - case tsym(p).typ of - staticvarsym : - begin - { local (procedure or unit) variables only need finalization - if they are used - } - if ((tstaticvarsym(p).refs>0) or - { global (unit) variables always need finalization, since - they may also be used in another unit - } - (tstaticvarsym(p).owner.symtabletype=globalsymtable)) and - ( - (tstaticvarsym(p).varspez<>vs_const) or - (vo_force_finalize in tstaticvarsym(p).varoptions) - ) and - not(vo_is_funcret in tstaticvarsym(p).varoptions) and - not(vo_is_external in tstaticvarsym(p).varoptions) and - is_managed_type(tstaticvarsym(p).vardef) and - not ( - assigned(tstaticvarsym(p).fieldvarsym) and - assigned(tstaticvarsym(p).fieldvarsym.owner.defowner) and - (df_generic in tdef(tstaticvarsym(p).fieldvarsym.owner.defowner).defoptions) - ) - then - finalize_sym(TAsmList(arg),tsym(p)); - end; - procsym : - begin - for i:=0 to tprocsym(p).ProcdefList.Count-1 do - begin - pd:=tprocdef(tprocsym(p).ProcdefList[i]); - if assigned(pd.localst) and - (pd.procsym=tprocsym(p)) and - (pd.localst.symtabletype<>staticsymtable) then - pd.localst.SymList.ForEachCall(@finalize_static_data,arg); - end; - end; - end; - end; - procedure thlcgobj.final_paras(p: TObject; arg: pointer); var list : TAsmList; @@ -4979,6 +4837,7 @@ implementation else highloc.loc:=LOC_INVALID; eldef:=tarraydef(tparavarsym(p).vardef).elementdef; + g_ptrtypecast_ref(list,cpointerdef.getreusable(tparavarsym(p).vardef),cpointerdef.getreusable(eldef),href); g_array_rtti_helper(list,eldef,href,highloc,'fpc_initialize_array'); end else diff --git a/compiler/i8086/cgcpu.pas b/compiler/i8086/cgcpu.pas index 5de6eda307..2a5a4aa2a2 100644 --- a/compiler/i8086/cgcpu.pas +++ b/compiler/i8086/cgcpu.pas @@ -1809,6 +1809,13 @@ unit cgcpu; procedure tcg8086.g_stackpointer_alloc(list : TAsmList;localsize: longint); begin + if cs_check_stack in current_settings.localswitches then + begin + cg.getcpuregister(list,NR_AX); + cg.a_load_const_reg(list,OS_16, localsize,NR_AX); + cg.a_call_name(list,'FPC_STACKCHECK_I8086',false); + cg.ungetcpuregister(list, NR_AX); + end; if localsize>0 then list.concat(Taicpu.Op_const_reg(A_SUB,S_W,localsize,NR_STACK_POINTER_REG)); end; diff --git a/compiler/llvm/aasmllvm.pas b/compiler/llvm/aasmllvm.pas index 430754e101..af1ab28c03 100644 --- a/compiler/llvm/aasmllvm.pas +++ b/compiler/llvm/aasmllvm.pas @@ -142,11 +142,10 @@ interface ); taillvmalias = class(tailineinfo) - vis: tllvmvisibility; - linkage: tllvmlinkage; + bind: tasmsymbind; oldsym, newsym: TAsmSymbol; def: tdef; - constructor create(_oldsym: tasmsymbol; const newname: TSymStr; _def: tdef; _vis: tllvmvisibility; _linkage: tllvmlinkage); + constructor create(_oldsym: tasmsymbol; const newname: TSymStr; _def: tdef; _bind: tasmsymbind); end; taillvmdeclflag = @@ -244,7 +243,7 @@ uses { taillvmalias } - constructor taillvmalias.create(_oldsym: tasmsymbol; const newname: TSymStr; _def: tdef; _vis: tllvmvisibility; _linkage: tllvmlinkage); + constructor taillvmalias.create(_oldsym: tasmsymbol; const newname: TSymStr; _def: tdef; _bind: tasmsymbind); begin inherited Create; typ:=ait_llvmalias; @@ -252,8 +251,7 @@ uses newsym:=current_asmdata.DefineAsmSymbol(newname,AB_GLOBAL,AT_FUNCTION); newsym.declared:=true; def:=_def; - vis:=_vis; - linkage:=_linkage; + bind:=_bind; end; @@ -584,7 +582,7 @@ uses la_icmp, la_fcmp: begin case opnr of - 0: result:=pasbool8type; + 0: result:=llvmbool1type; 3,4: result:=oper[2]^.def; else internalerror(2013110801); diff --git a/compiler/llvm/agllvm.pas b/compiler/llvm/agllvm.pas index 8921708e9b..f0c7a1a19d 100644 --- a/compiler/llvm/agllvm.pas +++ b/compiler/llvm/agllvm.pas @@ -731,13 +731,15 @@ implementation procedure WriteLinkageVibilityFlags(bind: TAsmSymBind); begin case bind of - AB_EXTERNAL: + AB_EXTERNAL, + AB_EXTERNAL_INDIRECT: writer.AsmWrite(' external'); AB_COMMON: writer.AsmWrite(' common'); AB_LOCAL: writer.AsmWrite(' internal'); - AB_GLOBAL: + AB_GLOBAL, + AB_INDIRECT: writer.AsmWrite(''); AB_WEAK_EXTERNAL: writer.AsmWrite(' extern_weak'); @@ -1047,18 +1049,7 @@ implementation begin writer.AsmWrite(LlvmAsmSymName(taillvmalias(hp).newsym)); writer.AsmWrite(' = alias '); - if taillvmalias(hp).linkage<>lll_default then - begin - str(taillvmalias(hp).linkage, s); - writer.AsmWrite(copy(s, length('lll_')+1, 255)); - writer.AsmWrite(' '); - end; - if taillvmalias(hp).vis<>llv_default then - begin - str(taillvmalias(hp).vis, s); - writer.AsmWrite(copy(s, length('llv_')+1, 255)); - writer.AsmWrite(' '); - end; + WriteLinkageVibilityFlags(taillvmalias(hp).bind); if taillvmalias(hp).def.typ=procdef then writer.AsmWrite(llvmencodeproctype(tabstractprocdef(taillvmalias(hp).def), '', lpd_alias)) else diff --git a/compiler/llvm/hlcgllvm.pas b/compiler/llvm/hlcgllvm.pas index 805da16185..ac08930160 100644 --- a/compiler/llvm/hlcgllvm.pas +++ b/compiler/llvm/hlcgllvm.pas @@ -934,7 +934,7 @@ implementation tmpsrc1:=getintregister(list,calcsize); a_load_reg_reg(list,size,calcsize,dst,tmpsrc1); location_reset(ovloc,LOC_REGISTER,OS_8); - ovloc.register:=getintregister(list,pasbool8type); + ovloc.register:=getintregister(list,llvmbool1type); list.concat(taillvm.op_reg_cond_size_reg_reg(la_icmp,ovloc.register,OC_NE,calcsize,tmpsrc1,tmpdst)); end; @@ -950,6 +950,9 @@ implementation if (size=pasbool8type) and (cmp_op in [OC_EQ,OC_NE]) then begin + { convert to an llvmbool1type and use directly } + tmpreg:=getintregister(list,llvmbool1type); + a_load_reg_reg(list,size,llvmbool1type,reg,tmpreg); case cmp_op of OC_EQ: invert:=a=0; @@ -967,7 +970,7 @@ implementation l:=falselab; falselab:=tmplab; end; - list.concat(taillvm.op_size_reg_lab_lab(la_br,pasbool8type,reg,l,falselab)); + list.concat(taillvm.op_size_reg_lab_lab(la_br,llvmbool1type,tmpreg,l,falselab)); a_label(list,fallthroughlab); exit; end; @@ -984,13 +987,13 @@ implementation begin if getregtype(reg1)<>getregtype(reg2) then internalerror(2012111105); - resreg:=getintregister(list,pasbool8type); + resreg:=getintregister(list,llvmbool1type); current_asmdata.getjumplabel(falselab); { invert order of registers. In FPC, cmp_reg_reg(reg1,reg2) means that e.g. OC_GT is true if "subl %reg1,%reg2" in x86 AT&T is >0. In LLVM, OC_GT is true if op1>op2 } list.concat(taillvm.op_reg_cond_size_reg_reg(la_icmp,resreg,cmp_op,size,reg2,reg1)); - list.concat(taillvm.op_size_reg_lab_lab(la_br,pasbool8type,resreg,l,falselab)); + list.concat(taillvm.op_size_reg_lab_lab(la_br,llvmbool1type,resreg,l,falselab)); a_label(list,falselab); end; @@ -1037,7 +1040,7 @@ implementation a_load_const_cgpara(list,u32inttype,maxalign,alignpara); { we don't know anything about volatility here, should become an extra parameter to g_concatcopy } - a_load_const_cgpara(list,pasbool8type,0,volatilepara); + a_load_const_cgpara(list,llvmbool1type,0,volatilepara); g_call_system_proc(list,pd,[@destpara,@sourcepara,@sizepara,@alignpara,@volatilepara],nil).resetiftemp; sourcepara.done; destpara.done; @@ -1171,7 +1174,7 @@ implementation while assigned(item) do begin if mangledname<>item.Str then - list.concat(taillvmalias.create(asmsym,item.str,current_procinfo.procdef,llv_default,lll_default)); + list.concat(taillvmalias.create(asmsym,item.str,current_procinfo.procdef,asmsym.bind)); item:=TCmdStrListItem(item.next); end; list.concat(taillvmdecl.createdef(asmsym,current_procinfo.procdef,nil,sec_code,current_procinfo.procdef.alignment)); @@ -1292,7 +1295,7 @@ implementation if ovloc.size<>OS_8 then internalerror(2015122504); current_asmdata.getjumplabel(hl); - a_cmp_const_loc_label(list,pasbool8type,OC_EQ,0,ovloc,hl); + a_cmp_const_loc_label(list,llvmbool1type,OC_EQ,0,ovloc,hl); g_call_system_proc(list,'fpc_overflow',[],nil); a_label(list,hl); end; @@ -1901,7 +1904,7 @@ implementation if po_external in procdef.procoptions then exit; asmsym:=current_asmdata.RefAsmSymbol(externalname,AT_FUNCTION); - list.concat(taillvmalias.create(asmsym,procdef.mangledname,procdef,llv_default,lll_default)); + list.concat(taillvmalias.create(asmsym,procdef.mangledname,procdef,asmsym.bind)); end; diff --git a/compiler/llvm/llvmdef.pas b/compiler/llvm/llvmdef.pas index be3c3972ca..17114cf8dd 100644 --- a/compiler/llvm/llvmdef.pas +++ b/compiler/llvm/llvmdef.pas @@ -211,17 +211,23 @@ implementation end; end; end - else if is_pasbool(fromsize) and - not is_pasbool(tosize) then + else if (fromsize=llvmbool1type) and + (tosize<>llvmbool1type) then begin if is_cbool(tosize) then result:=la_sext else result:=la_zext end - else if is_pasbool(tosize) and - not is_pasbool(fromsize) then - result:=la_trunc + else if (tosize=llvmbool1type) and + (fromsize<>llvmbool1type) then + begin + { would have to compare with 0, can't just take the lowest bit } + if is_cbool(fromsize) then + internalerror(2016052001) + else + result:=la_trunc + end else result:=la_bitcast; end; @@ -308,10 +314,10 @@ implementation if is_void(def) then encodedstr:=encodedstr+'void' { mainly required because comparison operations return i1, and - otherwise we always have to immediatel extend them to i8 for - no good reason; besides, Pascal booleans can only contain 0 - or 1 in valid code anyway (famous last words...) } - else if torddef(def).ordtype=pasbool8 then + we need a way to represent the i1 type in Pascal. We don't + reuse pasbool8type, because putting an i1 in a record or + passing it as a parameter may result in unexpected behaviour } + else if def=llvmbool1type then encodedstr:=encodedstr+'i1' else encodedstr:=encodedstr+'i'+tostr(def.size*8); diff --git a/compiler/llvm/nllvmadd.pas b/compiler/llvm/nllvmadd.pas index a348c4a6c5..d54b9c0eff 100644 --- a/compiler/llvm/nllvmadd.pas +++ b/compiler/llvm/nllvmadd.pas @@ -109,7 +109,7 @@ implementation pass_left_right; location_reset(location,LOC_REGISTER,OS_8); - location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,pasbool8type); + location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,llvmbool1type); force_reg_left_right(false,false); @@ -143,11 +143,15 @@ implementation else internalerror(2012042701); end; + tmpreg:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef); + hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,llvmbool1type,resultdef,location.register,tmpreg); + location.register:=tmpreg; end; procedure tllvmaddnode.second_cmpordinal; var + tmpreg: tregister; cmpop: topcmp; unsigned : boolean; begin @@ -189,7 +193,7 @@ implementation cmpop:=swap_opcmp(cmpop); location_reset(location,LOC_REGISTER,OS_8); - location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef); + location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,llvmbool1type); if right.location.loc=LOC_CONSTANT then current_asmdata.CurrAsmList.concat(taillvm.op_reg_cond_size_reg_const(la_icmp, @@ -197,6 +201,10 @@ implementation else current_asmdata.CurrAsmList.concat(taillvm.op_reg_cond_size_reg_reg(la_icmp, location.register,cmpop,left.resultdef,left.location.register,right.location.register)); + + tmpreg:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef); + hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,llvmbool1type,resultdef,location.register,tmpreg); + location.register:=tmpreg; end; @@ -214,6 +222,7 @@ implementation procedure tllvmaddnode.second_addfloat; var + tmpreg: tregister; op : tllvmop; llvmfpcmp : tllvmfpcmp; size : tdef; @@ -279,7 +288,7 @@ implementation else begin location_reset(location,LOC_REGISTER,OS_8); - location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef); + location.register:=hlcg.getintregister(current_asmdata.CurrAsmList,llvmbool1type); end; { see comment in thlcgllvm.a_loadfpu_ref_reg } @@ -297,7 +306,10 @@ implementation else begin current_asmdata.CurrAsmList.concat(taillvm.op_reg_fpcond_size_reg_reg(op, - location.register,llvmfpcmp,size,left.location.register,right.location.register)) + location.register,llvmfpcmp,size,left.location.register,right.location.register)); + tmpreg:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef); + hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,llvmbool1type,resultdef,location.register,tmpreg); + location.register:=tmpreg; end; end; diff --git a/compiler/llvm/nllvmcnv.pas b/compiler/llvm/nllvmcnv.pas index 7db9df8aa0..e696f9ee09 100644 --- a/compiler/llvm/nllvmcnv.pas +++ b/compiler/llvm/nllvmcnv.pas @@ -50,7 +50,7 @@ interface { procedure second_cord_to_pointer;override; } procedure second_proc_to_procvar;override; procedure second_nil_to_methodprocvar; override; - procedure second_bool_to_int;override; + { procedure second_bool_to_int;override; } procedure second_int_to_bool;override; { procedure second_load_smallset;override; } { procedure second_ansistring_to_pchar;override; } @@ -202,39 +202,6 @@ procedure tllvmtypeconvnode.second_nil_to_methodprocvar; end; -procedure tllvmtypeconvnode.second_bool_to_int; - var - pdef: tdef; - hreg: tregister; - begin - inherited; - { all boolean/integer of the same size are represented using the same type - by FPC in LLVM, except for Pascal booleans, which are i1 -> convert - the type if necessary. This never has to be done for registers on the - assignment side, because we make everything that's explicitly typecasted - on the assignment side non regable for llvm } - if is_pasbool(left.resultdef) and - (nf_explicit in flags) and - not(left.location.loc in [LOC_FLAGS,LOC_JUMP]) and - (resultdef.size=1) then - case location.loc of - LOC_REFERENCE,LOC_CREFERENCE: - begin - pdef:=cpointerdef.getreusable(resultdef); - hreg:=hlcg.getaddressregister(current_asmdata.CurrAsmList,pdef); - hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,left.resultdef,pdef,location.reference,hreg); - hlcg.reference_reset_base(location.reference,pdef,hreg,0,location.reference.alignment); - end; - LOC_REGISTER,LOC_CREGISTER: - begin - hreg:=hlcg.getintregister(current_asmdata.CurrAsmList,resultdef); - hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,left.resultdef,resultdef,location.register,hreg); - location.register:=hreg; - end; - end; - end; - - procedure tllvmtypeconvnode.second_int_to_bool; var truelabel, diff --git a/compiler/llvm/nllvmmat.pas b/compiler/llvm/nllvmmat.pas index 24c2a98948..031100feae 100644 --- a/compiler/llvm/nllvmmat.pas +++ b/compiler/llvm/nllvmmat.pas @@ -96,16 +96,16 @@ procedure tllvmmoddivnode.pass_generate_code; begin current_asmdata.getjumplabel(hl); location_reset(ovloc,LOC_REGISTER,OS_8); - ovloc.register:=hlcg.getintregister(current_asmdata.CurrAsmList,pasbool8type); + ovloc.register:=hlcg.getintregister(current_asmdata.CurrAsmList,llvmbool1type); if right.nodetype=ordconstn then current_asmdata.CurrAsmList.concat(taillvm.op_reg_cond_size_reg_const(la_icmp,ovloc.register,OC_EQ,resultdef,left.location.register,low(int64))) else begin - tmpovreg1:=hlcg.getintregister(current_asmdata.CurrAsmList,pasbool8type); - tmpovreg2:=hlcg.getintregister(current_asmdata.CurrAsmList,pasbool8type); + tmpovreg1:=hlcg.getintregister(current_asmdata.CurrAsmList,llvmbool1type); + tmpovreg2:=hlcg.getintregister(current_asmdata.CurrAsmList,llvmbool1type); current_asmdata.CurrAsmList.concat(taillvm.op_reg_cond_size_reg_const(la_icmp,tmpovreg1,OC_EQ,resultdef,left.location.register,low(int64))); current_asmdata.CurrAsmList.concat(taillvm.op_reg_cond_size_reg_const(la_icmp,tmpovreg2,OC_EQ,resultdef,right.location.register,-1)); - hlcg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_AND,pasbool8type,tmpovreg1,tmpovreg2,ovloc.register); + hlcg.a_op_reg_reg_reg(current_asmdata.CurrAsmList,OP_AND,llvmbool1type,tmpovreg1,tmpovreg2,ovloc.register); end; hlcg.g_overflowCheck_loc(current_asmdata.CurrAsmList,location,resultdef,ovloc); end; diff --git a/compiler/llvm/nllvmutil.pas b/compiler/llvm/nllvmutil.pas index f33b2b38e1..fc8d204b4a 100644 --- a/compiler/llvm/nllvmutil.pas +++ b/compiler/llvm/nllvmutil.pas @@ -45,13 +45,16 @@ implementation uses verbose,cutils,globals,fmodule,systems, aasmbase,aasmtai,cpubase,llvmbase,aasmllvm, + aasmcnst, symbase,symtable,defutil, llvmtype; class procedure tllvmnodeutils.insertbsssym(list: tasmlist; sym: tstaticvarsym; size: asizeint; varalign: shortint); var - asmsym: tasmsymbol; + asmsym, + symind: tasmsymbol; field1, field2: tsym; + tcb: ttai_typedconstbuilder; begin if sym.globalasmsym then asmsym:=current_asmdata.DefineAsmSymbol(sym.mangledname,AB_GLOBAL,AT_DATA) @@ -65,6 +68,15 @@ implementation list.concat(taillvmdecl.createdef(asmsym, get_threadvar_record(sym.vardef,field1,field2), nil,sec_data,varalign)); + symind:=current_asmdata.DefineAsmSymbol(sym.mangledname,AB_INDIRECT,AT_DATA); + tcb:=ctai_typedconstbuilder.create([tcalo_make_dead_strippable,tcalo_new_section]); + tcb.emit_tai(Tai_const.Create_sym_offset(asmsym,0),cpointerdef.getreusable(sym.vardef)); + list.concatlist(tcb.get_final_asmlist( + symind,cpointerdef.getreusable(sym.vardef), + sec_rodata, + lower(sym.mangledname), + const_align(sym.vardef.alignment))); + tcb.free; end; diff --git a/compiler/m68k/aasmcpu.pas b/compiler/m68k/aasmcpu.pas index 0dfc7d639a..f7c0ee7a53 100644 --- a/compiler/m68k/aasmcpu.pas +++ b/compiler/m68k/aasmcpu.pas @@ -42,6 +42,7 @@ type opsize : topsize; procedure loadregset(opidx:longint; const dataregs,addrregs,fpuregs:tcpuregisterset); + procedure loadrealconst(opidx:longint; const value_real: bestreal); constructor op_none(op : tasmop); constructor op_none(op : tasmop;_size : topsize); @@ -57,6 +58,7 @@ type constructor op_const_reg(op : tasmop;_size : topsize;_op1 : longint;_op2 : tregister); constructor op_const_const(op : tasmop;_size : topsize;_op1,_op2 : longint); constructor op_const_ref(op : tasmop;_size : topsize;_op1 : longint;_op2 : treference); + constructor op_realconst_reg(op : tasmop;_size : topsize;_op1: bestreal;_op2: tregister); constructor op_ref_reg(op : tasmop;_size : topsize;_op1 : treference;_op2 : tregister); { this is only allowed if _op1 is an int value (_op1^.isintvalue=true) } @@ -125,31 +127,40 @@ type begin if typ<>top_regset then clearop(opidx); - new(dataregset); - new(addrregset); - new(fpuregset); - dataregset^:=dataregs; - addrregset^:=addrregs; - fpuregset^:=fpuregs; + dataregset:=dataregs; + addrregset:=addrregs; + fpuregset:=fpuregs; typ:=top_regset; for i:=RS_D0 to RS_D7 do begin - if assigned(add_reg_instruction_hook) and (i in dataregset^) then + if assigned(add_reg_instruction_hook) and (i in dataregset) then add_reg_instruction_hook(self,newreg(R_INTREGISTER,i,R_SUBWHOLE)); end; for i:=RS_A0 to RS_SP do begin - if assigned(add_reg_instruction_hook) and (i in addrregset^) then + if assigned(add_reg_instruction_hook) and (i in addrregset) then add_reg_instruction_hook(self,newreg(R_ADDRESSREGISTER,i,R_SUBWHOLE)); end; for i:=RS_FP0 to RS_FP7 do begin - if assigned(add_reg_instruction_hook) and (i in fpuregset^) then + if assigned(add_reg_instruction_hook) and (i in fpuregset) then add_reg_instruction_hook(self,newreg(R_FPUREGISTER,i,R_SUBWHOLE)); end; end; end; + procedure taicpu.loadrealconst(opidx:longint; const value_real: bestreal); + begin + allocate_oper(opidx+1); + with oper[opidx]^ do + begin + if typ<>top_realconst then + clearop(opidx); + val_real:=value_real; + typ:=top_realconst; + end; + end; + procedure taicpu.init(_size : topsize); begin @@ -260,6 +271,14 @@ type loadref(1,_op2); end; + constructor taicpu.op_realconst_reg(op : tasmop;_size : topsize;_op1 : bestreal;_op2 : tregister); + begin + inherited create(op); + init(_size); + ops:=2; + loadrealconst(0,_op1); + loadreg(1,_op2); + end; constructor taicpu.op_ref_reg(op : tasmop;_size : topsize;_op1 : treference;_op2 : tregister); begin @@ -479,7 +498,7 @@ type A_ADD, A_ADDQ, A_ADDX, A_SUB, A_SUBQ, A_SUBX, A_AND, A_LSR, A_LSL, A_ASR, A_ASL, A_EOR, A_EORI, A_OR, A_ROL, A_ROR, A_ROXL, A_ROXR, - A_MULS, A_MULU, A_DIVS, A_DIVU, A_DIVSL, A_DIVUL, + A_MULS, A_MULU, A_DIVS, A_DIVU, A_DIVSL, A_DIVUL, A_REMS, A_REMU, A_BSET, A_BCLR: if opnr=1 then result:=operand_readwrite; diff --git a/compiler/m68k/ag68kgas.pas b/compiler/m68k/ag68kgas.pas index f140a6e251..5a5d18f6f9 100644 --- a/compiler/m68k/ag68kgas.pas +++ b/compiler/m68k/ag68kgas.pas @@ -163,23 +163,30 @@ interface getopstr:=''; for i:=RS_D0 to RS_D7 do begin - if i in o.dataregset^ then + if i in o.dataregset then getopstr:=getopstr+gas_regname(newreg(R_INTREGISTER,i,R_SUBWHOLE))+'/'; end; for i:=RS_A0 to RS_SP do begin - if i in o.addrregset^ then + if i in o.addrregset then getopstr:=getopstr+gas_regname(newreg(R_ADDRESSREGISTER,i,R_SUBWHOLE))+'/'; end; for i:=RS_FP0 to RS_FP7 do begin - if i in o.fpuregset^ then + if i in o.fpuregset then getopstr:=getopstr+gas_regname(newreg(R_FPUREGISTER,i,R_SUBNONE))+'/'; end; delete(getopstr,length(getopstr),1); end; top_const: getopstr:='#'+tostr(longint(o.val)); + top_realconst: + begin + str(o.val_real,getopstr); + if getopstr[1]=' ' then + getopstr[1]:='+'; + getopstr:='#0d'+getopstr; + end; else internalerror(200405021); end; end; @@ -288,7 +295,7 @@ interface sep:=#9 else if (i=2) and - (op in [A_DIVSL,A_DIVUL,A_MULS,A_MULU,A_DIVS,A_DIVU]) then + (op in [A_DIVSL,A_DIVUL,A_MULS,A_MULU,A_DIVS,A_DIVU,A_REMS,A_REMU]) then sep:=':' else sep:=','; diff --git a/compiler/m68k/ag68kvasm.pas b/compiler/m68k/ag68kvasm.pas new file mode 100644 index 0000000000..a597a7d963 --- /dev/null +++ b/compiler/m68k/ag68kvasm.pas @@ -0,0 +1,115 @@ +{ + Copyright (c) 2016 by the Free Pascal development team + + This unit is the VASM assembler writer for 68k + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} + +unit ag68kvasm; + +{$i fpcdefs.inc} + + interface + + uses + aasmbase,systems, + aasmtai,aasmdata, + aggas,ag68kgas, + cpubase,cgutils, + globtype; + + type + tm68kvasm = class(Tm68kGNUassembler) + constructor create(info: pasminfo; smart: boolean); override; + function MakeCmdLine: TCmdStr; override; + end; + + implementation + + uses + cutils,cfileutl,globals,verbose, + cgbase, + assemble,script, + itcpugas,cpuinfo, + aasmcpu; + + +{****************************************************************************} +{ VASM m68k Assembler writer } +{****************************************************************************} + + + constructor tm68kvasm.create(info: pasminfo; smart: boolean); + begin + inherited; + InstrWriter := Tm68kInstrWriter.create(self); + end; + + function tm68kvasm.MakeCmdLine: TCmdStr; + var + objtype: string; + begin + result:=asminfo^.asmcmd; + + case target_info.system of + system_m68k_amiga: objtype:='-Fhunk'; + system_m68k_atari: objtype:='-Fvobj'; // fix me? + system_m68k_linux: objtype:='-Felf'; + else + internalerror(2016052601); + end; + + if (target_info.system = system_m68k_amiga) then + begin + Replace(result,'$ASM',maybequoted(ScriptFixFileName(Unix2AmigaPath(AsmFileName)))); + Replace(result,'$OBJ',maybequoted(ScriptFixFileName(Unix2AmigaPath(ObjFileName)))); + end + else + begin + Replace(result,'$ASM',maybequoted(ScriptFixFileName(AsmFileName))); + Replace(result,'$OBJ',maybequoted(ScriptFixFileName(ObjFileName))); + end; + Replace(result,'$ARCH','-m'+GasCpuTypeStr[current_settings.cputype]); + Replace(result,'$OTYPE',objtype); + Replace(result,'$EXTRAOPT',asmextraopt); + end; + + + +{***************************************************************************** + Initialize +*****************************************************************************} + + const + as_m68k_vasm_info : tasminfo = + ( + id : as_m68k_vasm; + + idtxt : 'VASM'; + asmbin : 'vasmm68k_std'; + asmcmd: '-quiet -elfregs -gas $OTYPE $ARCH -o $OBJ $EXTRAOPT $ASM'; + supported_targets : [system_m68k_amiga,system_m68k_atari,system_m68k_linux]; + flags : [af_needar,af_smartlink_sections]; + labelprefix : '.L'; + comment : '# '; + dollarsign: '$'; + ); + +begin + RegisterAssembler(as_m68k_vasm_info,tm68kvasm); +end. diff --git a/compiler/m68k/aoptcpu.pas b/compiler/m68k/aoptcpu.pas index 4307c691f7..39ffcc9015 100644 --- a/compiler/m68k/aoptcpu.pas +++ b/compiler/m68k/aoptcpu.pas @@ -60,6 +60,7 @@ unit aoptcpu; var next: tai; tmpref: treference; + tmpsingle: single; begin result:=false; case p.typ of @@ -135,6 +136,43 @@ unit aoptcpu; taicpu(p).ops:=1; result:=true; end; + A_FCMP: + if (taicpu(p).oper[0]^.typ = top_realconst) then + begin + if (taicpu(p).oper[0]^.val_real = 0.0) then + begin + DebugMsg('Optimizer: FCMP #0.0 to FTST',p); + taicpu(p).opcode:=A_FTST; + taicpu(p).opsize:=S_FX; + taicpu(p).loadoper(0,taicpu(p).oper[1]^); + taicpu(p).clearop(1); + taicpu(p).ops:=1; + result:=true; + end + else + begin + tmpsingle:=taicpu(p).oper[0]^.val_real; + if (taicpu(p).opsize = S_FD) and + ((taicpu(p).oper[0]^.val_real - tmpsingle) = 0.0) then + begin + DebugMsg('Optimizer: FCMP const to lesser precision',p); + taicpu(p).opsize:=S_FS; + result:=true; + end; + end; + end; + A_FMOVE,A_FMUL,A_FADD,A_FSUB,A_FDIV: + if (taicpu(p).oper[0]^.typ = top_realconst) then + begin + tmpsingle:=taicpu(p).oper[0]^.val_real; + if (taicpu(p).opsize = S_FD) and + ((taicpu(p).oper[0]^.val_real - tmpsingle) = 0.0) then + begin + DebugMsg('Optimizer: FMOVE/FMUL/FADD/FSUB/FDIV const to lesser precision',p); + taicpu(p).opsize:=S_FS; + result:=true; + end; + end; end; end; end; diff --git a/compiler/m68k/cgcpu.pas b/compiler/m68k/cgcpu.pas index 95547958bf..3a3ab84c0f 100644 --- a/compiler/m68k/cgcpu.pas +++ b/compiler/m68k/cgcpu.pas @@ -50,8 +50,10 @@ unit cgcpu; procedure a_load_const_ref(list : TAsmList; tosize: tcgsize; a : tcgint;const ref : treference);override; procedure a_load_reg_ref(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);override; + procedure a_load_reg_ref_unaligned(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference);override; procedure a_load_reg_reg(list : TAsmList;fromsize,tosize : tcgsize;reg1,reg2 : tregister);override; procedure a_load_ref_reg(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister);override; + procedure a_load_ref_reg_unaligned(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister);override; procedure a_load_ref_ref(list : TAsmList;fromsize,tosize : tcgsize;const sref : treference;const dref : treference);override; procedure a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);override; @@ -65,6 +67,7 @@ unit cgcpu; procedure a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; const ref: TReference); override; procedure a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; src, dst: TRegister); override; procedure a_op_reg_ref(list : TAsmList; Op: TOpCG; size: TCGSize; reg: TRegister; const ref: TReference); override; + procedure a_op_ref_reg(list : TAsmList; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); override; procedure a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister; l : tasmlabel);override; procedure a_cmp_const_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;const ref : treference; l : tasmlabel); override; @@ -108,6 +111,8 @@ unit cgcpu; 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; + procedure a_load64_reg_ref(list : TAsmList;reg : tregister64;const ref : treference); override; + procedure a_load64_ref_reg(list : TAsmList;const ref : treference;reg : tregister64); override; end; { This function returns true if the reference+offset is valid. @@ -359,14 +364,7 @@ unit cgcpu; reference_reset_base(ref, NR_STACK_POINTER_REG, 0, tcgsize2size[pushsize]); ref.direction := dir_dec; - if tcgsize2size[paraloc^.size]<cgpara.alignment then - begin - tmpreg:=getintregister(list,pushsize); - a_load_ref_reg(list,paraloc^.size,pushsize,href,tmpreg); - list.concat(taicpu.op_reg_ref(A_MOVE,tcgsize2opsize[pushsize],tmpreg,ref)); - end - else - list.concat(taicpu.op_ref_ref(A_MOVE,tcgsize2opsize[pushsize],href,ref)); + a_load_ref_ref(list,int_cgsize(tcgsize2size[paraloc^.size]),pushsize,href,ref); end; var @@ -391,7 +389,7 @@ unit cgcpu; if tcgsize2size[cgpara.size]<>tcgsize2size[size] then internalerror(200501161); { We need to push the data in reverse order, - therefor we use a recursive algorithm } + therefore we use a recursive algorithm } pushdata(cgpara.location,0); end end @@ -708,6 +706,12 @@ unit cgcpu; hreg : tregister; href : treference; begin + if needs_unaligned(ref.alignment,tosize) then + begin + inherited; + exit; + end; + a:=longint(a); href:=ref; fixref(list,href,false); @@ -752,6 +756,13 @@ unit cgcpu; href : treference; hreg : tregister; begin + if needs_unaligned(ref.alignment,tosize) then + begin + //list.concat(tai_comment.create(strpnew('a_load_reg_ref calling unaligned'))); + a_load_reg_ref_unaligned(list,fromsize,tosize,register,ref); + exit; + end; + href := ref; hreg := register; fixref(list,href,false); @@ -765,6 +776,55 @@ unit cgcpu; end; + procedure tcg68k.a_load_reg_ref_unaligned(list : TAsmList;fromsize,tosize : tcgsize;register : tregister;const ref : treference); + var + tmpref : treference; + tmpreg, + tmpreg2 : tregister; + begin + if not needs_unaligned(ref.alignment,tosize) then + begin + a_load_reg_ref(list,fromsize,tosize,register,ref); + exit; + end; + + list.concat(tai_comment.create(strpnew('a_load_reg_ref_unaligned: generating unaligned store'))); + + tmpreg2:=getaddressregister(list); + tmpref:=ref; + inc(tmpref.offset,tcgsize2size[tosize]); + a_loadaddr_ref_reg(list,ref,tmpreg2); + reference_reset_base(tmpref,tmpreg2,0,1); + tmpref.direction:=dir_none; + + tmpreg:=getintregister(list,tosize); + a_load_reg_reg(list,fromsize,tosize,register,tmpreg); + + case tosize of + OS_16,OS_S16: + begin + list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref)); + list.concat(taicpu.op_const_reg(A_LSR,S_W,8,tmpreg)); + tmpref.direction:=dir_dec; + list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref)); + end; + OS_32,OS_S32: + begin + list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref)); + tmpref.direction:=dir_dec; + list.concat(taicpu.op_const_reg(A_LSR,S_W,8,tmpreg)); + list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref)); + list.concat(taicpu.op_reg(A_SWAP,S_L,tmpreg)); + list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref)); + list.concat(taicpu.op_const_reg(A_LSR,S_W,8,tmpreg)); + list.concat(taicpu.op_reg_ref(A_MOVE,S_B,tmpreg,tmpref)); + end + else + internalerror(2016052201); + end; + end; + + procedure tcg68k.a_load_ref_ref(list : TAsmList;fromsize,tosize : tcgsize;const sref : treference;const dref : treference); var aref: treference; @@ -773,24 +833,38 @@ unit cgcpu; hreg: TRegister; begin usetemp:=TCGSize2OpSize[fromsize]<>TCGSize2OpSize[tosize]; + usetemp:=usetemp or (needs_unaligned(sref.alignment,fromsize) or needs_unaligned(dref.alignment,tosize)); aref := sref; bref := dref; - fixref(list,aref,false); if usetemp then begin - { if we will use a temp register, we don't need to fully resolve - the dest ref, not even on coldfire } - fixref(list,bref,false); { if we need to change the size then always use a temporary register } hreg:=getintregister(list,fromsize); - list.concat(taicpu.op_ref_reg(A_MOVE,TCGSize2OpSize[fromsize],aref,hreg)); - sign_extend(list,fromsize,tosize,hreg); - list.concat(taicpu.op_reg_ref(A_MOVE,TCGSize2OpSize[tosize],hreg,bref)); + + if needs_unaligned(sref.alignment,fromsize) then + a_load_ref_reg_unaligned(list,fromsize,tosize,sref,hreg) + else + begin + fixref(list,aref,false); + list.concat(taicpu.op_ref_reg(A_MOVE,TCGSize2OpSize[fromsize],aref,hreg)); + sign_extend(list,fromsize,tosize,hreg); + end; + + if needs_unaligned(dref.alignment,tosize) then + a_load_reg_ref_unaligned(list,tosize,tosize,hreg,dref) + else + begin + { if we use a temp register, we don't need to fully resolve + the dest ref, not even on coldfire } + fixref(list,bref,false); + list.concat(taicpu.op_reg_ref(A_MOVE,TCGSize2OpSize[tosize],hreg,bref)); + end; end else begin + fixref(list,aref,false); fixref(list,bref,current_settings.cputype in cpu_coldfire); list.concat(taicpu.op_ref_ref(A_MOVE,TCGSize2OpSize[fromsize],aref,bref)); end; @@ -822,7 +896,7 @@ unit cgcpu; add_move_instruction(instr); list.concat(instr); end; - sign_extend(list,fromsize,reg2); + sign_extend(list,fromsize,tosize,reg2); end; end; @@ -833,27 +907,98 @@ unit cgcpu; hreg : tregister; size : tcgsize; opsize: topsize; + needsext: boolean; begin + if needs_unaligned(ref.alignment,fromsize) then + begin + //list.concat(tai_comment.create(strpnew('a_load_ref_reg calling unaligned'))); + a_load_ref_reg_unaligned(list,fromsize,tosize,ref,register); + exit; + end; + href:=ref; fixref(list,href,false); - if tcgsize2size[fromsize]<tcgsize2size[tosize] then + + needsext:=tcgsize2size[fromsize]<tcgsize2size[tosize]; + if needsext then size:=fromsize else size:=tosize; opsize:=TCGSize2OpSize[size]; if isaddressregister(register) and not (opsize in [S_L]) then + hreg:=getintregister(list,OS_ADDR) + else + hreg:=register; + + if needsext and (CPUM68K_HAS_MVSMVZ in cpu_capabilities[current_settings.cputype]) and not (opsize in [S_L]) then begin - hreg:=getintregister(list,OS_ADDR); - list.concat(taicpu.op_ref_reg(A_MOVE,opsize,href,hreg)); - sign_extend(list,size,hreg); - a_load_reg_reg(list,OS_ADDR,OS_ADDR,hreg,register); + if fromsize in [OS_S8,OS_S16] then + list.concat(taicpu.op_ref_reg(A_MVS,opsize,href,hreg)) + else if fromsize in [OS_8,OS_16] then + list.concat(taicpu.op_ref_reg(A_MVZ,opsize,href,hreg)) + else + internalerror(2016050502); end - else + else begin - list.concat(taicpu.op_ref_reg(A_MOVE,opsize,href,register)); - { extend the value in the register } - sign_extend(list, size, register); + list.concat(taicpu.op_ref_reg(A_MOVE,opsize,href,hreg)); + sign_extend(list,size,hreg); end; + + if hreg<>register then + a_load_reg_reg(list,OS_ADDR,OS_ADDR,hreg,register); + end; + + + procedure tcg68k.a_load_ref_reg_unaligned(list : TAsmList;fromsize,tosize : tcgsize;const ref : treference;register : tregister); + var + tmpref : treference; + tmpreg, + tmpreg2 : tregister; + begin + if not needs_unaligned(ref.alignment,fromsize) then + begin + a_load_ref_reg(list,fromsize,tosize,ref,register); + exit; + end; + + list.concat(tai_comment.create(strpnew('a_load_ref_reg_unaligned: generating unaligned load'))); + + tmpreg2:=getaddressregister(list); + a_loadaddr_ref_reg(list,ref,tmpreg2); + reference_reset_base(tmpref,tmpreg2,0,1); + tmpref.direction:=dir_inc; + + if isaddressregister(register) then + tmpreg:=getintregister(list,OS_ADDR) + else + tmpreg:=register; + + case fromsize of + OS_16,OS_S16: + begin + list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg)); + list.concat(taicpu.op_const_reg(A_LSL,S_W,8,tmpreg)); + tmpref.direction:=dir_none; + list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg)); + sign_extend(list,fromsize,tmpreg); + end; + OS_32,OS_S32: + begin + list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg)); + list.concat(taicpu.op_const_reg(A_LSL,S_W,8,tmpreg)); + list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg)); + list.concat(taicpu.op_reg(A_SWAP,S_L,tmpreg)); + list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg)); + list.concat(taicpu.op_const_reg(A_LSL,S_W,8,tmpreg)); + tmpref.direction:=dir_none; + list.concat(taicpu.op_ref_reg(A_MOVE,S_B,tmpref,tmpreg)); + end + else + internalerror(2016052103); + end; + if tmpreg<>register then + a_load_reg_reg(list,OS_ADDR,OS_ADDR,tmpreg,register); end; @@ -1118,7 +1263,8 @@ unit cgcpu; opsize := TCGSize2OpSize[size]; { on ColdFire all arithmetic operations are only possible on 32bit } - if ((current_settings.cputype in cpu_coldfire) and (opsize <> S_L) + if needs_unaligned(ref.alignment,size) or + ((current_settings.cputype in cpu_coldfire) and (opsize <> S_L) and not (op in [OP_NONE,OP_MOVE])) then begin inherited; @@ -1284,16 +1430,22 @@ unit cgcpu; { on ColdFire all arithmetic operations are only possible on 32bit and addressing modes are limited } - if ((current_settings.cputype in cpu_coldfire) and (opsize <> S_L)) then + if needs_unaligned(ref.alignment,size) or + ((current_settings.cputype in cpu_coldfire) and (opsize <> S_L)) then begin + //list.concat(tai_comment.create(strpnew('a_op_reg_ref: inherited #1'))); inherited; exit; end; case op of OP_ADD, - OP_SUB : + OP_SUB, + OP_OR, + OP_XOR, + OP_AND: begin + //list.concat(tai_comment.create(strpnew('a_op_reg_ref: normal op'))); href:=ref; fixref(list,href,false); { areg -> ref arithmetic operations are impossible on 68k } @@ -1302,12 +1454,56 @@ unit cgcpu; list.concat(taicpu.op_reg_ref(opcode, opsize, hreg, href)); end; else begin -// list.concat(tai_comment.create(strpnew('a_op_reg_ref inherited'))); + //list.concat(tai_comment.create(strpnew('a_op_reg_ref inherited #2'))); inherited; end; end; end; + + procedure tcg68k.a_op_ref_reg(list : TAsmList; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); + var + opcode : tasmop; + opsize : topsize; + href : treference; + hreg : tregister; + begin + opcode := topcg2tasmop[op]; + opsize := TCGSize2OpSize[size]; + + { on ColdFire all arithmetic operations are only possible on 32bit + and addressing modes are limited } + if needs_unaligned(ref.alignment,size) or + ((current_settings.cputype in cpu_coldfire) and (opsize <> S_L)) then + begin + //list.concat(tai_comment.create(strpnew('a_op_ref_reg: inherited #1'))); + inherited; + exit; + end; + + case op of + OP_ADD, + OP_SUB, + OP_OR, + OP_AND, + OP_MUL, + OP_IMUL: + begin + //list.concat(tai_comment.create(strpnew('a_op_ref_reg: normal op'))); + href:=ref; + { Coldfire doesn't support d(Ax,Dx) for long MULx... } + fixref(list,href,(op in [OP_MUL,OP_IMUL]) and + (current_settings.cputype in cpu_coldfire)); + list.concat(taicpu.op_ref_reg(opcode, opsize, href, reg)); + end; + else begin + //list.concat(tai_comment.create(strpnew('a_op_ref_reg inherited #2'))); + inherited; + end; + end; + end; + + procedure tcg68k.a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister; l : tasmlabel); var @@ -1372,7 +1568,7 @@ unit cgcpu; begin { optimize for usage of TST here, so ref compares against zero, which is the most common case by far in the RTL code at least (KB) } - if (a = 0) then + if not needs_unaligned(ref.alignment,size) and (a = 0) then begin //list.concat(tai_comment.create(strpnew('a_cmp_const_ref_label with TST'))); tmpref:=ref; @@ -1513,7 +1709,7 @@ unit cgcpu; a_loadaddr_ref_reg(list,source,iregister); a_loadaddr_ref_reg(list,dest,jregister); - if (current_settings.cputype <> cpu_mc68000) then + if not (needs_unaligned(source.alignment,OS_INT) or needs_unaligned(dest.alignment,OS_INT)) then begin if not ((len<=8) or (not(cs_opt_size in current_settings.optimizerswitches) and (len<=16))) then begin @@ -1570,7 +1766,7 @@ unit cgcpu; list.concat(taicpu.op_sym(A_BPL,S_NO,hl)); end else - list.concat(taicpu.op_reg_sym(A_DBRA,S_L,hregister,hl)); + list.concat(taicpu.op_reg_sym(A_DBRA,S_NO,hregister,hl)); end; end; @@ -1770,7 +1966,7 @@ unit cgcpu; { 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 + if (href.offset<low(smallint)) and (current_settings.cputype in cpu_coldfire+[cpu_mc68000]) 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)); @@ -1858,7 +2054,7 @@ 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 + if (href.offset<low(smallint)) and (current_settings.cputype in cpu_coldfire+[cpu_mc68000]) 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)); @@ -2144,10 +2340,9 @@ unit cgcpu; begin tempref:=ref; tcg68k(cg).fixref(list,tempref,false); + list.concat(taicpu.op_ref_reg(topcg2tasmop[op],S_L,tempref,reg.reghi)); 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 @@ -2210,6 +2405,34 @@ unit cgcpu; end; + procedure tcg64f68k.a_load64_reg_ref(list : TAsmList;reg : tregister64;const ref : treference); + var + tmpref: treference; + begin + tmpref:=ref; + tcg68k(cg).fixref(list,tmpref,false); + cg.a_load_reg_ref(list,OS_32,OS_32,reg.reghi,tmpref); + inc(tmpref.offset,4); + cg.a_load_reg_ref(list,OS_32,OS_32,reg.reglo,tmpref); + end; + + procedure tcg64f68k.a_load64_ref_reg(list : TAsmList;const ref : treference;reg : tregister64); + var + tmpref: treference; + begin + { do not allow 64bit values to be loaded to address registers } + if isaddressregister(reg.reglo) or + isaddressregister(reg.reghi) then + internalerror(2016050501); + + tmpref:=ref; + tcg68k(cg).fixref(list,tmpref,false); + cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reghi); + inc(tmpref.offset,4); + cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reglo); + end; + + procedure create_codegen; begin cg := tcg68k.create; diff --git a/compiler/m68k/cpubase.pas b/compiler/m68k/cpubase.pas index 24b6322209..12479463c1 100644 --- a/compiler/m68k/cpubase.pas +++ b/compiler/m68k/cpubase.pas @@ -67,7 +67,7 @@ unit cpubase; { mc64040 instructions } a_move16, { coldfire v4 instructions } - a_mov3q,a_mvz,a_mvs,a_sats,a_byterev,a_ff1, + a_mov3q,a_mvz,a_mvs,a_sats,a_byterev,a_ff1,a_remu,a_rems, { fpu processor instructions - directly supported } { ieee aware and misc. condition codes not supported } a_fabs,a_fadd, @@ -364,6 +364,7 @@ unit cpubase; function isintregister(reg : tregister) : boolean; function fpuregopsize: TOpSize; {$ifdef USEINLINE}inline;{$endif USEINLINE} function fpuregsize: aint; {$ifdef USEINLINE}inline;{$endif USEINLINE} + function needs_unaligned(const refalignment: aint; const size: tcgsize): boolean; function isregoverlap(reg1: tregister; reg2: tregister): boolean; function inverse_cond(const c: TAsmCond): TAsmCond; {$ifdef USEINLINE}inline;{$endif USEINLINE} @@ -553,6 +554,13 @@ implementation result:=fpu_regsize[current_settings.fputype = fpu_coldfire]; end; + function needs_unaligned(const refalignment: aint; const size: tcgsize): boolean; + begin + result:=not(CPUM68K_HAS_UNALIGNED in cpu_capabilities[current_settings.cputype]) and + (refalignment = 1) and + (tcgsize2size[size] > 1); + end; + // the function returns true, if the registers overlap (subreg of the same superregister and same type) function isregoverlap(reg1: tregister; reg2: tregister): boolean; begin diff --git a/compiler/m68k/cpuinfo.pas b/compiler/m68k/cpuinfo.pas index ea9a367b87..24fe1fdd95 100644 --- a/compiler/m68k/cpuinfo.pas +++ b/compiler/m68k/cpuinfo.pas @@ -38,6 +38,7 @@ Type cpu_MC68000, cpu_MC68020, cpu_MC68040, + cpu_MC68060, cpu_isa_a, cpu_isa_a_p, cpu_isa_b, @@ -94,6 +95,7 @@ Const '68000', '68020', '68040', + '68060', 'ISAA', 'ISAA+', 'ISAB', @@ -105,6 +107,7 @@ Const '68000', '68020', '68040', + '68060', 'isaa', 'isaaplus', 'isab', @@ -142,25 +145,39 @@ type CPUM68K_HAS_TAS, { CPU supports the TAS instruction } CPUM68K_HAS_BRAL, { CPU supports the BRA.L/Bcc.L instructions } CPUM68K_HAS_ROLROR, { CPU supports the ROL/ROR and ROXL/ROXR instructions } - CPUM68K_HAS_BYTEREV { CPU supports the BYTEREV instruction } + CPUM68K_HAS_BYTEREV, { CPU supports the BYTEREV instruction } + CPUM68K_HAS_MVSMVZ, { CPU supports the MVZ and MVS instructions } + CPUM68K_HAS_MOVE16, { CPU supports the MOVE16 instruction } + CPUM68K_HAS_32BITMUL, { CPU supports MULS/MULU 32x32 -> 32bit } + CPUM68K_HAS_64BITMUL, { CPU supports MULS/MULU 32x32 -> 64bit } + CPUM68K_HAS_16BITDIV, { CPU supports DIVS/DIVU 32/16 -> 16bit } + CPUM68K_HAS_32BITDIV, { CPU supports DIVS/DIVU 32/32 -> 32bit } + CPUM68K_HAS_64BITDIV, { CPU supports DIVS/DIVU 64/32 -> 32bit } + CPUM68K_HAS_REMSREMU, { CPU supports the REMS/REMU instructions } + CPUM68K_HAS_UNALIGNED, { CPU supports unaligned access } + CPUM68K_HAS_BASEDISP { CPU supports addressing with 32bit base displacements } ); const cpu_capabilities : array[tcputype] of set of tcpuflags = ( { cpu_none } [], - { cpu_68000 } [CPUM68K_HAS_DBRA,CPUM68K_HAS_TAS,CPUM68K_HAS_ROLROR], - { cpu_68020 } [CPUM68K_HAS_DBRA,CPUM68K_HAS_CAS,CPUM68K_HAS_TAS,CPUM68K_HAS_BRAL,CPUM68K_HAS_ROLROR], - { cpu_68040 } [CPUM68K_HAS_DBRA,CPUM68K_HAS_CAS,CPUM68K_HAS_TAS,CPUM68K_HAS_BRAL,CPUM68K_HAS_ROLROR], - { cpu_isaa } [], - { cpu_isaap } [CPUM68K_HAS_BRAL,CPUM68K_HAS_BYTEREV], - { cpu_isab } [CPUM68K_HAS_TAS,CPUM68K_HAS_BRAL], - { cpu_isac } [CPUM68K_HAS_TAS,CPUM68K_HAS_BYTEREV], - { cpu_cfv4e } [CPUM68K_HAS_TAS,CPUM68K_HAS_BYTEREV] + { cpu_68000 } [CPUM68K_HAS_DBRA,CPUM68K_HAS_TAS,CPUM68K_HAS_ROLROR,CPUM68K_HAS_16BITDIV], + { cpu_68020 } [CPUM68K_HAS_DBRA,CPUM68K_HAS_CAS,CPUM68K_HAS_TAS,CPUM68K_HAS_BRAL,CPUM68K_HAS_ROLROR,CPUM68K_HAS_UNALIGNED,CPUM68K_HAS_BASEDISP,CPUM68K_HAS_32BITMUL,CPUM68K_HAS_64BITMUL,CPUM68K_HAS_16BITDIV,CPUM68K_HAS_32BITDIV,CPUM68K_HAS_64BITDIV], + { cpu_68040 } [CPUM68K_HAS_DBRA,CPUM68K_HAS_CAS,CPUM68K_HAS_TAS,CPUM68K_HAS_BRAL,CPUM68K_HAS_ROLROR,CPUM68K_HAS_UNALIGNED,CPUM68K_HAS_BASEDISP,CPUM68K_HAS_32BITMUL,CPUM68K_HAS_64BITMUL,CPUM68K_HAS_16BITDIV,CPUM68K_HAS_32BITDIV,CPUM68K_HAS_64BITDIV,CPUM68K_HAS_MOVE16], + { cpu_68060 } [CPUM68K_HAS_DBRA,CPUM68K_HAS_CAS,CPUM68K_HAS_TAS,CPUM68K_HAS_BRAL,CPUM68K_HAS_ROLROR,CPUM68K_HAS_UNALIGNED,CPUM68K_HAS_BASEDISP,CPUM68K_HAS_32BITMUL,CPUM68K_HAS_16BITDIV,CPUM68K_HAS_32BITDIV,CPUM68K_HAS_MOVE16], + { cpu_isaa } [CPUM68K_HAS_UNALIGNED,CPUM68K_HAS_32BITMUL,CPUM68K_HAS_16BITDIV,CPUM68K_HAS_32BITDIV,CPUM68K_HAS_REMSREMU], + { cpu_isaap } [CPUM68K_HAS_BRAL,CPUM68K_HAS_BYTEREV,CPUM68K_HAS_UNALIGNED,CPUM68K_HAS_32BITMUL,CPUM68K_HAS_16BITDIV,CPUM68K_HAS_32BITDIV,CPUM68K_HAS_REMSREMU], + { cpu_isab } [CPUM68K_HAS_TAS,CPUM68K_HAS_BRAL,CPUM68K_HAS_MVSMVZ,CPUM68K_HAS_UNALIGNED,CPUM68K_HAS_32BITMUL,CPUM68K_HAS_16BITDIV,CPUM68K_HAS_32BITDIV,CPUM68K_HAS_REMSREMU], + { cpu_isac } [CPUM68K_HAS_TAS,CPUM68K_HAS_BYTEREV,CPUM68K_HAS_MVSMVZ,CPUM68K_HAS_UNALIGNED,CPUM68K_HAS_32BITMUL,CPUM68K_HAS_16BITDIV,CPUM68K_HAS_32BITDIV,CPUM68K_HAS_REMSREMU], + { cpu_cfv4e } [CPUM68K_HAS_TAS,CPUM68K_HAS_BRAL,CPUM68K_HAS_MVSMVZ,CPUM68K_HAS_UNALIGNED,CPUM68K_HAS_32BITMUL,CPUM68K_HAS_16BITDIV,CPUM68K_HAS_32BITDIV,CPUM68K_HAS_REMSREMU] ); { all CPUs commonly called "coldfire" } cpu_coldfire = [cpu_isa_a,cpu_isa_a_p,cpu_isa_b,cpu_isa_c,cpu_cfv4e]; + { all CPUs commonly called "68020+" } + cpu_mc68020p = [cpu_mc68020,cpu_mc68040,cpu_mc68060]; + Implementation end. diff --git a/compiler/m68k/cpunode.pas b/compiler/m68k/cpunode.pas index d956bc9826..489da54e16 100644 --- a/compiler/m68k/cpunode.pas +++ b/compiler/m68k/cpunode.pas @@ -39,7 +39,7 @@ unit cpunode; // nppccon, // nppcflw, n68kmem, -// nppcset, + n68kset, n68kinl, // nppcopt, { this not really a node } diff --git a/compiler/m68k/cputarg.pas b/compiler/m68k/cputarg.pas index 38bd83ac35..e6e6cdbc9a 100644 --- a/compiler/m68k/cputarg.pas +++ b/compiler/m68k/cputarg.pas @@ -59,6 +59,7 @@ implementation **************************************} ,ag68kgas + ,ag68kvasm {************************************** Debuginfo diff --git a/compiler/m68k/itcpugas.pas b/compiler/m68k/itcpugas.pas index f2b3fe9c3b..ee00e4b55b 100644 --- a/compiler/m68k/itcpugas.pas +++ b/compiler/m68k/itcpugas.pas @@ -61,7 +61,7 @@ interface { mc64040 instructions } 'move16', { coldfire v4 instructions } - 'mov3q','mvz','mvs','sats','byterev','ff1', + 'mov3q','mvz','mvs','sats','byterev','ff1','remu','rems', { fpu processor instructions - directly supported } { ieee aware and misc. condition codes not supported } 'fabs','fadd', diff --git a/compiler/m68k/n68kadd.pas b/compiler/m68k/n68kadd.pas index af61b9cdb3..7af020029c 100644 --- a/compiler/m68k/n68kadd.pas +++ b/compiler/m68k/n68kadd.pas @@ -37,6 +37,7 @@ interface protected procedure second_addfloat;override; procedure second_cmpfloat;override; + procedure second_addordinal;override; procedure second_cmpordinal;override; procedure second_cmpsmallset;override; procedure second_cmp64bit;override; @@ -171,23 +172,39 @@ implementation case current_settings.fputype of fpu_68881,fpu_coldfire: begin - { have left in the register, right can be a memory location } - hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true); - { initialize the result } location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef)); - location.register := cg.getfpuregister(current_asmdata.CurrAsmList,location.size); + + { have left in the register, right can be a memory location } + if not (current_settings.fputype = fpu_coldfire) and + (left.nodetype = realconstn) then + begin + location.register := cg.getfpuregister(current_asmdata.CurrAsmList,location.size); + current_asmdata.CurrAsmList.concat(taicpu.op_realconst_reg(A_FMOVE,tcgsize2opsize[left.location.size],trealconstnode(left).value_real,location.register)) + end + else + begin + hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true); + + location.register := cg.getfpuregister(current_asmdata.CurrAsmList,location.size); + cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmlist,OS_NO,OS_NO,left.location.register,location.register); + end; { emit the actual operation } - cg.a_loadfpu_reg_reg(current_asmdata.CurrAsmlist,OS_NO,OS_NO,left.location.register,location.register); case right.location.loc of LOC_FPUREGISTER,LOC_CFPUREGISTER: current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,fpuregopsize,right.location.register,location.register)); LOC_REFERENCE,LOC_CREFERENCE: begin - href:=right.location.reference; - tcg68k(cg).fixref(current_asmdata.CurrAsmList,href,current_settings.fputype = fpu_coldfire); - current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg(op,tcgsize2opsize[right.location.size],href,location.register)); + if not (current_settings.fputype = fpu_coldfire) and + (right.nodetype = realconstn) then + current_asmdata.CurrAsmList.concat(taicpu.op_realconst_reg(op,tcgsize2opsize[right.location.size],trealconstnode(right).value_real,location.register)) + else + begin + href:=right.location.reference; + tcg68k(cg).fixref(current_asmdata.CurrAsmList,href,current_settings.fputype = fpu_coldfire); + current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg(op,tcgsize2opsize[right.location.size],href,location.register)); + end; end else internalerror(2015021501); @@ -214,17 +231,46 @@ implementation fpu_68881,fpu_coldfire: begin { force left fpureg as register, right can be reference } - hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true); { emit compare } case right.location.loc of LOC_FPUREGISTER,LOC_CFPUREGISTER: - current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FCMP,fpuregopsize,right.location.register,left.location.register)); + begin + hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FCMP,fpuregopsize,right.location.register,left.location.register)); + end; LOC_REFERENCE,LOC_CREFERENCE: begin - href:=right.location.reference; - tcg68k(cg).fixref(current_asmdata.CurrAsmList,href,current_settings.fputype = fpu_coldfire); - current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg(A_FCMP,tcgsize2opsize[right.location.size],href,left.location.register)); + { use FTST, if realconst is 0.0, it would be very had to do this in the + optimized, because we would need to investigate the referenced value... } + if (right.nodetype = realconstn) and + (trealconstnode(right).value_real = 0.0) then + begin + if left.location.loc in [LOC_FPUREGISTER,LOC_CFPUREGISTER] then + current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_FTST,fpuregopsize,left.location.register)) + else + if left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE] then + begin + href:=left.location.reference; + tcg68k(cg).fixref(current_asmdata.CurrAsmList,href,false); + current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_FTST,tcgsize2opsize[left.location.size],href)) + end + else + internalerror(2016051001); + end + else + begin + hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true); + if not (current_settings.fputype = fpu_coldfire) and + (right.nodetype = realconstn) then + current_asmdata.CurrAsmList.concat(taicpu.op_realconst_reg(A_FCMP,tcgsize2opsize[right.location.size],trealconstnode(right).value_real,left.location.register)) + else + begin + href:=right.location.reference; + tcg68k(cg).fixref(current_asmdata.CurrAsmList,href,current_settings.fputype = fpu_coldfire); + current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg(A_FCMP,tcgsize2opsize[right.location.size],href,left.location.register)); + end; + end; end else internalerror(2015021502); @@ -298,6 +344,70 @@ implementation Ordinals *****************************************************************************} + procedure t68kaddnode.second_addordinal; + var + cgop : topcg; + begin + { if we need to handle overflow checking, fall back to the generic cg } + if (nodetype in [addn,subn,muln]) and + (left.resultdef.typ<>pointerdef) and + (right.resultdef.typ<>pointerdef) and + (cs_check_overflow in current_settings.localswitches) then + begin + inherited; + exit; + end; + + case nodetype of + addn: cgop:=OP_ADD; + xorn: cgop:=OP_XOR; + orn : cgop:=OP_OR; + andn: cgop:=OP_AND; + subn: cgop:=OP_SUB; + muln: + begin + if not(is_signed(left.resultdef)) or + not(is_signed(right.resultdef)) then + cgop:=OP_MUL + else + cgop:=OP_IMUL; + end; + else + internalerror(2013120104); + end; + + pass_left_right; + if (nodetype=subn) and (nf_swapped in flags) then + swapleftright; + + hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,false); + + { initialize the result } + location_reset(location,LOC_REGISTER,def_cgsize(resultdef)); + location.register := cg.getintregister(current_asmdata.CurrAsmList,location.size); + cg.a_load_reg_reg(current_asmdata.CurrAsmlist,left.location.size,location.size,left.location.register,location.register); + + if (location.size <> right.location.size) or + not (right.location.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_CONSTANT,LOC_REFERENCE,LOC_CREFERENCE]) or + (not(CPUM68K_HAS_32BITMUL in cpu_capabilities[current_settings.cputype]) and (nodetype = muln)) or + ((right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and needs_unaligned(right.location.reference.alignment,def_cgsize(resultdef))) then + hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,right.resultdef,true); + + case right.location.loc of + LOC_REGISTER, + LOC_CREGISTER: + cg.a_op_reg_reg(current_asmdata.CurrAsmList,cgop,def_cgsize(resultdef),right.location.register,location.register); + LOC_CONSTANT: + cg.a_op_const_reg(current_asmdata.CurrAsmList,cgop,def_cgsize(resultdef),right.location.value,location.register); + LOC_REFERENCE, + LOC_CREFERENCE: + cg.a_op_ref_reg(current_asmdata.CurrAsmList,cgop,def_cgsize(resultdef),right.location.reference,location.register); + else + internalerror(2016052101); + end; + end; + + procedure t68kaddnode.second_cmpordinal; var unsigned : boolean; @@ -322,19 +432,25 @@ implementation 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,false); - current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_TST,opsize,href)); - location_freetemp(current_asmdata.CurrAsmList,left.location); - end; + if (left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and not needs_unaligned(left.location.reference.alignment,cmpsize) then + begin + href:=left.location.reference; + tcg68k(cg).fixref(current_asmdata.CurrAsmList,href,false); + 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; + begin + hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true); + if (current_settings.cputype = cpu_mc68000) and isaddressregister(left.location.register) then + begin + tmpreg:=cg.getintregister(current_asmdata.CurrAsmList,cmpsize); + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_ADDR,cmpsize,left.location.register,tmpreg); + end + else + tmpreg:=left.location.register; + current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,opsize,tmpreg)); + end; location.resflags := getresflags(unsigned); exit; end; @@ -361,6 +477,10 @@ implementation toggleflag(nf_swapped); end; end; + + if (right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and needs_unaligned(right.location.reference.alignment,cmpsize) then + hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,right.resultdef,true); + { left is now in register } case right.location.loc of LOC_CONSTANT: @@ -490,26 +610,25 @@ implementation 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,false); - 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; + if (left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and not needs_unaligned(left.location.reference.alignment,OS_INT) then + begin + href:=left.location.reference; + tcg68k(cg).fixref(current_asmdata.CurrAsmList,href,false); + 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 - 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; + begin + 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; @@ -526,6 +645,9 @@ implementation end; end; + if (right.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and needs_unaligned(right.location.reference.alignment,OS_INT) then + hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,right.resultdef,true); + { left is now in register } case right.location.loc of LOC_REGISTER,LOC_CREGISTER: diff --git a/compiler/m68k/n68kcnv.pas b/compiler/m68k/n68kcnv.pas index f56885574f..61c02132dc 100644 --- a/compiler/m68k/n68kcnv.pas +++ b/compiler/m68k/n68kcnv.pas @@ -46,7 +46,7 @@ implementation ncon,ncal, ncgutil, cpubase,cpuinfo,aasmcpu, - rgobj,tgobj,cgobj,hlcgobj,cgutils,globtype,cgcpu; + rgobj,tgobj,cgobj,hlcgobj,cgutils,globtype,cgcpu,cutils; {***************************************************************************** @@ -191,7 +191,8 @@ implementation newsize:=def_cgsize(resultdef); opsize := def_cgsize(left.resultdef); - if (left.location.loc in [LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF]) then + if (left.location.loc in [LOC_SUBSETREG,LOC_CSUBSETREG,LOC_SUBSETREF,LOC_CSUBSETREF]) or + ((left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and needs_unaligned(left.location.reference.alignment,opsize)) then hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true); case left.location.loc of @@ -199,51 +200,42 @@ implementation begin if opsize in [OS_64,OS_S64] then begin + //current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('typeconvnode second_int_to_bool #1'))); reg64.reghi:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); reg64.reglo:=cg.getintregister(current_asmdata.CurrAsmList,OS_32); cg64.a_load64_loc_reg(current_asmdata.CurrAsmList,left.location,reg64); current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_OR,S_L,reg64.reghi,reg64.reglo)); - current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,S_L,reg64.reglo)); + // it's not necessary to call TST after OR, which sets the flags as required already + //current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,S_L,reg64.reglo)); end else begin - { can we optimize it, or do we need to fix the ref. ? } - if isvalidrefoffset(left.location.reference) then - begin - { Coldfire cannot handle tst.l 123(dX) } - if (current_settings.cputype in (cpu_coldfire + [cpu_mc68000])) and - isintregister(left.location.reference.base) then - begin - tmpreference:=left.location.reference; - hreg2:=cg.getaddressregister(current_asmdata.CurrAsmList); - tmpreference.base:=hreg2; - current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_MOVE,S_L,left.location.reference.base,hreg2)); - current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_TST,TCGSize2OpSize[opsize],tmpreference)); - end - else - current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_TST,TCGSize2OpSize[opsize],left.location.reference)); - end - else - begin - hreg2:=cg.getintregister(current_asmdata.CurrAsmList,opsize); - cg.a_load_ref_reg(current_asmdata.CurrAsmList,opsize,opsize, - left.location.reference,hreg2); - current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,TCGSize2OpSize[opsize],hreg2)); - end; + //current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('typeconvnode second_int_to_bool #2'))); + tmpreference:=left.location.reference; + tcg68k(cg).fixref(current_asmdata.CurrAsmList,tmpreference,false); + current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_TST,TCGSize2OpSize[opsize],tmpreference)); end; end; LOC_REGISTER,LOC_CREGISTER : begin if opsize in [OS_64,OS_S64] then begin + //current_asmdata.CurrAsmList.concat(tai_comment.create(strpnew('typeconvnode second_int_to_bool #3'))); hreg2:=cg.getintregister(current_asmdata.CurrAsmList,opsize); current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_MOVE,S_L,left.location.register64.reglo,hreg2)); current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_OR,S_L,left.location.register64.reghi,hreg2)); - current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,S_L,hreg2)); + // it's not necessary to call TST after OR, which sets the flags as required already + //current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,S_L,hreg2)); end else begin - hreg2:=left.location.register; + if (current_settings.cputype = cpu_mc68000) and isaddressregister(left.location.register) then + begin + hreg2:=cg.getintregister(current_asmdata.CurrAsmList,opsize); + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_ADDR,opsize,left.location.register,hreg2); + end + else + hreg2:=left.location.register; current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,TCGSize2OpSize[opsize],hreg2)); end; end; diff --git a/compiler/m68k/n68kmat.pas b/compiler/m68k/n68kmat.pas index 33a9f8b413..d755a90946 100644 --- a/compiler/m68k/n68kmat.pas +++ b/compiler/m68k/n68kmat.pas @@ -80,6 +80,10 @@ implementation begin secondpass(left); opsize:=def_cgsize(resultdef); + + if ((left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) and needs_unaligned(left.location.reference.alignment,opsize)) then + hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,resultdef,true); + case left.location.loc of LOC_FLAGS : begin @@ -117,7 +121,14 @@ implementation else begin hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,resultdef,true); - current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,tcgsize2opsize[opsize],left.location.register)); + if (current_settings.cputype = cpu_mc68000) and isaddressregister(left.location.register) then + begin + hreg:=cg.getintregister(current_asmdata.CurrAsmList,opsize); + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_ADDR,opsize,left.location.register,hreg); + end + else + hreg:=left.location.register; + current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,tcgsize2opsize[opsize],hreg)); end; location_reset(location,LOC_FLAGS,OS_NO); location.resflags:=F_E; @@ -135,7 +146,7 @@ implementation function tm68kmoddivnode.first_moddivint: tnode; begin - if current_settings.cputype=cpu_MC68020 then + if CPUM68K_HAS_32BITDIV in cpu_capabilities[current_settings.cputype] then result:=nil else result:=inherited first_moddivint; @@ -143,13 +154,12 @@ implementation procedure tm68kmoddivnode.emit_div_reg_reg(signed: boolean;denum,num : tregister); + const + divudivs: array[boolean] of tasmop = (A_DIVU,A_DIVS); begin - if current_settings.cputype=cpu_MC68020 then + if CPUM68K_HAS_32BITDIV in cpu_capabilities[current_settings.cputype] then begin - if signed then - current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_DIVS,S_L,denum,num)) - else - current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_DIVU,S_L,denum,num)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(divudivs[signed],S_L,denum,num)); end else InternalError(2014062801); @@ -157,22 +167,22 @@ implementation procedure tm68kmoddivnode.emit_mod_reg_reg(signed: boolean;denum,num : tregister); + const + remop: array[boolean,boolean] of tasmop = ((A_DIVU,A_DIVS),(A_REMU,A_REMS)); var tmpreg : tregister; begin - if current_settings.cputype=cpu_MC68020 then - begin - tmpreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); - { copy the numerator to the tmpreg, so we can use it as quotient, which - means we'll get the remainder immediately in the numerator } - cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,num,tmpreg); - if signed then - current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_DIVSL,S_L,denum,num,tmpreg)) - else - current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_DIVUL,S_L,denum,num,tmpreg)); - end - else - InternalError(2014062802); + if CPUM68K_HAS_32BITDIV in cpu_capabilities[current_settings.cputype] then + begin + tmpreg:=cg.getintregister(current_asmdata.CurrAsmList,OS_INT); + { copy the numerator to the tmpreg, so we can use it as quotient, which + means we'll get the remainder immediately in the numerator } + cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_INT,OS_INT,num,tmpreg); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg( + remop[CPUM68K_HAS_REMSREMU in cpu_capabilities[current_settings.cputype],signed],S_L,denum,num,tmpreg)); + end + else + InternalError(2014062802); end; diff --git a/compiler/m68k/n68kmem.pas b/compiler/m68k/n68kmem.pas index 63049bc4f0..af702b850d 100644 --- a/compiler/m68k/n68kmem.pas +++ b/compiler/m68k/n68kmem.pas @@ -90,7 +90,7 @@ implementation end; end; - if (location.reference.base=NR_NO) and not (scaled) then + if (location.reference.base=NR_NO) and not (scaled) and not assigned(location.reference.symbol) then begin { prefer an address reg, if we will be a base, for indexes any register works } if isintregister(maybe_const_reg) then diff --git a/compiler/m68k/n68kset.pas b/compiler/m68k/n68kset.pas new file mode 100644 index 0000000000..8df6712ff0 --- /dev/null +++ b/compiler/m68k/n68kset.pas @@ -0,0 +1,138 @@ +{ + Copyright (c) 2016 by the Free Pascal development team + + Generate m68k assembler for in set/case labels + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +unit n68kset; + +{$i fpcdefs.inc} + +interface + + uses + globtype, + symtype, + cgbase,cpuinfo,cpubase, + node,nset,ncgset; + + type + tcpucasenode = class(tcgcasenode) + procedure genlinearlist(hp : pcaselabel); override; + end; + +implementation + + uses + systems,globals, + cutils,verbose, + symdef,paramgr, + aasmtai,aasmdata, + nflw,constexp, + cgutils,cgobj,hlcgobj, + defutil; + + procedure tcpucasenode.genlinearlist(hp : pcaselabel); + + var + first : boolean; + last : TConstExprInt; + scratch_reg: tregister; + newsize: tcgsize; + newdef: tdef; + + procedure genitem(t : pcaselabel); + + begin + if assigned(t^.less) then + genitem(t^.less); + { do we need to test the first value? } + if first and (t^._low>get_min_value(left.resultdef)) then + hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,opsize,jmp_lt,tcgint(t^._low.svalue),hregister,elselabel); + if t^._low=t^._high then + begin + if t^._low-last=0 then + hlcg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,opsize,OC_EQ,0,hregister,blocklabel(t^.blockid)) + else + begin + hlcg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SUB, opsize, tcgint(t^._low.svalue-last.svalue), hregister); + hlcg.a_jmp_flags(current_asmdata.CurrAsmList,F_E,blocklabel(t^.blockid)); + end; + last:=t^._low; + end + else + begin + { it begins with the smallest label, if the value } + { is even smaller then jump immediately to the } + { ELSE-label } + if first then + begin + { have we to ajust the first value ? } + if (t^._low>get_min_value(left.resultdef)) or (get_min_value(left.resultdef)<>0) then + hlcg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SUB, opsize, tcgint(t^._low.svalue), hregister); + end + else + begin + { if there is no unused label between the last and the } + { present label then the lower limit can be checked } + { immediately. else check the range in between: } + hlcg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SUB, opsize, tcgint(t^._low.svalue-last.svalue), hregister); + hlcg.a_jmp_flags(current_asmdata.CurrAsmList,F_L,elselabel); + end; + hlcg.a_op_const_reg(current_asmdata.CurrAsmList, OP_SUB, opsize, tcgint(t^._high.svalue-t^._low.svalue), hregister); + hlcg.a_jmp_flags(current_asmdata.CurrAsmList,F_LE,blocklabel(t^.blockid)); + last:=t^._high; + end; + first:=false; + if assigned(t^.greater) then + genitem(t^.greater); + end; + + begin + { do we need to generate cmps? } + if (with_sign and (min_label<0)) then + genlinearcmplist(hp) + else + begin + { sign/zero extend the value to a full register before starting to + subtract values, so that on platforms that don't have + subregisters of the same size as the value we don't generate + sign/zero-extensions after every subtraction + + make newsize always signed, since we only do this if the size in + bytes of the register is larger than the original opsize, so + the value can always be represented by a larger signed type } + newsize:=tcgsize2signed[reg_cgsize(hregister)]; + if tcgsize2size[newsize]>opsize.size then + begin + newdef:=cgsize_orddef(newsize); + scratch_reg:=hlcg.getintregister(current_asmdata.CurrAsmList,newdef); + hlcg.a_load_reg_reg(current_asmdata.CurrAsmList,opsize,newdef,hregister,scratch_reg); + hregister:=scratch_reg; + opsize:=newdef; + end; + last:=0; + first:=true; + genitem(hp); + hlcg.a_jmp_always(current_asmdata.CurrAsmList,elselabel); + end; + end; + +begin + ccasenode:=tcpucasenode; +end. diff --git a/compiler/nbas.pas b/compiler/nbas.pas index dbedee8962..da328f4f3f 100644 --- a/compiler/nbas.pas +++ b/compiler/nbas.pas @@ -214,7 +214,6 @@ interface tempinfo: ptempinfo; constructor create(const temp: ttempcreatenode); virtual; - constructor create_offset(const temp: ttempcreatenode;aoffset:longint); constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; procedure ppuwrite(ppufile:tcompilerppufile);override; procedure resolveppuidx;override; @@ -224,8 +223,6 @@ interface procedure mark_write;override; function docompare(p: tnode): boolean; override; procedure printnodedata(var t:text);override; - protected - offset : longint; private tempidx : longint; end; @@ -1024,14 +1021,6 @@ implementation begin inherited create(temprefn); tempinfo := temp.tempinfo; - offset:=0; - end; - - - constructor ttemprefnode.create_offset(const temp: ttempcreatenode;aoffset:longint); - begin - self.create(temp); - offset := aoffset; end; @@ -1040,7 +1029,6 @@ implementation n: ttemprefnode; begin n := ttemprefnode(inherited dogetcopy); - n.offset := offset; if assigned(tempinfo^.hookoncopy) then { if the temp has been copied, assume it becomes a new } @@ -1073,7 +1061,6 @@ implementation begin inherited ppuload(t,ppufile); tempidx:=ppufile.getlongint; - offset:=ppufile.getlongint; end; @@ -1081,7 +1068,6 @@ implementation begin inherited ppuwrite(ppufile); ppufile.putlongint(tempinfo^.owner.ppuidx); - ppufile.putlongint(offset); end; @@ -1141,8 +1127,7 @@ implementation begin result := inherited docompare(p) and - (ttemprefnode(p).tempinfo = tempinfo) and - (ttemprefnode(p).offset = offset); + (ttemprefnode(p).tempinfo = tempinfo); end; diff --git a/compiler/ncal.pas b/compiler/ncal.pas index cdba28df6e..ea0ab5e33e 100644 --- a/compiler/ncal.pas +++ b/compiler/ncal.pas @@ -304,6 +304,7 @@ implementation symconst,defutil,defcmp, htypechk,pass_1, ncnv,nflw,nld,ninl,nadd,ncon,nmem,nset,nobjc, + pgenutil, ngenutil,objcutil, procinfo,cpuinfo, wpobase; @@ -365,6 +366,8 @@ implementation restype: byte; selftemp: ttempcreatenode; selfpara: tnode; + vardispatchparadef: trecorddef; + vardispatchfield: tsym; names : ansistring; variantdispatch : boolean; @@ -465,7 +468,9 @@ implementation end; { create a temp to store parameter values } - params:=ctempcreatenode.create(cformaltype,0,tt_persistent,false); + vardispatchparadef:=crecorddef.create_global_internal('',voidpointertype.size,voidpointertype.size,current_settings.alignment.maxCrecordalign); + { the size will be set once the vardistpatchparadef record has been completed } + params:=ctempcreatenode.create(vardispatchparadef,0,tt_persistent,false); addstatement(statements,params); calldescnode:=cdataconstnode.create; @@ -518,15 +523,14 @@ implementation { for Variants, we always pass a pointer, RTL helpers must handle it depending on byref bit } + vardispatchfield:=vardispatchparadef.add_field_by_def('',assignmenttype); if assignmenttype=voidpointertype then addstatement(statements,cassignmentnode.create( - ctypeconvnode.create_internal(ctemprefnode.create_offset(params,paramssize), - voidpointertype), + csubscriptnode.create(vardispatchfield,ctemprefnode.create(params)), ctypeconvnode.create_internal(caddrnode.create_internal(para.left),voidpointertype))) else addstatement(statements,cassignmentnode.create( - ctypeconvnode.create_internal(ctemprefnode.create_offset(params,paramssize), - assignmenttype), + csubscriptnode.create(vardispatchfield,ctemprefnode.create(params)), ctypeconvnode.create_internal(para.left,assignmenttype))); inc(paramssize,max(voidpointertype.size,assignmenttype.size)); @@ -536,6 +540,9 @@ implementation para:=tcallparanode(para.nextpara); end; + { finalize the parameter record } + trecordsymtable(vardispatchparadef.symtable).addalignmentpadding; + { Set final size for parameter block } params.size:=paramssize; @@ -3597,6 +3604,8 @@ implementation { if the final procedure definition is not yet owned, ensure that it is } procdefinition.register_def; + if procdefinition.is_specialization and (procdefinition.typ=procdef) then + maybe_add_pending_specialization(procdefinition); candidates.free; end; { end of procedure to call determination } diff --git a/compiler/ncgbas.pas b/compiler/ncgbas.pas index 8161472ee8..b8880bfba1 100644 --- a/compiler/ncgbas.pas +++ b/compiler/ncgbas.pas @@ -490,8 +490,6 @@ interface case tempinfo^.location.loc of LOC_REFERENCE: begin - inc(location.reference.offset,offset); - location.reference.alignment:=newalignment(location.reference.alignment,offset); { ti_valid should be excluded if it's a normal temp } end; LOC_REGISTER, @@ -516,8 +514,6 @@ interface tg.ChangeTempType(current_asmdata.CurrAsmList,tempinfo^.location.reference,tempinfo^.temptype); { adapt location } location.reference := ref; - inc(location.reference.offset,offset); - location.reference.alignment:=newalignment(location.reference.alignment,offset); end; diff --git a/compiler/ncgmem.pas b/compiler/ncgmem.pas index 1486988630..16611a41c4 100644 --- a/compiler/ncgmem.pas +++ b/compiler/ncgmem.pas @@ -926,12 +926,7 @@ implementation LOC_REGISTER, LOC_CREGISTER : begin -{$ifdef m68k} - location.reference.base:=cg.getaddressregister(current_asmdata.CurrAsmList); - cg.a_load_reg_reg(current_asmdata.CurrAsmList,OS_ADDR,OS_ADDR,left.location.register,location.reference.base); -{$else m68k} hlcg.reference_reset_base(location.reference,left.resultdef,left.location.register,0,location.reference.alignment); -{$endif m68k} end; LOC_CREFERENCE, LOC_REFERENCE : diff --git a/compiler/ncgutil.pas b/compiler/ncgutil.pas index 447619b45f..b09c97306c 100644 --- a/compiler/ncgutil.pas +++ b/compiler/ncgutil.pas @@ -1308,7 +1308,9 @@ implementation for i:=0 to current_procinfo.procdef.paras.count-1 do begin currpara:=tparavarsym(current_procinfo.procdef.paras[i]); - gen_load_cgpara_loc(list,currpara.vardef,currpara.paraloc[calleeside],currpara.initialloc,paramanager.param_use_paraloc(currpara.paraloc[calleeside])); + { don't use currpara.vardef, as this will be wrong in case of + call-by-reference parameters (it won't contain the pointerdef) } + gen_load_cgpara_loc(list,currpara.paraloc[calleeside].def,currpara.paraloc[calleeside],currpara.initialloc,paramanager.param_use_paraloc(currpara.paraloc[calleeside])); { gen_load_cgpara_loc() already allocated the initialloc -> don't allocate again } if currpara.initialloc.loc in [LOC_CREGISTER,LOC_CFPUREGISTER,LOC_CMMREGISTER] then diff --git a/compiler/ncnv.pas b/compiler/ncnv.pas index 404fd9c50c..dd83cd0f47 100644 --- a/compiler/ncnv.pas +++ b/compiler/ncnv.pas @@ -1760,7 +1760,7 @@ implementation { one dimensional } addstatement(newstatement,cassignmentnode.create( - ctemprefnode.create_offset(temp2,0), + ctemprefnode.create(temp2), cordconstnode.create (tarraydef(left.resultdef).highrange+1,s32inttype,true))); { create call to fpc_dynarr_setlength } diff --git a/compiler/ngenutil.pas b/compiler/ngenutil.pas index e7ea96fafa..0dcb142e64 100644 --- a/compiler/ngenutil.pas +++ b/compiler/ngenutil.pas @@ -37,6 +37,17 @@ interface class function call_fail_node:tnode; virtual; class function initialize_data_node(p:tnode; force: boolean):tnode; virtual; class function finalize_data_node(p:tnode):tnode; virtual; + strict protected + class procedure sym_maybe_initialize(p: TObject; arg: pointer); + { generates the code for finalisation of local variables } + class procedure local_varsyms_finalize(p:TObject;arg:pointer); + { generates the code for finalization of static symtable and + all local (static) typed consts } + class procedure static_syms_finalize(p: TObject; arg: pointer); + class procedure sym_maybe_finalize(var stat: tstatementnode; sym: tsym); + public + class procedure procdef_block_add_implicit_initialize_nodes(pd: tprocdef; var stat: tstatementnode); + class procedure procdef_block_add_implicit_finalize_nodes(pd: tprocdef; var stat: tstatementnode); { returns true if the unit requires an initialisation section (e.g., to force class constructors for the JVM target to initialise global records/arrays) } @@ -260,6 +271,149 @@ implementation end; + class procedure tnodeutils.sym_maybe_initialize(p: TObject; arg: pointer); + begin + if (tsym(p).typ = localvarsym) and + { local (procedure or unit) variables only need initialization if + they are used } + ((tabstractvarsym(p).refs>0) or + { managed return symbols must be inited } + ((tsym(p).typ=localvarsym) and (vo_is_funcret in tlocalvarsym(p).varoptions)) + ) and + not(vo_is_typed_const in tabstractvarsym(p).varoptions) and + not(vo_is_external in tabstractvarsym(p).varoptions) and + not(vo_is_default_var in tabstractvarsym(p).varoptions) and + (is_managed_type(tabstractvarsym(p).vardef) or + ((m_iso in current_settings.modeswitches) and (tabstractvarsym(p).vardef.typ=filedef)) + ) then + begin + addstatement(tstatementnode(arg^),initialize_data_node(cloadnode.create(tsym(p),tsym(p).owner),false)); + end; + end; + + + class procedure tnodeutils.local_varsyms_finalize(p: TObject; arg: pointer); + begin + if (tsym(p).typ=localvarsym) and + (tlocalvarsym(p).refs>0) and + not(vo_is_external in tlocalvarsym(p).varoptions) and + not(vo_is_funcret in tlocalvarsym(p).varoptions) and + not(vo_is_default_var in tabstractvarsym(p).varoptions) and + is_managed_type(tlocalvarsym(p).vardef) then + sym_maybe_finalize(tstatementnode(arg^),tsym(p)); + end; + + + class procedure tnodeutils.static_syms_finalize(p: TObject; arg: pointer); + var + i : longint; + pd : tprocdef; + begin + case tsym(p).typ of + staticvarsym : + begin + { local (procedure or unit) variables only need finalization + if they are used + } + if ((tstaticvarsym(p).refs>0) or + { global (unit) variables always need finalization, since + they may also be used in another unit + } + (tstaticvarsym(p).owner.symtabletype=globalsymtable)) and + ( + (tstaticvarsym(p).varspez<>vs_const) or + (vo_force_finalize in tstaticvarsym(p).varoptions) + ) and + not(vo_is_funcret in tstaticvarsym(p).varoptions) and + not(vo_is_external in tstaticvarsym(p).varoptions) and + is_managed_type(tstaticvarsym(p).vardef) and + not ( + assigned(tstaticvarsym(p).fieldvarsym) and + assigned(tstaticvarsym(p).fieldvarsym.owner.defowner) and + (df_generic in tdef(tstaticvarsym(p).fieldvarsym.owner.defowner).defoptions) + ) + then + sym_maybe_finalize(tstatementnode(arg^),tsym(p)); + end; + procsym : + begin + for i:=0 to tprocsym(p).ProcdefList.Count-1 do + begin + pd:=tprocdef(tprocsym(p).ProcdefList[i]); + if assigned(pd.localst) and + (pd.procsym=tprocsym(p)) and + (pd.localst.symtabletype<>staticsymtable) then + pd.localst.SymList.ForEachCall(@static_syms_finalize,arg); + end; + end; + end; + end; + + + class procedure tnodeutils.sym_maybe_finalize(var stat: tstatementnode; sym: tsym); + var + hp: tnode; + begin + include(current_procinfo.flags,pi_needs_implicit_finally); + hp:=cloadnode.create(sym,sym.owner); + if (sym.typ=staticvarsym) and (vo_force_finalize in tstaticvarsym(sym).varoptions) then + include(tloadnode(hp).loadnodeflags,loadnf_isinternal_ignoreconst); + addstatement(stat,finalize_data_node(hp)); + end; + + + class procedure tnodeutils.procdef_block_add_implicit_initialize_nodes(pd: tprocdef; var stat: tstatementnode); + begin + { initialize local data like ansistrings } + case pd.proctypeoption of + potype_unitinit: + begin + { this is also used for initialization of variables in a + program which does not have a globalsymtable } + if assigned(current_module.globalsymtable) then + TSymtable(current_module.globalsymtable).SymList.ForEachCall(@sym_maybe_initialize,@stat); + TSymtable(current_module.localsymtable).SymList.ForEachCall(@sym_maybe_initialize,@stat); + TSymtable(current_module.localsymtable).SymList.ForEachCall(@sym_maybe_initialize,@stat); + end; + { units have seperate code for initilization and finalization } + potype_unitfinalize: ; + { program init/final is generated in separate procedure } + potype_proginit: + begin + TSymtable(current_module.localsymtable).SymList.ForEachCall(@sym_maybe_initialize,@stat); + end; + else + current_procinfo.procdef.localst.SymList.ForEachCall(@sym_maybe_initialize,@stat); + end; + end; + + + class procedure tnodeutils.procdef_block_add_implicit_finalize_nodes(pd: tprocdef; var stat: tstatementnode); + begin + { no finalization in exceptfilters, they /are/ the finalization code } + if current_procinfo.procdef.proctypeoption=potype_exceptfilter then + exit; + + { finalize local data like ansistrings} + case current_procinfo.procdef.proctypeoption of + potype_unitfinalize: + begin + { this is also used for initialization of variables in a + program which does not have a globalsymtable } + if assigned(current_module.globalsymtable) then + TSymtable(current_module.globalsymtable).SymList.ForEachCall(@static_syms_finalize,@stat); + TSymtable(current_module.localsymtable).SymList.ForEachCall(@static_syms_finalize,@stat); + end; + { units/progs have separate code for initialization and finalization } + potype_unitinit: ; + { program init/final is generated in separate procedure } + potype_proginit: ; + else + current_procinfo.procdef.localst.SymList.ForEachCall(@local_varsyms_finalize,@stat); + end; + end; + + class function tnodeutils.force_init: boolean; begin result:= @@ -584,12 +738,15 @@ implementation else list.concat(Tai_datablock.create(sym.mangledname,size)); - { add the indirect symbol if needed } - new_section(list,sec_rodata,lower(sym.mangledname),const_align(sym.vardef.alignment)); - symind:=current_asmdata.DefineAsmSymbol(sym.mangledname,AB_INDIRECT,AT_DATA); - list.concat(Tai_symbol.Create_Global(symind,0)); - list.concat(Tai_const.Createname(sym.mangledname,AT_DATA,0)); - list.concat(tai_symbol_end.Create(symind)); + if (tf_supports_packages in target_info.flags) then + begin + { add the indirect symbol if needed } + new_section(list,sec_rodata,lower(sym.mangledname),const_align(sym.vardef.alignment)); + symind:=current_asmdata.DefineAsmSymbol(sym.mangledname,AB_INDIRECT,AT_DATA); + list.concat(Tai_symbol.Create_Global(symind,0)); + list.concat(Tai_const.Createname(sym.mangledname,AT_DATA,0)); + list.concat(tai_symbol_end.Create(symind)); + end; end; @@ -1160,7 +1317,8 @@ implementation ); tcb.free; - if not(tf_no_generic_stackcheck in target_info.flags) then + if (tf_emit_stklen in target_info.flags) or + not(tf_no_generic_stackcheck in target_info.flags) then begin { stacksize can be specified and is now simulated } tcb:=ctai_typedconstbuilder.create([tcalo_new_section,tcalo_make_dead_strippable]); diff --git a/compiler/ninl.pas b/compiler/ninl.pas index 696097924e..3417e0890e 100644 --- a/compiler/ninl.pas +++ b/compiler/ninl.pas @@ -3958,7 +3958,7 @@ implementation newblock:=internalstatements(newstatement); { get temp for array of lengths } - temp:=ctempcreatenode.create(sinttype,dims*sinttype.size,tt_persistent,false); + temp:=ctempcreatenode.create(carraydef.getreusable(sinttype,dims),dims*sinttype.size,tt_persistent,false); addstatement(newstatement,temp); { load array of lengths } @@ -3967,7 +3967,10 @@ implementation while assigned(ppn.right) do begin addstatement(newstatement,cassignmentnode.create( - ctemprefnode.create_offset(temp,counter*sinttype.size), + cvecnode.create( + ctemprefnode.create(temp), + genintconstnode(counter) + ), ppn.left)); ppn.left:=nil; dec(counter); @@ -3977,8 +3980,11 @@ implementation ppn.left:=nil; { create call to fpc_dynarr_setlength } - npara:=ccallparanode.create(caddrnode.create_internal - (ctemprefnode.create(temp)), + npara:=ccallparanode.create(caddrnode.create_internal( + cvecnode.create( + ctemprefnode.create(temp), + genintconstnode(0) + )), ccallparanode.create(cordconstnode.create (dims,sinttype,true), ccallparanode.create(caddrnode.create_internal diff --git a/compiler/ogbase.pas b/compiler/ogbase.pas index 16f16a8bb5..d27a23e9ba 100644 --- a/compiler/ogbase.pas +++ b/compiler/ogbase.pas @@ -192,7 +192,7 @@ interface symidx : longint; objsection : TObjSection; offset, - size : aword; + size : PUInt; { Used for external and common solving during linking } exesymbol : TExeSymbol; @@ -260,7 +260,7 @@ interface SecAlign : shortint; { alignment of the section } { section Data } Size, - DataPos : aword; + DataPos : PUInt; MemPos : qword; Group : TObjSectionGroup; DataAlignBytes : shortint; @@ -272,19 +272,19 @@ interface VTRefList : TFPObjectList; constructor create(AList:TFPHashObjectList;const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions);virtual; destructor destroy;override; - function write(const d;l:aword):aword; + function write(const d;l:PUInt):PUInt; { writes string plus zero byte } - function writestr(const s:string):aword; - function WriteZeros(l:longword):aword; + function writestr(const s:string):PUInt; + function WriteZeros(l:longword):PUInt; { writes content of s without null termination } - function WriteBytes(const s:string):aword; + function WriteBytes(const s:string):PUInt; procedure writeReloc_internal(aTarget:TObjSection;offset:aword;len:byte;reltype:TObjRelocationType);virtual; function setmempos(mpos:qword):qword; - procedure setDatapos(var dpos:aword); - procedure alloc(l:aword); - procedure addsymReloc(ofs:aword;p:TObjSymbol;Reloctype:TObjRelocationType); - procedure addsectionReloc(ofs:aword;aobjsec:TObjSection;Reloctype:TObjRelocationType); - procedure addrawReloc(ofs:aword;p:TObjSymbol;RawReloctype:byte); + procedure setDatapos(var dpos:PUInt); + procedure alloc(l:PUInt); + procedure addsymReloc(ofs:PUInt;p:TObjSymbol;Reloctype:TObjRelocationType); + procedure addsectionReloc(ofs:PUInt;aobjsec:TObjSection;Reloctype:TObjRelocationType); + procedure addrawReloc(ofs:PUInt;p:TObjSymbol;RawReloctype:byte); procedure ReleaseData; function FullName:string; { string representation for the linker map file } @@ -373,7 +373,7 @@ interface procedure afteralloc;virtual; procedure afterwrite;virtual; procedure resetsections; - procedure layoutsections(var datapos:aword); + procedure layoutsections(var datapos:PUInt); property Name:TString80 read FName; property CurrObjSec:TObjSection read FCurrObjSec; property ObjSymbolList:TObjSymbolList read FObjSymbolList; @@ -928,7 +928,7 @@ implementation end; - function TObjSection.write(const d;l:aword):aword; + function TObjSection.write(const d;l:PUInt):PUInt; begin result:=size; if assigned(Data) then @@ -947,7 +947,7 @@ implementation end; - function TObjSection.writestr(const s:string):aword; + function TObjSection.writestr(const s:string):PUInt; var b: byte; begin @@ -957,13 +957,13 @@ implementation end; - function TObjSection.WriteBytes(const s:string):aword; + function TObjSection.WriteBytes(const s:string):PUInt; begin result:=Write(s[1],length(s)); end; - function TObjSection.WriteZeros(l:longword):aword; + function TObjSection.WriteZeros(l:longword):PUInt; var empty : array[0..1023] of byte; begin @@ -995,7 +995,7 @@ implementation end; - procedure TObjSection.setDatapos(var dpos:aword); + procedure TObjSection.setDatapos(var dpos:PUInt); begin if oso_Data in secoptions then begin @@ -1018,7 +1018,7 @@ implementation end; - procedure TObjSection.alloc(l:aword); + procedure TObjSection.alloc(l:PUInt); begin {$ifndef cpu64bitalu} if (qword(size)+l)>high(size) then @@ -1031,19 +1031,19 @@ implementation end; - procedure TObjSection.addsymReloc(ofs:aword;p:TObjSymbol;Reloctype:TObjRelocationType); + procedure TObjSection.addsymReloc(ofs:PUInt;p:TObjSymbol;Reloctype:TObjRelocationType); begin ObjRelocations.Add(TObjRelocation.CreateSymbol(ofs,p,reloctype)); end; - procedure TObjSection.addsectionReloc(ofs:aword;aobjsec:TObjSection;Reloctype:TObjRelocationType); + procedure TObjSection.addsectionReloc(ofs:PUInt;aobjsec:TObjSection;Reloctype:TObjRelocationType); begin ObjRelocations.Add(TObjRelocation.CreateSection(ofs,aobjsec,reloctype)); end; - procedure TObjSection.addrawReloc(ofs:aword;p:TObjSymbol;RawReloctype:byte); + procedure TObjSection.addrawReloc(ofs:PUInt;p:TObjSymbol;RawReloctype:byte); begin ObjRelocations.Add(TObjRelocation.CreateRaw(ofs,p,RawReloctype)); end; @@ -1498,7 +1498,7 @@ implementation end; - procedure TObjData.layoutsections(var DataPos:aword); + procedure TObjData.layoutsections(var DataPos:PUInt); var i: longint; begin diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas index f61f9b8983..fd3e596bf0 100644 --- a/compiler/pdecsub.pas +++ b/compiler/pdecsub.pas @@ -3229,6 +3229,7 @@ const are written using ;procdir; or ['procdir'] syntax. } var + stoprecording, res : boolean; begin if (m_mac in current_settings.modeswitches) and (cs_externally_visible in current_settings.localswitches) then @@ -3257,6 +3258,17 @@ const include(pd.procoptions,po_staticmethod); end; + { for a generic routine we also need to record the procedure } + { directives, but only if we aren't already recording for a } + { surrounding generic } + if pd.is_generic and (pd.typ=procdef) and not current_scanner.is_recording_tokens then + begin + current_scanner.startrecordtokens(tprocdef(pd).genericdecltokenbuf); + stoprecording:=true; + end + else + stoprecording:=false; + while token in [_ID,_LECKKLAMMER] do begin if try_to_consume(_LECKKLAMMER) then @@ -3302,6 +3314,10 @@ const else break; end; + + if stoprecording then + current_scanner.stoprecordtokens; + { nostackframe requires assembler, but assembler may be specified in the implementation part only, and in not required if the function is first forward declared diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas index 2a3bd396b8..529023521c 100644 --- a/compiler/pexpr.pas +++ b/compiler/pexpr.pas @@ -66,7 +66,7 @@ implementation uses { common } - cutils, + cutils,cclasses, { global } verbose, systems,widestr, @@ -1717,28 +1717,39 @@ implementation temp : ttempcreatenode; paras : tcallparanode; newblock : tnode; - countindices : aint; + countindices : longint; + elements: tfplist; + arraydef: tdef; begin { create statements with call initialize the arguments and call fpc_dynarr_setlength } newblock:=internalstatements(newstatement); - { get temp for array of indicies, - we set the real size later } - temp:=ctempcreatenode.create(s32inttype,4,tt_persistent,false); - addstatement(newstatement,temp); - + { store all indices in a temporary array } countindices:=0; + elements:=tfplist.Create; repeat p4:=comp_expr([ef_accept_equal]); - - addstatement(newstatement,cassignmentnode.create( - ctemprefnode.create_offset(temp,countindices*s32inttype.size),p4)); - inc(countindices); + elements.add(p4); until not try_to_consume(_COMMA); - { set real size } - temp.size:=countindices*s32inttype.size; + arraydef:=carraydef.getreusable(s32inttype,elements.count); + temp:=ctempcreatenode.create(arraydef,arraydef.size,tt_persistent,false); + addstatement(newstatement,temp); + for countindices:=0 to elements.count-1 do + begin + addstatement(newstatement, + cassignmentnode.create( + cvecnode.create( + ctemprefnode.create(temp), + genintconstnode(countindices) + ), + tnode(elements[countindices]) + ) + ); + end; + countindices:=elements.count; + elements.free; consume(_RECKKLAMMER); @@ -1752,7 +1763,7 @@ implementation paras:=ccallparanode.create(cordconstnode.create (countindices,s32inttype,true), ccallparanode.create(caddrnode.create_internal - (ctemprefnode.create(temp)), + (cvecnode.create(ctemprefnode.create(temp),genintconstnode(0))), ccallparanode.create(ctypeconvnode.create_internal(p4,cvarianttype), ccallparanode.create(ctypeconvnode.create_internal(p1,cvarianttype) ,nil)))); @@ -1827,7 +1838,7 @@ implementation { one dimensional } addstatement(newstatement,cassignmentnode.create( - ctemprefnode.create_offset(temp2,0), + ctemprefnode.create(temp2), cordconstnode.create (paracount,s32inttype,true))); { create call to fpc_dynarr_setlength } diff --git a/compiler/pgenutil.pas b/compiler/pgenutil.pas index 1036c265c4..a1c7efd4cb 100644 --- a/compiler/pgenutil.pas +++ b/compiler/pgenutil.pas @@ -51,6 +51,9 @@ uses function resolve_generic_dummysym(const name:tidstring):tsym; function could_be_generic(const name:tidstring):boolean;inline; + procedure generate_specialization_procs; + procedure maybe_add_pending_specialization(def:tdef); + procedure specialization_init(genericdef:tdef;var state:tspecializationstate); procedure specialization_done(var state:tspecializationstate); @@ -70,7 +73,7 @@ uses node,nobj,nmem, { parser } scanner, - pbase,pexpr,pdecsub,ptype; + pbase,pexpr,pdecsub,ptype,psub; procedure maybe_add_waiting_unit(tt:tdef); @@ -701,6 +704,7 @@ uses item : tobject; hintsprocessed : boolean; pd : tprocdef; + pdflags : tpdflags; begin if not assigned(context) then internalerror(2015052203); @@ -995,6 +999,14 @@ uses end; procdef: begin + pdflags:=[pd_body,pd_implemen]; + if genericdef.owner.symtabletype=objectsymtable then + include(pdflags,pd_object) + else if genericdef.owner.symtabletype=recordsymtable then + include(pdflags,pd_record); + parse_proc_directives(pd,pdflags); + while try_consume_hintdirective(pd.symoptions,pd.deprecatedmsg) do + consume(_SEMICOLON); handle_calling_convention(tprocdef(result),hcc_all); proc_add_definition(tprocdef(result)); { for partial specializations we implicitely declare the routine as @@ -1060,6 +1072,10 @@ uses tempst.free; specialization_done(state); + + { procdefs are only added once we know which overload we use } + if result.typ<>procdef then + current_module.pendingspecializations.add(result.typename,result); end; generictypelist.free; @@ -1494,4 +1510,157 @@ uses fillchar(state, sizeof(state), 0); end; + +{**************************************************************************** + SPECIALIZATION BODY GENERATION +****************************************************************************} + + + procedure process_procdef(def:tprocdef;hmodule:tmodule); + var + oldcurrent_filepos : tfileposinfo; + begin + if assigned(def.genericdef) and + (def.genericdef.typ=procdef) and + assigned(tprocdef(def.genericdef).generictokenbuf) then + begin + if not assigned(tprocdef(def.genericdef).generictokenbuf) then + internalerror(2015061902); + oldcurrent_filepos:=current_filepos; + current_filepos:=tprocdef(def.genericdef).fileinfo; + { use the index the module got from the current compilation process } + current_filepos.moduleindex:=hmodule.unit_index; + current_tokenpos:=current_filepos; + current_scanner.startreplaytokens(tprocdef(def.genericdef).generictokenbuf); + read_proc_body(def); + current_filepos:=oldcurrent_filepos; + end + { synthetic routines will be implemented afterwards } + else if def.synthetickind=tsk_none then + MessagePos1(def.fileinfo,sym_e_forward_not_resolved,def.fullprocname(false)); + end; + + + function process_abstractrecorddef(def:tabstractrecorddef):boolean; + var + i : longint; + hp : tdef; + hmodule : tmodule; + begin + result:=true; + hmodule:=find_module_from_symtable(def.genericdef.owner); + if hmodule=nil then + internalerror(201202041); + for i:=0 to def.symtable.DefList.Count-1 do + begin + hp:=tdef(def.symtable.DefList[i]); + if hp.typ=procdef then + begin + { only generate the code if we need a body } + if assigned(tprocdef(hp).struct) and not tprocdef(hp).forwarddef then + continue; + { and the body is available already (which is implicitely the + case if the generic routine is part of another unit) } + if (hmodule=current_module) and tprocdef(tprocdef(hp).genericdef).forwarddef then + begin + result:=false; + continue; + end; + process_procdef(tprocdef(hp),hmodule); + end + else + if hp.typ in [objectdef,recorddef] then + { generate code for subtypes as well } + result:=process_abstractrecorddef(tabstractrecorddef(hp)) and result; + end; + end; + + + procedure generate_specialization_procs; + var + i : longint; + list, + readdlist : tfpobjectlist; + def : tstoreddef; + state : tspecializationstate; + hmodule : tmodule; + begin + { first copy all entries and then work with that list to ensure that + we don't get an infinite recursion } + list:=tfpobjectlist.create(false); + readdlist:=tfpobjectlist.create(false); + + for i:=0 to current_module.pendingspecializations.Count-1 do + list.add(current_module.pendingspecializations.Items[i]); + + current_module.pendingspecializations.clear; + + for i:=0 to list.count-1 do + begin + def:=tstoreddef(list[i]); + if not tstoreddef(def).is_specialization then + continue; + case def.typ of + procdef: + begin + { the use of forwarddef should not backfire as the + specialization always belongs to the current module } + if not tprocdef(def).forwarddef then + continue; + if not assigned(def.genericdef) then + internalerror(2015061903); + hmodule:=find_module_from_symtable(def.genericdef.owner); + if hmodule=nil then + internalerror(2015061904); + { we need to check for a forward declaration only if the + generic was declared in the same unit (otherwise there + should be one) } + if (hmodule=current_module) and tprocdef(def.genericdef).forwarddef then + begin + readdlist.add(def); + continue; + end; + + specialization_init(tstoreddef(def).genericdef,state); + + process_procdef(tprocdef(def),hmodule); + + specialization_done(state); + end; + recorddef, + objectdef: + begin + specialization_init(tstoreddef(def).genericdef,state); + + if not process_abstractrecorddef(tabstractrecorddef(def)) then + readdlist.add(def); + + specialization_done(state); + end; + end; + end; + + { add those defs back to the pending list for which we don't yet have + all method bodies } + for i:=0 to readdlist.count-1 do + current_module.pendingspecializations.add(tstoreddef(readdlist[i]).typename,readdlist[i]); + + readdlist.free; + list.free; + end; + + + procedure maybe_add_pending_specialization(def:tdef); + var + hmodule : tmodule; + st : tsymtable; + begin + st:=def.owner; + while st.symtabletype in [localsymtable] do + st:=st.defowner.owner; + hmodule:=find_module_from_symtable(st); + if tstoreddef(def).is_specialization and (hmodule=current_module) then + current_module.pendingspecializations.add(def.typename,def); + end; + end. diff --git a/compiler/pkgutil.pas b/compiler/pkgutil.pas index d0536ae900..f8ad90db78 100644 --- a/compiler/pkgutil.pas +++ b/compiler/pkgutil.pas @@ -639,8 +639,7 @@ implementation module:=tmodule(loaded_units.first); while assigned(module) do begin - //if not assigned(module.package) then - if (uf_in_library and module.flags)=0 then + if not assigned(module.package) then processimportedsyms(module.unitimportsyms); module:=tmodule(module.next); end; diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index c0f18cf9d5..e6b7f69fa5 100644 --- a/compiler/pmodules.pas +++ b/compiler/pmodules.pas @@ -47,7 +47,7 @@ implementation objcgutl, pkgutil, wpobase, - scanner,pbase,pexpr,psystem,psub,pdecsub,ncgvmt,ncgrtti, + scanner,pbase,pexpr,psystem,psub,pdecsub,pgenutil,ncgvmt,ncgrtti, cpuinfo; diff --git a/compiler/ppu.pas b/compiler/ppu.pas index 91a04b35d2..c3c3e04ad9 100644 --- a/compiler/ppu.pas +++ b/compiler/ppu.pas @@ -43,7 +43,7 @@ type {$endif Test_Double_checksum} const - CurrentPPUVersion = 182; + CurrentPPUVersion = 183; ppubufsize = 16384; diff --git a/compiler/psub.pas b/compiler/psub.pas index 0d55369f67..2c0de413c8 100644 --- a/compiler/psub.pas +++ b/compiler/psub.pas @@ -85,9 +85,10 @@ interface true) } procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef;isgeneric:boolean); - procedure import_external_proc(pd:tprocdef); + { parses only the body of a non nested routine; needs a correctly setup pd } + procedure read_proc_body(pd:tprocdef);inline; - procedure generate_specialization_procs; + procedure import_external_proc(pd:tprocdef); implementation @@ -756,6 +757,7 @@ implementation begin include(tocode.flags,nf_block_with_exit); addstatement(newstatement,final_asmnode); + cnodeutils.procdef_block_add_implicit_finalize_nodes(procdef,newstatement); final_used:=true; end; @@ -875,6 +877,7 @@ implementation addstatement(newstatement,loadpara_asmnode); addstatement(newstatement,stackcheck_asmnode); addstatement(newstatement,entry_asmnode); + cnodeutils.procdef_block_add_implicit_initialize_nodes(procdef,newstatement); addstatement(newstatement,init_asmnode); addstatement(newstatement,bodyentrycode); @@ -896,6 +899,7 @@ implementation { Generate code that will be in the try...finally } finalcode:=internalstatements(codestatement); addstatement(codestatement,final_asmnode); + cnodeutils.procdef_block_add_implicit_finalize_nodes(procdef,codestatement); final_used:=true; current_filepos:=entrypos; @@ -929,9 +933,12 @@ implementation if not is_constructor then begin addstatement(newstatement,final_asmnode); + cnodeutils.procdef_block_add_implicit_finalize_nodes(procdef,newstatement); final_used:=true; end; end; + if not final_used then + cnodeutils.procdef_block_add_implicit_finalize_nodes(procdef,newstatement); do_firstpass(newblock); code:=newblock; current_filepos:=oldfilepos; @@ -2021,7 +2028,12 @@ implementation if not isnestedproc then begin if not(df_generic in current_procinfo.procdef.defoptions) then - tcgprocinfo(current_procinfo).generate_code_tree; + begin + { also generate the bodies for all previously done + specializations so that we might inline them } + generate_specialization_procs; + tcgprocinfo(current_procinfo).generate_code_tree; + end; end; { reset _FAIL as _SELF normal } @@ -2045,6 +2057,21 @@ implementation end; + procedure read_proc_body(pd:tprocdef); + var + old_module_procinfo : tobject; + old_current_procinfo : tprocinfo; + begin + old_current_procinfo:=current_procinfo; + old_module_procinfo:=current_module.procinfo; + current_procinfo:=nil; + current_module.procinfo:=nil; + read_proc_body(nil,pd); + current_procinfo:=old_current_procinfo; + current_module.procinfo:=old_module_procinfo; + end; + + procedure read_proc(isclassmethod:boolean; usefwpd: tprocdef;isgeneric:boolean); { Parses the procedure directives, then parses the procedure body, then @@ -2492,131 +2519,4 @@ implementation end; -{**************************************************************************** - SPECIALIZATION BODY GENERATION -****************************************************************************} - - - procedure specialize_objectdefs(p:TObject;arg:pointer); - var - specobj : tabstractrecorddef; - state : tspecializationstate; - - procedure process_procdef(def:tprocdef;hmodule:tmodule); - var - oldcurrent_filepos : tfileposinfo; - begin - if assigned(def.genericdef) and - (def.genericdef.typ=procdef) and - assigned(tprocdef(def.genericdef).generictokenbuf) then - begin - if not assigned(tprocdef(def.genericdef).generictokenbuf) then - internalerror(2015061902); - oldcurrent_filepos:=current_filepos; - current_filepos:=tprocdef(def.genericdef).fileinfo; - { use the index the module got from the current compilation process } - current_filepos.moduleindex:=hmodule.unit_index; - current_tokenpos:=current_filepos; - current_scanner.startreplaytokens(tprocdef(def.genericdef).generictokenbuf); - read_proc_body(nil,def); - current_filepos:=oldcurrent_filepos; - end - { synthetic routines will be implemented afterwards } - else if def.synthetickind=tsk_none then - MessagePos1(def.fileinfo,sym_e_forward_not_resolved,def.fullprocname(false)); - end; - - procedure process_abstractrecorddef(def:tabstractrecorddef); - var - i : longint; - hp : tdef; - hmodule : tmodule; - begin - hmodule:=find_module_from_symtable(def.genericdef.owner); - if hmodule=nil then - internalerror(201202041); - for i:=0 to def.symtable.DefList.Count-1 do - begin - hp:=tdef(def.symtable.DefList[i]); - if hp.typ=procdef then - begin - { only generate the code if we need a body } - if assigned(tprocdef(hp).struct) and not tprocdef(hp).forwarddef then - continue; - process_procdef(tprocdef(hp),hmodule); - end - else - if hp.typ in [objectdef,recorddef] then - { generate code for subtypes as well } - process_abstractrecorddef(tabstractrecorddef(hp)); - end; - end; - - procedure process_procsym(procsym:tprocsym); - var - i : longint; - pd : tprocdef; - state : tspecializationstate; - hmodule : tmodule; - begin - for i:=0 to procsym.procdeflist.count-1 do - begin - pd:=tprocdef(procsym.procdeflist[i]); - if not pd.is_specialization then - continue; - if not pd.forwarddef then - continue; - if not assigned(pd.genericdef) then - internalerror(2015061903); - hmodule:=find_module_from_symtable(pd.genericdef.owner); - if hmodule=nil then - internalerror(2015061904); - - specialization_init(pd.genericdef,state); - - process_procdef(pd,hmodule); - - specialization_done(state); - end; - end; - - begin - if not((tsym(p).typ=typesym) and - (ttypesym(p).typedef.typesym=tsym(p)) and - (ttypesym(p).typedef.typ in [objectdef,recorddef]) - ) and - not (tsym(p).typ=procsym) then - exit; - - if tsym(p).typ=procsym then - process_procsym(tprocsym(p)) - else - if df_specialization in ttypesym(p).typedef.defoptions then - begin - { Setup symtablestack a definition time } - specobj:=tabstractrecorddef(ttypesym(p).typedef); - - if not (is_class_or_object(specobj) or is_record(specobj) or is_javaclass(specobj)) then - exit; - - specialization_init(specobj.genericdef,state); - - { procedure definitions for classes or objects } - process_abstractrecorddef(specobj); - - specialization_done(state); - end - else - tabstractrecorddef(ttypesym(p).typedef).symtable.symlist.whileeachcall(@specialize_objectdefs,nil); - end; - - - procedure generate_specialization_procs; - begin - if assigned(current_module.globalsymtable) then - current_module.globalsymtable.SymList.WhileEachCall(@specialize_objectdefs,nil); - if assigned(current_module.localsymtable) then - current_module.localsymtable.SymList.WhileEachCall(@specialize_objectdefs,nil); - end; - end. diff --git a/compiler/psystem.pas b/compiler/psystem.pas index 9901c1d42b..d7bd1d54a9 100644 --- a/compiler/psystem.pas +++ b/compiler/psystem.pas @@ -243,6 +243,9 @@ implementation bool16type:=corddef.create(bool16bit,low(int64),high(int64),true); bool32type:=corddef.create(bool32bit,low(int64),high(int64),true); bool64type:=corddef.create(bool64bit,low(int64),high(int64),true); +{$ifdef llvm} + llvmbool1type:=corddef.create(pasbool8,0,1,true); +{$endif llvm} cansichartype:=corddef.create(uchar,0,255,true); cwidechartype:=corddef.create(uwidechar,0,65535,true); cshortstringtype:=cstringdef.createshort(255,true); @@ -413,6 +416,9 @@ implementation addtype('WordBool',bool16type); addtype('LongBool',bool32type); addtype('QWordBool',bool64type); +{$ifdef llvm} + addtype('LLVMBool1',llvmbool1type); +{$endif llvm} addtype('Byte',u8inttype); addtype('ShortInt',s8inttype); addtype('Word',u16inttype); @@ -459,6 +465,9 @@ implementation addtype('$wordbool',bool16type); addtype('$longbool',bool32type); addtype('$qwordbool',bool64type); +{$ifdef llvm} + addtype('$llvmbool1',llvmbool1type); +{$endif llvm} addtype('$char_pointer',charpointertype); addtype('$widechar_pointer',widecharpointertype); addtype('$parentfp_void_pointer',parentfpvoidpointertype); @@ -621,6 +630,9 @@ implementation loadtype('longint_farpointer',longintfarpointertype); {$endif i8086} {$endif x86} +{$ifdef llvm} + loadtype('llvmbool1',llvmbool1type); +{$endif llvm} loadtype('file',cfiletype); if not(target_info.system in systems_managed_vm) then begin diff --git a/compiler/ptconst.pas b/compiler/ptconst.pas index 7bfbe73d68..cf83de56c1 100644 --- a/compiler/ptconst.pas +++ b/compiler/ptconst.pas @@ -135,13 +135,16 @@ implementation current_asmdata.asmlists[al_const].concatlist(datalist); { the (empty) lists themselves are freed by tcbuilder } - { add indirect symbol } - { ToDo: do we also need this for the else part? } - new_section(list,sec_rodata,lower(sym.mangledname),const_align(sym.vardef.alignment)); - symind:=current_asmdata.DefineAsmSymbol(sym.mangledname,AB_INDIRECT,AT_DATA); - list.concat(Tai_symbol.Create_Global(symind,0)); - list.concat(Tai_const.Createname(sym.mangledname,AT_DATA,0)); - list.concat(tai_symbol_end.Create(symind)); + if (tf_supports_packages in target_info.flags) then + begin + { add indirect symbol } + { ToDo: do we also need this for the else part? } + new_section(list,sec_rodata,lower(sym.mangledname),const_align(sym.vardef.alignment)); + symind:=current_asmdata.DefineAsmSymbol(sym.mangledname,AB_INDIRECT,AT_DATA); + list.concat(Tai_symbol.Create_Global(symind,0)); + list.concat(Tai_const.Createname(sym.mangledname,AT_DATA,0)); + list.concat(tai_symbol_end.Create(symind)); + end; end else begin diff --git a/compiler/scanner.pas b/compiler/scanner.pas index 0209efd453..f23db71695 100644 --- a/compiler/scanner.pas +++ b/compiler/scanner.pas @@ -177,6 +177,7 @@ interface procedure recordtoken; procedure startrecordtokens(buf:tdynamicarray); procedure stoprecordtokens; + function is_recording_tokens:boolean; procedure replaytoken; procedure startreplaytokens(buf:tdynamicarray); { bit length asizeint is target depend } @@ -2800,6 +2801,11 @@ type recordtokenbuf:=nil; end; + function tscannerfile.is_recording_tokens: boolean; + begin + result:=assigned(recordtokenbuf); + end; + procedure tscannerfile.writetoken(t : ttoken); var diff --git a/compiler/symdef.pas b/compiler/symdef.pas index a83b5da9a9..ab713a131a 100644 --- a/compiler/symdef.pas +++ b/compiler/symdef.pas @@ -1029,6 +1029,9 @@ interface bool16type, bool32type, bool64type, { implement me } +{$ifdef llvm} + llvmbool1type, { LLVM i1 type } +{$endif llvm} u8inttype, { 8-Bit unsigned integer } s8inttype, { 8-Bit signed integer } u16inttype, { 16-Bit unsigned integer } @@ -5750,7 +5753,7 @@ implementation assigned(returndef) and not(is_void(returndef)) then s:=s+':'+returndef.GetTypeName; - if owner.symtabletype=localsymtable then + if assigned(owner) and (owner.symtabletype=localsymtable) then s:=s+' is nested' else if po_is_block in procoptions then s:=s+' is block'; diff --git a/compiler/systems.inc b/compiler/systems.inc index fbe654f1f6..75ccd91bbc 100644 --- a/compiler/systems.inc +++ b/compiler/systems.inc @@ -222,6 +222,7 @@ ,as_llvm ,as_clang ,as_solaris_as + ,as_m68k_vasm ); tlink = (ld_none, diff --git a/compiler/systems.pas b/compiler/systems.pas index 72c811c2b5..7f7e59a402 100644 --- a/compiler/systems.pas +++ b/compiler/systems.pas @@ -137,6 +137,7 @@ interface tf_pic_default, { the os does some kind of stack checking and it can be converted into a rte 202 } tf_no_generic_stackcheck, + tf_emit_stklen, // Means that the compiler should emit a _stklen variable with the stack size, even if tf_no_generic_stackcheck is specified tf_has_winlike_resources, tf_safecall_clearstack, // With this flag set, after safecall calls the caller cleans up the stack tf_safecall_exceptions, // Exceptions in safecall calls are not raised, but passed to the caller as an ordinal (hresult) in the function result. diff --git a/compiler/systems/i_amiga.pas b/compiler/systems/i_amiga.pas index 9615e1840a..6d108e88a4 100644 --- a/compiler/systems/i_amiga.pas +++ b/compiler/systems/i_amiga.pas @@ -34,7 +34,7 @@ unit i_amiga; system : system_m68k_Amiga; name : 'Commodore Amiga'; shortname : 'amiga'; - flags : [tf_files_case_aware,tf_has_winlike_resources]; + flags : [tf_files_case_aware,tf_requires_proper_alignment,tf_has_winlike_resources]; cpu : cpu_m68k; unit_env : 'AMIGAUNITS'; extradefines : 'HASAMIGA;AMIGA68K'; @@ -97,7 +97,7 @@ unit i_amiga; system : system_powerpc_Amiga; name : 'AmigaOS for PowerPC'; shortname : 'amiga'; - flags : [tf_files_case_aware,tf_has_winlike_resources]; + flags : [tf_files_case_aware,tf_requires_proper_alignment,tf_has_winlike_resources]; cpu : cpu_powerpc; unit_env : 'AMIGAUNITS'; extradefines : 'PPC603;HASAMIGA;AMIGAOS4'; diff --git a/compiler/systems/i_morph.pas b/compiler/systems/i_morph.pas index 8c1a6dadda..c5b8553593 100644 --- a/compiler/systems/i_morph.pas +++ b/compiler/systems/i_morph.pas @@ -34,7 +34,7 @@ unit i_morph; system : system_powerpc_MorphOS; name : 'MorphOS'; shortname : 'MorphOS'; - flags : [tf_files_case_aware,tf_smartlink_library,tf_has_winlike_resources]; + flags : [tf_files_case_aware,tf_requires_proper_alignment,tf_smartlink_library,tf_has_winlike_resources]; cpu : cpu_powerpc; unit_env : 'MORPHOSUNITS'; extradefines : 'HASAMIGA'; diff --git a/compiler/systems/i_msdos.pas b/compiler/systems/i_msdos.pas index 13c86e1fa8..70e7ee145a 100644 --- a/compiler/systems/i_msdos.pas +++ b/compiler/systems/i_msdos.pas @@ -42,7 +42,8 @@ unit i_msdos; name : 'MS-DOS 16-bit real mode'; shortname : 'MSDOS'; flags : [tf_use_8_3,tf_smartlink_library, - tf_no_objectfiles_when_smartlinking,tf_cld]; + tf_no_objectfiles_when_smartlinking,tf_cld, + tf_no_generic_stackcheck,tf_emit_stklen]; cpu : cpu_i8086; unit_env : 'MSDOSUNITS'; extradefines : ''; diff --git a/compiler/systems/i_win16.pas b/compiler/systems/i_win16.pas index 7f6bccf48b..e5c6e50ffe 100644 --- a/compiler/systems/i_win16.pas +++ b/compiler/systems/i_win16.pas @@ -43,6 +43,7 @@ unit i_win16; shortname : 'Win16'; flags : [tf_use_8_3,tf_smartlink_library, tf_no_objectfiles_when_smartlinking,tf_cld, + tf_no_generic_stackcheck,tf_emit_stklen, tf_x86_far_procs_push_odd_bp]; cpu : cpu_i8086; unit_env : 'WIN16UNITS'; diff --git a/compiler/x86/cgx86.pas b/compiler/x86/cgx86.pas index b7f0457c49..40c436e09c 100644 --- a/compiler/x86/cgx86.pas +++ b/compiler/x86/cgx86.pas @@ -3067,7 +3067,14 @@ unit cgx86; if current_procinfo.framepointer=NR_STACK_POINTER_REG then current_asmdata.asmcfi.cfa_def_cfa_offset(list,localsize+sizeof(pint)); current_procinfo.final_localsize:=localsize; - end; + end +{$ifdef i8086} + else + { on i8086 we always call g_stackpointer_alloc, even with a zero size, + because it will generate code for stack checking, if stack checking is on } + g_stackpointer_alloc(list,0) +{$endif i8086} + ; {$ifdef i8086} { win16 exported proc prologue follow-up (see the huge comment above for details) } diff --git a/compiler/x86/nx86inl.pas b/compiler/x86/nx86inl.pas index 7f7c17a9ac..25b1055ecb 100644 --- a/compiler/x86/nx86inl.pas +++ b/compiler/x86/nx86inl.pas @@ -330,7 +330,7 @@ implementation begin secondpass(left); if left.location.loc<>LOC_MMREGISTER then - hlcg.location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,left.resultdef,false); + hlcg.location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,left.resultdef,UseAVX); if UseAVX then begin location_reset(location,LOC_MMREGISTER,def_cgsize(resultdef)); @@ -377,24 +377,24 @@ implementation if use_vectorfpu(left.resultdef) then begin secondpass(left); - hlcg.location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,left.resultdef,false); + hlcg.location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,left.resultdef,true); location_reset(location,LOC_REGISTER,OS_S64); location.register:=cg.getintregister(current_asmdata.CurrAsmList,OS_S64); if UseAVX then case left.location.size of OS_F32: - current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_VCVTSS2SI,S_Q,left.location.register,location.register)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_VCVTSS2SI,S_NO,left.location.register,location.register)); OS_F64: - current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_VCVTSD2SI,S_Q,left.location.register,location.register)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_VCVTSD2SI,S_NO,left.location.register,location.register)); else internalerror(2007031402); end else case left.location.size of OS_F32: - current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CVTSS2SI,S_Q,left.location.register,location.register)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CVTSS2SI,S_NO,left.location.register,location.register)); OS_F64: - current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CVTSD2SI,S_Q,left.location.register,location.register)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CVTSD2SI,S_NO,left.location.register,location.register)); else internalerror(2007031402); end; @@ -421,24 +421,24 @@ implementation not((left.location.loc=LOC_FPUREGISTER) and (current_settings.fputype>=fpu_sse3)) then begin secondpass(left); - hlcg.location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,left.resultdef,false); + hlcg.location_force_mmregscalar(current_asmdata.CurrAsmList,left.location,left.resultdef,true); location_reset(location,LOC_REGISTER,OS_S64); location.register:=cg.getintregister(current_asmdata.CurrAsmList,OS_S64); if UseAVX then case left.location.size of OS_F32: - current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_VCVTTSS2SI,S_Q,left.location.register,location.register)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_VCVTTSS2SI,S_NO,left.location.register,location.register)); OS_F64: - current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_VCVTTSD2SI,S_Q,left.location.register,location.register)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_VCVTTSD2SI,S_NO,left.location.register,location.register)); else internalerror(2007031401); end else case left.location.size of OS_F32: - current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CVTTSS2SI,S_Q,left.location.register,location.register)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CVTTSS2SI,S_NO,left.location.register,location.register)); OS_F64: - current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CVTTSD2SI,S_Q,left.location.register,location.register)); + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CVTTSD2SI,S_NO,left.location.register,location.register)); else internalerror(2007031401); end; diff --git a/compiler/x86/nx86set.pas b/compiler/x86/nx86set.pas index e35a753439..dd98fb54fb 100644 --- a/compiler/x86/nx86set.pas +++ b/compiler/x86/nx86set.pas @@ -112,6 +112,8 @@ implementation { case expr greater than max_ => goto elselabel } cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,opcgsize,OC_A,aint(max_)-aint(min_),hregister,elselabel); min_:=0; + { do not sign extend when we load the index register, as we applied an offset above } + opcgsize:=tcgsize2unsigned[opcgsize]; end; current_asmdata.getglobaldatalabel(table); { make it a 32bit register } diff --git a/compiler/x86_64/nx64set.pas b/compiler/x86_64/nx64set.pas index 73f1ef5c6f..d24d5a29e7 100644 --- a/compiler/x86_64/nx64set.pas +++ b/compiler/x86_64/nx64set.pas @@ -112,7 +112,10 @@ implementation { case expr greater than max_ => goto elselabel } cg.a_cmp_const_reg_label(current_asmdata.CurrAsmList,opcgsize,OC_A,aint(max_)-aint(min_),hregister,elselabel); min_:=0; + { do not sign extend when we load the index register, as we applied an offset above } + opcgsize:=tcgsize2unsigned[opcgsize]; end; + { local label in order to avoid using GOT } current_asmdata.getlabel(tablelabel,alt_data); indexreg:=cg.makeregsize(current_asmdata.CurrAsmList,hregister,OS_ADDR); |