Browse Source

* synchronized with trunk

git-svn-id: branches/wasm@46729 -
nickysn 5 years ago
parent
commit
851d23edba

+ 7 - 0
.gitattributes

@@ -13561,6 +13561,13 @@ tests/test/cg/obj/freebsd/x86_64/tcext3.o -text
 tests/test/cg/obj/freebsd/x86_64/tcext4.o -text
 tests/test/cg/obj/freebsd/x86_64/tcext5.o -text
 tests/test/cg/obj/freebsd/x86_64/tcext6.o -text
+tests/test/cg/obj/freertos/xtensa-windowed/cpptcl1.o -text
+tests/test/cg/obj/freertos/xtensa-windowed/cpptcl2.o -text
+tests/test/cg/obj/freertos/xtensa-windowed/ctest.o -text
+tests/test/cg/obj/freertos/xtensa-windowed/tcext3.o -text
+tests/test/cg/obj/freertos/xtensa-windowed/tcext4.o -text
+tests/test/cg/obj/freertos/xtensa-windowed/tcext5.o -text
+tests/test/cg/obj/freertos/xtensa-windowed/tcext6.o -text
 tests/test/cg/obj/go32v2/i386/cpptcl1.o -text
 tests/test/cg/obj/go32v2/i386/cpptcl2.o -text
 tests/test/cg/obj/go32v2/i386/ctest.o -text

+ 2 - 2
compiler/systems/i_freertos.pas

@@ -708,8 +708,8 @@ unit i_freertos;
                 localalignmin   : 4;
                 localalignmax   : 16;
                 recordalignmin  : 0;
-                recordalignmax  : 4;
-                maxCrecordalign : 4
+                recordalignmax  : 8;
+                maxCrecordalign : 8
               );
             first_parm_offset : 8;
             stacksize    : 65536;

+ 27 - 1
compiler/xtensa/cpupara.pas

@@ -40,6 +40,7 @@ unit cpupara;
          function create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;override;
          function create_varargs_paraloc_info(p : tabstractprocdef; side: tcallercallee; varargspara:tvarargsparalist):longint;override;
          function get_funcretloc(p : tabstractprocdef; side: tcallercallee; forcetempdef: tdef): tcgpara;override;
+         function ret_in_param(def: tdef; pd: tabstractprocdef): boolean;override;
        private
          { the max. register depends on the used call instruction }
          maxintreg : TSuperRegister;
@@ -145,7 +146,6 @@ unit cpupara;
             exit;
           end;
         case def.typ of
-          variantdef,
           formaldef :
             result:=true;
           recorddef :
@@ -157,6 +157,7 @@ unit cpupara;
                              is_array_constructor(def);
           objectdef :
             result:=is_object(def) and (varspez = vs_const);
+          variantdef,
           setdef :
             result:=(varspez = vs_const);
           stringdef :
@@ -265,6 +266,31 @@ unit cpupara;
       end;
 
 
+    function tcpuparamanager.ret_in_param(def:tdef;pd:tabstractprocdef):boolean;
+      var
+        i: longint;
+        sym: tsym;
+        basedef: tdef;
+      begin
+        if handle_common_ret_in_param(def,pd,result) then
+          exit;
+        case def.typ of
+          arraydef,
+          objectdef,
+          stringdef,
+          setdef,
+          recorddef:
+            result:=def.size>16;
+          floatdef,
+          variantdef,
+          procvardef:
+            result:=false
+          else
+            result:=inherited ret_in_param(def,pd);
+        end;
+      end;
+
+
     function tcpuparamanager.create_paraloc_info(p : tabstractprocdef; side: tcallercallee):longint;
 
       var

+ 6 - 1
compiler/xtensa/ncpuadd.pas

@@ -390,7 +390,12 @@ interface
             op:=A_MUL;
           subn :
             op:=A_SUB;
-          unequaln,
+          unequaln:
+            begin
+              op:=A_OEQ;
+              cmpop:=true;
+              inv:=true;
+            end;
           equaln:
             begin
               op:=A_OEQ;

+ 27 - 4
packages/fcl-report/src/fpreport.pp

@@ -247,6 +247,8 @@ const
        bmOncePerDataloop,bmOncePerPage,bmOncePerPage,bmOncePerPage,
        bmUnrestricted);
 
+  DefaultImageType = 'png';
+
 const
   cMMperInch = 25.4;
   cCMperInch = 2.54;
@@ -2090,10 +2092,12 @@ type
     FImage: TFPCustomImage;
     FStretched: boolean;
     FFieldName: TFPReportString;
+    FDBImageType : TFPReportString;
     FImageID: integer;
     procedure   SetImage(AValue: TFPCustomImage);
     procedure   SetStretched(AValue: boolean);
-    procedure   SetFieldName(AValue: TFPReportString);
+    procedure   SetFieldName(AValue: TFPReportString); 
+    procedure   SetDBImageType(AValue: TFPReportString);
     procedure   LoadDBData(AData: TFPReportData);
     procedure   SetImageID(AValue: integer);
     function    GetImage: TFPCustomImage;
@@ -2105,6 +2109,7 @@ type
     property    ImageID: integer read FImageID write SetImageID;
     property    Stretched: boolean read FStretched write SetStretched;
     property    FieldName: TFPReportString read FFieldName write SetFieldName;
+    property    DBImageType : TFPReportString read FDBImageType write SetDBImageType;
   public
     constructor Create(AOwner: TComponent); override;
     destructor  Destroy; override;
@@ -2126,6 +2131,7 @@ type
     property    ImageID;
     property    Stretched;
     property    FieldName;
+    property    DBImageType;
     property    OnBeforePrint;
   end;
 
@@ -5331,6 +5337,14 @@ begin
   Changed;
 end;
 
+procedure TFPReportCustomImage.SetDBImageType(AValue: TFPReportString);
+begin
+  if FDBImageType = AValue then
+    exit;
+  FDBImageType := AValue;
+  Changed;
+end;
+
 function TryVarByteArrayToStream(var AValue : Variant; Stream : TMemoryStream) : boolean;
 var
   p : Pointer;
@@ -5357,6 +5371,7 @@ var
   v : Variant;
   s: string;
   lStream: TMemoryStream;
+  irc : TFPCustomImageReaderClass;
 begin
   v := AData.FieldValues[FFieldName];
   lStream := TMemoryStream.Create;
@@ -5366,7 +5381,11 @@ begin
       s := v;
       FPReportMIMEEncodeStringToStream(s, lStream);
     end;
-    LoadPNGFromStream(lStream)
+    s := Trim(DBImageType);
+    if (s = '') then
+      s := DefaultImageType;
+    irc := TFPCustomImage.FindReaderFromExtension(s);
+    LoadFromStream(lStream,irc);
   finally
     lStream.Free;
   end;
@@ -5415,7 +5434,8 @@ begin
   idx := TFPReportCustomBand(Parent).Page.Report.Images.GetIndexFromID(ImageID);
   AWriter.WriteInteger('ImageIndex', idx);
   AWriter.WriteBoolean('Stretched', Stretched);
-  AWriter.WriteString('FieldName', FieldName);
+  AWriter.WriteString('FieldName', FieldName);  
+  AWriter.WriteString('DBImageType', DBImageType);
 end;
 
 procedure TFPReportCustomImage.RecalcLayout;
@@ -5455,6 +5475,7 @@ begin
   FImage := nil;
   FStretched := False;
   FImageID := -1;
+  FDBImageType := DefaultImageType;
 end;
 
 destructor TFPReportCustomImage.Destroy;
@@ -5494,6 +5515,7 @@ begin
     end;
     FStretched := i.Stretched;
     FFieldName := i.FieldName;
+    FDBImageType := i.DBImageType;
     FImageID := i.ImageID;
   end;
 end;
@@ -5504,7 +5526,8 @@ begin
   { See code comments in DoWriteLocalProperties() }
   ImageID := AReader.ReadInteger('ImageIndex', -1);
   Stretched := AReader.ReadBoolean('Stretched', Stretched);
-  FieldName := AReader.ReadString('FieldName', FieldName);
+  FieldName := AReader.ReadString('FieldName', FieldName);  
+  DBImageType := AReader.ReadString('DBImageType', DBImageType);
 end;
 
 procedure TFPReportCustomImage.LoadFromFile(const AFileName: string);

+ 29 - 63
packages/pastojs/src/fppas2js.pp

@@ -472,7 +472,7 @@ uses
   {$endif}
   Classes, SysUtils, math, contnrs,
   jsbase, jstree, jswriter,
-  PasTree, PScanner, PasResolveEval, PasResolver, PasUseAnalyzer;
+  PasTree, PScanner, PasResolveEval, PasResolver;
 
 // message numbers
 const
@@ -621,7 +621,6 @@ type
     pbifnRecordAssign,
     pbifnRecordClone,
     pbifnRecordCreateType,
-    pbifnRecordCreateSpecializeType,
     pbifnRecordEqual,
     pbifnRecordNew,
     pbifnRTTIAddField, // typeinfos of tkclass and tkrecord have addField
@@ -802,7 +801,6 @@ const
     '$assign', // pbifnRecordAssign
     '$clone', // pbifnRecordClone
     'recNewT', // pbifnRecordCreateType
-    'recNewS', // pbifnRecordCreateSpecializeType
     '$eq', // pbifnRecordEqual
     '$new', // pbifnRecordNew
     'addField', // pbifnRTTIAddField
@@ -1378,14 +1376,17 @@ type
 
   TPas2JSResolverHub = class(TPasResolverHub)
   private
-    FJSSpecialized: TPasAnalyzerKeySet; // set of TPasGenericType
+    FJSDelaySpecialize: TFPList;// list of TPasGenericType
+    function GetJSDelaySpecializes(Index: integer): TPasGenericType;
   public
     constructor Create(TheOwner: TObject); override;
     destructor Destroy; override;
     procedure Reset; override;
     // delayed type specialization
-    procedure AddJSSpecialized(SpecType: TPasGenericType);
-    function IsJSSpecialized(SpecType: TPasGenericType): boolean;
+    procedure AddJSDelaySpecialize(SpecType: TPasGenericType);
+    function IsJSDelaySpecialize(SpecType: TPasGenericType): boolean;
+    function JSDelaySpecializeCount: integer;
+    property JSDelaySpecializes[Index: integer]: TPasGenericType read GetJSDelaySpecializes;
   end;
 
   { TPas2JSResolver }
@@ -1922,7 +1923,6 @@ type
     Function CreateVarStatement(const aName: String; Init: TJSElement;
       El: TPasElement): TJSVariableStatement; virtual;
     Function CreateVarDecl(const aName: String; Init: TJSElement; El: TPasElement): TJSVarDeclaration; virtual;
-    Procedure InitJSSpecialization(aType: TPasType; AContext: TConvertContext; ErrorEl: TPasElement); virtual;
     // JS literals
     Function CreateLiteralNumber(El: TPasElement; const n: TJSNumber): TJSLiteral; virtual;
     Function CreateLiteralHexNumber(El: TPasElement; const n: TMaxPrecInt; Digits: byte): TJSLiteral; virtual;
@@ -2335,32 +2335,45 @@ end;
 
 { TPas2JSResolverHub }
 
+function TPas2JSResolverHub.GetJSDelaySpecializes(Index: integer
+  ): TPasGenericType;
+begin
+  Result:=TPasGenericType(FJSDelaySpecialize[Index]);
+end;
+
 constructor TPas2JSResolverHub.Create(TheOwner: TObject);
 begin
   inherited Create(TheOwner);
-  FJSSpecialized:=CreatePasElementSet;
+  FJSDelaySpecialize:=TFPList.Create;
 end;
 
 destructor TPas2JSResolverHub.Destroy;
 begin
-  FreeAndNil(FJSSpecialized);
+  FreeAndNil(FJSDelaySpecialize);
   inherited Destroy;
 end;
 
 procedure TPas2JSResolverHub.Reset;
 begin
   inherited Reset;
+  FJSDelaySpecialize.Clear;
 end;
 
-procedure TPas2JSResolverHub.AddJSSpecialized(SpecType: TPasGenericType);
+procedure TPas2JSResolverHub.AddJSDelaySpecialize(SpecType: TPasGenericType);
 begin
-  if FJSSpecialized.FindItem(SpecType)=nil then
-    FJSSpecialized.Add(SpecType,false);
+  if FJSDelaySpecialize.IndexOf(SpecType)>=0 then
+    raise EPas2JS.Create('TPas2JSResolverHub.AddJSDelaySpecialize '+GetObjPath(SpecType));
+  FJSDelaySpecialize.Add(SpecType);
 end;
 
-function TPas2JSResolverHub.IsJSSpecialized(SpecType: TPasGenericType): boolean;
+function TPas2JSResolverHub.IsJSDelaySpecialize(SpecType: TPasGenericType): boolean;
 begin
-  Result:=FJSSpecialized.FindItem(SpecType)<>nil;
+  Result:=FJSDelaySpecialize.IndexOf(SpecType)>=0;
+end;
+
+function TPas2JSResolverHub.JSDelaySpecializeCount: integer;
+begin
+  Result:=FJSDelaySpecialize.Count;
 end;
 
 { TPas2JSModuleScope }
@@ -22624,53 +22637,6 @@ begin
   Result.Init:=Init;
 end;
 
-procedure TPasToJSConverter.InitJSSpecialization(aType: TPasType;
-  AContext: TConvertContext; ErrorEl: TPasElement);
-var
-  aResolver: TPas2JSResolver;
-  SpecTypeData: TPasSpecializeTypeData;
-  Hub: TPas2JSResolverHub;
-  SpecType: TPasGenericType;
-  C: TClass;
-  FuncCtx: TFunctionContext;
-  SrcEl: TJSSourceElements;
-begin
-  while aType<>nil do
-    begin
-    C:=aType.ClassType;
-    if C=TPasAliasType then
-      aType:=TPasAliasType(aType).DestType
-    else if C=TPasSpecializeType then
-      begin
-      // specialized type
-      SpecTypeData:=aType.CustomData as TPasSpecializeTypeData;
-      if SpecTypeData=nil then
-        RaiseNotSupported(aType,AContext,20200815210904);
-      aResolver:=AContext.Resolver;
-      Hub:=TPas2JSResolverHub(aResolver.Hub);
-      SpecType:=SpecTypeData.SpecializedType;
-      if Hub.IsJSSpecialized(SpecType) then exit;
-      Hub.AddJSSpecialized(SpecType);
-      FuncCtx:=AContext.GetGlobalFunc;
-      SrcEl:=FuncCtx.JSElement as TJSSourceElements;
-
-      if SrcEl=nil then ;
-
-      if SpecType is TPasRecordType then
-        begin
-        // add $mod.TAnt$G1();
-        //CreateReferencePath();
-        RaiseNotSupported(ErrorEl,AContext,20200815215652);
-        end
-      else
-        RaiseNotSupported(ErrorEl,AContext,20200815215338);
-      exit;
-      end
-    else
-      exit;
-    end;
-end;
-
 function TPasToJSConverter.CreateLiteralNumber(El: TPasElement;
   const n: TJSNumber): TJSLiteral;
 begin
@@ -24789,8 +24755,8 @@ begin
     if RecScope.SpecializedFromItem<>nil then
       begin
       // ToDo
-      //if aResolver.SpecializeNeedsDelay(RecScope.SpecializedFromItem)<>nil then
-        //bifn:=pbifnRecordCreateSpecializeType;
+      if aResolver.SpecializeNeedsDelay(RecScope.SpecializedFromItem)<>nil then
+        ;//bifn:=pbifnRecordCreateSpecializeType;
       end;
 
     Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTL),GetBIName(bifn)]);

+ 1 - 1
packages/pastojs/tests/tcmodules.pas

@@ -30362,7 +30362,7 @@ begin
   ConvertProgram;
   CheckSource('TestRTTI_TypeInfo_ExtTypeInfoClasses2',
     LinesToStr([ // statements
-    '  $mod.$rtti.$StaticArray("TStaticArr", {',
+    '$mod.$rtti.$StaticArray("TStaticArr", {',
     '  dims: [2],',
     '  eltype: rtl.string',
     '});',

BIN
tests/test/cg/obj/freertos/xtensa-windowed/cpptcl1.o


BIN
tests/test/cg/obj/freertos/xtensa-windowed/cpptcl2.o


BIN
tests/test/cg/obj/freertos/xtensa-windowed/ctest.o


BIN
tests/test/cg/obj/freertos/xtensa-windowed/tcext3.o


BIN
tests/test/cg/obj/freertos/xtensa-windowed/tcext4.o


BIN
tests/test/cg/obj/freertos/xtensa-windowed/tcext5.o


BIN
tests/test/cg/obj/freertos/xtensa-windowed/tcext6.o


+ 0 - 7
utils/pas2js/dist/rtl.js

@@ -473,13 +473,6 @@ var rtl = {
     return t;
   },
 
-  recNewS: function(parent,name,initfn,full){
-    // register specialized record type
-    parent[name] = function(){
-      rtl.recNewT(parent,name,initfn,full);
-    }
-  },
-
   is: function(instance,type){
     return type.isPrototypeOf(instance) || (instance===type);
   },

+ 2 - 1
utils/pas2js/docs/translation.html

@@ -1947,7 +1947,7 @@ function(){
     <div class="section">
     <h2 id="attributes">Translating attributes</h2>
     Attributes are stored in the TTypeInfo objects as streams stored in an array.
-    See the <i>TypInfo</i> function <i>GetRTTIAttributes</i> for details.
+    See the function <i>GetRTTIAttributes</i> in unit <i>TypInfo</i> for details.
     </div>
 
     <div class="section">
@@ -3326,6 +3326,7 @@ end.
     <li><i>function concat(string1,string2,...): string</i> since 1.3</li>
     <li><i>$mode delphi: function lo|hi(integer): byte</i> since 1.3</li>
     <li><i>$mode objfpc: function lo|hi(integer): byte|word|longword</i> since 1.3</li>
+    <li><i>function GetTypeKind(Type or Var): TTypeKind;</i> since 1.5</li>
     </ul>
     </div>