From 4f6f4a294f00d559b4f024255d11eb1da9bfe036 Mon Sep 17 00:00:00 2001 From: "wolfgang.thaller@gmx.net" Date: Sun, 22 Oct 2006 16:05:07 +0000 Subject: [PATCH] Cast switch scrutinees to W_ in AutoApply.cmm ... and make CmmLint check for this problem. This doesn't matter for -fvia-C, but passing a halfword to a switch will make the NCG generate crashing code. --- compiler/cmm/CmmLint.hs | 6 +++++- utils/genapply/GenApply.hs | 4 ++-- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/compiler/cmm/CmmLint.hs b/compiler/cmm/CmmLint.hs index 632337f..875876f 100644 --- a/compiler/cmm/CmmLint.hs +++ b/compiler/cmm/CmmLint.hs @@ -119,7 +119,11 @@ lintCmmStmt (CmmStore l r) = do return () lintCmmStmt (CmmCall _target _res args _vols) = mapM_ (lintCmmExpr.fst) args lintCmmStmt (CmmCondBranch e _id) = lintCmmExpr e >> checkCond e >> return () -lintCmmStmt (CmmSwitch e _branches) = lintCmmExpr e >> return () +lintCmmStmt (CmmSwitch e _branches) = do + erep <- lintCmmExpr e + if (erep == wordRep) + then return () + else cmmLintErr (text "switch scrutinee is not a word: " <> ppr e) lintCmmStmt (CmmJump e _args) = lintCmmExpr e >> return () lintCmmStmt _other = return () diff --git a/utils/genapply/GenApply.hs b/utils/genapply/GenApply.hs index cdde66f..6827703 100644 --- a/utils/genapply/GenApply.hs +++ b/utils/genapply/GenApply.hs @@ -414,7 +414,7 @@ genApply regstatus args = -- if fast == 1: -- print " goto *lbls[info->type];"; -- else: - text "switch [INVALID_OBJECT .. N_CLOSURE_TYPES] (%INFO_TYPE(%STD_INFO(info))) {", + text "switch [INVALID_OBJECT .. N_CLOSURE_TYPES] (TO_W_(%INFO_TYPE(%STD_INFO(info)))) {", nest 4 (vcat [ -- if fast == 1: @@ -540,7 +540,7 @@ genApplyFast regstatus args = text "W_ info;", text "W_ arity;", text "info = %GET_STD_INFO(R1);", - text "switch [INVALID_OBJECT .. N_CLOSURE_TYPES] (%INFO_TYPE(info)) {", + text "switch [INVALID_OBJECT .. N_CLOSURE_TYPES] (TO_W_(%INFO_TYPE(info))) {", nest 4 (vcat [ text "case FUN,", text " FUN_1_0,", -- 1.7.10.4