diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,10 @@ # Revision history for ghc-debug-stub +## 0.4.0.0 -- 2022-12-14 + +* Fix compatability with HEAD/9.4/9.2 +* Support for SRT requests + ## 0.3.0.0 -- 2022-10-06 * Allow clients to reconnect multiple times to debuggee (Finley McIlwaine) diff --git a/cbits/stub.cpp b/cbits/stub.cpp --- a/cbits/stub.cpp +++ b/cbits/stub.cpp @@ -25,6 +25,10 @@ #error You must use a patched version of cabal-install which includes - https://github.com/haskell/cabal/pull/7183 #endif +#if !defined(TABLES_NEXT_TO_CODE) +#error TABLES_NEXT_TO_CODE not defined +#endif + // This used to be 4096 but that was too small #define MAX_CMD_SIZE 10000 @@ -48,6 +52,30 @@ * */ +namespace { + bool isFUN(StgHalfWord flags) { + return !isTHUNK(flags) && hasSRT(flags); + } +#ifndef ip_STACK_FRAME + // ghc has this now, but it's new + bool ip_STACK_FRAME(StgInfoTable* info) { + switch(info->type) { + case RET_SMALL: + case RET_BIG: + case RET_FUN: + case UPDATE_FRAME: + case CATCH_FRAME: + case UNDERFLOW_FRAME: + case STOP_FRAME: + case ATOMICALLY_FRAME: + case CATCH_RETRY_FRAME: + case CATCH_STM_FRAME: return true; + default: return false; + } + } +#endif +} + enum commands { CMD_VERSION = 1, CMD_PAUSE = 2, @@ -63,7 +91,8 @@ CMD_SOURCE_INFO = 12, CMD_BLOCKS = 14, CMD_BLOCK = 15, - CMD_FUN_BITMAP = 16 + CMD_FUN_BITMAP = 16, + CMD_GET_SRT = 17 }; enum response_code { @@ -260,13 +289,17 @@ paused = true; } -static void write_large_bitmap(Response& resp, StgLargeBitmap *large_bitmap, StgWord size) { - uint32_t b = 0; - uint32_t size_payload; - size_payload=htonl(size); +// Size fields are always uint32_t in network-byte-order. +static void write_size(Response& resp, StgWord size) { + uint32_t size_payload = htonl(size); trace("SIZE %llu", size); resp.write((uint32_t) size_payload); +} +static void write_large_bitmap(Response& resp, StgLargeBitmap *large_bitmap, StgWord size) { + uint32_t b = 0; + write_size(resp, size); + for (uint32_t i = 0; i < size; b++) { StgWord bitmap = large_bitmap->bitmap[b]; uint32_t j = stg_min(size-i, BITS_IN(W_)); @@ -282,10 +315,7 @@ uint32_t i = 0; // Small bitmap - uint32_t size_payload; - size_payload=htonl(size); - trace("SIZE %llu", size); - resp.write((uint32_t) size_payload); + write_size(resp, size); while (size > 0) { resp.write((uint8_t) ! (bitmap & 1)); bitmap = bitmap >> 1; @@ -313,15 +343,10 @@ static void write_string(Response& resp, const char * s){ - uint32_t len_payload; - len_payload=htonl(strlen(s)); - resp.write(len_payload); - trace("SIZE: %lu", strlen(s)); - uint32_t i; + StgWord size = strlen(s); + write_size(resp, size); trace("WRITING: %s\n", s); - for (i = 0; i < strlen(s); i++){ - resp.write(s[i]); - } + resp.write(s, size); } @@ -478,6 +503,38 @@ } break; + case CMD_GET_SRT: + // TODO: SRTs are immutable so we needn't pause for this request + if (!paused) { + resp.finish(RESP_NOT_PAUSED); + } else { + trace("GET_SRT\n"); + uint16_t n_raw = p.get(); + uint16_t n = htons(n_raw); + for (; n > 0; n--) { + trace("GET_SRT_GET_INFO %d\n", n); + StgInfoTable *ptr_end = (StgInfoTable *) p.get(); + StgInfoTable *info = INFO_PTR_TO_STRUCT(ptr_end); + StgHalfWord flags = ipFlags(info); + StgClosure* srt = nullptr; + if(ip_SRT(info) && info->srt) { // Is this info table of a type which CAN have an SRT, and does it actually have an SRT? + if (isFUN(flags)) { + StgFunInfoTable* funinfo = FUN_INFO_PTR_TO_STRUCT(ptr_end); + srt = GET_FUN_SRT(funinfo); + } else if (isTHUNK(flags)) { + StgThunkInfoTable* thunkinfo = THUNK_INFO_PTR_TO_STRUCT(ptr_end); + srt = GET_SRT(thunkinfo); + } else if (ip_STACK_FRAME(info)) { + StgRetInfoTable* retinfo = RET_INFO_PTR_TO_STRUCT(ptr_end); + srt = GET_SRT(retinfo); + } + } + resp.write((uint64_t)srt); + } + resp.finish(RESP_OKAY); + } + break; + case CMD_GET_BITMAP: { response_code code = RESP_OKAY; @@ -601,16 +658,26 @@ trace("FOUND\n"); size_t len = 6; - uint32_t len_payload = htonl(len); - resp.write(len_payload); + write_size(resp, len); - // Using the function just produces garbage.. no idea why - write_string(resp, ip.table_name); - write_string(resp, ip.closure_desc); - write_string(resp, ip.ty_desc); - write_string(resp, ip.label); - write_string(resp, ip.module); - write_string(resp, ip.srcloc); + // Using the function just produces garbage.. no idea why + write_string(resp, ip.table_name); + write_string(resp, ip.closure_desc); + write_string(resp, ip.ty_desc); + write_string(resp, ip.label); + write_string(resp, ip.module); +#if MIN_VERSION_GLASGOW_HASKELL(9,5,0,0) + { + size_t len_file = strlen(ip.src_file); + size_t len_span = strlen(ip.src_span); + write_size(resp, len_file + 1 + len_span); + resp.write(ip.src_file, len_file); + resp.write(":", 1); + resp.write(ip.src_span, len_span); + } +#else + write_string(resp, ip.srcloc); +#endif } resp.finish(RESP_OKAY); break; diff --git a/ghc-debug-stub.cabal b/ghc-debug-stub.cabal --- a/ghc-debug-stub.cabal +++ b/ghc-debug-stub.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: ghc-debug-stub -version: 0.3.0.0 +version: 0.4.0.0 synopsis: Functions for instrumenting your application so the heap can be analysed with ghc-debug-common. description: Functions for instrumenting your application so the heap can @@ -27,7 +27,7 @@ , directory ^>= 1.3 , filepath ^>= 1.4 , ghc-prim ^>= 0.8 - , ghc-debug-convention == 0.3.0.0 + , ghc-debug-convention == 0.4.0.0 default-language: Haskell2010 cxx-sources: cbits/stub.cpp, cbits/socket.cpp, cbits/trace.cpp cxx-options: -std=gnu++11 -pthread -O3 -g3 -DTHREADED_RTS