auditor

commit f0145af0dd904c52a4505ca83616f970c06cf91f
parent b38f3199721e08f9af7efc144f15888224a6b3a1
Author: Jared Tobin <jared@jtobin.io>
Date:   Fri, 13 Feb 2026 07:56:02 +0400

feat: expand GHC runtime pattern detection

Add recognition for additional GHC runtime patterns:
- Nursery checks (cmp against BaseReg offset loads)
- CAF result checks (cbz x0 after bl _newCAF)
- Dictionary/vtable calls (blr after ldr from object field)
- Extend closure entry lookback from 3 to 5 instructions

Reduces false positives from 56 to 33 on test file.

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

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

1 file changed, 66 insertions(+), 17 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)
+import Data.Text (Text, isSuffixOf)
 import GHC.Generics (Generic)
 
 -- | Reason for flagging an instruction as non-constant-time.
@@ -158,15 +158,23 @@ buildLineMap lns = IntMap.fromList [(lineNum l, l) | l <- lns]
 -- * Heap checks: @cmp <reg>, x28@ followed by conditional branch
 --   (x28 is GHC's heap limit register)
 --
+-- * Nursery checks: @cmp <reg>, [x19, #offset]@ followed by conditional
+--   branch (x19 is BaseReg, offset 856 is typical nursery limit)
+--
 -- * Tag checks: @tst <reg>, #0x7@ followed by conditional branch
 --   (pointer tagging for evaluation state)
 --
--- * Closure entry: @ldr x8, [<reg>]@ followed by @blr x8@
+-- * CAF checks: @cbz x0@ after @bl _newCAF@ (checking CAF init result)
+--
+-- * Closure entry: @ldr/ldur <reg>, [...]@ followed by @blr <reg>@
 --   (entering closure via info pointer)
+--
+-- * Typeclass dictionary calls: @ldr <reg>, [<base>, #offset]@ followed
+--   by @blr <reg>@ (calling through dictionary)
 isGhcRuntimeFinding :: LineMap -> NctFinding -> Bool
 isGhcRuntimeFinding lineMap f = case nctReason f of
-  CondBranch     -> isHeapCheck || isTagCheck
-  IndirectBranch -> isClosureEntry
+  CondBranch     -> isHeapCheck || isNurseryCheck || isTagCheck || isCafCheck
+  IndirectBranch -> isClosureEntry || isDictCall
   _              -> False
   where
     -- Check if conditional branch is a heap check (prev: cmp <r>, x28)
@@ -175,24 +183,65 @@ isGhcRuntimeFinding lineMap f = case nctReason f of
       Just (Cmp _ (OpReg X28)) -> True
       _                        -> False
 
+    -- Check if conditional branch is a nursery check
+    -- (prev: cmp <r>, <r'> where one was loaded from BaseReg x19)
+    isNurseryCheck :: Bool
+    isNurseryCheck = case prevInstr of
+      Just (Cmp _ (OpReg _)) ->
+        -- Look for recent ldr from [x19, #offset] (BaseReg)
+        any isBaseRegLoad recentInstrs5
+      _ -> False
+
+    isBaseRegLoad :: Instr -> Bool
+    isBaseRegLoad instr = case instr of
+      Ldr _ (BaseImm X19 _) -> True
+      Ldur _ (BaseImm X19 _) -> True
+      _ -> False
+
     -- Check if conditional branch is a tag check (prev: tst <r>, #7)
     isTagCheck :: Bool
     isTagCheck = case prevInstr of
       Just (Tst _ (OpImm 7)) -> True
       _                      -> False
 
-    -- Check if blr x8 is closure entry (recent: ldr/ldur x8, [...])
-    -- Look back up to 3 instructions to account for intervening loads
+    -- Check if cbz x0 is a CAF check (recent: bl _newCAF or similar)
+    isCafCheck :: Bool
+    isCafCheck = case nctInstr f of
+      Cbz X0 _ -> any isCafCall recentInstrs5
+      Cbnz X0 _ -> any isCafCall recentInstrs5
+      _ -> False
+
+    isCafCall :: Instr -> Bool
+    isCafCall instr = case instr of
+      Bl label -> "_newCAF" `isSuffixOf` label
+      _ -> False
+
+    -- Check if blr is closure entry (recent: ldr/ldur to same reg)
+    -- Look back up to 5 instructions to account for intervening loads
     isClosureEntry :: Bool
     isClosureEntry = case nctInstr f of
-      Blr X8 -> any isX8Load recentInstrs
-      _      -> False
+      Blr reg -> any (isRegLoad reg) recentInstrs5
+      _ -> False
+
+    -- Check if blr is a dictionary/vtable call
+    -- (ldr from [base, #offset] pattern - calling through object field)
+    isDictCall :: Bool
+    isDictCall = case nctInstr f of
+      Blr reg -> any (isDictLoad reg) recentInstrs5
+      _ -> False
+
+    isRegLoad :: Reg -> Instr -> Bool
+    isRegLoad reg instr = case instr of
+      Ldr r (BaseImm _ _)  -> r == reg
+      Ldur r (BaseImm _ _) -> r == reg
+      Ldp r1 r2 (BaseImm _ _) -> r1 == reg || r2 == reg
+      _ -> False
 
-    isX8Load :: Instr -> Bool
-    isX8Load instr = case instr of
-      Ldr X8 _  -> True
-      Ldur X8 _ -> True
-      _         -> False
+    isDictLoad :: Reg -> Instr -> Bool
+    isDictLoad reg instr = case instr of
+      -- ldr reg, [base, #offset] where offset > 0 (field access)
+      Ldr r (BaseImm _ off) -> r == reg && off > 0
+      _ -> False
 
     -- Get instruction from preceding line
     prevInstr :: Maybe Instr
@@ -200,11 +249,11 @@ isGhcRuntimeFinding lineMap f = case nctReason f of
       prevLine <- IntMap.lookup (nctLine f - 1) lineMap
       lineInstr prevLine
 
-    -- Get up to 3 recent instructions before finding
-    recentInstrs :: [Instr]
-    recentInstrs =
+    -- Get up to 5 recent instructions before finding
+    recentInstrs5 :: [Instr]
+    recentInstrs5 =
       [ instr
-      | offset <- [1..3]
+      | offset <- [1..5]
       , Just ln <- [IntMap.lookup (nctLine f - offset) lineMap]
       , Just instr <- [lineInstr ln]
       ]