Browse Source

* synchronized with trunk

git-svn-id: branches/wasm@46746 -
nickysn 5 years ago
parent
commit
68d22e6e09

+ 3 - 1
packages/pastojs/src/fppas2js.pp

@@ -13312,7 +13312,7 @@ begin
     {$IFDEF VerbosePas2JS}
     writeln('TPasToJSConverter.ConvertBuiltInConcatArray Count=',length(El.Params));
     {$ENDIF}
-    Result:=ConvertExpression(Param0,AContext);
+    Result:=CreateArrayRef(El,ConvertExpression(Param0,AContext));
     end
   else
     begin
@@ -17431,6 +17431,8 @@ function TPasToJSConverter.CreateArrayRef(El: TPasElement; ArrayExpr: TJSElement
 var
   Call: TJSCallExpression;
 begin
+  if ArrayExpr is TJSArrayLiteral then
+    exit(ArrayExpr);
   Call:=CreateCallExpression(El);
   Call.Expr:=CreateMemberExpression([GetBIName(pbivnRTL),GetBIName(pbifnArray_Reference)]);
   Call.AddArg(ArrayExpr);

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

@@ -9855,16 +9855,16 @@ begin
     'this.ArrJSValue = [];',
     '']),
     LinesToStr([ // $mod.$main
-    '$mod.ArrInt = $mod.ArrInt;',
+    '$mod.ArrInt = rtl.arrayRef($mod.ArrInt);',
     '$mod.ArrInt = rtl.arrayConcatN($mod.ArrInt, $mod.ArrInt);',
     '$mod.ArrInt = rtl.arrayConcatN($mod.ArrInt, $mod.ArrInt, $mod.ArrInt);',
-    '$mod.ArrRec = $mod.ArrRec;',
+    '$mod.ArrRec = rtl.arrayRef($mod.ArrRec);',
     '$mod.ArrRec = rtl.arrayConcat($mod.TRec, $mod.ArrRec, $mod.ArrRec);',
     '$mod.ArrRec = rtl.arrayConcat($mod.TRec, $mod.ArrRec, $mod.ArrRec, $mod.ArrRec);',
-    '$mod.ArrSet = $mod.ArrSet;',
+    '$mod.ArrSet = rtl.arrayRef($mod.ArrSet);',
     '$mod.ArrSet = rtl.arrayConcat("refSet", $mod.ArrSet, $mod.ArrSet);',
     '$mod.ArrSet = rtl.arrayConcat("refSet", $mod.ArrSet, $mod.ArrSet, $mod.ArrSet);',
-    '$mod.ArrJSValue = $mod.ArrJSValue;',
+    '$mod.ArrJSValue = rtl.arrayRef($mod.ArrJSValue);',
     '$mod.ArrJSValue = rtl.arrayConcatN($mod.ArrJSValue, $mod.ArrJSValue);',
     '$mod.ArrJSValue = rtl.arrayConcatN($mod.ArrJSValue, $mod.ArrJSValue, $mod.ArrJSValue);',
     '$mod.ArrInt = rtl.arrayConcatN([1], $mod.ArrInt);',

+ 5 - 5
rtl/freertos/system.pp

@@ -295,8 +295,8 @@ begin
     programs this does not matter because in the main thread, the variables are located
     in bss
 
-    SysInitExceptions;
   }
+  SysInitExceptions;
 {$endif FPC_HAS_FEATURE_EXCEPTIONS}
 
 {$ifdef FPC_HAS_FEATURE_CONSOLEIO}
@@ -304,12 +304,12 @@ begin
   InOutRes:=0;
 {$endif FPC_HAS_FEATURE_CONSOLEIO}
 
-{$ifdef FPC_HAS_FEATURE_THREADING}
+{ $ifdef FPC_HAS_FEATURE_THREADING}
   { threading }
-  //InitSystemThreads; // Empty call for embedded anyway
-{$endif FPC_HAS_FEATURE_THREADING}
+  InitSystemThreads;
+{ $endif FPC_HAS_FEATURE_THREADING}
 
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
-//  initunicodestringmanager;
+  initunicodestringmanager;
 {$endif FPC_HAS_FEATURE_WIDESTRINGS}
 end.

+ 109 - 3
rtl/freertos/systhrd.inc

@@ -3,7 +3,7 @@
     Copyright (c) 2002 by Peter Vreman,
     member of the Free Pascal development team.
 
-    Embedded empty threading support implementation
+    FreeRTOS threading support implementation
 
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
@@ -14,8 +14,114 @@
 
  **********************************************************************}
 
+{ resourcestrings are not supported by the system unit,
+  they are in the objpas unit and not available for fpc/tp modes }
+const
+  SNoThreads = 'This binary has no thread support compiled in.';
+  SRecompileWithThreads = 'Recompile the application with a thread-driver in the program uses clause before other units using thread.';
+
+Procedure NoThreadError;
+  begin
+  {$ifdef FPC_HAS_FEATURE_CONSOLEIO}
+    If IsConsole then
+      begin
+      Writeln(StdErr,SNoThreads);
+      Writeln(StdErr,SRecompileWithThreads);
+      end;
+  {$endif FPC_HAS_FEATURE_CONSOLEIO}
+    RunError(232)
+  end;
+
+
+function  NoGetCurrentThreadId : TThreadID;
+  begin
+    if IsMultiThread then
+      NoThreadError
+    else
+      ThreadingAlreadyUsed:=true;
+    result:=TThreadID(1);
+  end;
+
+
+function NoBeginThread(sa : Pointer;stacksize : PtrUInt;
+                     ThreadFunction : tthreadfunc;p : pointer;
+                     creationFlags : dword; var ThreadId : TThreadID) : TThreadID;
+  begin
+    NoThreadError;
+    result:=tthreadid(-1);
+  end;
+
+
+procedure SysInitCriticalSection(var cs);
+  begin
+  end;
+
+
+procedure SysDoneCriticalSection(var cs);
+  begin
+  end;
+
+
+procedure SysEnterCriticalSection(var cs);
+  begin
+  end;
+
+
+function SysTryEnterCriticalSection(var cs):longint;
+  begin
+  end;
+
+
+procedure SysLeaveCriticalSection(var cs);
+  begin
+  end;
+
+const
+  FreeRTOSThreadManager : TThreadManager = (
+    InitManager            : Nil;
+    DoneManager            : Nil;
+    { while this is pretty hacky, it reduces the size of typical embedded programs
+     and works fine on arm and avr }
+    BeginThread            : @NoBeginThread;
+    EndThread              : TEndThreadHandler(@NoThreadError);
+    SuspendThread          : TThreadHandler(@NoThreadError);
+    ResumeThread           : TThreadHandler(@NoThreadError);
+    KillThread             : TThreadHandler(@NoThreadError);
+    CloseThread            : TThreadHandler(@NoThreadError);
+    ThreadSwitch           : TThreadSwitchHandler(@NoThreadError);
+    WaitForThreadTerminate : TWaitForThreadTerminateHandler(@NoThreadError);
+    ThreadSetPriority      : TThreadSetPriorityHandler(@NoThreadError);
+    ThreadGetPriority      : TThreadGetPriorityHandler(@NoThreadError);
+    GetCurrentThreadId     : @NoGetCurrentThreadId;
+    SetThreadDebugNameA    : TThreadSetThreadDebugNameHandlerA(@NoThreadError);
+    {$ifdef FPC_HAS_FEATURE_UNICODESTRINGS}
+    SetThreadDebugNameU    : TThreadSetThreadDebugNameHandlerU(@NoThreadError);
+    {$endif FPC_HAS_FEATURE_UNICODESTRINGS}
+    InitCriticalSection    : @SysInitCriticalSection;
+    DoneCriticalSection    : @SysDoneCriticalSection;
+    EnterCriticalSection   : @SysEnterCriticalSection;
+    TryEnterCriticalSection: @SysTryEnterCriticalSection;
+    LeaveCriticalSection   : @SysLeaveCriticalSection;
+    InitThreadVar          : TInitThreadVarHandler(@NoThreadError);
+    RelocateThreadVar      : TRelocateThreadVarHandler(@NoThreadError);
+    AllocateThreadVars     : @NoThreadError;
+    ReleaseThreadVars      : @NoThreadError;
+    BasicEventCreate       : TBasicEventCreateHandler(@NoThreadError);
+    BasicEventdestroy      : TBasicEventHandler(@NoThreadError);
+    BasicEventResetEvent   : TBasicEventHandler(@NoThreadError);
+    BasicEventSetEvent     : TBasicEventHandler(@NoThreadError);
+    BasicEventWaitFor      : TBasicEventWaitForHandler(@NoThreadError);
+    RTLEventCreate         : TRTLCreateEventHandler(@NoThreadError);
+    RTLEventdestroy        : TRTLEventHandler(@NoThreadError);
+    RTLEventSetEvent       : TRTLEventHandler(@NoThreadError);
+    RTLEventResetEvent     : TRTLEventHandler(@NoThreadError);
+    RTLEventWaitFor        : TRTLEventHandler(@NoThreadError);
+    RTLEventwaitfortimeout : TRTLEventHandlerTimeout(@NoThreadError);
+  );
+
 Procedure InitSystemThreads;
-begin
-end;
+  begin
+    SetThreadManager(FreeRTOSThreadManager);
+  end;
 
 

+ 8 - 8
rtl/objpas/sysutils/sysutils.inc

@@ -39,7 +39,7 @@
 
   { variant error codes }
   {$i varerror.inc}
-  
+
   { Type helpers}
   {$i syshelp.inc}
 
@@ -144,7 +144,7 @@ end;
   {$i sysuni.inc}
   {$i sysencoding.inc}
 {$endif FPC_HAS_UNICODESTRING}
-  
+
   { threading stuff }
   {$i sysuthrd.inc}
 
@@ -161,7 +161,7 @@ end;
       end;
 
     procedure FreeMemAndNil(var p);
-    
+
     var
       temp:Pointer;
     begin
@@ -169,7 +169,7 @@ end;
       Pointer(P):=nil;
       FreeMem(temp);
     end;
-    
+
   { Interfaces support }
   {$i sysuintf.inc}
 
@@ -300,7 +300,7 @@ Procedure CatchUnhandledException (Obj : TObject; Addr: CodePointer; FrameCount:
 Var
   i : longint;
   hstdout : ^text;
-  
+
 begin
   if WriteErrorsToStdErr then
     hstdout:=@stderr
@@ -802,7 +802,7 @@ begin
 end;
 
 function ExecuteProcess(Const Path: UnicodeString; Const ComLine: Array of UnicodeString;Flags:TExecuteFlags=[]):integer;
-var 
+var
   ComLineA : array of RawByteString;
   I        : Integer;
 begin
@@ -818,9 +818,9 @@ end;
 {$IFNDEF VER3_0}
 generic function IfThen<T>(val:boolean;const iftrue:T; const iffalse:T) :T; inline; overload;
 begin
-  if val then 
+  if val then
     Result := ifTrue
   else
-    Result:=ifFalse;  
+    Result:=ifFalse;
 end;
 {$ENDIF}

+ 2 - 2
utils/pas2js/dist/rtl.js

@@ -999,11 +999,11 @@ var rtl = {
 
   arrayConcatN: function(){
     var a = null;
-    for (var i=1; i<arguments.length; i++){
+    for (var i=0; i<arguments.length; i++){
       var src = arguments[i];
       if (src === null) continue;
       if (a===null){
-        a=src; // Note: concat(a) does not clone
+        a=rtl.arrayRef(src); // Note: concat(a) does not clone
       } else {
         a=a.concat(src);
       }