{-# LINE 1 "GHC/ExecutionStack/Internal.hsc" #-}------------------------------------------------------------------------------- |-- Module : GHC.ExecutionStack.Internal-- Copyright : (c) The University of Glasgow 2013-2015-- License : see libraries/base/LICENSE---- Maintainer : cvs-ghc@haskell.org-- Stability : internal-- Portability : non-portable (GHC Extensions)---- Internals of the `GHC.ExecutionStack` module---- @since 4.9.0.0-----------------------------------------------------------------------------{-# LANGUAGE MultiWayIf #-}moduleGHC.ExecutionStack.Internal(-- * InternalLocation(..),SrcLoc (..),StackTrace ,stackFrames,stackDepth ,collectStackTrace,showStackFrames ,invalidateDebugCache)whereimportControl. Monad(join)importData.Word importForeign.C.Types importForeign.C. String(peekCString,CString)importForeign.Ptr (Ptr ,nullPtr,castPtr,plusPtr,FunPtr)importForeign.ForeignPtr importForeign.Marshal. Alloc(allocaBytes)importForeign.Storable (Storable (..))importSystem.IO.Unsafe(unsafePerformIO,unsafeInterleaveIO)-- N.B. See includes/rts/Libdw.h for notes on stack representation.-- | A location in the original program source.dataSrcLoc=SrcLoc{sourceFile ::String,sourceLine ::Int,sourceColumn::Int}-- | Location information about an address from a backtrace.dataLocation=Location{objectName ::String ,functionName::String,srcLoc::MaybeSrcLoc}-- | A chunk of backtrace framesdataChunk=Chunk{chunkFrames::!Word,chunkNext ::!(Ptr Chunk),chunkFirstFrame::!(PtrAddr)}-- | The state of the execution stacknewtypeStackTrace=StackTrace(ForeignPtrStackTrace)-- | An addresstypeAddr=Ptr()withSession ::(ForeignPtrSession->IOa)->IO(Maybea)withSessionaction =doptr<-libdw_pool_takeif|nullPtr ==ptr->returnNothing|otherwise->dofptr<-newForeignPtrlibdw_pool_releaseptrret <-actionfptrreturn$Justret-- | How many stack frames in the given 'StackTrace'stackDepth ::StackTrace->IntstackDepth(StackTracefptr )=unsafePerformIO$withForeignPtrfptr $ \ptr->fromIntegral.asWord<$>((\hsc_ptr->peekByteOffhsc_ptr0))ptr{-# LINE 84 "GHC/ExecutionStack/Internal.hsc" #-}whereasWord=id ::Word->WordpeekChunk::PtrChunk ->IOChunk peekChunkptr =Chunk<$> ((\hsc_ptr->peekByteOffhsc_ptr0))ptr {-# LINE 90 "GHC/ExecutionStack/Internal.hsc" #-}<*>((\hsc_ptr->peekByteOffhsc_ptr8))ptr{-# LINE 91 "GHC/ExecutionStack/Internal.hsc" #-}<*>pure (castPtr$((\hsc_ptr->hsc_ptr`plusPtr`16))ptr){-# LINE 92 "GHC/ExecutionStack/Internal.hsc" #-}-- | Return a list of the chunks of a backtrace, from the outer-most to-- inner-most chunk.chunksList::StackTrace->IO [Chunk ]chunksList(StackTracefptr)=withForeignPtrfptr$\ptr->go[]=<<((\hsc_ptr->peekByteOffhsc_ptr8))ptr{-# LINE 98 "GHC/ExecutionStack/Internal.hsc" #-}wheregoaccumptr|ptr==nullPtr=returnaccum|otherwise=dochunk<-peekChunkptrgo (chunk :accum)(chunkNextchunk)-- | Unpack the given 'Location' in the Haskell representationpeekLocation::Ptr Location ->IOLocationpeekLocationptr=doletpeekCStringPtr::CString->IO StringpeekCStringPtrp |p/=nullPtr=peekCString $ castPtrp|otherwise=return""objFile<-peekCStringPtr=<< ((\hsc_ptr->peekByteOffhsc_ptr0))ptr{-# LINE 113 "GHC/ExecutionStack/Internal.hsc" #-}function<-peekCStringPtr=<<((\hsc_ptr->peekByteOffhsc_ptr8))ptr{-# LINE 114 "GHC/ExecutionStack/Internal.hsc" #-}srcFile<-peekCStringPtr=<<((\hsc_ptr->peekByteOffhsc_ptr16))ptr{-# LINE 115 "GHC/ExecutionStack/Internal.hsc" #-}lineNo<-((\hsc_ptr->peekByteOffhsc_ptr24))ptr::IOWord32{-# LINE 116 "GHC/ExecutionStack/Internal.hsc" #-}colNo<-((\hsc_ptr->peekByteOffhsc_ptr28))ptr::IOWord32{-# LINE 117 "GHC/ExecutionStack/Internal.hsc" #-}let_srcLoc|nullsrcFile=Nothing|otherwise=Just$SrcLoc{sourceFile=srcFile,sourceLine=fromIntegrallineNo,sourceColumn=fromIntegralcolNo}return Location{objectName=objFile ,functionName=function,srcLoc=_srcLoc}-- | The size in bytes of a 'locationSize'locationSize::IntlocationSize=(32){-# LINE 131 "GHC/ExecutionStack/Internal.hsc" #-}-- | List the frames of a stack trace.stackFrames::StackTrace->Maybe[Location]stackFramesst@(StackTracefptr)=unsafePerformIO$withSession$\sess->dochunks<-chunksListstgosess(reversechunks)wherego::ForeignPtrSession->[Chunk]->IO[Location]go_[]=return[]gosess(chunk:chunks)=dothis<-iterChunksesschunkrest<-unsafeInterleaveIO(gosesschunks)return(this++rest){-
 Here we lazily lookup the location information associated with each address
 as this can be rather costly. This does mean, however, that if the set of
 loaded modules changes between the time that we capture the stack and the
 time we reach here, we may end up with nonsense (mostly likely merely
 unknown symbols). I think this is a reasonable price to pay, however, as
 module loading/unloading is a rather rare event.
 Morover, we stand to gain a great deal by lazy lookups as the stack frames
 may never even be requested, meaning the only effort wasted is the
 collection of the stack frames themselves.
 The only slightly tricky thing here is to ensure that the ForeignPtr
 stays alive until we reach the end.
 -}iterChunk::ForeignPtrSession->Chunk->IO[Location]iterChunksesschunk=iterFrames(chunkFrameschunk)(chunkFirstFramechunk)whereiterFrames::Word->Ptr Addr->IO[Location]iterFrames0_=return []iterFramesnframe=dopc<-peekframe::IO Addr mframe<-lookupFramepc rest<-unsafeInterleaveIO(iterFrames(n-1)frame')return$mayberest(:rest)mframewhereframe'=frame`plusPtr`sizeOf(undefined::Addr)lookupFrame::Addr->IO (MaybeLocation)lookupFramepc=withForeignPtrfptr$const$doallocaByteslocationSize$\buf->doret<-withForeignPtrsess $ \sessPtr->libdw_lookup_locationsessPtrbufpccaseretof0->Just<$>peekLocationbuf_->returnNothing-- | A LibdwSession from the runtime systemdataSessionforeignimportccallunsafe"libdwPoolTake"libdw_pool_take::IO(Ptr Session )foreignimportccallunsafe"&libdwPoolRelease"libdw_pool_release::FunPtr(Ptr Session->IO())foreignimportccallunsafe"libdwPoolClear"libdw_pool_clear::IO()foreignimportccall unsafe"libdwLookupLocation"libdw_lookup_location::Ptr Session ->PtrLocation->Addr->IOCIntforeignimportccallunsafe"libdwGetBacktrace"libdw_get_backtrace::PtrSession->IO(PtrStackTrace)foreign importccall unsafe"&backtraceFree"backtrace_free::FunPtr(PtrStackTrace->IO())-- | Get an execution stack.collectStackTrace::IO(MaybeStackTrace)collectStackTrace=fmapjoin$withSession$\sess->dost<-withForeignPtrsess libdw_get_backtraceif|st==nullPtr->returnNothing|otherwise->Just.StackTrace<$>newForeignPtrbacktrace_freest-- | Free the cached debug data.invalidateDebugCache::IO()invalidateDebugCache=libdw_pool_clear-- | Render a stacktrace as a stringshowStackFrames::[Location]->ShowSshowStackFramesframes=showString"Stack trace:\n".foldr(.)id(mapshowFrameframes)whereshowFrame loc=showString" ".showLocationloc.showChar'\n'-- | Render a 'Location' as a stringshowLocation::Location->ShowSshowLocationloc =showString(functionNameloc). maybe id showSrcLoc(srcLocloc).showString" in ".showString(objectNameloc)whereshowSrcLoc::SrcLoc->ShowSshowSrcLocsloc=showString" (".showString(sourceFilesloc).showString":".shows(sourceLinesloc).showString".".shows(sourceColumnsloc).showString")"