<commit_before>-----------------------------------------------------------------------------
--
-- CmmLint: checking the correctness of Cmm statements and expressions
--
-- (c) The University of Glasgow 2004
--
-----------------------------------------------------------------------------

module CmmLint (
  cmmLint, cmmLintTop
  ) where

#include "HsVersions.h"

import Cmm
import CLabel		( pprCLabel )
import MachOp
import Outputable
import PprCmm
import Unique		( getUnique )
import Constants	( wORD_SIZE )

import Monad		( when )

-- -----------------------------------------------------------------------------
-- Exported entry points:

cmmLint :: Cmm -> Maybe SDoc
cmmLint (Cmm tops) = runCmmLint $ mapM_ lintCmmTop tops

cmmLintTop :: CmmTop -> Maybe SDoc
cmmLintTop top = runCmmLint $ lintCmmTop top

runCmmLint :: CmmLint a -> Maybe SDoc
runCmmLint l = 
   case unCL l of
	Left err -> Just (ptext SLIT("Cmm lint error:") $$ nest 2 err)
	Right _  -> Nothing

lintCmmTop (CmmProc _info lbl _args blocks)
  = addLintInfo (text "in proc " <> pprCLabel lbl) $
	mapM_ lintCmmBlock blocks
lintCmmTop _other
  = return ()

lintCmmBlock (BasicBlock id stmts)
  = addLintInfo (text "in basic block " <> ppr (getUnique id)) $
	mapM_ lintCmmStmt stmts

-- -----------------------------------------------------------------------------
-- lintCmmExpr

-- Checks whether a CmmExpr is "type-correct", and check for obvious-looking
-- byte/word mismatches.

lintCmmExpr :: CmmExpr -> CmmLint MachRep
lintCmmExpr (CmmLoad expr rep) = do
  lintCmmExpr expr
  when (machRepByteWidth rep >= wORD_SIZE) $
     cmmCheckWordAddress expr
  return rep
lintCmmExpr expr@(CmmMachOp op args) = do
  mapM_ lintCmmExpr args
  if map cmmExprRep args == machOpArgReps op
  	then cmmCheckMachOp op args
	else cmmLintMachOpErr expr
lintCmmExpr (CmmRegOff reg offset)
  = lintCmmExpr (CmmMachOp (MO_Add rep) 
		[CmmReg reg, CmmLit (CmmInt (fromIntegral offset) rep)])
  where rep = cmmRegRep reg
lintCmmExpr expr = 
  return (cmmExprRep expr)

-- Check for some common byte/word mismatches (eg. Sp + 1)
cmmCheckMachOp  op args@[CmmReg reg, CmmLit (CmmInt i _)]
  | isWordOffsetReg reg && isOffsetOp op && i `rem` fromIntegral wORD_SIZE /= 0
  = cmmLintDubiousWordOffset (CmmMachOp op args)
cmmCheckMachOp op [lit@(CmmLit (CmmInt i _)), reg@(CmmReg _)]
  = cmmCheckMachOp op [reg, lit]
cmmCheckMachOp op args
  = return (resultRepOfMachOp op)

isWordOffsetReg (CmmGlobal Sp) = True
isWordOffsetReg (CmmGlobal Hp) = True
isWordOffsetReg _ = False

isOffsetOp (MO_Add _) = True
isOffsetOp (MO_Sub _) = True
isOffsetOp _ = False

-- This expression should be an address from which a word can be loaded:
-- check for funny-looking sub-word offsets.
cmmCheckWordAddress e@(CmmMachOp op [arg, CmmLit (CmmInt i _)])
  | isOffsetOp op && i `rem` fromIntegral wORD_SIZE /= 0
  = cmmLintDubiousWordOffset e
cmmCheckWordAddress e@(CmmMachOp op [CmmLit (CmmInt i _), arg])
  | isOffsetOp op && i `rem` fromIntegral wORD_SIZE /= 0
  = cmmLintDubiousWordOffset e
cmmCheckWordAddress _
  = return ()


lintCmmStmt :: CmmStmt -> CmmLint ()
lintCmmStmt stmt@(CmmAssign reg expr) = do
  erep <- lintCmmExpr expr
  if (erep == cmmRegRep reg)
	then return ()
	else cmmLintAssignErr stmt
lintCmmStmt (CmmStore l r) = do<commit_msg>[project @ 2005-05-03 10:38:19 by simonmar] Add a couple more lint tests<commit_after>-----------------------------------------------------------------------------
--
-- CmmLint: checking the correctness of Cmm statements and expressions
--
-- (c) The University of Glasgow 2004
--
-----------------------------------------------------------------------------

module CmmLint (
  cmmLint, cmmLintTop
  ) where

#include "HsVersions.h"

import Cmm
import CLabel		( pprCLabel )
import MachOp
import Outputable
import PprCmm
import Unique		( getUnique )
import Constants	( wORD_SIZE )

import Monad		( when )

-- -----------------------------------------------------------------------------
-- Exported entry points:

cmmLint :: Cmm -> Maybe SDoc
cmmLint (Cmm tops) = runCmmLint $ mapM_ lintCmmTop tops

cmmLintTop :: CmmTop -> Maybe SDoc
cmmLintTop top = runCmmLint $ lintCmmTop top

runCmmLint :: CmmLint a -> Maybe SDoc
runCmmLint l = 
   case unCL l of
	Left err -> Just (ptext SLIT("Cmm lint error:") $$ nest 2 err)
	Right _  -> Nothing

lintCmmTop (CmmProc _info lbl _args blocks)
  = addLintInfo (text "in proc " <> pprCLabel lbl) $
	mapM_ lintCmmBlock blocks
lintCmmTop _other
  = return ()

lintCmmBlock (BasicBlock id stmts)
  = addLintInfo (text "in basic block " <> ppr (getUnique id)) $
	mapM_ lintCmmStmt stmts

-- -----------------------------------------------------------------------------
-- lintCmmExpr

-- Checks whether a CmmExpr is "type-correct", and check for obvious-looking
-- byte/word mismatches.

lintCmmExpr :: CmmExpr -> CmmLint MachRep
lintCmmExpr (CmmLoad expr rep) = do
  lintCmmExpr expr
  when (machRepByteWidth rep >= wORD_SIZE) $
     cmmCheckWordAddress expr
  return rep
lintCmmExpr expr@(CmmMachOp op args) = do
  mapM_ lintCmmExpr args
  if map cmmExprRep args == machOpArgReps op
  	then cmmCheckMachOp op args
	else cmmLintMachOpErr expr
lintCmmExpr (CmmRegOff reg offset)
  = lintCmmExpr (CmmMachOp (MO_Add rep) 
		[CmmReg reg, CmmLit (CmmInt (fromIntegral offset) rep)])
  where rep = cmmRegRep reg
lintCmmExpr lit@(CmmLit (CmmInt _ rep))
  | isFloatingRep rep
  = cmmLintErr (text "integer literal with floating MachRep: " <> ppr lit)
lintCmmExpr expr = 
  return (cmmExprRep expr)

-- Check for some common byte/word mismatches (eg. Sp + 1)
cmmCheckMachOp  op args@[CmmReg reg, CmmLit (CmmInt i _)]
  | isWordOffsetReg reg && isOffsetOp op && i `rem` fromIntegral wORD_SIZE /= 0
  = cmmLintDubiousWordOffset (CmmMachOp op args)
cmmCheckMachOp op [lit@(CmmLit (CmmInt i _)), reg@(CmmReg _)]
  = cmmCheckMachOp op [reg, lit]
cmmCheckMachOp op@(MO_U_Conv from to) args
  | isFloatingRep from || isFloatingRep to
  = cmmLintErr (text "unsigned conversion from/to floating rep: " 
		<> ppr (CmmMachOp op args))
cmmCheckMachOp op args
  = return (resultRepOfMachOp op)

isWordOffsetReg (CmmGlobal Sp) = True
isWordOffsetReg (CmmGlobal Hp) = True
isWordOffsetReg _ = False

isOffsetOp (MO_Add _) = True
isOffsetOp (MO_Sub _) = True
isOffsetOp _ = False

-- This expression should be an address from which a word can be loaded:
-- check for funny-looking sub-word offsets.
cmmCheckWordAddress e@(CmmMachOp op [arg, CmmLit (CmmInt i _)])
  | isOffsetOp op && i `rem` fromIntegral wORD_SIZE /= 0
  = cmmLintDubiousWordOffset e
cmmCheckWordAddress e@(CmmMachOp op [CmmLit (CmmInt i _), arg])
  | isOffsetOp op && i `rem` fromIntegral wORD_SIZE /= 0
  = cmmLintDubiousWordOffset e
cmmCheckWordAddress _
  = return ()


lintCmmStmt :: CmmStmt -> CmmLint ()
lintCmmStmt stmt@(CmmAssign reg expr) = do
  erep <- lintCmmExpr expr
  if (erep == cmmRegRep reg)
	then return ()
	else cmmLintAssignErr stmt
lintCmmStmt (CmmStore l r) = do
{'fraction_non_alphanumeric': 0.17043328055275658, 'fraction_numerical': 0.004606304879804232, 'mean_word_length': 2.7374932759548143, 'pattern_counts': {'":': 0, '<': 11, '<?xml version=': 0, '>': 25, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '3486999', 'n_tokens_mistral': 2511, 'n_tokens_neox': 2441, 'n_words': 722}