[Git][ghc/ghc][wip/ubsan-gcc] 7 commits: compiler: Exclude units with no exposed modules from unused package check
Cheng Shao pushed to branch wip/ubsan-gcc at Glasgow Haskell Compiler / GHC Commits: 5cdcfaed by Ben Gamari at 2025-11-06T09:01:36-05:00 compiler: Exclude units with no exposed modules from unused package check Such packages cannot be "used" in the Haskell sense of the word yet are nevertheless necessary as they may provide, e.g., C object code or link flags. Fixes #24120. - - - - - 74b8397a by Brandon Chinn at 2025-11-06T09:02:19-05:00 Replace deprecated argparse.FileType - - - - - 36ddf988 by Ben Gamari at 2025-11-06T09:03:01-05:00 Bump unix submodule to 2.8.8.0 Closes #26474. - - - - - c32b3a29 by fendor at 2025-11-06T09:03:43-05:00 Fix assertion in `postStringLen` to account for \0 byte We fix the assertion to handle trailing \0 bytes in `postStringLen`. Before this change, the assertion looked like this: ASSERT(eb->begin + eb->size > eb->pos + len + 1); Let's assume some values to see why this is actually off by one: eb->begin = 0 eb->size = 1 eb->pos = 0 len = 1 then the assertion would trigger correctly: 0 + 1 > 0 + 1 + 1 => 1 > 2 => false as there is not enough space for the \0 byte (which is the trailing +1). However, if we change `eb->size = 2`, then we do have enough space for a string of length 1, but the assertion still fails: 0 + 2 > 0 + 1 + 1 => 2 > 2 => false Which causes the assertion to fail if there is exactly enough space for the string with a trailing \0 byte. Clearly, the assertion should be `>=`! If we switch around the operand, it should become more obvious that `<=` is the correct comparison: ASSERT(eb->pos + len + 1 <= eb->begin + eb->size); This is expresses more naturally that the current position plus the length of the string (and the null byte) must be smaller or equal to the overall size of the buffer. This change also is in line with the implementation in `hasRoomForEvent` and `hasRoomForVariableEvent`: ``` StgBool hasRoomForEvent(EventsBuf *eb, EventTypeNum eNum) { uint32_t size = ...; if (eb->pos + size > eb->begin + eb->size) ... ``` the check `eb->pos + size > eb->begin + eb->size` is identical to `eb->pos + size <= eb->begin + eb->size` plus a negation. - - - - - 3034a6f2 by Ben Gamari at 2025-11-06T09:04:24-05:00 Bump os-string submodule to 2.0.8 - - - - - 39567e85 by Cheng Shao at 2025-11-06T09:05:06-05:00 rts: use computed goto for instruction dispatch in the bytecode interpreter This patch uses computed goto for instruction dispatch in the bytecode interpreter. Previously instruction dispatch is done by a classic switch loop, so executing the next instruction requires two jumps: one to the start of the switch loop and another to the case block based on the instruction tag. By using computed goto, we can build a jump table consisted of code addresses indexed by the instruction tags themselves, so executing the next instruction requires only one jump, to the destination directly fetched from the jump table. Closes #12953. - - - - - 761843b0 by Cheng Shao at 2025-11-06T18:09:23+01:00 hadrian/rts: add support for building with UndefinedBehaviorSanitizer - - - - - 13 changed files: - compiler/GHC/Driver/Make.hs - docs/users_guide/compare-flags.py - hadrian/src/Flavour.hs - libraries/os-string - libraries/unix - rts/Interpreter.c - rts/eventlog/EventLog.c - rts/gen_event_types.py - rts/include/rts/Bytecodes.h - rts/rts.cabal - testsuite/driver/runtests.py - + testsuite/tests/driver/T24120.hs - testsuite/tests/driver/all.T Changes: ===================================== compiler/GHC/Driver/Make.hs ===================================== @@ -474,6 +474,10 @@ warnUnusedPackages us dflags mod_graph = ui <- lookupUnit us u -- Which are not explicitly used guard (Set.notMember (unitId ui) used_args) + -- Exclude units with no exposed modules. This covers packages which only + -- provide C object code or link flags (e.g. system-cxx-std-lib). + -- See #24120. + guard (not $ null $ unitExposedModules ui) return (unitId ui, unitPackageName ui, unitPackageVersion ui, flag) unusedArgs = sortOn (\(u,_,_,_) -> u) $ mapMaybe resolve (explicitUnits us) ===================================== docs/users_guide/compare-flags.py ===================================== @@ -35,7 +35,7 @@ def expected_undocumented(flag: str) -> bool: return False -def read_documented_flags(doc_flags) -> Set[str]: +def read_documented_flags(doc_flags: Path) -> Set[str]: # Map characters that mark the end of a flag # to whitespace. trans = str.maketrans({ @@ -44,10 +44,10 @@ def read_documented_flags(doc_flags) -> Set[str]: '⟨': ' ', }) return {line.translate(trans).split()[0] - for line in doc_flags.read().split('\n') + for line in doc_flags.read_text(encoding="UTF-8").split('\n') if line != ''} -def read_ghc_flags(ghc_path: str) -> Set[str]: +def read_ghc_flags(ghc_path: Path) -> Set[str]: ghc_output = subprocess.check_output([ghc_path, '--show-options']) ghci_output = subprocess.check_output([ghc_path, '--interactive', '--show-options']) @@ -63,16 +63,16 @@ def error(s: str): def main() -> None: import argparse parser = argparse.ArgumentParser() - parser.add_argument('--ghc', type=argparse.FileType('r'), + parser.add_argument('--ghc', type=Path, help='path of GHC executable', required=True) - parser.add_argument('--doc-flags', type=argparse.FileType(mode='r', encoding='UTF-8'), + parser.add_argument('--doc-flags', type=Path, help='path of ghc-flags.txt output from Sphinx', required=True) args = parser.parse_args() doc_flags = read_documented_flags(args.doc_flags) - ghc_flags = read_ghc_flags(args.ghc.name) + ghc_flags = read_ghc_flags(args.ghc) failed = False ===================================== hadrian/src/Flavour.hs ===================================== @@ -9,6 +9,7 @@ module Flavour , enableThreadSanitizer , enableLateCCS , enableHashUnitIds + , enableUBSan , enableDebugInfo, enableTickyGhc , viaLlvmBackend , enableProfiledGhc @@ -53,6 +54,7 @@ flavourTransformers = M.fromList , "no_split_sections" =: noSplitSections , "thread_sanitizer" =: enableThreadSanitizer False , "thread_sanitizer_cmm" =: enableThreadSanitizer True + , "ubsan" =: enableUBSan , "llvm" =: viaLlvmBackend , "profiled_ghc" =: enableProfiledGhc , "no_dynamic_ghc" =: disableDynamicGhcPrograms @@ -258,6 +260,20 @@ enableThreadSanitizer instrumentCmm = addArgs $ notStage0 ? mconcat ] ] +enableUBSan :: Flavour -> Flavour +enableUBSan = + addArgs $ + notStage0 + ? mconcat + [ package rts ? builder (Cabal Flags) ? arg "ubsan", + builder (Ghc CompileHs) ? arg "-optc-fsanitize=undefined", + builder (Ghc CompileCWithGhc) ? arg "-optc-fsanitize=undefined", + builder (Ghc CompileCppWithGhc) ? arg "optcxx-fsanitize=undefined", + builder (Ghc LinkHs) ? arg "-optc-fsanitize=undefined" + <> arg "-optl-fsanitize=undefined", + builder (Cc CompileC) ? arg "-fsanitize=undefined" + ] + -- | Use the LLVM backend in stages 1 and later. viaLlvmBackend :: Flavour -> Flavour viaLlvmBackend = addArgs $ notStage0 ? builder Ghc ? arg "-fllvm" ===================================== libraries/os-string ===================================== @@ -1 +1 @@ -Subproject commit 2e693aad07540173a0169971b27c9acac28eeff1 +Subproject commit c08666bf7bf528e607fc1eacc20032ec59e69df3 ===================================== libraries/unix ===================================== @@ -1 +1 @@ -Subproject commit c9b3e95b5c15b118e55522bd92963038c6a88160 +Subproject commit 60f432b76871bd7787df07dd3e2a567caba393f5 ===================================== rts/Interpreter.c ===================================== @@ -91,6 +91,80 @@ See also Note [Width of parameters] for some more motivation. /* #define INTERP_STATS */ +// Note [Instruction dispatch in the bytecode interpreter] +// ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +// Like all bytecode interpreters out there, instruction dispatch is +// the backbone of our bytecode interpreter: +// +// - Each instruction starts with a unique integer tag +// - Each instruction has a piece of code to handle it +// - Fetch next instruction's tag, interpret, repeat +// +// There are two classical approaches to organize the interpreter loop +// and implement instruction dispatch: +// +// 1. switch-case: fetch the instruction tag, then a switch statement +// contains each instruction's handler code as a case within it. +// This is the simplest and most portable approach, but the +// compiler often generates suboptimal code that involves two jumps +// per instruction: the first one that jumps back to the switch +// statement, followed by the second one that jumps to the handler +// case statement. +// 2. computed-goto (direct threaded code): GNU C has an extension +// (https://gcc.gnu.org/onlinedocs/gcc/Labels-as-Values.html) that +// allows storing a code label as a pointer and using the goto +// statement to jump to such a pointer. So we can organize the +// handler code as a code block under a label, have a pointer array +// that maps an instruction tag to its handler's code label, then +// instruction dispatch can happen with a single jump after a +// memory load. +// +// A classical paper "The Structure and Performance of Efficient +// Interpreters" by M. Anton Ertl and David Gregg in 2003 explains it +// in further details with profiling data: +// https://jilp.org/vol5/v5paper12.pdf. There exist more subtle issues +// like interaction with modern CPU's branch predictors, though in +// practice computed-goto does outperform switch-case, and I've +// observed around 10%-15% wall clock time speedup in simple +// benchmarks, so our bytecode interpreter now defaults to using +// computed-goto when applicable, and falls back to switch-case in +// other cases. +// +// The COMPUTED_GOTO macro is defined when we use computed-goto. We +// don't do autoconf feature detection since it works with all +// versions of gcc/clang on all platforms we currently support. +// Exceptions include: +// +// - When DEBUG or other macros are enabled so that there's extra +// logic per instruction: assertions, statistics, etc. To make +// computed-goto support those would need us to duplicate the extra +// code in every instruction's handler code block, not really worth +// it when speed is not the primary concern. +// - On wasm, because wasm prohibits goto anyway and LLVM has to lower +// goto in C to br_table, so there's no performance benefit of +// computed-goto, only slight penalty due to an extra load from the +// user-defined dispatch table in the linear memory. +// +// The source of truth for our bytecode definition is +// rts/include/rts/Bytecodes.h. For each bytecode `#define bci_FOO +// tag`, we have jumptable[tag] which stores the 32-bit offset +// `&&lbl_bci_FOO - &&lbl_bci_DEFAULT`, so the goto destination can +// always be computed by adding the jumptable[tag] offset to the base +// address `&&lbl_bci_DEFAULT`. Whenever you change the bytecode +// definitions, always remember to update `jumptable` as well! + +#if !defined(DEBUG) && !defined(ASSERTS_ENABLED) && !defined(INTERP_STATS) && !defined(wasm32_HOST_ARCH) +#define COMPUTED_GOTO +#endif + +#if defined(COMPUTED_GOTO) +#pragma GCC diagnostic ignored "-Wpointer-arith" +#define INSTRUCTION(name) lbl_##name +#define NEXT_INSTRUCTION goto *(&&lbl_bci_DEFAULT + jumptable[(bci = instrs[bciPtr++]) & 0xFF]) +#else +#define INSTRUCTION(name) case name +#define NEXT_INSTRUCTION goto nextInsn +#endif /* Sp points to the lowest live word on the stack. */ @@ -1542,7 +1616,9 @@ run_BCO: it_lastopc = 0; /* no opcode */ #endif +#if !defined(COMPUTED_GOTO) nextInsn: +#endif ASSERT(bciPtr < bcoSize); IF_DEBUG(interpreter, //if (do_print_stack) { @@ -1572,15 +1648,263 @@ run_BCO: it_lastopc = (int)instrs[bciPtr]; #endif - bci = BCO_NEXT; +#if defined(COMPUTED_GOTO) + static const int32_t jumptable[] = { + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_STKCHECK - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH_L - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH_LL - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH_LLL - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH8 - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH16 - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH32 - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH8_W - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH16_W - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH32_W - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH_G - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH_ALTS_P - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH_ALTS_N - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH_ALTS_F - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH_ALTS_D - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH_ALTS_L - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH_ALTS_V - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH_PAD8 - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH_PAD16 - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH_PAD32 - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH_UBX8 - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH_UBX16 - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH_UBX32 - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH_UBX - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH_APPLY_N - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH_APPLY_F - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH_APPLY_D - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH_APPLY_L - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH_APPLY_V - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH_APPLY_P - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH_APPLY_PP - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH_APPLY_PPP - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH_APPLY_PPPP - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH_APPLY_PPPPP - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH_APPLY_PPPPPP - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_SLIDE - &&lbl_bci_DEFAULT, + &&lbl_bci_ALLOC_AP - &&lbl_bci_DEFAULT, + &&lbl_bci_ALLOC_AP_NOUPD - &&lbl_bci_DEFAULT, + &&lbl_bci_ALLOC_PAP - &&lbl_bci_DEFAULT, + &&lbl_bci_MKAP - &&lbl_bci_DEFAULT, + &&lbl_bci_MKPAP - &&lbl_bci_DEFAULT, + &&lbl_bci_UNPACK - &&lbl_bci_DEFAULT, + &&lbl_bci_PACK - &&lbl_bci_DEFAULT, + &&lbl_bci_TESTLT_I - &&lbl_bci_DEFAULT, + &&lbl_bci_TESTEQ_I - &&lbl_bci_DEFAULT, + &&lbl_bci_TESTLT_F - &&lbl_bci_DEFAULT, + &&lbl_bci_TESTEQ_F - &&lbl_bci_DEFAULT, + &&lbl_bci_TESTLT_D - &&lbl_bci_DEFAULT, + &&lbl_bci_TESTEQ_D - &&lbl_bci_DEFAULT, + &&lbl_bci_TESTLT_P - &&lbl_bci_DEFAULT, + &&lbl_bci_TESTEQ_P - &&lbl_bci_DEFAULT, + &&lbl_bci_CASEFAIL - &&lbl_bci_DEFAULT, + &&lbl_bci_JMP - &&lbl_bci_DEFAULT, + &&lbl_bci_CCALL - &&lbl_bci_DEFAULT, + &&lbl_bci_SWIZZLE - &&lbl_bci_DEFAULT, + &&lbl_bci_ENTER - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_RETURN_P - &&lbl_bci_DEFAULT, + &&lbl_bci_RETURN_N - &&lbl_bci_DEFAULT, + &&lbl_bci_RETURN_F - &&lbl_bci_DEFAULT, + &&lbl_bci_RETURN_D - &&lbl_bci_DEFAULT, + &&lbl_bci_RETURN_L - &&lbl_bci_DEFAULT, + &&lbl_bci_RETURN_V - &&lbl_bci_DEFAULT, + &&lbl_bci_BRK_FUN - &&lbl_bci_DEFAULT, + &&lbl_bci_TESTLT_W - &&lbl_bci_DEFAULT, + &&lbl_bci_TESTEQ_W - &&lbl_bci_DEFAULT, + &&lbl_bci_RETURN_T - &&lbl_bci_DEFAULT, + &&lbl_bci_PUSH_ALTS_T - &&lbl_bci_DEFAULT, + &&lbl_bci_TESTLT_I64 - &&lbl_bci_DEFAULT, + &&lbl_bci_TESTEQ_I64 - &&lbl_bci_DEFAULT, + &&lbl_bci_TESTLT_I32 - &&lbl_bci_DEFAULT, + &&lbl_bci_TESTEQ_I32 - &&lbl_bci_DEFAULT, + &&lbl_bci_TESTLT_I16 - &&lbl_bci_DEFAULT, + &&lbl_bci_TESTEQ_I16 - &&lbl_bci_DEFAULT, + &&lbl_bci_TESTLT_I8 - &&lbl_bci_DEFAULT, + &&lbl_bci_TESTEQ_I8 - &&lbl_bci_DEFAULT, + &&lbl_bci_TESTLT_W64 - &&lbl_bci_DEFAULT, + &&lbl_bci_TESTEQ_W64 - &&lbl_bci_DEFAULT, + &&lbl_bci_TESTLT_W32 - &&lbl_bci_DEFAULT, + &&lbl_bci_TESTEQ_W32 - &&lbl_bci_DEFAULT, + &&lbl_bci_TESTLT_W16 - &&lbl_bci_DEFAULT, + &&lbl_bci_TESTEQ_W16 - &&lbl_bci_DEFAULT, + &&lbl_bci_TESTLT_W8 - &&lbl_bci_DEFAULT, + &&lbl_bci_TESTEQ_W8 - &&lbl_bci_DEFAULT, + &&lbl_bci_PRIMCALL - &&lbl_bci_DEFAULT, + &&lbl_bci_BCO_NAME - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_ADD_64 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_SUB_64 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_AND_64 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_XOR_64 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_NOT_64 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_NEG_64 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_MUL_64 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_SHL_64 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_ASR_64 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_LSR_64 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_OR_64 - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_NEQ_64 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_EQ_64 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_U_GE_64 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_U_GT_64 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_U_LT_64 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_U_LE_64 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_S_GE_64 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_S_GT_64 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_S_LT_64 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_S_LE_64 - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_ADD_32 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_SUB_32 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_AND_32 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_XOR_32 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_NOT_32 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_NEG_32 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_MUL_32 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_SHL_32 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_ASR_32 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_LSR_32 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_OR_32 - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_NEQ_32 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_EQ_32 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_U_GE_32 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_U_GT_32 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_U_LT_32 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_U_LE_32 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_S_GE_32 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_S_GT_32 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_S_LT_32 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_S_LE_32 - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_ADD_16 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_SUB_16 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_AND_16 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_XOR_16 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_NOT_16 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_NEG_16 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_MUL_16 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_SHL_16 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_ASR_16 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_LSR_16 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_OR_16 - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_NEQ_16 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_EQ_16 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_U_GE_16 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_U_GT_16 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_U_LT_16 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_U_LE_16 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_S_GE_16 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_S_GT_16 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_S_LT_16 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_S_LE_16 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_ADD_08 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_SUB_08 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_AND_08 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_XOR_08 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_NOT_08 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_NEG_08 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_MUL_08 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_SHL_08 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_ASR_08 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_LSR_08 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_OR_08 - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_NEQ_08 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_EQ_08 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_U_GE_08 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_U_GT_08 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_U_LT_08 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_U_LE_08 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_S_GE_08 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_S_GT_08 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_S_LT_08 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_S_LE_08 - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_DEFAULT - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_INDEX_ADDR_08 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_INDEX_ADDR_16 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_INDEX_ADDR_32 - &&lbl_bci_DEFAULT, + &&lbl_bci_OP_INDEX_ADDR_64 - &&lbl_bci_DEFAULT}; + NEXT_INSTRUCTION; +#else + bci = BCO_NEXT; /* We use the high 8 bits for flags. The highest of which is * currently allocated to LARGE_ARGS */ ASSERT((bci & 0xFF00) == (bci & ( bci_FLAG_LARGE_ARGS ))); - switch (bci & 0xFF) { +#endif /* check for a breakpoint on the beginning of a BCO */ - case bci_BRK_FUN: + INSTRUCTION(bci_BRK_FUN): { W_ arg1_brk_array, arg2_info_mod_name, arg3_info_mod_id, arg4_info_index; #if defined(PROFILING) @@ -1779,10 +2103,10 @@ run_BCO: cap->r.rCurrentTSO->flags &= ~TSO_STOPPED_ON_BREAKPOINT; // continue normal execution of the byte code instructions - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_STKCHECK: { + INSTRUCTION(bci_STKCHECK): { // Explicit stack check at the beginning of a function // *only* (stack checks in case alternatives are // propagated to the enclosing function). @@ -1793,27 +2117,27 @@ run_BCO: SpW(0) = (W_)&stg_apply_interp_info; RETURN_TO_SCHEDULER(ThreadInterpret, StackOverflow); } else { - goto nextInsn; + NEXT_INSTRUCTION; } } - case bci_PUSH_L: { + INSTRUCTION(bci_PUSH_L): { W_ o1 = BCO_GET_LARGE_ARG; SpW(-1) = ReadSpW(o1); Sp_subW(1); - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_PUSH_LL: { + INSTRUCTION(bci_PUSH_LL): { W_ o1 = BCO_GET_LARGE_ARG; W_ o2 = BCO_GET_LARGE_ARG; SpW(-1) = ReadSpW(o1); SpW(-2) = ReadSpW(o2); Sp_subW(2); - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_PUSH_LLL: { + INSTRUCTION(bci_PUSH_LLL): { W_ o1 = BCO_GET_LARGE_ARG; W_ o2 = BCO_GET_LARGE_ARG; W_ o3 = BCO_GET_LARGE_ARG; @@ -1821,52 +2145,52 @@ run_BCO: SpW(-2) = ReadSpW(o2); SpW(-3) = ReadSpW(o3); Sp_subW(3); - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_PUSH8: { + INSTRUCTION(bci_PUSH8): { W_ off = BCO_GET_LARGE_ARG; Sp_subB(1); *(StgWord8*)Sp = (StgWord8) (ReadSpB(off+1)); - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_PUSH16: { + INSTRUCTION(bci_PUSH16): { W_ off = BCO_GET_LARGE_ARG; Sp_subB(2); *(StgWord16*)Sp = (StgWord16) (ReadSpB(off+2)); - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_PUSH32: { + INSTRUCTION(bci_PUSH32): { W_ off = BCO_GET_LARGE_ARG; Sp_subB(4); *(StgWord32*)Sp = (StgWord32) (ReadSpB(off+4)); - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_PUSH8_W: { + INSTRUCTION(bci_PUSH8_W): { W_ off = BCO_GET_LARGE_ARG; *(StgWord*)(Sp_minusW(1)) = (StgWord) ((StgWord8) (ReadSpB(off))); Sp_subW(1); - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_PUSH16_W: { + INSTRUCTION(bci_PUSH16_W): { W_ off = BCO_GET_LARGE_ARG; *(StgWord*)(Sp_minusW(1)) = (StgWord) ((StgWord16) (ReadSpB(off))); Sp_subW(1); - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_PUSH32_W: { + INSTRUCTION(bci_PUSH32_W): { W_ off = BCO_GET_LARGE_ARG; *(StgWord*)(Sp_minusW(1)) = (StgWord) ((StgWord32) (ReadSpB(off))); Sp_subW(1); - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_PUSH_G: { + INSTRUCTION(bci_PUSH_G): { W_ o1 = BCO_GET_LARGE_ARG; StgClosure *tagged_obj = (StgClosure*) BCO_PTR(o1); @@ -1905,10 +2229,10 @@ run_BCO: SpW(-1) = (W_) tagged_obj; Sp_subW(1); - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_PUSH_ALTS_P: { + INSTRUCTION(bci_PUSH_ALTS_P): { W_ o_bco = BCO_GET_LARGE_ARG; Sp_subW(2); SpW(1) = BCO_PTR(o_bco); @@ -1918,10 +2242,10 @@ run_BCO: SpW(1) = (W_)cap->r.rCCCS; SpW(0) = (W_)&stg_restore_cccs_d_info; #endif - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_PUSH_ALTS_N: { + INSTRUCTION(bci_PUSH_ALTS_N): { W_ o_bco = BCO_GET_LARGE_ARG; SpW(-2) = (W_)&stg_ctoi_R1n_info; SpW(-1) = BCO_PTR(o_bco); @@ -1931,10 +2255,10 @@ run_BCO: SpW(1) = (W_)cap->r.rCCCS; SpW(0) = (W_)&stg_restore_cccs_d_info; #endif - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_PUSH_ALTS_F: { + INSTRUCTION(bci_PUSH_ALTS_F): { W_ o_bco = BCO_GET_LARGE_ARG; SpW(-2) = (W_)&stg_ctoi_F1_info; SpW(-1) = BCO_PTR(o_bco); @@ -1944,10 +2268,10 @@ run_BCO: SpW(1) = (W_)cap->r.rCCCS; SpW(0) = (W_)&stg_restore_cccs_d_info; #endif - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_PUSH_ALTS_D: { + INSTRUCTION(bci_PUSH_ALTS_D): { W_ o_bco = BCO_GET_LARGE_ARG; SpW(-2) = (W_)&stg_ctoi_D1_info; SpW(-1) = BCO_PTR(o_bco); @@ -1957,10 +2281,10 @@ run_BCO: SpW(1) = (W_)cap->r.rCCCS; SpW(0) = (W_)&stg_restore_cccs_d_info; #endif - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_PUSH_ALTS_L: { + INSTRUCTION(bci_PUSH_ALTS_L): { W_ o_bco = BCO_GET_LARGE_ARG; SpW(-2) = (W_)&stg_ctoi_L1_info; SpW(-1) = BCO_PTR(o_bco); @@ -1970,10 +2294,10 @@ run_BCO: SpW(1) = (W_)cap->r.rCCCS; SpW(0) = (W_)&stg_restore_cccs_d_info; #endif - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_PUSH_ALTS_V: { + INSTRUCTION(bci_PUSH_ALTS_V): { W_ o_bco = BCO_GET_LARGE_ARG; SpW(-2) = (W_)&stg_ctoi_V_info; SpW(-1) = BCO_PTR(o_bco); @@ -1983,10 +2307,10 @@ run_BCO: SpW(1) = (W_)cap->r.rCCCS; SpW(0) = (W_)&stg_restore_cccs_d_info; #endif - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_PUSH_ALTS_T: { + INSTRUCTION(bci_PUSH_ALTS_T): { W_ o_bco = BCO_GET_LARGE_ARG; W_ tuple_info = (W_)BCO_LIT(BCO_GET_LARGE_ARG); W_ o_tuple_bco = BCO_GET_LARGE_ARG; @@ -2006,83 +2330,83 @@ run_BCO: W_ ctoi_t_offset = (W_) ctoi_tuple_infos[tuple_stack_words]; SpW(-4) = ctoi_t_offset; Sp_subW(4); - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_PUSH_APPLY_N: + INSTRUCTION(bci_PUSH_APPLY_N): Sp_subW(1); SpW(0) = (W_)&stg_ap_n_info; - goto nextInsn; - case bci_PUSH_APPLY_V: + NEXT_INSTRUCTION; + INSTRUCTION(bci_PUSH_APPLY_V): Sp_subW(1); SpW(0) = (W_)&stg_ap_v_info; - goto nextInsn; - case bci_PUSH_APPLY_F: + NEXT_INSTRUCTION; + INSTRUCTION(bci_PUSH_APPLY_F): Sp_subW(1); SpW(0) = (W_)&stg_ap_f_info; - goto nextInsn; - case bci_PUSH_APPLY_D: + NEXT_INSTRUCTION; + INSTRUCTION(bci_PUSH_APPLY_D): Sp_subW(1); SpW(0) = (W_)&stg_ap_d_info; - goto nextInsn; - case bci_PUSH_APPLY_L: + NEXT_INSTRUCTION; + INSTRUCTION(bci_PUSH_APPLY_L): Sp_subW(1); SpW(0) = (W_)&stg_ap_l_info; - goto nextInsn; - case bci_PUSH_APPLY_P: + NEXT_INSTRUCTION; + INSTRUCTION(bci_PUSH_APPLY_P): Sp_subW(1); SpW(0) = (W_)&stg_ap_p_info; - goto nextInsn; - case bci_PUSH_APPLY_PP: + NEXT_INSTRUCTION; + INSTRUCTION(bci_PUSH_APPLY_PP): Sp_subW(1); SpW(0) = (W_)&stg_ap_pp_info; - goto nextInsn; - case bci_PUSH_APPLY_PPP: + NEXT_INSTRUCTION; + INSTRUCTION(bci_PUSH_APPLY_PPP): Sp_subW(1); SpW(0) = (W_)&stg_ap_ppp_info; - goto nextInsn; - case bci_PUSH_APPLY_PPPP: + NEXT_INSTRUCTION; + INSTRUCTION(bci_PUSH_APPLY_PPPP): Sp_subW(1); SpW(0) = (W_)&stg_ap_pppp_info; - goto nextInsn; - case bci_PUSH_APPLY_PPPPP: + NEXT_INSTRUCTION; + INSTRUCTION(bci_PUSH_APPLY_PPPPP): Sp_subW(1); SpW(0) = (W_)&stg_ap_ppppp_info; - goto nextInsn; - case bci_PUSH_APPLY_PPPPPP: + NEXT_INSTRUCTION; + INSTRUCTION(bci_PUSH_APPLY_PPPPPP): Sp_subW(1); SpW(0) = (W_)&stg_ap_pppppp_info; - goto nextInsn; + NEXT_INSTRUCTION; - case bci_PUSH_PAD8: { + INSTRUCTION(bci_PUSH_PAD8): { Sp_subB(1); *(StgWord8*)Sp = 0; - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_PUSH_PAD16: { + INSTRUCTION(bci_PUSH_PAD16): { Sp_subB(2); *(StgWord16*)Sp = 0; - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_PUSH_PAD32: { + INSTRUCTION(bci_PUSH_PAD32): { Sp_subB(4); *(StgWord32*)Sp = 0; - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_PUSH_UBX8: { + INSTRUCTION(bci_PUSH_UBX8): { W_ o_lit = BCO_GET_LARGE_ARG; Sp_subB(1); *(StgWord8*)Sp = (StgWord8) BCO_LIT(o_lit); - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_PUSH_UBX16: { + INSTRUCTION(bci_PUSH_UBX16): { W_ o_lit = BCO_GET_LARGE_ARG; Sp_subB(2); *(StgWord16*)Sp = (StgWord16) BCO_LIT(o_lit); - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_PUSH_UBX32: { + INSTRUCTION(bci_PUSH_UBX32): { W_ o_lit = BCO_GET_LARGE_ARG; Sp_subB(4); *(StgWord32*)Sp = (StgWord32) BCO_LIT(o_lit); - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_PUSH_UBX: { + INSTRUCTION(bci_PUSH_UBX): { W_ i; W_ o_lits = BCO_GET_LARGE_ARG; W_ n_words = BCO_GET_LARGE_ARG; @@ -2090,10 +2414,10 @@ run_BCO: for (i = 0; i < n_words; i++) { SpW(i) = (W_)BCO_LIT(o_lits+i); } - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_SLIDE: { + INSTRUCTION(bci_SLIDE): { W_ n = BCO_GET_LARGE_ARG; W_ by = BCO_GET_LARGE_ARG; /* @@ -2106,10 +2430,10 @@ run_BCO: } Sp_addW(by); INTERP_TICK(it_slides); - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_ALLOC_AP: { + INSTRUCTION(bci_ALLOC_AP): { StgHalfWord n_payload = BCO_GET_LARGE_ARG; StgAP *ap = (StgAP*)allocate(cap, AP_sizeW(n_payload)); SpW(-1) = (W_)ap; @@ -2119,10 +2443,10 @@ run_BCO: // visible only from our stack SET_HDR(ap, &stg_AP_info, cap->r.rCCCS) Sp_subW(1); - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_ALLOC_AP_NOUPD: { + INSTRUCTION(bci_ALLOC_AP_NOUPD): { StgHalfWord n_payload = BCO_GET_LARGE_ARG; StgAP *ap = (StgAP*)allocate(cap, AP_sizeW(n_payload)); SpW(-1) = (W_)ap; @@ -2132,10 +2456,10 @@ run_BCO: // visible only from our stack SET_HDR(ap, &stg_AP_NOUPD_info, cap->r.rCCCS) Sp_subW(1); - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_ALLOC_PAP: { + INSTRUCTION(bci_ALLOC_PAP): { StgPAP* pap; StgHalfWord arity = BCO_GET_LARGE_ARG; StgHalfWord n_payload = BCO_GET_LARGE_ARG; @@ -2147,10 +2471,10 @@ run_BCO: // visible only from our stack SET_HDR(pap, &stg_PAP_info, cap->r.rCCCS) Sp_subW(1); - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_MKAP: { + INSTRUCTION(bci_MKAP): { StgHalfWord i; W_ stkoff = BCO_GET_LARGE_ARG; StgHalfWord n_payload = BCO_GET_LARGE_ARG; @@ -2171,10 +2495,10 @@ run_BCO: debugBelch("\tBuilt "); printObj((StgClosure*)ap); ); - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_MKPAP: { + INSTRUCTION(bci_MKPAP): { StgHalfWord i; W_ stkoff = BCO_GET_LARGE_ARG; StgHalfWord n_payload = BCO_GET_LARGE_ARG; @@ -2198,10 +2522,10 @@ run_BCO: debugBelch("\tBuilt "); printObj((StgClosure*)pap); ); - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_UNPACK: { + INSTRUCTION(bci_UNPACK): { /* Unpack N ptr words from t.o.s constructor */ W_ i; W_ n_words = BCO_GET_LARGE_ARG; @@ -2210,10 +2534,10 @@ run_BCO: for (i = 0; i < n_words; i++) { SpW(i) = (W_)con->payload[i]; } - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_PACK: { + INSTRUCTION(bci_PACK): { W_ o_itbl = BCO_GET_LARGE_ARG; W_ n_words = BCO_GET_LARGE_ARG; StgConInfoTable* itbl = CON_INFO_PTR_TO_STRUCT((StgInfoTable *)BCO_LIT(o_itbl)); @@ -2244,220 +2568,220 @@ run_BCO: debugBelch("\tBuilt "); printObj((StgClosure*)tagged_con); ); - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_TESTLT_P: { + INSTRUCTION(bci_TESTLT_P): { unsigned int discr = BCO_NEXT; int failto = BCO_GET_LARGE_ARG; StgClosure* con = UNTAG_CLOSURE((StgClosure*)ReadSpW(0)); if (GET_TAG(con) >= discr) { bciPtr = failto; } - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_TESTEQ_P: { + INSTRUCTION(bci_TESTEQ_P): { unsigned int discr = BCO_NEXT; int failto = BCO_GET_LARGE_ARG; StgClosure* con = UNTAG_CLOSURE((StgClosure*)ReadSpW(0)); if (GET_TAG(con) != discr) { bciPtr = failto; } - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_TESTLT_I: { + INSTRUCTION(bci_TESTLT_I): { int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; I_ stackInt = (I_)ReadSpW(0); if (stackInt >= (I_)BCO_LIT(discr)) bciPtr = failto; - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_TESTLT_I64: { + INSTRUCTION(bci_TESTLT_I64): { int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; StgInt64 stackInt = ReadSpW64(0); if (stackInt >= BCO_LITI64(discr)) bciPtr = failto; - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_TESTLT_I32: { + INSTRUCTION(bci_TESTLT_I32): { int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; StgInt32 stackInt = (StgInt32) ReadSpW(0); if (stackInt >= (StgInt32)BCO_LIT(discr)) bciPtr = failto; - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_TESTLT_I16: { + INSTRUCTION(bci_TESTLT_I16): { int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; StgInt16 stackInt = (StgInt16) ReadSpW(0); if (stackInt >= (StgInt16)BCO_LIT(discr)) bciPtr = failto; - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_TESTLT_I8: { + INSTRUCTION(bci_TESTLT_I8): { int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; StgInt8 stackInt = (StgInt8) ReadSpW(0); if (stackInt >= (StgInt8)BCO_LIT(discr)) bciPtr = failto; - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_TESTEQ_I: { + INSTRUCTION(bci_TESTEQ_I): { int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; I_ stackInt = (I_)ReadSpW(0); if (stackInt != (I_)BCO_LIT(discr)) { bciPtr = failto; } - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_TESTEQ_I64: { + INSTRUCTION(bci_TESTEQ_I64): { int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; StgInt64 stackInt = ReadSpW64(0); if (stackInt != BCO_LITI64(discr)) { bciPtr = failto; } - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_TESTEQ_I32: { + INSTRUCTION(bci_TESTEQ_I32): { int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; StgInt32 stackInt = (StgInt32) ReadSpW(0); if (stackInt != (StgInt32)BCO_LIT(discr)) { bciPtr = failto; } - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_TESTEQ_I16: { + INSTRUCTION(bci_TESTEQ_I16): { int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; StgInt16 stackInt = (StgInt16) ReadSpW(0); if (stackInt != (StgInt16)BCO_LIT(discr)) { bciPtr = failto; } - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_TESTEQ_I8: { + INSTRUCTION(bci_TESTEQ_I8): { int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; StgInt8 stackInt = (StgInt8) ReadSpW(0); if (stackInt != (StgInt8)BCO_LIT(discr)) { bciPtr = failto; } - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_TESTLT_W: { + INSTRUCTION(bci_TESTLT_W): { int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; W_ stackWord = (W_)ReadSpW(0); if (stackWord >= (W_)BCO_LIT(discr)) bciPtr = failto; - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_TESTLT_W64: { + INSTRUCTION(bci_TESTLT_W64): { int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; StgWord64 stackWord = ReadSpW64(0); if (stackWord >= BCO_LITW64(discr)) bciPtr = failto; - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_TESTLT_W32: { + INSTRUCTION(bci_TESTLT_W32): { int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; StgWord32 stackWord = (StgWord32) ReadSpW(0); if (stackWord >= (StgWord32)BCO_LIT(discr)) bciPtr = failto; - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_TESTLT_W16: { + INSTRUCTION(bci_TESTLT_W16): { int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; StgWord16 stackWord = (StgInt16) ReadSpW(0); if (stackWord >= (StgWord16)BCO_LIT(discr)) bciPtr = failto; - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_TESTLT_W8: { + INSTRUCTION(bci_TESTLT_W8): { int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; StgWord8 stackWord = (StgInt8) ReadSpW(0); if (stackWord >= (StgWord8)BCO_LIT(discr)) bciPtr = failto; - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_TESTEQ_W: { + INSTRUCTION(bci_TESTEQ_W): { int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; W_ stackWord = (W_)ReadSpW(0); if (stackWord != (W_)BCO_LIT(discr)) { bciPtr = failto; } - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_TESTEQ_W64: { + INSTRUCTION(bci_TESTEQ_W64): { int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; StgWord64 stackWord = ReadSpW64(0); if (stackWord != BCO_LITW64(discr)) { bciPtr = failto; } - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_TESTEQ_W32: { + INSTRUCTION(bci_TESTEQ_W32): { int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; StgWord32 stackWord = (StgWord32) ReadSpW(0); if (stackWord != (StgWord32)BCO_LIT(discr)) { bciPtr = failto; } - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_TESTEQ_W16: { + INSTRUCTION(bci_TESTEQ_W16): { int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; StgWord16 stackWord = (StgWord16) ReadSpW(0); if (stackWord != (StgWord16)BCO_LIT(discr)) { bciPtr = failto; } - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_TESTEQ_W8: { + INSTRUCTION(bci_TESTEQ_W8): { int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; StgWord8 stackWord = (StgWord8) ReadSpW(0); if (stackWord != (StgWord8)BCO_LIT(discr)) { bciPtr = failto; } - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_TESTLT_D: { + INSTRUCTION(bci_TESTLT_D): { int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; StgDouble stackDbl, discrDbl; @@ -2466,10 +2790,10 @@ run_BCO: if (stackDbl >= discrDbl) { bciPtr = failto; } - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_TESTEQ_D: { + INSTRUCTION(bci_TESTEQ_D): { int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; StgDouble stackDbl, discrDbl; @@ -2478,10 +2802,10 @@ run_BCO: if (stackDbl != discrDbl) { bciPtr = failto; } - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_TESTLT_F: { + INSTRUCTION(bci_TESTLT_F): { int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; StgFloat stackFlt, discrFlt; @@ -2490,10 +2814,10 @@ run_BCO: if (stackFlt >= discrFlt) { bciPtr = failto; } - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_TESTEQ_F: { + INSTRUCTION(bci_TESTEQ_F): { int discr = BCO_GET_LARGE_ARG; int failto = BCO_GET_LARGE_ARG; StgFloat stackFlt, discrFlt; @@ -2502,11 +2826,11 @@ run_BCO: if (stackFlt != discrFlt) { bciPtr = failto; } - goto nextInsn; + NEXT_INSTRUCTION; } // Control-flow ish things - case bci_ENTER: + INSTRUCTION(bci_ENTER): // Context-switch check. We put it here to ensure that // the interpreter has done at least *some* work before // context switching: sometimes the scheduler can invoke @@ -2518,50 +2842,50 @@ run_BCO: } goto eval; - case bci_RETURN_P: + INSTRUCTION(bci_RETURN_P): tagged_obj = (StgClosure *)ReadSpW(0); Sp_addW(1); goto do_return_pointer; - case bci_RETURN_N: + INSTRUCTION(bci_RETURN_N): Sp_subW(1); SpW(0) = (W_)&stg_ret_n_info; goto do_return_nonpointer; - case bci_RETURN_F: + INSTRUCTION(bci_RETURN_F): Sp_subW(1); SpW(0) = (W_)&stg_ret_f_info; goto do_return_nonpointer; - case bci_RETURN_D: + INSTRUCTION(bci_RETURN_D): Sp_subW(1); SpW(0) = (W_)&stg_ret_d_info; goto do_return_nonpointer; - case bci_RETURN_L: + INSTRUCTION(bci_RETURN_L): Sp_subW(1); SpW(0) = (W_)&stg_ret_l_info; goto do_return_nonpointer; - case bci_RETURN_V: + INSTRUCTION(bci_RETURN_V): Sp_subW(1); SpW(0) = (W_)&stg_ret_v_info; goto do_return_nonpointer; - case bci_RETURN_T: { + INSTRUCTION(bci_RETURN_T): { /* tuple_info and tuple_bco must already be on the stack */ Sp_subW(1); SpW(0) = (W_)&stg_ret_t_info; goto do_return_nonpointer; } - case bci_BCO_NAME: + INSTRUCTION(bci_BCO_NAME): bciPtr++; - goto nextInsn; + NEXT_INSTRUCTION; - case bci_SWIZZLE: { + INSTRUCTION(bci_SWIZZLE): { W_ stkoff = BCO_GET_LARGE_ARG; StgInt n = BCO_GET_LARGE_ARG; (*(StgInt*)(SafeSpWP(stkoff))) += n; - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_PRIMCALL: { + INSTRUCTION(bci_PRIMCALL): { Sp_subW(1); SpW(0) = (W_)&stg_primcall_info; RETURN_TO_SCHEDULER_NO_PAUSE(ThreadRunGHC, ThreadYielding); @@ -2577,7 +2901,7 @@ run_BCO: ty r = op ((ty) ReadSpW(0)); \ SpW(0) = (StgWord) r; \ } \ - goto nextInsn; \ + NEXT_INSTRUCTION; \ } // op :: ty -> ty -> ty @@ -2592,7 +2916,7 @@ run_BCO: Sp_addW(1); \ SpW(0) = (StgWord) r; \ }; \ - goto nextInsn; \ + NEXT_INSTRUCTION; \ } // op :: ty -> Int -> ty @@ -2607,7 +2931,7 @@ run_BCO: Sp_addW(1); \ SpW(0) = (StgWord) r; \ }; \ - goto nextInsn; \ + NEXT_INSTRUCTION; \ } // op :: ty -> ty -> Int @@ -2622,113 +2946,113 @@ run_BCO: Sp_addW(1); \ SpW(0) = (StgWord) r; \ }; \ - goto nextInsn; \ + NEXT_INSTRUCTION; \ } - case bci_OP_ADD_64: SIZED_BIN_OP(+, StgInt64) - case bci_OP_SUB_64: SIZED_BIN_OP(-, StgInt64) - case bci_OP_AND_64: SIZED_BIN_OP(&, StgInt64) - case bci_OP_XOR_64: SIZED_BIN_OP(^, StgInt64) - case bci_OP_OR_64: SIZED_BIN_OP(|, StgInt64) - case bci_OP_MUL_64: SIZED_BIN_OP(*, StgInt64) - case bci_OP_SHL_64: SIZED_BIN_OP_TY_INT(<<, StgWord64) - case bci_OP_LSR_64: SIZED_BIN_OP_TY_INT(>>, StgWord64) - case bci_OP_ASR_64: SIZED_BIN_OP_TY_INT(>>, StgInt64) - - case bci_OP_NEQ_64: SIZED_BIN_OP_TY_TY_INT(!=, StgWord64) - case bci_OP_EQ_64: SIZED_BIN_OP_TY_TY_INT(==, StgWord64) - case bci_OP_U_GT_64: SIZED_BIN_OP_TY_TY_INT(>, StgWord64) - case bci_OP_U_GE_64: SIZED_BIN_OP_TY_TY_INT(>=, StgWord64) - case bci_OP_U_LT_64: SIZED_BIN_OP_TY_TY_INT(<, StgWord64) - case bci_OP_U_LE_64: SIZED_BIN_OP_TY_TY_INT(<=, StgWord64) - - case bci_OP_S_GT_64: SIZED_BIN_OP_TY_TY_INT(>, StgInt64) - case bci_OP_S_GE_64: SIZED_BIN_OP_TY_TY_INT(>=, StgInt64) - case bci_OP_S_LT_64: SIZED_BIN_OP_TY_TY_INT(<, StgInt64) - case bci_OP_S_LE_64: SIZED_BIN_OP_TY_TY_INT(<=, StgInt64) - - case bci_OP_NOT_64: UN_SIZED_OP(~, StgWord64) - case bci_OP_NEG_64: UN_SIZED_OP(-, StgInt64) - - - case bci_OP_ADD_32: SIZED_BIN_OP(+, StgInt32) - case bci_OP_SUB_32: SIZED_BIN_OP(-, StgInt32) - case bci_OP_AND_32: SIZED_BIN_OP(&, StgInt32) - case bci_OP_XOR_32: SIZED_BIN_OP(^, StgInt32) - case bci_OP_OR_32: SIZED_BIN_OP(|, StgInt32) - case bci_OP_MUL_32: SIZED_BIN_OP(*, StgInt32) - case bci_OP_SHL_32: SIZED_BIN_OP_TY_INT(<<, StgWord32) - case bci_OP_LSR_32: SIZED_BIN_OP_TY_INT(>>, StgWord32) - case bci_OP_ASR_32: SIZED_BIN_OP_TY_INT(>>, StgInt32) - - case bci_OP_NEQ_32: SIZED_BIN_OP_TY_TY_INT(!=, StgWord32) - case bci_OP_EQ_32: SIZED_BIN_OP_TY_TY_INT(==, StgWord32) - case bci_OP_U_GT_32: SIZED_BIN_OP_TY_TY_INT(>, StgWord32) - case bci_OP_U_GE_32: SIZED_BIN_OP_TY_TY_INT(>=, StgWord32) - case bci_OP_U_LT_32: SIZED_BIN_OP_TY_TY_INT(<, StgWord32) - case bci_OP_U_LE_32: SIZED_BIN_OP_TY_TY_INT(<=, StgWord32) - - case bci_OP_S_GT_32: SIZED_BIN_OP_TY_TY_INT(>, StgInt32) - case bci_OP_S_GE_32: SIZED_BIN_OP_TY_TY_INT(>=, StgInt32) - case bci_OP_S_LT_32: SIZED_BIN_OP_TY_TY_INT(<, StgInt32) - case bci_OP_S_LE_32: SIZED_BIN_OP_TY_TY_INT(<=, StgInt32) - - case bci_OP_NOT_32: UN_SIZED_OP(~, StgWord32) - case bci_OP_NEG_32: UN_SIZED_OP(-, StgInt32) - - - case bci_OP_ADD_16: SIZED_BIN_OP(+, StgInt16) - case bci_OP_SUB_16: SIZED_BIN_OP(-, StgInt16) - case bci_OP_AND_16: SIZED_BIN_OP(&, StgInt16) - case bci_OP_XOR_16: SIZED_BIN_OP(^, StgInt16) - case bci_OP_OR_16: SIZED_BIN_OP(|, StgInt16) - case bci_OP_MUL_16: SIZED_BIN_OP(*, StgInt16) - case bci_OP_SHL_16: SIZED_BIN_OP_TY_INT(<<, StgWord16) - case bci_OP_LSR_16: SIZED_BIN_OP_TY_INT(>>, StgWord16) - case bci_OP_ASR_16: SIZED_BIN_OP_TY_INT(>>, StgInt16) - - case bci_OP_NEQ_16: SIZED_BIN_OP_TY_TY_INT(!=, StgWord16) - case bci_OP_EQ_16: SIZED_BIN_OP_TY_TY_INT(==, StgWord16) - case bci_OP_U_GT_16: SIZED_BIN_OP_TY_TY_INT(>, StgWord16) - case bci_OP_U_GE_16: SIZED_BIN_OP_TY_TY_INT(>=, StgWord16) - case bci_OP_U_LT_16: SIZED_BIN_OP_TY_TY_INT(<, StgWord16) - case bci_OP_U_LE_16: SIZED_BIN_OP_TY_TY_INT(<=, StgWord16) - - case bci_OP_S_GT_16: SIZED_BIN_OP(>, StgInt16) - case bci_OP_S_GE_16: SIZED_BIN_OP(>=, StgInt16) - case bci_OP_S_LT_16: SIZED_BIN_OP(<, StgInt16) - case bci_OP_S_LE_16: SIZED_BIN_OP(<=, StgInt16) - - case bci_OP_NOT_16: UN_SIZED_OP(~, StgWord16) - case bci_OP_NEG_16: UN_SIZED_OP(-, StgInt16) - - - case bci_OP_ADD_08: SIZED_BIN_OP(+, StgInt8) - case bci_OP_SUB_08: SIZED_BIN_OP(-, StgInt8) - case bci_OP_AND_08: SIZED_BIN_OP(&, StgInt8) - case bci_OP_XOR_08: SIZED_BIN_OP(^, StgInt8) - case bci_OP_OR_08: SIZED_BIN_OP(|, StgInt8) - case bci_OP_MUL_08: SIZED_BIN_OP(*, StgInt8) - case bci_OP_SHL_08: SIZED_BIN_OP_TY_INT(<<, StgWord8) - case bci_OP_LSR_08: SIZED_BIN_OP_TY_INT(>>, StgWord8) - case bci_OP_ASR_08: SIZED_BIN_OP_TY_INT(>>, StgInt8) - - case bci_OP_NEQ_08: SIZED_BIN_OP_TY_TY_INT(!=, StgWord8) - case bci_OP_EQ_08: SIZED_BIN_OP_TY_TY_INT(==, StgWord8) - case bci_OP_U_GT_08: SIZED_BIN_OP_TY_TY_INT(>, StgWord8) - case bci_OP_U_GE_08: SIZED_BIN_OP_TY_TY_INT(>=, StgWord8) - case bci_OP_U_LT_08: SIZED_BIN_OP_TY_TY_INT(<, StgWord8) - case bci_OP_U_LE_08: SIZED_BIN_OP_TY_TY_INT(<=, StgWord8) - - case bci_OP_S_GT_08: SIZED_BIN_OP_TY_TY_INT(>, StgInt8) - case bci_OP_S_GE_08: SIZED_BIN_OP_TY_TY_INT(>=, StgInt8) - case bci_OP_S_LT_08: SIZED_BIN_OP_TY_TY_INT(<, StgInt8) - case bci_OP_S_LE_08: SIZED_BIN_OP_TY_TY_INT(<=, StgInt8) - - case bci_OP_NOT_08: UN_SIZED_OP(~, StgWord8) - case bci_OP_NEG_08: UN_SIZED_OP(-, StgInt8) - - case bci_OP_INDEX_ADDR_64: + INSTRUCTION(bci_OP_ADD_64): SIZED_BIN_OP(+, StgInt64) + INSTRUCTION(bci_OP_SUB_64): SIZED_BIN_OP(-, StgInt64) + INSTRUCTION(bci_OP_AND_64): SIZED_BIN_OP(&, StgInt64) + INSTRUCTION(bci_OP_XOR_64): SIZED_BIN_OP(^, StgInt64) + INSTRUCTION(bci_OP_OR_64): SIZED_BIN_OP(|, StgInt64) + INSTRUCTION(bci_OP_MUL_64): SIZED_BIN_OP(*, StgInt64) + INSTRUCTION(bci_OP_SHL_64): SIZED_BIN_OP_TY_INT(<<, StgWord64) + INSTRUCTION(bci_OP_LSR_64): SIZED_BIN_OP_TY_INT(>>, StgWord64) + INSTRUCTION(bci_OP_ASR_64): SIZED_BIN_OP_TY_INT(>>, StgInt64) + + INSTRUCTION(bci_OP_NEQ_64): SIZED_BIN_OP_TY_TY_INT(!=, StgWord64) + INSTRUCTION(bci_OP_EQ_64): SIZED_BIN_OP_TY_TY_INT(==, StgWord64) + INSTRUCTION(bci_OP_U_GT_64): SIZED_BIN_OP_TY_TY_INT(>, StgWord64) + INSTRUCTION(bci_OP_U_GE_64): SIZED_BIN_OP_TY_TY_INT(>=, StgWord64) + INSTRUCTION(bci_OP_U_LT_64): SIZED_BIN_OP_TY_TY_INT(<, StgWord64) + INSTRUCTION(bci_OP_U_LE_64): SIZED_BIN_OP_TY_TY_INT(<=, StgWord64) + + INSTRUCTION(bci_OP_S_GT_64): SIZED_BIN_OP_TY_TY_INT(>, StgInt64) + INSTRUCTION(bci_OP_S_GE_64): SIZED_BIN_OP_TY_TY_INT(>=, StgInt64) + INSTRUCTION(bci_OP_S_LT_64): SIZED_BIN_OP_TY_TY_INT(<, StgInt64) + INSTRUCTION(bci_OP_S_LE_64): SIZED_BIN_OP_TY_TY_INT(<=, StgInt64) + + INSTRUCTION(bci_OP_NOT_64): UN_SIZED_OP(~, StgWord64) + INSTRUCTION(bci_OP_NEG_64): UN_SIZED_OP(-, StgInt64) + + + INSTRUCTION(bci_OP_ADD_32): SIZED_BIN_OP(+, StgInt32) + INSTRUCTION(bci_OP_SUB_32): SIZED_BIN_OP(-, StgInt32) + INSTRUCTION(bci_OP_AND_32): SIZED_BIN_OP(&, StgInt32) + INSTRUCTION(bci_OP_XOR_32): SIZED_BIN_OP(^, StgInt32) + INSTRUCTION(bci_OP_OR_32): SIZED_BIN_OP(|, StgInt32) + INSTRUCTION(bci_OP_MUL_32): SIZED_BIN_OP(*, StgInt32) + INSTRUCTION(bci_OP_SHL_32): SIZED_BIN_OP_TY_INT(<<, StgWord32) + INSTRUCTION(bci_OP_LSR_32): SIZED_BIN_OP_TY_INT(>>, StgWord32) + INSTRUCTION(bci_OP_ASR_32): SIZED_BIN_OP_TY_INT(>>, StgInt32) + + INSTRUCTION(bci_OP_NEQ_32): SIZED_BIN_OP_TY_TY_INT(!=, StgWord32) + INSTRUCTION(bci_OP_EQ_32): SIZED_BIN_OP_TY_TY_INT(==, StgWord32) + INSTRUCTION(bci_OP_U_GT_32): SIZED_BIN_OP_TY_TY_INT(>, StgWord32) + INSTRUCTION(bci_OP_U_GE_32): SIZED_BIN_OP_TY_TY_INT(>=, StgWord32) + INSTRUCTION(bci_OP_U_LT_32): SIZED_BIN_OP_TY_TY_INT(<, StgWord32) + INSTRUCTION(bci_OP_U_LE_32): SIZED_BIN_OP_TY_TY_INT(<=, StgWord32) + + INSTRUCTION(bci_OP_S_GT_32): SIZED_BIN_OP_TY_TY_INT(>, StgInt32) + INSTRUCTION(bci_OP_S_GE_32): SIZED_BIN_OP_TY_TY_INT(>=, StgInt32) + INSTRUCTION(bci_OP_S_LT_32): SIZED_BIN_OP_TY_TY_INT(<, StgInt32) + INSTRUCTION(bci_OP_S_LE_32): SIZED_BIN_OP_TY_TY_INT(<=, StgInt32) + + INSTRUCTION(bci_OP_NOT_32): UN_SIZED_OP(~, StgWord32) + INSTRUCTION(bci_OP_NEG_32): UN_SIZED_OP(-, StgInt32) + + + INSTRUCTION(bci_OP_ADD_16): SIZED_BIN_OP(+, StgInt16) + INSTRUCTION(bci_OP_SUB_16): SIZED_BIN_OP(-, StgInt16) + INSTRUCTION(bci_OP_AND_16): SIZED_BIN_OP(&, StgInt16) + INSTRUCTION(bci_OP_XOR_16): SIZED_BIN_OP(^, StgInt16) + INSTRUCTION(bci_OP_OR_16): SIZED_BIN_OP(|, StgInt16) + INSTRUCTION(bci_OP_MUL_16): SIZED_BIN_OP(*, StgInt16) + INSTRUCTION(bci_OP_SHL_16): SIZED_BIN_OP_TY_INT(<<, StgWord16) + INSTRUCTION(bci_OP_LSR_16): SIZED_BIN_OP_TY_INT(>>, StgWord16) + INSTRUCTION(bci_OP_ASR_16): SIZED_BIN_OP_TY_INT(>>, StgInt16) + + INSTRUCTION(bci_OP_NEQ_16): SIZED_BIN_OP_TY_TY_INT(!=, StgWord16) + INSTRUCTION(bci_OP_EQ_16): SIZED_BIN_OP_TY_TY_INT(==, StgWord16) + INSTRUCTION(bci_OP_U_GT_16): SIZED_BIN_OP_TY_TY_INT(>, StgWord16) + INSTRUCTION(bci_OP_U_GE_16): SIZED_BIN_OP_TY_TY_INT(>=, StgWord16) + INSTRUCTION(bci_OP_U_LT_16): SIZED_BIN_OP_TY_TY_INT(<, StgWord16) + INSTRUCTION(bci_OP_U_LE_16): SIZED_BIN_OP_TY_TY_INT(<=, StgWord16) + + INSTRUCTION(bci_OP_S_GT_16): SIZED_BIN_OP(>, StgInt16) + INSTRUCTION(bci_OP_S_GE_16): SIZED_BIN_OP(>=, StgInt16) + INSTRUCTION(bci_OP_S_LT_16): SIZED_BIN_OP(<, StgInt16) + INSTRUCTION(bci_OP_S_LE_16): SIZED_BIN_OP(<=, StgInt16) + + INSTRUCTION(bci_OP_NOT_16): UN_SIZED_OP(~, StgWord16) + INSTRUCTION(bci_OP_NEG_16): UN_SIZED_OP(-, StgInt16) + + + INSTRUCTION(bci_OP_ADD_08): SIZED_BIN_OP(+, StgInt8) + INSTRUCTION(bci_OP_SUB_08): SIZED_BIN_OP(-, StgInt8) + INSTRUCTION(bci_OP_AND_08): SIZED_BIN_OP(&, StgInt8) + INSTRUCTION(bci_OP_XOR_08): SIZED_BIN_OP(^, StgInt8) + INSTRUCTION(bci_OP_OR_08): SIZED_BIN_OP(|, StgInt8) + INSTRUCTION(bci_OP_MUL_08): SIZED_BIN_OP(*, StgInt8) + INSTRUCTION(bci_OP_SHL_08): SIZED_BIN_OP_TY_INT(<<, StgWord8) + INSTRUCTION(bci_OP_LSR_08): SIZED_BIN_OP_TY_INT(>>, StgWord8) + INSTRUCTION(bci_OP_ASR_08): SIZED_BIN_OP_TY_INT(>>, StgInt8) + + INSTRUCTION(bci_OP_NEQ_08): SIZED_BIN_OP_TY_TY_INT(!=, StgWord8) + INSTRUCTION(bci_OP_EQ_08): SIZED_BIN_OP_TY_TY_INT(==, StgWord8) + INSTRUCTION(bci_OP_U_GT_08): SIZED_BIN_OP_TY_TY_INT(>, StgWord8) + INSTRUCTION(bci_OP_U_GE_08): SIZED_BIN_OP_TY_TY_INT(>=, StgWord8) + INSTRUCTION(bci_OP_U_LT_08): SIZED_BIN_OP_TY_TY_INT(<, StgWord8) + INSTRUCTION(bci_OP_U_LE_08): SIZED_BIN_OP_TY_TY_INT(<=, StgWord8) + + INSTRUCTION(bci_OP_S_GT_08): SIZED_BIN_OP_TY_TY_INT(>, StgInt8) + INSTRUCTION(bci_OP_S_GE_08): SIZED_BIN_OP_TY_TY_INT(>=, StgInt8) + INSTRUCTION(bci_OP_S_LT_08): SIZED_BIN_OP_TY_TY_INT(<, StgInt8) + INSTRUCTION(bci_OP_S_LE_08): SIZED_BIN_OP_TY_TY_INT(<=, StgInt8) + + INSTRUCTION(bci_OP_NOT_08): UN_SIZED_OP(~, StgWord8) + INSTRUCTION(bci_OP_NEG_08): UN_SIZED_OP(-, StgInt8) + + INSTRUCTION(bci_OP_INDEX_ADDR_64): { StgWord64* addr = (StgWord64*) SpW(0); StgInt offset = (StgInt) SpW(1); @@ -2736,35 +3060,35 @@ run_BCO: Sp_addW(1); } SpW64(0) = *(addr+offset); - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_OP_INDEX_ADDR_32: + INSTRUCTION(bci_OP_INDEX_ADDR_32): { StgWord32* addr = (StgWord32*) SpW(0); StgInt offset = (StgInt) SpW(1); Sp_addW(1); SpW(0) = (StgWord) *(addr+offset); - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_OP_INDEX_ADDR_16: + INSTRUCTION(bci_OP_INDEX_ADDR_16): { StgWord16* addr = (StgWord16*) SpW(0); StgInt offset = (StgInt) SpW(1); Sp_addW(1); SpW(0) = (StgWord) *(addr+offset); - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_OP_INDEX_ADDR_08: + INSTRUCTION(bci_OP_INDEX_ADDR_08): { StgWord8* addr = (StgWord8*) SpW(0); StgInt offset = (StgInt) SpW(1); Sp_addW(1); SpW(0) = (StgWord) *(addr+offset); - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_CCALL: { + INSTRUCTION(bci_CCALL): { void *tok; W_ stk_offset = BCO_GET_LARGE_ARG; int o_itbl = BCO_GET_LARGE_ARG; @@ -2921,25 +3245,33 @@ run_BCO: memcpy(Sp, ret, sizeof(W_) * ret_size); #endif - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_JMP: { + INSTRUCTION(bci_JMP): { /* BCO_NEXT modifies bciPtr, so be conservative. */ int nextpc = BCO_GET_LARGE_ARG; bciPtr = nextpc; - goto nextInsn; + NEXT_INSTRUCTION; } - case bci_CASEFAIL: + INSTRUCTION(bci_CASEFAIL): barf("interpretBCO: hit a CASEFAIL"); - // Errors + + +#if defined(COMPUTED_GOTO) + INSTRUCTION(bci_DEFAULT): + barf("interpretBCO: unknown or unimplemented opcode %d", + (int)(bci & 0xFF)); +#else + // Errors default: barf("interpretBCO: unknown or unimplemented opcode %d", (int)(bci & 0xFF)); - } /* switch on opcode */ +#endif + } } ===================================== rts/eventlog/EventLog.c ===================================== @@ -197,7 +197,7 @@ static inline void postBuf(EventsBuf *eb, const StgWord8 *buf, uint32_t size) static inline void postStringLen(EventsBuf *eb, const char *buf, StgWord len) { if (buf) { - ASSERT(eb->begin + eb->size > eb->pos + len + 1); + ASSERT(eb->pos + len + 1 <= eb->begin + eb->size); memcpy(eb->pos, buf, len); eb->pos += len; } ===================================== rts/gen_event_types.py ===================================== @@ -1,6 +1,7 @@ #!/usr/bin/env python # -*- coding: utf-8 -*- +from pathlib import Path from typing import List, Union, Dict from collections import namedtuple @@ -198,17 +199,17 @@ def generate_event_types_defines() -> str: def main() -> None: import argparse parser = argparse.ArgumentParser() - parser.add_argument('--event-types-array', type=argparse.FileType('w'), metavar='FILE') - parser.add_argument('--event-types-defines', type=argparse.FileType('w'), metavar='FILE') + parser.add_argument('--event-types-array', type=Path, metavar='FILE') + parser.add_argument('--event-types-defines', type=Path, metavar='FILE') args = parser.parse_args() check_events() if args.event_types_array: - args.event_types_array.write(generate_event_types_array()) + args.event_types_array.write_text(generate_event_types_array()) if args.event_types_defines: - args.event_types_defines.write(generate_event_types_defines()) + args.event_types_defines.write_text(generate_event_types_defines()) if __name__ == '__main__': main() ===================================== rts/include/rts/Bytecodes.h ===================================== @@ -23,6 +23,11 @@ I hope that's clear :-) */ +/* + Make sure to update jumptable in rts/Interpreter.c when modifying + bytecodes! See Note [Instruction dispatch in the bytecode interpreter] + for details. +*/ #define bci_STKCHECK 1 #define bci_PUSH_L 2 #define bci_PUSH_LL 3 ===================================== rts/rts.cabal ===================================== @@ -91,6 +91,9 @@ flag thread-sanitizer in @rts/include/rts/TSANUtils.h@. default: False manual: True +flag ubsan + default: False + manual: True library -- rts is a wired in package and @@ -200,6 +203,9 @@ library cc-options: -fsanitize=thread ld-options: -fsanitize=thread + if flag(ubsan) + ld-options: -fsanitize=undefined + if os(linux) -- the RTS depends upon libc. while this dependency is generally -- implicitly added by `cc`, we must explicitly add it here to ensure ===================================== testsuite/driver/runtests.py ===================================== @@ -83,7 +83,7 @@ parser.add_argument("--way", action="append", help="just this way") parser.add_argument("--skipway", action="append", help="skip this way") parser.add_argument("--threads", type=int, help="threads to run simultaneously") parser.add_argument("--verbose", type=int, choices=[0,1,2,3,4,5], help="verbose (Values 0 through 5 accepted)") -parser.add_argument("--junit", type=argparse.FileType('wb'), help="output testsuite summary in JUnit format") +parser.add_argument("--junit", type=Path, help="output testsuite summary in JUnit format") parser.add_argument("--broken-test", action="append", default=[], help="a test name to mark as broken for this run") parser.add_argument("--test-env", default='local', help="Override default chosen test-env.") parser.add_argument("--perf-baseline", type=GitRef, metavar='COMMIT', help="Baseline commit for performance comparsons.") @@ -91,7 +91,7 @@ perf_group.add_argument("--skip-perf-tests", action="store_true", help="skip per perf_group.add_argument("--only-perf-tests", action="store_true", help="Only do performance tests") parser.add_argument("--ignore-perf-failures", choices=['increases','decreases','all'], help="Do not fail due to out-of-tolerance perf tests") -parser.add_argument("--only-report-hadrian-deps", type=argparse.FileType('w'), +parser.add_argument("--only-report-hadrian-deps", type=Path, help="Dry run the testsuite and report all extra hadrian dependencies needed on the given file") args = parser.parse_args() @@ -615,14 +615,14 @@ else: summary(t, f) if args.junit: - junit(t).write(args.junit) - args.junit.close() + with args.junit.open("wb") as f: + junit(t).write(f) if config.only_report_hadrian_deps: print("WARNING - skipping all tests and only reporting required hadrian dependencies:", config.hadrian_deps) - for d in config.hadrian_deps: - print(d,file=config.only_report_hadrian_deps) - config.only_report_hadrian_deps.close() + with config.only_report_hadrian_deps.open("w") as f: + for d in config.hadrian_deps: + print(d, file=f) if len(t.unexpected_failures) > 0 or \ len(t.unexpected_stat_failures) > 0 or \ ===================================== testsuite/tests/driver/T24120.hs ===================================== @@ -0,0 +1,5 @@ +-- | This should not issue an @-Wunused-packages@ warning for @system-cxx-std-lib@. +module Main where + +main :: IO () +main = putStrLn "hello world" ===================================== testsuite/tests/driver/all.T ===================================== @@ -331,3 +331,4 @@ test('T24839', [unless(arch('x86_64') or arch('aarch64'), skip), extra_files(["t test('t25150', [extra_files(["t25150"])], multimod_compile, ['Main.hs', '-v0 -working-dir t25150/dir a.c']) test('T25382', normal, makefile_test, []) test('T26018', req_c, makefile_test, []) +test('T24120', normal, compile, ['-Wunused-packages -hide-all-packages -package base -package system-cxx-std-lib']) View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ea3a58d23c89b00c48cfb3906abdd38... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ea3a58d23c89b00c48cfb3906abdd38... You're receiving this email because of your account on gitlab.haskell.org.
participants (1)
-
Cheng Shao (＠TerrorJack)