diff --git a/.gitattributes b/.gitattributes index 7af5900b62..21354a52f4 100644 --- a/.gitattributes +++ b/.gitattributes @@ -680,6 +680,7 @@ compiler/riscv/nrvcnv.pas svneol=native#text/plain compiler/riscv/nrvcon.pas svneol=native#text/plain compiler/riscv/nrvinl.pas svneol=native#text/plain compiler/riscv/nrvset.pas svneol=native#text/plain +compiler/riscv/rarvgas.pas svneol=native#text/plain compiler/riscv/rgcpu.pas svneol=native#text/plain compiler/riscv32/aoptcpu.pas svneol=native#text/plain compiler/riscv32/aoptcpub.pas svneol=native#text/plain @@ -9802,10 +9803,9 @@ rtl/linux/riscv32/syscall.inc svneol=native#text/plain rtl/linux/riscv32/syscallh.inc svneol=native#text/plain rtl/linux/riscv32/sysnr.inc svneol=native#text/plain rtl/linux/riscv64/bsyscall.inc svneol=native#text/plain -rtl/linux/riscv64/cprt0.as svneol=native#text/plain -rtl/linux/riscv64/dllprt0.as svneol=native#text/plain -rtl/linux/riscv64/gprt0.as svneol=native#text/plain -rtl/linux/riscv64/prt0.as svneol=native#text/plain +rtl/linux/riscv64/si_c.inc svneol=native#text/plain +rtl/linux/riscv64/si_dll.inc svneol=native#text/plain +rtl/linux/riscv64/si_prc.inc svneol=native#text/plain rtl/linux/riscv64/sighnd.inc svneol=native#text/plain rtl/linux/riscv64/sighndh.inc svneol=native#text/plain rtl/linux/riscv64/stat.inc svneol=native#text/plain @@ -10285,6 +10285,7 @@ rtl/openbsd/sysctlh.inc svneol=native#text/plain rtl/openbsd/sysnr.inc svneol=native#text/plain rtl/openbsd/sysofft.inc svneol=native#text/plain rtl/openbsd/systypes.inc svneol=native#text/plain +rtl/openbsd/t_openbsd.h2paschk svneol=native#text/plain rtl/openbsd/termio.pp svneol=native#text/plain rtl/openbsd/termios.inc svneol=native#text/plain rtl/openbsd/termiosproc.inc svneol=native#text/plain @@ -11169,6 +11170,9 @@ tests/tbf/tb0265.pp svneol=native#text/pascal tests/tbf/tb0266a.pp svneol=native#text/pascal tests/tbf/tb0266b.pp svneol=native#text/pascal tests/tbf/tb0267.pp svneol=native#text/plain +tests/tbf/tb0268.pp svneol=native#text/pascal +tests/tbf/tb0269.pp svneol=native#text/pascal +tests/tbf/tb0270.pp svneol=native#text/pascal tests/tbf/tb0588.pp svneol=native#text/pascal tests/tbf/ub0115.pp svneol=native#text/plain tests/tbf/ub0149.pp svneol=native#text/plain @@ -14848,6 +14852,7 @@ tests/webtbf/tw3488.pp svneol=native#text/plain tests/webtbf/tw3495.pp svneol=native#text/plain tests/webtbf/tw3502.pp svneol=native#text/plain tests/webtbf/tw35149a.pp svneol=native#text/plain +tests/webtbf/tw35348.pp svneol=native#text/pascal tests/webtbf/tw3553.pp svneol=native#text/plain tests/webtbf/tw3562.pp svneol=native#text/plain tests/webtbf/tw3583.pp svneol=native#text/plain diff --git a/compiler/aasmtai.pas b/compiler/aasmtai.pas index 65f2d67019..0083895a78 100644 --- a/compiler/aasmtai.pas +++ b/compiler/aasmtai.pas @@ -373,7 +373,9 @@ interface all assemblers. } asd_cpu, { for the OMF object format } - asd_omf_linnum_line + asd_omf_linnum_line, + { RISC-V } + asd_option ); TAsmSehDirective=( @@ -413,7 +415,9 @@ interface 'code', 'cpu', { for the OMF object format } - 'omf_line' + 'omf_line', + { RISC-V } + 'option' ); sehdirectivestr : array[TAsmSehDirective] of string[16]=( '.seh_proc','.seh_endproc', diff --git a/compiler/arm/aoptcpu.pas b/compiler/arm/aoptcpu.pas index 4a1dcad8f3..65891e4730 100644 --- a/compiler/arm/aoptcpu.pas +++ b/compiler/arm/aoptcpu.pas @@ -1968,6 +1968,7 @@ Implementation strb reg1,[...] } if MatchInstruction(p, taicpu(p).opcode, [C_None], [PF_None]) and + (taicpu(p).ops=2) and GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and MatchInstruction(hp1, A_STR, [C_None], [PF_B]) and assigned(FindRegDealloc(taicpu(p).oper[0]^.reg,tai(hp1.Next))) and @@ -1993,6 +1994,7 @@ Implementation uxtb reg3,reg1 } else if MatchInstruction(p, A_UXTB, [C_None], [PF_None]) and + (taicpu(p).ops=2) and GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and MatchInstruction(hp1, A_UXTH, [C_None], [PF_None]) and (taicpu(hp1).ops = 2) and @@ -2016,6 +2018,7 @@ Implementation uxtb reg3,reg1 } else if MatchInstruction(p, A_UXTB, [C_None], [PF_None]) and + (taicpu(p).ops=2) and GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and MatchInstruction(hp1, A_UXTB, [C_None], [PF_None]) and (taicpu(hp1).ops = 2) and @@ -2039,8 +2042,8 @@ Implementation uxtb reg3,reg1 } else if MatchInstruction(p, A_UXTB, [C_None], [PF_None]) and - GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and (taicpu(p).ops=2) and + GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and MatchInstruction(hp1, A_AND, [C_None], [PF_None]) and (taicpu(hp1).ops=3) and (taicpu(hp1).oper[2]^.typ=top_const) and @@ -2075,6 +2078,7 @@ Implementation strh reg1,[...] } if MatchInstruction(p, taicpu(p).opcode, [C_None], [PF_None]) and + (taicpu(p).ops=2) and GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and MatchInstruction(hp1, A_STR, [C_None], [PF_H]) and RegEndofLife(taicpu(p).oper[0]^.reg,taicpu(hp1)) and @@ -2100,6 +2104,7 @@ Implementation uxth reg3,reg1 } else if MatchInstruction(p, A_UXTH, [C_None], [PF_None]) and + (taicpu(p).ops=2) and GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and MatchInstruction(hp1, A_UXTH, [C_None], [PF_None]) and (taicpu(hp1).ops=2) and @@ -2126,6 +2131,7 @@ Implementation uxth reg3,reg1 } else if MatchInstruction(p, A_UXTH, [C_None], [PF_None]) and + (taicpu(p).ops=2) and GetNextInstructionUsingReg(p,hp1,taicpu(p).oper[0]^.reg) and MatchInstruction(hp1, A_AND, [C_None], [PF_None]) and (taicpu(hp1).ops=3) and diff --git a/compiler/assemble.pas b/compiler/assemble.pas index 2ad66ab2cf..0c5da7c9da 100644 --- a/compiler/assemble.pas +++ b/compiler/assemble.pas @@ -1647,6 +1647,10 @@ Implementation { ai_directive(hp).name can be only 16 or 32, this is checked by the reader } ObjData.ThumbFunc:=tai_directive(hp).name='16'; {$endif ARM} +{$ifdef RISCV} + asd_option: + internalerror(2019031701); +{$endif RISCV} else internalerror(2010011101); end; @@ -1800,6 +1804,9 @@ Implementation asd_code: { ignore for now, but should be added} ; + asd_option: + { ignore for now, but should be added} + ; {$ifdef OMFOBJSUPPORT} asd_omf_linnum_line: { ignore for now, but should be added} diff --git a/compiler/fpcdefs.inc b/compiler/fpcdefs.inc index ee556b90ec..a82df00c1d 100644 --- a/compiler/fpcdefs.inc +++ b/compiler/fpcdefs.inc @@ -275,6 +275,7 @@ {$endif aarch64} {$ifdef riscv32} + {$define riscv} {$define cpu32bit} {$define cpu32bitaddr} {$define cpu32bitalu} @@ -287,6 +288,7 @@ {$endif riscv32} {$ifdef riscv64} + {$define riscv} {$define cpu64bit} {$define cpu64bitaddr} {$define cpu64bitalu} diff --git a/compiler/hlcgobj.pas b/compiler/hlcgobj.pas index 427a9a1d35..1e32f270f0 100644 --- a/compiler/hlcgobj.pas +++ b/compiler/hlcgobj.pas @@ -4475,24 +4475,23 @@ implementation procedure thlcgobj.gen_proc_symbol(list: TAsmList); var - item, - previtem : TCmdStrListItem; + firstitem, + item: TCmdStrListItem; begin - previtem:=nil; - item := TCmdStrListItem(current_procinfo.procdef.aliasnames.first); + item:=TCmdStrListItem(current_procinfo.procdef.aliasnames.first); + firstitem:=item; while assigned(item) do begin {$ifdef arm} if GenerateThumbCode or GenerateThumb2Code then list.concat(tai_directive.create(asd_thumb_func,'')); {$endif arm} - { "double link" all procedure entry symbols via .reference } - { directives on darwin, because otherwise the linker } - { sometimes strips the procedure if only on of the symbols } - { is referenced } - if assigned(previtem) and + { alias procedure entry symbols via ".set" on Darwin, otherwise + they can be interpreted as all different starting symbols of + subsections and be reordered } + if (item<>firstitem) and (target_info.system in systems_darwin) then - list.concat(tai_directive.create(asd_reference,item.str)); + list.concat(tai_symbolpair.create(spk_set,item.str,firstitem.str)); if (cs_profile in current_settings.moduleswitches) or { smart linking using a library requires to promote all non-nested procedures to AB_GLOBAL @@ -4503,13 +4502,9 @@ implementation list.concat(Tai_symbol.createname_global(item.str,AT_FUNCTION,0,current_procinfo.procdef)) else list.concat(Tai_symbol.createname(item.str,AT_FUNCTION,0,current_procinfo.procdef)); - if assigned(previtem) and - (target_info.system in systems_darwin) then - list.concat(tai_directive.create(asd_reference,previtem.str)); if not(af_stabs_use_function_absolute_addresses in target_asm.flags) then list.concat(Tai_function_name.create(item.str)); - previtem:=item; - item := TCmdStrListItem(item.next); + item:=TCmdStrListItem(item.next); end; current_procinfo.procdef.procstarttai:=tai(list.last); end; diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas index 0a7e9d0d0a..b3f8c71bbe 100644 --- a/compiler/htypechk.pas +++ b/compiler/htypechk.pas @@ -37,6 +37,8 @@ interface nod : tnodetype; inr : tinlinenumber; op_overloading_supported : boolean; + minargs : longint; + maxargs : longint; end; Ttok2opRec=record @@ -111,33 +113,33 @@ interface const tok2nodes=27; tok2node:array[1..tok2nodes] of ttok2noderec=( - (tok:_PLUS ;nod:addn;inr:in_none;op_overloading_supported:true), { binary overloading supported } - (tok:_MINUS ;nod:subn;inr:in_none;op_overloading_supported:true), { binary and unary overloading supported } - (tok:_STAR ;nod:muln;inr:in_none;op_overloading_supported:true), { binary overloading supported } - (tok:_SLASH ;nod:slashn;inr:in_none;op_overloading_supported:true), { binary overloading supported } - (tok:_EQ ;nod:equaln;inr:in_none;op_overloading_supported:true), { binary overloading supported } - (tok:_GT ;nod:gtn;inr:in_none;op_overloading_supported:true), { binary overloading supported } - (tok:_LT ;nod:ltn;inr:in_none;op_overloading_supported:true), { binary overloading supported } - (tok:_GTE ;nod:gten;inr:in_none;op_overloading_supported:true), { binary overloading supported } - (tok:_LTE ;nod:lten;inr:in_none;op_overloading_supported:true), { binary overloading supported } - (tok:_SYMDIF ;nod:symdifn;inr:in_none;op_overloading_supported:true), { binary overloading supported } - (tok:_STARSTAR ;nod:starstarn;inr:in_none;op_overloading_supported:true), { binary overloading supported } - (tok:_OP_AS ;nod:asn;inr:in_none;op_overloading_supported:false), { binary overloading NOT supported } - (tok:_OP_IN ;nod:inn;inr:in_none;op_overloading_supported:true), { binary overloading supported } - (tok:_OP_IS ;nod:isn;inr:in_none;op_overloading_supported:false), { binary overloading NOT supported } - (tok:_OP_OR ;nod:orn;inr:in_none;op_overloading_supported:true), { binary overloading supported } - (tok:_OP_AND ;nod:andn;inr:in_none;op_overloading_supported:true), { binary overloading supported } - (tok:_OP_DIV ;nod:divn;inr:in_none;op_overloading_supported:true), { binary overloading supported } - (tok:_OP_NOT ;nod:notn;inr:in_none;op_overloading_supported:true), { unary overloading supported } - (tok:_OP_MOD ;nod:modn;inr:in_none;op_overloading_supported:true), { binary overloading supported } - (tok:_OP_SHL ;nod:shln;inr:in_none;op_overloading_supported:true), { binary overloading supported } - (tok:_OP_SHR ;nod:shrn;inr:in_none;op_overloading_supported:true), { binary overloading supported } - (tok:_OP_XOR ;nod:xorn;inr:in_none;op_overloading_supported:true), { binary overloading supported } - (tok:_ASSIGNMENT ;nod:assignn;inr:in_none;op_overloading_supported:true), { unary overloading supported } - (tok:_OP_EXPLICIT;nod:assignn;inr:in_none;op_overloading_supported:true), { unary overloading supported } - (tok:_NE ;nod:unequaln;inr:in_none;op_overloading_supported:true), { binary overloading supported } - (tok:_OP_INC ;nod:inlinen;inr:in_inc_x;op_overloading_supported:true), { unary overloading supported } - (tok:_OP_DEC ;nod:inlinen;inr:in_dec_x;op_overloading_supported:true) { unary overloading supported } + (tok:_PLUS ;nod:addn;inr:in_none;op_overloading_supported:true;minargs:1;maxargs:2), { binary overloading supported } + (tok:_MINUS ;nod:subn;inr:in_none;op_overloading_supported:true;minargs:1;maxargs:2), { binary and unary overloading supported } + (tok:_STAR ;nod:muln;inr:in_none;op_overloading_supported:true;minargs:2;maxargs:2), { binary overloading supported } + (tok:_SLASH ;nod:slashn;inr:in_none;op_overloading_supported:true;minargs:2;maxargs:2), { binary overloading supported } + (tok:_EQ ;nod:equaln;inr:in_none;op_overloading_supported:true;minargs:2;maxargs:2), { binary overloading supported } + (tok:_GT ;nod:gtn;inr:in_none;op_overloading_supported:true;minargs:2;maxargs:2), { binary overloading supported } + (tok:_LT ;nod:ltn;inr:in_none;op_overloading_supported:true;minargs:2;maxargs:2), { binary overloading supported } + (tok:_GTE ;nod:gten;inr:in_none;op_overloading_supported:true;minargs:2;maxargs:2), { binary overloading supported } + (tok:_LTE ;nod:lten;inr:in_none;op_overloading_supported:true;minargs:2;maxargs:2), { binary overloading supported } + (tok:_SYMDIF ;nod:symdifn;inr:in_none;op_overloading_supported:true;minargs:2;maxargs:2), { binary overloading supported } + (tok:_STARSTAR ;nod:starstarn;inr:in_none;op_overloading_supported:true;minargs:2;maxargs:2), { binary overloading supported } + (tok:_OP_AS ;nod:asn;inr:in_none;op_overloading_supported:false;minargs:0;maxargs:0), { binary overloading NOT supported } + (tok:_OP_IN ;nod:inn;inr:in_none;op_overloading_supported:true;minargs:2;maxargs:2), { binary overloading supported } + (tok:_OP_IS ;nod:isn;inr:in_none;op_overloading_supported:false;minargs:0;maxargs:0), { binary overloading NOT supported } + (tok:_OP_OR ;nod:orn;inr:in_none;op_overloading_supported:true;minargs:2;maxargs:2), { binary overloading supported } + (tok:_OP_AND ;nod:andn;inr:in_none;op_overloading_supported:true;minargs:2;maxargs:2), { binary overloading supported } + (tok:_OP_DIV ;nod:divn;inr:in_none;op_overloading_supported:true;minargs:2;maxargs:2), { binary overloading supported } + (tok:_OP_NOT ;nod:notn;inr:in_none;op_overloading_supported:true;minargs:1;maxargs:1), { unary overloading supported } + (tok:_OP_MOD ;nod:modn;inr:in_none;op_overloading_supported:true;minargs:2;maxargs:2), { binary overloading supported } + (tok:_OP_SHL ;nod:shln;inr:in_none;op_overloading_supported:true;minargs:2;maxargs:2), { binary overloading supported } + (tok:_OP_SHR ;nod:shrn;inr:in_none;op_overloading_supported:true;minargs:2;maxargs:2), { binary overloading supported } + (tok:_OP_XOR ;nod:xorn;inr:in_none;op_overloading_supported:true;minargs:2;maxargs:2), { binary overloading supported } + (tok:_ASSIGNMENT ;nod:assignn;inr:in_none;op_overloading_supported:true;minargs:1;maxargs:1), { unary overloading supported } + (tok:_OP_EXPLICIT;nod:assignn;inr:in_none;op_overloading_supported:true;minargs:1;maxargs:1), { unary overloading supported } + (tok:_NE ;nod:unequaln;inr:in_none;op_overloading_supported:true;minargs:2;maxargs:2), { binary overloading supported } + (tok:_OP_INC ;nod:inlinen;inr:in_inc_x;op_overloading_supported:true;minargs:1;maxargs:1), { unary overloading supported } + (tok:_OP_DEC ;nod:inlinen;inr:in_dec_x;op_overloading_supported:true;minargs:1;maxargs:1) { unary overloading supported } ); tok2ops=4; @@ -625,7 +627,11 @@ implementation while count > 0 do begin parasym:=tparavarsym(pf.parast.SymList[count-1]); - if is_boolean(parasym.vardef) then + if parasym.typ<>paravarsym then + begin + dec(count); + end + else if is_boolean(parasym.vardef) then begin if parasym.name='RANGECHECK' then begin @@ -697,6 +703,8 @@ implementation begin result:= tok2node[i].op_overloading_supported and + (tok2node[i].minargs<=1) and + (tok2node[i].maxargs>=1) and isunaryoperatoroverloadable(tok2node[i].nod,tok2node[i].inr,ld); break; end; @@ -713,6 +721,8 @@ implementation rd:=tparavarsym(pf.parast.SymList[1]).vardef; result:= tok2node[i].op_overloading_supported and + (tok2node[i].minargs<=2) and + (tok2node[i].maxargs>=2) and isbinaryoperatoroverloadable(tok2node[i].nod,ld,nothingn,rd,nothingn); break; end; diff --git a/compiler/jvm/pjvm.pas b/compiler/jvm/pjvm.pas index f9dc2a712a..2eba3fcb4d 100644 --- a/compiler/jvm/pjvm.pas +++ b/compiler/jvm/pjvm.pas @@ -322,7 +322,6 @@ implementation vmtbuilder:=TVMTBuilder.Create(enumclass); vmtbuilder.generate_vmt; vmtbuilder.free; - insert_struct_hidden_paras(enumclass); restore_after_new_class(sstate,islocal,oldsymtablestack); current_structdef:=old_current_structdef; @@ -433,7 +432,6 @@ implementation vmtbuilder:=TVMTBuilder.Create(pvclass); vmtbuilder.generate_vmt; vmtbuilder.free; - insert_struct_hidden_paras(pvclass); restore_after_new_class(sstate,islocal,oldsymtablestack); end; diff --git a/compiler/nobj.pas b/compiler/nobj.pas index 5bba262cde..2a898b2838 100644 --- a/compiler/nobj.pas +++ b/compiler/nobj.pas @@ -60,7 +60,8 @@ implementation globals,verbose,systems, node, symbase,symtable,symconst,symtype,symcpu, - defcmp; + defcmp, + pparautl; {***************************************************************************** @@ -922,6 +923,7 @@ implementation add_new_vmt_entry(tprocdef(def),overridesclasshelper); end; end; + insert_struct_hidden_paras(_class); build_interface_mappings; if assigned(_class.ImplementedInterfaces) and not(is_objc_class_or_protocol(_class)) and diff --git a/compiler/pdecl.pas b/compiler/pdecl.pas index 4def01ba87..fcb19c2c3d 100644 --- a/compiler/pdecl.pas +++ b/compiler/pdecl.pas @@ -888,7 +888,6 @@ implementation vmtbuilder:=TVMTBuilder.Create(tobjectdef(hdef)); vmtbuilder.generate_vmt; vmtbuilder.free; - insert_struct_hidden_paras(tobjectdef(hdef)); end; { In case of an objcclass, verify that all methods have a message diff --git a/compiler/pgenutil.pas b/compiler/pgenutil.pas index e62f005452..4e52761d73 100644 --- a/compiler/pgenutil.pas +++ b/compiler/pgenutil.pas @@ -1059,7 +1059,6 @@ uses vmtbuilder:=TVMTBuilder.Create(tobjectdef(result)); vmtbuilder.generate_vmt; vmtbuilder.free; - insert_struct_hidden_paras(tobjectdef(result)); end; { handle params, calling convention, etc } procvardef: diff --git a/compiler/riscv/rarvgas.pas b/compiler/riscv/rarvgas.pas new file mode 100644 index 0000000000..97bacda10e --- /dev/null +++ b/compiler/riscv/rarvgas.pas @@ -0,0 +1,85 @@ +{ + Copyright (c) 2019 by Jeppe Johansen + + Does the parsing for the RISC-V GNU AS styled inline assembler. + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. + + **************************************************************************** +} +unit rarvgas; + +{$I fpcdefs.inc} + + interface + + uses + raatt, + cpubase; + + type + + trvattreader = class(tattreader) + function is_targetdirective(const s: string): boolean; override; + procedure HandleTargetDirective; override; + end; + + implementation + + uses + { helpers } + cutils, + { global } + globtype,globals,verbose, + systems, + { aasm } + aasmbase,aasmtai,aasmdata,aasmcpu, + { symtable } + symconst,symsym,symdef, + { parser } + procinfo, + rabase,rautils, + cgbase,cgobj,cgrv + ; + + function trvattreader.is_targetdirective(const s: string): boolean; + begin + case s of + '.option': + result:=true + else + Result:=inherited is_targetdirective(s); + end; + end; + + procedure trvattreader.HandleTargetDirective; + var + id: string; + begin + case actasmpattern of + '.option': + begin + consume(AS_TARGET_DIRECTIVE); + id:=actasmpattern; + Consume(AS_ID); + curList.concat(tai_directive.create(asd_option, lower(id))); + end + else + inherited HandleTargetDirective; + end; + end; + +end. + diff --git a/compiler/riscv64/cgcpu.pas b/compiler/riscv64/cgcpu.pas index f8b3888ae9..4b889b3c4d 100644 --- a/compiler/riscv64/cgcpu.pas +++ b/compiler/riscv64/cgcpu.pas @@ -104,6 +104,8 @@ implementation list.Concat(taicpu.op_reg_reg_const(A_ADDIW,reg2,reg1,0)) else if (tosize=OS_S32) and (tcgsize2unsigned[fromsize]=OS_64) then list.Concat(taicpu.op_reg_reg_const(A_ADDIW,reg2,reg1,0)) + else if (tosize=OS_S32) and (fromsize=OS_32) then + list.Concat(taicpu.op_reg_reg_const(A_ADDIW,reg2,reg1,0)) else if (tcgsize2unsigned[tosize]=OS_64) and (fromsize=OS_8) then list.Concat(taicpu.op_reg_reg_const(A_ANDI,reg2,reg1,$FF)) else if (tcgsize2size[fromsize] > tcgsize2size[tosize]) or diff --git a/compiler/riscv64/rarv64gas.pas b/compiler/riscv64/rarv64gas.pas index 2c727846d8..bf92dffc1e 100644 --- a/compiler/riscv64/rarv64gas.pas +++ b/compiler/riscv64/rarv64gas.pas @@ -26,11 +26,11 @@ unit rarv64gas; interface uses - raatt, rarv, + raatt, rarvgas, rarv, cpubase; type - trv64attreader = class(tattreader) + trv64attreader = class(trvattreader) actmemoryordering: TMemoryOrdering; function is_register(const s: string): boolean; override; function is_asmopcode(const s: string):boolean;override; @@ -413,8 +413,10 @@ unit rarv64gas; hl : tasmlabel; ofs : aint; refaddr: trefaddr; + entered_paren: Boolean; Begin expr:=''; + entered_paren:=false; refaddr:=addr_full; if actasmtoken=AS_MOD then @@ -444,6 +446,7 @@ unit rarv64gas; consume(AS_ID); consume(AS_LPAREN); + entered_paren:=true; end; end; @@ -472,6 +475,7 @@ unit rarv64gas; BuildReference(oper); end; + AS_DOT, AS_ID: { A constant expression, or a Variable ref. } Begin if is_fenceflag(actasmpattern) then @@ -553,7 +557,7 @@ unit rarv64gas; { add a constant expression? } if (actasmtoken=AS_PLUS) then begin - l:=BuildConstExpression(true,false); + l:=BuildConstExpression(true,entered_paren); case oper.opr.typ of OPR_CONSTANT : inc(oper.opr.val,l); diff --git a/compiler/systems.pas b/compiler/systems.pas index 1ecb0c57ef..71269b12b8 100644 --- a/compiler/systems.pas +++ b/compiler/systems.pas @@ -356,7 +356,8 @@ interface system_i386_linux,system_powerpc64_linux,system_sparc64_linux,system_x86_64_linux, system_m68k_atari,system_m68k_palmos, system_i386_haiku,system_x86_64_haiku, - system_i386_openbsd,system_x86_64_openbsd + system_i386_openbsd,system_x86_64_openbsd, + system_riscv32_linux,system_riscv64_linux ]+systems_darwin+systems_amigalike; { all systems that use garbage collection for reference-counted types } diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index 801c6beb4b..be20f53a65 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/packages/fcl-passrc/src/pasresolver.pp @@ -1443,7 +1443,7 @@ type FindProcData: Pointer; var Abort: boolean); virtual; function IsSameProcContext(ProcParentA, ProcParentB: TPasElement): boolean; function FindProcSameSignature(const ProcName: string; Proc: TPasProcedure; - Scope: TPasScope): TPasProcedure; + Scope: TPasIdentifierScope; OnlyLocal: boolean): TPasProcedure; protected procedure SetCurrentParser(AValue: TPasParser); override; procedure ScannerWarnDirective(Sender: TObject; Identifier: string; @@ -4871,7 +4871,8 @@ begin end; function TPasResolver.FindProcSameSignature(const ProcName: string; - Proc: TPasProcedure; Scope: TPasScope): TPasProcedure; + Proc: TPasProcedure; Scope: TPasIdentifierScope; OnlyLocal: boolean + ): TPasProcedure; var FindData: TFindProcData; Abort: boolean; @@ -4881,7 +4882,10 @@ begin FindData.Args:=Proc.ProcType.Args; FindData.Kind:=fpkSameSignature; Abort:=false; - Scope.IterateElements(ProcName,Scope,@OnFindProc,@FindData,Abort); + if OnlyLocal then + Scope.IterateLocalElements(ProcName,Scope,@OnFindProc,@FindData,Abort) + else + Scope.IterateElements(ProcName,Scope,@OnFindProc,@FindData,Abort); Result:=FindData.Found; end; @@ -5860,7 +5864,7 @@ var DeclProc, Proc, ParentProc: TPasProcedure; Abort, HasDots, IsClassConDestructor: boolean; DeclProcScope, ProcScope: TPasProcedureScope; - ParentScope: TPasScope; + ParentScope: TPasIdentifierScope; pm: TProcedureModifier; ptm: TProcTypeModifier; ObjKind: TPasObjKind; @@ -6100,13 +6104,15 @@ begin if (ProcName<>'') and ProcNeedsBody(Proc) then begin // check if there is a forward declaration - ParentScope:=GetParentLocalScope; + //writeln('TPasResolver.FinishProcedureType ',GetObjName(TopScope),' ',GetObjName(Scopes[ScopeCount-2])); + ParentScope:=GetParentLocalScope as TPasIdentifierScope; //writeln('TPasResolver.FinishProcedureType FindForward2 ParentScope=',GetObjName(ParentScope),'=',GetObjName(ParentScope.Element),' Proc=',GetObjName(Proc),' at ',GetElementSourcePosStr(Proc)); - DeclProc:=FindProcSameSignature(ProcName,Proc,ParentScope); + DeclProc:=FindProcSameSignature(ProcName,Proc,ParentScope,true); //writeln('TPasResolver.FinishProcedureType FindForward3 DeclProc=',GetObjName(DeclProc),' Proc.Parent=',GetObjName(Proc.Parent)); + //if DeclProc<>nil then writeln('TPasResolver.FinishProcedureType DeclProc at ',GetElementSourcePosStr(DeclProc)); if (DeclProc=nil) and (Proc.Parent.ClassType=TImplementationSection) then DeclProc:=FindProcSameSignature(ProcName,Proc, - (Proc.GetModule.InterfaceSection.CustomData) as TPasScope); + (Proc.GetModule.InterfaceSection.CustomData) as TPasIdentifierScope,true); //writeln('TPasResolver.FinishProcedureType FindForward4 ',GetObjName(DeclProc),' at ',GetElementSourcePosStr(DeclProc)); if (DeclProc<>nil) then begin @@ -6333,7 +6339,7 @@ begin else if ImplProc.ClassType=TPasClassDestructor then DeclProc:=ClassOrRecScope.ClassDestructor else - DeclProc:=FindProcSameSignature(ProcName,ImplProc,ClassOrRecScope); + DeclProc:=FindProcSameSignature(ProcName,ImplProc,ClassOrRecScope,false); if DeclProc=nil then RaiseIdentifierNotFound(20170216151720,ImplProc.Name,ImplProc.ProcType); DeclProcScope:=DeclProc.CustomData as TPasProcedureScope; @@ -9004,7 +9010,7 @@ begin exit; InhScope:=PushInheritedScope(TPasMembersType(AncestorScope.Element),true,nil); end; - AncestorProc:=FindProcSameSignature(DeclProc.Name,DeclProc,InhScope); + AncestorProc:=FindProcSameSignature(DeclProc.Name,DeclProc,InhScope,false); PopScope; if AncestorProc=nil then // 'inherited;' without ancestor DeclProc is silently ignored diff --git a/packages/fcl-passrc/tests/tcresolver.pas b/packages/fcl-passrc/tests/tcresolver.pas index 515876c919..5bf5ee9c6c 100644 --- a/packages/fcl-passrc/tests/tcresolver.pas +++ b/packages/fcl-passrc/tests/tcresolver.pas @@ -410,6 +410,7 @@ type Procedure TestProcOverloadBaseTypeOtherUnit; Procedure TestProcOverloadBaseProcNoHint; Procedure TestProcOverload_UnitOrderFail; + Procedure TestProcOverload_UnitSameSignature; Procedure TestProcOverloadDelphiMissingNextOverload; Procedure TestProcOverloadDelphiMissingPrevOverload; Procedure TestProcOverloadDelphiUnit; @@ -4650,7 +4651,6 @@ procedure TTestResolver.TestCAssignments; begin StartProgram(false); Parser.Options:=Parser.Options+[po_cassignments]; - Scanner.Options:=Scanner.Options+[po_cassignments]; Add('Type'); Add(' TFlag = (Flag1,Flag2);'); Add(' TFlags = set of TFlag;'); @@ -4831,7 +4831,6 @@ procedure TTestResolver.TestAssign_Access; begin StartProgram(false); Parser.Options:=Parser.Options+[po_cassignments]; - Scanner.Options:=Scanner.Options+[po_cassignments]; Add('var i: longint;'); Add('begin'); Add(' {#a1_assign}i:={#a2_read}i;'); @@ -6626,6 +6625,28 @@ begin CheckResolverException(sIncompatibleTypeArgNo,nIncompatibleTypeArgNo); end; +procedure TTestResolver.TestProcOverload_UnitSameSignature; +begin + AddModuleWithIntfImplSrc('unit1.pp', + LinesToStr([ + 'procedure Val(d: string);', + '']), + LinesToStr([ + 'procedure Val(d: string); begin end;', + ''])); + StartProgram(true); + Add([ + 'uses unit1;', + 'procedure Val(d: string);', + 'begin', + 'end;', + 'var', + ' s: string;', + 'begin', + ' Val(s);']); + ParseProgram; +end; + procedure TTestResolver.TestProcOverloadDelphiMissingNextOverload; begin StartProgram(false); @@ -14085,7 +14106,6 @@ end; procedure TTestResolver.TestArray_DynArrayConstObjFPC; begin Parser.Options:=Parser.Options+[po_cassignments]; - Scanner.Options:=Scanner.Options+[po_cassignments]; StartProgram(false); Add([ '{$modeswitch arrayoperators}', diff --git a/rtl/inc/heaptrc.pp b/rtl/inc/heaptrc.pp index ea9e63eb03..2e3d86fee8 100644 --- a/rtl/inc/heaptrc.pp +++ b/rtl/inc/heaptrc.pp @@ -509,8 +509,6 @@ var begin loc_info := @heap_info; try_finish_heap_free_todo_list(loc_info); - inc(loc_info^.getmem_size,size); - inc(loc_info^.getmem8_size,(size+7) and not 7); { Do the real GetMem, but alloc also for the info block } {$ifdef cpuarm} allocsize:=(size + 3) and not 3+sizeof(theap_mem_info)+extra_info_size; @@ -529,6 +527,10 @@ begin end; pp:=pheap_mem_info(p); inc(p,sizeof(theap_mem_info)); + { Update getmem_size and getmem8_size only after successful call + to SysGetMem } + inc(loc_info^.getmem_size,size); + inc(loc_info^.getmem8_size,(size+7) and not 7); { Create the info block } pp^.sig:=longword(AllocateSig); pp^.todolist:=@loc_info^.heap_free_todo; diff --git a/rtl/linux/Makefile b/rtl/linux/Makefile index 6a9e8c3666..0ee1ca5fee 100644 --- a/rtl/linux/Makefile +++ b/rtl/linux/Makefile @@ -359,7 +359,8 @@ override LOADERS= SYSINIT_UNITS=si_prc si_c si_g si_dll endif ifeq ($(ARCH),riscv64) -override LOADERS=prt0 cprt0 dllprt0 +override LOADERS= +SYSINIT_UNITS=si_prc si_dll si_c endif ifeq ($(ARCH),mipsel) override FPCOPT+=-Ur diff --git a/rtl/linux/Makefile.fpc b/rtl/linux/Makefile.fpc index 6fe66bc1a1..843ccf45ac 100644 --- a/rtl/linux/Makefile.fpc +++ b/rtl/linux/Makefile.fpc @@ -91,7 +91,8 @@ SYSINIT_UNITS=si_prc si_c si_g si_dll endif ifeq ($(ARCH),riscv64) -override LOADERS=prt0 cprt0 dllprt0 +override LOADERS= +SYSINIT_UNITS=si_prc si_dll si_c endif # mipsel reuses mips files by including so some file names exist diff --git a/rtl/linux/riscv64/cprt0.as b/rtl/linux/riscv64/cprt0.as deleted file mode 100644 index 17f520f896..0000000000 --- a/rtl/linux/riscv64/cprt0.as +++ /dev/null @@ -1,142 +0,0 @@ -/* Startup code for ARM & ELF - Copyright (C) 1995, 1996, 1997, 1998, 2001, 2002 Free Software Foundation, Inc. - This file is part of the GNU C Library. - - The GNU C Library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. - - The GNU C Library 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 - Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with the GNU C Library; if not, write to the Free - Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, - MA 02110-1301, USA. */ - -/* This is the canonical entry point, usually the first thing in the text - segment. - - Note that the code in the .init section has already been run. - This includes _init and _libc_init - - - At this entry point, most registers' values are unspecified, except: - - a0 Contains a function pointer to be registered with `atexit'. - This is how the dynamic linker arranges to have DT_FINI - functions called for shared libraries that have been loaded - before this code runs. - - sp The stack contains the arguments and environment: - 0(sp) argc - 8(sp) argv[0] - ... - (8*argc)(sp) NULL - (8*(argc+1))(sp) envp[0] - ... - NULL -*/ - - .text - .globl _start - .type _start,function -_start: - .option push - .option norelax -1:auipc gp, %pcrel_hi(__global_pointer$) - addi gp, gp, %pcrel_lo(1b) - .option pop - - /* Store rtld_fini in a5 */ - addi a5, a0, 0 - - /* Clear the frame pointer since this is the outermost frame. */ - addi x8, x0, 0 - - /* Pop argc off the stack, and save argc, argv and envp */ - ld a1, 0(sp) - addi a2, sp, 8 - addi a4, a1, 1 - slli a4, a4, 3 - add a4, a2, a4 - -1:auipc x8,%pcrel_hi(operatingsystem_parameter_argc) - sw a1,%pcrel_lo(1b)(x8) -1:auipc x8,%pcrel_hi(operatingsystem_parameter_argv) - sd a2,%pcrel_lo(1b)(x8) -1:auipc x8,%pcrel_hi(operatingsystem_parameter_envp) - sd a4,%pcrel_lo(1b)(x8) - - /* Save initial stackpointer */ -1:auipc x8,%pcrel_hi(__stkptr) - sd sp,%pcrel_lo(1b)(x8) - - /* Fetch address of fini */ -1:auipc x8,%pcrel_hi(__libc_csu_fini) - addi a4,x8,%pcrel_lo(1b) - - addi a6, sp, 0 - - /* Set up the other arguments in registers */ -1:auipc x8,%pcrel_hi(PASCALMAIN) - addi a0, x8, %pcrel_lo(1b) -1:auipc x8,%pcrel_hi(__libc_csu_init) - addi a3, x8, %pcrel_lo(1b) - - /* __libc_start_main (main, argc, argv, init, fini, rtld_fini, stack_end) */ - - /* Let the libc call main and exit with its return code. */ -1:auipc x8,%pcrel_hi(__libc_start_main) - jalr ra, x8, %pcrel_lo(1b) - - /* should never get here....*/ -1:auipc x8,%pcrel_hi(abort) - jalr ra, x8, %pcrel_lo(1b) - - .globl _haltproc - .type _haltproc,function -_haltproc: -1:auipc x8,%pcrel_hi(operatingsystem_result) - lbu x1,%pcrel_lo(1b)(x8) - addi x17, x0, 94 - ecall - jal x0, _haltproc - - /* Define a symbol for the first piece of initialized data. */ - .data - .globl __data_start -__data_start: - .long 0 - .weak data_start - data_start = __data_start - -.bss - .comm __stkptr,8 - - .comm operatingsystem_parameter_envp,8 - .comm operatingsystem_parameter_argc,4 - .comm operatingsystem_parameter_argv,8 - - .section ".comment" - .byte 0 - .ascii "generated by FPC http://www.freepascal.org\0" - -/* We need this stuff to make gdb behave itself, otherwise - gdb will chokes with SIGILL when trying to debug apps. -*/ - .section ".note.ABI-tag", "a" - .align 4 - .long 1f - 0f - .long 3f - 2f - .long 1 -0: .asciz "GNU" -1: .align 4 -2: .long 0 - .long 2,0,0 -3: .align 4 - -.section .note.GNU-stack,"",%progbits diff --git a/rtl/linux/riscv64/dllprt0.as b/rtl/linux/riscv64/dllprt0.as deleted file mode 100644 index 9c0cc1cccd..0000000000 --- a/rtl/linux/riscv64/dllprt0.as +++ /dev/null @@ -1,76 +0,0 @@ -/* - * This file is part of the Free Pascal run time library. - * Copyright (c) 2011 by Thomas Schatzl, - * member of the Free Pascal development team. - * - * Startup code for shared libraries, ARM version. - * - * See the file COPYING.FPC, included in this distribution, - * for details about the copyright. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - */ - -.file "dllprt0.as" -.text - .globl _startlib - .type _startlib,function -_startlib: - .globl FPC_SHARED_LIB_START - .type FPC_SHARED_LIB_START,function -FPC_SHARED_LIB_START: - addi sp, sp, -16 - sd ra, 8(sp) - sd x8, 0(sp) - addi x8, sp, 16 - - /* a0 contains argc, a1 contains argv and a2 contains envp */ -1:auipc x8,%pcrel_hi(operatingsystem_parameter_argc) - sw a0,%pcrel_lo(1b)(x8) -1:auipc x8,%pcrel_hi(operatingsystem_parameter_argv) - sd a1,%pcrel_lo(1b)(x8) -1:auipc x8,%pcrel_hi(operatingsystem_parameter_envp) - sd a2,%pcrel_lo(1b)(x8) - - /* save initial stackpointer */ -1:auipc x8,%pcrel_hi(__stklen) - sd sp,%pcrel_lo(1b)(x8) - - /* call main and exit normally */ -1:auipc x8,%pcrel_hi(PASCALMAIN) - jalr ra, x8, %pcrel_lo(1b) - - ld x8, 0(x8) - ld ra, 8(x8) - addi sp, sp, 16 - - jalr x0, ra - - .globl _haltproc - .type _haltproc,function -_haltproc: -1:auipc x8,%pcrel_hi(operatingsystem_result) - lbu x1,%pcrel_lo(1b)(x8) - addi x17, x0, 94 - ecall - jal x0, _haltproc - -.data - - .type operatingsystem_parameters,object - .size operatingsystem_parameters, 24 -operatingsystem_parameters: - .skip 3 * 8 - .global operatingsystem_parameter_argc - .global operatingsystem_parameter_argv - .global operatingsystem_parameter_envp - .set operatingsystem_parameter_argc, operatingsystem_parameters+0 - .set operatingsystem_parameter_argv, operatingsystem_parameters+8 - .set operatingsystem_parameter_envp, operatingsystem_parameters+16 - -.bss - - .comm __stkptr,8 - diff --git a/rtl/linux/riscv64/gprt0.as b/rtl/linux/riscv64/gprt0.as deleted file mode 100644 index 592c9c9b96..0000000000 --- a/rtl/linux/riscv64/gprt0.as +++ /dev/null @@ -1,162 +0,0 @@ -/* Startup code for ARM & ELF - Copyright (C) 1995, 1996, 1997, 1998, 2001, 2002 Free Software Foundation, Inc. - This file is part of the GNU C Library. - - The GNU C Library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. - - The GNU C Library 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 - Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with the GNU C Library; if not, write to the Free - Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, - MA 02110-1301, USA. */ - -/* This is the canonical entry point, usually the first thing in the text - segment. - - Note that the code in the .init section has already been run. - This includes _init and _libc_init - - - At this entry point, most registers' values are unspecified, except: - - a1 Contains a function pointer to be registered with `atexit'. - This is how the dynamic linker arranges to have DT_FINI - functions called for shared libraries that have been loaded - before this code runs. - - sp The stack contains the arguments and environment: - 0(sp) argc - 4(sp) argv[0] - ... - (4*argc)(sp) NULL - (4*(argc+1))(sp) envp[0] - ... - NULL -*/ - - .text - .globl _start - .type _start,#function -_start: - /* Clear the frame pointer since this is the outermost frame. */ - addi x8, x0, 0 - ld a2, (sp) - addi sp, sp, 4 - - /* Pop argc off the stack and save a pointer to argv */ - la x5, operatingsystem_parameter_argc - la x6,operatingsystem_parameter_argv - sd a2, (x5) - - /* calc envp */ - addi a4,a2,1 - slli a4,a4,3 - add a4,sp,a4 - la x5, operatingsystem_parameter_envp - - sd sp,(a3) - sd a4,(x5) - - /* Save initial stackpointer */ - la x5,__stkptr - sd sp, (x5) - - /* Initialize gmon */ - mov r2,#1 - ldr r1,=_etext - ldr r0,=_start - bl __monstartup - ldr r0,=_mcleanup - bl atexit - - /* argc already loaded to a2*/ - ldr ip, =operatingsystem_parameter_argc - ldr a2,[ip] - - /* Fetch address of fini */ - ldr ip, =_fini - - /* load argv */ - mov a3, sp - - /* Push stack limit */ - str a3, [sp, #-4]! - - /* Push rtld_fini */ - str a1, [sp, #-4]! - - /* Set up the other arguments in registers */ - ldr a1, =PASCALMAIN - ldr a4, =_init - - /* Push fini */ - str ip, [sp, #-4]! - - /* __libc_start_main (main, argc, argv, init, fini, rtld_fini, stack_end) */ - - /* Let the libc call main and exit with its return code. */ - bl __libc_start_main - - /* should never get here....*/ - bl abort - - .globl _haltproc - .type _haltproc,#function -_haltproc: - ldr r0,=operatingsystem_result - ldrb r0,[r0] - swi 0x900001 - b _haltproc - - .globl _haltproc_eabi - .type _haltproc_eabi,#function -_haltproc_eabi: - bl exit /* libc exit */ - - ldr r0,=operatingsystem_result - ldrb r0,[r0] - mov r7,#248 - swi 0x0 - b _haltproc_eabi - - /* Define a symbol for the first piece of initialized data. */ - .data - .globl __data_start -__data_start: - .long 0 - .weak data_start - data_start = __data_start - -.bss - .comm __stkptr,4 - - .comm operatingsystem_parameter_envp,4 - .comm operatingsystem_parameter_argc,4 - .comm operatingsystem_parameter_argv,4 - - .section ".comment" - .byte 0 - .ascii "generated by FPC http://www.freepascal.org\0" - -/* We need this stuff to make gdb behave itself, otherwise - gdb will chokes with SIGILL when trying to debug apps. -*/ - .section ".note.ABI-tag", "a" - .align 4 - .long 1f - 0f - .long 3f - 2f - .long 1 -0: .asciz "GNU" -1: .align 4 -2: .long 0 - .long 2,0,0 -3: .align 4 - -.section .note.GNU-stack,"",%progbits diff --git a/rtl/linux/riscv64/prt0.as b/rtl/linux/riscv64/prt0.as deleted file mode 100644 index e58feb3469..0000000000 --- a/rtl/linux/riscv64/prt0.as +++ /dev/null @@ -1,85 +0,0 @@ -/* - Start-up code for Free Pascal Compiler, not in a shared library, - not linking with C library. - - Written by Edmund Grimley Evans in 2015 and released into the public domain. -*/ - - .text - .align 2 - - .globl _dynamic_start - .type _dynamic_start, function -_dynamic_start: -1: - auipc x5,%pcrel_hi(__dl_fini) - sd x10, %pcrel_lo(1b)(x5) - jal x0, _start - - .globl _start - .type _start, function -_start: - .option push - .option norelax -1: auipc gp, %pcrel_hi(__bss_start+0x800) - addi gp, gp, %pcrel_lo(1b) - .option pop - - /* Get argc, argv, envp */ - ld x5,(x2) - addi x6,x2,8 - addi x7,x5,1 - slli x7,x7,3 - add x7,x6,x7 - - /* Save argc, argv, envp, and initial stack pointer */ -1:auipc x8,%pcrel_hi(operatingsystem_parameter_argc) - sw x5,%pcrel_lo(1b)(x8) -1:auipc x8,%pcrel_hi(operatingsystem_parameter_argv) - sd x6,%pcrel_lo(1b)(x8) -1:auipc x8,%pcrel_hi(operatingsystem_parameter_envp) - sd x7,%pcrel_lo(1b)(x8) -1:auipc x5,%pcrel_hi(__stkptr) - addi x6, x2, 0 - sd x6,%pcrel_lo(1b)(x5) - - /* Initialise FP to zero */ - addi x8,x0,0 - - /* Call main */ - jal x1, PASCALMAIN - - .globl _haltproc - .type _haltproc,function -_haltproc: -1:auipc x10,%pcrel_hi(__dl_fini) - ld x10,%pcrel_lo(1b)(x10) - beq x10,x0,.Lexit - jalr x1,x10 -.Lexit: -1:auipc x10,%pcrel_hi(operatingsystem_result) - ld x10,%pcrel_lo(1b)(x10) - addi x17, x0, 94 - ecall - jal x0, _haltproc - - /* Define a symbol for the first piece of initialized data. */ - .data - .align 4 - .globl __data_start -__data_start: - .quad 0 - .weak data_start - data_start = __data_start - - .bss - .align 4 - - .comm __dl_fini,8 - .comm __stkptr,8 - - .comm operatingsystem_parameter_envp,8 - .comm operatingsystem_parameter_argc,4 - .comm operatingsystem_parameter_argv,8 - - .section .note.GNU-stack,"",%progbits diff --git a/rtl/linux/riscv64/si_c.inc b/rtl/linux/riscv64/si_c.inc new file mode 100644 index 0000000000..23286a931b --- /dev/null +++ b/rtl/linux/riscv64/si_c.inc @@ -0,0 +1,81 @@ +{ + This file is part of the Free Pascal run time library. + Copyright (c) 2019 by Jeppe Johansen. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +{****************************************************************************** + Process start/halt + ******************************************************************************} + +var + dlexitproc : pointer; + +var + BSS_START: record end; external name '__bss_start'; + STACK_PTR: record end; external name '__stkptr'; + + libc_init_proc: TProcedure; weakexternal name '_init'; + libc_fini_proc: TProcedure; weakexternal name '_fini'; + +procedure libc_start_main(main: TProcedure; argc: ptruint; argv: ppchar; init, fini, rtld_fini: TProcedure; stack_end: pointer); cdecl; external name '__libc_start_main'; +procedure libc_exit(code: ptruint); cdecl; external name 'exit'; + +procedure _FPC_rv_enter(at_exit: TProcedure; sp: pptruint); + var + argc: ptruint; + argv: ppchar; + begin + argc:=sp[0]; + argv:=@sp[1]; + + initialstkptr:=sp; + operatingsystem_parameter_argc:=argc; + operatingsystem_parameter_argv:=argv; + operatingsystem_parameter_envp:=@sp[1+argc]; + + libc_start_main(@PascalMain, argc, argv, libc_init_proc, libc_fini_proc, at_exit, sp); + end; + + +procedure _FPC_proc_start; assembler; nostackframe; public name '_start'; + asm + { set up GP } + .option push + .option norelax +.L1: + auipc gp, %pcrel_hi(BSS_START+0x800) + addi gp, gp, %pcrel_lo(.L1) + .option pop + + { Initialise FP to zero } + addi fp, x0, 0 + + { atexit is in a0 } + addi a1, sp, 0 + jal x1, _FPC_rv_enter + end; + + +procedure _FPC_rv_exit(e:longint); assembler; nostackframe; + asm + addi a7, x0, 94 + ecall + end; + + +procedure _FPC_proc_haltproc(e:longint); cdecl; public name '_haltproc'; + begin + while true do + begin + libc_exit(e); + _FPC_rv_exit(e); + end; + end; diff --git a/rtl/linux/riscv64/si_dll.inc b/rtl/linux/riscv64/si_dll.inc new file mode 100644 index 0000000000..c14c1ea75b --- /dev/null +++ b/rtl/linux/riscv64/si_dll.inc @@ -0,0 +1,38 @@ +{ + This file is part of the Free Pascal run time library. + Copyright (c) 2019 by Jeppe Johansen. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + + +{****************************************************************************** + Shared library start/halt + ******************************************************************************} + +procedure _FPC_shared_lib_start(argc : dword;argv,envp : pointer); cdecl; public name 'FPC_SHARED_LIB_START'; public name '_start'; + begin + + operatingsystem_parameter_argc:=argc; { Copy the argument count } + operatingsystem_parameter_argv:=argv; { Copy the argument pointer } + operatingsystem_parameter_envp:=envp; { Copy the environment pointer } + initialstkptr:=get_frame; + + PASCALMAIN; + end; + +{ this routine is only called when the halt() routine of the RTL embedded in + the shared library is called } +procedure _FPC_shared_lib_haltproc(e:longint); cdecl; assembler; public name '_haltproc'; + asm +.L1: + addi a7, x0, 94 + ecall + jal x0, .L1 + end; diff --git a/rtl/linux/riscv64/si_prc.inc b/rtl/linux/riscv64/si_prc.inc new file mode 100644 index 0000000000..598788cc34 --- /dev/null +++ b/rtl/linux/riscv64/si_prc.inc @@ -0,0 +1,84 @@ +{ + This file is part of the Free Pascal run time library. + Copyright (c) 2019 by Jeppe Johansen. + + See the file COPYING.FPC, included in this distribution, + for details about the copyright. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + + **********************************************************************} + +{****************************************************************************** + Process start/halt + ******************************************************************************} + +var + dlexitproc : pointer; + +var + BSS_START: record end; external name '__bss_start'; + STACK_PTR: record end; external name '__stkptr'; + +procedure _FPC_rv_enter(sp: pptruint); + var + argc: ptruint; + begin + argc:=sp[0]; + + initialstkptr:=sp; + operatingsystem_parameter_argc:=argc; + operatingsystem_parameter_argv:=@sp[1]; + operatingsystem_parameter_envp:=@sp[1+argc]; + + PascalMain; + end; + +procedure _FPC_proc_start; assembler; nostackframe; public name '_start'; + asm + { set up GP } + .option push + .option norelax +.L1: + auipc gp, %pcrel_hi(BSS_START+0x800) + addi gp, gp, %pcrel_lo(.L1) + .option pop + + { Initialise FP to zero } + addi fp, x0, 0 + + addi a0, sp, 0 + jal x1, _FPC_rv_enter + end; + + +procedure _FPC_dynamic_proc_start; assembler; nostackframe; public name '_dynamic_start'; + asm + .option push + .option norelax +.L1: + auipc t0, %pcrel_hi(dlexitproc) + sd a0, %pcrel_lo(.L1)(t0) + .option pop + + jal x0, _FPC_proc_start + end; + + +procedure _FPC_rv_exit(e:longint); assembler; nostackframe; + asm +.L1: + addi a7, x0, 94 + ecall + jal x0, .L1 + end; + + +procedure _FPC_proc_haltproc(e:longint); cdecl; public name '_haltproc'; + begin + if assigned(dlexitproc) then + TProcedure(dlexitproc); + _FPC_rv_exit(e); + end; diff --git a/rtl/objpas/sysutils/syshelph.inc b/rtl/objpas/sysutils/syshelph.inc index 4de19c717f..a233c5afde 100644 --- a/rtl/objpas/sysutils/syshelph.inc +++ b/rtl/objpas/sysutils/syshelph.inc @@ -523,7 +523,7 @@ Type public const MaxValue = High(NativeInt); - MinValue = Low(NativeUInt); + MinValue = Low(NativeInt); Public Class Function Parse(const AString: string): NativeInt; inline; static; Class Function Size: Integer; inline; static; diff --git a/rtl/openbsd/ptypes.inc b/rtl/openbsd/ptypes.inc index d7be599cce..2ba6bebf8c 100644 --- a/rtl/openbsd/ptypes.inc +++ b/rtl/openbsd/ptypes.inc @@ -149,11 +149,11 @@ type ); Const - MNAMLEN = 90; // length of buffer for returned name - MFSNamLen = 16; // length of fs type name, including nul + MFSNAMELEN = 16; // length of fs type name, including nul + MNAMELEN = 90; // length of buffer for returned name type - fsid_t = array[0..1] of cint; + fsid_t = array[0..1] of cint32; ufs_args_rec = record end; mfs_args_rec = record end; @@ -176,29 +176,36 @@ type end; // kernel statfs from mount.h + { new statfs structure with mount options and statvfs fields } TStatfs = record - flags, { copy of mount flags } - bsize, { filesystem block size} - iosize : cint; { optimal transfr block size } - blocks, { total data block in file system } - bfree : cuint64; { blocks free in fs } - bavail : cint64; { block available for non-superuser } - files, { total file nodes in file system } - ffree : cuint64; { free files nodes in fs } - favail : cint64; { free file nodes avail to non-root } - fsyncwrites, { count of sync writes since mount } - fasyncwrites, { count of async writes since mount } - fsyncreads, { count of sync reads since mount } - fasyncreads : cuint64; { count of async reads since mount } - fsid : fsid_t; { file system id } - namemax : cint; { maximum fileystem length } - fowner : tuid; { user that mounted the fileystem } - ctime : cint; { last mount [-u] time } - fspare3 : array[0..2] of cint; { spare for later } - fstypename : array[0..MFSNamLen-1] of char; { fs type name } - mountpoint : array[0..MNAMLEN-1] of char; { directory on which mounted} - mnfromname : array[0..MNAMLEN-1] of char; { mounted file system } - mount_info : mountinfo; { per-filesystem mount options } + flags, { copy of mount flags } + bsize, { filesystem block size } + iosize : cuint32; { optimal transfer block size } + + { unit is f_bsize } + blocks, { total data block in file system } + bfree : cuint64; { free blocks in fs } + bavail : cint64; { free blocks avail to non-superuser } + + files, { total file nodes in file system } + ffree : cuint64; { free files nodes in fs } + favail : cint64; { free file nodes avail to non-root } + + fsyncwrites, { count of sync writes since mount } + fsyncreads, { count of sync reads since mount } + fasyncwrites, { count of async writes since mount } + fasyncreads : cuint64; { count of async reads since mount } + + fsid : fsid_t; { file system id } + namemax : cuint32; { maximum filename length } + owner : tuid; { user that mounted the fileystem } + ctime : cuint64; { last mount [-u] time } + + fstypename : array[0..MFSNAMELEN-1] of char; { fs type name } + mntonname : array[0..MNAMELEN-1] of char; { directory on which mounted } + mntfromname: array[0..MNAMELEN-1] of char; { mounted file system } + mntfromspec: array[0..MNAMELEN-1] of char; { special for mount request } + mount_info: mountinfo; { per-filesystem mount options } end; PStatFS=^TStatFS; diff --git a/rtl/openbsd/t_openbsd.h2paschk b/rtl/openbsd/t_openbsd.h2paschk new file mode 100644 index 0000000000..82d0c26cb6 --- /dev/null +++ b/rtl/openbsd/t_openbsd.h2paschk @@ -0,0 +1,115 @@ +# OpenBSD RTL-to-C structure compatibility checker description file +# +# Use +# h2paschk t_openbsd.h2paschk +# +# ...to generate Pascal and C code, then make sure they both compile and that +# the Pascal program produces the same output as the C program for each +# supported architecture. + +@Pascal uses baseunix; +@Pascal begin + +@C #include +@C #include +@C #include +@C #include +@C #include +@C #include +@C #include +@C #include +@C #include +@C #include +@C #include +@C #include +@C #include +@C int main() +@C { + +@record stat,struct stat +.st_mode +.st_dev +.st_ino +.st_nlink +.st_uid +.st_gid +.st_rdev +.st_atime +.st_atimensec +.st_mtime +.st_mtimensec +.st_ctime +.st_ctimensec +.st_size +.st_blocks +.st_blksize +.st_flags +.st_gen +.st_birthtime,__st_birthtime +.st_birthtimensec,__st_birthtimensec + +@record dirent,struct dirent +.d_fileno +.d_off +.d_reclen +.d_type +.d_namlen +.d_padding,__d_padding +.d_name + +@record pollfd,struct pollfd +.fd +.events +.revents + +@record utimbuf,struct utimbuf +.actime +.modtime + +@record flock,struct flock +.l_start +.l_len +.l_pid +.l_type +.l_whence + +@record tms,struct tms +.tms_utime +.tms_stime +.tms_cutime +.tms_cstime + +@record timezone,struct timezone +.tz_minuteswest +.tz_dsttime + +@record rusage,struct rusage +.ru_utime +.ru_stime +.ru_maxrss +.ru_ixrss +.ru_idrss +.ru_isrss +.ru_minflt +.ru_majflt +.ru_nswap +.ru_inblock +.ru_oublock +.ru_msgsnd +.ru_msgrcv +.ru_nsignals +.ru_nvcsw +.ru_nivcsw + +@record TRLimit,struct rlimit +.rlim_cur +.rlim_max + +@record iovec,struct iovec +.iov_base +.iov_len + +@C return 0; +@C } + +@Pascal end. diff --git a/tests/tbf/tb0268.pp b/tests/tbf/tb0268.pp new file mode 100644 index 0000000000..c6bfc43b5d --- /dev/null +++ b/tests/tbf/tb0268.pp @@ -0,0 +1,13 @@ +{ %FAIL } + +program tb0268; + +{$mode objfpc} + +operator Not (aArg1: TObject; aArg2: TObject): TObject; +begin +end; + +begin + +end. diff --git a/tests/tbf/tb0269.pp b/tests/tbf/tb0269.pp new file mode 100644 index 0000000000..273b006076 --- /dev/null +++ b/tests/tbf/tb0269.pp @@ -0,0 +1,13 @@ +{ %FAIL } + +program tb0269; + +{$mode objfpc} + +operator + (aArg1: TObject; aArg2: TObject; aArg3: TObject): TObject; +begin +end; + +begin + +end. diff --git a/tests/tbf/tb0270.pp b/tests/tbf/tb0270.pp new file mode 100644 index 0000000000..5cc62a463d --- /dev/null +++ b/tests/tbf/tb0270.pp @@ -0,0 +1,13 @@ +{ %FAIL } + +program tb0270; + +{$mode objfpc} + +operator / (aArg1: TObject): TObject; +begin +end; + +begin + +end. diff --git a/tests/webtbf/tw35348.pp b/tests/webtbf/tw35348.pp new file mode 100644 index 0000000000..48533d2ebe --- /dev/null +++ b/tests/webtbf/tw35348.pp @@ -0,0 +1,13 @@ +{ %FAIL } + +{$mode objfpc}{$H+} + +Type + TAZ=String; + +operator inc(az: TAZ; i: integer=1) raz:TAZ; // inline; +begin +end; + +begin +end. diff --git a/tests/webtbs/tw17430.pp b/tests/webtbs/tw17430.pp index 3884580cc0..90ef6892f8 100644 --- a/tests/webtbs/tw17430.pp +++ b/tests/webtbs/tw17430.pp @@ -6,7 +6,13 @@ var p:pointer; begin returnnilifgrowheapfails:=true; - GetMem(p,ptruint(-128)); + { Use a bigger absoulte value to avoid + getting a overflow inside heaptrc + if compiled with -gh option: + -128 changed to -1024, + which should be larger than typical + size of extra memory used by heaptrc } + GetMem(p,ptruint(-1024)); if assigned(p) then halt(1); end.