auditor

commit 81df281f56455c489640898c6820a5674d93c81b
parent 89b9a2ab26920214173ff08dea9dfa039c30ba79
Author: Jared Tobin <jared@jtobin.io>
Date:   Fri, 13 Feb 2026 08:41:23 +0400

feat: add NCG backend support for GHC runtime detection

- Handle br (not just blr) for closure entry, dict calls, RTS calls
- Detect STG stack returns: ldr xN, [x20, ...]; br xN
- Detect BaseReg dispatch: ldr xN, [x19, ...]; br xN
- Add NCG-style tag check: and xN, xM, #7; cbnz xN
- Add NCG-style CAF check: mov xN, x0; cbz xN after bl _newCAF

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

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

1 file changed, 47 insertions(+), 8 deletions(-)
diff --git a/lib/Audit/AArch64/NCT.hs b/lib/Audit/AArch64/NCT.hs
@@ -203,19 +203,29 @@ isGhcRuntimeFinding lineMap f = case nctReason f of
       _ -> False
 
     -- Check if conditional branch is a tag check
-    -- Pattern 1: tst <r>, #7 followed by branch
-    -- Pattern 2: and <r>, <r2>, #7; cmp <r>, #N followed by branch
+    -- Pattern 1: tst <r>, #7 followed by branch (LLVM)
+    -- Pattern 2: and <r>, <r2>, #7; cmp <r>, #N followed by branch (LLVM)
+    -- Pattern 3: and <r>, <r2>, #7; cbnz/cbz <r> (NCG)
     isTagCheck :: Bool
     isTagCheck = case prevInstr of
       Just (Tst _ (OpImm 7)) -> True
       Just (Cmp _ (OpImm _)) -> any isTagMask recentInstrs5
-      _                      -> False
+      _ -> case nctInstr f of
+        -- NCG: cbnz/cbz on register set by and #7
+        Cbnz reg _ -> any (isTagMaskFor reg) recentInstrs5
+        Cbz reg _  -> any (isTagMaskFor reg) recentInstrs5
+        _          -> False
 
     isTagMask :: Instr -> Bool
     isTagMask instr = case instr of
       And _ _ (OpImm 7) -> True
       _                 -> False
 
+    isTagMaskFor :: Reg -> Instr -> Bool
+    isTagMaskFor reg instr = case instr of
+      And r _ (OpImm 7) -> r == reg
+      _                 -> False
+
     -- Check if conditional branch is an arity/closure-type check
     -- Pattern: ldur <r>, [<r2>, #-N] (info table access); cmp <r>, #M
     -- Info tables are at negative offsets from info pointer
@@ -230,11 +240,17 @@ isGhcRuntimeFinding lineMap f = case nctReason f of
       Ldur _ (BaseImm _ off) -> off < 0
       _                      -> False
 
-    -- Check if cbz x0 is a CAF check (recent: bl _newCAF or similar)
+    -- Check if cbz/cbnz is a CAF check (recent: bl _newCAF or similar)
+    -- LLVM: cbz x0 after bl _newCAF
+    -- NCG: mov xN, x0; cbz xN after bl _newCAF
     isCafCheck :: Bool
     isCafCheck = case nctInstr f of
-      Cbz X0 _ -> any isCafCall recentInstrs5
+      Cbz X0 _  -> any isCafCall recentInstrs5
       Cbnz X0 _ -> any isCafCall recentInstrs5
+      Cbz reg _ -> any isCafCall recentInstrs5
+                   && any (isCafResultMove reg) recentInstrs5
+      Cbnz reg _ -> any isCafCall recentInstrs5
+                    && any (isCafResultMove reg) recentInstrs5
       _ -> False
 
     isCafCall :: Instr -> Bool
@@ -242,17 +258,26 @@ isGhcRuntimeFinding lineMap f = case nctReason f of
       Bl label -> "_newCAF" `isSuffixOf` label
       _ -> False
 
-    -- Check if blr is closure entry (ldr/ldur to same reg in BB)
+    -- NCG moves x0 to another register before testing
+    isCafResultMove :: Reg -> Instr -> Bool
+    isCafResultMove reg instr = case instr of
+      Mov r (OpReg X0) -> r == reg
+      _ -> False
+
+    -- Check if blr/br is closure entry (ldr/ldur to same reg in BB)
+    -- LLVM uses blr, NCG uses br
     isClosureEntry :: Bool
     isClosureEntry = case nctInstr f of
       Blr reg -> any (isRegLoad reg) bbInstrs
+      Br reg  -> any (isRegLoad reg) bbInstrs
       _ -> False
 
-    -- Check if blr is a dictionary/vtable call
+    -- Check if blr/br 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) bbInstrs
+      Br reg  -> any (isDictLoad reg) bbInstrs
       _ -> False
 
     isRegLoad :: Reg -> Instr -> Bool
@@ -272,11 +297,15 @@ isGhcRuntimeFinding lineMap f = case nctReason f of
       Ldr r (PostIndex _ off) -> r == reg && off > 0
       _ -> False
 
-    -- Check if blr is calling a GHC RTS function
+    -- Check if blr/br is calling a GHC RTS function
     -- Scan backwards within basic block for adrp <reg>, _stg_* pattern
+    -- Also check for return continuation via STG stack (x20) or BaseReg (x19)
     isRtsCall :: Bool
     isRtsCall = case nctInstr f of
       Blr reg -> any (isRtsSymbolLoad reg) bbInstrs
+                 || any (isStgStackLoad reg) bbInstrs
+      Br reg  -> any (isRtsSymbolLoad reg) bbInstrs
+                 || any (isStgStackLoad reg) bbInstrs
       _ -> False
 
     isRtsSymbolLoad :: Reg -> Instr -> Bool
@@ -285,6 +314,16 @@ isGhcRuntimeFinding lineMap f = case nctReason f of
       Adrp r label -> r == reg && "_stg_" `isInfixOf` label
       _ -> False
 
+    -- Check if register was loaded from STG stack (x20) or BaseReg (x19)
+    -- These are return continuations / RTS dispatch
+    isStgStackLoad :: Reg -> Instr -> Bool
+    isStgStackLoad reg instr = case instr of
+      Ldr r (BaseImm X20 _)   -> r == reg  -- STG stack return
+      Ldr r (BaseImm X19 _)   -> r == reg  -- BaseReg dispatch
+      Ldur r (BaseImm X20 _)  -> r == reg
+      Ldur r (BaseImm X19 _)  -> r == reg
+      _ -> False
+
     -- Get instruction from preceding line
     prevInstr :: Maybe Instr
     prevInstr = do