From 69d892578ac676d6e51401b9bcced62a0c77c6f6 Mon Sep 17 00:00:00 2001 From: Dmytro Date: Wed, 13 Oct 2021 22:12:46 +0300 Subject: [PATCH 01/11] Fixed arithmetic for simple integer types (in progress) --- packages/fcl-passrc/src/pasresolver.pp | 4 + packages/pastojs/src/fppas2js.pp | 588 ++++++++++++++++++++++--- utils/pas2js/dist/rtl.js | 5 - 3 files changed, 531 insertions(+), 66 deletions(-) diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index 6149438382..0270d21753 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/packages/fcl-passrc/src/pasresolver.pp @@ -409,6 +409,10 @@ const {$ifdef HasInt64} ,btInt64,btComp {$endif}]; + btAllUnsignedInteger = [btByte,btWord,btUIntSingle,btLongWord,btUIntDouble + {$ifdef HasInt64} + ,btQWord + {$endif}]; btAllChars = [btChar,{$ifdef FPC_HAS_CPSTRING}btAnsiChar,{$endif}btWideChar]; btAllStrings = [btString, {$ifdef FPC_HAS_CPSTRING}btAnsiString,btShortString,btRawByteString,{$endif} diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 283fa9a60d..8694fbf2db 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -465,6 +465,8 @@ unit FPPas2Js; {$IFOPT Q+}{$DEFINE OverflowCheckOn}{$ENDIF} {$IFOPT R+}{$DEFINE RangeCheckOn}{$ENDIF} +{$define VerbosePas2JS} + interface uses @@ -565,7 +567,6 @@ type pbifnArray_Static_Clone, pbifnAs, pbifnAsExt, - pbifnBitwiseLongwordFix, pbifnBitwiseNativeIntAnd, pbifnBitwiseNativeIntOr, pbifnBitwiseNativeIntShl, @@ -758,7 +759,6 @@ const '$clone', // pbifnArray_Static_Clone 'as', // rtl.as pbifnAs 'asExt', // rtl.asExt pbifnAsExt - 'lw', // pbifnBitwiseLongwordFix 'and', // pbifnBitwiseNativeIntAnd, 'or', // pbifnBitwiseNativeIntOr, 'shl', // pbifnBitwiseNativeIntShl, @@ -2249,8 +2249,15 @@ type Function ConvertNilExpr(El: TNilExpr; AContext: TConvertContext): TJSElement; virtual; Function ConvertCharToInt(Arg: TJSElement; PosEl: TPasElement; ArgContext: TConvertContext): TJSElement; virtual; Function ConvertIntToInt(Arg: TJSElement; FromBT, ToBT: TResolverBaseType; PosEl: TPasElement; ArgContext: TConvertContext): TJSElement; virtual; - Function CreateBitWiseAnd(El: TPasElement; Value: TJSElement; const Mask: TMaxPrecInt; Shift: integer): TJSElement; virtual; - Function CreateBitWiseLongword(El: TPasElement; Value: TJSElement): TJSElement; virtual; + Function CreateBitwiseAnd(El: TPasElement; Value: TJSElement; const Mask: TMaxPrecInt; Shift: integer = 0): TJSElement; virtual; + Function CreateBitwiseXor(El: TPasElement; Value: TJSElement; const Mask: TMaxPrecInt): TJSElement; virtual; + function CreateByteBitFix(El: TPasElement; Value: TJSElement): TJSElement; virtual; + function CreateShortIntBitFix(El: TPasElement; Value: TJSElement): TJSElement; virtual; + function CreateWordBitFix(El: TPasElement; Value: TJSElement): TJSElement; virtual; + function CreateSmallIntBitFix(El: TPasElement; Value: TJSElement): TJSElement; virtual; + function CreateLongwordBitFix(El: TPasElement; Value: TJSElement): TJSElement; virtual; + function CreateLongIntBitFix(El: TPasElement; Value: TJSElement): TJSElement; virtual; + function CreateIntegerBitFixAuto(El: TPasElement; AContext: TConvertContext; Value: TJSElement): TJSElement; virtual; Function ConvertParamsExpr(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual; Function ConvertArrayParams(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual; Function ConvertFuncParams(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual; @@ -5788,10 +5795,158 @@ procedure TPas2JSResolver.ComputeBinaryExprRes(Bin: TBinaryExpr; out ResolvedEl: TPasResolverResult; Flags: TPasResolverComputeFlags; var LeftResolved, RightResolved: TPasResolverResult); - procedure SetBaseType(BaseType: TResolverBaseType); + procedure SetBaseType(BaseType: TResolverBaseType; Flags: TPasResolverResultFlags); begin SetResolverValueExpr(ResolvedEl,BaseType,BaseTypes[BaseType],BaseTypes[BaseType], - Bin,[rrfReadable]); + Bin,Flags); + end; + + function GetPrimitiveExprSmallestIntegerBaseType(PrimExpr : TPrimitiveExpr) : TResolverBaseType; + var + Value: TResEvalValue; + Int: TMaxPrecInt; + begin + Value:=Eval(PrimExpr,[]); + if Value=nil then + RaiseInternalError(20211011142901); + try + case Value.Kind of + revkInt: + begin + Int:=TResEvalInt(Value).Int; + {$IFDEF VerbosePas2JS} + writeln('TPas2JSResolver.ComputeBinaryExprRes Primitive value=',IntToStr(Int)); + {$ENDIF} + //if TResEvalInt(Value).Typed = + Result:=GetSmallestIntegerBaseType(Int,Int); + end; + else + RaiseInternalError(20211011142902); + end; + finally + ReleaseEvalValue(Value); + end; + end; + + procedure SetIntValueExpr(Flags: TPasResolverResultFlags); + var + LeftBaseType, RightBaseType: TResolverBaseType; + begin + {$IFDEF VerbosePas2JS} + writeln('TPas2JSResolver.ComputeBinaryExprRes LeftClass=',GetClassAncestorsDbg(TPasClassType(LeftResolved.LoTypeEl))); + writeln('TPas2JSResolver.ComputeBinaryExprRes RightClass=',GetClassAncestorsDbg(TPasClassType(RightResolved.LoTypeEl))); + {$ENDIF} + + LeftBaseType := LeftResolved.BaseType; + RightBaseType := RightResolved.BaseType; + if Bin.OpCode in [eopAdd, eopSubtract, eopMultiply, eopDiv, eopMod, eopPower] then + begin + if (RightBaseType = btLongWord) and (LeftBaseType = btLongInt) and (Bin.Left is TPrimitiveExpr) and + (LeftResolved.ExprEl is TPrimitiveExpr) and (TPrimitiveExpr(LeftResolved.ExprEl).Kind = pekNumber) then + begin + LeftBaseType := GetPrimitiveExprSmallestIntegerBaseType(TPrimitiveExpr(LeftResolved.ExprEl)); + {$IFDEF VerbosePas2JS} + writeln('TPas2JSResolver.ComputeBinaryExprRes Left is Primitive type=',BaseTypeNames[LeftBaseType]); + {$ENDIF} + end; + + if (LeftBaseType = btLongWord) and (RightBaseType = btLongInt) and (Bin.Right is TPrimitiveExpr) and + (RightResolved.ExprEl is TPrimitiveExpr) and (TPrimitiveExpr(RightResolved.ExprEl).Kind = pekNumber) then + begin + RightBaseType := GetPrimitiveExprSmallestIntegerBaseType(TPrimitiveExpr(RightResolved.ExprEl)); + {$IFDEF VerbosePas2JS} + writeln('TPas2JSResolver.ComputeBinaryExprRes Right is Primitive type=',BaseTypeNames[RightBaseType]); + {$ENDIF} + end; + + if (LeftBaseType = btLongWord) and (RightBaseType = btLongWord) then + SetBaseType(btLongWord,Flags) + else + if (LeftBaseType in [btByte, btShortInt, btWord, btSmallInt, btLongInt]) and + (RightBaseType in [btByte, btShortInt, btWord, btSmallInt, btLongInt]) then + SetBaseType(btLongInt,Flags) + else + if (LeftBaseType in [btByte, btWord, btLongWord]) and + (RightBaseType in [btByte, btWord, btLongWord]) then + SetBaseType(btLongWord,Flags) + else + if ((LeftBaseType = btLongWord) and (RightBaseType in btAllSignedInteger)) or + ((RightBaseType = btLongWord) and (LeftBaseType in btAllSignedInteger)) then + SetBaseType(btIntDouble,Flags) + else + if ((LeftBaseType = btUIntDouble) and (RightBaseType in btAllUnsignedInteger)) or + ((RightBaseType = btUIntDouble) and (LeftBaseType in btAllUnsignedInteger)) then + SetBaseType(btUIntDouble,Flags) + else + if ((LeftBaseType = btIntDouble) and (RightBaseType in btAllInteger)) or + ((RightBaseType = btIntDouble) and (LeftBaseType in btAllInteger)) then + SetBaseType(btIntDouble,Flags) + else + // default behavior + SetBaseType(LeftBaseType, Flags); + end + else + if Bin.OpCode in [eopShl, eopShr] then + begin + if LeftBaseType in [btByte, btShortInt, btWord, btSmallInt, btLongInt] then + SetBaseType(btLongInt,Flags) + else + // default behavior + SetBaseType(LeftBaseType, Flags); + end + else // eopAnd, eopOr, eopXor + begin + if (LeftBaseType = btLongInt) and (Bin.Left is TPrimitiveExpr) and + (LeftResolved.ExprEl is TPrimitiveExpr) and (TPrimitiveExpr(LeftResolved.ExprEl).Kind = pekNumber) then + begin + LeftBaseType := GetPrimitiveExprSmallestIntegerBaseType(TPrimitiveExpr(LeftResolved.ExprEl)); + {$IFDEF VerbosePas2JS} + writeln('TPas2JSResolver.ComputeBinaryExprRes Left is Primitive type=',BaseTypeNames[LeftBaseType]); + {$ENDIF} + end; + + if (RightBaseType = btLongInt) and (Bin.Right is TPrimitiveExpr) and + (RightResolved.ExprEl is TPrimitiveExpr) and (TPrimitiveExpr(RightResolved.ExprEl).Kind = pekNumber) then + begin + RightBaseType := GetPrimitiveExprSmallestIntegerBaseType(TPrimitiveExpr(RightResolved.ExprEl)); + {$IFDEF VerbosePas2JS} + writeln('TPas2JSResolver.ComputeBinaryExprRes Right is Primitive type=',BaseTypeNames[RightBaseType]); + {$ENDIF} + end; + + if LeftBaseType = RightBaseType then + SetBaseType(LeftBaseType, Flags) + else + if (LeftBaseType in [btByte, btWord]) and + (RightBaseType in [btByte, btWord]) then + SetBaseType(btWord,Flags) + else + if (LeftBaseType in [btByte, btShortInt, btSmallInt]) and + (RightBaseType in [btByte, btShortInt, btSmallInt]) then + SetBaseType(btSmallInt,Flags) + else + if (LeftBaseType in [btByte, btShortInt, btWord, btSmallInt, btLongInt]) and + (RightBaseType in [btByte, btShortInt, btWord, btSmallInt, btLongInt]) then + SetBaseType(btLongInt,Flags) + else + if (LeftBaseType in [btByte, btShortInt, btWord, btSmallInt, btLongInt, btLongWord]) and + (RightBaseType in [btByte, btShortInt, btWord, btSmallInt, btLongInt, btLongWord]) then + SetBaseType(btLongWord,Flags) + else + if (LeftBaseType in [btByte, btWord, btLongWord, btUIntDouble]) and + (RightBaseType in [btByte, btWord, btLongWord, btUIntDouble]) then + SetBaseType(btUIntDouble,Flags) + else + if (LeftBaseType in [btByte, btShortInt, btWord, btSmallInt, btLongInt, btLongWord, btIntDouble, btUIntDouble]) and + (RightBaseType in [btByte, btShortInt, btWord, btSmallInt, btLongInt, btLongWord, btIntDouble, btUIntDouble]) then + SetBaseType(btIntDouble,Flags) + else + // default behavior + SetBaseType(LeftBaseType, Flags); + end; + {$IFDEF VerbosePas2JS} + writeln('TPas2JSResolver.ComputeBinaryExprRes Result=',GetClassAncestorsDbg(TPasClassType(ResolvedEl.LoTypeEl))); + {$endif} end; var @@ -5808,7 +5963,7 @@ begin and (ResolveAliasType(TPasType(RightResolved.IdentEl)) is TPasClassType) then begin // e.g. if aJSValue is TObject then ; - SetBaseType(btBoolean); + SetBaseType(btBoolean,[rrfReadable]); exit; end; RightTypeEl:=RightResolved.LoTypeEl; @@ -5816,12 +5971,20 @@ begin begin // e.g. if aJSValue is TClass then ; // or if aJSValue is ImageClass then ; - SetBaseType(btBoolean); + SetBaseType(btBoolean,[rrfReadable]); exit; end; end; end; + if (LeftResolved.BaseType in btAllInteger) and (RightResolved.BaseType in btAllInteger) and + (Bin.OpCode in [eopAdd, eopSubtract, eopMultiply, eopDiv, eopMod, eopPower, + eopShl, eopShr, eopAnd, eopOr, eopXor]) then + begin + SetIntValueExpr([rrfReadable]); + exit; + end; + inherited ComputeBinaryExprRes(Bin, ResolvedEl, Flags, LeftResolved, RightResolved); end; @@ -8642,7 +8805,7 @@ Var U : TJSUnaryExpression; E : TJSElement; ResolvedEl: TPasResolverResult; - BitwiseNot, NeedLongWordBitFix: Boolean; + BitwiseNot: Boolean; aResolver: TPas2JSResolver; TypeEl, SubTypeEl: TPasType; begin @@ -8656,12 +8819,14 @@ begin E:=ConvertExpression(El.Operand,AContext); U:=CreateUnaryPlus(E,El); U.A:=E; + exit(CreateIntegerBitFixAuto(El,AContext,U)); end; eopSubtract: begin E:=ConvertExpression(El.Operand,AContext); U:=TJSUnaryMinusExpression(CreateElement(TJSUnaryMinusExpression,El)); U.A:=E; + exit(CreateIntegerBitFixAuto(El,AContext,U)); end; eopNot: begin @@ -8671,16 +8836,12 @@ begin begin aResolver.ComputeElement(El.Operand,ResolvedEl,[]); BitwiseNot:=ResolvedEl.BaseType in btAllJSInteger; - NeedLongWordBitFix:=ResolvedEl.BaseType=btLongWord; - end - else - NeedLongWordBitFix:=false; + end; if BitwiseNot then begin U:=TJSUnaryInvExpression(CreateElement(TJSUnaryInvExpression,El)); U.A:=E; - if NeedLongWordBitFix then - exit(CreateBitWiseLongword(El,U)); + exit(CreateIntegerBitFixAuto(El,AContext,U)); end else U:=CreateUnaryNot(E,El); @@ -8937,20 +9098,14 @@ Var +GetResolverResultDbg(RightResolved)); end; - function BitwiseOpNeedLongwordFix: boolean; - begin - Result:=((LeftResolved.BaseType=btLongWord) and (RightResolved.BaseType<=btLongWord)) - or ((RightResolved.BaseType=btLongWord) and (LeftResolved.BaseType<=btLongWord)); - end; - - function CreateBitwiseLongwordOp(A, B: TJSElement; C: TJSBinaryClass): TJSElement; + function CreateIntBitFixOp(A, B: TJSElement; C: TJSBinaryClass): TJSElement; var R: TJSBinary; begin R:=TJSBinary(CreateElement(C,El)); R.A:=A; R.B:=B; - Result:=CreateBitWiseLongword(El,R); + Result:=CreateIntegerBitFixAuto(El,AContext,R); end; var @@ -9121,9 +9276,9 @@ begin Result:=Call; exit; end - else if BitwiseOpNeedLongwordFix then + else if (LeftResolved.BaseType in btAllJSInteger) and (RightResolved.BaseType in btAllJSInteger) then begin - Result:=CreateBitwiseLongwordOp(A,B,TJSBitwiseAndExpression); + Result:=CreateIntBitFixOp(A,B,TJSBitwiseAndExpression); exit; end; end; @@ -9154,9 +9309,9 @@ begin Result:=Call; exit; end - else if BitwiseOpNeedLongwordFix then + else if (LeftResolved.BaseType in btAllJSInteger) and (RightResolved.BaseType in btAllJSInteger) then begin - Result:=CreateBitwiseLongwordOp(A,B,TJSBitwiseOrExpression); + Result:=CreateIntBitFixOp(A,B,TJSBitwiseOrExpression); exit; end; end; @@ -9187,9 +9342,9 @@ begin Result:=Call; exit; end - else if BitwiseOpNeedLongwordFix then + else if (LeftResolved.BaseType in btAllJSInteger) and (RightResolved.BaseType in btAllJSInteger) then begin - Result:=CreateBitwiseLongwordOp(A,B,TJSBitwiseXOrExpression); + Result:=CreateIntBitFixOp(A,B,TJSBitwiseXOrExpression); exit; end; end; @@ -9229,6 +9384,10 @@ begin end; end; + if (LeftResolved.BaseType in btAllJSInteger) and (RightResolved.BaseType in btAllJSInteger) and + (El.OpCode in [eopAdd, eopSubtract, eopMultiply, eopShl, eopShr]) then + Result:=CreateIntegerBitFixAuto(El,AContext,Result); + if (bsOverflowChecks in AContext.ScannerBoolSwitches) and (aResolver<>nil) then case El.OpCode of eopAdd,eopSubtract: @@ -9441,7 +9600,7 @@ begin Call.AddArg(B); B:=nil; exit; end - else if LeftResolved.BaseType=btLongWord then + else if LeftResolved.BaseType in btAllJSInteger then begin // aLongWord shl b -> rtl.lw(a << b) if El.OpCode=eopShl then @@ -9451,7 +9610,7 @@ begin Result:=TJSBinaryExpression(CreateElement(JSBinClass,El)); TJSBinaryExpression(Result).A:=A; A:=nil; TJSBinaryExpression(Result).B:=B; B:=nil; - Result:=CreateBitWiseLongword(El,Result); + Result:=CreateIntegerBitFixAuto(El,AContext,Result); exit; end; end @@ -9929,7 +10088,7 @@ begin R:=TJSBinary(CreateElement(TJSAdditiveExpressionPlus,SubBin)); R.A:=A; A:=nil; R.B:=B; B:=nil; - Result:=R; + Result:=CreateIntegerBitFixAuto(SubBin,AContext,R); if (bsOverflowChecks in AContext.ScannerBoolSwitches) and (aResolver<>nil) then case El.OpCode of @@ -10776,7 +10935,6 @@ var aResolver: TPas2JSResolver; MinVal, MaxVal: TMaxPrecInt; Call: TJSCallExpression; - ShiftEx: TJSURShiftExpression; begin Result:=Arg; aResolver:=ArgContext.Resolver; @@ -10806,40 +10964,29 @@ begin else case ToBT of btByte: - // value to byte -> value & 255 if FromBT<>btByte then - Result:=CreateBitWiseAnd(PosEl,Result,255,0); + Result:=CreateByteBitFix(PosEl,Result); btShortInt: - // value to shortint -> value & 255 << 24 >> 24 if FromBT<>btShortInt then - Result:=CreateBitWiseAnd(PosEl,Result,255,24); + Result:=CreateShortIntBitFix(PosEl,Result); btWord: - // value to word -> value & 65535 if not (FromBT in [btByte,btWord]) then - Result:=CreateBitWiseAnd(PosEl,Result,65535,0); - btSmallInt: - // value to smallint -> value & 65535 << 16 >> 16 + Result:=CreateWordBitFix(PosEl,Result); + btSmallInt: if not (FromBT in [btShortInt,btSmallInt]) then - Result:=CreateBitWiseAnd(PosEl,Result,65535,16); - btLongWord: - // value to longword -> value >>> 0 + Result:=CreateSmallIntBitFix(PosEl,Result); + btLongWord: if not (FromBT in [btByte,btWord,btLongWord,btUIntSingle]) then - begin - ShiftEx:=TJSURShiftExpression(CreateElement(TJSURShiftExpression,PosEl)); - ShiftEx.A:=Result; - ShiftEx.B:=CreateLiteralNumber(PosEl,0); - Result:=ShiftEx; - end; - btLongint: - // value to longint -> value & 0xffffffff + Result := CreateLongwordBitFix(PosEl, Result); + btLongint: if not (FromBT in [btShortInt,btSmallInt,btLongint,btIntSingle]) then - Result:=CreateBitWiseAnd(PosEl,Result,$ffffffff,0); + Result:=CreateLongIntBitFix(PosEl,Result); end; end; end; -function TPasToJSConverter.CreateBitWiseAnd(El: TPasElement; Value: TJSElement; - const Mask: TMaxPrecInt; Shift: integer): TJSElement; +function TPasToJSConverter.CreateBitwiseAnd(El: TPasElement; Value: TJSElement; + const Mask: TMaxPrecInt; Shift: integer = 0): TJSElement; // if sign=false: Value & Mask // if sign=true: Value & Mask << ZeroBits >> ZeroBits var @@ -10879,15 +11026,332 @@ begin end; end; -function TPasToJSConverter.CreateBitWiseLongword(El: TPasElement; +function TPasToJSConverter.CreateBitwiseXor(El: TPasElement; Value: TJSElement; + const Mask: TMaxPrecInt): TJSElement; +var + XorEx: TJSBitwiseXorExpression; + Hex: String; + i: Integer; +begin + XorEx:=TJSBitwiseXorExpression(CreateElement(TJSBitwiseXorExpression,El)); + XorEx.A:=Value; + XorEx.B:=CreateLiteralNumber(El,Mask); + if Mask>999999 then + begin + Hex:=HexStr(Mask,8); + i:=1; + while i<8 do + if Hex[i]='0' then + inc(i) + else + break; + Hex:=Copy(Hex,i,8); + TJSLiteral(XorEx.B).Value.CustomValue:=TJSString('0x'+Hex); + end; + Result:=XorEx; +end; + +function TPasToJSConverter.CreateByteBitFix(El: TPasElement; + Value: TJSElement): TJSElement; +begin + // value to byte -> value & 255 + Result:=CreateBitwiseAnd(El,Value,$ff,0); +end; + +function TPasToJSConverter.CreateShortIntBitFix(El: TPasElement; + Value: TJSElement): TJSElement; +begin + // value to shortint -> value & 255 << 24 >> 24 + Result:=CreateBitwiseAnd(El,Value,$ff,24); +end; + +function TPasToJSConverter.CreateWordBitFix(El: TPasElement; + Value: TJSElement): TJSElement; +begin + // value to word -> value & 65535 + Result:=CreateBitwiseAnd(El,Value,$ffff,0); +end; + +function TPasToJSConverter.CreateSmallIntBitFix(El: TPasElement; + Value: TJSElement): TJSElement; +begin + // value to smallint -> value & 65535 << 16 >> 16 + Result:=CreateBitwiseAnd(El,Value,$ffff,16); +end; + +function TPasToJSConverter.CreateLongwordBitFix(El: TPasElement; Value: TJSElement): TJSElement; var - Call: TJSCallExpression; + ShiftEx: TJSURShiftExpression; begin - Call:=CreateCallExpression(El); - Call.Expr:=CreatePrimitiveDotExpr(GetBIName(pbivnRTL)+'.'+GetBIName(pbifnBitwiseLongwordFix),El); - Call.AddArg(Value); - Result:=Call; + // value to longword -> value >>> 0 + ShiftEx:=TJSURShiftExpression(CreateElement(TJSURShiftExpression,El)); + ShiftEx.A:=Value; + ShiftEx.B:=CreateLiteralNumber(El,0); + Result:=ShiftEx; +end; + +function TPasToJSConverter.CreateLongIntBitFix(El: TPasElement; + Value: TJSElement): TJSElement; +var + OrEx: TJSBitwiseOrExpression; +begin + // value to longint -> value | 0 + OrEx:=TJSBitwiseOrExpression(CreateElement(TJSBitwiseOrExpression,El)); + OrEx.A:=Value; + OrEx.B:=CreateLiteralNumber(El,0); + Result:=OrEx; +end; + +function TPasToJSConverter.CreateIntegerBitFixAuto(El: TPasElement; AContext: TConvertContext; + Value: TJSElement): TJSElement; + + function UseLeftTypeForAssignment(LeftResolvedType, RightResolvedType : TResolverBaseType) : boolean; + begin + Result := false; + if LeftResolvedType = RightResolvedType then + exit; + + Result := true; + end; + +var + ResolvedEl, LeftResolved, RightResolved: TPasResolverResult; + aResolver: TPas2JSResolver; + UnaryEl : TUnaryExpr; + BinaryEl : TBinaryExpr; + AssignEl : TPasImplAssign; + IntResType, LeftResolvedType, RightResolvedType : TResolverBaseType; + BInt: TMaxPrecInt; + JSAndOp : TJSBitwiseAndExpression; + AssignContext : TAssignContext; + NeedBitFix, ParentWillFix : Boolean; +begin + if AContext=nil then ; + aResolver:=AContext.Resolver; + Result := Value; + + {$IFDEF VerbosePas2JS} + writeln('TPasToJSConverter.CreateIntegerBitFixAuto Value=',Value.ClassName); +WriteLn('El.Parent=', El.Parent.ClassName, ', Context=', AContext.ClassName); + {$ENDIF} + IntResType := btNone; + ParentWillFix := false; + NeedBitFix := false; + // checking where current expression is used to decide wether we need to fix integer value now or we can leave it for the parent expression + if El.Parent <> nil then + begin + if El.Parent is TUnaryExpr then + begin + UnaryEl := TUnaryExpr(El.Parent); + if UnaryEl.OpCode in [eopSubtract, eopNot] then + ParentWillFix := true; + end + else + if El.Parent is TBinaryExpr then + begin + BinaryEl := TBinaryExpr(El.Parent); + if aResolver <> nil then + begin + aResolver.ComputeElement(BinaryEl.Left,LeftResolved,[]); + LeftResolvedType := LeftResolved.BaseType; + + aResolver.ComputeElement(BinaryEl.Right,RightResolved,[]); + RightResolvedType := RightResolved.BaseType; + + //aResolver.ComputeBinaryExprRes(BinaryEl,ResolvedEl,[],LeftResolved,RightResolved); + + if BinaryEl.OpCode in [eopShl, eopShr] then + ParentWillFix := (BinaryEl.Left = El) + else + if (BinaryEl.OpCode in [eopAdd, eopSubtract, eopAnd, eopOr, eopXor]) then + ParentWillFix := true; + (* + begin + case LeftResolvedType of + btByte: + if RightResolvedType = btByte then + ParentWillFix := true; + btShortInt: + if RightResolvedType = btShortInt then + ParentWillFix := true; + btWord: + if RightResolvedType in [btByte, btWord] then + ParentWillFix := true; + btSmallInt: + if RightResolvedType in [btShortInt, btSmallInt] then + ParentWillFix := true; + btLongWord: + if RightResolvedType in [btByte,btWord,btLongWord,btUIntSingle] then + ParentWillFix := true; + btLongint: + if RightResolvedType in [btShortInt,btSmallInt,btLongint,btIntSingle] then + ParentWillFix := true; + end; + end; + *) + + if BinaryEl.Left = El then + IntResType := LeftResolvedType + else + IntResType := RightResolvedType; + end; + end + else + if El.Parent is TPasImplAssign then + begin + AssignEl := TPasImplAssign(El.Parent); + // getting left type of the assignment expression, implicit casting + if AssignEl.Right = El then + begin + aResolver.ComputeElement(AssignEl.Left,LeftResolved,[]); + LeftResolvedType := LeftResolved.BaseType; + + aResolver.ComputeElement(AssignEl.Right,RightResolved,[]); + RightResolvedType := RightResolved.BaseType; + + // select smallest type by size + if UseLeftTypeForAssignment(LeftResolvedType, RightResolvedType) then + begin + //ParentWillFix := true; + IntResType := LeftResolvedType; + end + else + IntResType := RightResolvedType; + end; + end; + end; + + {$IFDEF VerbosePas2JS} + writeln('TPasToJSConverter.CreateIntegerBitFixAuto IntResType=',aResolver.BaseTypeNames[IntResType]); + {$ENDIF} + // TODO + //ParentWillFix := false; + + if El is TUnaryExpr then + begin + UnaryEl := TUnaryExpr(El); + if UnaryEl.OpCode in [eopAdd, eopSubtract, eopNot] then + begin + if ParentWillFix then + Exit; + + if (IntResType = btNone) and (aResolver <> nil) then + begin + aResolver.ComputeElement(UnaryEl.Operand,ResolvedEl,[]); + IntResType := ResolvedEl.BaseType; + end; + + if IntResType in btAllJSInteger then + begin + // no need to fix value for "add" operation + // no need to fix value for "not" operation for LongInt + if (UnaryEl.OpCode = eopNot) and (IntResType <> btLongint) then + NeedBitFix := true + // no need to fix value for "subtract" operation and constant + else if (UnaryEl.OpCode = eopSubtract) and + not ((UnaryEl.Operand is TPrimitiveExpr) and (TPrimitiveExpr(UnaryEl.Operand).Kind = pekNumber)) then + NeedBitFix := true; + end; + end; + end + else + if El is TBinaryExpr then + begin + BinaryEl := TBinaryExpr(El); + if (IntResType = btNone) and (aResolver <> nil) then + begin + aResolver.ComputeElement(BinaryEl.Left,LeftResolved,[]); + LeftResolvedType := LeftResolved.BaseType; + + aResolver.ComputeElement(BinaryEl.Right,RightResolved,[]); + RightResolvedType := RightResolved.BaseType; + + aResolver.ComputeBinaryExprRes(BinaryEl,ResolvedEl,[],LeftResolved,RightResolved); + + IntResType := ResolvedEl.BaseType; + end; + + if IntResType in btAllJSInteger then + begin + if BinaryEl.OpCode in [eopMultiply, eopPower (*, eopDiv, eopMod*)] then + NeedBitFix := true + else + if BinaryEl.OpCode in [eopAdd, eopSubtract, eopAnd, eopOr, eopXor, eopShr, eopShl] then + begin + if ParentWillFix then + Exit; + + // no need to fix value for "shr" operation or LongInt type and bitwise operation + if (BinaryEl.OpCode in [eopAdd, eopSubtract]) or + ((BinaryEl.OpCode in [eopAnd, eopOr, eopXor]) and (IntResType <> btLongint)) then + NeedBitFix := true + // "shl" operation expanded to 32-bit + else + if (BinaryEl.OpCode = eopShl) and (IntResType = btLongWord) then + NeedBitFix := true; + + // optimize And operation, remove redandant fix operation + if NeedBitFix and (BinaryEl.OpCode = eopAnd) and (IntResType in [btByte, btWord, btLongWord]) and + (Result is TJSBitwiseAndExpression) then + begin + JSAndOp := TJSBitwiseAndExpression(Result); + if IsLiteralInteger(JSAndOp.A, BInt) then + begin + if IntResType = btByte then + begin + TJSLiteral(JSAndOp.A).Value.AsNumber := BInt and $ff; + NeedBitFix := false; + end + else if IntResType = btWord then + begin + TJSLiteral(JSAndOp.A).Value.AsNumber := BInt and $ffff; + NeedBitFix := false; + end + else if (IntResType = btLongWord) and (BInt <= $7fffffff) then + NeedBitFix := false; + end; + + if IsLiteralInteger(JSAndOp.B, BInt) then + begin + if IntResType = btByte then + begin + TJSLiteral(JSAndOp.B).Value.AsNumber := BInt and $ff; + NeedBitFix := false; + end + else if IntResType = btWord then + begin + TJSLiteral(JSAndOp.B).Value.AsNumber := BInt and $ffff; + NeedBitFix := false; + end + else if (IntResType = btLongWord) and (BInt <= $7fffffff) then + NeedBitFix := false; + end; + end; + end; + end; + end; + + {$IFDEF VerbosePas2JS} + writeln('TPasToJSConverter.CreateIntegerBitFixAuto.2 IntResType=',aResolver.BaseTypeNames[IntResType]); + {$ENDIF} + if not NeedBitFix then + Exit; + + case IntResType of + btByte: + Result := CreateByteBitFix(El, Result); + btShortInt: + Result := CreateShortIntBitFix(El, Result); + btWord: + Result := CreateWordBitFix(El, Result); + btSmallInt: + Result := CreateSmallIntBitFix(El, Result); + btLongWord: + Result := CreateLongwordBitFix(El, Result); + btLongint: + Result := CreateLongIntBitFix(El, Result); + end; end; function TPasToJSConverter.ConvertInheritedExpr(El: TInheritedExpr; @@ -23141,6 +23605,8 @@ begin AssignContext.RightSide:=nil; T.LHS:=LHS; Result:=T; + if AssignContext.LeftResolved.BaseType in btAllJSInteger then + Result := CreateIntegerBitFixAuto(El,AssignContext,Result); LHS:=nil; if (bsRangeChecks in AContext.ScannerBoolSwitches) diff --git a/utils/pas2js/dist/rtl.js b/utils/pas2js/dist/rtl.js index 624d4c1bb3..0399642cb2 100644 --- a/utils/pas2js/dist/rtl.js +++ b/utils/pas2js/dist/rtl.js @@ -1260,11 +1260,6 @@ var rtl = { return 0; }, - lw: function(l){ - // fix longword bitwise operation - return l<0?l+0x100000000:l; - }, - and: function(a,b){ var hi = 0x80000000; var low = 0x7fffffff; From 99f6184db559732eefa68426e7438ac965d696c6 Mon Sep 17 00:00:00 2001 From: Dmytro Date: Fri, 15 Oct 2021 02:08:22 +0300 Subject: [PATCH 02/11] Fixed arithmetic for simple integer types (in progress, follow-up) --- packages/pastojs/src/fppas2js.pp | 309 +++++++++++++++++++------------ 1 file changed, 187 insertions(+), 122 deletions(-) diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 8694fbf2db..9ecc56d7d4 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -2249,14 +2249,15 @@ type Function ConvertNilExpr(El: TNilExpr; AContext: TConvertContext): TJSElement; virtual; Function ConvertCharToInt(Arg: TJSElement; PosEl: TPasElement; ArgContext: TConvertContext): TJSElement; virtual; Function ConvertIntToInt(Arg: TJSElement; FromBT, ToBT: TResolverBaseType; PosEl: TPasElement; ArgContext: TConvertContext): TJSElement; virtual; - Function CreateBitwiseAnd(El: TPasElement; Value: TJSElement; const Mask: TMaxPrecInt; Shift: integer = 0): TJSElement; virtual; - Function CreateBitwiseXor(El: TPasElement; Value: TJSElement; const Mask: TMaxPrecInt): TJSElement; virtual; + Function CreateBitwiseAnd(El: TPasElement; Value: TJSElement; const Mask: TMaxPrecInt): TJSElement; virtual; + Function CreateBitwiseShiftLeftRight(El: TPasElement; Value: TJSElement; Shift: integer): TJSElement; virtual; function CreateByteBitFix(El: TPasElement; Value: TJSElement): TJSElement; virtual; function CreateShortIntBitFix(El: TPasElement; Value: TJSElement): TJSElement; virtual; function CreateWordBitFix(El: TPasElement; Value: TJSElement): TJSElement; virtual; function CreateSmallIntBitFix(El: TPasElement; Value: TJSElement): TJSElement; virtual; function CreateLongwordBitFix(El: TPasElement; Value: TJSElement): TJSElement; virtual; function CreateLongIntBitFix(El: TPasElement; Value: TJSElement): TJSElement; virtual; + function CreateIntegerBitFix(El: TPasElement; Value: TJSElement; ToType : TResolverBaseType): TJSElement; function CreateIntegerBitFixAuto(El: TPasElement; AContext: TConvertContext; Value: TJSElement): TJSElement; virtual; Function ConvertParamsExpr(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual; Function ConvertArrayParams(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual; @@ -10986,121 +10987,195 @@ begin end; function TPasToJSConverter.CreateBitwiseAnd(El: TPasElement; Value: TJSElement; - const Mask: TMaxPrecInt; Shift: integer = 0): TJSElement; -// if sign=false: Value & Mask -// if sign=true: Value & Mask << ZeroBits >> ZeroBits + const Mask: TMaxPrecInt): TJSElement; + + procedure SetNumberCustomValue(V: TJSLiteral; const Value: TMaxPrecInt); + var + Hex: String; + i: Integer; + begin + if Value>999999 then + begin + Hex:=HexStr(Value,8); + i:=1; + while i<8 do + if Hex[i]='0' then + inc(i) + else + break; + Hex:=Copy(Hex,i,8); + V.Value.CustomValue:=TJSString('0x'+Hex); + end + else + V.Value.CustomValue:=TJSString(''); + end; + var AndEx: TJSBitwiseAndExpression; - Hex: String; - i: Integer; - ShiftEx: TJSShiftExpression; + Int: TMaxPrecInt; begin + if IsLiteralInteger(Value, Int) then + begin + TJSLiteral(Value).Value.AsNumber := Int and Mask; + SetNumberCustomValue(TJSLiteral(Value), Int and Mask); + Result:=Value; + exit; + end + else + if Value is TJSBitwiseAndExpression then + begin + AndEx := TJSBitwiseAndExpression(Value); + if IsLiteralInteger(AndEx.A, Int) then + begin + TJSLiteral(AndEx.A).Value.AsNumber := Int and Mask; + SetNumberCustomValue(TJSLiteral(AndEx.A), Int and Mask); + Result:=Value; + exit; + end; + + if IsLiteralInteger(AndEx.B, Int) then + begin + TJSLiteral(AndEx.B).Value.AsNumber := Int and Mask; + SetNumberCustomValue(TJSLiteral(AndEx.B), Int and Mask); + Result:=Value; + exit; + end; + end; + AndEx:=TJSBitwiseAndExpression(CreateElement(TJSBitwiseAndExpression,El)); Result:=AndEx; AndEx.A:=Value; AndEx.B:=CreateLiteralNumber(El,Mask); - if Mask>999999 then - begin - Hex:=HexStr(Mask,8); - i:=1; - while i<8 do - if Hex[i]='0' then - inc(i) - else - break; - Hex:=Copy(Hex,i,8); - TJSLiteral(AndEx.B).Value.CustomValue:=TJSString('0x'+Hex); - end; - if Shift>0 then - begin - // value << ZeroBits - ShiftEx:=TJSLShiftExpression(CreateElement(TJSLShiftExpression,El)); - ShiftEx.A:=Result; - Result:=ShiftEx; - ShiftEx.B:=CreateLiteralNumber(El,Shift); - // value << ZeroBits >> ZeroBits - ShiftEx:=TJSRShiftExpression(CreateElement(TJSRShiftExpression,El)); - ShiftEx.A:=Result; - Result:=ShiftEx; - ShiftEx.B:=CreateLiteralNumber(El,Shift); - end; + SetNumberCustomValue(TJSLiteral(AndEx.B), Mask); end; -function TPasToJSConverter.CreateBitwiseXor(El: TPasElement; Value: TJSElement; - const Mask: TMaxPrecInt): TJSElement; +Function TPasToJSConverter.CreateBitwiseShiftLeftRight(El: TPasElement; Value: TJSElement; Shift: integer): TJSElement; var - XorEx: TJSBitwiseXorExpression; - Hex: String; - i: Integer; + ShiftEx: TJSShiftExpression; begin - XorEx:=TJSBitwiseXorExpression(CreateElement(TJSBitwiseXorExpression,El)); - XorEx.A:=Value; - XorEx.B:=CreateLiteralNumber(El,Mask); - if Mask>999999 then - begin - Hex:=HexStr(Mask,8); - i:=1; - while i<8 do - if Hex[i]='0' then - inc(i) - else - break; - Hex:=Copy(Hex,i,8); - TJSLiteral(XorEx.B).Value.CustomValue:=TJSString('0x'+Hex); - end; - Result:=XorEx; + Result:=Value; + if Shift <= 0 then + Exit; + // value << ZeroBits + ShiftEx:=TJSLShiftExpression(CreateElement(TJSLShiftExpression,El)); + ShiftEx.A:=Result; + Result:=ShiftEx; + ShiftEx.B:=CreateLiteralNumber(El,Shift); + // value << ZeroBits >> ZeroBits + ShiftEx:=TJSRShiftExpression(CreateElement(TJSRShiftExpression,El)); + ShiftEx.A:=Result; + Result:=ShiftEx; + ShiftEx.B:=CreateLiteralNumber(El,Shift); end; function TPasToJSConverter.CreateByteBitFix(El: TPasElement; Value: TJSElement): TJSElement; +var + Int: TMaxPrecInt; begin - // value to byte -> value & 255 - Result:=CreateBitwiseAnd(El,Value,$ff,0); + if IsLiteralInteger(Value, Int) and (Int and $ff = Int) then + Result:=Value + else + // value to byte -> value & 255 + Result:=CreateBitwiseAnd(El,Value,$ff); end; function TPasToJSConverter.CreateShortIntBitFix(El: TPasElement; Value: TJSElement): TJSElement; +var + Int: TMaxPrecInt; begin - // value to shortint -> value & 255 << 24 >> 24 - Result:=CreateBitwiseAnd(El,Value,$ff,24); + if IsLiteralInteger(Value, Int) and (ShortInt(Int) = Int) then + Result:=Value + else + begin + // value to shortint -> value & 255 << 24 >> 24 + Result:=CreateBitwiseAnd(El,Value,$ff); + Result:=CreateBitwiseShiftLeftRight(El,Result,24); + end; end; function TPasToJSConverter.CreateWordBitFix(El: TPasElement; Value: TJSElement): TJSElement; +var + Int: TMaxPrecInt; begin - // value to word -> value & 65535 - Result:=CreateBitwiseAnd(El,Value,$ffff,0); + if IsLiteralInteger(Value, Int) and (Int and $ffff = Int) then + Result:=Value + else + // value to word -> value & 65535 + Result:=CreateBitwiseAnd(El,Value,$ffff); end; function TPasToJSConverter.CreateSmallIntBitFix(El: TPasElement; Value: TJSElement): TJSElement; +var + Int: TMaxPrecInt; begin - // value to smallint -> value & 65535 << 16 >> 16 - Result:=CreateBitwiseAnd(El,Value,$ffff,16); + if IsLiteralInteger(Value, Int) and (SmallInt(Int) = Int) then + Result:=Value + else + begin + // value to smallint -> value & 65535 << 16 >> 16 + Result:=CreateBitwiseAnd(El,Value,$ffff); + Result:=CreateBitwiseShiftLeftRight(El,Result,16); + end; end; function TPasToJSConverter.CreateLongwordBitFix(El: TPasElement; Value: TJSElement): TJSElement; var ShiftEx: TJSURShiftExpression; + Int: TMaxPrecInt; begin - // value to longword -> value >>> 0 - ShiftEx:=TJSURShiftExpression(CreateElement(TJSURShiftExpression,El)); - ShiftEx.A:=Value; - ShiftEx.B:=CreateLiteralNumber(El,0); - Result:=ShiftEx; + if IsLiteralInteger(Value, Int) and (Int and $ffffffff = Int) then + Result:=Value + else + begin + // value to longword -> value >>> 0 + ShiftEx:=TJSURShiftExpression(CreateElement(TJSURShiftExpression,El)); + ShiftEx.A:=Value; + ShiftEx.B:=CreateLiteralNumber(El,0); + Result:=ShiftEx; + end; end; function TPasToJSConverter.CreateLongIntBitFix(El: TPasElement; Value: TJSElement): TJSElement; var OrEx: TJSBitwiseOrExpression; + Int: TMaxPrecInt; begin - // value to longint -> value | 0 - OrEx:=TJSBitwiseOrExpression(CreateElement(TJSBitwiseOrExpression,El)); - OrEx.A:=Value; - OrEx.B:=CreateLiteralNumber(El,0); - Result:=OrEx; + if IsLiteralInteger(Value, Int) and (Integer(Int) = Int) then + Result:=Value + else + begin + // value to longint -> value | 0 + OrEx:=TJSBitwiseOrExpression(CreateElement(TJSBitwiseOrExpression,El)); + OrEx.A:=Value; + OrEx.B:=CreateLiteralNumber(El,0); + Result:=OrEx; + end; +end; + +function TPasToJSConverter.CreateIntegerBitFix(El: TPasElement; + Value: TJSElement; ToType : TResolverBaseType): TJSElement; +begin + Result := Value; + case ToType of + btByte: + Result := CreateByteBitFix(El, Result); + btShortInt: + Result := CreateShortIntBitFix(El, Result); + btWord: + Result := CreateWordBitFix(El, Result); + btSmallInt: + Result := CreateSmallIntBitFix(El, Result); + btLongWord: + Result := CreateLongwordBitFix(El, Result); + btLongint: + Result := CreateLongIntBitFix(El, Result); + end; end; function TPasToJSConverter.CreateIntegerBitFixAuto(El: TPasElement; AContext: TConvertContext; @@ -11122,8 +11197,8 @@ var BinaryEl : TBinaryExpr; AssignEl : TPasImplAssign; IntResType, LeftResolvedType, RightResolvedType : TResolverBaseType; - BInt: TMaxPrecInt; - JSAndOp : TJSBitwiseAndExpression; + Int: TMaxPrecInt; + AndEx : TJSBitwiseAndExpression; AssignContext : TAssignContext; NeedBitFix, ParentWillFix : Boolean; begin @@ -11136,9 +11211,12 @@ begin WriteLn('El.Parent=', El.Parent.ClassName, ', Context=', AContext.ClassName); {$ENDIF} IntResType := btNone; + LeftResolvedType := btNone; + RightResolvedType := btNone; ParentWillFix := false; NeedBitFix := false; - // checking where current expression is used to decide wether we need to fix integer value now or we can leave it for the parent expression + + // checking where current expression is used to decide whether we need to fix integer value now or we can leave it for the parent expression if El.Parent <> nil then begin if El.Parent is TUnaryExpr then @@ -11213,7 +11291,7 @@ WriteLn('El.Parent=', El.Parent.ClassName, ', Context=', AContext.ClassName); // select smallest type by size if UseLeftTypeForAssignment(LeftResolvedType, RightResolvedType) then begin - //ParentWillFix := true; + ParentWillFix := true; IntResType := LeftResolvedType; end else @@ -11292,44 +11370,44 @@ WriteLn('El.Parent=', El.Parent.ClassName, ', Context=', AContext.ClassName); NeedBitFix := true; // optimize And operation, remove redandant fix operation - if NeedBitFix and (BinaryEl.OpCode = eopAnd) and (IntResType in [btByte, btWord, btLongWord]) and + if NeedBitFix and (BinaryEl.OpCode = eopAnd) and (IntResType = btLongWord) and (Result is TJSBitwiseAndExpression) then begin - JSAndOp := TJSBitwiseAndExpression(Result); - if IsLiteralInteger(JSAndOp.A, BInt) then - begin - if IntResType = btByte then - begin - TJSLiteral(JSAndOp.A).Value.AsNumber := BInt and $ff; - NeedBitFix := false; - end - else if IntResType = btWord then - begin - TJSLiteral(JSAndOp.A).Value.AsNumber := BInt and $ffff; - NeedBitFix := false; - end - else if (IntResType = btLongWord) and (BInt <= $7fffffff) then - NeedBitFix := false; - end; + AndEx := TJSBitwiseAndExpression(Result); + if IsLiteralInteger(AndEx.A, Int) and (Int <= $7fffffff) then + NeedBitFix := false; - if IsLiteralInteger(JSAndOp.B, BInt) then - begin - if IntResType = btByte then - begin - TJSLiteral(JSAndOp.B).Value.AsNumber := BInt and $ff; - NeedBitFix := false; - end - else if IntResType = btWord then - begin - TJSLiteral(JSAndOp.B).Value.AsNumber := BInt and $ffff; - NeedBitFix := false; - end - else if (IntResType = btLongWord) and (BInt <= $7fffffff) then - NeedBitFix := false; - end; + if IsLiteralInteger(AndEx.B, Int) and (Int <= $7fffffff) then + NeedBitFix := false; end; end; end; + end + else + if El is TPasImplAssign then + begin + AssignEl := TPasImplAssign(El); + if AContext is TAssignContext then + begin + AssignContext := TAssignContext(AContext); + LeftResolved := AssignContext.LeftResolved; + LeftResolvedType := LeftResolved.BaseType; + + RightResolved := AssignContext.RightResolved; + RightResolvedType := RightResolved.BaseType; + + if (LeftResolvedType in btAllJSInteger) and (RightResolvedType in btAllJSInteger) and + UseLeftTypeForAssignment(LeftResolvedType, RightResolvedType) then + begin + {$IFDEF VerbosePas2JS} + writeln('TPasToJSConverter.CreateIntegerBitFixAuto.3 ToType=',aResolver.BaseTypeNames[LeftResolvedType]); + {$ENDIF} + if Result is TJSSimpleAssignStatement then + TJSSimpleAssignStatement(Result).Expr := CreateIntegerBitFix(El, TJSSimpleAssignStatement(Result).Expr, LeftResolvedType); + + exit; + end; + end; end; {$IFDEF VerbosePas2JS} @@ -11338,20 +11416,7 @@ WriteLn('El.Parent=', El.Parent.ClassName, ', Context=', AContext.ClassName); if not NeedBitFix then Exit; - case IntResType of - btByte: - Result := CreateByteBitFix(El, Result); - btShortInt: - Result := CreateShortIntBitFix(El, Result); - btWord: - Result := CreateWordBitFix(El, Result); - btSmallInt: - Result := CreateSmallIntBitFix(El, Result); - btLongWord: - Result := CreateLongwordBitFix(El, Result); - btLongint: - Result := CreateLongIntBitFix(El, Result); - end; + Result := CreateIntegerBitFix(El, Result, IntResType); end; function TPasToJSConverter.ConvertInheritedExpr(El: TInheritedExpr; From 9a399f7a9750b745d65b7088e793ea4624e58c1c Mon Sep 17 00:00:00 2001 From: Dmytro Date: Tue, 19 Oct 2021 22:04:51 +0300 Subject: [PATCH 03/11] Fixed arithmetic for simple integer types (in progress, follow-up) --- packages/fcl-passrc/src/pasresolver.pp | 4 +- packages/pastojs/src/fppas2js.pp | 379 +++++++++++++++---------- 2 files changed, 232 insertions(+), 151 deletions(-) diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index 0270d21753..c1f223031b 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/packages/fcl-passrc/src/pasresolver.pp @@ -28061,12 +28061,12 @@ begin RaiseMsg(20170216152532,nIllegalQualifierInFrontOf,sIllegalQualifierInFrontOf, [OpcodeStrings[TUnaryExpr(El).OpCode],GetResolverResultDescription(ResolvedEl)],El); eopSubtract: - if ResolvedEl.BaseType in (btAllSignedInteger+btAllFloats) then + if ResolvedEl.BaseType in btAllFloats then exit else if ResolvedEl.BaseType in btAllInteger then begin case ResolvedEl.BaseType of - btByte,btWord: + btByte,btWord,btShortInt,btSmallInt: ResolvedEl.BaseType:=btLongint; btLongWord,btUIntDouble: ResolvedEl.BaseType:=btIntDouble; diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 9ecc56d7d4..1abe141b89 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -1992,6 +1992,7 @@ type Function ComputeConstString(Expr: TPasExpr; AContext: TConvertContext; NotEmpty: boolean): String; virtual; Function IsLiteralInteger(El: TJSElement; out Number: TMaxPrecInt): boolean; Function IsLiteralNumber(El: TJSElement; out n: TJSNumber): boolean; + Function IsLiteralIntegerExpr(El: TJSElement; out Number: TMaxPrecInt): boolean; // Name mangling Function GetOverloadName(El: TPasElement; AContext: TConvertContext): string; Function CanClashWithGlobal(El: TPasElement): boolean; @@ -5818,7 +5819,6 @@ procedure TPas2JSResolver.ComputeBinaryExprRes(Bin: TBinaryExpr; out {$IFDEF VerbosePas2JS} writeln('TPas2JSResolver.ComputeBinaryExprRes Primitive value=',IntToStr(Int)); {$ENDIF} - //if TResEvalInt(Value).Typed = Result:=GetSmallestIntegerBaseType(Int,Int); end; else @@ -5834,8 +5834,7 @@ procedure TPas2JSResolver.ComputeBinaryExprRes(Bin: TBinaryExpr; out LeftBaseType, RightBaseType: TResolverBaseType; begin {$IFDEF VerbosePas2JS} - writeln('TPas2JSResolver.ComputeBinaryExprRes LeftClass=',GetClassAncestorsDbg(TPasClassType(LeftResolved.LoTypeEl))); - writeln('TPas2JSResolver.ComputeBinaryExprRes RightClass=',GetClassAncestorsDbg(TPasClassType(RightResolved.LoTypeEl))); + writeln('TPas2JSResolver.ComputeBinaryExprRes LeftClass=',GetClassAncestorsDbg(TPasClassType(LeftResolved.LoTypeEl)),', RightClass=',GetClassAncestorsDbg(TPasClassType(RightResolved.LoTypeEl)),', OpCode: ',OpcodeStrings[Bin.OpCode]); {$ENDIF} LeftBaseType := LeftResolved.BaseType; @@ -9023,6 +9022,47 @@ begin n:=Value.AsNumber; end; +function TPasToJSConverter.IsLiteralIntegerExpr(El: TJSElement; out + Number: TMaxPrecInt): boolean; +var + NumberB : TMaxPrecInt; +begin + if El is TJSLiteral then + exit(IsLiteralInteger(El, Number)); + + // TODO: check overflow + if El is TJSUnaryMinusExpression then + begin + Result := IsLiteralIntegerExpr(TJSUnaryMinusExpression(El).A, Number); + if Result then + Number := -Number; + exit; + end; + + if El is TJSUnaryPlusExpression then + exit(IsLiteralIntegerExpr(TJSUnaryPlusExpression(El).A, Number)); + + if El is TJSAdditiveExpressionPlus then + begin + Result := IsLiteralIntegerExpr(TJSAdditiveExpressionPlus(El).A, Number) and + IsLiteralIntegerExpr(TJSAdditiveExpressionPlus(El).B, NumberB); + if Result then + Number := Number + NumberB; + exit; + end; + + if El is TJSAdditiveExpressionMinus then + begin + Result := IsLiteralIntegerExpr(TJSAdditiveExpressionMinus(El).A, Number) and + IsLiteralIntegerExpr(TJSAdditiveExpressionMinus(El).B, NumberB); + if Result then + Number := Number - NumberB; + exit; + end; + + Result := false; +end; + function TPasToJSConverter.GetOverloadName(El: TPasElement; AContext: TConvertContext): string; begin @@ -10937,6 +10977,9 @@ var MinVal, MaxVal: TMaxPrecInt; Call: TJSCallExpression; begin + {$IFDEF VerbosePas2JS} + writeln('TPasToJSConverter.ConvertIntToInt PosEl=',GetObjName(PosEl),' ArgContext=',GetObjName(ArgContext),' FromType=',ResBaseTypeNames[FromBT],' ToType=',ResBaseTypeNames[ToBT]); + {$ENDIF} Result:=Arg; aResolver:=ArgContext.Resolver; if FromBT=btCurrency then @@ -10948,9 +10991,9 @@ begin else if ToBT=btCurrency then // integer to currency -> value*10000 Result:=CreateMulNumber(PosEl,Result,10000); - if (ToBT<>btIntDouble) and not (Result is TJSLiteral) then + if ToBT<>btIntDouble then begin - if bsRangeChecks in ArgContext.ScannerBoolSwitches then + if not (Result is TJSLiteral) and (bsRangeChecks in ArgContext.ScannerBoolSwitches) then begin // rtl.rc(param,MinInt,MaxInt) if not aResolver.GetIntegerRange(ToBT,MinVal,MaxVal) then @@ -11014,31 +11057,33 @@ var AndEx: TJSBitwiseAndExpression; Int: TMaxPrecInt; begin - if IsLiteralInteger(Value, Int) then + if IsLiteralInteger(Value,Int) then begin TJSLiteral(Value).Value.AsNumber := Int and Mask; SetNumberCustomValue(TJSLiteral(Value), Int and Mask); - Result:=Value; - exit; + exit(Value); end else if Value is TJSBitwiseAndExpression then begin AndEx := TJSBitwiseAndExpression(Value); - if IsLiteralInteger(AndEx.A, Int) then + if IsLiteralIntegerExpr(AndEx.A,Int) and (Int and Mask = Int) then + exit(Value); + if IsLiteralIntegerExpr(AndEx.B,Int) and (Int and Mask = Int) then + exit(Value); + + if IsLiteralInteger(AndEx.A,Int) then begin TJSLiteral(AndEx.A).Value.AsNumber := Int and Mask; SetNumberCustomValue(TJSLiteral(AndEx.A), Int and Mask); - Result:=Value; - exit; + exit(Value); end; - if IsLiteralInteger(AndEx.B, Int) then + if IsLiteralInteger(AndEx.B,Int) then begin TJSLiteral(AndEx.B).Value.AsNumber := Int and Mask; SetNumberCustomValue(TJSLiteral(AndEx.B), Int and Mask); - Result:=Value; - exit; + exit(Value); end; end; @@ -11053,19 +11098,19 @@ Function TPasToJSConverter.CreateBitwiseShiftLeftRight(El: TPasElement; Value: T var ShiftEx: TJSShiftExpression; begin - Result:=Value; + Result := Value; if Shift <= 0 then Exit; // value << ZeroBits - ShiftEx:=TJSLShiftExpression(CreateElement(TJSLShiftExpression,El)); - ShiftEx.A:=Result; - Result:=ShiftEx; - ShiftEx.B:=CreateLiteralNumber(El,Shift); + ShiftEx := TJSLShiftExpression(CreateElement(TJSLShiftExpression,El)); + ShiftEx.A := Result; + Result := ShiftEx; + ShiftEx.B := CreateLiteralNumber(El,Shift); // value << ZeroBits >> ZeroBits - ShiftEx:=TJSRShiftExpression(CreateElement(TJSRShiftExpression,El)); - ShiftEx.A:=Result; - Result:=ShiftEx; - ShiftEx.B:=CreateLiteralNumber(El,Shift); + ShiftEx := TJSRShiftExpression(CreateElement(TJSRShiftExpression,El)); + ShiftEx.A := Result; + Result := ShiftEx; + ShiftEx.B := CreateLiteralNumber(El,Shift); end; function TPasToJSConverter.CreateByteBitFix(El: TPasElement; @@ -11073,11 +11118,11 @@ function TPasToJSConverter.CreateByteBitFix(El: TPasElement; var Int: TMaxPrecInt; begin - if IsLiteralInteger(Value, Int) and (Int and $ff = Int) then - Result:=Value + if IsLiteralIntegerExpr(Value,Int) and (Int and $ff = Int) then + Result := Value else // value to byte -> value & 255 - Result:=CreateBitwiseAnd(El,Value,$ff); + Result := CreateBitwiseAnd(El,Value,$ff); end; function TPasToJSConverter.CreateShortIntBitFix(El: TPasElement; @@ -11085,13 +11130,13 @@ function TPasToJSConverter.CreateShortIntBitFix(El: TPasElement; var Int: TMaxPrecInt; begin - if IsLiteralInteger(Value, Int) and (ShortInt(Int) = Int) then - Result:=Value + if IsLiteralIntegerExpr(Value,Int) and (ShortInt(Int) = Int) then + Result := Value else begin // value to shortint -> value & 255 << 24 >> 24 - Result:=CreateBitwiseAnd(El,Value,$ff); - Result:=CreateBitwiseShiftLeftRight(El,Result,24); + Result := CreateBitwiseAnd(El,Value,$ff); + Result := CreateBitwiseShiftLeftRight(El,Result,24); end; end; @@ -11100,11 +11145,11 @@ function TPasToJSConverter.CreateWordBitFix(El: TPasElement; var Int: TMaxPrecInt; begin - if IsLiteralInteger(Value, Int) and (Int and $ffff = Int) then - Result:=Value + if IsLiteralIntegerExpr(Value,Int) and (Int and $ffff = Int) then + Result := Value else // value to word -> value & 65535 - Result:=CreateBitwiseAnd(El,Value,$ffff); + Result := CreateBitwiseAnd(El,Value,$ffff); end; function TPasToJSConverter.CreateSmallIntBitFix(El: TPasElement; @@ -11112,13 +11157,13 @@ function TPasToJSConverter.CreateSmallIntBitFix(El: TPasElement; var Int: TMaxPrecInt; begin - if IsLiteralInteger(Value, Int) and (SmallInt(Int) = Int) then - Result:=Value + if IsLiteralIntegerExpr(Value,Int) and (SmallInt(Int) = Int) then + Result := Value else begin // value to smallint -> value & 65535 << 16 >> 16 - Result:=CreateBitwiseAnd(El,Value,$ffff); - Result:=CreateBitwiseShiftLeftRight(El,Result,16); + Result := CreateBitwiseAnd(El,Value,$ffff); + Result := CreateBitwiseShiftLeftRight(El,Result,16); end; end; @@ -11126,17 +11171,28 @@ function TPasToJSConverter.CreateLongwordBitFix(El: TPasElement; Value: TJSElement): TJSElement; var ShiftEx: TJSURShiftExpression; + AndEx: TJSBitwiseAndExpression; Int: TMaxPrecInt; begin - if IsLiteralInteger(Value, Int) and (Int and $ffffffff = Int) then - Result:=Value + if IsLiteralIntegerExpr(Value,Int) and (Int and $ffffffff = Int) then + Result := Value else begin + if Value is TJSBitwiseAndExpression then + begin + AndEx := TJSBitwiseAndExpression(Value); + if IsLiteralIntegerExpr(AndEx.A,Int) and (Int >= 0) and (Int <= $7fffffff) then + exit(Value); + + if IsLiteralIntegerExpr(AndEx.B,Int) and (Int >= 0) and (Int <= $7fffffff) then + exit(Value); + end; + // value to longword -> value >>> 0 - ShiftEx:=TJSURShiftExpression(CreateElement(TJSURShiftExpression,El)); - ShiftEx.A:=Value; - ShiftEx.B:=CreateLiteralNumber(El,0); - Result:=ShiftEx; + ShiftEx := TJSURShiftExpression(CreateElement(TJSURShiftExpression,El)); + ShiftEx.A := Value; + ShiftEx.B := CreateLiteralNumber(El,0); + Result := ShiftEx; end; end; @@ -11146,21 +11202,24 @@ var OrEx: TJSBitwiseOrExpression; Int: TMaxPrecInt; begin - if IsLiteralInteger(Value, Int) and (Integer(Int) = Int) then - Result:=Value + if IsLiteralIntegerExpr(Value,Int) and (Integer(Int) = Int) then + Result := Value else begin // value to longint -> value | 0 - OrEx:=TJSBitwiseOrExpression(CreateElement(TJSBitwiseOrExpression,El)); - OrEx.A:=Value; - OrEx.B:=CreateLiteralNumber(El,0); - Result:=OrEx; + OrEx := TJSBitwiseOrExpression(CreateElement(TJSBitwiseOrExpression,El)); + OrEx.A := Value; + OrEx.B := CreateLiteralNumber(El,0); + Result := OrEx; end; end; function TPasToJSConverter.CreateIntegerBitFix(El: TPasElement; Value: TJSElement; ToType : TResolverBaseType): TJSElement; begin + {$IFDEF VerbosePas2JS} + writeln('TPasToJSConverter.CreateIntegerBitFix ToType=', ResBaseTypeNames[ToType]); + {$ENDIF} Result := Value; case ToType of btByte: @@ -11184,10 +11243,25 @@ function TPasToJSConverter.CreateIntegerBitFixAuto(El: TPasElement; AContext: TC function UseLeftTypeForAssignment(LeftResolvedType, RightResolvedType : TResolverBaseType) : boolean; begin Result := false; + if not (LeftResolvedType in btAllJSInteger) or not (RightResolvedType in btAllJSInteger) then + exit; if LeftResolvedType = RightResolvedType then exit; - Result := true; + case LeftResolvedType of + btByte, btShortInt: + Result := true; + btWord: + Result := RightResolvedType <> btByte; + btSmallInt: + Result := not (RightResolvedType in [btByte,btShortInt]); + btLongWord: + Result := not (RightResolvedType in [btByte,btWord]); + btLongInt: + Result := not (RightResolvedType in [btByte,btShortInt,btWord,btSmallInt]); + btUIntDouble: + Result := not (RightResolvedType in [btByte,btWord,btLongWord]); + end; end; var @@ -11196,25 +11270,26 @@ var UnaryEl : TUnaryExpr; BinaryEl : TBinaryExpr; AssignEl : TPasImplAssign; - IntResType, LeftResolvedType, RightResolvedType : TResolverBaseType; + ParamsEl : TParamsExpr; + PropertyEl : TPasProperty; + ToType, LeftResolvedType, RightResolvedType : TResolverBaseType; Int: TMaxPrecInt; AndEx : TJSBitwiseAndExpression; AssignContext : TAssignContext; - NeedBitFix, ParentWillFix : Boolean; + NeedBitFix, ParentWillFix, ParentAllowSignificantOverflow, IsArrayIndexExpr : Boolean; begin if AContext=nil then ; aResolver:=AContext.Resolver; Result := Value; {$IFDEF VerbosePas2JS} - writeln('TPasToJSConverter.CreateIntegerBitFixAuto Value=',Value.ClassName); -WriteLn('El.Parent=', El.Parent.ClassName, ', Context=', AContext.ClassName); + writeln('TPasToJSConverter.CreateIntegerBitFixAuto Value=',Value.ClassName,', El.Parent=', El.Parent.ClassName, ', Context=', AContext.ClassName); {$ENDIF} - IntResType := btNone; - LeftResolvedType := btNone; - RightResolvedType := btNone; - ParentWillFix := false; + ToType := btNone; NeedBitFix := false; + ParentWillFix := false; + ParentAllowSignificantOverflow := false; + IsArrayIndexExpr := false; // checking where current expression is used to decide whether we need to fix integer value now or we can leave it for the parent expression if El.Parent <> nil then @@ -11224,59 +11299,40 @@ WriteLn('El.Parent=', El.Parent.ClassName, ', Context=', AContext.ClassName); UnaryEl := TUnaryExpr(El.Parent); if UnaryEl.OpCode in [eopSubtract, eopNot] then ParentWillFix := true; + if UnaryEl.OpCode = eopNot then + ParentAllowSignificantOverflow := true; end - else - if El.Parent is TBinaryExpr then + else if El.Parent is TBinaryExpr then begin BinaryEl := TBinaryExpr(El.Parent); if aResolver <> nil then begin - aResolver.ComputeElement(BinaryEl.Left,LeftResolved,[]); - LeftResolvedType := LeftResolved.BaseType; - - aResolver.ComputeElement(BinaryEl.Right,RightResolved,[]); - RightResolvedType := RightResolved.BaseType; - - //aResolver.ComputeBinaryExprRes(BinaryEl,ResolvedEl,[],LeftResolved,RightResolved); + if BinaryEl.Left = El then + begin + aResolver.ComputeElement(BinaryEl.Left,LeftResolved,[]); + ToType := LeftResolved.BaseType; + end + else + begin + aResolver.ComputeElement(BinaryEl.Right,RightResolved,[]); + ToType := RightResolved.BaseType; + end; if BinaryEl.OpCode in [eopShl, eopShr] then - ParentWillFix := (BinaryEl.Left = El) - else - if (BinaryEl.OpCode in [eopAdd, eopSubtract, eopAnd, eopOr, eopXor]) then - ParentWillFix := true; - (* begin - case LeftResolvedType of - btByte: - if RightResolvedType = btByte then - ParentWillFix := true; - btShortInt: - if RightResolvedType = btShortInt then - ParentWillFix := true; - btWord: - if RightResolvedType in [btByte, btWord] then - ParentWillFix := true; - btSmallInt: - if RightResolvedType in [btShortInt, btSmallInt] then - ParentWillFix := true; - btLongWord: - if RightResolvedType in [btByte,btWord,btLongWord,btUIntSingle] then - ParentWillFix := true; - btLongint: - if RightResolvedType in [btShortInt,btSmallInt,btLongint,btIntSingle] then - ParentWillFix := true; - end; - end; - *) - - if BinaryEl.Left = El then - IntResType := LeftResolvedType - else - IntResType := RightResolvedType; + ParentWillFix := (BinaryEl.Left = El); + ParentAllowSignificantOverflow := ParentWillFix; + end + else if BinaryEl.OpCode in [eopAnd, eopOr, eopXor] then + begin + ParentWillFix := true; + ParentAllowSignificantOverflow := true; + end + else if BinaryEl.OpCode in [eopAdd, eopSubtract] then + ParentWillFix := true; end; end - else - if El.Parent is TPasImplAssign then + else if El.Parent is TPasImplAssign then begin AssignEl := TPasImplAssign(El.Parent); // getting left type of the assignment expression, implicit casting @@ -11292,19 +11348,24 @@ WriteLn('El.Parent=', El.Parent.ClassName, ', Context=', AContext.ClassName); if UseLeftTypeForAssignment(LeftResolvedType, RightResolvedType) then begin ParentWillFix := true; - IntResType := LeftResolvedType; + ParentAllowSignificantOverflow := true; + ToType := LeftResolvedType; end else - IntResType := RightResolvedType; + ToType := RightResolvedType; end; + end + else if El.Parent is TParamsExpr then + begin + ParamsEl := TParamsExpr(El.Parent); + if ParamsEl.Kind = pekArrayParams then + IsArrayIndexExpr := (ParamsEl.Value <> El); end; end; {$IFDEF VerbosePas2JS} - writeln('TPasToJSConverter.CreateIntegerBitFixAuto IntResType=',aResolver.BaseTypeNames[IntResType]); + writeln('TPasToJSConverter.CreateIntegerBitFixAuto ToType=',aResolver.BaseTypeNames[ToType]); {$ENDIF} - // TODO - //ParentWillFix := false; if El is TUnaryExpr then begin @@ -11314,17 +11375,21 @@ WriteLn('El.Parent=', El.Parent.ClassName, ', Context=', AContext.ClassName); if ParentWillFix then Exit; - if (IntResType = btNone) and (aResolver <> nil) then + if (ToType = btNone) and (aResolver <> nil) then begin aResolver.ComputeElement(UnaryEl.Operand,ResolvedEl,[]); - IntResType := ResolvedEl.BaseType; + ToType := ResolvedEl.BaseType; end; - if IntResType in btAllJSInteger then + if ToType in [btByte,btShortInt,btWord,btSmallInt,btLongWord,btLongInt] then begin + // if the expression is used as the array index, then for LongInt and LongWord type we can ignore the possibility of integer overflow + if IsArrayIndexExpr and (ToType in [btLongInt,btLongWord]) then + Exit; + // no need to fix value for "add" operation // no need to fix value for "not" operation for LongInt - if (UnaryEl.OpCode = eopNot) and (IntResType <> btLongint) then + if (UnaryEl.OpCode = eopNot) and (ToType <> btLongint) then NeedBitFix := true // no need to fix value for "subtract" operation and constant else if (UnaryEl.OpCode = eopSubtract) and @@ -11337,49 +11402,41 @@ WriteLn('El.Parent=', El.Parent.ClassName, ', Context=', AContext.ClassName); if El is TBinaryExpr then begin BinaryEl := TBinaryExpr(El); - if (IntResType = btNone) and (aResolver <> nil) then + if (ToType = btNone) and (aResolver <> nil) then begin aResolver.ComputeElement(BinaryEl.Left,LeftResolved,[]); - LeftResolvedType := LeftResolved.BaseType; - aResolver.ComputeElement(BinaryEl.Right,RightResolved,[]); - RightResolvedType := RightResolved.BaseType; - aResolver.ComputeBinaryExprRes(BinaryEl,ResolvedEl,[],LeftResolved,RightResolved); - - IntResType := ResolvedEl.BaseType; + ToType := ResolvedEl.BaseType; end; - if IntResType in btAllJSInteger then + if ToType in [btByte,btShortInt,btWord,btSmallInt,btLongWord,btLongInt] then begin + // if the expression is used as the array index, then for LongInt and LongWord type we can ignore the possibility of integer overflow + if IsArrayIndexExpr and (ToType in [btLongInt,btLongWord]) then + exit; + if BinaryEl.OpCode in [eopMultiply, eopPower (*, eopDiv, eopMod*)] then - NeedBitFix := true + begin + if ParentWillFix and ParentAllowSignificantOverflow then + exit; + + NeedBitFix := true; + end else if BinaryEl.OpCode in [eopAdd, eopSubtract, eopAnd, eopOr, eopXor, eopShr, eopShl] then begin if ParentWillFix then - Exit; + exit; // no need to fix value for "shr" operation or LongInt type and bitwise operation if (BinaryEl.OpCode in [eopAdd, eopSubtract]) or - ((BinaryEl.OpCode in [eopAnd, eopOr, eopXor]) and (IntResType <> btLongint)) then + ((BinaryEl.OpCode in [eopAnd, eopOr, eopXor]) and (ToType <> btLongint)) then NeedBitFix := true // "shl" operation expanded to 32-bit else - if (BinaryEl.OpCode = eopShl) and (IntResType = btLongWord) then + if (BinaryEl.OpCode = eopShl) and (ToType = btLongWord) then NeedBitFix := true; - - // optimize And operation, remove redandant fix operation - if NeedBitFix and (BinaryEl.OpCode = eopAnd) and (IntResType = btLongWord) and - (Result is TJSBitwiseAndExpression) then - begin - AndEx := TJSBitwiseAndExpression(Result); - if IsLiteralInteger(AndEx.A, Int) and (Int <= $7fffffff) then - NeedBitFix := false; - - if IsLiteralInteger(AndEx.B, Int) and (Int <= $7fffffff) then - NeedBitFix := false; - end; end; end; end @@ -11396,27 +11453,51 @@ WriteLn('El.Parent=', El.Parent.ClassName, ', Context=', AContext.ClassName); RightResolved := AssignContext.RightResolved; RightResolvedType := RightResolved.BaseType; - if (LeftResolvedType in btAllJSInteger) and (RightResolvedType in btAllJSInteger) and - UseLeftTypeForAssignment(LeftResolvedType, RightResolvedType) then + if UseLeftTypeForAssignment(LeftResolvedType, RightResolvedType) then begin - {$IFDEF VerbosePas2JS} - writeln('TPasToJSConverter.CreateIntegerBitFixAuto.3 ToType=',aResolver.BaseTypeNames[LeftResolvedType]); - {$ENDIF} - if Result is TJSSimpleAssignStatement then - TJSSimpleAssignStatement(Result).Expr := CreateIntegerBitFix(El, TJSSimpleAssignStatement(Result).Expr, LeftResolvedType); + NeedBitFix := true; + ToType := LeftResolvedType; + + // if we are assigning value to the TypedArray, then we can omit typecasting + if (aResolver <> nil) and (LeftResolved.IdentEl is TPasProperty) then + begin + PropertyEl := TPasProperty(LeftResolved.IdentEl); + if aResolver.IsExternalBracketAccessor(aResolver.GetPasPropertySetter(PropertyEl)) then + begin + if PropertyEl.Parent is TPasClassType then + begin + if (ToType = btByte) and + aResolver.IsExternalClass_Name(TPasClassType(PropertyEl.Parent),'Uint8Array') then + NeedBitFix := false + else if (ToType = btShortInt) and + aResolver.IsExternalClass_Name(TPasClassType(PropertyEl.Parent),'Int8Array') then + NeedBitFix := false + else if (ToType = btWord) and + aResolver.IsExternalClass_Name(TPasClassType(PropertyEl.Parent),'Uint16Array') then + NeedBitFix := false + else if (ToType = btSmallInt) and + aResolver.IsExternalClass_Name(TPasClassType(PropertyEl.Parent),'Int16Array') then + NeedBitFix := false + else if (ToType = btLongWord) and + aResolver.IsExternalClass_Name(TPasClassType(PropertyEl.Parent),'Uint32Array') then + NeedBitFix := false + else if (ToType = btLongInt) and + aResolver.IsExternalClass_Name(TPasClassType(PropertyEl.Parent),'Int32Array') then + NeedBitFix := false; + end; + end; + end; + + if NeedBitFix and (Result is TJSSimpleAssignStatement) then + TJSSimpleAssignStatement(Result).Expr := CreateIntegerBitFix(El, TJSSimpleAssignStatement(Result).Expr, ToType); exit; end; end; end; - {$IFDEF VerbosePas2JS} - writeln('TPasToJSConverter.CreateIntegerBitFixAuto.2 IntResType=',aResolver.BaseTypeNames[IntResType]); - {$ENDIF} - if not NeedBitFix then - Exit; - - Result := CreateIntegerBitFix(El, Result, IntResType); + if NeedBitFix then + Result := CreateIntegerBitFix(El, Result, ToType); end; function TPasToJSConverter.ConvertInheritedExpr(El: TInheritedExpr; @@ -23671,7 +23752,7 @@ begin T.LHS:=LHS; Result:=T; if AssignContext.LeftResolved.BaseType in btAllJSInteger then - Result := CreateIntegerBitFixAuto(El,AssignContext,Result); + Result:=CreateIntegerBitFixAuto(El,AssignContext,Result); LHS:=nil; if (bsRangeChecks in AContext.ScannerBoolSwitches) From 5c650a39a6b90e4a1edfe6c9acc282ebfb86d36d Mon Sep 17 00:00:00 2001 From: Dmytro Date: Thu, 21 Oct 2021 00:30:21 +0300 Subject: [PATCH 04/11] Fixed arithmetic for simple integer types (follow-up, done) --- packages/pastojs/src/fppas2js.pp | 264 ++++++++++++++++++++++--------- 1 file changed, 189 insertions(+), 75 deletions(-) diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 1abe141b89..6b22994a5a 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -465,8 +465,6 @@ unit FPPas2Js; {$IFOPT Q+}{$DEFINE OverflowCheckOn}{$ENDIF} {$IFOPT R+}{$DEFINE RangeCheckOn}{$ENDIF} -{$define VerbosePas2JS} - interface uses @@ -2251,15 +2249,16 @@ type Function ConvertCharToInt(Arg: TJSElement; PosEl: TPasElement; ArgContext: TConvertContext): TJSElement; virtual; Function ConvertIntToInt(Arg: TJSElement; FromBT, ToBT: TResolverBaseType; PosEl: TPasElement; ArgContext: TConvertContext): TJSElement; virtual; Function CreateBitwiseAnd(El: TPasElement; Value: TJSElement; const Mask: TMaxPrecInt): TJSElement; virtual; + Function CreateBitwiseXor(El: TPasElement; Value: TJSElement; const Mask: TMaxPrecInt): TJSElement; virtual; Function CreateBitwiseShiftLeftRight(El: TPasElement; Value: TJSElement; Shift: integer): TJSElement; virtual; - function CreateByteBitFix(El: TPasElement; Value: TJSElement): TJSElement; virtual; - function CreateShortIntBitFix(El: TPasElement; Value: TJSElement): TJSElement; virtual; - function CreateWordBitFix(El: TPasElement; Value: TJSElement): TJSElement; virtual; - function CreateSmallIntBitFix(El: TPasElement; Value: TJSElement): TJSElement; virtual; - function CreateLongwordBitFix(El: TPasElement; Value: TJSElement): TJSElement; virtual; - function CreateLongIntBitFix(El: TPasElement; Value: TJSElement): TJSElement; virtual; - function CreateIntegerBitFix(El: TPasElement; Value: TJSElement; ToType : TResolverBaseType): TJSElement; - function CreateIntegerBitFixAuto(El: TPasElement; AContext: TConvertContext; Value: TJSElement): TJSElement; virtual; + Function CreateByteBitFix(El: TPasElement; Value: TJSElement): TJSElement; virtual; + Function CreateShortIntBitFix(El: TPasElement; Value: TJSElement): TJSElement; virtual; + Function CreateWordBitFix(El: TPasElement; Value: TJSElement): TJSElement; virtual; + Function CreateSmallIntBitFix(El: TPasElement; Value: TJSElement): TJSElement; virtual; + Function CreateLongwordBitFix(El: TPasElement; Value: TJSElement): TJSElement; virtual; + Function CreateLongIntBitFix(El: TPasElement; Value: TJSElement): TJSElement; virtual; + Function CreateIntegerBitFix(El: TPasElement; Value: TJSElement; ToType : TResolverBaseType): TJSElement; + Function CreateIntegerBitFixAuto(El: TPasElement; AContext: TConvertContext; Value: TJSElement): TJSElement; virtual; Function ConvertParamsExpr(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual; Function ConvertArrayParams(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual; Function ConvertFuncParams(El: TParamsExpr; AContext: TConvertContext): TJSElement; virtual; @@ -8805,6 +8804,7 @@ Var U : TJSUnaryExpression; E : TJSElement; ResolvedEl: TPasResolverResult; + ResolvedType : TResolverBaseType; BitwiseNot: Boolean; aResolver: TPas2JSResolver; TypeEl, SubTypeEl: TPasType; @@ -8832,13 +8832,20 @@ begin begin E:=ConvertExpression(El.Operand,AContext); BitwiseNot:=true; + ResolvedType:=btNone; if aResolver<>nil then begin aResolver.ComputeElement(El.Operand,ResolvedEl,[]); - BitwiseNot:=ResolvedEl.BaseType in btAllJSInteger; + ResolvedType:=ResolvedEl.BaseType; + BitwiseNot:=ResolvedType in btAllJSInteger; end; if BitwiseNot then begin + if ResolvedType = btByte then + exit(CreateBitwiseXor(El,E,$ff)); + if ResolvedType = btWord then + exit(CreateBitwiseXor(El,E,$ffff)); + U:=TJSUnaryInvExpression(CreateElement(TJSUnaryInvExpression,El)); U.A:=E; exit(CreateIntegerBitFixAuto(El,AContext,U)); @@ -11087,13 +11094,73 @@ begin end; end; - AndEx:=TJSBitwiseAndExpression(CreateElement(TJSBitwiseAndExpression,El)); - Result:=AndEx; - AndEx.A:=Value; - AndEx.B:=CreateLiteralNumber(El,Mask); + AndEx := TJSBitwiseAndExpression(CreateElement(TJSBitwiseAndExpression,El)); + Result := AndEx; + AndEx.A := Value; + AndEx.B := CreateLiteralNumber(El, Mask); SetNumberCustomValue(TJSLiteral(AndEx.B), Mask); end; +function TPasToJSConverter.CreateBitwiseXor(El: TPasElement; Value: TJSElement; + const Mask: TMaxPrecInt): TJSElement; + + procedure SetNumberCustomValue(V: TJSLiteral; const Value: TMaxPrecInt); + var + Hex: String; + i: Integer; + begin + if Value>999999 then + begin + Hex:=HexStr(Value,8); + i:=1; + while i<8 do + if Hex[i]='0' then + inc(i) + else + break; + Hex:=Copy(Hex,i,8); + V.Value.CustomValue:=TJSString('0x'+Hex); + end + else + V.Value.CustomValue:=TJSString(''); + end; + +var + XorEx: TJSBitwiseXorExpression; + Int: TMaxPrecInt; +begin + if IsLiteralInteger(Value,Int) then + begin + TJSLiteral(Value).Value.AsNumber := Int xor Mask; + SetNumberCustomValue(TJSLiteral(Value), Int xor Mask); + exit(Value); + end + else + if Value is TJSBitwiseXorExpression then + begin + XorEx := TJSBitwiseXorExpression(Value); + if IsLiteralInteger(XorEx.A,Int) then + begin + TJSLiteral(XorEx.A).Value.AsNumber := Int xor Mask; + SetNumberCustomValue(TJSLiteral(XorEx.A), Int xor Mask); + exit(Value); + end; + + if IsLiteralInteger(XorEx.B,Int) then + begin + TJSLiteral(XorEx.B).Value.AsNumber := Int xor Mask; + SetNumberCustomValue(TJSLiteral(XorEx.B), Int xor Mask); + exit(Value); + end; + end; + + XorEx := TJSBitwiseXorExpression(CreateElement(TJSBitwiseXorExpression,El)); + Result := XorEx; + XorEx.A := Value; + XorEx.B := CreateLiteralNumber(El, Mask); + SetNumberCustomValue(TJSLiteral(XorEx.B), Mask); +end; + Function TPasToJSConverter.CreateBitwiseShiftLeftRight(El: TPasElement; Value: TJSElement; Shift: integer): TJSElement; var ShiftEx: TJSShiftExpression; @@ -11273,10 +11340,8 @@ var ParamsEl : TParamsExpr; PropertyEl : TPasProperty; ToType, LeftResolvedType, RightResolvedType : TResolverBaseType; - Int: TMaxPrecInt; - AndEx : TJSBitwiseAndExpression; AssignContext : TAssignContext; - NeedBitFix, ParentWillFix, ParentAllowSignificantOverflow, IsArrayIndexExpr : Boolean; + NeedBitFix, ParentWillFixOverflow, ParentAllowSignificantOverflow, IsArrayIndexExpr : Boolean; begin if AContext=nil then ; aResolver:=AContext.Resolver; @@ -11287,49 +11352,64 @@ begin {$ENDIF} ToType := btNone; NeedBitFix := false; - ParentWillFix := false; + ParentWillFixOverflow := false; ParentAllowSignificantOverflow := false; IsArrayIndexExpr := false; // checking where current expression is used to decide whether we need to fix integer value now or we can leave it for the parent expression - if El.Parent <> nil then + if (El.Parent <> nil) { todo: disable this if optimization is disabled } then begin if El.Parent is TUnaryExpr then begin UnaryEl := TUnaryExpr(El.Parent); - if UnaryEl.OpCode in [eopSubtract, eopNot] then - ParentWillFix := true; - if UnaryEl.OpCode = eopNot then - ParentAllowSignificantOverflow := true; + if UnaryEl.OpCode = eopSubtract then + ParentWillFixOverflow := true + else if UnaryEl.OpCode = eopNot then + begin + if aResolver <> nil then + begin + aResolver.ComputeElement(UnaryEl.Operand,ResolvedEl,[]); + ToType := ResolvedEl.BaseType; + end; + + // for Byte and Word the "not" operation is implemented using bitwise xor, so there is no need to fix bits but also it won't fix the overflow + if not (ToType in [btNone, btByte, btWord]) then + begin + ParentWillFixOverflow := true; + ParentAllowSignificantOverflow := true; + end; + end; end else if El.Parent is TBinaryExpr then begin BinaryEl := TBinaryExpr(El.Parent); - if aResolver <> nil then + if (aResolver <> nil) and (BinaryEl.OpCode in [eopAdd, eopSubtract, eopAnd, eopOr, eopXor, eopShr, eopShl]) then begin - if BinaryEl.Left = El then - begin - aResolver.ComputeElement(BinaryEl.Left,LeftResolved,[]); - ToType := LeftResolved.BaseType; - end - else - begin - aResolver.ComputeElement(BinaryEl.Right,RightResolved,[]); - ToType := RightResolved.BaseType; - end; + aResolver.ComputeElement(BinaryEl.Left,LeftResolved,[]); + LeftResolvedType := LeftResolved.BaseType; + + aResolver.ComputeElement(BinaryEl.Right,RightResolved,[]); + RightResolvedType := RightResolved.BaseType; + + aResolver.ComputeBinaryExprRes(BinaryEl,ResolvedEl,[],LeftResolved,RightResolved); if BinaryEl.OpCode in [eopShl, eopShr] then begin - ParentWillFix := (BinaryEl.Left = El); - ParentAllowSignificantOverflow := ParentWillFix; + ParentWillFixOverflow := (BinaryEl.Left = El) and (ResolvedEl.BaseType in [btLongInt,btLongWord]); + ParentAllowSignificantOverflow := ParentWillFixOverflow; end else if BinaryEl.OpCode in [eopAnd, eopOr, eopXor] then begin - ParentWillFix := true; - ParentAllowSignificantOverflow := true; + ParentWillFixOverflow := ResolvedEl.BaseType in [btLongInt,btLongWord]; + ParentAllowSignificantOverflow := ParentWillFixOverflow; end else if BinaryEl.OpCode in [eopAdd, eopSubtract] then - ParentWillFix := true; + ParentWillFixOverflow := true; + + if BinaryEl.Left = El then + ToType := LeftResolvedType + else + ToType := RightResolvedType; end; end else if El.Parent is TPasImplAssign then @@ -11347,7 +11427,7 @@ begin // select smallest type by size if UseLeftTypeForAssignment(LeftResolvedType, RightResolvedType) then begin - ParentWillFix := true; + ParentWillFixOverflow := true; ParentAllowSignificantOverflow := true; ToType := LeftResolvedType; end @@ -11370,11 +11450,8 @@ begin if El is TUnaryExpr then begin UnaryEl := TUnaryExpr(El); - if UnaryEl.OpCode in [eopAdd, eopSubtract, eopNot] then + if UnaryEl.OpCode in [eopSubtract, eopNot] then begin - if ParentWillFix then - Exit; - if (ToType = btNone) and (aResolver <> nil) then begin aResolver.ComputeElement(UnaryEl.Operand,ResolvedEl,[]); @@ -11383,18 +11460,27 @@ begin if ToType in [btByte,btShortInt,btWord,btSmallInt,btLongWord,btLongInt] then begin - // if the expression is used as the array index, then for LongInt and LongWord type we can ignore the possibility of integer overflow - if IsArrayIndexExpr and (ToType in [btLongInt,btLongWord]) then - Exit; + if UnaryEl.OpCode = eopSubtract then + begin + if ParentWillFixOverflow then + exit; + + // if the expression is used as the array index, then for LongInt and LongWord types we can ignore the possibility of integer overflow + if IsArrayIndexExpr and (ToType in [btLongInt,btLongWord]) then + exit; + + // no need to fix value for "subtract" operation and constant + if (UnaryEl.Operand is TPrimitiveExpr) and (TPrimitiveExpr(UnaryEl.Operand).Kind = pekNumber) then + exit; - // no need to fix value for "add" operation - // no need to fix value for "not" operation for LongInt - if (UnaryEl.OpCode = eopNot) and (ToType <> btLongint) then - NeedBitFix := true - // no need to fix value for "subtract" operation and constant - else if (UnaryEl.OpCode = eopSubtract) and - not ((UnaryEl.Operand is TPrimitiveExpr) and (TPrimitiveExpr(UnaryEl.Operand).Kind = pekNumber)) then NeedBitFix := true; + end + else // UnaryEl.OpCode = eopNot + begin + // no need to fix value for "not" operation for Byte, Word and LongInt. Also overflow automatically will be fixed for LongInt. + if (UnaryEl.OpCode = eopNot) and (ToType in [btShortInt,btSmallInt,btLongWord]) then + NeedBitFix := true; + end; end; end; end @@ -11412,13 +11498,13 @@ begin if ToType in [btByte,btShortInt,btWord,btSmallInt,btLongWord,btLongInt] then begin - // if the expression is used as the array index, then for LongInt and LongWord type we can ignore the possibility of integer overflow + // if the expression is used as the array index, then for LongInt and LongWord types we can ignore the possibility of integer overflow if IsArrayIndexExpr and (ToType in [btLongInt,btLongWord]) then exit; if BinaryEl.OpCode in [eopMultiply, eopPower (*, eopDiv, eopMod*)] then begin - if ParentWillFix and ParentAllowSignificantOverflow then + if ParentWillFixOverflow and ParentAllowSignificantOverflow then exit; NeedBitFix := true; @@ -11426,17 +11512,18 @@ begin else if BinaryEl.OpCode in [eopAdd, eopSubtract, eopAnd, eopOr, eopXor, eopShr, eopShl] then begin - if ParentWillFix then + if ParentWillFixOverflow then exit; - // no need to fix value for "shr" operation or LongInt type and bitwise operation - if (BinaryEl.OpCode in [eopAdd, eopSubtract]) or - ((BinaryEl.OpCode in [eopAnd, eopOr, eopXor]) and (ToType <> btLongint)) then + if (BinaryEl.OpCode in [eopAdd, eopSubtract]) then + NeedBitFix := true + // no need to fix value for bitwise operation for everything except LongWord + else if (BinaryEl.OpCode in [eopAnd, eopOr, eopXor]) and (ToType = btLongWord) then NeedBitFix := true // "shl" operation expanded to 32-bit - else - if (BinaryEl.OpCode = eopShl) and (ToType = btLongWord) then + else if (BinaryEl.OpCode = eopShl) and (ToType = btLongWord) then NeedBitFix := true; + // no need to fix value for "shr" operation end; end; end @@ -14085,7 +14172,6 @@ begin AddJS:=TJSAdditiveExpressionPlus(CreateElement(TJSAdditiveExpressionPlus,SrcEl)) else AddJS:=TJSAdditiveExpressionMinus(CreateElement(TJSAdditiveExpressionMinus,SrcEl)); - Call.AddArg(AddJS); // create "ref.get()" AddJS.A:=TJSCallExpression(CreateElement(TJSCallExpression,SrcEl)); TJSCallExpression(AddJS.A).Expr:=CreateDotNameExpr(SrcEl, @@ -14093,8 +14179,12 @@ begin TJSString(TempRefObjGetterName)); // add "b" AddJS.B:=ValueJS; - ValueJS:=nil; + if ExprResolved.BaseType in [btByte,btShortInt,btWord,btSmallInt,btLongInt,btLongWord] then + Call.AddArg(CreateIntegerBitFix(El,AddJS,ExprResolved.BaseType)) + else + Call.AddArg(AddJS); + ValueJS:=nil; Result:=Call; exit; end; @@ -14126,17 +14216,41 @@ begin RaiseInconsistency(20180622211919,El); end; - // convert inc(avar,b) to a+=b - if IsInc then - AssignSt:=TJSAddEqAssignStatement(CreateElement(TJSAddEqAssignStatement,SrcEl)) - else - AssignSt:=TJSSubEqAssignStatement(CreateElement(TJSSubEqAssignStatement,SrcEl)); + if ExprResolved.BaseType in [btByte,btShortInt,btWord,btSmallInt,btLongInt,btLongWord] then + begin + // convert inc(avar,b) to a=a+b - AssignSt.LHS:=LHS; - LHS:=nil; - AssignSt.Expr:=AssignContext.RightSide; - AssignContext.RightSide:=nil; - Result:=AssignSt; + AssignSt:=TJSSimpleAssignStatement(CreateElement(TJSSimpleAssignStatement,SrcEl)); + AssignSt.LHS:=LHS; + LHS:=ConvertExpression(Expr,AssignContext); + + // create "+" + if IsInc then + AddJS:=TJSAdditiveExpressionPlus(CreateElement(TJSAdditiveExpressionPlus,SrcEl)) + else + AddJS:=TJSAdditiveExpressionMinus(CreateElement(TJSAdditiveExpressionMinus,SrcEl)); + + AssignSt.Expr:=CreateIntegerBitFix(El,AddJS,ExprResolved.BaseType); + AddJS.A:=LHS; + LHS:=nil; + AddJS.B:=AssignContext.RightSide; + AssignContext.RightSide:=nil; + Result:=AssignSt; + end + else + begin + // convert inc(avar,b) to a+=b + if IsInc then + AssignSt:=TJSAddEqAssignStatement(CreateElement(TJSAddEqAssignStatement,SrcEl)) + else + AssignSt:=TJSSubEqAssignStatement(CreateElement(TJSSubEqAssignStatement,SrcEl)); + + AssignSt.LHS:=LHS; + LHS:=nil; + AssignSt.Expr:=AssignContext.RightSide; + AssignContext.RightSide:=nil; + Result:=AssignSt; + end; finally ValueJS.Free; if Result=nil then From 38207649e8b42db56d0c1e5dfb8ac5e64d4205f1 Mon Sep 17 00:00:00 2001 From: Dmytro Date: Sat, 23 Oct 2021 14:59:20 +0300 Subject: [PATCH 05/11] Added TruncateIntegersOnOverflow compiler option --- packages/pastojs/src/fppas2js.pp | 106 +++++++++++++++++++++---- packages/pastojs/src/pas2jscompiler.pp | 8 ++ packages/pastojs/src/pas2jsfiler.pp | 3 +- packages/pastojs/tests/tcmodules.pas | 32 ++++---- 4 files changed, 118 insertions(+), 31 deletions(-) diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 6b22994a5a..d9989b6ce0 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -1424,7 +1424,8 @@ type coRTLVersionCheckSystem, // insert rtl version check into system unit init coRTLVersionCheckUnit, // insert rtl version check into every unit init coShortRefGlobals, // use short local variables for global identifiers - coObfuscateLocalIdentifiers // use auto generated names for private and local Pascal identifiers + coObfuscateLocalIdentifiers, // use auto generated names for private and local Pascal identifiers + coTruncateIntegersOnOverflow // whether to truncate integers in case of overflow or not) is not ); TPasToJsConverterOptions = set of TPasToJsConverterOption; const @@ -3034,6 +3035,8 @@ begin HandleBoolean(coShortRefGlobals,true); 'jsobfuscatelocalidentifiers': HandleBoolean(coObfuscateLocalIdentifiers,true); + 'jstruncateintegersonoverflow': + HandleBoolean(coTruncateIntegersOnOverflow,true); else DoLog(mtWarning,nWarnIllegalCompilerDirectiveX,sWarnIllegalCompilerDirectiveX,['optimization '+OptName]); end; @@ -5828,9 +5831,32 @@ procedure TPas2JSResolver.ComputeBinaryExprRes(Bin: TBinaryExpr; out end; end; + function GetPrimitiveExprSmallestIntegerBaseTypeNeg(PrimExpr : TPrimitiveExpr) : TResolverBaseType; + var + Value: TResEvalValue; + Int: TMaxPrecInt; + begin + Value:=Eval(PrimExpr,[]); + if Value=nil then + RaiseInternalError(20211011142903); + try + case Value.Kind of + revkInt: + begin + Int:=-(TResEvalInt(Value).Int + 1); // not + Result:=GetSmallestIntegerBaseType(Int,Int); + end; + else + RaiseInternalError(20211011142904); + end; + finally + ReleaseEvalValue(Value); + end; + end; + procedure SetIntValueExpr(Flags: TPasResolverResultFlags); var - LeftBaseType, RightBaseType: TResolverBaseType; + LeftBaseType, RightBaseType, LeftBaseTypeNeg, RightBaseTypeNeg: TResolverBaseType; begin {$IFDEF VerbosePas2JS} writeln('TPas2JSResolver.ComputeBinaryExprRes LeftClass=',GetClassAncestorsDbg(TPasClassType(LeftResolved.LoTypeEl)),', RightClass=',GetClassAncestorsDbg(TPasClassType(RightResolved.LoTypeEl)),', OpCode: ',OpcodeStrings[Bin.OpCode]); @@ -5838,6 +5864,8 @@ procedure TPas2JSResolver.ComputeBinaryExprRes(Bin: TBinaryExpr; out LeftBaseType := LeftResolved.BaseType; RightBaseType := RightResolved.BaseType; + LeftBaseTypeNeg := btNone; + RightBaseTypeNeg := btNone; if Bin.OpCode in [eopAdd, eopSubtract, eopMultiply, eopDiv, eopMod, eopPower] then begin if (RightBaseType = btLongWord) and (LeftBaseType = btLongInt) and (Bin.Left is TPrimitiveExpr) and @@ -5899,8 +5927,9 @@ procedure TPas2JSResolver.ComputeBinaryExprRes(Bin: TBinaryExpr; out (LeftResolved.ExprEl is TPrimitiveExpr) and (TPrimitiveExpr(LeftResolved.ExprEl).Kind = pekNumber) then begin LeftBaseType := GetPrimitiveExprSmallestIntegerBaseType(TPrimitiveExpr(LeftResolved.ExprEl)); + LeftBaseTypeNeg := GetPrimitiveExprSmallestIntegerBaseTypeNeg(TPrimitiveExpr(LeftResolved.ExprEl)); {$IFDEF VerbosePas2JS} - writeln('TPas2JSResolver.ComputeBinaryExprRes Left is Primitive type=',BaseTypeNames[LeftBaseType]); + writeln('TPas2JSResolver.ComputeBinaryExprRes Left is Primitive type=',BaseTypeNames[LeftBaseType],' type2=',BaseTypeNames[LeftBaseTypeNeg]); {$ENDIF} end; @@ -5908,8 +5937,9 @@ procedure TPas2JSResolver.ComputeBinaryExprRes(Bin: TBinaryExpr; out (RightResolved.ExprEl is TPrimitiveExpr) and (TPrimitiveExpr(RightResolved.ExprEl).Kind = pekNumber) then begin RightBaseType := GetPrimitiveExprSmallestIntegerBaseType(TPrimitiveExpr(RightResolved.ExprEl)); + RightBaseTypeNeg := GetPrimitiveExprSmallestIntegerBaseTypeNeg(TPrimitiveExpr(RightResolved.ExprEl)); {$IFDEF VerbosePas2JS} - writeln('TPas2JSResolver.ComputeBinaryExprRes Right is Primitive type=',BaseTypeNames[RightBaseType]); + writeln('TPas2JSResolver.ComputeBinaryExprRes Right is Primitive type=',BaseTypeNames[RightBaseType],' type2=',BaseTypeNames[RightBaseTypeNeg]); {$ENDIF} end; @@ -5920,12 +5950,18 @@ procedure TPas2JSResolver.ComputeBinaryExprRes(Bin: TBinaryExpr; out (RightBaseType in [btByte, btWord]) then SetBaseType(btWord,Flags) else - if (LeftBaseType in [btByte, btShortInt, btSmallInt]) and - (RightBaseType in [btByte, btShortInt, btSmallInt]) then + // bitwise operation of ShortInt with constant gives ShortInt + if ((LeftBaseType = btShortInt) and (Bin.Right is TPrimitiveExpr) and ((RightBaseType = btShortInt) or (RightBaseTypeNeg = btShortInt))) or + ((RightBaseType = btShortInt) and (Bin.Left is TPrimitiveExpr) and ((LeftBaseType = btShortInt) or (LeftBaseTypeNeg = btShortInt))) then + SetBaseType(btShortInt,Flags) + else + // also taking into account the case when constant could be either Word or SmallInt + if ((LeftBaseType in [btByte, btShortInt, btSmallInt]) or (LeftBaseTypeNeg = btSmallInt)) and + ((RightBaseType in [btByte, btShortInt, btSmallInt]) or (RightBaseTypeNeg = btSmallInt)) then SetBaseType(btSmallInt,Flags) else - if (LeftBaseType in [btByte, btShortInt, btWord, btSmallInt, btLongInt]) and - (RightBaseType in [btByte, btShortInt, btWord, btSmallInt, btLongInt]) then + if ((LeftBaseType in [btByte, btShortInt, btWord, btSmallInt, btLongInt]) or (LeftBaseTypeNeg = btLongInt)) and + ((RightBaseType in [btByte, btShortInt, btWord, btSmallInt, btLongInt]) or (RightBaseTypeNeg = btLongInt)) then SetBaseType(btLongInt,Flags) else if (LeftBaseType in [btByte, btShortInt, btWord, btSmallInt, btLongInt, btLongWord]) and @@ -5943,6 +5979,7 @@ procedure TPas2JSResolver.ComputeBinaryExprRes(Bin: TBinaryExpr; out // default behavior SetBaseType(LeftBaseType, Flags); end; + {$IFDEF VerbosePas2JS} writeln('TPas2JSResolver.ComputeBinaryExprRes Result=',GetClassAncestorsDbg(TPasClassType(ResolvedEl.LoTypeEl))); {$endif} @@ -9037,7 +9074,6 @@ begin if El is TJSLiteral then exit(IsLiteralInteger(El, Number)); - // TODO: check overflow if El is TJSUnaryMinusExpression then begin Result := IsLiteralIntegerExpr(TJSUnaryMinusExpression(El).A, Number); @@ -11351,6 +11387,47 @@ begin writeln('TPasToJSConverter.CreateIntegerBitFixAuto Value=',Value.ClassName,', El.Parent=', El.Parent.ClassName, ', Context=', AContext.ClassName); {$ENDIF} ToType := btNone; + + if not (coTruncateIntegersOnOverflow in Options) then + begin + // for backward compatibility applying fix only for LongWord type and bitwise operations + if El is TUnaryExpr then + begin + UnaryEl := TUnaryExpr(El); + if UnaryEl.OpCode = eopNot then + begin + if aResolver <> nil then + begin + aResolver.ComputeElement(UnaryEl.Operand,ResolvedEl,[]); + ToType := ResolvedEl.BaseType; + end; + + if ToType = btLongWord then + Result := CreateLongwordBitFix(El, Result); + end; + end + else + if El is TBinaryExpr then + begin + BinaryEl := TBinaryExpr(El); + if BinaryEl.OpCode in [eopAnd, eopOr, eopXor, eopShr, eopShl] then + begin + if aResolver <> nil then + begin + aResolver.ComputeElement(BinaryEl.Left,LeftResolved,[]); + aResolver.ComputeElement(BinaryEl.Right,RightResolved,[]); + aResolver.ComputeBinaryExprRes(BinaryEl,ResolvedEl,[],LeftResolved,RightResolved); + ToType := ResolvedEl.BaseType; + end; + + if ToType = btLongWord then + Result := CreateLongwordBitFix(El, Result); + end; + end; + + exit; + end; + NeedBitFix := false; ParentWillFixOverflow := false; ParentAllowSignificantOverflow := false; @@ -11372,8 +11449,8 @@ begin ToType := ResolvedEl.BaseType; end; - // for Byte and Word the "not" operation is implemented using bitwise xor, so there is no need to fix bits but also it won't fix the overflow - if not (ToType in [btNone, btByte, btWord]) then + // for Byte, Word, ShortInt, SmallInt there is no need to fix bits but also it won't fix the overflow + if ToType in [btLongInt, btLongWord] then begin ParentWillFixOverflow := true; ParentAllowSignificantOverflow := true; @@ -11477,8 +11554,8 @@ begin end else // UnaryEl.OpCode = eopNot begin - // no need to fix value for "not" operation for Byte, Word and LongInt. Also overflow automatically will be fixed for LongInt. - if (UnaryEl.OpCode = eopNot) and (ToType in [btShortInt,btSmallInt,btLongWord]) then + // fixing value for "not" operation only for LongWord. Also overflow automatically will be fixed for LongInt. + if (UnaryEl.OpCode = eopNot) and (ToType = btLongWord) then NeedBitFix := true; end; end; @@ -11488,7 +11565,8 @@ begin if El is TBinaryExpr then begin BinaryEl := TBinaryExpr(El); - if (ToType = btNone) and (aResolver <> nil) then + if (ToType = btNone) and (aResolver <> nil) and + (BinaryEl.OpCode in [eopMultiply, eopPower, eopAdd, eopSubtract, eopAnd, eopOr, eopXor, eopShr, eopShl]) then begin aResolver.ComputeElement(BinaryEl.Left,LeftResolved,[]); aResolver.ComputeElement(BinaryEl.Right,RightResolved,[]); diff --git a/packages/pastojs/src/pas2jscompiler.pp b/packages/pastojs/src/pas2jscompiler.pp index 70f01b5398..2ab337272b 100644 --- a/packages/pastojs/src/pas2jscompiler.pp +++ b/packages/pastojs/src/pas2jscompiler.pp @@ -140,6 +140,7 @@ type coKeepNotUsedDeclarationsWPO, // -O- coShortRefGlobals, // -O2 coObfuscateLocalIdentifiers, // -O2 + coTruncateIntegersOnOverflow, // source map coSourceMapCreate, coSourceMapInclude, @@ -203,6 +204,7 @@ const 'Keep not used declarations (WPO)', 'Create short local variables for globals', 'Obfuscate local identifiers', + 'Truncate integers in case of overflow', 'Create source map', 'Include Pascal sources in source map', 'Do not shorten filenames in source map', @@ -1070,6 +1072,11 @@ begin if coObfuscateLocalIdentifiers in Compiler.Options then Include(Result,fppas2js.coObfuscateLocalIdentifiers); + if coTruncateIntegersOnOverflow in Compiler.Options then + Include(Result,fppas2js.coTruncateIntegersOnOverflow) + else + Exclude(Result,fppas2js.coTruncateIntegersOnOverflow); + if coLowerCase in Compiler.Options then Include(Result,fppas2js.coLowerCase) else @@ -3831,6 +3838,7 @@ begin 'removenotuseddeclarations': SetOption(coKeepNotUsedDeclarationsWPO,not Enable); 'shortrefglobals': SetOption(coShortRefGlobals,Enable); 'obfuscatelocalidentifiers': SetOption(coObfuscateLocalIdentifiers,Enable); + 'truncateintegersonoverflow': SetOption(coTruncateIntegersOnOverflow,Enable); else Log.LogMsgIgnoreFilter(nUnknownOptimizationOption,[QuoteStr(aValue)]); end; diff --git a/packages/pastojs/src/pas2jsfiler.pp b/packages/pastojs/src/pas2jsfiler.pp index 2a52db563b..11f21587e0 100644 --- a/packages/pastojs/src/pas2jsfiler.pp +++ b/packages/pastojs/src/pas2jsfiler.pp @@ -268,7 +268,8 @@ const 'RTLVersionCheckSystem', 'RTLVersionCheckUnit', 'ShortRefGlobals', - 'ObfuscateLocalIdentifiers' + 'ObfuscateLocalIdentifiers', + 'TruncateIntegersOnOverflow' ); PCUDefaultTargetPlatform = PlatformBrowser; diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas index 92ca6958c5..5b78c2b2a9 100644 --- a/packages/pastojs/tests/tcmodules.pas +++ b/packages/pastojs/tests/tcmodules.pas @@ -4136,22 +4136,22 @@ begin LinesToStr([ // this.$main '$mod.a = 0x12345678;', '$mod.b = 0xEDCBA987;', - '$mod.c = rtl.lw(~$mod.a);', - '$mod.c = rtl.lw($mod.a & $mod.b);', - '$mod.c = rtl.lw($mod.a & 0xffff0000);', - '$mod.c = rtl.lw($mod.a | $mod.b);', - '$mod.c = rtl.lw($mod.a | 0xff00ff00);', - '$mod.c = rtl.lw($mod.a ^ $mod.b);', - '$mod.c = rtl.lw($mod.a ^ 0xf0f0f0f0);', - '$mod.c = rtl.lw($mod.a << 1);', - '$mod.c = rtl.lw($mod.a << 16);', - '$mod.c = rtl.lw($mod.a << 24);', - '$mod.c = rtl.lw($mod.a << $mod.b);', - '$mod.c = rtl.lw($mod.a >>> 1);', - '$mod.c = rtl.lw($mod.a >>> 16);', - '$mod.c = rtl.lw($mod.a >>> 24);', - '$mod.c = rtl.lw($mod.a >>> $mod.b);', - '$mod.c = rtl.lw(rtl.lw($mod.b & $mod.c) | rtl.lw($mod.a & $mod.b));', + '$mod.c = ~$mod.a >>> 0;', + '$mod.c = ($mod.a & $mod.b) >>> 0;', + '$mod.c = ($mod.a & 0xffff0000) >>> 0;', + '$mod.c = ($mod.a | $mod.b) >>> 0;', + '$mod.c = ($mod.a | 0xff00ff00) >>> 0;', + '$mod.c = ($mod.a ^ $mod.b) >>> 0;', + '$mod.c = ($mod.a ^ 0xf0f0f0f0) >>> 0;', + '$mod.c = ($mod.a << 1) >>> 0;', + '$mod.c = ($mod.a << 16) >>> 0;', + '$mod.c = ($mod.a << 24) >>> 0;', + '$mod.c = ($mod.a << $mod.b) >>> 0;', + '$mod.c = $mod.a >>> 1;', + '$mod.c = $mod.a >>> 16;', + '$mod.c = $mod.a >>> 24;', + '$mod.c = $mod.a >>> $mod.b;', + '$mod.c = ((($mod.b & $mod.c) >>> 0) | (($mod.a & $mod.b) >>> 0)) >>> 0;', '$mod.c = $mod.i & $mod.a;', '$mod.c = $mod.i | $mod.a;', '$mod.c = $mod.i ^ $mod.a;', From c276cda46602d854f78ca6777f1fa1aac11b12d5 Mon Sep 17 00:00:00 2001 From: Dmytro Date: Sat, 23 Oct 2021 15:28:01 +0300 Subject: [PATCH 06/11] Updated description for TruncateIntegersOnOverflow compiler option --- packages/pastojs/src/pas2jscompiler.pp | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/packages/pastojs/src/pas2jscompiler.pp b/packages/pastojs/src/pas2jscompiler.pp index 2ab337272b..9da8fcfaac 100644 --- a/packages/pastojs/src/pas2jscompiler.pp +++ b/packages/pastojs/src/pas2jscompiler.pp @@ -165,7 +165,7 @@ const DefaultResourceMode = rmHTML; coShowAll = [coShowErrors..coShowDebug]; - coAllOptimizations = [coEnumValuesAsNumbers..coObfuscateLocalIdentifiers]; + coAllOptimizations = [coEnumValuesAsNumbers..coTruncateIntegersOnOverflow]; coO0 = [coKeepNotUsedPrivates,coKeepNotUsedDeclarationsWPO]; coO1 = [coEnumValuesAsNumbers]; coO2 = coO1+[coShortRefGlobals @@ -3783,6 +3783,7 @@ begin Log.LogPlain('RemoveNotUsedPrivates'); Log.LogPlain('RemoveNotUsedDeclarations'); Log.LogPlain('ShortRefGlobals'); + Log.LogPlain('TruncateIntegersOnOverflow'); end; 't': // write list of supported targets @@ -4849,6 +4850,7 @@ begin {$IFDEF EnableObfuscateIdentifiers} w(' -OoObfuscateLocalIdentifiers[-]: Use auto generated names for private and local Pascal identifiers. Default enabled in -O2'); {$ENDIF} + w(' -OoTruncateIntegersOnOverflow [-]: Whether to truncate integers in case of overflow. Default is disabled'); w(' -P : Set target processor. Case insensitive:'); w(' -Pecmascript5: default'); w(' -Pecmascript6'); @@ -5079,6 +5081,7 @@ begin Log.LogPlain(' EnumNumbers'); Log.LogPlain(' RemoveNotUsedPrivates'); Log.LogPlain(' ShortRefGlobals'); + Log.LogPlain(' TruncateIntegersOnOverflow'); Log.LogLn; Log.LogPlain('Supported Whole Program Optimizations:'); Log.LogPlain(' RemoveNotUsedDeclarations'); From 52d5e1dce46a12a58800454abbebfff047567e7e Mon Sep 17 00:00:00 2001 From: Dmytro Date: Sat, 23 Oct 2021 20:00:13 +0300 Subject: [PATCH 07/11] Minor fixes --- packages/pastojs/src/fppas2js.pp | 21 +++++++++++++++------ packages/pastojs/tests/tcmodules.pas | 16 ++++++++-------- 2 files changed, 23 insertions(+), 14 deletions(-) diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index d9989b6ce0..6227df2fe9 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -5859,7 +5859,11 @@ procedure TPas2JSResolver.ComputeBinaryExprRes(Bin: TBinaryExpr; out LeftBaseType, RightBaseType, LeftBaseTypeNeg, RightBaseTypeNeg: TResolverBaseType; begin {$IFDEF VerbosePas2JS} - writeln('TPas2JSResolver.ComputeBinaryExprRes LeftClass=',GetClassAncestorsDbg(TPasClassType(LeftResolved.LoTypeEl)),', RightClass=',GetClassAncestorsDbg(TPasClassType(RightResolved.LoTypeEl)),', OpCode: ',OpcodeStrings[Bin.OpCode]); + writeln('TPas2JSResolver.ComputeBinaryExprRes OpCode: ',OpcodeStrings[Bin.OpCode]); + if LeftResolved.LoTypeEl is TPasClassType then + writeln(' LeftClass=',GetClassAncestorsDbg(TPasClassType(LeftResolved.LoTypeEl))); + if RightResolved.LoTypeEl is TPasClassType then + writeln(' RightClass=',GetClassAncestorsDbg(TPasClassType(RightResolved.LoTypeEl))); {$ENDIF} LeftBaseType := LeftResolved.BaseType; @@ -5981,7 +5985,8 @@ procedure TPas2JSResolver.ComputeBinaryExprRes(Bin: TBinaryExpr; out end; {$IFDEF VerbosePas2JS} - writeln('TPas2JSResolver.ComputeBinaryExprRes Result=',GetClassAncestorsDbg(TPasClassType(ResolvedEl.LoTypeEl))); + if ResolvedEl.LoTypeEl is TPasClassType then + writeln('TPas2JSResolver.ComputeBinaryExprRes Result=',GetClassAncestorsDbg(TPasClassType(ResolvedEl.LoTypeEl))); {$endif} end; @@ -11384,7 +11389,9 @@ begin Result := Value; {$IFDEF VerbosePas2JS} - writeln('TPasToJSConverter.CreateIntegerBitFixAuto Value=',Value.ClassName,', El.Parent=', El.Parent.ClassName, ', Context=', AContext.ClassName); + writeln('TPasToJSConverter.CreateIntegerBitFixAuto Value=',Value.ClassName, ', Context=', AContext.ClassName); + if El.Parent <> nil then + writeln(' El.Parent=', El.Parent.ClassName); {$ENDIF} ToType := btNone; @@ -11410,7 +11417,7 @@ begin if El is TBinaryExpr then begin BinaryEl := TBinaryExpr(El); - if BinaryEl.OpCode in [eopAnd, eopOr, eopXor, eopShr, eopShl] then + if BinaryEl.OpCode in [eopAnd, eopOr, eopXor, eopShl] then begin if aResolver <> nil then begin @@ -14257,7 +14264,8 @@ begin TJSString(TempRefObjGetterName)); // add "b" AddJS.B:=ValueJS; - if ExprResolved.BaseType in [btByte,btShortInt,btWord,btSmallInt,btLongInt,btLongWord] then + if (coTruncateIntegersOnOverflow in Options) and + (ExprResolved.BaseType in [btByte,btShortInt,btWord,btSmallInt,btLongInt,btLongWord]) then Call.AddArg(CreateIntegerBitFix(El,AddJS,ExprResolved.BaseType)) else Call.AddArg(AddJS); @@ -14294,7 +14302,8 @@ begin RaiseInconsistency(20180622211919,El); end; - if ExprResolved.BaseType in [btByte,btShortInt,btWord,btSmallInt,btLongInt,btLongWord] then + if (coTruncateIntegersOnOverflow in Options) and + (ExprResolved.BaseType in [btByte,btShortInt,btWord,btSmallInt,btLongInt,btLongWord]) then begin // convert inc(avar,b) to a=a+b diff --git a/packages/pastojs/tests/tcmodules.pas b/packages/pastojs/tests/tcmodules.pas index 5b78c2b2a9..e50edca328 100644 --- a/packages/pastojs/tests/tcmodules.pas +++ b/packages/pastojs/tests/tcmodules.pas @@ -3516,7 +3516,7 @@ begin Add(' f = high(word);'); Add('begin'); ConvertProgram; - CheckSource('TestVarBaseTypes', + CheckSource('TestConstBaseTypes', LinesToStr([ 'this.i=3;', 'this.s="foo";', @@ -3829,8 +3829,8 @@ begin 'this.HiWord2 = Math.floor(-0x1234CDEF / 4294967296) >>> 0;', 'this.lo4 = 0x34 & 0xF;', 'this.hi4 = (0x34 >> 4) & 0xF;', - 'this.lo5 = (((-0x34 & 255) << 24) >> 24) & 0xFF;', - 'this.hi5 = ((((-0x34 & 255) << 24) >> 24) >> 8) & 0xFF;', + 'this.lo5 = -0x34 & 0xFF;', + 'this.hi5 = (-0x34 >> 8) & 0xFF;', 'this.lo6 = 0x123456789ABCD >>> 0;', 'this.hi6 = 74565 >>> 0;', 'this.lo7 = -0x123456789ABCD >>> 0;', @@ -4152,9 +4152,9 @@ begin '$mod.c = $mod.a >>> 24;', '$mod.c = $mod.a >>> $mod.b;', '$mod.c = ((($mod.b & $mod.c) >>> 0) | (($mod.a & $mod.b) >>> 0)) >>> 0;', - '$mod.c = $mod.i & $mod.a;', - '$mod.c = $mod.i | $mod.a;', - '$mod.c = $mod.i ^ $mod.a;', + '$mod.c = ($mod.i & $mod.a) >>> 0;', + '$mod.c = ($mod.i | $mod.a) >>> 0;', + '$mod.c = ($mod.i ^ $mod.a) >>> 0;', ''])); end; @@ -8144,7 +8144,7 @@ begin '$mod.w = $mod.i & 65535;', '$mod.sm = (($mod.i & 65535) << 16) >> 16;', '$mod.lw = $mod.i >>> 0;', - '$mod.li = $mod.i & 0xFFFFFFFF;', + '$mod.li = $mod.i | 0;', ''])); end; @@ -8723,7 +8723,7 @@ begin '$mod.c = "\uFFFF";', '$mod.i = $mod.c.charCodeAt() & 255;', '$mod.i = $mod.c.charCodeAt();', - '$mod.i = $mod.c.charCodeAt() & 0xFFFFFFFF;', + '$mod.i = $mod.c.charCodeAt() | 0;', ''])); end; From f70afa779546aff28ef73dfe201288755c5c105e Mon Sep 17 00:00:00 2001 From: Dmytro Date: Wed, 27 Oct 2021 01:34:08 +0300 Subject: [PATCH 08/11] minor fix --- packages/pastojs/src/fppas2js.pp | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 6227df2fe9..ad899c536e 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -5801,8 +5801,17 @@ procedure TPas2JSResolver.ComputeBinaryExprRes(Bin: TBinaryExpr; out procedure SetBaseType(BaseType: TResolverBaseType; Flags: TPasResolverResultFlags); begin - SetResolverValueExpr(ResolvedEl,BaseType,BaseTypes[BaseType],BaseTypes[BaseType], - Bin,Flags); + // A small hack that uses the original type when possible. + // It is required to make type helpers work for integer types in expressions. + if LeftResolved.BaseType = BaseType then + SetResolverValueExpr(ResolvedEl,LeftResolved.BaseType, + LeftResolved.LoTypeEl,LeftResolved.HiTypeEl,Bin,Flags) + else if RightResolved.BaseType = BaseType then + SetResolverValueExpr(ResolvedEl,RightResolved.BaseType, + RightResolved.LoTypeEl,RightResolved.HiTypeEl,Bin,Flags) + else + SetResolverValueExpr(ResolvedEl,BaseType, + BaseTypes[BaseType],BaseTypes[BaseType],Bin,Flags); end; function GetPrimitiveExprSmallestIntegerBaseType(PrimExpr : TPrimitiveExpr) : TResolverBaseType; From 5b66c3ed7daffe742f59ad842a3b67c41f8622eb Mon Sep 17 00:00:00 2001 From: Dmytro Date: Wed, 27 Oct 2021 01:35:59 +0300 Subject: [PATCH 09/11] Added tests for TruncateIntegersOnOverflow option --- packages/pastojs/tests/tcoptimizations.pas | 1594 ++++++++++++++++++++ 1 file changed, 1594 insertions(+) diff --git a/packages/pastojs/tests/tcoptimizations.pas b/packages/pastojs/tests/tcoptimizations.pas index 781465ca62..089b71997e 100644 --- a/packages/pastojs/tests/tcoptimizations.pas +++ b/packages/pastojs/tests/tcoptimizations.pas @@ -108,6 +108,14 @@ type procedure TestWPO_ConstructorDefaultValueConst; procedure TestWPO_RTTI_PublishedField; procedure TestWPO_RTTI_TypeInfo; + + // TruncateIntegersOnOverflow + procedure TestOptTruncateIntegersOnOverflow_OperatorsByte; + procedure TestOptTruncateIntegersOnOverflow_OperatorsShortInt; + procedure TestOptTruncateIntegersOnOverflow_OperatorsWord; + procedure TestOptTruncateIntegersOnOverflow_OperatorsSmallInt; + procedure TestOptTruncateIntegersOnOverflow_OperatorsLongWord; + procedure TestOptTruncateIntegersOnOverflow_OperatorsLongInt; end; implementation @@ -2615,6 +2623,1592 @@ begin CheckDiff('TestWPO_RTTI_TypeInfo',ExpectedSrc,ActualSrc); end; +procedure TTestOptimizations.TestOptTruncateIntegersOnOverflow_OperatorsByte; +begin + StartProgram(false); + Add([ + '{$modeswitch externalclass}', + '{$optimization JSTruncateIntegersOnOverflow ON}', + 'procedure IntTypeTest(v: Byte); overload; begin end;', + 'procedure IntTypeTest(v: ShortInt); overload; begin end;', + 'procedure IntTypeTest(v: Word); overload; begin end;', + 'procedure IntTypeTest(v: SmallInt); overload; begin end;', + 'procedure IntTypeTest(v: LongWord); overload; begin end;', + 'procedure IntTypeTest(v: LongInt); overload; begin end;', + 'procedure IntTypeTest(v: NativeUInt); overload; begin end;', + 'procedure IntTypeTest(v: NativeInt); overload; begin end;', + 'type', + ' TJSUint8Array = class external name ''Uint8Array''', + ' private', + ' function getTypedValue(Index : NativeInt): Byte; external name ''[]'';', + ' procedure setTypedValue(Index : NativeInt; AValue: Byte);external name ''[]'';', + ' public', + ' constructor new (length : NativeInt);', + ' property values[Index : NativeInt] : Byte Read getTypedValue Write setTypedValue; default;', + ' end;', + 'var', + ' a, b, c, d : Byte;', + ' Buf : array of Byte;', + ' Buf2 : TJSUint8Array;', + 'begin', + ' IntTypeTest(a and 1);', + ' IntTypeTest(a or 1);', + ' IntTypeTest(a xor 1);', + ' IntTypeTest(a shr 1);', + ' IntTypeTest(a shl 1);', + ' IntTypeTest(a + 1);', + ' IntTypeTest(a - 1);', + ' IntTypeTest(a * 1);', + ' IntTypeTest(a div 1);', + ' IntTypeTest(a mod 1);', + ' IntTypeTest(a ** 1);', + ' IntTypeTest(9 and a);', + ' IntTypeTest(9 or a);', + ' IntTypeTest(9 xor a);', + ' IntTypeTest(9 shr a);', + ' IntTypeTest(9 shl a);', + ' IntTypeTest(9 + a);', + ' IntTypeTest(9 - a);', + ' IntTypeTest(9 * a);', + ' IntTypeTest(9 div a);', + ' IntTypeTest(9 mod a);', + ' IntTypeTest(9 ** a);', + ' IntTypeTest(a or $111);', + ' IntTypeTest(a or $33333);', + ' IntTypeTest(a or $5555555);', + ' IntTypeTest(a + $111);', + ' IntTypeTest(a + $33333);', + ' IntTypeTest(a + $5555555);', + ' IntTypeTest(a and b);', + ' IntTypeTest(a or b);', + ' IntTypeTest(a xor b);', + ' IntTypeTest(a shr b);', + ' IntTypeTest(a shl b);', + ' IntTypeTest(not a);', + ' IntTypeTest(a + b);', + ' IntTypeTest(a - b);', + ' IntTypeTest(a + -b);', + ' IntTypeTest(a * b);', + ' IntTypeTest(a div b);', + ' IntTypeTest(a mod b);', + ' IntTypeTest(a ** b);', + ' IntTypeTest(a and b and c and d);', + ' IntTypeTest(a or b or c or d);', + ' IntTypeTest(a xor b xor c xor d);', + ' IntTypeTest(a shr b shr c shr d);', + ' IntTypeTest(a shl b shl c shl d);', + ' IntTypeTest(a + b + c + d);', + ' IntTypeTest(a - b - c - d);', + ' IntTypeTest(a * b * c * d);', + ' IntTypeTest(a and b or c xor d or not c shr 1 or c shl 1);', + ' IntTypeTest(a + b - c * d);', + ' a := b;', + ' b := c xor d;', + ' c := b + a;', + ' d := not c;', + ' Inc(a);', + ' Inc(a, 10);', + ' Dec(b);', + ' Dec(b, 10);', + ' Buf[0] := a;', + ' Buf[0] := a shr 1;', + ' Buf[0] := a + b;', + ' Buf[0] := a or Buf[0];', + ' Buf[0] := a - Buf[0];', + ' Buf2[0] := a;', + ' Buf2[0] := a shr 1;', + ' Buf2[0] := a + b;', + ' Buf2[0] := a or Buf2[0];', + '']); + ConvertProgram; + CheckSource('TestOptTruncateIntegersOnOverflow_OperatorsByte', + LinesToStr([ // statements + 'this.IntTypeTest = function (v) {', + '};', + 'this.IntTypeTest$2 = function (v) {', + '};', + 'this.IntTypeTest$5 = function (v) {', + '};', + 'this.a = 0;', + 'this.b = 0;', + 'this.c = 0;', + 'this.d = 0;', + 'this.Buf = [];', + 'this.Buf2 = null;', + '']), + LinesToStr([ // this.$main + '$mod.IntTypeTest($mod.a & 1);', + '$mod.IntTypeTest($mod.a | 1);', + '$mod.IntTypeTest($mod.a ^ 1);', + '$mod.IntTypeTest$5($mod.a >>> 1);', + '$mod.IntTypeTest$5($mod.a << 1);', + '$mod.IntTypeTest$5(($mod.a + 1) | 0);', + '$mod.IntTypeTest$5(($mod.a - 1) | 0);', + '$mod.IntTypeTest$5(($mod.a * 1) | 0);', + '$mod.IntTypeTest$5(rtl.trunc($mod.a / 1));', + '$mod.IntTypeTest$5($mod.a % 1);', + '$mod.IntTypeTest$5(Math.pow($mod.a,1));', + '$mod.IntTypeTest(9 & $mod.a);', + '$mod.IntTypeTest(9 | $mod.a);', + '$mod.IntTypeTest(9 ^ $mod.a);', + '$mod.IntTypeTest$5(9 >>> $mod.a);', + '$mod.IntTypeTest$5(9 << $mod.a);', + '$mod.IntTypeTest$5((9 + $mod.a) | 0);', + '$mod.IntTypeTest$5((9 - $mod.a) | 0);', + '$mod.IntTypeTest$5((9 * $mod.a) | 0);', + '$mod.IntTypeTest$5(rtl.trunc(9 / $mod.a));', + '$mod.IntTypeTest$5(9 % $mod.a);', + '$mod.IntTypeTest$5(Math.pow(9,$mod.a));', + '$mod.IntTypeTest$2($mod.a | 0x111);', + '$mod.IntTypeTest$5($mod.a | 0x33333);', + '$mod.IntTypeTest$5($mod.a | 0x5555555);', + '$mod.IntTypeTest$5(($mod.a + 0x111) | 0);', + '$mod.IntTypeTest$5(($mod.a + 0x33333) | 0);', + '$mod.IntTypeTest$5(($mod.a + 0x5555555) | 0);', + '$mod.IntTypeTest($mod.a & $mod.b);', + '$mod.IntTypeTest($mod.a | $mod.b);', + '$mod.IntTypeTest($mod.a ^ $mod.b);', + '$mod.IntTypeTest$5($mod.a >>> $mod.b);', + '$mod.IntTypeTest$5($mod.a << $mod.b);', + '$mod.IntTypeTest($mod.a ^ 255);', + '$mod.IntTypeTest$5(($mod.a + $mod.b) | 0);', + '$mod.IntTypeTest$5(($mod.a - $mod.b) | 0);', + '$mod.IntTypeTest$5(($mod.a + -$mod.b) | 0);', + '$mod.IntTypeTest$5(($mod.a * $mod.b) | 0);', + '$mod.IntTypeTest$5(rtl.trunc($mod.a / $mod.b));', + '$mod.IntTypeTest$5($mod.a % $mod.b);', + '$mod.IntTypeTest$5(Math.pow($mod.a, $mod.b));', + '$mod.IntTypeTest($mod.a & $mod.b & $mod.c & $mod.d);', + '$mod.IntTypeTest($mod.a | $mod.b | $mod.c | $mod.d);', + '$mod.IntTypeTest($mod.a ^ $mod.b ^ $mod.c ^ $mod.d);', + '$mod.IntTypeTest$5((($mod.a >>> $mod.b) >>> $mod.c) >>> $mod.d);', + '$mod.IntTypeTest$5((($mod.a << $mod.b) << $mod.c) << $mod.d);', + '$mod.IntTypeTest$5(($mod.a + $mod.b + $mod.c + $mod.d) | 0);', + '$mod.IntTypeTest$5(($mod.a - $mod.b - $mod.c - $mod.d) | 0);', + '$mod.IntTypeTest$5(((((($mod.a * $mod.b) | 0) * $mod.c) | 0) * $mod.d) | 0);', + '$mod.IntTypeTest$5(((($mod.a & $mod.b) | $mod.c) ^ $mod.d) | (($mod.c ^ 255) >>> 1) | ($mod.c << 1));', + '$mod.IntTypeTest$5((($mod.a + $mod.b) - (($mod.c * $mod.d) | 0)) | 0);', + '$mod.a = $mod.b;', + '$mod.b = $mod.c ^ $mod.d;', + '$mod.c = ($mod.b + $mod.a) & 255;', + '$mod.d = $mod.c ^ 255;', + '$mod.a = ($mod.a + 1) & 255;', + '$mod.a = ($mod.a + 10) & 255;', + '$mod.b = ($mod.b - 1) & 255;', + '$mod.b = ($mod.b - 10) & 255;', + '$mod.Buf[0] = $mod.a;', + '$mod.Buf[0] = ($mod.a >>> 1) & 255;', + '$mod.Buf[0] = ($mod.a + $mod.b) & 255;', + '$mod.Buf[0] = $mod.a | $mod.Buf[0];', + '$mod.Buf[0] = ($mod.a - $mod.Buf[0]) & 255;', + '$mod.Buf2[0] = $mod.a;', + '$mod.Buf2[0] = $mod.a >>> 1;', + '$mod.Buf2[0] = $mod.a + $mod.b;', + '$mod.Buf2[0] = $mod.a | $mod.Buf2[0];', + ''])); +end; + +procedure TTestOptimizations.TestOptTruncateIntegersOnOverflow_OperatorsShortInt; +begin + StartProgram(false); + Add([ + '{$modeswitch externalclass}', + '{$optimization JSTruncateIntegersOnOverflow ON}', + 'procedure IntTypeTest(v: Byte); overload; begin end;', + 'procedure IntTypeTest(v: ShortInt); overload; begin end;', + 'procedure IntTypeTest(v: Word); overload; begin end;', + 'procedure IntTypeTest(v: SmallInt); overload; begin end;', + 'procedure IntTypeTest(v: LongWord); overload; begin end;', + 'procedure IntTypeTest(v: LongInt); overload; begin end;', + 'procedure IntTypeTest(v: NativeUInt); overload; begin end;', + 'procedure IntTypeTest(v: NativeInt); overload; begin end;', + 'type', + ' TJSInt8Array = class external name ''Int8Array''', + ' private', + ' function getTypedValue(Index : NativeInt): ShortInt; external name ''[]'';', + ' procedure setTypedValue(Index : NativeInt; AValue: ShortInt);external name ''[]'';', + ' public', + ' constructor new (length : NativeInt);', + ' property values[Index : NativeInt] : ShortInt Read getTypedValue Write setTypedValue; default;', + ' end;', + 'var', + ' a, b, c, d : ShortInt;', + ' vb : Byte;', + ' Buf : array of ShortInt;', + ' Buf2 : TJSInt8Array;', + 'begin', + ' IntTypeTest(a and 1);', + ' IntTypeTest(a or 1);', + ' IntTypeTest(a xor 1);', + ' IntTypeTest(a shr 1);', + ' IntTypeTest(a shl 1);', + ' IntTypeTest(a + 1);', + ' IntTypeTest(a - 1);', + ' IntTypeTest(a * 1);', + ' IntTypeTest(a div 1);', + ' IntTypeTest(a mod 1);', + ' IntTypeTest(a ** 1);', + ' IntTypeTest(9 and a);', + ' IntTypeTest(9 or a);', + ' IntTypeTest(9 xor a);', + ' IntTypeTest(9 shr a);', + ' IntTypeTest(9 shl a);', + ' IntTypeTest(9 + a);', + ' IntTypeTest(9 - a);', + ' IntTypeTest(9 * a);', + ' IntTypeTest(9 div a);', + ' IntTypeTest(9 mod a);', + ' IntTypeTest(9 ** a);', + ' IntTypeTest(a or $111);', + ' IntTypeTest(a or $33333);', + ' IntTypeTest(a or $5555555);', + ' IntTypeTest(a + $111);', + ' IntTypeTest(a + $33333);', + ' IntTypeTest(a + $5555555);', + ' IntTypeTest(a and b);', + ' IntTypeTest(a or b);', + ' IntTypeTest(a xor b);', + ' IntTypeTest(a shr b);', + ' IntTypeTest(a shl b);', + ' IntTypeTest(not a);', + ' IntTypeTest(a + b);', + ' IntTypeTest(a - b);', + ' IntTypeTest(a + -b);', + ' IntTypeTest(a * b);', + ' IntTypeTest(a div b);', + ' IntTypeTest(a mod b);', + ' IntTypeTest(a ** b);', + ' IntTypeTest(a and b and c and d);', + ' IntTypeTest(a or b or c or d);', + ' IntTypeTest(a xor b xor c xor d);', + ' IntTypeTest(a shr b shr c shr d);', + ' IntTypeTest(a shl b shl c shl d);', + ' IntTypeTest(a + b + c + d);', + ' IntTypeTest(a - b - c - d);', + ' IntTypeTest(a * b * c * d);', + ' IntTypeTest(a and b or c xor d or not c shr 1 or c shl 1);', + ' IntTypeTest(a + b - c * d);', + ' IntTypeTest(b or vb);', + ' IntTypeTest(vb xor b);', + ' IntTypeTest(b or vb and c);', + ' IntTypeTest(b + vb);', + ' IntTypeTest(vb - b);', + ' IntTypeTest(b + vb * c);', + ' a := b;', + ' b := c xor d;', + ' c := b + a;', + ' d := not c;', + ' Inc(a);', + ' Inc(a, 10);', + ' Dec(b);', + ' Dec(b, 10);', + ' Buf[0] := a;', + ' Buf[0] := a shr 1;', + ' Buf[0] := a + b;', + ' Buf[0] := a or Buf[0];', + ' Buf[0] := a - Buf[0];', + ' Buf2[0] := a;', + ' Buf2[0] := a shr 1;', + ' Buf2[0] := a + b;', + ' Buf2[0] := a or Buf2[0];', + ' a := b or vb;', + ' a := vb xor b;', + ' a := b or vb and c;', + ' a := b + vb;', + ' a := vb - b;', + ' a := b + vb * c;', + ' vb := a;', + ' vb := a and b;', + ' vb := a + b;', + '']); + ConvertProgram; + CheckSource('TestOptTruncateIntegersOnOverflow_OperatorsShortInt', + LinesToStr([ // statements + 'this.IntTypeTest$1 = function (v) {', + '};', + 'this.IntTypeTest$3 = function (v) {', + '};', + 'this.IntTypeTest$5 = function (v) {', + '};', + 'this.a = 0;', + 'this.b = 0;', + 'this.c = 0;', + 'this.d = 0;', + 'this.vb = 0;', + 'this.Buf = [];', + 'this.Buf2 = null;', + '']), + LinesToStr([ // this.$main + '$mod.IntTypeTest$1($mod.a & 1);', + '$mod.IntTypeTest$1($mod.a | 1);', + '$mod.IntTypeTest$1($mod.a ^ 1);', + '$mod.IntTypeTest$5($mod.a >>> 1);', + '$mod.IntTypeTest$5($mod.a << 1);', + '$mod.IntTypeTest$5(($mod.a + 1) | 0);', + '$mod.IntTypeTest$5(($mod.a - 1) | 0);', + '$mod.IntTypeTest$5(($mod.a * 1) | 0);', + '$mod.IntTypeTest$5(rtl.trunc($mod.a / 1));', + '$mod.IntTypeTest$5($mod.a % 1);', + '$mod.IntTypeTest$5(Math.pow($mod.a, 1));', + '$mod.IntTypeTest$1(9 & $mod.a);', + '$mod.IntTypeTest$1(9 | $mod.a);', + '$mod.IntTypeTest$1(9 ^ $mod.a);', + '$mod.IntTypeTest$5(9 >>> $mod.a);', + '$mod.IntTypeTest$5(9 << $mod.a);', + '$mod.IntTypeTest$5((9 + $mod.a) | 0);', + '$mod.IntTypeTest$5((9 - $mod.a) | 0);', + '$mod.IntTypeTest$5((9 * $mod.a) | 0);', + '$mod.IntTypeTest$5(rtl.trunc(9 / $mod.a));', + '$mod.IntTypeTest$5(9 % $mod.a);', + '$mod.IntTypeTest$5(Math.pow(9, $mod.a));', + '$mod.IntTypeTest$3($mod.a | 0x111);', + '$mod.IntTypeTest$5($mod.a | 0x33333);', + '$mod.IntTypeTest$5($mod.a | 0x5555555);', + '$mod.IntTypeTest$5(($mod.a + 0x111) | 0);', + '$mod.IntTypeTest$5(($mod.a + 0x33333) | 0);', + '$mod.IntTypeTest$5(($mod.a + 0x5555555) | 0);', + '$mod.IntTypeTest$1($mod.a & $mod.b);', + '$mod.IntTypeTest$1($mod.a | $mod.b);', + '$mod.IntTypeTest$1($mod.a ^ $mod.b);', + '$mod.IntTypeTest$5($mod.a >>> $mod.b);', + '$mod.IntTypeTest$5($mod.a << $mod.b);', + '$mod.IntTypeTest$1(~$mod.a);', + '$mod.IntTypeTest$5(($mod.a + $mod.b) | 0);', + '$mod.IntTypeTest$5(($mod.a - $mod.b) | 0);', + '$mod.IntTypeTest$5(($mod.a + -$mod.b) | 0);', + '$mod.IntTypeTest$5(($mod.a * $mod.b) | 0);', + '$mod.IntTypeTest$5(rtl.trunc($mod.a / $mod.b));', + '$mod.IntTypeTest$5($mod.a % $mod.b);', + '$mod.IntTypeTest$5(Math.pow($mod.a, $mod.b));', + '$mod.IntTypeTest$1($mod.a & $mod.b & $mod.c & $mod.d);', + '$mod.IntTypeTest$1($mod.a | $mod.b | $mod.c | $mod.d);', + '$mod.IntTypeTest$1($mod.a ^ $mod.b ^ $mod.c ^ $mod.d);', + '$mod.IntTypeTest$5((($mod.a >>> $mod.b) >>> $mod.c) >>> $mod.d);', + '$mod.IntTypeTest$5((($mod.a << $mod.b) << $mod.c) << $mod.d);', + '$mod.IntTypeTest$5(($mod.a + $mod.b + $mod.c + $mod.d) | 0);', + '$mod.IntTypeTest$5(($mod.a - $mod.b - $mod.c - $mod.d) | 0);', + '$mod.IntTypeTest$5(((((($mod.a * $mod.b) | 0) * $mod.c) | 0) * $mod.d) | 0);', + '$mod.IntTypeTest$5(((($mod.a & $mod.b) | $mod.c) ^ $mod.d) | (~$mod.c >>> 1) | ($mod.c << 1));', + '$mod.IntTypeTest$5((($mod.a + $mod.b) - (($mod.c * $mod.d) | 0)) | 0);', + '$mod.IntTypeTest$3($mod.b | $mod.vb);', + '$mod.IntTypeTest$3($mod.vb ^ $mod.b);', + '$mod.IntTypeTest$3($mod.b | ($mod.vb & $mod.c));', + '$mod.IntTypeTest$5(($mod.b + $mod.vb) | 0);', + '$mod.IntTypeTest$5(($mod.vb - $mod.b) | 0);', + '$mod.IntTypeTest$5(($mod.b + (($mod.vb * $mod.c) | 0)) | 0);', + '$mod.a = $mod.b;', + '$mod.b = $mod.c ^ $mod.d;', + '$mod.c = ((($mod.b + $mod.a) & 255) << 24) >> 24;', + '$mod.d = ~$mod.c;', + '$mod.a = ((($mod.a + 1) & 255) << 24) >> 24;', + '$mod.a = ((($mod.a + 10) & 255) << 24) >> 24;', + '$mod.b = ((($mod.b - 1) & 255) << 24) >> 24;', + '$mod.b = ((($mod.b - 10) & 255) << 24) >> 24;', + '$mod.Buf[0] = $mod.a;', + '$mod.Buf[0] = ((($mod.a >>> 1) & 255) << 24) >> 24;', + '$mod.Buf[0] = ((($mod.a + $mod.b) & 255) << 24) >> 24;', + '$mod.Buf[0] = $mod.a | $mod.Buf[0];', + '$mod.Buf[0] = ((($mod.a - $mod.Buf[0]) & 255) << 24) >> 24;', + '$mod.Buf2[0] = $mod.a;', + '$mod.Buf2[0] = $mod.a >>> 1;', + '$mod.Buf2[0] = $mod.a + $mod.b;', + '$mod.Buf2[0] = $mod.a | $mod.Buf2[0];', + '$mod.a = ((($mod.b | $mod.vb) & 255) << 24) >> 24;', + '$mod.a = ((($mod.vb ^ $mod.b) & 255) << 24) >> 24;', + '$mod.a = ((($mod.b | ($mod.vb & $mod.c)) & 255) << 24) >> 24;', + '$mod.a = ((($mod.b + $mod.vb) & 255) << 24) >> 24;', + '$mod.a = ((($mod.vb - $mod.b) & 255) << 24) >> 24;', + '$mod.a = ((($mod.b + (($mod.vb * $mod.c) | 0)) & 255) << 24) >> 24;', + '$mod.vb = $mod.a & 255;', + '$mod.vb = $mod.a & $mod.b & 255;', + '$mod.vb = ($mod.a + $mod.b) & 255;', + ''])); +end; + +procedure TTestOptimizations.TestOptTruncateIntegersOnOverflow_OperatorsWord; +begin + StartProgram(false); + Add([ + '{$modeswitch externalclass}', + '{$optimization JSTruncateIntegersOnOverflow ON}', + 'procedure IntTypeTest(v: Byte); overload; begin end;', + 'procedure IntTypeTest(v: ShortInt); overload; begin end;', + 'procedure IntTypeTest(v: Word); overload; begin end;', + 'procedure IntTypeTest(v: SmallInt); overload; begin end;', + 'procedure IntTypeTest(v: LongWord); overload; begin end;', + 'procedure IntTypeTest(v: LongInt); overload; begin end;', + 'procedure IntTypeTest(v: NativeUInt); overload; begin end;', + 'procedure IntTypeTest(v: NativeInt); overload; begin end;', + 'type', + ' TJSUint16Array = class external name ''Uint16Array''', + ' private', + ' function getTypedValue(Index : NativeInt): Word; external name ''[]'';', + ' procedure setTypedValue(Index : NativeInt; AValue: Word);external name ''[]'';', + ' public', + ' constructor new (length : NativeInt);', + ' property values[Index : NativeInt] : Word Read getTypedValue Write setTypedValue; default;', + ' end;', + 'var', + ' a, b, c, d : Word;', + ' vb : Byte;', + ' vh : ShortInt;', + ' Buf : array of Word;', + ' Buf2 : TJSUint16Array;', + 'begin', + ' IntTypeTest(a and 1);', + ' IntTypeTest(a or 1);', + ' IntTypeTest(a xor 1);', + ' IntTypeTest(a shr 1);', + ' IntTypeTest(a shl 1);', + ' IntTypeTest(a + 1);', + ' IntTypeTest(a - 1);', + ' IntTypeTest(a * 1);', + ' IntTypeTest(a div 1);', + ' IntTypeTest(a mod 1);', + ' IntTypeTest(a ** 1);', + ' IntTypeTest(9 and a);', + ' IntTypeTest(9 or a);', + ' IntTypeTest(9 xor a);', + ' IntTypeTest(9 shr a);', + ' IntTypeTest(9 shl a);', + ' IntTypeTest(9 + a);', + ' IntTypeTest(9 - a);', + ' IntTypeTest(9 * a);', + ' IntTypeTest(9 div a);', + ' IntTypeTest(9 mod a);', + ' IntTypeTest(9 ** a);', + ' IntTypeTest(a or $111);', + ' IntTypeTest(a or $33333);', + ' IntTypeTest(a or $5555555);', + ' IntTypeTest(a + $111);', + ' IntTypeTest(a + $33333);', + ' IntTypeTest(a + $5555555);', + ' IntTypeTest(a and b);', + ' IntTypeTest(a or b);', + ' IntTypeTest(a xor b);', + ' IntTypeTest(a shr b);', + ' IntTypeTest(a shl b);', + ' IntTypeTest(not a);', + ' IntTypeTest(a + b);', + ' IntTypeTest(a - b);', + ' IntTypeTest(a + -b);', + ' IntTypeTest(a * b);', + ' IntTypeTest(a div b);', + ' IntTypeTest(a mod b);', + ' IntTypeTest(a ** b);', + ' IntTypeTest(a and b and c and d);', + ' IntTypeTest(a or b or c or d);', + ' IntTypeTest(a xor b xor c xor d);', + ' IntTypeTest(a shr b shr c shr d);', + ' IntTypeTest(a shl b shl c shl d);', + ' IntTypeTest(a + b + c + d);', + ' IntTypeTest(a - b - c - d);', + ' IntTypeTest(a * b * c * d);', + ' IntTypeTest(a and b or c xor d or not c shr 1 or c shl 1);', + ' IntTypeTest(a + b - c * d);', + ' IntTypeTest(b or vb);', + ' IntTypeTest(vb xor b);', + ' IntTypeTest(b or vb and c);', + ' IntTypeTest(b + vb);', + ' IntTypeTest(vb - b);', + ' IntTypeTest(b + vb * c);', + ' IntTypeTest(b or vh);', + ' IntTypeTest(vh xor b);', + ' IntTypeTest(b or vh and c);', + ' IntTypeTest(b + vh);', + ' IntTypeTest(vh - b);', + ' IntTypeTest(b + vh * c);', + ' a := b;', + ' b := c xor d;', + ' c := b + a;', + ' d := not c;', + ' Inc(a);', + ' Inc(a, 10);', + ' Dec(b);', + ' Dec(b, 10);', + ' Buf[0] := a;', + ' Buf[0] := a shr 1;', + ' Buf[0] := a + b;', + ' Buf[0] := a or Buf[0];', + ' Buf[0] := a - Buf[0];', + ' Buf2[0] := a;', + ' Buf2[0] := a shr 1;', + ' Buf2[0] := a + b;', + ' Buf2[0] := a or Buf2[0];', + ' a := b or vb;', + ' a := vb xor b;', + ' a := b or vb and c;', + ' a := b + vb;', + ' a := vb - b;', + ' a := b + vb * c;', + ' vb := a;', + ' vb := a and b;', + ' vb := a + b;', + ' a := b or vh;', + ' a := vh xor b;', + ' a := b or vh and c;', + ' a := b + vh;', + ' a := vh - b;', + ' a := b + vh * c;', + ' vh := a;', + ' vh := a and b;', + ' vh := a + b;', + '']); + ConvertProgram; + CheckSource('TestOptTruncateIntegersOnOverflow_OperatorsWord', + LinesToStr([ // statements + 'this.IntTypeTest$2 = function (v) {', + '};', + 'this.IntTypeTest$5 = function (v) {', + '};', + 'this.a = 0;', + 'this.b = 0;', + 'this.c = 0;', + 'this.d = 0;', + 'this.vb = 0;', + 'this.vh = 0;', + 'this.Buf = [];', + 'this.Buf2 = null;', + '']), + LinesToStr([ // this.$main + '$mod.IntTypeTest$2($mod.a & 1);', + '$mod.IntTypeTest$2($mod.a | 1);', + '$mod.IntTypeTest$2($mod.a ^ 1);', + '$mod.IntTypeTest$5($mod.a >>> 1);', + '$mod.IntTypeTest$5($mod.a << 1);', + '$mod.IntTypeTest$5(($mod.a + 1) | 0);', + '$mod.IntTypeTest$5(($mod.a - 1) | 0);', + '$mod.IntTypeTest$5(($mod.a * 1) | 0);', + '$mod.IntTypeTest$5(rtl.trunc($mod.a / 1));', + '$mod.IntTypeTest$5($mod.a % 1);', + '$mod.IntTypeTest$5(Math.pow($mod.a, 1));', + '$mod.IntTypeTest$2(9 & $mod.a);', + '$mod.IntTypeTest$2(9 | $mod.a);', + '$mod.IntTypeTest$2(9 ^ $mod.a);', + '$mod.IntTypeTest$5(9 >>> $mod.a);', + '$mod.IntTypeTest$5(9 << $mod.a);', + '$mod.IntTypeTest$5((9 + $mod.a) | 0);', + '$mod.IntTypeTest$5((9 - $mod.a) | 0);', + '$mod.IntTypeTest$5((9 * $mod.a) | 0);', + '$mod.IntTypeTest$5(rtl.trunc(9 / $mod.a));', + '$mod.IntTypeTest$5(9 % $mod.a);', + '$mod.IntTypeTest$5(Math.pow(9, $mod.a));', + '$mod.IntTypeTest$2($mod.a | 0x111);', + '$mod.IntTypeTest$5($mod.a | 0x33333);', + '$mod.IntTypeTest$5($mod.a | 0x5555555);', + '$mod.IntTypeTest$5(($mod.a + 0x111) | 0);', + '$mod.IntTypeTest$5(($mod.a + 0x33333) | 0);', + '$mod.IntTypeTest$5(($mod.a + 0x5555555) | 0);', + '$mod.IntTypeTest$2($mod.a & $mod.b);', + '$mod.IntTypeTest$2($mod.a | $mod.b);', + '$mod.IntTypeTest$2($mod.a ^ $mod.b);', + '$mod.IntTypeTest$5($mod.a >>> $mod.b);', + '$mod.IntTypeTest$5($mod.a << $mod.b);', + '$mod.IntTypeTest$2($mod.a ^ 65535);', + '$mod.IntTypeTest$5(($mod.a + $mod.b) | 0);', + '$mod.IntTypeTest$5(($mod.a - $mod.b) | 0);', + '$mod.IntTypeTest$5(($mod.a + -$mod.b) | 0);', + '$mod.IntTypeTest$5(($mod.a * $mod.b) | 0);', + '$mod.IntTypeTest$5(rtl.trunc($mod.a / $mod.b));', + '$mod.IntTypeTest$5($mod.a % $mod.b);', + '$mod.IntTypeTest$5(Math.pow($mod.a, $mod.b));', + '$mod.IntTypeTest$2($mod.a & $mod.b & $mod.c & $mod.d);', + '$mod.IntTypeTest$2($mod.a | $mod.b | $mod.c | $mod.d);', + '$mod.IntTypeTest$2($mod.a ^ $mod.b ^ $mod.c ^ $mod.d);', + '$mod.IntTypeTest$5((($mod.a >>> $mod.b) >>> $mod.c) >>> $mod.d);', + '$mod.IntTypeTest$5((($mod.a << $mod.b) << $mod.c) << $mod.d);', + '$mod.IntTypeTest$5(($mod.a + $mod.b + $mod.c + $mod.d) | 0);', + '$mod.IntTypeTest$5(($mod.a - $mod.b - $mod.c - $mod.d) | 0);', + '$mod.IntTypeTest$5(((((($mod.a * $mod.b) | 0) * $mod.c) | 0) * $mod.d) | 0);', + '$mod.IntTypeTest$5(((($mod.a & $mod.b) | $mod.c) ^ $mod.d) | (($mod.c ^ 65535) >>> 1) | ($mod.c << 1));', + '$mod.IntTypeTest$5((($mod.a + $mod.b) - (($mod.c * $mod.d) | 0)) | 0);', + '$mod.IntTypeTest$2($mod.b | $mod.vb);', + '$mod.IntTypeTest$2($mod.vb ^ $mod.b);', + '$mod.IntTypeTest$2($mod.b | ($mod.vb & $mod.c));', + '$mod.IntTypeTest$5(($mod.b + $mod.vb) | 0);', + '$mod.IntTypeTest$5(($mod.vb - $mod.b) | 0);', + '$mod.IntTypeTest$5(($mod.b + (($mod.vb * $mod.c) | 0)) | 0);', + '$mod.IntTypeTest$5($mod.b | $mod.vh);', + '$mod.IntTypeTest$5($mod.vh ^ $mod.b);', + '$mod.IntTypeTest$5($mod.b | ($mod.vh & $mod.c));', + '$mod.IntTypeTest$5(($mod.b + $mod.vh) | 0);', + '$mod.IntTypeTest$5(($mod.vh - $mod.b) | 0);', + '$mod.IntTypeTest$5(($mod.b + (($mod.vh * $mod.c) | 0)) | 0);', + '$mod.a = $mod.b;', + '$mod.b = $mod.c ^ $mod.d;', + '$mod.c = ($mod.b + $mod.a) & 65535;', + '$mod.d = $mod.c ^ 65535;', + '$mod.a = ($mod.a + 1) & 65535;', + '$mod.a = ($mod.a + 10) & 65535;', + '$mod.b = ($mod.b - 1) & 65535;', + '$mod.b = ($mod.b - 10) & 65535;', + '$mod.Buf[0] = $mod.a;', + '$mod.Buf[0] = ($mod.a >>> 1) & 65535;', + '$mod.Buf[0] = ($mod.a + $mod.b) & 65535;', + '$mod.Buf[0] = $mod.a | $mod.Buf[0];', + '$mod.Buf[0] = ($mod.a - $mod.Buf[0]) & 65535;', + '$mod.Buf2[0] = $mod.a;', + '$mod.Buf2[0] = $mod.a >>> 1;', + '$mod.Buf2[0] = $mod.a + $mod.b;', + '$mod.Buf2[0] = $mod.a | $mod.Buf2[0];', + '$mod.a = $mod.b | $mod.vb;', + '$mod.a = $mod.vb ^ $mod.b;', + '$mod.a = $mod.b | ($mod.vb & $mod.c);', + '$mod.a = ($mod.b + $mod.vb) & 65535;', + '$mod.a = ($mod.vb - $mod.b) & 65535;', + '$mod.a = ($mod.b + (($mod.vb * $mod.c) | 0)) & 65535;', + '$mod.vb = $mod.a & 255;', + '$mod.vb = $mod.a & $mod.b & 255;', + '$mod.vb = ($mod.a + $mod.b) & 255;', + '$mod.a = ($mod.b | $mod.vh) & 65535;', + '$mod.a = ($mod.vh ^ $mod.b) & 65535;', + '$mod.a = ($mod.b | ($mod.vh & $mod.c)) & 65535;', + '$mod.a = ($mod.b + $mod.vh) & 65535;', + '$mod.a = ($mod.vh - $mod.b) & 65535;', + '$mod.a = ($mod.b + (($mod.vh * $mod.c) | 0)) & 65535;', + '$mod.vh = (($mod.a & 255) << 24) >> 24;', + '$mod.vh = (($mod.a & $mod.b & 255) << 24) >> 24;', + '$mod.vh = ((($mod.a + $mod.b) & 255) << 24) >> 24;', + ''])); +end; + +procedure TTestOptimizations.TestOptTruncateIntegersOnOverflow_OperatorsSmallInt; +begin + StartProgram(false); + Add([ + '{$modeswitch externalclass}', + '{$optimization JSTruncateIntegersOnOverflow ON}', + 'procedure IntTypeTest(v: Byte); overload; begin end;', + 'procedure IntTypeTest(v: ShortInt); overload; begin end;', + 'procedure IntTypeTest(v: Word); overload; begin end;', + 'procedure IntTypeTest(v: SmallInt); overload; begin end;', + 'procedure IntTypeTest(v: LongWord); overload; begin end;', + 'procedure IntTypeTest(v: LongInt); overload; begin end;', + 'procedure IntTypeTest(v: NativeUInt); overload; begin end;', + 'procedure IntTypeTest(v: NativeInt); overload; begin end;', + 'type', + ' TJSInt16Array = class external name ''Int16Array''', + ' private', + ' function getTypedValue(Index : NativeInt): SmallInt; external name ''[]'';', + ' procedure setTypedValue(Index : NativeInt; AValue: SmallInt);external name ''[]'';', + ' public', + ' constructor new (length : NativeInt);', + ' property values[Index : NativeInt] : SmallInt Read getTypedValue Write setTypedValue; default;', + ' end;', + 'var', + ' a, b, c, d : SmallInt;', + ' vb : Byte;', + ' vh : ShortInt;', + ' vw : Word;', + ' Buf : array of SmallInt;', + ' Buf2 : TJSInt16Array;', + 'begin', + ' IntTypeTest(a and 1);', + ' IntTypeTest(a or 1);', + ' IntTypeTest(a xor 1);', + ' IntTypeTest(a shr 1);', + ' IntTypeTest(a shl 1);', + ' IntTypeTest(a + 1);', + ' IntTypeTest(a - 1);', + ' IntTypeTest(a * 1);', + ' IntTypeTest(a div 1);', + ' IntTypeTest(a mod 1);', + ' IntTypeTest(a ** 1);', + ' IntTypeTest(9 and a);', + ' IntTypeTest(9 or a);', + ' IntTypeTest(9 xor a);', + ' IntTypeTest(9 shr a);', + ' IntTypeTest(9 shl a);', + ' IntTypeTest(9 + a);', + ' IntTypeTest(9 - a);', + ' IntTypeTest(9 * a);', + ' IntTypeTest(9 div a);', + ' IntTypeTest(9 mod a);', + ' IntTypeTest(9 ** a);', + ' IntTypeTest(a or $111);', + ' IntTypeTest(a or $33333);', + ' IntTypeTest(a or $5555555);', + ' IntTypeTest(a + $111);', + ' IntTypeTest(a + $33333);', + ' IntTypeTest(a + $5555555);', + ' IntTypeTest(a and b);', + ' IntTypeTest(a or b);', + ' IntTypeTest(a xor b);', + ' IntTypeTest(a shr b);', + ' IntTypeTest(a shl b);', + ' IntTypeTest(not a);', + ' IntTypeTest(a + b);', + ' IntTypeTest(a - b);', + ' IntTypeTest(a + -b);', + ' IntTypeTest(a * b);', + ' IntTypeTest(a div b);', + ' IntTypeTest(a mod b);', + ' IntTypeTest(a ** b);', + ' IntTypeTest(a and b and c and d);', + ' IntTypeTest(a or b or c or d);', + ' IntTypeTest(a xor b xor c xor d);', + ' IntTypeTest(a shr b shr c shr d);', + ' IntTypeTest(a shl b shl c shl d);', + ' IntTypeTest(a + b + c + d);', + ' IntTypeTest(a - b - c - d);', + ' IntTypeTest(a * b * c * d);', + ' IntTypeTest(a and b or c xor d or not c shr 1 or c shl 1);', + ' IntTypeTest(a + b - c * d);', + ' IntTypeTest(b or vb);', + ' IntTypeTest(vb xor b);', + ' IntTypeTest(b or vb and c);', + ' IntTypeTest(b + vb);', + ' IntTypeTest(vb - b);', + ' IntTypeTest(b + vb * c);', + ' IntTypeTest(b or vh);', + ' IntTypeTest(vh xor b);', + ' IntTypeTest(b or vh and c);', + ' IntTypeTest(b + vh);', + ' IntTypeTest(vh - b);', + ' IntTypeTest(b + vh * c);', + ' IntTypeTest(b or vw);', + ' IntTypeTest(vw xor b);', + ' IntTypeTest(b or vw and c);', + ' IntTypeTest(b + vw);', + ' IntTypeTest(vw - b);', + ' IntTypeTest(b + vw * c);', + ' a := b;', + ' b := c xor d;', + ' c := b + a;', + ' d := not c;', + ' Inc(a);', + ' Inc(a, 10);', + ' Dec(b);', + ' Dec(b, 10);', + ' Buf[0] := a;', + ' Buf[0] := a shr 1;', + ' Buf[0] := a + b;', + ' Buf[0] := a or Buf[0];', + ' Buf[0] := a - Buf[0];', + ' Buf2[0] := a;', + ' Buf2[0] := a shr 1;', + ' Buf2[0] := a + b;', + ' Buf2[0] := a or Buf2[0];', + ' a := b or vb;', + ' a := vb xor b;', + ' a := b or vb and c;', + ' a := b + vb;', + ' a := vb - b;', + ' a := b + vb * c;', + ' vb := a;', + ' vb := a and b;', + ' vb := a + b;', + ' a := b or vh;', + ' a := vh xor b;', + ' a := b or vh and c;', + ' a := b + vh;', + ' a := vh - b;', + ' a := b + vh * c;', + ' vh := a;', + ' vh := a and b;', + ' vh := a + b;', + ' a := b or vw;', + ' a := vw xor b;', + ' a := b or vw and c;', + ' a := b + vw;', + ' a := vw - b;', + ' a := b + vw * c;', + ' vw := a;', + ' vw := a and b;', + ' vw := a + b;', + '']); + ConvertProgram; + CheckSource('TestOptTruncateIntegersOnOverflow_OperatorsSmallInt', + LinesToStr([ // statements + 'this.IntTypeTest$3 = function (v) {', + '};', + 'this.IntTypeTest$5 = function (v) {', + '};', + 'this.a = 0;', + 'this.b = 0;', + 'this.c = 0;', + 'this.d = 0;', + 'this.vb = 0;', + 'this.vh = 0;', + 'this.vw = 0;', + 'this.Buf = [];', + 'this.Buf2 = null;', + '']), + LinesToStr([ // this.$main + '$mod.IntTypeTest$3($mod.a & 1);', + '$mod.IntTypeTest$3($mod.a | 1);', + '$mod.IntTypeTest$3($mod.a ^ 1);', + '$mod.IntTypeTest$5($mod.a >>> 1);', + '$mod.IntTypeTest$5($mod.a << 1);', + '$mod.IntTypeTest$5(($mod.a + 1) | 0);', + '$mod.IntTypeTest$5(($mod.a - 1) | 0);', + '$mod.IntTypeTest$5(($mod.a * 1) | 0);', + '$mod.IntTypeTest$5(rtl.trunc($mod.a / 1));', + '$mod.IntTypeTest$5($mod.a % 1);', + '$mod.IntTypeTest$5(Math.pow($mod.a, 1));', + '$mod.IntTypeTest$3(9 & $mod.a);', + '$mod.IntTypeTest$3(9 | $mod.a);', + '$mod.IntTypeTest$3(9 ^ $mod.a);', + '$mod.IntTypeTest$5(9 >>> $mod.a);', + '$mod.IntTypeTest$5(9 << $mod.a);', + '$mod.IntTypeTest$5((9 + $mod.a) | 0);', + '$mod.IntTypeTest$5((9 - $mod.a) | 0);', + '$mod.IntTypeTest$5((9 * $mod.a) | 0);', + '$mod.IntTypeTest$5(rtl.trunc(9 / $mod.a));', + '$mod.IntTypeTest$5(9 % $mod.a);', + '$mod.IntTypeTest$5(Math.pow(9, $mod.a));', + '$mod.IntTypeTest$3($mod.a | 0x111);', + '$mod.IntTypeTest$5($mod.a | 0x33333);', + '$mod.IntTypeTest$5($mod.a | 0x5555555);', + '$mod.IntTypeTest$5(($mod.a + 0x111) | 0);', + '$mod.IntTypeTest$5(($mod.a + 0x33333) | 0);', + '$mod.IntTypeTest$5(($mod.a + 0x5555555) | 0);', + '$mod.IntTypeTest$3($mod.a & $mod.b);', + '$mod.IntTypeTest$3($mod.a | $mod.b);', + '$mod.IntTypeTest$3($mod.a ^ $mod.b);', + '$mod.IntTypeTest$5($mod.a >>> $mod.b);', + '$mod.IntTypeTest$5($mod.a << $mod.b);', + '$mod.IntTypeTest$3(~$mod.a);', + '$mod.IntTypeTest$5(($mod.a + $mod.b) | 0);', + '$mod.IntTypeTest$5(($mod.a - $mod.b) | 0);', + '$mod.IntTypeTest$5(($mod.a + -$mod.b) | 0);', + '$mod.IntTypeTest$5(($mod.a * $mod.b) | 0);', + '$mod.IntTypeTest$5(rtl.trunc($mod.a / $mod.b));', + '$mod.IntTypeTest$5($mod.a % $mod.b);', + '$mod.IntTypeTest$5(Math.pow($mod.a, $mod.b));', + '$mod.IntTypeTest$3($mod.a & $mod.b & $mod.c & $mod.d);', + '$mod.IntTypeTest$3($mod.a | $mod.b | $mod.c | $mod.d);', + '$mod.IntTypeTest$3($mod.a ^ $mod.b ^ $mod.c ^ $mod.d);', + '$mod.IntTypeTest$5((($mod.a >>> $mod.b) >>> $mod.c) >>> $mod.d);', + '$mod.IntTypeTest$5((($mod.a << $mod.b) << $mod.c) << $mod.d);', + '$mod.IntTypeTest$5(($mod.a + $mod.b + $mod.c + $mod.d) | 0);', + '$mod.IntTypeTest$5(($mod.a - $mod.b - $mod.c - $mod.d) | 0);', + '$mod.IntTypeTest$5(((((($mod.a * $mod.b) | 0) * $mod.c) | 0) * $mod.d) | 0);', + '$mod.IntTypeTest$5(((($mod.a & $mod.b) | $mod.c) ^ $mod.d) | (~$mod.c >>> 1) | ($mod.c << 1));', + '$mod.IntTypeTest$5((($mod.a + $mod.b) - (($mod.c * $mod.d) | 0)) | 0);', + '$mod.IntTypeTest$3($mod.b | $mod.vb);', + '$mod.IntTypeTest$3($mod.vb ^ $mod.b);', + '$mod.IntTypeTest$3($mod.b | ($mod.vb & $mod.c));', + '$mod.IntTypeTest$5(($mod.b + $mod.vb) | 0);', + '$mod.IntTypeTest$5(($mod.vb - $mod.b) | 0);', + '$mod.IntTypeTest$5(($mod.b + (($mod.vb * $mod.c) | 0)) | 0);', + '$mod.IntTypeTest$3($mod.b | $mod.vh);', + '$mod.IntTypeTest$3($mod.vh ^ $mod.b);', + '$mod.IntTypeTest$3($mod.b | ($mod.vh & $mod.c));', + '$mod.IntTypeTest$5(($mod.b + $mod.vh) | 0);', + '$mod.IntTypeTest$5(($mod.vh - $mod.b) | 0);', + '$mod.IntTypeTest$5(($mod.b + (($mod.vh * $mod.c) | 0)) | 0);', + '$mod.IntTypeTest$5($mod.b | $mod.vw);', + '$mod.IntTypeTest$5($mod.vw ^ $mod.b);', + '$mod.IntTypeTest$5($mod.b | ($mod.vw & $mod.c));', + '$mod.IntTypeTest$5(($mod.b + $mod.vw) | 0);', + '$mod.IntTypeTest$5(($mod.vw - $mod.b) | 0);', + '$mod.IntTypeTest$5(($mod.b + (($mod.vw * $mod.c) | 0)) | 0);', + '$mod.a = $mod.b;', + '$mod.b = $mod.c ^ $mod.d;', + '$mod.c = ((($mod.b + $mod.a) & 65535) << 16) >> 16;', + '$mod.d = ~$mod.c;', + '$mod.a = ((($mod.a + 1) & 65535) << 16) >> 16;', + '$mod.a = ((($mod.a + 10) & 65535) << 16) >> 16;', + '$mod.b = ((($mod.b - 1) & 65535) << 16) >> 16;', + '$mod.b = ((($mod.b - 10) & 65535) << 16) >> 16;', + '$mod.Buf[0] = $mod.a;', + '$mod.Buf[0] = ((($mod.a >>> 1) & 65535) << 16) >> 16;', + '$mod.Buf[0] = ((($mod.a + $mod.b) & 65535) << 16) >> 16;', + '$mod.Buf[0] = $mod.a | $mod.Buf[0];', + '$mod.Buf[0] = ((($mod.a - $mod.Buf[0]) & 65535) << 16) >> 16;', + '$mod.Buf2[0] = $mod.a;', + '$mod.Buf2[0] = $mod.a >>> 1;', + '$mod.Buf2[0] = $mod.a + $mod.b;', + '$mod.Buf2[0] = $mod.a | $mod.Buf2[0];', + '$mod.a = $mod.b | $mod.vb;', + '$mod.a = $mod.vb ^ $mod.b;', + '$mod.a = $mod.b | ($mod.vb & $mod.c);', + '$mod.a = ((($mod.b + $mod.vb) & 65535) << 16) >> 16;', + '$mod.a = ((($mod.vb - $mod.b) & 65535) << 16) >> 16;', + '$mod.a = ((($mod.b + (($mod.vb * $mod.c) | 0)) & 65535) << 16) >> 16;', + '$mod.vb = $mod.a & 255;', + '$mod.vb = $mod.a & $mod.b & 255;', + '$mod.vb = ($mod.a + $mod.b) & 255;', + '$mod.a = $mod.b | $mod.vh;', + '$mod.a = $mod.vh ^ $mod.b;', + '$mod.a = $mod.b | ($mod.vh & $mod.c);', + '$mod.a = ((($mod.b + $mod.vh) & 65535) << 16) >> 16;', + '$mod.a = ((($mod.vh - $mod.b) & 65535) << 16) >> 16;', + '$mod.a = ((($mod.b + (($mod.vh * $mod.c) | 0)) & 65535) << 16) >> 16;', + '$mod.vh = (($mod.a & 255) << 24) >> 24;', + '$mod.vh = (($mod.a & $mod.b & 255) << 24) >> 24;', + '$mod.vh = ((($mod.a + $mod.b) & 255) << 24) >> 24;', + '$mod.a = ((($mod.b | $mod.vw) & 65535) << 16) >> 16;', + '$mod.a = ((($mod.vw ^ $mod.b) & 65535) << 16) >> 16;', + '$mod.a = ((($mod.b | ($mod.vw & $mod.c)) & 65535) << 16) >> 16;', + '$mod.a = ((($mod.b + $mod.vw) & 65535) << 16) >> 16;', + '$mod.a = ((($mod.vw - $mod.b) & 65535) << 16) >> 16;', + '$mod.a = ((($mod.b + (($mod.vw * $mod.c) | 0)) & 65535) << 16) >> 16;', + '$mod.vw = $mod.a & 65535;', + '$mod.vw = $mod.a & $mod.b & 65535;', + '$mod.vw = ($mod.a + $mod.b) & 65535;', + ''])); +end; + +procedure TTestOptimizations.TestOptTruncateIntegersOnOverflow_OperatorsLongWord; +begin + StartProgram(false); + Add([ + '{$modeswitch externalclass}', + '{$optimization JSTruncateIntegersOnOverflow ON}', + 'procedure IntTypeTest(v: Byte); overload; begin end;', + 'procedure IntTypeTest(v: ShortInt); overload; begin end;', + 'procedure IntTypeTest(v: Word); overload; begin end;', + 'procedure IntTypeTest(v: SmallInt); overload; begin end;', + 'procedure IntTypeTest(v: LongWord); overload; begin end;', + 'procedure IntTypeTest(v: LongInt); overload; begin end;', + 'procedure IntTypeTest(v: NativeUInt); overload; begin end;', + 'procedure IntTypeTest(v: NativeInt); overload; begin end;', + 'type', + ' TJSUint32Array = class external name ''Uint32Array''', + ' private', + ' function getTypedValue(Index : NativeInt): LongWord; external name ''[]'';', + ' procedure setTypedValue(Index : NativeInt; AValue: LongWord);external name ''[]'';', + ' public', + ' constructor new (length : NativeInt);', + ' property values[Index : NativeInt] : LongWord Read getTypedValue Write setTypedValue; default;', + ' end;', + 'var', + ' a, b, c, d : LongWord;', + ' vb : Byte;', + ' vh : ShortInt;', + ' vw : Word;', + ' vm : SmallInt;', + ' Buf : array of LongWord;', + ' Buf2 : TJSUint32Array;', + 'begin', + ' IntTypeTest(a and 1);', + ' IntTypeTest(a or 1);', + ' IntTypeTest(a xor 1);', + ' IntTypeTest(a shr 1);', + ' IntTypeTest(a shl 1);', + ' IntTypeTest(a + 1);', + ' IntTypeTest(a - 1);', + ' IntTypeTest(a * 1);', + ' IntTypeTest(a div 1);', + ' IntTypeTest(a mod 1);', + ' IntTypeTest(a ** 1);', + ' IntTypeTest(9 and a);', + ' IntTypeTest(9 or a);', + ' IntTypeTest(9 xor a);', + ' IntTypeTest(9 shr a);', + ' IntTypeTest(9 shl a);', + ' IntTypeTest(9 + a);', + ' IntTypeTest(9 - a);', + ' IntTypeTest(9 * a);', + ' IntTypeTest(9 div a);', + ' IntTypeTest(9 mod a);', + ' IntTypeTest(9 ** a);', + ' IntTypeTest(a or $111);', + ' IntTypeTest(a or $33333);', + ' IntTypeTest(a or $5555555);', + ' IntTypeTest(a + $111);', + ' IntTypeTest(a + $33333);', + ' IntTypeTest(a + $5555555);', + ' IntTypeTest(a and b);', + ' IntTypeTest(a or b);', + ' IntTypeTest(a xor b);', + ' IntTypeTest(a shr b);', + ' IntTypeTest(a shl b);', + ' IntTypeTest(not a);', + ' IntTypeTest(a + b);', + ' IntTypeTest(a - b);', + ' IntTypeTest(a + -b);', + ' IntTypeTest(a * b);', + ' IntTypeTest(a div b);', + ' IntTypeTest(a mod b);', + ' IntTypeTest(a ** b);', + ' IntTypeTest(a and b and c and d);', + ' IntTypeTest(a or b or c or d);', + ' IntTypeTest(a xor b xor c xor d);', + ' IntTypeTest(a shr b shr c shr d);', + ' IntTypeTest(a shl b shl c shl d);', + ' IntTypeTest(a + b + c + d);', + ' IntTypeTest(a - b - c - d);', + ' IntTypeTest(a * b * c * d);', + ' IntTypeTest(a and b or c xor d or not c shr 1 or c shl 1);', + ' IntTypeTest(a + b - c * d);', + ' IntTypeTest(b or vb);', + ' IntTypeTest(vb xor b);', + ' IntTypeTest(b or vb and c);', + ' IntTypeTest(b + vb);', + ' IntTypeTest(vb - b);', + ' IntTypeTest(b + vb * c);', + ' IntTypeTest(b or vh);', + ' IntTypeTest(vh xor b);', + ' IntTypeTest(b or vh and c);', + ' IntTypeTest(b + vh);', + ' IntTypeTest(vh - b);', + ' IntTypeTest(b + vh * c);', + ' IntTypeTest(b or vw);', + ' IntTypeTest(vw xor b);', + ' IntTypeTest(b or vw and c);', + ' IntTypeTest(b + vw);', + ' IntTypeTest(vw - b);', + ' IntTypeTest(b + vw * c);', + ' IntTypeTest(b or vm);', + ' IntTypeTest(vm xor b);', + ' IntTypeTest(b or vm and c);', + ' IntTypeTest(b + vm);', + ' IntTypeTest(vm - b);', + ' IntTypeTest(b + vm * c);', + ' a := b;', + ' b := c xor d;', + ' c := b + a;', + ' d := not c;', + ' Inc(a);', + ' Inc(a, 10);', + ' Dec(b);', + ' Dec(b, 10);', + ' Buf[0] := a;', + ' Buf[0] := a shr 1;', + ' Buf[0] := a + b;', + ' Buf[0] := a or Buf[0];', + ' Buf[0] := a - Buf[0];', + ' Buf2[0] := a;', + ' Buf2[0] := a shr 1;', + ' Buf2[0] := a + b;', + ' Buf2[0] := a or Buf2[0];', + ' a := b or vb;', + ' a := vb xor b;', + ' a := b or vb and c;', + ' a := b + vb;', + ' a := vb - b;', + ' a := b + vb * c;', + ' vb := a;', + ' vb := a and b;', + ' vb := a + b;', + ' a := b or vh;', + ' a := vh xor b;', + ' a := b or vh and c;', + ' a := b + vh;', + ' a := vh - b;', + ' a := b + vh * c;', + ' vh := a;', + ' vh := a and b;', + ' vh := a + b;', + ' a := b or vw;', + ' a := vw xor b;', + ' a := b or vw and c;', + ' a := b + vw;', + ' a := vw - b;', + ' a := b + vw * c;', + ' vw := a;', + ' vw := a and b;', + ' vw := a + b;', + ' a := b or vm;', + ' a := vm xor b;', + ' a := b or vm and c;', + ' a := b + vm;', + ' a := vm - b;', + ' a := b + vm * c;', + ' vm := a;', + ' vm := a and b;', + ' vm := a + b;', + '']); + ConvertProgram; + CheckSource('TestOptTruncateIntegersOnOverflow_OperatorsLongWord', + LinesToStr([ // statements + 'this.IntTypeTest$4 = function (v) {', + '};', + 'this.IntTypeTest$5 = function (v) {', + '};', + 'this.IntTypeTest$7 = function (v) {', + '};', + 'this.a = 0;', + 'this.b = 0;', + 'this.c = 0;', + 'this.d = 0;', + 'this.vb = 0;', + 'this.vh = 0;', + 'this.vw = 0;', + 'this.vm = 0;', + 'this.Buf = [];', + 'this.Buf2 = null;', + '']), + LinesToStr([ // this.$main + '$mod.IntTypeTest$4($mod.a & 1);', + '$mod.IntTypeTest$4(($mod.a | 1) >>> 0);', + '$mod.IntTypeTest$4(($mod.a ^ 1) >>> 0);', + '$mod.IntTypeTest$4($mod.a >>> 1);', + '$mod.IntTypeTest$4(($mod.a << 1) >>> 0);', + '$mod.IntTypeTest$4(($mod.a + 1) >>> 0);', + '$mod.IntTypeTest$4(($mod.a - 1) >>> 0);', + '$mod.IntTypeTest$4(($mod.a * 1) >>> 0);', + '$mod.IntTypeTest$4(rtl.trunc($mod.a / 1));', + '$mod.IntTypeTest$4($mod.a % 1);', + '$mod.IntTypeTest$4(Math.pow($mod.a, 1));', + '$mod.IntTypeTest$4(9 & $mod.a);', + '$mod.IntTypeTest$4((9 | $mod.a) >>> 0);', + '$mod.IntTypeTest$4((9 ^ $mod.a) >>> 0);', + '$mod.IntTypeTest$5(9 >>> $mod.a);', + '$mod.IntTypeTest$5(9 << $mod.a);', + '$mod.IntTypeTest$4((9 + $mod.a) >>> 0);', + '$mod.IntTypeTest$4((9 - $mod.a) >>> 0);', + '$mod.IntTypeTest$4((9 * $mod.a) >>> 0);', + '$mod.IntTypeTest$4(rtl.trunc(9 / $mod.a));', + '$mod.IntTypeTest$4(9 % $mod.a);', + '$mod.IntTypeTest$4(Math.pow(9, $mod.a));', + '$mod.IntTypeTest$4(($mod.a | 0x111) >>> 0);', + '$mod.IntTypeTest$4(($mod.a | 0x33333) >>> 0);', + '$mod.IntTypeTest$4(($mod.a | 0x5555555) >>> 0);', + '$mod.IntTypeTest$4(($mod.a + 0x111) >>> 0);', + '$mod.IntTypeTest$4(($mod.a + 0x33333) >>> 0);', + '$mod.IntTypeTest$4(($mod.a + 0x5555555) >>> 0);', + '$mod.IntTypeTest$4(($mod.a & $mod.b) >>> 0);', + '$mod.IntTypeTest$4(($mod.a | $mod.b) >>> 0);', + '$mod.IntTypeTest$4(($mod.a ^ $mod.b) >>> 0);', + '$mod.IntTypeTest$4($mod.a >>> $mod.b);', + '$mod.IntTypeTest$4(($mod.a << $mod.b) >>> 0);', + '$mod.IntTypeTest$4(~$mod.a >>> 0);', + '$mod.IntTypeTest$4(($mod.a + $mod.b) >>> 0);', + '$mod.IntTypeTest$4(($mod.a - $mod.b) >>> 0);', + '$mod.IntTypeTest$7($mod.a + -$mod.b);', + '$mod.IntTypeTest$4(($mod.a * $mod.b) >>> 0);', + '$mod.IntTypeTest$4(rtl.trunc($mod.a / $mod.b));', + '$mod.IntTypeTest$4($mod.a % $mod.b);', + '$mod.IntTypeTest$4(Math.pow($mod.a, $mod.b));', + '$mod.IntTypeTest$4(($mod.a & $mod.b & $mod.c & $mod.d) >>> 0);', + '$mod.IntTypeTest$4(($mod.a | $mod.b | $mod.c | $mod.d) >>> 0);', + '$mod.IntTypeTest$4(($mod.a ^ $mod.b ^ $mod.c ^ $mod.d) >>> 0);', + '$mod.IntTypeTest$4((($mod.a >>> $mod.b) >>> $mod.c) >>> $mod.d);', + '$mod.IntTypeTest$4(((($mod.a << $mod.b) << $mod.c) << $mod.d) >>> 0);', + '$mod.IntTypeTest$4(($mod.a + $mod.b + $mod.c + $mod.d) >>> 0);', + '$mod.IntTypeTest$4(($mod.a - $mod.b - $mod.c - $mod.d) >>> 0);', + '$mod.IntTypeTest$4(((((($mod.a * $mod.b) >>> 0) * $mod.c) >>> 0) * $mod.d) >>> 0);', + '$mod.IntTypeTest$4((((($mod.a & $mod.b) | $mod.c) ^ $mod.d) | ((~$mod.c >>> 0) >>> 1) | ($mod.c << 1)) >>> 0);', + '$mod.IntTypeTest$4((($mod.a + $mod.b) - (($mod.c * $mod.d) >>> 0)) >>> 0);', + '$mod.IntTypeTest$4(($mod.b | $mod.vb) >>> 0);', + '$mod.IntTypeTest$4(($mod.vb ^ $mod.b) >>> 0);', + '$mod.IntTypeTest$4(($mod.b | ($mod.vb & $mod.c)) >>> 0);', + '$mod.IntTypeTest$4(($mod.b + $mod.vb) >>> 0);', + '$mod.IntTypeTest$4(($mod.vb - $mod.b) >>> 0);', + '$mod.IntTypeTest$4(($mod.b + (($mod.vb * $mod.c) >>> 0)) >>> 0);', + '$mod.IntTypeTest$4(($mod.b | $mod.vh) >>> 0);', + '$mod.IntTypeTest$4(($mod.vh ^ $mod.b) >>> 0);', + '$mod.IntTypeTest$4(($mod.b | ($mod.vh & $mod.c)) >>> 0);', + '$mod.IntTypeTest$7($mod.b + $mod.vh);', + '$mod.IntTypeTest$7($mod.vh - $mod.b);', + '$mod.IntTypeTest$7($mod.b + ($mod.vh * $mod.c));', + '$mod.IntTypeTest$4(($mod.b | $mod.vw) >>> 0);', + '$mod.IntTypeTest$4(($mod.vw ^ $mod.b) >>> 0);', + '$mod.IntTypeTest$4(($mod.b | ($mod.vw & $mod.c)) >>> 0);', + '$mod.IntTypeTest$4(($mod.b + $mod.vw) >>> 0);', + '$mod.IntTypeTest$4(($mod.vw - $mod.b) >>> 0);', + '$mod.IntTypeTest$4(($mod.b + (($mod.vw * $mod.c) >>> 0)) >>> 0);', + '$mod.IntTypeTest$4(($mod.b | $mod.vm) >>> 0);', + '$mod.IntTypeTest$4(($mod.vm ^ $mod.b) >>> 0);', + '$mod.IntTypeTest$4(($mod.b | ($mod.vm & $mod.c)) >>> 0);', + '$mod.IntTypeTest$7($mod.b + $mod.vm);', + '$mod.IntTypeTest$7($mod.vm - $mod.b);', + '$mod.IntTypeTest$7($mod.b + ($mod.vm * $mod.c));', + '$mod.a = $mod.b;', + '$mod.b = ($mod.c ^ $mod.d) >>> 0;', + '$mod.c = ($mod.b + $mod.a) >>> 0;', + '$mod.d = ~$mod.c >>> 0;', + '$mod.a = ($mod.a + 1) >>> 0;', + '$mod.a = ($mod.a + 10) >>> 0;', + '$mod.b = ($mod.b - 1) >>> 0;', + '$mod.b = ($mod.b - 10) >>> 0;', + '$mod.Buf[0] = $mod.a;', + '$mod.Buf[0] = $mod.a >>> 1;', + '$mod.Buf[0] = ($mod.a + $mod.b) >>> 0;', + '$mod.Buf[0] = ($mod.a | $mod.Buf[0]) >>> 0;', + '$mod.Buf[0] = ($mod.a - $mod.Buf[0]) >>> 0;', + '$mod.Buf2[0] = $mod.a;', + '$mod.Buf2[0] = $mod.a >>> 1;', + '$mod.Buf2[0] = ($mod.a + $mod.b) >>> 0;', + '$mod.Buf2[0] = ($mod.a | $mod.Buf2[0]) >>> 0;', + '$mod.a = ($mod.b | $mod.vb) >>> 0;', + '$mod.a = ($mod.vb ^ $mod.b) >>> 0;', + '$mod.a = ($mod.b | ($mod.vb & $mod.c)) >>> 0;', + '$mod.a = ($mod.b + $mod.vb) >>> 0;', + '$mod.a = ($mod.vb - $mod.b) >>> 0;', + '$mod.a = ($mod.b + (($mod.vb * $mod.c) >>> 0)) >>> 0;', + '$mod.vb = $mod.a & 255;', + '$mod.vb = $mod.a & $mod.b & 255;', + '$mod.vb = ($mod.a + $mod.b) & 255;', + '$mod.a = ($mod.b | $mod.vh) >>> 0;', + '$mod.a = ($mod.vh ^ $mod.b) >>> 0;', + '$mod.a = ($mod.b | ($mod.vh & $mod.c)) >>> 0;', + '$mod.a = ($mod.b + $mod.vh) >>> 0;', + '$mod.a = ($mod.vh - $mod.b) >>> 0;', + '$mod.a = ($mod.b + ($mod.vh * $mod.c)) >>> 0;', + '$mod.vh = (($mod.a & 255) << 24) >> 24;', + '$mod.vh = (($mod.a & $mod.b & 255) << 24) >> 24;', + '$mod.vh = ((($mod.a + $mod.b) & 255) << 24) >> 24;', + '$mod.a = ($mod.b | $mod.vw) >>> 0;', + '$mod.a = ($mod.vw ^ $mod.b) >>> 0;', + '$mod.a = ($mod.b | ($mod.vw & $mod.c)) >>> 0;', + '$mod.a = ($mod.b + $mod.vw) >>> 0;', + '$mod.a = ($mod.vw - $mod.b) >>> 0;', + '$mod.a = ($mod.b + (($mod.vw * $mod.c) >>> 0)) >>> 0;', + '$mod.vw = $mod.a & 65535;', + '$mod.vw = $mod.a & $mod.b & 65535;', + '$mod.vw = ($mod.a + $mod.b) & 65535;', + '$mod.a = ($mod.b | $mod.vm) >>> 0;', + '$mod.a = ($mod.vm ^ $mod.b) >>> 0;', + '$mod.a = ($mod.b | ($mod.vm & $mod.c)) >>> 0;', + '$mod.a = ($mod.b + $mod.vm) >>> 0;', + '$mod.a = ($mod.vm - $mod.b) >>> 0;', + '$mod.a = ($mod.b + ($mod.vm * $mod.c)) >>> 0;', + '$mod.vm = (($mod.a & 65535) << 16) >> 16;', + '$mod.vm = (($mod.a & $mod.b & 65535) << 16) >> 16;', + '$mod.vm = ((($mod.a + $mod.b) & 65535) << 16) >> 16;', + ''])); +end; + +procedure TTestOptimizations.TestOptTruncateIntegersOnOverflow_OperatorsLongInt; +begin + StartProgram(false); + Add([ + '{$modeswitch externalclass}', + '{$optimization JSTruncateIntegersOnOverflow ON}', + 'procedure IntTypeTest(v: Byte); overload; begin end;', + 'procedure IntTypeTest(v: ShortInt); overload; begin end;', + 'procedure IntTypeTest(v: Word); overload; begin end;', + 'procedure IntTypeTest(v: SmallInt); overload; begin end;', + 'procedure IntTypeTest(v: LongWord); overload; begin end;', + 'procedure IntTypeTest(v: LongInt); overload; begin end;', + 'procedure IntTypeTest(v: NativeUInt); overload; begin end;', + 'procedure IntTypeTest(v: NativeInt); overload; begin end;', + 'type', + ' TJSInt32Array = class external name ''Int32Array''', + ' private', + ' function getTypedValue(Index : NativeInt): LongInt; external name ''[]'';', + ' procedure setTypedValue(Index : NativeInt; AValue: LongInt);external name ''[]'';', + ' public', + ' constructor new (length : NativeInt);', + ' property values[Index : NativeInt] : LongInt Read getTypedValue Write setTypedValue; default;', + ' end;', + 'var', + ' a, b, c, d : LongInt;', + ' vb : Byte;', + ' vh : ShortInt;', + ' vw : Word;', + ' vm : SmallInt;', + ' vl : LongWord;', + ' Buf : array of LongInt;', + ' Buf2 : TJSInt32Array;', + 'begin', + ' IntTypeTest(a and 1);', + ' IntTypeTest(a or 1);', + ' IntTypeTest(a xor 1);', + ' IntTypeTest(a shr 1);', + ' IntTypeTest(a shl 1);', + ' IntTypeTest(a + 1);', + ' IntTypeTest(a - 1);', + ' IntTypeTest(a * 1);', + ' IntTypeTest(a div 1);', + ' IntTypeTest(a mod 1);', + ' IntTypeTest(a ** 1);', + ' IntTypeTest(9 and a);', + ' IntTypeTest(9 or a);', + ' IntTypeTest(9 xor a);', + ' IntTypeTest(9 shr a);', + ' IntTypeTest(9 shl a);', + ' IntTypeTest(9 + a);', + ' IntTypeTest(9 - a);', + ' IntTypeTest(9 * a);', + ' IntTypeTest(9 div a);', + ' IntTypeTest(9 mod a);', + ' IntTypeTest(9 ** a);', + ' IntTypeTest(a or $111);', + ' IntTypeTest(a or $33333);', + ' IntTypeTest(a or $5555555);', + ' IntTypeTest(a + $111);', + ' IntTypeTest(a + $33333);', + ' IntTypeTest(a + $5555555);', + ' IntTypeTest(a and b);', + ' IntTypeTest(a or b);', + ' IntTypeTest(a xor b);', + ' IntTypeTest(a shr b);', + ' IntTypeTest(a shl b);', + ' IntTypeTest(not a);', + ' IntTypeTest(a + b);', + ' IntTypeTest(a - b);', + ' IntTypeTest(a + -b);', + ' IntTypeTest(a * b);', + ' IntTypeTest(a div b);', + ' IntTypeTest(a mod b);', + ' IntTypeTest(a ** b);', + ' IntTypeTest(a and b and c and d);', + ' IntTypeTest(a or b or c or d);', + ' IntTypeTest(a xor b xor c xor d);', + ' IntTypeTest(a shr b shr c shr d);', + ' IntTypeTest(a shl b shl c shl d);', + ' IntTypeTest(a + b + c + d);', + ' IntTypeTest(a - b - c - d);', + ' IntTypeTest(a * b * c * d);', + ' IntTypeTest(a and b or c xor d or not c shr 1 or c shl 1);', + ' IntTypeTest(a + b - c * d);', + ' IntTypeTest(b or vb);', + ' IntTypeTest(vb xor b);', + ' IntTypeTest(b or vb and c);', + ' IntTypeTest(b + vb);', + ' IntTypeTest(vb - b);', + ' IntTypeTest(b + vb * c);', + ' IntTypeTest(b or vh);', + ' IntTypeTest(vh xor b);', + ' IntTypeTest(b or vh and c);', + ' IntTypeTest(b + vh);', + ' IntTypeTest(vh - b);', + ' IntTypeTest(b + vh * c);', + ' IntTypeTest(b or vw);', + ' IntTypeTest(vw xor b);', + ' IntTypeTest(b or vw and c);', + ' IntTypeTest(b + vw);', + ' IntTypeTest(vw - b);', + ' IntTypeTest(b + vw * c);', + ' IntTypeTest(b or vm);', + ' IntTypeTest(vm xor b);', + ' IntTypeTest(b or vm and c);', + ' IntTypeTest(b + vm);', + ' IntTypeTest(vm - b);', + ' IntTypeTest(b + vm * c);', + ' IntTypeTest(b or vl);', + ' IntTypeTest(vl xor b);', + ' IntTypeTest(b or vl and c);', + ' IntTypeTest(b + vl);', + ' IntTypeTest(vl - b);', + ' IntTypeTest(b + vl * c);', + ' a := b;', + ' b := c xor d;', + ' c := b + a;', + ' d := not c;', + ' Inc(a);', + ' Inc(a, 10);', + ' Dec(b);', + ' Dec(b, 10);', + ' Buf[0] := a;', + ' Buf[0] := a shr 1;', + ' Buf[0] := a + b;', + ' Buf[0] := a or Buf[0];', + ' Buf[0] := a - Buf[0];', + ' Buf2[0] := a;', + ' Buf2[0] := a shr 1;', + ' Buf2[0] := a + b;', + ' Buf2[0] := a or Buf2[0];', + ' a := b or vb;', + ' a := vb xor b;', + ' a := b or vb and c;', + ' a := b + vb;', + ' a := vb - b;', + ' a := b + vb * c;', + ' vb := a;', + ' vb := a and b;', + ' vb := a + b;', + ' a := b or vh;', + ' a := vh xor b;', + ' a := b or vh and c;', + ' a := b + vh;', + ' a := vh - b;', + ' a := b + vh * c;', + ' vh := a;', + ' vh := a and b;', + ' vh := a + b;', + ' a := b or vw;', + ' a := vw xor b;', + ' a := b or vw and c;', + ' a := b + vw;', + ' a := vw - b;', + ' a := b + vw * c;', + ' vw := a;', + ' vw := a and b;', + ' vw := a + b;', + ' a := b or vm;', + ' a := vm xor b;', + ' a := b or vm and c;', + ' a := b + vm;', + ' a := vm - b;', + ' a := b + vm * c;', + ' vm := a;', + ' vm := a and b;', + ' vm := a + b;', + ' a := b or vl;', + ' a := vl xor b;', + ' a := b or vl and c;', + ' a := b + vl;', + ' a := vl - b;', + ' a := b + vl * c;', + ' vl := a;', + ' vl := a and b;', + ' vl := a + b;', + '']); + ConvertProgram; + CheckSource('TestOptTruncateIntegersOnOverflow_OperatorsLongInt', + LinesToStr([ // statements + 'this.IntTypeTest$4 = function (v) {', + '};', + 'this.IntTypeTest$5 = function (v) {', + '};', + 'this.IntTypeTest$7 = function (v) {', + '};', + 'this.a = 0;', + 'this.b = 0;', + 'this.c = 0;', + 'this.d = 0;', + 'this.vb = 0;', + 'this.vh = 0;', + 'this.vw = 0;', + 'this.vm = 0;', + 'this.vl = 0;', + 'this.Buf = [];', + 'this.Buf2 = null;', + '']), + LinesToStr([ // this.$main + '$mod.IntTypeTest$5($mod.a & 1);', + '$mod.IntTypeTest$5($mod.a | 1);', + '$mod.IntTypeTest$5($mod.a ^ 1);', + '$mod.IntTypeTest$5($mod.a >>> 1);', + '$mod.IntTypeTest$5($mod.a << 1);', + '$mod.IntTypeTest$5(($mod.a + 1) | 0);', + '$mod.IntTypeTest$5(($mod.a - 1) | 0);', + '$mod.IntTypeTest$5(($mod.a * 1) | 0);', + '$mod.IntTypeTest$5(rtl.trunc($mod.a / 1));', + '$mod.IntTypeTest$5($mod.a % 1);', + '$mod.IntTypeTest$5(Math.pow($mod.a, 1));', + '$mod.IntTypeTest$5(9 & $mod.a);', + '$mod.IntTypeTest$5(9 | $mod.a);', + '$mod.IntTypeTest$5(9 ^ $mod.a);', + '$mod.IntTypeTest$5(9 >>> $mod.a);', + '$mod.IntTypeTest$5(9 << $mod.a);', + '$mod.IntTypeTest$5((9 + $mod.a) | 0);', + '$mod.IntTypeTest$5((9 - $mod.a) | 0);', + '$mod.IntTypeTest$5((9 * $mod.a) | 0);', + '$mod.IntTypeTest$5(rtl.trunc(9 / $mod.a));', + '$mod.IntTypeTest$5(9 % $mod.a);', + '$mod.IntTypeTest$5(Math.pow(9, $mod.a));', + '$mod.IntTypeTest$5($mod.a | 0x111);', + '$mod.IntTypeTest$5($mod.a | 0x33333);', + '$mod.IntTypeTest$5($mod.a | 0x5555555);', + '$mod.IntTypeTest$5(($mod.a + 0x111) | 0);', + '$mod.IntTypeTest$5(($mod.a + 0x33333) | 0);', + '$mod.IntTypeTest$5(($mod.a + 0x5555555) | 0);', + '$mod.IntTypeTest$5($mod.a & $mod.b);', + '$mod.IntTypeTest$5($mod.a | $mod.b);', + '$mod.IntTypeTest$5($mod.a ^ $mod.b);', + '$mod.IntTypeTest$5($mod.a >>> $mod.b);', + '$mod.IntTypeTest$5($mod.a << $mod.b);', + '$mod.IntTypeTest$5(~$mod.a);', + '$mod.IntTypeTest$5(($mod.a + $mod.b) | 0);', + '$mod.IntTypeTest$5(($mod.a - $mod.b) | 0);', + '$mod.IntTypeTest$5(($mod.a + -$mod.b) | 0);', + '$mod.IntTypeTest$5(($mod.a * $mod.b) | 0);', + '$mod.IntTypeTest$5(rtl.trunc($mod.a / $mod.b));', + '$mod.IntTypeTest$5($mod.a % $mod.b);', + '$mod.IntTypeTest$5(Math.pow($mod.a, $mod.b));', + '$mod.IntTypeTest$5($mod.a & $mod.b & $mod.c & $mod.d);', + '$mod.IntTypeTest$5($mod.a | $mod.b | $mod.c | $mod.d);', + '$mod.IntTypeTest$5($mod.a ^ $mod.b ^ $mod.c ^ $mod.d);', + '$mod.IntTypeTest$5((($mod.a >>> $mod.b) >>> $mod.c) >>> $mod.d);', + '$mod.IntTypeTest$5((($mod.a << $mod.b) << $mod.c) << $mod.d);', + '$mod.IntTypeTest$5(($mod.a + $mod.b + $mod.c + $mod.d) | 0);', + '$mod.IntTypeTest$5(($mod.a - $mod.b - $mod.c - $mod.d) | 0);', + '$mod.IntTypeTest$5(((((($mod.a * $mod.b) | 0) * $mod.c) | 0) * $mod.d) | 0);', + '$mod.IntTypeTest$5(((($mod.a & $mod.b) | $mod.c) ^ $mod.d) | (~$mod.c >>> 1) | ($mod.c << 1));', + '$mod.IntTypeTest$5((($mod.a + $mod.b) - (($mod.c * $mod.d) | 0)) | 0);', + '$mod.IntTypeTest$5($mod.b | $mod.vb);', + '$mod.IntTypeTest$5($mod.vb ^ $mod.b);', + '$mod.IntTypeTest$5($mod.b | ($mod.vb & $mod.c));', + '$mod.IntTypeTest$5(($mod.b + $mod.vb) | 0);', + '$mod.IntTypeTest$5(($mod.vb - $mod.b) | 0);', + '$mod.IntTypeTest$5(($mod.b + (($mod.vb * $mod.c) | 0)) | 0);', + '$mod.IntTypeTest$5($mod.b | $mod.vh);', + '$mod.IntTypeTest$5($mod.vh ^ $mod.b);', + '$mod.IntTypeTest$5($mod.b | ($mod.vh & $mod.c));', + '$mod.IntTypeTest$5(($mod.b + $mod.vh) | 0);', + '$mod.IntTypeTest$5(($mod.vh - $mod.b) | 0);', + '$mod.IntTypeTest$5(($mod.b + (($mod.vh * $mod.c) | 0)) | 0);', + '$mod.IntTypeTest$5($mod.b | $mod.vw);', + '$mod.IntTypeTest$5($mod.vw ^ $mod.b);', + '$mod.IntTypeTest$5($mod.b | ($mod.vw & $mod.c));', + '$mod.IntTypeTest$5(($mod.b + $mod.vw) | 0);', + '$mod.IntTypeTest$5(($mod.vw - $mod.b) | 0);', + '$mod.IntTypeTest$5(($mod.b + (($mod.vw * $mod.c) | 0)) | 0);', + '$mod.IntTypeTest$5($mod.b | $mod.vm);', + '$mod.IntTypeTest$5($mod.vm ^ $mod.b);', + '$mod.IntTypeTest$5($mod.b | ($mod.vm & $mod.c));', + '$mod.IntTypeTest$5(($mod.b + $mod.vm) | 0);', + '$mod.IntTypeTest$5(($mod.vm - $mod.b) | 0);', + '$mod.IntTypeTest$5(($mod.b + (($mod.vm * $mod.c) | 0)) | 0);', + '$mod.IntTypeTest$4(($mod.b | $mod.vl) >>> 0);', + '$mod.IntTypeTest$4(($mod.vl ^ $mod.b) >>> 0);', + '$mod.IntTypeTest$4(($mod.b | ($mod.vl & $mod.c)) >>> 0);', + '$mod.IntTypeTest$7($mod.b + $mod.vl);', + '$mod.IntTypeTest$7($mod.vl - $mod.b);', + '$mod.IntTypeTest$7($mod.b + ($mod.vl * $mod.c));', + '$mod.a = $mod.b;', + '$mod.b = $mod.c ^ $mod.d;', + '$mod.c = ($mod.b + $mod.a) | 0;', + '$mod.d = ~$mod.c;', + '$mod.a = ($mod.a + 1) | 0;', + '$mod.a = ($mod.a + 10) | 0;', + '$mod.b = ($mod.b - 1) | 0;', + '$mod.b = ($mod.b - 10) | 0;', + '$mod.Buf[0] = $mod.a;', + '$mod.Buf[0] = $mod.a >>> 1;', + '$mod.Buf[0] = ($mod.a + $mod.b) | 0;', + '$mod.Buf[0] = $mod.a | $mod.Buf[0];', + '$mod.Buf[0] = ($mod.a - $mod.Buf[0]) | 0;', + '$mod.Buf2[0] = $mod.a;', + '$mod.Buf2[0] = $mod.a >>> 1;', + '$mod.Buf2[0] = ($mod.a + $mod.b) | 0;', + '$mod.Buf2[0] = $mod.a | $mod.Buf2[0];', + '$mod.a = $mod.b | $mod.vb;', + '$mod.a = $mod.vb ^ $mod.b;', + '$mod.a = $mod.b | ($mod.vb & $mod.c);', + '$mod.a = ($mod.b + $mod.vb) | 0;', + '$mod.a = ($mod.vb - $mod.b) | 0;', + '$mod.a = ($mod.b + (($mod.vb * $mod.c) | 0)) | 0;', + '$mod.vb = $mod.a & 255;', + '$mod.vb = $mod.a & $mod.b & 255;', + '$mod.vb = ($mod.a + $mod.b) & 255;', + '$mod.a = $mod.b | $mod.vh;', + '$mod.a = $mod.vh ^ $mod.b;', + '$mod.a = $mod.b | ($mod.vh & $mod.c);', + '$mod.a = ($mod.b + $mod.vh) | 0;', + '$mod.a = ($mod.vh - $mod.b) | 0;', + '$mod.a = ($mod.b + (($mod.vh * $mod.c) | 0)) | 0;', + '$mod.vh = (($mod.a & 255) << 24) >> 24;', + '$mod.vh = (($mod.a & $mod.b & 255) << 24) >> 24;', + '$mod.vh = ((($mod.a + $mod.b) & 255) << 24) >> 24;', + '$mod.a = $mod.b | $mod.vw;', + '$mod.a = $mod.vw ^ $mod.b;', + '$mod.a = $mod.b | ($mod.vw & $mod.c);', + '$mod.a = ($mod.b + $mod.vw) | 0;', + '$mod.a = ($mod.vw - $mod.b) | 0;', + '$mod.a = ($mod.b + (($mod.vw * $mod.c) | 0)) | 0;', + '$mod.vw = $mod.a & 65535;', + '$mod.vw = $mod.a & $mod.b & 65535;', + '$mod.vw = ($mod.a + $mod.b) & 65535;', + '$mod.a = $mod.b | $mod.vm;', + '$mod.a = $mod.vm ^ $mod.b;', + '$mod.a = $mod.b | ($mod.vm & $mod.c);', + '$mod.a = ($mod.b + $mod.vm) | 0;', + '$mod.a = ($mod.vm - $mod.b) | 0;', + '$mod.a = ($mod.b + (($mod.vm * $mod.c) | 0)) | 0;', + '$mod.vm = (($mod.a & 65535) << 16) >> 16;', + '$mod.vm = (($mod.a & $mod.b & 65535) << 16) >> 16;', + '$mod.vm = ((($mod.a + $mod.b) & 65535) << 16) >> 16;', + '$mod.a = $mod.b | $mod.vl | 0;', + '$mod.a = ($mod.vl ^ $mod.b) | 0;', + '$mod.a = $mod.b | ($mod.vl & $mod.c) | 0;', + '$mod.a = ($mod.b + $mod.vl) | 0;', + '$mod.a = ($mod.vl - $mod.b) | 0;', + '$mod.a = ($mod.b + ($mod.vl * $mod.c)) | 0;', + '$mod.vl = $mod.a >>> 0;', + '$mod.vl = ($mod.a & $mod.b) >>> 0;', + '$mod.vl = ($mod.a + $mod.b) >>> 0;', + ''])); +end; + Initialization RegisterTests([TTestOptimizations]); end. From 44c43145774f09226b5ba2cc508fa4a63cad9a7b Mon Sep 17 00:00:00 2001 From: Dmytro Date: Fri, 29 Oct 2021 16:12:45 +0300 Subject: [PATCH 10/11] Added minor optimization on assigning expression to Uint32Array/Int32Array element --- packages/pastojs/src/fppas2js.pp | 72 ++++++++++++---------- packages/pastojs/tests/tcoptimizations.pas | 6 +- 2 files changed, 44 insertions(+), 34 deletions(-) diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index ad899c536e..8d87016e5a 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -11381,6 +11381,42 @@ function TPasToJSConverter.CreateIntegerBitFixAuto(El: TPasElement; AContext: TC end; end; + function LeftIsTypedArrayOfType(aResolver: TPas2JSResolver; LeftResolved: TPasResolverResult; + ToType: TResolverBaseType) : Boolean; + var + PropertyEl : TPasProperty; + begin + Result := false; + if (aResolver <> nil) and (LeftResolved.IdentEl is TPasProperty) then + begin + PropertyEl := TPasProperty(LeftResolved.IdentEl); + if aResolver.IsExternalBracketAccessor(aResolver.GetPasPropertySetter(PropertyEl)) then + begin + if PropertyEl.Parent is TPasClassType then + begin + if (ToType = btByte) and + aResolver.IsExternalClass_Name(TPasClassType(PropertyEl.Parent),'Uint8Array') then + Result := true + else if (ToType = btShortInt) and + aResolver.IsExternalClass_Name(TPasClassType(PropertyEl.Parent),'Int8Array') then + Result := true + else if (ToType = btWord) and + aResolver.IsExternalClass_Name(TPasClassType(PropertyEl.Parent),'Uint16Array') then + Result := true + else if (ToType = btSmallInt) and + aResolver.IsExternalClass_Name(TPasClassType(PropertyEl.Parent),'Int16Array') then + Result := true + else if (ToType = btLongWord) and + aResolver.IsExternalClass_Name(TPasClassType(PropertyEl.Parent),'Uint32Array') then + Result := true + else if (ToType = btLongInt) and + aResolver.IsExternalClass_Name(TPasClassType(PropertyEl.Parent),'Int32Array') then + Result := true; + end; + end; + end; + end; + var ResolvedEl, LeftResolved, RightResolved: TPasResolverResult; aResolver: TPas2JSResolver; @@ -11388,7 +11424,6 @@ var BinaryEl : TBinaryExpr; AssignEl : TPasImplAssign; ParamsEl : TParamsExpr; - PropertyEl : TPasProperty; ToType, LeftResolvedType, RightResolvedType : TResolverBaseType; AssignContext : TAssignContext; NeedBitFix, ParentWillFixOverflow, ParentAllowSignificantOverflow, IsArrayIndexExpr : Boolean; @@ -11518,7 +11553,9 @@ begin RightResolvedType := RightResolved.BaseType; // select smallest type by size - if UseLeftTypeForAssignment(LeftResolvedType, RightResolvedType) then + if UseLeftTypeForAssignment(LeftResolvedType, RightResolvedType) or + // in case if types equal and left is TypedArray, then we can omit typecasting + ((LeftResolvedType = RightResolvedType) and LeftIsTypedArrayOfType(aResolver, LeftResolved, LeftResolvedType)) then begin ParentWillFixOverflow := true; ParentAllowSignificantOverflow := true; @@ -11638,36 +11675,9 @@ begin begin NeedBitFix := true; ToType := LeftResolvedType; - // if we are assigning value to the TypedArray, then we can omit typecasting - if (aResolver <> nil) and (LeftResolved.IdentEl is TPasProperty) then - begin - PropertyEl := TPasProperty(LeftResolved.IdentEl); - if aResolver.IsExternalBracketAccessor(aResolver.GetPasPropertySetter(PropertyEl)) then - begin - if PropertyEl.Parent is TPasClassType then - begin - if (ToType = btByte) and - aResolver.IsExternalClass_Name(TPasClassType(PropertyEl.Parent),'Uint8Array') then - NeedBitFix := false - else if (ToType = btShortInt) and - aResolver.IsExternalClass_Name(TPasClassType(PropertyEl.Parent),'Int8Array') then - NeedBitFix := false - else if (ToType = btWord) and - aResolver.IsExternalClass_Name(TPasClassType(PropertyEl.Parent),'Uint16Array') then - NeedBitFix := false - else if (ToType = btSmallInt) and - aResolver.IsExternalClass_Name(TPasClassType(PropertyEl.Parent),'Int16Array') then - NeedBitFix := false - else if (ToType = btLongWord) and - aResolver.IsExternalClass_Name(TPasClassType(PropertyEl.Parent),'Uint32Array') then - NeedBitFix := false - else if (ToType = btLongInt) and - aResolver.IsExternalClass_Name(TPasClassType(PropertyEl.Parent),'Int32Array') then - NeedBitFix := false; - end; - end; - end; + if LeftIsTypedArrayOfType(aResolver, LeftResolved, ToType) then + NeedBitFix := false; if NeedBitFix and (Result is TJSSimpleAssignStatement) then TJSSimpleAssignStatement(Result).Expr := CreateIntegerBitFix(El, TJSSimpleAssignStatement(Result).Expr, ToType); diff --git a/packages/pastojs/tests/tcoptimizations.pas b/packages/pastojs/tests/tcoptimizations.pas index 089b71997e..b61dc14d70 100644 --- a/packages/pastojs/tests/tcoptimizations.pas +++ b/packages/pastojs/tests/tcoptimizations.pas @@ -3823,8 +3823,8 @@ begin '$mod.Buf[0] = ($mod.a - $mod.Buf[0]) >>> 0;', '$mod.Buf2[0] = $mod.a;', '$mod.Buf2[0] = $mod.a >>> 1;', - '$mod.Buf2[0] = ($mod.a + $mod.b) >>> 0;', - '$mod.Buf2[0] = ($mod.a | $mod.Buf2[0]) >>> 0;', + '$mod.Buf2[0] = $mod.a + $mod.b;', + '$mod.Buf2[0] = $mod.a | $mod.Buf2[0];', '$mod.a = ($mod.b | $mod.vb) >>> 0;', '$mod.a = ($mod.vb ^ $mod.b) >>> 0;', '$mod.a = ($mod.b | ($mod.vb & $mod.c)) >>> 0;', @@ -4159,7 +4159,7 @@ begin '$mod.Buf[0] = ($mod.a - $mod.Buf[0]) | 0;', '$mod.Buf2[0] = $mod.a;', '$mod.Buf2[0] = $mod.a >>> 1;', - '$mod.Buf2[0] = ($mod.a + $mod.b) | 0;', + '$mod.Buf2[0] = $mod.a + $mod.b;', '$mod.Buf2[0] = $mod.a | $mod.Buf2[0];', '$mod.a = $mod.b | $mod.vb;', '$mod.a = $mod.vb ^ $mod.b;', From 4821dff8997114fe234c64c4ac96bd9488c49e76 Mon Sep 17 00:00:00 2001 From: Dmytro Date: Mon, 13 Mar 2023 16:02:31 +0200 Subject: [PATCH 11/11] merge related fixes --- packages/pastojs/src/fppas2js.pp | 622 +++++++++++++++++++++++++++++++ 1 file changed, 622 insertions(+) diff --git a/packages/pastojs/src/fppas2js.pp b/packages/pastojs/src/fppas2js.pp index 94719ede0d..8d87016e5a 100644 --- a/packages/pastojs/src/fppas2js.pp +++ b/packages/pastojs/src/fppas2js.pp @@ -11049,6 +11049,568 @@ begin // integer to currency -> value*10000 Result:=CreateMulNumber(PosEl,Result,10000); if ToBT<>btIntDouble then + begin + if not (Result is TJSLiteral) and (bsRangeChecks in ArgContext.ScannerBoolSwitches) then + begin + // rtl.rc(param,MinInt,MaxInt) + if not aResolver.GetIntegerRange(ToBT,MinVal,MaxVal) then + RaiseNotSupported(PosEl,ArgContext,20180425131839); + Call:=CreateCallExpression(PosEl); + Call.Expr:=CreatePrimitiveDotExpr(GetBIName(pbivnRTL)+'.'+GetBIName(pbifnRangeCheckInt),PosEl); + Call.AddArg(Result); + Result:=Call; + Call.AddArg(CreateLiteralNumber(PosEl,MinVal)); + Call.AddArg(CreateLiteralNumber(PosEl,MaxVal)); + end + else + case ToBT of + btByte: + if FromBT<>btByte then + Result:=CreateByteBitFix(PosEl,Result); + btShortInt: + if FromBT<>btShortInt then + Result:=CreateShortIntBitFix(PosEl,Result); + btWord: + if not (FromBT in [btByte,btWord]) then + Result:=CreateWordBitFix(PosEl,Result); + btSmallInt: + if not (FromBT in [btShortInt,btSmallInt]) then + Result:=CreateSmallIntBitFix(PosEl,Result); + btLongWord: + if not (FromBT in [btByte,btWord,btLongWord,btUIntSingle]) then + Result := CreateLongwordBitFix(PosEl, Result); + btLongint: + if not (FromBT in [btShortInt,btSmallInt,btLongint,btIntSingle]) then + Result:=CreateLongIntBitFix(PosEl,Result); + end; + end; +end; + +function TPasToJSConverter.CreateBitwiseAnd(El: TPasElement; Value: TJSElement; + const Mask: TMaxPrecInt): TJSElement; + + procedure SetNumberCustomValue(V: TJSLiteral; const Value: TMaxPrecInt); + var + Hex: String; + i: Integer; + begin + if Value>999999 then + begin + Hex:=HexStr(Value,8); + i:=1; + while i<8 do + if Hex[i]='0' then + inc(i) + else + break; + Hex:=Copy(Hex,i,8); + V.Value.CustomValue:=TJSString('0x'+Hex); + end + else + V.Value.CustomValue:=TJSString(''); + end; + +var + AndEx: TJSBitwiseAndExpression; + Int: TMaxPrecInt; +begin + if IsLiteralInteger(Value,Int) then + begin + TJSLiteral(Value).Value.AsNumber := Int and Mask; + SetNumberCustomValue(TJSLiteral(Value), Int and Mask); + exit(Value); + end + else + if Value is TJSBitwiseAndExpression then + begin + AndEx := TJSBitwiseAndExpression(Value); + if IsLiteralIntegerExpr(AndEx.A,Int) and (Int and Mask = Int) then + exit(Value); + if IsLiteralIntegerExpr(AndEx.B,Int) and (Int and Mask = Int) then + exit(Value); + + if IsLiteralInteger(AndEx.A,Int) then + begin + TJSLiteral(AndEx.A).Value.AsNumber := Int and Mask; + SetNumberCustomValue(TJSLiteral(AndEx.A), Int and Mask); + exit(Value); + end; + + if IsLiteralInteger(AndEx.B,Int) then + begin + TJSLiteral(AndEx.B).Value.AsNumber := Int and Mask; + SetNumberCustomValue(TJSLiteral(AndEx.B), Int and Mask); + exit(Value); + end; + end; + + AndEx := TJSBitwiseAndExpression(CreateElement(TJSBitwiseAndExpression,El)); + Result := AndEx; + AndEx.A := Value; + AndEx.B := CreateLiteralNumber(El, Mask); + SetNumberCustomValue(TJSLiteral(AndEx.B), Mask); +end; + +function TPasToJSConverter.CreateBitwiseXor(El: TPasElement; Value: TJSElement; + const Mask: TMaxPrecInt): TJSElement; + + procedure SetNumberCustomValue(V: TJSLiteral; const Value: TMaxPrecInt); + var + Hex: String; + i: Integer; + begin + if Value>999999 then + begin + Hex:=HexStr(Value,8); + i:=1; + while i<8 do + if Hex[i]='0' then + inc(i) + else + break; + Hex:=Copy(Hex,i,8); + V.Value.CustomValue:=TJSString('0x'+Hex); + end + else + V.Value.CustomValue:=TJSString(''); + end; + +var + XorEx: TJSBitwiseXorExpression; + Int: TMaxPrecInt; +begin + if IsLiteralInteger(Value,Int) then + begin + TJSLiteral(Value).Value.AsNumber := Int xor Mask; + SetNumberCustomValue(TJSLiteral(Value), Int xor Mask); + exit(Value); + end + else + if Value is TJSBitwiseXorExpression then + begin + XorEx := TJSBitwiseXorExpression(Value); + if IsLiteralInteger(XorEx.A,Int) then + begin + TJSLiteral(XorEx.A).Value.AsNumber := Int xor Mask; + SetNumberCustomValue(TJSLiteral(XorEx.A), Int xor Mask); + exit(Value); + end; + + if IsLiteralInteger(XorEx.B,Int) then + begin + TJSLiteral(XorEx.B).Value.AsNumber := Int xor Mask; + SetNumberCustomValue(TJSLiteral(XorEx.B), Int xor Mask); + exit(Value); + end; + end; + + XorEx := TJSBitwiseXorExpression(CreateElement(TJSBitwiseXorExpression,El)); + Result := XorEx; + XorEx.A := Value; + XorEx.B := CreateLiteralNumber(El, Mask); + SetNumberCustomValue(TJSLiteral(XorEx.B), Mask); +end; + +Function TPasToJSConverter.CreateBitwiseShiftLeftRight(El: TPasElement; Value: TJSElement; Shift: integer): TJSElement; +var + ShiftEx: TJSShiftExpression; +begin + Result := Value; + if Shift <= 0 then + Exit; + // value << ZeroBits + ShiftEx := TJSLShiftExpression(CreateElement(TJSLShiftExpression,El)); + ShiftEx.A := Result; + Result := ShiftEx; + ShiftEx.B := CreateLiteralNumber(El,Shift); + // value << ZeroBits >> ZeroBits + ShiftEx := TJSRShiftExpression(CreateElement(TJSRShiftExpression,El)); + ShiftEx.A := Result; + Result := ShiftEx; + ShiftEx.B := CreateLiteralNumber(El,Shift); +end; + +function TPasToJSConverter.CreateByteBitFix(El: TPasElement; + Value: TJSElement): TJSElement; +var + Int: TMaxPrecInt; +begin + if IsLiteralIntegerExpr(Value,Int) and (Int and $ff = Int) then + Result := Value + else + // value to byte -> value & 255 + Result := CreateBitwiseAnd(El,Value,$ff); +end; + +function TPasToJSConverter.CreateShortIntBitFix(El: TPasElement; + Value: TJSElement): TJSElement; +var + Int: TMaxPrecInt; +begin + if IsLiteralIntegerExpr(Value,Int) and (ShortInt(Int) = Int) then + Result := Value + else + begin + // value to shortint -> value & 255 << 24 >> 24 + Result := CreateBitwiseAnd(El,Value,$ff); + Result := CreateBitwiseShiftLeftRight(El,Result,24); + end; +end; + +function TPasToJSConverter.CreateWordBitFix(El: TPasElement; + Value: TJSElement): TJSElement; +var + Int: TMaxPrecInt; +begin + if IsLiteralIntegerExpr(Value,Int) and (Int and $ffff = Int) then + Result := Value + else + // value to word -> value & 65535 + Result := CreateBitwiseAnd(El,Value,$ffff); +end; + +function TPasToJSConverter.CreateSmallIntBitFix(El: TPasElement; + Value: TJSElement): TJSElement; +var + Int: TMaxPrecInt; +begin + if IsLiteralIntegerExpr(Value,Int) and (SmallInt(Int) = Int) then + Result := Value + else + begin + // value to smallint -> value & 65535 << 16 >> 16 + Result := CreateBitwiseAnd(El,Value,$ffff); + Result := CreateBitwiseShiftLeftRight(El,Result,16); + end; +end; + +function TPasToJSConverter.CreateLongwordBitFix(El: TPasElement; + Value: TJSElement): TJSElement; +var + ShiftEx: TJSURShiftExpression; + AndEx: TJSBitwiseAndExpression; + Int: TMaxPrecInt; +begin + if IsLiteralIntegerExpr(Value,Int) and (Int and $ffffffff = Int) then + Result := Value + else + begin + if Value is TJSBitwiseAndExpression then + begin + AndEx := TJSBitwiseAndExpression(Value); + if IsLiteralIntegerExpr(AndEx.A,Int) and (Int >= 0) and (Int <= $7fffffff) then + exit(Value); + + if IsLiteralIntegerExpr(AndEx.B,Int) and (Int >= 0) and (Int <= $7fffffff) then + exit(Value); + end; + + // value to longword -> value >>> 0 + ShiftEx := TJSURShiftExpression(CreateElement(TJSURShiftExpression,El)); + ShiftEx.A := Value; + ShiftEx.B := CreateLiteralNumber(El,0); + Result := ShiftEx; + end; +end; + +function TPasToJSConverter.CreateLongIntBitFix(El: TPasElement; + Value: TJSElement): TJSElement; +var + OrEx: TJSBitwiseOrExpression; + Int: TMaxPrecInt; +begin + if IsLiteralIntegerExpr(Value,Int) and (Integer(Int) = Int) then + Result := Value + else + begin + // value to longint -> value | 0 + OrEx := TJSBitwiseOrExpression(CreateElement(TJSBitwiseOrExpression,El)); + OrEx.A := Value; + OrEx.B := CreateLiteralNumber(El,0); + Result := OrEx; + end; +end; + +function TPasToJSConverter.CreateIntegerBitFix(El: TPasElement; + Value: TJSElement; ToType : TResolverBaseType): TJSElement; +begin + {$IFDEF VerbosePas2JS} + writeln('TPasToJSConverter.CreateIntegerBitFix ToType=', ResBaseTypeNames[ToType]); + {$ENDIF} + Result := Value; + case ToType of + btByte: + Result := CreateByteBitFix(El, Result); + btShortInt: + Result := CreateShortIntBitFix(El, Result); + btWord: + Result := CreateWordBitFix(El, Result); + btSmallInt: + Result := CreateSmallIntBitFix(El, Result); + btLongWord: + Result := CreateLongwordBitFix(El, Result); + btLongint: + Result := CreateLongIntBitFix(El, Result); + end; +end; + +function TPasToJSConverter.CreateIntegerBitFixAuto(El: TPasElement; AContext: TConvertContext; + Value: TJSElement): TJSElement; + + function UseLeftTypeForAssignment(LeftResolvedType, RightResolvedType : TResolverBaseType) : boolean; + begin + Result := false; + if not (LeftResolvedType in btAllJSInteger) or not (RightResolvedType in btAllJSInteger) then + exit; + if LeftResolvedType = RightResolvedType then + exit; + + case LeftResolvedType of + btByte, btShortInt: + Result := true; + btWord: + Result := RightResolvedType <> btByte; + btSmallInt: + Result := not (RightResolvedType in [btByte,btShortInt]); + btLongWord: + Result := not (RightResolvedType in [btByte,btWord]); + btLongInt: + Result := not (RightResolvedType in [btByte,btShortInt,btWord,btSmallInt]); + btUIntDouble: + Result := not (RightResolvedType in [btByte,btWord,btLongWord]); + end; + end; + + function LeftIsTypedArrayOfType(aResolver: TPas2JSResolver; LeftResolved: TPasResolverResult; + ToType: TResolverBaseType) : Boolean; + var + PropertyEl : TPasProperty; + begin + Result := false; + if (aResolver <> nil) and (LeftResolved.IdentEl is TPasProperty) then + begin + PropertyEl := TPasProperty(LeftResolved.IdentEl); + if aResolver.IsExternalBracketAccessor(aResolver.GetPasPropertySetter(PropertyEl)) then + begin + if PropertyEl.Parent is TPasClassType then + begin + if (ToType = btByte) and + aResolver.IsExternalClass_Name(TPasClassType(PropertyEl.Parent),'Uint8Array') then + Result := true + else if (ToType = btShortInt) and + aResolver.IsExternalClass_Name(TPasClassType(PropertyEl.Parent),'Int8Array') then + Result := true + else if (ToType = btWord) and + aResolver.IsExternalClass_Name(TPasClassType(PropertyEl.Parent),'Uint16Array') then + Result := true + else if (ToType = btSmallInt) and + aResolver.IsExternalClass_Name(TPasClassType(PropertyEl.Parent),'Int16Array') then + Result := true + else if (ToType = btLongWord) and + aResolver.IsExternalClass_Name(TPasClassType(PropertyEl.Parent),'Uint32Array') then + Result := true + else if (ToType = btLongInt) and + aResolver.IsExternalClass_Name(TPasClassType(PropertyEl.Parent),'Int32Array') then + Result := true; + end; + end; + end; + end; + +var + ResolvedEl, LeftResolved, RightResolved: TPasResolverResult; + aResolver: TPas2JSResolver; + UnaryEl : TUnaryExpr; + BinaryEl : TBinaryExpr; + AssignEl : TPasImplAssign; + ParamsEl : TParamsExpr; + ToType, LeftResolvedType, RightResolvedType : TResolverBaseType; + AssignContext : TAssignContext; + NeedBitFix, ParentWillFixOverflow, ParentAllowSignificantOverflow, IsArrayIndexExpr : Boolean; +begin + if AContext=nil then ; + aResolver:=AContext.Resolver; + Result := Value; + + {$IFDEF VerbosePas2JS} + writeln('TPasToJSConverter.CreateIntegerBitFixAuto Value=',Value.ClassName, ', Context=', AContext.ClassName); + if El.Parent <> nil then + writeln(' El.Parent=', El.Parent.ClassName); + {$ENDIF} + ToType := btNone; + + if not (coTruncateIntegersOnOverflow in Options) then + begin + // for backward compatibility applying fix only for LongWord type and bitwise operations + if El is TUnaryExpr then + begin + UnaryEl := TUnaryExpr(El); + if UnaryEl.OpCode = eopNot then + begin + if aResolver <> nil then + begin + aResolver.ComputeElement(UnaryEl.Operand,ResolvedEl,[]); + ToType := ResolvedEl.BaseType; + end; + + if ToType = btLongWord then + Result := CreateLongwordBitFix(El, Result); + end; + end + else + if El is TBinaryExpr then + begin + BinaryEl := TBinaryExpr(El); + if BinaryEl.OpCode in [eopAnd, eopOr, eopXor, eopShl] then + begin + if aResolver <> nil then + begin + aResolver.ComputeElement(BinaryEl.Left,LeftResolved,[]); + aResolver.ComputeElement(BinaryEl.Right,RightResolved,[]); + aResolver.ComputeBinaryExprRes(BinaryEl,ResolvedEl,[],LeftResolved,RightResolved); + ToType := ResolvedEl.BaseType; + end; + + if ToType = btLongWord then + Result := CreateLongwordBitFix(El, Result); + end; + end; + + exit; + end; + + NeedBitFix := false; + ParentWillFixOverflow := false; + ParentAllowSignificantOverflow := false; + IsArrayIndexExpr := false; + + // checking where current expression is used to decide whether we need to fix integer value now or we can leave it for the parent expression + if (El.Parent <> nil) { todo: disable this if optimization is disabled } then + begin + if El.Parent is TUnaryExpr then + begin + UnaryEl := TUnaryExpr(El.Parent); + if UnaryEl.OpCode = eopSubtract then + ParentWillFixOverflow := true + else if UnaryEl.OpCode = eopNot then + begin + if aResolver <> nil then + begin + aResolver.ComputeElement(UnaryEl.Operand,ResolvedEl,[]); + ToType := ResolvedEl.BaseType; + end; + + // for Byte, Word, ShortInt, SmallInt there is no need to fix bits but also it won't fix the overflow + if ToType in [btLongInt, btLongWord] then + begin + ParentWillFixOverflow := true; + ParentAllowSignificantOverflow := true; + end; + end; + end + else if El.Parent is TBinaryExpr then + begin + BinaryEl := TBinaryExpr(El.Parent); + if (aResolver <> nil) and (BinaryEl.OpCode in [eopAdd, eopSubtract, eopAnd, eopOr, eopXor, eopShr, eopShl]) then + begin + aResolver.ComputeElement(BinaryEl.Left,LeftResolved,[]); + LeftResolvedType := LeftResolved.BaseType; + + aResolver.ComputeElement(BinaryEl.Right,RightResolved,[]); + RightResolvedType := RightResolved.BaseType; + + aResolver.ComputeBinaryExprRes(BinaryEl,ResolvedEl,[],LeftResolved,RightResolved); + + if BinaryEl.OpCode in [eopShl, eopShr] then + begin + ParentWillFixOverflow := (BinaryEl.Left = El) and (ResolvedEl.BaseType in [btLongInt,btLongWord]); + ParentAllowSignificantOverflow := ParentWillFixOverflow; + end + else if BinaryEl.OpCode in [eopAnd, eopOr, eopXor] then + begin + ParentWillFixOverflow := ResolvedEl.BaseType in [btLongInt,btLongWord]; + ParentAllowSignificantOverflow := ParentWillFixOverflow; + end + else if BinaryEl.OpCode in [eopAdd, eopSubtract] then + ParentWillFixOverflow := true; + + if BinaryEl.Left = El then + ToType := LeftResolvedType + else + ToType := RightResolvedType; + end; + end + else if El.Parent is TPasImplAssign then + begin + AssignEl := TPasImplAssign(El.Parent); + // getting left type of the assignment expression, implicit casting + if AssignEl.Right = El then + begin + aResolver.ComputeElement(AssignEl.Left,LeftResolved,[]); + LeftResolvedType := LeftResolved.BaseType; + + aResolver.ComputeElement(AssignEl.Right,RightResolved,[]); + RightResolvedType := RightResolved.BaseType; + + // select smallest type by size + if UseLeftTypeForAssignment(LeftResolvedType, RightResolvedType) or + // in case if types equal and left is TypedArray, then we can omit typecasting + ((LeftResolvedType = RightResolvedType) and LeftIsTypedArrayOfType(aResolver, LeftResolved, LeftResolvedType)) then + begin + ParentWillFixOverflow := true; + ParentAllowSignificantOverflow := true; + ToType := LeftResolvedType; + end + else + ToType := RightResolvedType; + end; + end + else if El.Parent is TParamsExpr then + begin + ParamsEl := TParamsExpr(El.Parent); + if ParamsEl.Kind = pekArrayParams then + IsArrayIndexExpr := (ParamsEl.Value <> El); + end; + end; + + {$IFDEF VerbosePas2JS} + writeln('TPasToJSConverter.CreateIntegerBitFixAuto ToType=',aResolver.BaseTypeNames[ToType]); + {$ENDIF} + + if El is TUnaryExpr then + begin + UnaryEl := TUnaryExpr(El); + if UnaryEl.OpCode in [eopSubtract, eopNot] then + begin + if (ToType = btNone) and (aResolver <> nil) then + begin + aResolver.ComputeElement(UnaryEl.Operand,ResolvedEl,[]); + ToType := ResolvedEl.BaseType; + end; + + if ToType in [btByte,btShortInt,btWord,btSmallInt,btLongWord,btLongInt] then + begin + if UnaryEl.OpCode = eopSubtract then + begin + if ParentWillFixOverflow then + exit; + + // if the expression is used as the array index, then for LongInt and LongWord types we can ignore the possibility of integer overflow + if IsArrayIndexExpr and (ToType in [btLongInt,btLongWord]) then + exit; + + // no need to fix value for "subtract" operation and constant + if (UnaryEl.Operand is TPrimitiveExpr) and (TPrimitiveExpr(UnaryEl.Operand).Kind = pekNumber) then + exit; + + NeedBitFix := true; + end + else // UnaryEl.OpCode = eopNot + begin + // fixing value for "not" operation only for LongWord. Also overflow automatically will be fixed for LongInt. + if (UnaryEl.OpCode = eopNot) and (ToType = btLongWord) then + NeedBitFix := true; + end; end; end; end @@ -11065,6 +11627,66 @@ begin ToType := ResolvedEl.BaseType; end; + if ToType in [btByte,btShortInt,btWord,btSmallInt,btLongWord,btLongInt] then + begin + // if the expression is used as the array index, then for LongInt and LongWord types we can ignore the possibility of integer overflow + if IsArrayIndexExpr and (ToType in [btLongInt,btLongWord]) then + exit; + + if BinaryEl.OpCode in [eopMultiply, eopPower (*, eopDiv, eopMod*)] then + begin + if ParentWillFixOverflow and ParentAllowSignificantOverflow then + exit; + + NeedBitFix := true; + end + else + if BinaryEl.OpCode in [eopAdd, eopSubtract, eopAnd, eopOr, eopXor, eopShr, eopShl] then + begin + if ParentWillFixOverflow then + exit; + + if (BinaryEl.OpCode in [eopAdd, eopSubtract]) then + NeedBitFix := true + // no need to fix value for bitwise operation for everything except LongWord + else if (BinaryEl.OpCode in [eopAnd, eopOr, eopXor]) and (ToType = btLongWord) then + NeedBitFix := true + // "shl" operation expanded to 32-bit + else if (BinaryEl.OpCode = eopShl) and (ToType = btLongWord) then + NeedBitFix := true; + // no need to fix value for "shr" operation + end; + end; + end + else + if El is TPasImplAssign then + begin + AssignEl := TPasImplAssign(El); + if AContext is TAssignContext then + begin + AssignContext := TAssignContext(AContext); + LeftResolved := AssignContext.LeftResolved; + LeftResolvedType := LeftResolved.BaseType; + + RightResolved := AssignContext.RightResolved; + RightResolvedType := RightResolved.BaseType; + + if UseLeftTypeForAssignment(LeftResolvedType, RightResolvedType) then + begin + NeedBitFix := true; + ToType := LeftResolvedType; + // if we are assigning value to the TypedArray, then we can omit typecasting + if LeftIsTypedArrayOfType(aResolver, LeftResolved, ToType) then + NeedBitFix := false; + + if NeedBitFix and (Result is TJSSimpleAssignStatement) then + TJSSimpleAssignStatement(Result).Expr := CreateIntegerBitFix(El, TJSSimpleAssignStatement(Result).Expr, ToType); + + exit; + end; + end; + end; + if NeedBitFix then Result := CreateIntegerBitFix(El, Result, ToType); end;