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

* synchronized with trunk

Browse Source 
git-svn-id: branches/wasm@48102 -
This commit is contained in:
nickysn 2021-01-07 07:21:01 +00:00
commit ed26d54e3b
16 changed files with 209 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
compiler/llvm/hlcgllvm.pas
View File

@ -477,10 +477,6 @@ implementation
begin
new(callpara);
callpara^.def:=paraloc^.def;
if firstparaloc then
callpara^.alignment:=paras[i]^.Alignment
else
callpara^.alignment:=std_param_align;
{ if the paraloc doesn't contain the value itself, it's a byval
parameter }
if paraloc^.retvalloc then
@ -493,6 +489,11 @@ implementation
callpara^.sret:=false;
callpara^.byval:=not paraloc^.llvmvalueloc;
end;
if firstparaloc and
callpara^.byval then
callpara^.alignment:=paras[i]^.Alignment
else
callpara^.alignment:=std_param_align;
llvmextractvalueextinfo(paras[i]^.def, callpara^.def, callpara^.valueext);
case paraloc^.llvmloc.loc of
LOC_CONSTANT:

2
compiler/ncgcon.pas
View File

@ -206,7 +206,7 @@ implementation
begin
{ an integer const. behaves as a memory reference }
location_reset(location,LOC_CONSTANT,OS_ADDR);
location.value:=aint(value);
location.value:=PInt(value);
end;

2
compiler/pdecsub.pas
View File

@ -1183,6 +1183,8 @@ implementation
include(dummysym.symoptions,sp_generic_dummy);
add_generic_dummysym(dummysym);
end;
if dummysym.typ=procsym then
tprocsym(dummysym).add_generic_overload(aprocsym);
{ start token recorder for the declaration }
pd.init_genericdecl;
current_scanner.startrecordtokens(pd.genericdecltokenbuf);

2
compiler/ppu.pas
View File

@ -48,7 +48,7 @@ const
CurrentPPUVersion = 208;
{ for any other changes to the ppu format, increase this version number
(it's a cardinal) }
CurrentPPULongVersion = 12;
CurrentPPULongVersion = 13;
{ unit flags }
uf_big_endian = $000004;

78
compiler/symsym.pas
View File

@ -131,6 +131,8 @@ interface
protected
FProcdefList : TFPObjectList;
FProcdefDerefList : TFPList;
fgenprocsymovlds : tfpobjectlist;
fgenprocsymovldsderefs : tfplist;
public
constructor create(const n : TSymStr);virtual;
constructor ppuload(ppufile:tcompilerppufile);
@ -153,7 +155,11 @@ interface
function find_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
function find_procdef_assignment_operator(fromdef,todef:tdef;var besteq:tequaltype;isexplicit:boolean):Tprocdef;
function find_procdef_enumerator_operator(fromdef,todef:tdef;var besteq:tequaltype):Tprocdef;
procedure add_generic_overload(sym:tprocsym);
property ProcdefList:TFPObjectList read FProcdefList;
{ only valid if sp_generic_dummy is set and either an overload was
added using add_generic_overload or this was loaded from a ppu }
property genprocsymovlds:tfpobjectlist read fgenprocsymovlds;
end;
tprocsymclass = class of tprocsym;
@ -902,8 +908,10 @@ implementation
constructor tprocsym.ppuload(ppufile:tcompilerppufile);
var
symderef,
pdderef : tderef;
i,
symcnt,
pdcnt : longint;
begin
inherited ppuload(procsym,ppufile);
@ -915,6 +923,17 @@ implementation
ppufile.getderef(pdderef);
FProcdefDerefList.Add(Pointer(PtrInt(pdderef.dataidx)));
end;
if sp_generic_dummy in symoptions then
begin
fgenprocsymovlds:=tfpobjectlist.create(false);
fgenprocsymovldsderefs:=tfplist.create;
symcnt:=ppufile.getword;
for i:=1 to symcnt do
begin
ppufile.getderef(symderef);
fgenprocsymovldsderefs.add(pointer(ptrint(symderef.dataidx)));
end;
end;
ppuload_platform(ppufile);
end;
@ -924,6 +943,8 @@ implementation
FProcdefList.Free;
if assigned(FProcdefDerefList) then
FProcdefDerefList.Free;
fgenprocsymovlds.free;
fgenprocsymovldsderefs.free;
inherited destroy;
end;
@ -942,6 +963,17 @@ implementation
d.dataidx:=PtrInt(FProcdefDerefList[i]);
ppufile.putderef(d);
end;
if sp_generic_dummy in symoptions then
begin
if not assigned(fgenprocsymovldsderefs) then
internalerror(2021010301);
ppufile.putword(fgenprocsymovldsderefs.count);
for i:=0 to fgenprocsymovldsderefs.count-1 do
begin
d.dataidx:=ptrint(fgenprocsymovldsderefs[i]);
ppufile.putderef(d);
end;
end;
writeentry(ppufile,ibprocsym);
end;
@ -996,6 +1028,7 @@ implementation
i : longint;
pd : tprocdef;
d : tderef;
sym : tprocsym;
begin
inherited;
if not assigned(FProcdefDerefList) then
@ -1013,6 +1046,21 @@ implementation
FProcdefDerefList.Add(Pointer(PtrInt(d.dataidx)));
end;
end;
if sp_generic_dummy in symoptions then
begin
if not assigned(fgenprocsymovlds) then
internalerror(2021010602);
if not assigned(fgenprocsymovldsderefs) then
fgenprocsymovldsderefs:=tfplist.create
else
fgenprocsymovldsderefs.clear;
for i:=0 to fgenprocsymovlds.count-1 do
begin
sym:=tprocsym(fgenprocsymovlds[i]);
d.build(sym);
fgenprocsymovldsderefs.add(pointer(ptrint(d.dataidx)));
end;
end;
end;
@ -1021,6 +1069,7 @@ implementation
i : longint;
pd : tprocdef;
d : tderef;
sym : tsym;
begin
{ Clear all procdefs }
ProcdefList.Clear;
@ -1032,6 +1081,20 @@ implementation
pd:=tprocdef(d.resolve);
ProcdefList.Add(pd);
end;
if sp_generic_dummy in symoptions then
begin
if not assigned(fgenprocsymovlds) then
internalerror(2021010603);
if not assigned(fgenprocsymovldsderefs) then
internalerror(2021010302);
fgenprocsymovlds.clear;
for i:= 0 to fgenprocsymovldsderefs.count-1 do
begin
d.dataidx:=ptrint(fgenprocsymovldsderefs[i]);
sym:=tprocsym(d.resolve);
fgenprocsymovlds.add(sym);
end;
end;
end;
@ -1398,6 +1461,21 @@ implementation
end;
procedure tprocsym.add_generic_overload(sym:tprocsym);
var
i : longint;
begin
if not (sp_generic_dummy in symoptions) then
internalerror(2021010601);
if not assigned(fgenprocsymovlds) then
fgenprocsymovlds:=tfpobjectlist.create(false);
for i:=0 to genprocsymovlds.count-1 do
if tprocsym(genprocsymovlds[i])=sym then
exit;
genprocsymovlds.add(sym);
end;
{****************************************************************************
TERRORSYM
****************************************************************************}

18
compiler/utils/ppuutils/ppudump.pp
View File

@ -1706,8 +1706,12 @@ begin
if symoptions<>[] then
begin
if Def <> nil then
if sp_internal in symoptions then
Def.Visibility:=dvHidden;
begin
if sp_internal in symoptions then
Def.Visibility:=dvHidden;
if sp_generic_dummy in symoptions then
Def.GenericDummy:=true;
end;
first:=true;
for i:=1to symopts do
if (symopt[i].mask in symoptions) then
@ -3600,6 +3604,16 @@ begin
readderef('', def.Ref);
_finddef(def);
end;
if def.GenericDummy then
begin
len:=ppufile.getword;
for i:=1 to len do
begin
write([space,' Gen Ovld : ']);
readderef('',def.Ref);
_finddef(def);
end;
end;
end;
ibconstsym :

1
compiler/utils/ppuutils/ppuout.pp
View File

@ -127,6 +127,7 @@ type
// Symbol/definition reference
Ref: TPpuRef;
Visibility: TPpuDefVisibility;
GenericDummy: Boolean;
Attrs: array of TPpuAttr;
constructor Create(AParent: TPpuContainerDef); virtual; reintroduce;

2
packages/cocoaint/src/foundation/NSProcessInfo.inc
View File

@ -74,7 +74,7 @@ const
NSActivitySuddenTerminationDisabled = 1 shl 14;
NSActivityAutomaticTerminationDisabled = 1 shl 15;
NSActivityUserInitiated = $00FFFFFF + NSActivityIdleSystemSleepDisabled;
NSActivityUserInitiatedAllowingIdleSystemSleep = NSActivityUserInitiated and NSActivityIdleSystemSleepDisabled;
NSActivityUserInitiatedAllowingIdleSystemSleep = NSActivityUserInitiated and (not NSActivityIdleSystemSleepDisabled);
NSActivityBackground = $000000FF;
NSActivityLatencyCritical = $FF00000000;
{$endif}

2
rtl/objpas/classes/classesh.inc
View File

@ -1139,7 +1139,7 @@ type
function Read(var Buffer; Count: Longint): Longint; override;
function Write(const Buffer; Count: Longint): Longint; override;
function Seek(const Offset: int64; Origin: TSeekOrigin): int64; override;
procedure Check(err:integer); virtual;
procedure Check(err:integer); virtual; abstract;
end;
{ TOwnerStream }

8
rtl/objpas/classes/streams.inc
View File

@ -2038,12 +2038,4 @@ begin
Result := FStream;
end;
procedure TProxyStream.Check(err:integer);
var e : EInOutError;
begin
e:= EInOutError.Create('Proxystream.Check');
e.Errorcode:=err;
raise e;
end;
{$pop}

10
utils/fpdoc/dglobals.pp
View File

@ -162,7 +162,7 @@ resourcestring
SMDNavTree = ' UnitTree : put every units as a node on the same level as packages node';
SXMLUsageFlatStructure = 'Use a flat output structure of XML files and directories';
SXMLUsageSource = 'Include source file and line info in generated XML';
// Linear usage
@ -671,7 +671,7 @@ var
i: Integer;
begin
for i := 0 to FPackages.Count - 1 do
TPasPackage(FPackages[i]).Release;
TPasPackage(FPackages[i]).Release{$IFDEF CheckPasTreeRefCount}('TFPDocEngine.Destroy'){$ENDIF};
FreeAndNil(FRootDocNode);
FreeAndNil(FRootLinkNode);
FreeAndNil(DescrDocNames);
@ -807,6 +807,7 @@ var
Module := TPasExternalModule.Create(s, HPackage);
Module.InterfaceSection := TInterfaceSection.Create('', Module);
Module.PackageName:= HPackage.Name;
// Module.AddRef{$IFDEF CheckPasTreeRefCount}('ReadContentFile.ResolvePackageModule'){$ENDIF};
HPackage.Modules.Add(Module);
end;
pkg:=hpackage;
@ -867,6 +868,7 @@ var
// Create node for class
Result := TPasExternalClassType.Create(s, Module.InterfaceSection);
Result.ObjKind := okClass;
// Result.AddRef{$IFDEF CheckPasTreeRefCount}('ReadContentFile.ResolveAndLinkClass'){$ENDIF};
Module.InterfaceSection.Declarations.Add(Result);
Module.InterfaceSection.Classes.Add(Result);
// defer processing inheritancestr till all classes are loaded.
@ -895,7 +897,7 @@ var
result:=TPasClassType(ResolveClassType(clname));
if assigned(result) and not (cls=result) then // save from tobject=implicit tobject
begin
result.addref;
result.addref{$IFDEF CheckPasTreeRefCount}('ReadContentFile.ResolveAndLinkClass'){$ENDIF};
if IsClass then
begin
cls.ancestortype:=result;
@ -934,7 +936,7 @@ var
else
begin
// writeln('new alias ',clname,' (',s,') ');
cl2.addref;
cl2.addref{$IFDEF CheckPasTreeRefCount}('ReadContentFile.CreateAliasType'){$ENDIF};
Result := TPasAliasType(CreateElement(TPasAliasType,s,module.interfacesection,vispublic,'',0));
module.interfacesection.Declarations.Add(Result);
TPasAliasType(Result).DestType := cl2;

5
utils/fpdoc/dw_basemd.pp
View File

@ -21,8 +21,8 @@ uses
Classes, SysUtils, dwriter, DOM, pastree, dglobals;
Const
MaxIndents = 10;
MaxLists = 10;
MaxIndents = 32;
MaxLists = 32;
Type
THeaderLevel = 1..6;
@ -842,6 +842,7 @@ end;
destructor TBaseMarkdownWriter.Destroy;
begin
FreeAndNil(FMarkDown);
FreeAndNil(FMetadata);
inherited Destroy;
end;

2
utils/fpdoc/dw_html.pp
View File

@ -129,7 +129,7 @@ type
implementation
uses SysUtils, XMLRead, HTMWrite, sh_pas, fpdocclasstree;
uses SysUtils, HTMWrite, fpdocclasstree;
{$i css.inc}
{$i plusimage.inc}

17
utils/fpdoc/dw_markdown.pp
View File

@ -124,7 +124,6 @@ type
procedure WriteDocPage(const aFileName: String; aElement: TPasElement; aSubPageIndex: Integer); override;
// Start producing html complete package documentation
function ModuleForElement(AnElement:TPasElement):TPasModule;
Function InterPretOption(Const Cmd,Arg : String) : boolean; override;
Procedure WriteDoc; override;
@ -326,18 +325,6 @@ begin
Result:=FHeaderMarkDown;
end;
function TMarkdownWriter.ModuleForElement(AnElement:TPasElement):TPasModule;
begin
result:=TPasModule(AnElement);
while assigned(result) and not (result is TPasModule) do
result:=TPasModule(result.parent);
if not (result is TPasModule) then
result:=nil;
end;
procedure TMarkdownWriter.AppendShortDescr(AContext: TPasElement; DocNode: TDocNode) ;
Var
@ -715,7 +702,7 @@ begin
DescrEndTableCell;
DescrBeginTableCell;
DescrEl:=Engine.FindShortDescr(ModuleForElement(AElement),UTF8Encode(aList[i]));
DescrEl:=Engine.FindShortDescr(AElement.GetModule(),UTF8Encode(aList[i]));
if Assigned(DescrEl) then
ConvertShort(AElement, DescrEl)
else
@ -882,7 +869,7 @@ type
PE:=EN.Element;
DescrBeginListItem;
AppendHyperLink(PE);
PM:=ModuleForElement(PE);
PM:=PE.GetModule();
if (PM<>Nil) then
begin
AppendText(' (');

97
utils/fpdoc/dw_xml.pp
View File

@ -29,17 +29,34 @@ Type
{ TXMLWriter }
TXMLWriter = Class(TFPDocWriter)
TXMLWriter = Class(TMultiFileDocWriter)
private
FShowSourceInfo: Boolean;
FShowSourceInfo:Boolean;
FUseFlatStructure:Boolean;
protected
function CreateAllocator : TFileAllocator; override;
procedure AllocatePackagePages; override;
procedure AllocateModulePages(AModule: TPasModule; {%H-}LinkList: TObjectList); override;
procedure WriteDocPage(const aFileName: String; aElement: TPasElement; {%H-}aSubPageIndex: Integer); override;
public
constructor Create(APackage: TPasPackage; AEngine: TFPDocEngine); override;
function ModuleToXMLStruct(AModule: TPasModule): TXMLDocument;
Procedure WriteDoc; override;
class procedure Usage(List: TStrings); override;
function InterPretOption(const Cmd,Arg : String): boolean; override;
end;
{ TFlatFileAllocator }
TFlatFileAllocator = class(TFileAllocator)
private
FExtension: String;
public
constructor Create(const AExtension: String);
function GetFilename(AElement: TPasElement; ASubindex: Integer): String; override;
function GetRelativePathToTop(AElement: TPasElement): String; override;
property Extension: String read FExtension;
end;
implementation
@ -47,6 +64,31 @@ implementation
const
DefaultVisibility = [visDefault, visPublic, visPublished, visProtected];
{ TXmlFileAllocator }
constructor TFlatFileAllocator.Create(const AExtension: String);
begin
FExtension:= AExtension;
inherited Create();
end;
function TFlatFileAllocator.GetFilename(AElement: TPasElement; ASubindex: Integer
): String;
begin
Result:='';
if AElement.ClassType = TPasPackage then
Result := 'index'
else if AElement.ClassType = TPasModule then
Result := LowerCase(AElement.Name);
Result := Result + Extension;
end;
function TFlatFileAllocator.GetRelativePathToTop(AElement: TPasElement): String;
begin
Result:=inherited GetRelativePathToTop(AElement);
end;
function TXMLWriter.ModuleToXMLStruct(AModule: TPasModule): TXMLDocument;
var
@ -586,24 +628,59 @@ end;
{ TXMLWriter }
procedure TXMLWriter.WriteDoc;
begin
inherited WriteDoc;
end;
function TXMLWriter.CreateAllocator: TFileAllocator;
begin
if FUseFlatStructure then
Result:=TFlatFileAllocator.Create('.xml')
else
Result:=TLongNameFileAllocator.Create('.xml');
end;
procedure TXMLWriter.AllocatePackagePages;
var
H: Boolean;
begin
H:= false; // TODO: I want to public TreeClass for package
if H then
AddPage(Package,ClassHierarchySubIndex);
end;
procedure TXMLWriter.AllocateModulePages(AModule: TPasModule;
LinkList: TObjectList);
begin
if not assigned(Amodule.Interfacesection) then
exit;
AddPage(AModule, 0);
end;
procedure TXMLWriter.WriteDocPage(const aFileName: String;
aElement: TPasElement; aSubPageIndex: Integer);
var
doc: TXMLDocument;
i: Integer;
begin
if Engine.Output <> '' then
Engine.Output := IncludeTrailingBackSlash(Engine.Output);
for i := 0 to Package.Modules.Count - 1 do
if (aElement is TPasModule) then
begin
doc := ModuleToXMLStruct(TPasModule(Package.Modules[i]));
WriteXMLFile(doc, Engine.Output + TPasModule(Package.Modules[i]).Name + '.xml' );
doc := ModuleToXMLStruct(TPasModule(aElement));
WriteXMLFile(doc, GetFileBaseDir(Engine.Output) + aFileName);
doc.Free;
end;
end;
constructor TXMLWriter.Create(APackage: TPasPackage; AEngine: TFPDocEngine);
begin
FUseFlatStructure:= False;
FShowSourceInfo:= False;
inherited Create(APackage, AEngine);
end;
class procedure TXMLWriter.Usage(List: TStrings);
begin
List.AddStrings(['--source-info', SXMLUsageSource]);
List.AddStrings(['--flat-structure', SXMLUsageFlatStructure]);
end;
function TXMLWriter.InterPretOption(const Cmd, Arg: String): boolean;
@ -611,6 +688,8 @@ begin
Result := True;
if Cmd = '--source-info' then
FShowSourceInfo:=True
else if Cmd = '--flat-structure' then
FUseFlatStructure:=True
else
Result:=inherited InterPretOption(Cmd, Arg);
end;

7
utils/fpdoc/dwriter.pp
View File

@ -282,7 +282,7 @@ Type
procedure AllocateClassMemberPages(AModule: TPasModule; LinkList: TObjectList); virtual;
procedure AllocateModulePages(AModule: TPasModule; LinkList: TObjectList); virtual;
procedure AllocatePackagePages; virtual;
// Prefix every filename generated with the eesult of this.
// Prefix every filename generated with the result of this.
function GetFileBaseDir(aOutput: String): String; virtual;
function ModuleHasClasses(AModule: TPasModule): Boolean;
@ -310,7 +310,6 @@ function MethodFilter(AMember: TPasElement): Boolean;
function EventFilter(AMember: TPasElement): Boolean;
// Register backend
Procedure RegisterWriter(AClass : TFPDocWriterClass; Const AName,ADescr : String);
// UnRegister backend
@ -398,7 +397,6 @@ constructor TMultiFileDocWriter.Create(APackage: TPasPackage;
AEngine: TFPDocEngine);
begin
inherited Create(APackage, AEngine);
FAllocator:=CreateAllocator;
FPageInfos:=TFPObjectList.Create;
end;
@ -721,7 +719,7 @@ end;
function TMultiFileDocWriter.GetFileBaseDir(aOutput: String) : String;
begin
Result:=Engine.Output;
Result:=aOutput;
if Result<>'' then
Result:=IncludeTrailingPathDelimiter(Result);
end;
@ -759,6 +757,7 @@ var
FinalFilename: String;
begin
FAllocator:=CreateAllocator;
AllocatePages;
DoLog(SWritingPages, [PageCount]);
if Engine.Output <> '' then