* synchronized with trunk

git-svn-id: branches/wasm@48248 -

compiler/armgen/aoptarm.pas

@@ -531,6 +531,11 @@ Implementation
                               { Instruction will become mov r1,r1 }
                               DebugMsg('Peephole Optimization: Mov2None 2 done', next_hp);
 
+                              { Allocate r1 between the instructions; not doing
+                                so may cause problems when removing superfluous
+                                MOVs later (i38055) }
+                              AllocRegBetween(taicpu(p).oper[1]^.reg, p, next_hp, UsedRegs);
+
                               if (next_hp = hp1) then
                                 { Don't let hp1 become a dangling pointer }
                                 hp1 := nil;

compiler/options.pas

@@ -1830,6 +1830,7 @@ begin
                   exclude(init_settings.globalswitches,cs_use_heaptrc);
                   exclude(init_settings.globalswitches,cs_use_lineinfo);
                   exclude(init_settings.localswitches,cs_checkpointer);
+                  paratargetdbg:=dbg_none;
                   localvartrashing := -1;
                 end
                else

packages/fcl-passrc/src/pasresolver.pp

@@ -19136,19 +19136,19 @@ begin
     exit(cIncompatible);
   Params:=TParamsExpr(Expr);
 
-  // first param: bool, enum or char
+  // first param: bool, integer, enum or char
   Param:=Params.Params[0];
   ComputeElement(Param,ParamResolved,[]);
   Result:=cIncompatible;
   if rrfReadable in ParamResolved.Flags then
     begin
-    if ParamResolved.BaseType in (btAllBooleans+btAllChars) then
+    if ParamResolved.BaseType in btArrayRangeTypes then
       Result:=cExact
     else if (ParamResolved.BaseType=btContext) and (ParamResolved.LoTypeEl is TPasEnumType) then
       Result:=cExact
     else if ParamResolved.BaseType=btRange then
       begin
-      if ParamResolved.SubType in btAllBooleans+btAllChars then
+      if ParamResolved.SubType in btArrayRangeTypes then
         Result:=cExact
       else if ParamResolved.SubType=btContext then
         begin

packages/fcl-passrc/tests/tcresolver.pas

@@ -3359,8 +3359,10 @@ begin
   '  i2: TInt2;',
   'begin',
   '  i:=i2;',
-  '  if i=i2 then ;']);
+  '  if i=i2 then ;',
+  '  i:=ord(i);']);
   ParseProgram;
+  CheckResolverUnexpectedHints;
 end;
 
 procedure TTestResolver.TestIntegerRangeHighLowerLowFail;

packages/pastojs/src/fppas2js.pp

@@ -3954,6 +3954,7 @@ var
 begin
   Lines:=El.Tokens;
   if Lines=nil then exit;
+  // ToDo: resolve explicit references
 end;
 
 procedure TPas2JSResolver.ResolveNameExpr(El: TPasExpr; const aName: string;
@@ -13398,6 +13399,15 @@ begin
     Result:=Add;
     exit;
     end
+  else if bt in btAllJSInteger then
+    begin
+    // ord(integer)
+    Result:=CheckOrdConstant(aResolver,Param);
+    if Result<>nil then exit;
+    // ord(integer) ->  integer
+    Result:=ConvertExpression(Param,AContext);
+    exit;
+    end
   else if bt=btContext then
     begin
     C:=ParamResolved.LoTypeEl.ClassType;
@@ -17551,6 +17561,7 @@ var
   L: TJSLiteral;
   AsmLines: TStrings;
   Line, Col, StartLine: integer;
+  Statements: TJSStatementList;
 begin
   if AContext=nil then ;
   AsmLines:=El.Tokens;
@@ -17569,6 +17580,15 @@ begin
     L:=TJSLiteral.Create(Line+StartLine,Col,El.SourceFilename);
     L.Value.CustomValue:=TJSString(s);
     Result:=L;
+    if Pos(';',s)>0 then
+      begin
+      // multi statement JS
+      // for example "if e then asm a;b end;"
+      //       ->     if (e){ a;b }
+      Statements:=TJSStatementList.Create(L.Line,L.Column,L.Source);
+      Statements.A:=L;
+      Result:=Statements;
+      end;
   end;
 end;
 

packages/pastojs/src/pas2jsfiler.pp

@@ -609,6 +609,7 @@ type
   public
     Owner: TObject;
   end;
+  EPas2JsFilerErrorClass = class of EPas2JsFilerError;
   EPas2JsWriteError = class(EPas2JsFilerError);
   EPas2JsReadError = class(EPas2JsFilerError);
 
@@ -665,6 +666,7 @@ type
 
   TPCUFiler = class
   private
+    FErrorClass: EPas2JsFilerErrorClass;
     FFileVersion: longint;
     FGUID: TGUID;
     FInitialFlags: TPCUInitialFlags;
@@ -676,7 +678,7 @@ type
     function GetSourceFiles(Index: integer): TPCUSourceFile;
   protected
     FElementRefs: TAVLTree; // tree of TPCUFilerElementRef sorted for Element
-    procedure RaiseMsg(Id: int64; const Msg: string = ''); virtual; abstract; overload;
+    procedure RaiseMsg(Id: int64; const Msg: string = ''); virtual; overload;
     procedure RaiseMsg(Id: int64; El: TPasElement; const Msg: string = ''); overload;
     function GetDefaultMemberVisibility(El: TPasElement): TPasMemberVisibility; virtual;
     function GetDefaultPasScopeVisibilityContext(Scope: TPasScope): TPasElement; virtual;
@@ -703,6 +705,7 @@ type
     property SourceFiles[Index: integer]: TPCUSourceFile read GetSourceFiles;
     property ElementRefs: TAVLTree read FElementRefs;
     property GUID: TGUID read FGUID write FGUID;
+    property ErrorClass: EPas2JsFilerErrorClass read FErrorClass write FErrorClass;
   end;
 
   { TPCUCustomWriter }
@@ -711,6 +714,7 @@ type
   private
     FOnIsElementUsed: TPas2JSIsElementUsedEvent;
   public
+    constructor Create; override;
     procedure WritePCU(aResolver: TPas2JSResolver; aConverter: TPasToJSConverter;
       InitFlags: TPCUInitialFlags; aStream: TStream; Compressed: boolean); virtual; abstract;
     property OnIsElementUsed: TPas2JSIsElementUsedEvent read FOnIsElementUsed write FOnIsElementUsed;
@@ -721,12 +725,15 @@ type
 
   TPCUCustomReader = class(TPCUFiler)
   private
+    FPCUFilename: string;
     FSourceFilename: string;
   public
+    constructor Create; override;
     procedure ReadPCU(aResolver: TPas2JSResolver; aStream: TStream); virtual; abstract;
     function ReadContinue: boolean; virtual; abstract;  // true=finished
     function ReadCanContinue: boolean; virtual; // true=not finished and no pending used interface
     property SourceFilename: string read FSourceFilename write FSourceFilename; // default value for TPasElement.SourceFilename
+    property PCUFilename: string read FPCUFilename write FPCUFilename; // for nicer error messages
   end;
   TPCUReaderClass = class of TPCUCustomReader;
 
@@ -768,7 +775,6 @@ type
     FBuiltInSymbolsArr: TJSONArray;
   protected
     FFirstNewExt, FLastNewExt: TPCUFilerElementRef; // not yet stored external references
-    procedure RaiseMsg(Id: int64; const Msg: string = ''); override; overload;
     procedure ResolvePendingElRefs(Ref: TPCUFilerElementRef);
     function CheckElScope(El: TPasElement; NotNilId: int64; ScopeClass: TPasScopeClass): TPasScope; virtual;
     procedure AddArrayFlag(Obj: TJSONObject; var Arr: TJSONArray;
@@ -1239,6 +1245,7 @@ type
     procedure ReadPCU(aResolver: TPas2JSResolver; aStream: TStream); override; // sets property JSON, reads header and returns
     procedure ReadJSONHeader(aResolver: TPas2JSResolver; Obj: TJSONObject); virtual;
     function ReadContinue: boolean; override; // true=finished
+    function GetPCUExt: string; virtual; // without dot
     property FileVersion: longint read FFileVersion;
     property JSON: TJSONObject read FJSON;
   end;
@@ -1857,6 +1864,14 @@ begin
     AddLine(Line);
 end;
 
+{ TPCUCustomWriter }
+
+constructor TPCUCustomWriter.Create;
+begin
+  inherited Create;
+  FErrorClass:=EPas2JsWriteError;
+end;
+
 { TPCUReaderPendingSpecialized }
 
 destructor TPCUReaderPendingSpecialized.Destroy;
@@ -1877,6 +1892,12 @@ end;
 
 { TPCUCustomReader }
 
+constructor TPCUCustomReader.Create;
+begin
+  inherited Create;
+  FErrorClass:=EPas2JsReadError;
+end;
+
 function TPCUCustomReader.ReadCanContinue: boolean;
 var
   Module: TPasModule;
@@ -1930,6 +1951,18 @@ begin
   Result:=TPCUSourceFile(FSourceFiles[Index]);
 end;
 
+procedure TPCUFiler.RaiseMsg(Id: int64; const Msg: string);
+var
+  E: EPas2JsFilerError;
+begin
+  E:=ErrorClass.Create('['+IntToStr(Id)+'] '+Msg);
+  E.Owner:=Self;
+  {$IFDEF VerbosePCUFiler}
+  writeln(ClassName+'/TPCUFiler.RaiseMsg ',E.Message);
+  {$ENDIF}
+  raise E;
+end;
+
 procedure TPCUFiler.RaiseMsg(Id: int64; El: TPasElement; const Msg: string);
 var
   Path, s: String;
@@ -2215,18 +2248,6 @@ begin
     end;
 end;
 
-procedure TPCUWriter.RaiseMsg(Id: int64; const Msg: string);
-var
-  E: EPas2JsWriteError;
-begin
-  E:=EPas2JsWriteError.Create('['+IntToStr(Id)+'] '+Msg);
-  E.Owner:=Self;
-  {$IFDEF VerbosePCUFiler}
-  writeln('TPCUWriter.RaiseMsg ',E.Message);
-  {$ENDIF}
-  raise E;
-end;
-
 function TPCUWriter.CheckElScope(El: TPasElement; NotNilId: int64;
   ScopeClass: TPasScopeClass): TPasScope;
 var
@@ -5781,12 +5802,16 @@ end;
 
 procedure TPCUReader.RaiseMsg(Id: int64; const Msg: string);
 var
-  E: EPas2JsReadError;
+  E: EPas2JsFilerError;
+  s: String;
 begin
-  E:=EPas2JsReadError.Create('['+IntToStr(Id)+'] '+Msg);
+  s:='['+IntToStr(Id)+'] '+Msg;
+  if PCUFilename<>'' then
+    s:=s+' file: '+PCUFilename;
+  E:=ErrorClass.Create(s);
   E.Owner:=Self;
   {$IFDEF VerbosePCUFiler}
-  writeln('TPCUReader.RaiseMsg ',E.Message);
+  writeln(ClassName+'/TPCUReader.RaiseMsg ',E.Message);
   {$ENDIF}
   raise E;
 end;
@@ -6317,9 +6342,9 @@ begin
   writeln('TPCUReader.ReadHeaderVersion ',FFileVersion);
   {$ENDIF}
   if FFileVersion<1 then
-    RaiseMsg(20180130201801,'invalid PCU file version');
+    RaiseMsg(20180130201801,'invalid file version');
   if FFileVersion>PCUVersion then
-    RaiseMsg(20180130201822,'pcu file was created by a newer compiler.');
+    RaiseMsg(20180130201822,'file was created by a newer compiler.');
 end;
 
 procedure TPCUReader.ReadGUID(Obj: TJSONObject);
@@ -10135,6 +10160,15 @@ begin
   {$ENDIF}
 end;
 
+function TPCUReader.GetPCUExt: string;
+begin
+  Result:=ExtractFileExt(PCUFilename);
+  if Result='' then
+    Result:='pcu'
+  else
+    System.Delete(Result,1,1); // remove leading dot
+end;
+
 { TPas2JSPrecompileFormats }
 
 function TPas2JSPrecompileFormats.GetItems(Index: integer

packages/pastojs/src/pas2jspcucompiler.pp

@@ -187,6 +187,7 @@ begin
     RaiseInternalError(20180312142954,'');
   FPCUReader:=FPCUFormat.ReaderClass.Create;
   FPCUReader.SourceFilename:=ExtractFileName(MyFile.PCUFilename);
+  FPCUReader.PCUFilename:=MyFile.PCUFilename;
 
   if MyFile.ShowDebug then
     MyFile.Log.LogMsg(nParsingFile,[QuoteStr(MyFile.PCUFilename)]);

packages/pastojs/tests/tcmodules.pas

@@ -337,6 +337,7 @@ type
     Procedure TestProc_External;
     Procedure TestProc_ExternalOtherUnit;
     Procedure TestProc_Asm;
+    Procedure TestProc_AsmSubBlock;
     Procedure TestProc_Assembler;
     Procedure TestProc_VarParam;
     Procedure TestProc_VarParamString;
@@ -4139,6 +4140,65 @@ begin
     ]));
 end;
 
+procedure TTestModule.TestProc_AsmSubBlock;
+begin
+  StartProgram(true,[supTObject]);
+  Add([
+  '{$mode delphi}',
+  'type',
+  '  TBird = class end;',
+  'procedure Run(w: word);',
+  'begin;',
+  '  if true then asm console.log(); end;',
+  '  if w>3 then asm',
+  '    var a = w+1;',
+  '    w = a+3;',
+  '  end;',
+  '  while (w>7) do asm',
+  '    w+=3; w*=2;',
+  '  end;',
+  '  try',
+  '  except',
+  '    on E: TBird do',
+  '      asm console.log(E); end;',
+  '    on E: TObject do',
+  '      asm var i=3; i--; end;',
+  '    else asm Fly; High; end;',
+  '  end;',
+  'end;',
+  'begin']);
+  ConvertProgram;
+  CheckSource('TestProc_AsmSubBlock',
+    LinesToStr([ // statements
+    'rtl.createClass(this, "TBird", pas.system.TObject, function () {',
+    '});',
+    'this.Run = function (w) {',
+    '  if (true) console.log();',
+    '  if (w > 3) {',
+    '    var a = w+1;',
+    '    w = a+3;',
+    '  };',
+    '  while (w > 7) {',
+    '    w+=3; w*=2;',
+    '  };',
+    '  try {} catch ($e) {',
+    '    if ($mod.TBird.isPrototypeOf($e)) {',
+    '      var E = $e;',
+    '      console.log(E);',
+    '    } else if (pas.system.TObject.isPrototypeOf($e)) {',
+    '      var E = $e;',
+    '      var i=3; i--;',
+    '    } else {',
+    '      Fly; High;',
+    '    }',
+    '  };',
+    '};',
+    '']),
+    LinesToStr([
+    ''
+    ]));
+end;
+
 procedure TTestModule.TestProc_Assembler;
 begin
   StartProgram(false);
@@ -7122,7 +7182,9 @@ begin
   'begin',
   '  i:=i2;',
   '  i:=default(TMyInt);',
-  '  if i=i2 then ;']);
+  '  if i=i2 then ;',
+  '  i:=ord(i2);',
+  '']);
   ConvertProgram;
   CheckSource('TestIntegerRange',
     LinesToStr([
@@ -7143,6 +7205,7 @@ begin
     '$mod.i = $mod.i2;',
     '$mod.i = -1;',
     'if ($mod.i === $mod.i2) ;',
+    '$mod.i = $mod.i2;',
     '']));
 end;
 
@@ -7257,6 +7320,7 @@ begin
   '  i:=system.high(i);',
   '  i:=system.pred(i);',
   '  i:=system.succ(i);',
+  '  i:=system.ord(i);',
   '']);
   ConvertProgram;
   CheckResolverUnexpectedHints;
@@ -7273,6 +7337,7 @@ begin
     '$mod.i = 255;',
     '$mod.i = $mod.i - 1;',
     '$mod.i = $mod.i + 1;',
+    '$mod.i = $mod.i;',
     '']));
 end;
 

packages/rtl-extra/fpmake.pp

@@ -27,8 +27,6 @@ Const
   WinsockOSes   = [win32,win64,wince,os2,emx,netware,netwlibc];
   WinSock2OSes  = [win32,win64,wince];
   SocketsOSes   = UnixLikes+AllAmigaLikeOSes+[netware,netwlibc,os2,emx,wince,win32,win64];
-  Socksyscall   = [beos,freebsd,haiku,linux,netbsd,openbsd,dragonfly];
-  Socklibc  = unixlikes-socksyscall;
   gpmOSes = [Linux,Android];
   AllTargetsextra = ObjectsOSes + UComplexOSes + MatrixOSes+
                       SerialOSes +PrinterOSes+SocketsOSes+gpmOSes;
@@ -36,6 +34,7 @@ Const
 Var
   P : TPackage;
   T : TTarget;
+  Socksyscall, Socklibc : set of Tos;
 
 begin
   With Installer do
@@ -51,6 +50,15 @@ begin
     if Defaults.CPU=jvm then
       P.OSes := P.OSes - [java,android];
 
+    Socksyscall := [beos,freebsd,haiku,linux,netbsd,dragonfly];
+    Socklibc  := unixlikes-socksyscall;
+{$ifdef FPC_USE_SYSCALL}
+    if Defaults.OS=openbsd then
+      begin
+        system.include(Socksyscall,openbsd);
+        system.exclude(Socklibc,openbsd);
+      end;
+{$endif}
     P.Email := '';
     P.Description := 'Rtl-extra, RTL not needed for bootstrapping';
     P.NeedLibC:= false;

packages/rtl-extra/src/bsd/osdefs.inc

@@ -27,4 +27,9 @@
 {$ifdef darwin}
   {$define FPC_USE_LIBC}
 {$endif}
+{$ifdef openbsd}
+  {$ifndef FPC_USE_SYSCALL}
+    {$define FPC_USE_LIBC}
+  {$endif}
+{$endif}
 

tests/test/packages/fcl-registry/tregistry2.pp

@@ -5,7 +5,7 @@
 }
 
 {$ifdef FPC} {$mode delphi}  {$endif}
-uses Windows, SysUtils, Classes, registry;
+uses SysUtils, Classes, registry;
 
 {$ifdef FPC}
   {$WARN implicit_string_cast_loss off}

tests/webtbs/tw37060.pp

@@ -4,7 +4,7 @@ program fp37060;
 
 uses sockets, Classes, SysUtils;
 
-procedure BuildBadAddrs4(out bad_addrs: TStringList);
+procedure BuildBadAddrs4(var bad_addrs: TStringList);
 begin
   bad_addrs.Add('1.1.1.1.1'); // too many octets
   bad_addrs.Add('0xa.3.4.5'); //hex in octets
@@ -32,7 +32,7 @@ begin
   bad_addrs.Add('&7.&5.30.4'); // octal
 end;
 
-procedure BuildGoodAddrs4(out good_addrs: TStringList);
+procedure BuildGoodAddrs4(var good_addrs: TStringList);
 begin
   good_addrs.Add('127.0.0.1|127.0.0.1');
   good_addrs.Add('0.0.0.0|0.0.0.0');
@@ -40,7 +40,7 @@ begin
   good_addrs.Add('255.255.255.255|255.255.255.255');
 end;
 
-procedure BuildBadAddrs6(out bad_addrs: TStringList);
+procedure BuildBadAddrs6(var bad_addrs: TStringList);
 begin
   // start with some obviously bad formats.
   bad_addrs.Add('');
@@ -193,7 +193,7 @@ begin
   bad_addrs.Add('127.0.0.2');
 end;
 
-procedure BuildGoodAddrs6(out addrlist: TStringList);
+procedure BuildGoodAddrs6(var addrlist: TStringList);
 begin
   // Each str is two parts, separated by a pipe. The left part is the input
   // address to be parsed, and the right is the expected result of taking the