auditor

commit 3b2328ecee2adeb3cfae24b20681b718632f6da1
parent f0145af0dd904c52a4505ca83616f970c06cf91f
Author: Jared Tobin <jared@jtobin.io>
Date:   Fri, 13 Feb 2026 08:00:03 +0400

feat: detect GHC RTS calls via adrp symbol lookup

Add detection for blr instructions that call GHC runtime system
functions. Looks back 20 instructions for adrp loading a _stg_*
symbol (e.g., _stg_bh_upd_frame_info, _stg_upd_frame_info).

Curve.s: 33 -> 31 findings
secp256k1.s: tested with 419 findings

Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>

Diffstat:
M
lib/Audit/AArch64/NCT.hs
 | 
31
+++++++++++++++++++++++++++----

1 file changed, 27 insertions(+), 4 deletions(-)
diff --git a/lib/Audit/AArch64/NCT.hs b/lib/Audit/AArch64/NCT.hs
@@ -32,7 +32,7 @@ import Data.IntMap.Strict (IntMap)
 import qualified Data.IntMap.Strict as IntMap
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
-import Data.Text (Text, isSuffixOf)
+import Data.Text (Text, isInfixOf, isSuffixOf)
 import GHC.Generics (Generic)
 
 -- | Reason for flagging an instruction as non-constant-time.
@@ -171,10 +171,13 @@ buildLineMap lns = IntMap.fromList [(lineNum l, l) | l <- lns]
 --
 -- * Typeclass dictionary calls: @ldr <reg>, [<base>, #offset]@ followed
 --   by @blr <reg>@ (calling through dictionary)
+--
+-- * RTS calls: @adrp <reg>, _stg_*@ (GHC runtime system symbols)
+--   followed eventually by @blr <reg>@
 isGhcRuntimeFinding :: LineMap -> NctFinding -> Bool
 isGhcRuntimeFinding lineMap f = case nctReason f of
   CondBranch     -> isHeapCheck || isNurseryCheck || isTagCheck || isCafCheck
-  IndirectBranch -> isClosureEntry || isDictCall
+  IndirectBranch -> isClosureEntry || isDictCall || isRtsCall
   _              -> False
   where
     -- Check if conditional branch is a heap check (prev: cmp <r>, x28)
@@ -243,6 +246,19 @@ isGhcRuntimeFinding lineMap f = case nctReason f of
       Ldr r (BaseImm _ off) -> r == reg && off > 0
       _ -> False
 
+    -- Check if blr is calling a GHC RTS function
+    -- Look for adrp <reg>, _stg_* pattern in recent instructions
+    isRtsCall :: Bool
+    isRtsCall = case nctInstr f of
+      Blr reg -> any (isRtsSymbolLoad reg) recentInstrs20
+      _ -> False
+
+    isRtsSymbolLoad :: Reg -> Instr -> Bool
+    isRtsSymbolLoad reg instr = case instr of
+      -- adrp to _stg_* symbol (GHC RTS)
+      Adrp r label -> r == reg && "_stg_" `isInfixOf` label
+      _ -> False
+
     -- Get instruction from preceding line
     prevInstr :: Maybe Instr
     prevInstr = do
@@ -251,9 +267,16 @@ isGhcRuntimeFinding lineMap f = case nctReason f of
 
     -- Get up to 5 recent instructions before finding
     recentInstrs5 :: [Instr]
-    recentInstrs5 =
+    recentInstrs5 = recentInstrs 5
+
+    -- Get up to 20 recent instructions before finding (for RTS calls)
+    recentInstrs20 :: [Instr]
+    recentInstrs20 = recentInstrs 20
+
+    recentInstrs :: Int -> [Instr]
+    recentInstrs n =
       [ instr
-      | offset <- [1..5]
+      | offset <- [1..n]
       , Just ln <- [IntMap.lookup (nctLine f - offset) lineMap]
       , Just instr <- [lineInstr ln]
       ]