June 2025 - ghc-commits

[Git][ghc/ghc][wip/T130103] rts/linker/LoadArchive: Don't rely on file extensions for identification
by Ben Gamari (＠bgamari) 16 Jun '25

16 Jun '25

Ben Gamari pushed to branch wip/T130103 at Glasgow Haskell Compiler / GHC Commits: d36dbc7b by Ben Gamari at 2025-06-16T16:41:22-04:00 rts/linker/LoadArchive: Don't rely on file extensions for identification Previously archive members would be identified via their file extension, as described in #13103. We now instead use a more principled approach, relying on the magic number in the member's header. As well, we refactor treatment of archive format detection to improve code clarity and error handling. Closes #13103. - - - - - 1 changed file: - rts/linker/LoadArchive.c Changes: ===================================== rts/linker/LoadArchive.c ===================================== @@ -33,6 +33,7 @@ #define DEBUG_LOG(...) IF_DEBUG(linker, debugBelch("loadArchive: " __VA_ARGS__)) + #if defined(darwin_HOST_OS) || defined(ios_HOST_OS) /* Read 4 bytes and convert to host byte order */ static uint32_t read4Bytes(const char buf[static 4]) @@ -40,7 +41,7 @@ static uint32_t read4Bytes(const char buf[static 4]) return ntohl(*(uint32_t*)buf); } -static bool loadFatArchive(char tmp[static 20], FILE* f, pathchar* path) +static bool loadFatArchive(char input[static 20], FILE* f, pathchar* path) { uint32_t nfat_arch, nfat_offset, cputype, cpusubtype; #if defined(i386_HOST_ARCH) @@ -58,8 +59,9 @@ static bool loadFatArchive(char tmp[static 20], FILE* f, pathchar* path) #error Unknown Darwin architecture #endif - nfat_arch = read4Bytes(tmp + 4); + nfat_arch = read4Bytes(input + 4); DEBUG_LOG("found a fat archive containing %d architectures\n", nfat_arch); + char tmp[20]; nfat_offset = 0; for (uint32_t i = 0; i < nfat_arch; i++) { /* search for the right arch */ @@ -108,7 +110,48 @@ static bool loadFatArchive(char tmp[static 20], FILE* f, pathchar* path) } #endif -static StgBool readThinArchiveMember(int n, int memberSize, pathchar* path, +enum ObjectFileFormat { + NotObject, + COFFAmd64, + COFFI386, + COFFAArch64, + ELF, + MachO32, + MachO64, +}; + +static enum ObjectFileFormat identifyObjectFile_(char* buf, size_t sz) +{ + if (sz > 2 && ((uint16_t*)buf)[0] == 0x8664) { + return COFFAmd64; + } + if (sz > 2 && ((uint16_t*)buf)[0] == 0x014c) { + return COFFI386; + } + if (sz > 2 && ((uint16_t*)buf)[0] == 0xaa64) { + return COFFAArch64; + } + if (sz > 4 && memcmp(buf, "\x7f" "ELF", 4) == 0) { + return ELF; + } + if (sz > 4 && ((uint32_t*)buf)[0] == 0xfeedface) { + return MachO32; + } + if (sz > 4 && ((uint32_t*)buf)[0] == 0xfeedfacf) { + return MachO64; + } + return NotObject; +} + +static enum ObjectFileFormat identifyObjectFile(FILE *f) +{ + char buf[32]; + ssize_t sz = fread(buf, 1, 32, f); + CHECK(fseek(f, -sz, SEEK_CUR) == 0); + return identifyObjectFile_(buf, sz); +} + +static bool readThinArchiveMember(int n, int memberSize, pathchar* path, char* fileName, char* image) { bool has_succeeded = false; @@ -149,7 +192,7 @@ inner_fail: return has_succeeded; } -static bool checkFatArchive(char magic[static 20], FILE* f, pathchar* path) +static bool checkFatArchive(char magic[static 4], FILE* f, pathchar* path) { bool success = false; #if defined(darwin_HOST_OS) || defined(ios_HOST_OS) @@ -241,46 +284,21 @@ lookupGNUArchiveIndex(int gnuFileIndexSize, char **fileName_, return true; } -HsInt loadArchive_ (pathchar *path) -{ - char *image = NULL; - HsInt retcode = 0; - int memberSize; - int memberIdx = 0; - FILE *f = NULL; - int n; - size_t thisFileNameSize = (size_t)-1; /* shut up bogus GCC warning */ - char *fileName; - size_t fileNameSize; - bool isGnuIndex, isThin, isImportLib; - char *gnuFileIndex; - int gnuFileIndexSize; - int misalignment = 0; - - DEBUG_LOG("start\n"); - DEBUG_LOG("Loading archive `%" PATH_FMT "'\n", path); +enum ArchiveFormat { + StandardArchive, + ThinArchive, + FatArchive, +}; - /* Check that we haven't already loaded this archive. - Ignore requests to load multiple times */ - if (isAlreadyLoaded(path)) { - IF_DEBUG(linker, - debugBelch("ignoring repeated load of %" PATH_FMT "\n", path)); - return 1; /* success */ +static bool identifyArchiveFormat(FILE *f, pathchar *path, enum ArchiveFormat *out) +{ + char tmp[8]; + size_t n = fread(tmp, 1, 8, f); + if (n != 8) { + errorBelch("loadArchive: Failed reading header from `%" PATH_FMT "'", path); \ + return false; } - gnuFileIndex = NULL; - gnuFileIndexSize = 0; - - fileNameSize = 32; - fileName = stgMallocBytes(fileNameSize, "loadArchive(fileName)"); - - isThin = false; - isImportLib = false; - - f = pathopen(path, WSTR("rb")); - if (!f) - FAIL("loadObj: can't read `%" PATH_FMT "'", path); - /* Check if this is an archive by looking for the magic "!<arch>\n" * string. Usually, if this fails, we belch an error and return. On * Darwin however, we may have a fat archive, which contains archives for @@ -299,12 +317,10 @@ HsInt loadArchive_ (pathchar *path) * its magic "!<arch>\n" string and continue processing just as if * we had a single architecture archive. */ - - n = fread ( tmp, 1, 8, f ); - if (n != 8) { - FAIL("Failed reading header from `%" PATH_FMT "'", path); + if (strncmp(tmp, "!<arch>\n", 8) == 0) { + *out = StandardArchive; + return true; } - if (strncmp(tmp, "!<arch>\n", 8) == 0) {} /* Check if this is a thin archive by looking for the magic string "!<thin>\n" * * ar thin libraries have the exact same format as normal archives except they @@ -321,16 +337,59 @@ HsInt loadArchive_ (pathchar *path) * */ else if (strncmp(tmp, "!<thin>\n", 8) == 0) { - isThin = true; + *out = ThinArchive; + return true; } else { bool success = checkFatArchive(tmp, f, path); - if (!success) - goto fail; + if (!success) { + return false; + } + *out = FatArchive; + return true; + } +} + +HsInt loadArchive_ (pathchar *path) +{ + char *image = NULL; + HsInt retcode = 0; + int memberIdx = 0; + FILE *f = NULL; + size_t thisFileNameSize = (size_t) -1; /* shut up bogus GCC warning */ + int misalignment = 0; + + DEBUG_LOG("start\n"); + DEBUG_LOG("Loading archive `%" PATH_FMT "'\n", path); + + /* Check that we haven't already loaded this archive. + Ignore requests to load multiple times */ + if (isAlreadyLoaded(path)) { + IF_DEBUG(linker, + debugBelch("ignoring repeated load of %" PATH_FMT "\n", path)); + return 1; /* success */ } + + char *gnuFileIndex = NULL; + int gnuFileIndexSize = 0; + + size_t fileNameSize = 32; + char *fileName = stgMallocBytes(fileNameSize, "loadArchive(fileName)"); + + f = pathopen(path, WSTR("rb")); + if (!f) + FAIL("loadObj: can't read `%" PATH_FMT "'", path); + + enum ArchiveFormat archive_fmt; + if (!identifyArchiveFormat(f, path, &archive_fmt)) { + FAIL("failed to identify archive format of %" PATH_FMT ".", path); + } + bool isThin = archive_fmt == ThinArchive; + DEBUG_LOG("loading archive contents\n"); while (1) { + size_t n; DEBUG_LOG("reading at %ld\n", ftell(f)); n = fread ( fileName, 1, 16, f ); if (n != 16) { @@ -350,6 +409,7 @@ HsInt loadArchive_ (pathchar *path) } #endif + char tmp[32]; n = fread ( tmp, 1, 12, f ); if (n != 12) FAIL("Failed reading mod time from `%" PATH_FMT "'", path); @@ -368,9 +428,16 @@ HsInt loadArchive_ (pathchar *path) tmp[10] = '\0'; for (n = 0; isdigit(tmp[n]); n++); tmp[n] = '\0'; - memberSize = atoi(tmp); + size_t memberSize; + { + char *end; + memberSize = strtol(tmp, &end, 10); + if (tmp == end) { + FAIL("Failed to decode member size"); + } + } - DEBUG_LOG("size of this archive member is %d\n", memberSize); + DEBUG_LOG("size of this archive member is %zd\n", memberSize); n = fread ( tmp, 1, 2, f ); if (n != 2) FAIL("Failed reading magic from `%" PATH_FMT "'", path); @@ -378,7 +445,7 @@ HsInt loadArchive_ (pathchar *path) FAIL("Failed reading magic from `%" PATH_FMT "' at %ld. Got %c%c", path, ftell(f), tmp[0], tmp[1]); - isGnuIndex = false; + bool isGnuIndex = false; /* Check for BSD-variant large filenames */ if (0 == strncmp(fileName, "#1/", 3)) { size_t n = 0; @@ -459,12 +526,7 @@ HsInt loadArchive_ (pathchar *path) DEBUG_LOG("Found member file `%s'\n", fileName); - /* TODO: Stop relying on file extensions to determine input formats. - Instead try to match file headers. See #13103. */ - isObject = (thisFileNameSize >= 2 && strncmp(fileName + thisFileNameSize - 2, ".o" , 2) == 0) - || (thisFileNameSize >= 3 && strncmp(fileName + thisFileNameSize - 3, ".lo" , 3) == 0) - || (thisFileNameSize >= 4 && strncmp(fileName + thisFileNameSize - 4, ".p_o", 4) == 0) - || (thisFileNameSize >= 4 && strncmp(fileName + thisFileNameSize - 4, ".obj", 4) == 0); + enum ObjectFileFormat object_fmt = identifyObjectFile(f); #if defined(OBJFORMAT_PEi386) /* @@ -478,13 +540,15 @@ HsInt loadArchive_ (pathchar *path) * * Linker members (e.g. filename / are skipped since they are not needed) */ - isImportLib = thisFileNameSize >= 4 && strncmp(fileName + thisFileNameSize - 4, ".dll", 4) == 0; + bool isImportLib = thisFileNameSize >= 4 && strncmp(fileName + thisFileNameSize - 4, ".dll", 4) == 0; +#else + bool isImportLib = false; #endif // windows DEBUG_LOG("\tthisFileNameSize = %d\n", (int)thisFileNameSize); - DEBUG_LOG("\tisObject = %d\n", isObject); + DEBUG_LOG("\tisObject = %d\n", object_fmt); - if (isObject) { + if (object_fmt != NotObject) { DEBUG_LOG("Member is an object file...loading...\n"); #if defined(darwin_HOST_OS) || defined(ios_HOST_OS) @@ -509,7 +573,7 @@ HsInt loadArchive_ (pathchar *path) } else { - n = fread ( image, 1, memberSize, f ); + size_t n = fread ( image, 1, memberSize, f ); if (n != memberSize) { FAIL("error whilst reading `%" PATH_FMT "'", path); } @@ -527,9 +591,11 @@ HsInt loadArchive_ (pathchar *path) ObjectCode *oc = mkOc(STATIC_OBJECT, path, image, memberSize, false, archiveMemberName, misalignment); #if defined(OBJFORMAT_MACHO) + ASSERT(object_fmt == MachO32 || object_fmt == MachO64); ocInit_MachO( oc ); #endif #if defined(OBJFORMAT_ELF) + ASSERT(object_fmt == ELF); ocInit_ELF( oc ); #endif @@ -574,7 +640,7 @@ while reading filename from `%" PATH_FMT "'", path); "Skipping...\n"); n = fseek(f, memberSize, SEEK_CUR); if (n != 0) - FAIL("error whilst seeking by %d in `%" PATH_FMT "'", + FAIL("error whilst seeking by %zd in `%" PATH_FMT "'", memberSize, path); } #endif @@ -585,7 +651,7 @@ while reading filename from `%" PATH_FMT "'", path); if (!isThin || thisFileNameSize == 0) { n = fseek(f, memberSize, SEEK_CUR); if (n != 0) - FAIL("error whilst seeking by %d in `%" PATH_FMT "'", + FAIL("error whilst seeking by %zd in `%" PATH_FMT "'", memberSize, path); } } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d36dbc7b0723eb30ab08ffb9a3c357a… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d36dbc7b0723eb30ab08ffb9a3c357a… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/az/ghc-cpp] 134 commits: Revert "Specialise: Don't float out constraint components."
by Alan Zimmerman (＠alanz) 16 Jun '25

16 Jun '25

Alan Zimmerman pushed to branch wip/az/ghc-cpp at Glasgow Haskell Compiler / GHC Commits: c7aa0c10 by Andreas Klebinger at 2025-06-15T05:47:24-04:00 Revert "Specialise: Don't float out constraint components." This reverts commit c9abb87ccc0c91cd94f42b3e36270158398326ef. Turns out two benchmarks from #19747 regresses by a factor of 7-8x if we do not float those out. - - - - - fd998679 by Krzysztof Gogolewski at 2025-06-15T05:48:06-04:00 Fix EPT enforcement when mixing unboxed tuples and non-tuples The code was assuming that an alternative cannot be returning a normal datacon and an unboxed tuple at the same time. However, as seen in #26107, this can happen when using a GADT to refine the representation type. The solution is just to conservatively return TagDunno. - - - - - b5ca0c88 by Alan Zimmerman at 2025-06-16T20:38:12+01:00 GHC-CPP: first rough proof of concept Processes #define FOO #ifdef FOO x = 1 #endif Into [ITcppIgnored [L loc ITcppDefine] ,ITcppIgnored [L loc ITcppIfdef] ,ITvarid "x" ,ITequal ,ITinteger (IL {il_text = SourceText "1", il_neg = False, il_value = 1}) ,ITcppIgnored [L loc ITcppEndif] ,ITeof] In time, ITcppIgnored will be pushed into a comment - - - - - b482283e by Alan Zimmerman at 2025-06-16T20:38:12+01:00 Tidy up before re-visiting the continuation mechanic - - - - - 80712c0e by Alan Zimmerman at 2025-06-16T20:38:12+01:00 Switch preprocessor to continuation passing style Proof of concept, needs tidying up - - - - - 07b957e3 by Alan Zimmerman at 2025-06-16T20:38:12+01:00 Small cleanup - - - - - db0af5e7 by Alan Zimmerman at 2025-06-16T20:38:12+01:00 Get rid of some cruft - - - - - 4cc48e6e by Alan Zimmerman at 2025-06-16T20:38:12+01:00 Starting to integrate. Need to get the pragma recognised and set - - - - - 296e5e2c by Alan Zimmerman at 2025-06-16T20:38:12+01:00 Make cppTokens extend to end of line, and process CPP comments - - - - - f7f3ce71 by Alan Zimmerman at 2025-06-16T20:38:12+01:00 Remove unused ITcppDefined - - - - - c6334d99 by Alan Zimmerman at 2025-06-16T20:38:12+01:00 Allow spaces between # and keyword for preprocessor directive - - - - - 5d2cf958 by Alan Zimmerman at 2025-06-16T20:38:12+01:00 Process CPP continuation lines They are emited as separate ITcppContinue tokens. Perhaps the processing should be more like a comment, and keep on going to the end. BUT, the last line needs to be slurped as a whole. - - - - - 5055fa9b by Alan Zimmerman at 2025-06-16T20:38:12+01:00 Accumulate CPP continuations, process when ready Can be simplified further, we only need one CPP token - - - - - e3897801 by Alan Zimmerman at 2025-06-16T20:38:12+01:00 Simplify Lexer interface. Only ITcpp We transfer directive lines through it, then parse them from scratch in the preprocessor. - - - - - 75e311e4 by Alan Zimmerman at 2025-06-16T20:38:12+01:00 Deal with directive on last line, with no trailing \n - - - - - 70d337da by Alan Zimmerman at 2025-06-16T20:38:12+01:00 Start parsing and processing the directives - - - - - a3b0ecef by Alan Zimmerman at 2025-06-16T20:38:12+01:00 Prepare for processing include files - - - - - 4cd02936 by Alan Zimmerman at 2025-06-16T20:38:12+01:00 Move PpState into PreProcess And initParserState, initPragState too - - - - - 13ee850c by Alan Zimmerman at 2025-06-16T20:38:12+01:00 Process nested include files Also move PpState out of Lexer.x, so it is easy to evolve it in a ghci session, loading utils/check-cpp/Main.hs - - - - - ffe2b0af by Alan Zimmerman at 2025-06-16T20:38:12+01:00 Split into separate files - - - - - f647d882 by Alan Zimmerman at 2025-06-16T20:38:12+01:00 Starting on expression parser. But it hangs. Time for Text.Parsec.Expr - - - - - cb585d46 by Alan Zimmerman at 2025-06-16T20:38:12+01:00 Start integrating the ghc-cpp work From https://github.com/alanz/ghc-cpp - - - - - fd7abae4 by Alan Zimmerman at 2025-06-16T20:38:12+01:00 WIP - - - - - 66d50496 by Alan Zimmerman at 2025-06-16T20:38:12+01:00 Fixup after rebase - - - - - bd0cf83e by Alan Zimmerman at 2025-06-16T20:38:13+01:00 WIP - - - - - ce97a77a by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Fixup after rebase, including all tests pass - - - - - f4e72bb6 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Change pragma usage to GHC_CPP from GhcCPP - - - - - dc8065ab by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Some comments - - - - - 94302aa7 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Reformat - - - - - 6be65f82 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Delete unused file - - - - - ebf647b3 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Rename module Parse to ParsePP - - - - - d05ee980 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Clarify naming in the parser - - - - - 2826c91f by Alan Zimmerman at 2025-06-16T20:38:13+01:00 WIP. Switching to alex/happy to be able to work in-tree Since Parsec is not available - - - - - b64334d2 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Layering is now correct - GHC lexer, emits CPP tokens - accumulated in Preprocessor state - Lexed by CPP lexer, CPP command extracted, tokens concated with spaces (to get rid of token pasting via comments) - if directive lexed and parsed by CPP lexer/parser, and evaluated - - - - - 0a9b98c2 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 First example working Loading Example1.hs into ghci, getting the right results ``` {-# LANGUAGE GHC_CPP #-} module Example1 where y = 3 x = "hello" "bye now" foo = putStrLn x ``` - - - - - c3a49825 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Rebase, and all tests pass except whitespace for generated parser - - - - - 02336e80 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 More plumbing. Ready for testing tomorrow. - - - - - bc3631a6 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Proress. Renamed module State from Types And at first blush it seems to handle preprocessor scopes properly. - - - - - a8ea5ef7 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Insert basic GHC version macros into parser __GLASGOW_HASKELL__ __GLASGOW_HASKELL_FULL_VERSION__ __GLASGOW_HASKELL_PATCHLEVEL1__ __GLASGOW_HASKELL_PATCHLEVEL2__ - - - - - af18730b by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Re-sync check-cpp for easy ghci work - - - - - d62d4831 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Get rid of warnings - - - - - b4b90037 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Rework macro processing, in check-cpp Macros kept at the top level, looked up via name, multiple arity versions per name can be stored - - - - - 1145ab9c by Alan Zimmerman at 2025-06-16T20:38:13+01:00 WIP. Can crack arguments for #define Next step it to crack out args in an expansion - - - - - 8948f255 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 WIP on arg parsing. - - - - - 5159fd45 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Progress. Still screwing up nested parens. - - - - - 5a25d711 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Seems to work, but has redundant code - - - - - 4d8a64f7 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Remove redundant code - - - - - d91aa75c by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Reformat - - - - - 031bbca4 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Expand args, single pass Still need to repeat until fixpoint - - - - - 3bfd1415 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Fixed point expansion - - - - - 2aeb7f75 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Sync the playground to compiler - - - - - 80ffa7a5 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Working on dumping the GHC_CPP result But We need to keep the BufSpan in a comment - - - - - d08260e2 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Keep BufSpan in queued comments in GHC.Parser.Lexer - - - - - bb1aece5 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Getting close to being able to print the combined tokens showing what is in and what is out - - - - - 1a4ec313 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 First implementation of dumpGhcCpp. Example output First dumps all macros in the state, then the source, showing which lines are in and which are out ------------------------------ - |#define FOO(A,B) A + B - |#define FOO(A,B,C) A + B + C - |#if FOO(1,FOO(3,4)) == 8 - |-- a comment |x = 1 - |#else - |x = 5 - |#endif - - - - - b7ba331a by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Clean up a bit - - - - - d09bfbdd by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Add -ddump-ghc-cpp option and a test based on it - - - - - 9589464e by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Restore Lexer.x rules, we need them for continuation lines - - - - - 5e0ed352 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Lexer.x: trying to sort out the span for continuations - We need to match on \n at the end of the line - We cannot simply back up for it - - - - - 28110495 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Inserts predefined macros. But does not dump properly Because the cpp tokens have a trailing newline - - - - - 9c153370 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Remove unnecessary LExer rules We *need* the ones that explicitly match to the end of the line. - - - - - 1dd59f35 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Generate correct span for ITcpp Dump now works, except we do not render trailing `\` for continuation lines. This is good enough for use in test output. - - - - - 7a53616e by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Reduce duplication in lexer - - - - - 1a5ca838 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Tweaks - - - - - 36990b03 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Insert min_version predefined macros into state The mechanism now works. Still need to flesh out the full set. - - - - - 4504494d by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Trying my alternative pragma syntax. It works, but dumpGhcCpp is broken, I suspect from the ITcpp token span update. - - - - - b5a4cd12 by Alan Zimmerman at 2025-06-16T20:38:13+01:00 Pragma extraction now works, with both CPP and GHC_CPP For the following {-# LANGUAGE CPP #-} #if __GLASGOW_HASKELL__ >= 913 {-# LANGUAGE GHC_CPP #-} #endif We will enable GHC_CPP only - - - - - 58ded48e by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Remove some tracing - - - - - eef78db8 by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Fix test exes for changes - - - - - 9a4be927 by Alan Zimmerman at 2025-06-16T20:38:14+01:00 For GHC_CPP tests, normalise config-time-based macros - - - - - 422ddcfe by Alan Zimmerman at 2025-06-16T20:38:14+01:00 WIP - - - - - 7786c86e by Alan Zimmerman at 2025-06-16T20:38:14+01:00 WIP again. What is wrong? - - - - - 8817c3d3 by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Revert to dynflags for normal not pragma lexing - - - - - 5905a1b6 by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Working on getting check-exact to work properly - - - - - 64ff3895 by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Passes CppCommentPlacement test - - - - - e2544f32 by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Starting on exact printing with GHC_CPP While overriding normal CPP - - - - - f7014dff by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Correctly store CPP ignored tokens as comments By populating the lexeme string in it, based on the bufpos - - - - - cbc9b1ba by Alan Zimmerman at 2025-06-16T20:38:14+01:00 WIP - - - - - 3a962f10 by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Simplifying - - - - - ef14d69f by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Update the active state logic - - - - - 15adf2cf by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Work the new logic into the mainline code - - - - - 72291b37 by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Process `defined` operator - - - - - e19c5b9b by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Manage lexer state while skipping tokens There is very intricate layout-related state used when lexing. If a CPP directive blanks out some tokens, store this state when the blanking starts, and restore it when they are no longer being blanked. - - - - - 04ca10e5 by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Track the last token buffer index, for ITCppIgnored We need to attach the source being skipped in an ITCppIgnored token. We cannot simply use its BufSpan as an index into the underlying StringBuffer as it counts unicode chars, not bytes. So we update the lexer state to store the starting StringBuffer location for the last token, and use the already-stored length to extract the correct portion of the StringBuffer being parsed. - - - - - 912e169a by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Process the ! operator in GHC_CPP expressions - - - - - 07272bdf by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Predefine a constant when GHC_CPP is being used. - - - - - d4834ef1 by Alan Zimmerman at 2025-06-16T20:38:14+01:00 WIP - - - - - b7f55fdd by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Skip lines directly in the lexer when required - - - - - 9c5a9abd by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Properly manage location when accepting tokens again - - - - - db5bc52a by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Seems to be working now, for Example9 - - - - - 65afd1eb by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Remove tracing - - - - - b92824d0 by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Fix parsing '*' in block comments Instead of replacing them with '-' - - - - - 8b1107d2 by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Keep the trailing backslash in a ITcpp token - - - - - 3c5b601c by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Deal with only enabling one section of a group. A group is an instance of a conditional introduced by #if/#ifdef/#ifndef, and ending at the final #endif, including intermediate #elsif sections - - - - - 8a8a30e9 by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Replace remaining identifiers with 0 when evaluating As per the spec - - - - - 7c517040 by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Snapshot before rebase - - - - - 4509470a by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Skip non-processed lines starting with # - - - - - 0b86582f by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Export generateMacros so we can use it in ghc-exactprint - - - - - d18db291 by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Fix rebase - - - - - 7c67cb7e by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Expose initParserStateWithMacrosString - - - - - e5bf75a2 by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Fix buggy lexer cppSkip It was skipping all lines, not just ones prefixed by # - - - - - ab732d3d by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Fix evaluation of && to use the correct operator - - - - - 91fd6476 by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Deal with closing #-} at the start of a line - - - - - 58b9fff9 by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Add the MIN_VERSION_GLASGOW_HASKELL predefined macro - - - - - 958c9c1e by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Include MIN_VERSION_GLASGOW_HASKELL in GhcCpp01.stderr - - - - - b1d22df4 by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Use a strict map for macro defines - - - - - 34e98c1a by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Process TIdentifierLParen Which only matters at the start of #define - - - - - ca1afb10 by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Do not provide TIdentifierLParen paren twice - - - - - 6fdd89cd by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Handle whitespace between identifier and '(' for directive only - - - - - da0b00d7 by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Expose some Lexer bitmap manipulation helpers - - - - - 2a3424de by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Deal with line pragmas as tokens Blows up for dumpGhcCpp though - - - - - 534d6adb by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Allow strings delimited by a single quote too - - - - - 426b93e3 by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Allow leading whitespace on cpp directives As per https://timsong-cpp.github.io/cppwp/n4140/cpp#1 - - - - - 7c006ee0 by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Implement GHC_CPP undef - - - - - 7a6e0968 by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Sort out expansion of no-arg macros, in a context with args And make the expansion bottom out, in the case of recursion - - - - - 644688a3 by Alan Zimmerman at 2025-06-16T20:38:14+01:00 Fix GhcCpp01 test The LINE pragma stuff works in ghc-exactprint when specifically setting flag to emit ITline_pragma tokens - - - - - a84dbda6 by Alan Zimmerman at 2025-06-16T20:38:15+01:00 Process comments in CPP directives - - - - - 3290096a by Alan Zimmerman at 2025-06-16T20:38:15+01:00 Correctly lex pragmas with finel #-} on a newline - - - - - 6ee54c72 by Alan Zimmerman at 2025-06-16T20:38:15+01:00 Do not process CPP-style comments - - - - - f069ba96 by Alan Zimmerman at 2025-06-16T20:38:15+01:00 Allow cpp-style comments when GHC_CPP enabled - - - - - a512ecd3 by Alan Zimmerman at 2025-06-16T20:38:15+01:00 Return other pragmas as cpp ignored when GHC_CPP active - - - - - c1a8d61d by Alan Zimmerman at 2025-06-16T20:38:15+01:00 Fix exactprinting default decl - - - - - 86f72f62 by Alan Zimmerman at 2025-06-16T20:38:15+01:00 Reorganise getOptionsFromFile for use in ghc-exactprint We want to be able to inject predefined macro definitions into the parser preprocessor state for when we do a hackage roundtrip. - - - - - 027e2bbd by Alan Zimmerman at 2025-06-16T20:38:15+01:00 Tweak testing - - - - - 8d0ec8bf by Alan Zimmerman at 2025-06-16T20:38:15+01:00 Only allow unknown cpp pragmas with # in left margin - - - - - 305edf29 by Alan Zimmerman at 2025-06-16T20:38:15+01:00 Require # against left margin for all GHC_CPP directives - - - - - 0ab61528 by Alan Zimmerman at 2025-06-16T20:38:15+01:00 Fix CPP directives appearing in pragmas And add a test for error reporting for missing `#if` - - - - - 56c4a318 by Alan Zimmerman at 2025-06-16T20:38:15+01:00 Starting to report GHC_CPP errors using GHC machinery - - - - - 48cf8287 by Alan Zimmerman at 2025-06-16T20:38:15+01:00 More GHC_CPP diagnostic results - - - - - f0aa3567 by Alan Zimmerman at 2025-06-16T20:38:15+01:00 WIP on converting error calls to GHC diagnostics in GHC_CPP - - - - - 920f7123 by Alan Zimmerman at 2025-06-16T20:38:15+01:00 Working on CPP diagnostic reporting - - - - - 901f0917 by Alan Zimmerman at 2025-06-16T20:38:15+01:00 Tweak some tests/lint warnings - - - - - d0248398 by Alan Zimmerman at 2025-06-16T20:38:15+01:00 More error reporting in Macro - - - - - 2c39a131 by Alan Zimmerman at 2025-06-16T20:38:15+01:00 Some cleanups - - - - - 88 changed files: - compiler/GHC.hs - compiler/GHC/Cmm/Lexer.x - compiler/GHC/Cmm/Parser.y - compiler/GHC/Cmm/Parser/Monad.hs - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Driver/Backpack.hs - compiler/GHC/Driver/Config/Parser.hs - compiler/GHC/Driver/Downsweep.hs - compiler/GHC/Driver/Flags.hs - compiler/GHC/Driver/Main.hs - compiler/GHC/Driver/Pipeline.hs - compiler/GHC/Driver/Pipeline/Execute.hs - compiler/GHC/Driver/Session.hs - compiler/GHC/Parser.hs-boot - compiler/GHC/Parser.y - compiler/GHC/Parser/Annotation.hs - compiler/GHC/Parser/Errors/Ppr.hs - compiler/GHC/Parser/Errors/Types.hs - compiler/GHC/Parser/HaddockLex.x - compiler/GHC/Parser/Header.hs - compiler/GHC/Parser/Lexer.x - compiler/GHC/Parser/PostProcess.hs - compiler/GHC/Parser/PostProcess/Haddock.hs - + compiler/GHC/Parser/PreProcess.hs - + compiler/GHC/Parser/PreProcess/Eval.hs - + compiler/GHC/Parser/PreProcess/Lexer.x - + compiler/GHC/Parser/PreProcess/Macro.hs - + compiler/GHC/Parser/PreProcess/ParsePP.hs - + compiler/GHC/Parser/PreProcess/Parser.y - + compiler/GHC/Parser/PreProcess/ParserM.hs - + compiler/GHC/Parser/PreProcess/State.hs - compiler/GHC/Parser/Utils.hs - compiler/GHC/Stg/EnforceEpt/Types.hs - compiler/GHC/SysTools/Cpp.hs - compiler/GHC/Types/Error/Codes.hs - compiler/ghc.cabal.in - docs/users_guide/debugging.rst - ghc/GHCi/UI.hs - hadrian/src/Rules/SourceDist.hs - hadrian/stack.yaml.lock - libraries/ghc-internal/src/GHC/Internal/LanguageExtensions.hs - testsuite/tests/count-deps/CountDepsParser.stdout - testsuite/tests/driver/T4437.hs - testsuite/tests/ghc-api/T11579.hs - + testsuite/tests/ghc-cpp/GhcCpp01.hs - + testsuite/tests/ghc-cpp/GhcCpp01.stderr - + testsuite/tests/ghc-cpp/GhcCpp02.hs - + testsuite/tests/ghc-cpp/GhcCpp02.stderr - + testsuite/tests/ghc-cpp/all.T - testsuite/tests/interface-stability/template-haskell-exports.stdout - + testsuite/tests/printer/CppCommentPlacement.hs - + testsuite/tests/rep-poly/T26107.hs - testsuite/tests/rep-poly/all.T - + utils/check-cpp/.ghci - + utils/check-cpp/.gitignore - + utils/check-cpp/Eval.hs - + utils/check-cpp/Example1.hs - + utils/check-cpp/Example10.hs - + utils/check-cpp/Example11.hs - + utils/check-cpp/Example12.hs - + utils/check-cpp/Example13.hs - + utils/check-cpp/Example2.hs - + utils/check-cpp/Example3.hs - + utils/check-cpp/Example4.hs - + utils/check-cpp/Example5.hs - + utils/check-cpp/Example6.hs - + utils/check-cpp/Example7.hs - + utils/check-cpp/Example8.hs - + utils/check-cpp/Example9.hs - + utils/check-cpp/Lexer.x - + utils/check-cpp/Macro.hs - + utils/check-cpp/Main.hs - + utils/check-cpp/ParsePP.hs - + utils/check-cpp/ParseSimulate.hs - + utils/check-cpp/Parser.y - + utils/check-cpp/ParserM.hs - + utils/check-cpp/PreProcess.hs - + utils/check-cpp/README.md - + utils/check-cpp/State.hs - + utils/check-cpp/run.sh - utils/check-exact/ExactPrint.hs - utils/check-exact/Main.hs - utils/check-exact/Parsers.hs - utils/check-exact/Preprocess.hs - utils/check-exact/Utils.hs - utils/haddock/haddock-api/src/Haddock/Backends/Hyperlinker/Parser.hs - utils/haddock/haddock-api/src/Haddock/Parser.hs - utils/haddock/haddock-api/src/Haddock/Types.hs The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cf5f9dc51b382f1c54059e4194e1f9… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cf5f9dc51b382f1c54059e4194e1f9… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T130103] rts/linker/LoadArchive: Don't rely on file extensions for identification
by Ben Gamari (＠bgamari) 16 Jun '25

16 Jun '25

Ben Gamari pushed to branch wip/T130103 at Glasgow Haskell Compiler / GHC Commits: a26cf7dd by Ben Gamari at 2025-06-16T15:35:11-04:00 rts/linker/LoadArchive: Don't rely on file extensions for identification Previously archive members would be identified via their file extension, as described in #13103. We now instead use a more principled approach, relying on the magic number in the member's header. As well, we refactor treatment of archive format detection to improve code clarity and error handling. Closes #13103. - - - - - 1 changed file: - rts/linker/LoadArchive.c Changes: ===================================== rts/linker/LoadArchive.c ===================================== @@ -33,6 +33,7 @@ #define DEBUG_LOG(...) IF_DEBUG(linker, debugBelch("loadArchive: " __VA_ARGS__)) + #if defined(darwin_HOST_OS) || defined(ios_HOST_OS) /* Read 4 bytes and convert to host byte order */ static uint32_t read4Bytes(const char buf[static 4]) @@ -40,7 +41,7 @@ static uint32_t read4Bytes(const char buf[static 4]) return ntohl(*(uint32_t*)buf); } -static bool loadFatArchive(char tmp[static 20], FILE* f, pathchar* path) +static bool loadFatArchive(char input[static 20], FILE* f, pathchar* path) { uint32_t nfat_arch, nfat_offset, cputype, cpusubtype; #if defined(i386_HOST_ARCH) @@ -58,8 +59,9 @@ static bool loadFatArchive(char tmp[static 20], FILE* f, pathchar* path) #error Unknown Darwin architecture #endif - nfat_arch = read4Bytes(tmp + 4); + nfat_arch = read4Bytes(input + 4); DEBUG_LOG("found a fat archive containing %d architectures\n", nfat_arch); + char tmp[20]; nfat_offset = 0; for (uint32_t i = 0; i < nfat_arch; i++) { /* search for the right arch */ @@ -108,7 +110,40 @@ static bool loadFatArchive(char tmp[static 20], FILE* f, pathchar* path) } #endif -static StgBool readThinArchiveMember(int n, int memberSize, pathchar* path, +enum ObjectFileFormat { + NotObject, + PortableExecutable, + ELF, + MachO32, + MachO64, +}; + +static enum ObjectFileFormat identifyObjectFile_(char* buf, size_t sz) +{ + if (sz > 2 && ((uint16_t*)buf)[0] == 0x5a4d) { + return PortableExecutable; + } + if (sz > 4 && memcmp(buf, "\x7f" "ELF", 4) == 0) { + return ELF; + } + if (sz > 4 && ((uint32_t*)buf)[0] == 0xfeedface) { + return MachO32; + } + if (sz > 4 && ((uint32_t*)buf)[0] == 0xfeedfacf) { + return MachO64; + } + return NotObject; +} + +static enum ObjectFileFormat identifyObjectFile(FILE *f) +{ + char buf[32]; + ssize_t sz = fread(buf, 1, 32, f); + CHECK(fseek(f, -sz, SEEK_CUR) == 0); + return identifyObjectFile_(buf, sz); +} + +static bool readThinArchiveMember(int n, int memberSize, pathchar* path, char* fileName, char* image) { bool has_succeeded = false; @@ -149,7 +184,7 @@ inner_fail: return has_succeeded; } -static bool checkFatArchive(char magic[static 20], FILE* f, pathchar* path) +static bool checkFatArchive(char magic[static 4], FILE* f, pathchar* path) { bool success = false; #if defined(darwin_HOST_OS) || defined(ios_HOST_OS) @@ -241,46 +276,21 @@ lookupGNUArchiveIndex(int gnuFileIndexSize, char **fileName_, return true; } -HsInt loadArchive_ (pathchar *path) -{ - char *image = NULL; - HsInt retcode = 0; - int memberSize; - int memberIdx = 0; - FILE *f = NULL; - int n; - size_t thisFileNameSize = (size_t)-1; /* shut up bogus GCC warning */ - char *fileName; - size_t fileNameSize; - bool isGnuIndex, isThin, isImportLib; - char *gnuFileIndex; - int gnuFileIndexSize; - int misalignment = 0; - - DEBUG_LOG("start\n"); - DEBUG_LOG("Loading archive `%" PATH_FMT "'\n", path); +enum ArchiveFormat { + StandardArchive, + ThinArchive, + FatArchive, +}; - /* Check that we haven't already loaded this archive. - Ignore requests to load multiple times */ - if (isAlreadyLoaded(path)) { - IF_DEBUG(linker, - debugBelch("ignoring repeated load of %" PATH_FMT "\n", path)); - return 1; /* success */ +static bool identifyArchiveFormat(FILE *f, pathchar *path, enum ArchiveFormat *out) +{ + char tmp[8]; + size_t n = fread(tmp, 1, 8, f); + if (n != 8) { + errorBelch("loadArchive: Failed reading header from `%" PATH_FMT "'", path); \ + return false; } - gnuFileIndex = NULL; - gnuFileIndexSize = 0; - - fileNameSize = 32; - fileName = stgMallocBytes(fileNameSize, "loadArchive(fileName)"); - - isThin = false; - isImportLib = false; - - f = pathopen(path, WSTR("rb")); - if (!f) - FAIL("loadObj: can't read `%" PATH_FMT "'", path); - /* Check if this is an archive by looking for the magic "!<arch>\n" * string. Usually, if this fails, we belch an error and return. On * Darwin however, we may have a fat archive, which contains archives for @@ -299,12 +309,10 @@ HsInt loadArchive_ (pathchar *path) * its magic "!<arch>\n" string and continue processing just as if * we had a single architecture archive. */ - - n = fread ( tmp, 1, 8, f ); - if (n != 8) { - FAIL("Failed reading header from `%" PATH_FMT "'", path); + if (strncmp(tmp, "!<arch>\n", 8) == 0) { + *out = StandardArchive; + return true; } - if (strncmp(tmp, "!<arch>\n", 8) == 0) {} /* Check if this is a thin archive by looking for the magic string "!<thin>\n" * * ar thin libraries have the exact same format as normal archives except they @@ -321,16 +329,59 @@ HsInt loadArchive_ (pathchar *path) * */ else if (strncmp(tmp, "!<thin>\n", 8) == 0) { - isThin = true; + *out = ThinArchive; + return true; } else { bool success = checkFatArchive(tmp, f, path); - if (!success) - goto fail; + if (!success) { + return false; + } + *out = FatArchive; + return true; } +} + +HsInt loadArchive_ (pathchar *path) +{ + char *image = NULL; + HsInt retcode = 0; + int memberIdx = 0; + FILE *f = NULL; + size_t thisFileNameSize = (size_t) -1; /* shut up bogus GCC warning */ + int misalignment = 0; + + DEBUG_LOG("start\n"); + DEBUG_LOG("Loading archive `%" PATH_FMT "'\n", path); + + /* Check that we haven't already loaded this archive. + Ignore requests to load multiple times */ + if (isAlreadyLoaded(path)) { + IF_DEBUG(linker, + debugBelch("ignoring repeated load of %" PATH_FMT "\n", path)); + return 1; /* success */ + } + + char *gnuFileIndex = NULL; + int gnuFileIndexSize = 0; + + size_t fileNameSize = 32; + char *fileName = stgMallocBytes(fileNameSize, "loadArchive(fileName)"); + + f = pathopen(path, WSTR("rb")); + if (!f) + FAIL("loadObj: can't read `%" PATH_FMT "'", path); + + enum ArchiveFormat archive_fmt; + if (!identifyArchiveFormat(f, path, &archive_fmt)) { + FAIL("failed to identify archive format of %" PATH_FMT ".", path); + } + bool isThin = archive_fmt == ThinArchive; + DEBUG_LOG("loading archive contents\n"); while (1) { + size_t n; DEBUG_LOG("reading at %ld\n", ftell(f)); n = fread ( fileName, 1, 16, f ); if (n != 16) { @@ -350,6 +401,7 @@ HsInt loadArchive_ (pathchar *path) } #endif + char tmp[32]; n = fread ( tmp, 1, 12, f ); if (n != 12) FAIL("Failed reading mod time from `%" PATH_FMT "'", path); @@ -368,9 +420,16 @@ HsInt loadArchive_ (pathchar *path) tmp[10] = '\0'; for (n = 0; isdigit(tmp[n]); n++); tmp[n] = '\0'; - memberSize = atoi(tmp); + size_t memberSize; + { + char *end; + memberSize = strtol(tmp, &end, 10); + if (tmp == end) { + FAIL("Failed to decode member size"); + } + } - DEBUG_LOG("size of this archive member is %d\n", memberSize); + DEBUG_LOG("size of this archive member is %zd\n", memberSize); n = fread ( tmp, 1, 2, f ); if (n != 2) FAIL("Failed reading magic from `%" PATH_FMT "'", path); @@ -378,7 +437,7 @@ HsInt loadArchive_ (pathchar *path) FAIL("Failed reading magic from `%" PATH_FMT "' at %ld. Got %c%c", path, ftell(f), tmp[0], tmp[1]); - isGnuIndex = false; + bool isGnuIndex = false; /* Check for BSD-variant large filenames */ if (0 == strncmp(fileName, "#1/", 3)) { size_t n = 0; @@ -459,12 +518,7 @@ HsInt loadArchive_ (pathchar *path) DEBUG_LOG("Found member file `%s'\n", fileName); - /* TODO: Stop relying on file extensions to determine input formats. - Instead try to match file headers. See #13103. */ - isObject = (thisFileNameSize >= 2 && strncmp(fileName + thisFileNameSize - 2, ".o" , 2) == 0) - || (thisFileNameSize >= 3 && strncmp(fileName + thisFileNameSize - 3, ".lo" , 3) == 0) - || (thisFileNameSize >= 4 && strncmp(fileName + thisFileNameSize - 4, ".p_o", 4) == 0) - || (thisFileNameSize >= 4 && strncmp(fileName + thisFileNameSize - 4, ".obj", 4) == 0); + enum ObjectFileFormat object_fmt = identifyObjectFile(f); #if defined(OBJFORMAT_PEi386) /* @@ -478,13 +532,15 @@ HsInt loadArchive_ (pathchar *path) * * Linker members (e.g. filename / are skipped since they are not needed) */ - isImportLib = thisFileNameSize >= 4 && strncmp(fileName + thisFileNameSize - 4, ".dll", 4) == 0; + bool isImportLib = thisFileNameSize >= 4 && strncmp(fileName + thisFileNameSize - 4, ".dll", 4) == 0; +#else + bool isImportLib = false; #endif // windows DEBUG_LOG("\tthisFileNameSize = %d\n", (int)thisFileNameSize); - DEBUG_LOG("\tisObject = %d\n", isObject); + DEBUG_LOG("\tisObject = %d\n", object_fmt); - if (isObject) { + if (object_fmt != NotObject) { DEBUG_LOG("Member is an object file...loading...\n"); #if defined(darwin_HOST_OS) || defined(ios_HOST_OS) @@ -509,7 +565,7 @@ HsInt loadArchive_ (pathchar *path) } else { - n = fread ( image, 1, memberSize, f ); + size_t n = fread ( image, 1, memberSize, f ); if (n != memberSize) { FAIL("error whilst reading `%" PATH_FMT "'", path); } @@ -527,9 +583,11 @@ HsInt loadArchive_ (pathchar *path) ObjectCode *oc = mkOc(STATIC_OBJECT, path, image, memberSize, false, archiveMemberName, misalignment); #if defined(OBJFORMAT_MACHO) + ASSERT(object_fmt == MachO32 || object_fmt == MachO64); ocInit_MachO( oc ); #endif #if defined(OBJFORMAT_ELF) + ASSERT(object_fmt == ELF); ocInit_ELF( oc ); #endif @@ -574,7 +632,7 @@ while reading filename from `%" PATH_FMT "'", path); "Skipping...\n"); n = fseek(f, memberSize, SEEK_CUR); if (n != 0) - FAIL("error whilst seeking by %d in `%" PATH_FMT "'", + FAIL("error whilst seeking by %zd in `%" PATH_FMT "'", memberSize, path); } #endif @@ -585,7 +643,7 @@ while reading filename from `%" PATH_FMT "'", path); if (!isThin || thisFileNameSize == 0) { n = fseek(f, memberSize, SEEK_CUR); if (n != 0) - FAIL("error whilst seeking by %d in `%" PATH_FMT "'", + FAIL("error whilst seeking by %zd in `%" PATH_FMT "'", memberSize, path); } } View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a26cf7dd67414ed0b8d590f3327c3fc… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a26cf7dd67414ed0b8d590f3327c3fc… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/az/ghc-cpp] Some cleanups
by Alan Zimmerman (＠alanz) 16 Jun '25

16 Jun '25

Alan Zimmerman pushed to branch wip/az/ghc-cpp at Glasgow Haskell Compiler / GHC Commits: cf5f9dc5 by Alan Zimmerman at 2025-06-16T20:37:37+01:00 Some cleanups - - - - - 2 changed files: - compiler/GHC/Parser/PreProcess.hs - compiler/GHC/Parser/PreProcess/ParserM.hs Changes: ===================================== compiler/GHC/Parser/PreProcess.hs ===================================== @@ -294,8 +294,6 @@ processCpp loc s = do acceptStateChange ar Right CppDumpState -> do return () - -- accepting <- getAccepting - -- return (trace ("processCpp:" ++ show (accepting,directive)) Nothing) return Nothing acceptStateChange :: AcceptingResult -> PP () ===================================== compiler/GHC/Parser/PreProcess/ParserM.hs ===================================== @@ -43,8 +43,6 @@ import Data.Word (Word8) -- Parser Monad newtype ParserM a = ParserM {unParserM :: AlexInput -> St -> Either String (AlexInput, St, a)} --- newtype P a = P { unP :: PState -> ParseResult a } - instance Functor ParserM where fmap = liftM View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cf5f9dc51b382f1c54059e4194e1f9a… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cf5f9dc51b382f1c54059e4194e1f9a… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc] Pushed new branch wip/T26077
by Ben Gamari (＠bgamari) 16 Jun '25

16 Jun '25

Ben Gamari pushed new branch wip/T26077 at Glasgow Haskell Compiler / GHC -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/tree/wip/T26077 You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/improve-implicit-lifting-error] Improve error messages when implicit lifting fails
by Matthew Pickering (＠mpickering) 16 Jun '25

16 Jun '25

Matthew Pickering pushed to branch wip/improve-implicit-lifting-error at Glasgow Haskell Compiler / GHC Commits: d9fb83b5 by Matthew Pickering at 2025-06-16T17:17:13+01:00 Improve error messages when implicit lifting fails This patch concerns programs which automatically try to fix level errors by inserting `Lift`. For example: ``` foo x = [| x |] ~> foo x = [| $(lift x) |] ``` Before, there were two problems with the message. 1. (#26031), the location of the error was reported as the whole quotation. 2. (#26035), the message just mentions there is no Lift instance, but gives no indicate why the user program needed a Lift instance in the first place. This problem is especially bad when you disable `ImplicitStagePersistence`, so you just end up with a confusing "No instance for" message rather than an error message about levels This patch fixes both these issues. Firstly, `PendingRnSplice` differentiates between a user-written splice and an implicit lift. Then, the Lift instance is precisely requested with a specific origin in the typechecker. If the instance fails to be solved, the message is reported using the `TcRnBadlyLevelled` constructor (like a normal level error). Fixes #26031, #26035 - - - - - 42 changed files: - compiler/GHC/Hs/Expr.hs - compiler/GHC/Iface/Ext/Ast.hs - compiler/GHC/Rename/Splice.hs - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Errors/Ppr.hs - compiler/GHC/Tc/Errors/Types.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Gen/Splice.hs - compiler/GHC/Tc/Solver/Monad.hs - compiler/GHC/Tc/Types/Origin.hs - testsuite/tests/annotations/should_fail/annfail03.stderr - testsuite/tests/annotations/should_fail/annfail09.stderr - testsuite/tests/quasiquotation/qq001/qq001.stderr - testsuite/tests/quasiquotation/qq002/qq002.stderr - testsuite/tests/quasiquotation/qq003/qq003.stderr - testsuite/tests/quasiquotation/qq004/qq004.stderr - + testsuite/tests/quotes/LiftErrMsg.hs - + testsuite/tests/quotes/LiftErrMsg.stderr - + testsuite/tests/quotes/LiftErrMsgDefer.hs - + testsuite/tests/quotes/LiftErrMsgDefer.stderr - + testsuite/tests/quotes/LiftErrMsgTyped.hs - + testsuite/tests/quotes/LiftErrMsgTyped.stderr - testsuite/tests/quotes/T10384.stderr - testsuite/tests/quotes/TH_localname.stderr - testsuite/tests/quotes/all.T - testsuite/tests/splice-imports/SI03.stderr - testsuite/tests/splice-imports/SI05.stderr - testsuite/tests/splice-imports/SI16.stderr - testsuite/tests/splice-imports/SI18.stderr - testsuite/tests/splice-imports/SI20.stderr - testsuite/tests/splice-imports/SI25.stderr - testsuite/tests/splice-imports/SI28.stderr - testsuite/tests/splice-imports/SI31.stderr - testsuite/tests/th/T16976z.stderr - testsuite/tests/th/T17820a.stderr - testsuite/tests/th/T17820b.stderr - testsuite/tests/th/T17820c.stderr - testsuite/tests/th/T17820d.stderr - testsuite/tests/th/T17820e.stderr - testsuite/tests/th/T23829_hasty.stderr - testsuite/tests/th/T23829_hasty_b.stderr - testsuite/tests/th/T5795.stderr The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d9fb83b557e875c6076eb0fdf1b776c… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d9fb83b557e875c6076eb0fdf1b776c… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/step-out-5] 2 commits: docs: Case continuation BCOs
by Rodrigo Mesquita (＠alt-romes) 16 Jun '25

16 Jun '25

Rodrigo Mesquita pushed to branch wip/romes/step-out-5 at Glasgow Haskell Compiler / GHC Commits: 4518ebaf by Rodrigo Mesquita at 2025-06-16T13:50:30+01:00 docs: Case continuation BCOs This commit documents a subtle interaction between frames for case BCOs and their parents frames. Namely, case continuation BCOs may refer to (non-local) variables that are part of the parent's frame. The note expanding a bit on these details is called [Case continuation BCOs] - - - - - c7b043ae by Rodrigo Mesquita at 2025-06-16T14:45:00+01:00 debugger: Implement step-out feature Implements support for stepping-out of a function (aka breaking right after returning from a function) in the interactive debugger. It also introduces a GHCi command :stepout to step-out of a function being debugged in the interpreter. The feature is described as: Stop at the first breakpoint immediately after returning from the current function scope. Known limitations: because a function tail-call does not push a stack frame, if step-out is used inside of a function that was tail-called, execution will not be returned to its caller, but rather its caller's first non-tail caller. On the other hand, it means the debugger follows the more realistic execution of the program. In the following example: .. code-block:: none f = do a b <--- (1) set breakpoint then step in here c b = do ... d <--- (2) step-into this tail call d = do ... something <--- (3) step-out here ... Stepping-out will stop execution at the `c` invokation in `f`, rather than stopping at `b`. The key idea is simple: When step-out is enabled, traverse the runtime stack until a continuation BCO is found -- and enable the breakpoint heading that BCO explicitly using its tick-index. The details are specified in `Note [Debugger: Step-out]` in `rts/Interpreter.c`. Since PUSH_ALTS BCOs (representing case continuations) were never headed by a breakpoint (unlike the case alternatives they push), we introduced the BRK_ALTS instruction to allow the debugger to set a case continuation to stop at the breakpoint heading the alternative that is taken. This is further described in `Note [Debugger: BRK_ALTS]`. Fixes #26042 - - - - - 40 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/ByteCode/Types.hs - compiler/GHC/Driver/Config.hs - compiler/GHC/Runtime/Eval.hs - compiler/GHC/Runtime/Eval/Types.hs - compiler/GHC/StgToByteCode.hs - docs/users_guide/ghci.rst - ghc/GHCi/UI.hs - libraries/ghc-heap/GHC/Exts/Heap/Closures.hs - libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingDisabled.hsc - libraries/ghc-heap/GHC/Exts/Heap/FFIClosures_ProfilingEnabled.hsc - libraries/ghc-heap/tests/parse_tso_flags.hs - libraries/ghci/GHCi/Debugger.hs - libraries/ghci/GHCi/Message.hs - libraries/ghci/GHCi/Run.hs - + rts/Debugger.cmm - rts/Disassembler.c - rts/Interpreter.c - rts/Interpreter.h - rts/RtsSymbols.c - rts/StgMiscClosures.cmm - rts/include/rts/Bytecodes.h - rts/include/rts/Constants.h - rts/include/rts/storage/Closures.h - rts/rts.cabal - + testsuite/tests/ghci.debugger/scripts/T26042a.hs - + testsuite/tests/ghci.debugger/scripts/T26042a.script - + testsuite/tests/ghci.debugger/scripts/T26042a.stdout - + testsuite/tests/ghci.debugger/scripts/T26042b.hs - + testsuite/tests/ghci.debugger/scripts/T26042b.script - + testsuite/tests/ghci.debugger/scripts/T26042b.stdout - + testsuite/tests/ghci.debugger/scripts/T26042c.hs - + testsuite/tests/ghci.debugger/scripts/T26042c.script - + testsuite/tests/ghci.debugger/scripts/T26042c.stdout - + testsuite/tests/ghci.debugger/scripts/T26042d.hs - + testsuite/tests/ghci.debugger/scripts/T26042e.hs - + testsuite/tests/ghci.debugger/scripts/T26042f.hs - + testsuite/tests/ghci.debugger/scripts/T26042g.hs - testsuite/tests/ghci.debugger/scripts/all.T The diff was not included because it is too large. View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2d7995dca4abd94a3f36a14e8262f6… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/2d7995dca4abd94a3f36a14e8262f6… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/step-out-5] BRK_ALTS BCO
by Rodrigo Mesquita (＠alt-romes) 16 Jun '25

16 Jun '25

Rodrigo Mesquita pushed to branch wip/romes/step-out-5 at Glasgow Haskell Compiler / GHC Commits: 2d7995dc by Rodrigo Mesquita at 2025-06-16T12:05:34+01:00 BRK_ALTS BCO - - - - - 6 changed files: - compiler/GHC/ByteCode/Asm.hs - compiler/GHC/ByteCode/Instr.hs - compiler/GHC/StgToByteCode.hs - rts/Disassembler.c - rts/Interpreter.c - rts/include/rts/Bytecodes.h Changes: ===================================== compiler/GHC/ByteCode/Asm.hs ===================================== @@ -858,7 +858,7 @@ assembleI platform i = case i of , Op np ] - BRK_INTERNAL active -> emit_ bci_BRK_INTERNAL [SmallOp active] + BRK_ALTS active -> emit_ bci_BRK_ALTS [SmallOp active] #if MIN_VERSION_rts(1,0,3) BCO_NAME name -> do np <- lit1 (BCONPtrStr name) ===================================== compiler/GHC/ByteCode/Instr.hs ===================================== @@ -272,9 +272,10 @@ data BCInstr !UnitId -- breakpoint info module unit id !Word16 -- breakpoint info index (RemotePtr CostCentre) - -- An internal breakpoint should only be set by the compiler or RTS - -- See Note [BRK_INTERNAL] - | BRK_INTERNAL !Word16 {- enabled? -} + + -- An internal breakpoint for triggering a break on any case alternative + -- See Note [Debugger: BRK_ALTS] + | BRK_ALTS !Word16 {- enabled? -} #if MIN_VERSION_rts(1,0,3) -- | A "meta"-instruction for recording the name of a BCO for debugging purposes. @@ -471,7 +472,7 @@ instance Outputable BCInstr where <+> text "<tick_module>" <+> text "<tick_module_unitid>" <+> ppr tickx <+> text "<info_module>" <+> text "<info_module_unitid>" <+> ppr infox <+> text "<cc>" - ppr (BRK_INTERNAL active) = text "BRK_INTERNAL" <+> ppr active + ppr (BRK_ALTS active) = text "BRK_ALTS" <+> ppr active #if MIN_VERSION_rts(1,0,3) ppr (BCO_NAME nm) = text "BCO_NAME" <+> text (show nm) #endif @@ -597,7 +598,7 @@ bciStackUse OP_INDEX_ADDR{} = 0 bciStackUse SWIZZLE{} = 0 bciStackUse BRK_FUN{} = 0 -bciStackUse BRK_INTERNAL{} = 0 +bciStackUse BRK_ALTS{} = 0 -- These insns actually reduce stack use, but we need the high-tide level, -- so can't use this info. Not that it matters much. ===================================== compiler/GHC/StgToByteCode.hs ===================================== @@ -1372,7 +1372,10 @@ doCase d s p scrut bndr alts | ubx_tuple_frame = SLIDE 0 2 `consOL` alt_final0 | otherwise = alt_final0 alt_final - = BRK_INTERNAL 0 `consOL` alt_final1 + | gopt Opt_InsertBreakpoints (hsc_dflags hsc_env) + -- See Note [Debugger: BRK_ALTS] + = BRK_ALTS 0 `consOL` alt_final1 + | otherwise = alt_final1 add_bco_name <- shouldAddBcoName let @@ -1392,6 +1395,37 @@ doCase d s p scrut bndr alts _ -> panic "schemeE(StgCase).push_alts" in return (PUSH_ALTS alt_bco scrut_rep `consOL` scrut_code) +{- +Note [Debugger: BRK_ALTS] +~~~~~~~~~~~~~~~~~~~~~~~~~ +As described in Note [Debugger: Step-out] in rts/Interpreter.c, to implement +the stepping-out debugger feature we traverse the heap at runtime, identify +the continuation BCO, and explicitly enable that BCO's breakpoint thus ensuring +we stop exactly when we return to the continuation. + +However, a case continuation BCO (pushed by PUSH_ALTS), which computes what +case alternative BCO to take, never gets a user-facing breakpoint tick (BRK_FUN): + + 1) It's not useful to a user stepping through the program to always have a + breakpoint after the scrutinee is evaluated but before the case alternative + is selected. The associated source span would also be slightly awkward to choose. + + 2) It's not easy to add a source-tick before the case alternatives because in + essentially all internal representations they are given as a list of Alts + rather than an expression. + +To provide the debugger a way to enable at runtime the case continuation +breakpoints regardless, we introduce at the start of every PUSH_ALTS BCO a +BRK_ALTS instruction. + +The BRK_ALTS instruction, if enabled (by its single arg), ensures we stop at +the breakpoint heading the case alternative we take. Under the hood, this means +that when BRK_ALTS is enabled we set TSO_STOP_NEXT_BREAKPOINT just before +selecting the alternative. + +It's important that BRK_ALTS (just like BRK_FUN) is the first instruction of +the BCO, since that's where the debugger will look to enable it at runtime. +-} -- ----------------------------------------------------------------------------- -- Deal with tuples ===================================== rts/Disassembler.c ===================================== @@ -94,8 +94,8 @@ disInstr ( StgBCO *bco, int pc ) debugBelch("\n"); pc += 6; break; - case bci_BRK_INTERNAL: - debugBelch ("BRK_INTERNAL %d\n", BCO_NEXT); + case bci_BRK_ALTS: + debugBelch ("BRK_ALTS %d\n", BCO_NEXT); break; case bci_SWIZZLE: { W_ stkoff = BCO_GET_LARGE_ARG; ===================================== rts/Interpreter.c ===================================== @@ -643,10 +643,12 @@ interpretBCO (Capability* cap) // ACTIVATE the breakpoint by tick index ((StgInt*)breakPoints->payload)[tick_index] = 0; } - else if ((bco_instrs[0] & 0xFF) == bci_BRK_INTERNAL) { + else if ((bco_instrs[0] & 0xFF) == bci_BRK_ALTS) { // ACTIVATE BRK_ALTS by setting its only argument to ON bco_instrs[1] = 1; } + // else: if there is no BRK instruction perhaps we should keep + // traversing; that said, the continuation should always have a BRK } else /* type == STOP_FRAME */ { /* No continuation frame to further stop at: Nothing to do */ @@ -1588,14 +1590,11 @@ run_BCO: goto nextInsn; } - case bci_BRK_INTERNAL: + /* See Note [Debugger: BRK_ALTS] */ + case bci_BRK_ALTS: { - printf("BREAK INTERNAL\n"); StgWord16 active = BCO_NEXT; - printf("BREAK INTERNAL: %d\n", active); if (active) { - printf("BREAK INTERNAL is active\n"); - // Break on next! cap->r.rCurrentTSO->flags |= TSO_STOP_NEXT_BREAKPOINT; } ===================================== rts/include/rts/Bytecodes.h ===================================== @@ -214,7 +214,7 @@ #define bci_OP_INDEX_ADDR_32 242 #define bci_OP_INDEX_ADDR_64 243 -#define bci_BRK_INTERNAL 244 +#define bci_BRK_ALTS 244 /* If you need to go past 255 then you will run into the flags */ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2d7995dca4abd94a3f36a14e8262f67… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/2d7995dca4abd94a3f36a14e8262f67… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/romes/step-out-5] Complete implementation of step-out RTS level
by Rodrigo Mesquita (＠alt-romes) 16 Jun '25

16 Jun '25

Rodrigo Mesquita pushed to branch wip/romes/step-out-5 at Glasgow Haskell Compiler / GHC Commits: 9efbbddb by Rodrigo Mesquita at 2025-06-16T11:15:11+01:00 Complete implementation of step-out RTS level - - - - - 1 changed file: - rts/Interpreter.c Changes: ===================================== rts/Interpreter.c ===================================== @@ -595,77 +595,67 @@ interpretBCO (Capability* cap) debugBelch("\n\n"); ); - // On entering interpretBCO, check if the step-out flag is set for this - // thread. If yes, push a step-out frame between the first frame and second - // frame. - // - // This frame will be responsible for enabling the first breakpoint that - // comes after it is evaluated (i.e. for breaking right after evaluation of - // this bco returns). - // - // See Note [Debugger: Step-out] for details - // TODOOOOOOOOOOOOOOOO UPDATES + /* If the "step-out" flag is set for this thread, find the *continuation* + * BCO on the stack and activate its breakpoint specifically. Be careful to + * use SafeSp macros to handle stack underflows. + * + * See Note [Debugger: Step-out] + */ if (cap->r.rCurrentTSO->flags & TSO_STOP_AFTER_RETURN) { - StgPtr frame; StgBCO* bco; StgWord16* bco_instrs; - frame = Sp; - - frame += stack_frame_sizeW((StgClosure *)frame); // ignore first BCO because this is the one we are stopped at. We only want to stop at the next one up the stack. - - // Insert the stg_stop_after_ret_frame after the first frame that is NOT a - // case continuation BCO. - // - // Do /not/ insert a step-out frame between case continuation - // frames and their parent BCO frame. Case continuation BCOs may have - // non-local stack references. See Note [Case continuation BCOs]. - - // UPDATE COMMENTS: NOW FIND STOP FRAME AND ACTIVATE IT - while (get_itbl((StgClosure*)frame)->type != RET_BCO) - { // TODO: HANDLE IF STACK BOTTOM - frame += stack_frame_sizeW((StgClosure *)frame); - printf("Wasn't right, keep going\n"); - } - - printf("Found frame\n"); + StgHalfWord type; - // TODO: Handle stack bottom edge case!? if frame == STACK BOTTOM... - // stack underflow *and* overflow... + /* Store the entry Sp; traverse the stack modifying Sp (using Sp macros); + * restore Sp afterwards. */ + StgPtr restoreStackPointer = Sp; - // Then write it. - // ((StgStopAfterRetFrame*)frame)->enabled = 1; + /* The first BCO on the stack is the one we are already stopped at. + * Skip it. */ + Sp = SafeSpWP(stack_frame_sizeW((StgClosure *)Sp)); - // TODO: Write profiling info if needed + /* Traverse upwards until continuation BCO, or the end */ + while ((type = get_itbl((StgClosure*)Sp)->type) != RET_BCO + && type != STOP_FRAME) { + Sp = SafeSpWP(stack_frame_sizeW((StgClosure *)Sp)); + } - bco = (StgBCO*)(frame[1]); // BCO is first argument of RET_BCO frame - ASSERT(get_itbl((StgClosure*)bco)->type == BCO); - bco_instrs = (StgWord16*)(bco->instrs->payload); + ASSERT(type == RET_BCO || type == STOP_FRAME); + if (type == RET_BCO) { - if ((bco_instrs[0] /* BRK_FUN ALWAYS FIRST INSTR */ & 0xFF) == bci_BRK_FUN) { - printf("Found BRK FUN\n"); - printf("Enabling breakpoint of BCO: %p\n", bco); + bco = (StgBCO*)(SpW(1)); // BCO is first arg of a RET_BCO + ASSERT(get_itbl((StgClosure*)bco)->type == BCO); + bco_instrs = (StgWord16*)(bco->instrs->payload); - int brk_array, tick_index; - StgArrBytes *breakPoints; - StgPtr* ptrs; + /* A breakpoint instruction (BRK_FUN or BRK_ALTS) is always the first + * instruction in a BCO */ + if ((bco_instrs[0] & 0xFF) == bci_BRK_FUN) { + int brk_array, tick_index; + StgArrBytes *breakPoints; + StgPtr* ptrs; - ptrs = (StgPtr*)(&bco->ptrs->payload[0]); - brk_array = bco_instrs[1]; - tick_index = bco_instrs[6]; + ptrs = (StgPtr*)(&bco->ptrs->payload[0]); + brk_array = bco_instrs[1]; + tick_index = bco_instrs[6]; - breakPoints = (StgArrBytes *) BCO_PTR(brk_array); - // ACTIVATE - ((StgInt*)breakPoints->payload)[tick_index] = 0; + breakPoints = (StgArrBytes *) BCO_PTR(brk_array); + // ACTIVATE the breakpoint by tick index + ((StgInt*)breakPoints->payload)[tick_index] = 0; + } + else if ((bco_instrs[0] & 0xFF) == bci_BRK_INTERNAL) { + // ACTIVATE BRK_ALTS by setting its only argument to ON + bco_instrs[1] = 1; + } } - else if ((bco_instrs[0] & 0xFF) == bci_BRK_INTERNAL) { - printf("Found BRK INTERNAL\n"); - printf("Enabling breakpoint of BCO: %p\n", bco); - bco_instrs[1] = 1; // ACTIVATE + else /* type == STOP_FRAME */ { + /* No continuation frame to further stop at: Nothing to do */ } - // Frame was pushed, mark as done to not do it again + // Mark as done to not do it again cap->r.rCurrentTSO->flags &= ~TSO_STOP_AFTER_RETURN; + + Sp = restoreStackPointer; } // ------------------------------------------------------------------------ View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9efbbddb8ffa2078ea38fc2b6de6d66… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9efbbddb8ffa2078ea38fc2b6de6d66… You're receiving this email because of your account on gitlab.haskell.org.

1 0

[Git][ghc/ghc][wip/T26115] 4 commits: Fix inverted test
by Simon Peyton Jones (＠simonpj) 16 Jun '25

16 Jun '25

Simon Peyton Jones pushed to branch wip/T26115 at Glasgow Haskell Compiler / GHC Commits: 4cca8e5e by Simon Peyton Jones at 2025-06-16T09:53:00+01:00 Fix inverted test - - - - - a0406056 by Simon Peyton Jones at 2025-06-16T10:22:16+01:00 Missing close paren in tc-trace - - - - - 24cc2a81 by Simon Peyton Jones at 2025-06-16T10:22:34+01:00 A bit more tc-tracing for record updates - - - - - c9c848ad by Simon Peyton Jones at 2025-06-16T10:22:51+01:00 Don't create implications for FunSigCtxt unless we have to - - - - - 4 changed files: - compiler/GHC/Core/Opt/Specialise.hs - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Expr.hs - compiler/GHC/Tc/Utils/Unify.hs Changes: ===================================== compiler/GHC/Core/Opt/Specialise.hs ===================================== @@ -2965,15 +2965,14 @@ singleCall spec_env id args unitBag (CI { ci_key = args , ci_fvs = fvVarSet call_fvs }) } where - call_fvs | gopt Opt_PolymorphicSpecialisation (se_dflags spec_env) - = specArgsFVs isLocalVar args - | otherwise - = specArgsFVs isLocalId args + poly_spec = gopt Opt_PolymorphicSpecialisation (se_dflags spec_env) - -- specArgFreeIds: we specifically look for free Ids, not TyVars - -- see (MP1) in Note [Specialising polymorphic dictionaries] - -- - -- We don't include the 'id' itself. + -- With -fpolymorphic-specialisation, keep just local /Ids/ + -- Otherwise, keep /all/ free vars including TyVars + -- See (MP1) in Note [Specialising polymorphic dictionaries] + -- But NB: we don't include the 'id' itself. + call_fvs | poly_spec = specArgsFVs isLocalId args + | otherwise = specArgsFVs isLocalVar args mkCallUDs :: SpecEnv -> OutExpr -> [OutExpr] -> UsageDetails mkCallUDs env fun args @@ -3504,7 +3503,7 @@ What should we do when a value is specialised to a *strict* unboxed value? in h:t Could convert let to case: - + map_*_Int# f (x:xs) = case f x of h# -> let t = map f xs in h#:t ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -460,6 +460,7 @@ finishApp tc_head@(tc_fun,_) tc_args app_res_rho res_wrap ; res_expr <- if isTagToEnum tc_fun then tcTagToEnum tc_head tc_args app_res_rho else return (rebuildHsApps tc_head tc_args) + ; traceTc "End tcApp }" (ppr tc_fun) ; return (mkHsWrap res_wrap res_expr) } checkResultTy :: HsExpr GhcRn ===================================== compiler/GHC/Tc/Gen/Expr.hs ===================================== @@ -1481,6 +1481,7 @@ expandRecordUpd record_expr possible_parents rbnds res_ty vcat [ text "relevant_con:" <+> ppr relevant_con , text "res_ty:" <+> ppr res_ty , text "ds_res_ty:" <+> ppr ds_res_ty + , text "ds_expr:" <+> ppr ds_expr ] ; return (ds_expr, ds_res_ty, RecordUpdCtxt relevant_cons upd_fld_names ex_tvs) } ===================================== compiler/GHC/Tc/Utils/Unify.hs ===================================== @@ -583,7 +583,6 @@ alwaysBuildImplication :: SkolemInfoAnon -> Bool -- See Note [When to build an implication] alwaysBuildImplication (SigSkol ctxt _ _) = case ctxt of - FunSigCtxt {} -> True -- RHS of a binding with a signature SpecInstCtxt -> True -- SpecInstCtxt: this is rather delicate _ -> False alwaysBuildImplication _ = False @@ -591,6 +590,10 @@ alwaysBuildImplication _ = False {- Commmented out for now while I figure out about error messages. See #14185 +Caution: we get some duplication of errors if we build more implications. +Because we get one error for each function RHS, even if it's for +the same class constraint. + alwaysBuildImplication (SigSkol ctxt _ _) = case ctxt of FunSigCtxt {} -> True -- RHS of a binding with a signature View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/13a1fcecf95a5809d4dc9d84ac8dfb… -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/13a1fcecf95a5809d4dc9d84ac8dfb… You're receiving this email because of your account on gitlab.haskell.org.

1 0