diff --git a/src/Pact/Gas/Table.hs b/src/Pact/Gas/Table.hs index 9a3591557..3f183c6b6 100644 --- a/src/Pact/Gas/Table.hs +++ b/src/Pact/Gas/Table.hs @@ -248,8 +248,8 @@ tableGasModel gasConfig = GUserApp t -> case t of Defpact -> gasToMilliGas $ _gasCostConfig_defPactCost gasConfig * _gasCostConfig_functionApplicationCost gasConfig _ -> gasToMilliGas $ _gasCostConfig_functionApplicationCost gasConfig - GIntegerOpCost i j -> - gasToMilliGas $ intCost (fst i) + intCost (fst j) + GIntegerOpCost i j ts -> + gasToMilliGas $ intCost ts (fst i) + intCost ts (fst j) GDecimalOpCost _ _ -> mempty GMakeList v -> gasToMilliGas $ expLengthPenalty v GSort len -> gasToMilliGas $ expLengthPenalty len @@ -310,9 +310,9 @@ tableGasModel gasConfig = GInterfaceDecl _interfaceName _iCode -> gasToMilliGas (_gasCostConfig_interfaceCost gasConfig) GModuleMemory i -> gasToMilliGas $ moduleMemoryCost i GPrincipal g -> gasToMilliGas $ fromIntegral g * _gasCostConfig_principalCost gasConfig - GMakeList2 len msz -> + GMakeList2 len msz ts -> let glen = fromIntegral len - in gasToMilliGas $ glen + maybe 0 ((* glen) . intCost) msz + in gasToMilliGas $ glen + maybe 0 ((* glen) . intCost ts) msz GZKArgs arg -> gasToMilliGas $ case arg of PointAdd g -> pointAddGas g ScalarMult g -> scalarMulGas g @@ -374,16 +374,16 @@ defaultGasModel = tableGasModel defaultGasConfig #if !defined(ghcjs_HOST_OS) -- | Costing function for binary integer ops -intCost :: Integer -> Gas -intCost !a - | (abs a) < threshold = 0 +intCost :: IntOpThreshold -> Integer -> Gas +intCost ts !a + | (abs a) < threshold ts = 0 | otherwise = let !nbytes = (I# (IntLog.integerLog2# (abs a)) + 1) `quot` 8 in fromIntegral (nbytes * nbytes `quot` 100) where - threshold :: Integer - threshold = (10 :: Integer) ^ (30 :: Integer) - + threshold :: IntOpThreshold -> Integer + threshold Pact43IntThreshold = (10 :: Integer) ^ (30 :: Integer) + threshold Pact48IntThreshold = (10 :: Integer) ^ (80 :: Integer) _intCost :: Integer -> Int _intCost !a = diff --git a/src/Pact/Native.hs b/src/Pact/Native.hs index 14afa8e9c..3ebe770c5 100644 --- a/src/Pact/Native.hs +++ b/src/Pact/Native.hs @@ -912,7 +912,8 @@ list i as = return $ TList (V.fromList as) TyAny (_faInfo i) -- TODO, could set makeList :: GasRNativeFun e makeList i [TLitInteger len,value] = case typeof value of Right ty -> do - ga <- ifExecutionFlagSet' FlagDisablePact45 (GMakeList len) (GMakeList2 len Nothing) + ts <- ifExecutionFlagSet' FlagDisablePact48 Pact43IntThreshold Pact48IntThreshold + ga <- ifExecutionFlagSet' FlagDisablePact45 (GMakeList len) (GMakeList2 len Nothing ts) computeGas' i ga $ return $ toTListV ty def $ V.replicate (fromIntegral len) value Left ty -> evalError' i $ "make-list: invalid value type: " <> pretty ty @@ -936,7 +937,8 @@ enumerate i = \case -- ^ The generated vector -> Eval e (Term Name) computeList len sz v = do - ga <- ifExecutionFlagSet' FlagDisablePact45 (GMakeList len) (GMakeList2 len (Just sz)) + ts <- ifExecutionFlagSet' FlagDisablePact48 Pact43IntThreshold Pact48IntThreshold + ga <- ifExecutionFlagSet' FlagDisablePact45 (GMakeList len) (GMakeList2 len (Just sz) ts) computeGas' i ga $ pure $ toTListV tTyInteger def $ fmap toTerm v step to' inc acc @@ -1315,7 +1317,8 @@ stringToCharList t = V.fromList $ tLit . LString . T.singleton <$> T.unpack t strToList :: GasRNativeFun e strToList i [TLitString s] = do let len = fromIntegral $ T.length s - ga <- ifExecutionFlagSet' FlagDisablePact45 (GMakeList len) (GMakeList2 len Nothing) + ts <- ifExecutionFlagSet' FlagDisablePact48 Pact43IntThreshold Pact48IntThreshold + ga <- ifExecutionFlagSet' FlagDisablePact45 (GMakeList len) (GMakeList2 len Nothing ts) computeGas' i ga $ return $ toTListV tTyString def $ stringToCharList s strToList i as = argsError i as diff --git a/src/Pact/Native/Ops.hs b/src/Pact/Native/Ops.hs index c114e9a55..06fac4ed9 100644 --- a/src/Pact/Native/Ops.hs +++ b/src/Pact/Native/Ops.hs @@ -162,15 +162,18 @@ powImpl i as@[TLiteral a _,TLiteral b _] = do powImpl i as = argsError i as twoArgIntOpGas :: Integer -> Integer -> Eval e () -twoArgIntOpGas loperand roperand = - computeGasCommit def "" (GIntegerOpCost (loperand, Nothing) (roperand, Nothing)) +twoArgIntOpGas loperand roperand = do + ts <- ifExecutionFlagSet' FlagDisablePact48 Pact43IntThreshold Pact48IntThreshold + computeGasCommit def "" (GIntegerOpCost (loperand, Nothing) (roperand, Nothing) ts) twoArgDecOpGas :: Decimal -> Decimal -> Eval e () -twoArgDecOpGas loperand roperand = +twoArgDecOpGas loperand roperand = do + ts <- ifExecutionFlagSet' FlagDisablePact48 Pact43IntThreshold Pact48IntThreshold computeGasCommit def "" - (GIntegerOpCost - (decimalMantissa loperand, Just (fromIntegral (decimalPlaces loperand))) - (decimalMantissa roperand, Just (fromIntegral (decimalPlaces roperand)))) + (GIntegerOpCost + (decimalMantissa loperand, Just (fromIntegral (decimalPlaces loperand))) + (decimalMantissa roperand, Just (fromIntegral (decimalPlaces roperand))) + ts) legalLogArg :: Literal -> Bool legalLogArg = \case diff --git a/src/Pact/Types/Gas.hs b/src/Pact/Types/Gas.hs index 46b46bd26..b2c9c2c93 100644 --- a/src/Pact/Types/Gas.hs +++ b/src/Pact/Types/Gas.hs @@ -28,6 +28,7 @@ module Pact.Types.Gas , MilliGasLimit(..) , ZKGroup(..) , ZKArg(..) + , IntOpThreshold(..) , gasLimitToMilliGasLimit -- * optics , geGasLimit @@ -166,11 +167,11 @@ data GasArgs -- ^ The cost of the in-memory representation of the module | GPrincipal !Int -- ^ the cost of principal creation and validation - | GIntegerOpCost !(Integer, Maybe Integer) !(Integer, Maybe Integer) + | GIntegerOpCost !(Integer, Maybe Integer) !(Integer, Maybe Integer) IntOpThreshold -- ^ Integer costs | GDecimalOpCost !Decimal !Decimal -- ^ Decimal costs - | GMakeList2 !Integer !(Maybe Integer) + | GMakeList2 !Integer !(Maybe Integer) IntOpThreshold -- ^ List versioning 2 | GZKArgs !ZKArg | GReverse !Int @@ -178,6 +179,17 @@ data GasArgs | GFormatValues !Text !(V.Vector PactValue) -- ^ Cost of formatting with the given format string and args +data IntOpThreshold + = Pact43IntThreshold + | Pact48IntThreshold + deriving (Eq, Show, Enum, Bounded) + +instance Pretty IntOpThreshold where + pretty = \case + Pact43IntThreshold -> "Pact43IntThreshold" + Pact48IntThreshold -> "Pact48IntThreshold" + + -- | The elliptic curve pairing group we are -- handling data ZKGroup @@ -227,9 +239,9 @@ instance Pretty GasArgs where GFoldDB -> "GFoldDB" GModuleMemory i -> "GModuleMemory: " <> pretty i GPrincipal i -> "GPrincipal: " <> pretty i - GIntegerOpCost i j -> "GIntegerOpCost:" <> pretty i <> colon <> pretty j + GIntegerOpCost i j ts -> "GIntegerOpCost:" <> pretty i <> colon <> pretty j <> colon <> pretty ts GDecimalOpCost i j -> "GDecimalOpCost:" <> pretty (show i) <> colon <> pretty (show j) - GMakeList2 i k -> "GMakeList2:" <> pretty i <> colon <> pretty k + GMakeList2 i k ts -> "GMakeList2:" <> pretty i <> colon <> pretty k <> colon <> pretty ts GZKArgs arg -> "GZKArgs:" <> pretty arg GReverse len -> "GReverse:" <> pretty len GFormatValues s args -> "GFormatValues:" <> pretty s <> pretty (V.toList args) diff --git a/tests/pact/gas.repl b/tests/pact/gas.repl index ae20ec1da..1f1d0c933 100644 --- a/tests/pact/gas.repl +++ b/tests/pact/gas.repl @@ -848,3 +848,31 @@ d.G3 (expect "gas of formatting a sample list" 10014 (env-gas)) (commit-tx) + +; tests for pre/post integer ops +(begin-tx) +(module m G (defcap G () true) + (defconst i79:integer (+ (^ 10 79) 1)) + (defconst i80:integer (+ (^ 10 80) 1)) +) +(env-exec-config ["DisablePact48"]) +(env-gas 0) +(+ i79 i79) +(expect "gas of + pre-fork 10^79" (env-gas) 21) + +(env-gas 0) +(+ i80 i80) +(expect "gas of + pre-fork 10^80" (env-gas) 21) + +; post-fork +(env-gas 0) +(env-exec-config []) +(env-gas 0) +(+ i79 i79) +(expect "gas of + post-fork 10^79" (env-gas) 1) + +(env-gas 0) +(+ i80 i80) +(expect "gas of + post-fork 10^80" (env-gas) 21) + +(commit-tx)