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

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

@@ -9855,16 +9855,16 @@ begin
     'this.ArrJSValue = [];',
     'this.ArrJSValue = [];',
     '']),
     '']),
     LinesToStr([ // $mod.$main
     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 = rtl.arrayConcatN($mod.ArrInt, $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 = rtl.arrayConcat($mod.TRec, $mod.ArrRec, $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 = rtl.arrayConcat("refSet", $mod.ArrSet, $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 = rtl.arrayConcatN($mod.ArrJSValue, $mod.ArrJSValue, $mod.ArrJSValue);',
     '$mod.ArrJSValue = rtl.arrayConcatN($mod.ArrJSValue, $mod.ArrJSValue, $mod.ArrJSValue);',
     '$mod.ArrInt = rtl.arrayConcatN([1], $mod.ArrInt);',
     '$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
     programs this does not matter because in the main thread, the variables are located
     in bss
     in bss
 
 
-    SysInitExceptions;
   }
   }
+  SysInitExceptions;
 {$endif FPC_HAS_FEATURE_EXCEPTIONS}
 {$endif FPC_HAS_FEATURE_EXCEPTIONS}
 
 
 {$ifdef FPC_HAS_FEATURE_CONSOLEIO}
 {$ifdef FPC_HAS_FEATURE_CONSOLEIO}
@@ -304,12 +304,12 @@ begin
   InOutRes:=0;
   InOutRes:=0;
 {$endif FPC_HAS_FEATURE_CONSOLEIO}
 {$endif FPC_HAS_FEATURE_CONSOLEIO}
 
 
-{$ifdef FPC_HAS_FEATURE_THREADING}
+{ $ifdef FPC_HAS_FEATURE_THREADING}
   { threading }
   { threading }
-  //InitSystemThreads; // Empty call for embedded anyway
-{$endif FPC_HAS_FEATURE_THREADING}
+  InitSystemThreads;
+{ $endif FPC_HAS_FEATURE_THREADING}
 
 
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
 {$ifdef FPC_HAS_FEATURE_WIDESTRINGS}
-//  initunicodestringmanager;
+  initunicodestringmanager;
 {$endif FPC_HAS_FEATURE_WIDESTRINGS}
 {$endif FPC_HAS_FEATURE_WIDESTRINGS}
 end.
 end.

+ 109 - 3
rtl/freertos/systhrd.inc

@@ -3,7 +3,7 @@
     Copyright (c) 2002 by Peter Vreman,
     Copyright (c) 2002 by Peter Vreman,
     member of the Free Pascal development team.
     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,
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
     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;
 Procedure InitSystemThreads;
-begin
-end;
+  begin
+    SetThreadManager(FreeRTOSThreadManager);
+  end;
 
 
 
 

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

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

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

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