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

* synchronised with trunk till r41885

Browse Source 
git-svn-id: branches/debug_eh@41886 -
This commit is contained in:
Jonas Maebe 2019-04-16 16:20:44 +00:00
commit a0f850d57f
35 changed files with 634 additions and 567 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
.gitattributes vendored
View File

@ -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

8
compiler/aasmtai.pas
View File

@ -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',

8
compiler/arm/aoptcpu.pas
View File

@ -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

7
compiler/assemble.pas
View File

@ -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}

2
compiler/fpcdefs.inc
View File

@ -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}

25
compiler/hlcgobj.pas
View File

@ -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;

66
compiler/htypechk.pas
View File

@ -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;

2
compiler/jvm/pjvm.pas
View File

@ -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;

4
compiler/nobj.pas
View File

@ -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

1
compiler/pdecl.pas
View File

@ -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

1
compiler/pgenutil.pas
View File

@ -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:

85
compiler/riscv/rarvgas.pas Normal file
View File

@ -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.

2
compiler/riscv64/cgcpu.pas
View File

@ -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

10
compiler/riscv64/rarv64gas.pas
View File

@ -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);

3
compiler/systems.pas
View File

@ -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 }

24
packages/fcl-passrc/src/pasresolver.pp
View File

@ -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

26
packages/fcl-passrc/tests/tcresolver.pas
View File

@ -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}',

6
rtl/inc/heaptrc.pp
View File

@ -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;

3
rtl/linux/Makefile
View File

@ -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

3
rtl/linux/Makefile.fpc
View File

@ -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

142
rtl/linux/riscv64/cprt0.as
View File

@ -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

76
rtl/linux/riscv64/dllprt0.as
View File

@ -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

162
rtl/linux/riscv64/gprt0.as
View File

@ -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

85
rtl/linux/riscv64/prt0.as
View File

@ -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

81
rtl/linux/riscv64/si_c.inc Normal file
View File

@ -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;

38
rtl/linux/riscv64/si_dll.inc Normal file
View File

@ -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;

84
rtl/linux/riscv64/si_prc.inc Normal file
View File

@ -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;

2
rtl/objpas/sysutils/syshelph.inc
View File

@ -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;

57
rtl/openbsd/ptypes.inc
View File

@ -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;

115
rtl/openbsd/t_openbsd.h2paschk Normal file
View File

@ -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 <sys/types.h>
@C #include <sys/stat.h>
@C #include <sys/time.h>
@C #include <sys/times.h>
@C #include <sys/resource.h>
@C #include <sys/uio.h>
@C #include <dirent.h>
@C #include <poll.h>
@C #include <utime.h>
@C #include <fcntl.h>
@C #include <unistd.h>
@C #include <stdio.h>
@C #include <stddef.h>
@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.

13
tests/tbf/tb0268.pp Normal file
View File

@ -0,0 +1,13 @@
{ %FAIL }
program tb0268;
{$mode objfpc}
operator Not (aArg1: TObject; aArg2: TObject): TObject;
begin
end;
begin
end.

13
tests/tbf/tb0269.pp Normal file
View File

@ -0,0 +1,13 @@
{ %FAIL }
program tb0269;
{$mode objfpc}
operator + (aArg1: TObject; aArg2: TObject; aArg3: TObject): TObject;
begin
end;
begin
end.

13
tests/tbf/tb0270.pp Normal file
View File

@ -0,0 +1,13 @@
{ %FAIL }
program tb0270;
{$mode objfpc}
operator / (aArg1: TObject): TObject;
begin
end;
begin
end.

13
tests/webtbf/tw35348.pp Normal file
View File

@ -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.

8
tests/webtbs/tw17430.pp
View File

@ -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.