Browse Source

* synchronized with trunk

git-svn-id: branches/wasm@48102 -
nickysn 4 years ago
parent
commit
ed26d54e3b

+ 5 - 4
compiler/llvm/hlcgllvm.pas

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

+ 1 - 1
compiler/ncgcon.pas

@@ -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 - 0
compiler/pdecsub.pas

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

+ 1 - 1
compiler/ppu.pas

@@ -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 - 0
compiler/symsym.pas

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

+ 16 - 2
compiler/utils/ppuutils/ppudump.pp

@@ -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 - 0
compiler/utils/ppuutils/ppuout.pp

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

+ 1 - 1
packages/cocoaint/src/foundation/NSProcessInfo.inc

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

+ 1 - 1
rtl/objpas/classes/classesh.inc

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

+ 0 - 8
rtl/objpas/classes/streams.inc

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

+ 6 - 4
utils/fpdoc/dglobals.pp

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

+ 3 - 2
utils/fpdoc/dw_basemd.pp

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

+ 1 - 1
utils/fpdoc/dw_html.pp

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

+ 2 - 15
utils/fpdoc/dw_markdown.pp

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

+ 88 - 9
utils/fpdoc/dw_xml.pp

@@ -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
-  doc: TXMLDocument;
-  i: Integer;
+  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 Engine.Output <> '' then
-    Engine.Output := IncludeTrailingBackSlash(Engine.Output);
+  if not assigned(Amodule.Interfacesection) then
+    exit;
+  AddPage(AModule, 0);
+end;
 
-  for i := 0 to Package.Modules.Count - 1 do
+procedure TXMLWriter.WriteDocPage(const aFileName: String;
+  aElement: TPasElement; aSubPageIndex: Integer);
+var
+  doc: TXMLDocument;
+begin
+  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;

+ 3 - 4
utils/fpdoc/dwriter.pp

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