Movatterモバイル変換

{-# LINE1"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.WordimportForeign.C.TypesimportForeign.C.String(peekCString,CString)importForeign.Ptr(Ptr,nullPtr,castPtr,plusPtr,FunPtr)importForeign.ForeignPtrimportForeign.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::!(PtrChunk),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{-# LINE84"GHC/ExecutionStack/Internal.hsc"#-}whereasWord=id::Word->WordpeekChunk::PtrChunk->IOChunkpeekChunkptr=Chunk<$>((\hsc_ptr->peekByteOffhsc_ptr0))ptr{-# LINE90"GHC/ExecutionStack/Internal.hsc"#-}<*>((\hsc_ptr->peekByteOffhsc_ptr8))ptr{-# LINE91"GHC/ExecutionStack/Internal.hsc"#-}<*>pure(castPtr$((\hsc_ptr->hsc_ptr`plusPtr`16))ptr){-# LINE92"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{-# LINE98"GHC/ExecutionStack/Internal.hsc"#-}wheregoaccumptr|ptr==nullPtr=returnaccum|otherwise=dochunk<-peekChunkptrgo(chunk:accum)(chunkNextchunk)-- | Unpack the given 'Location' in the Haskell representationpeekLocation::PtrLocation->IOLocationpeekLocationptr=doletpeekCStringPtr::CString->IOStringpeekCStringPtrp|p/=nullPtr=peekCString$castPtrp|otherwise=return""objFile<-peekCStringPtr=<<((\hsc_ptr->peekByteOffhsc_ptr0))ptr{-# LINE113"GHC/ExecutionStack/Internal.hsc"#-}function<-peekCStringPtr=<<((\hsc_ptr->peekByteOffhsc_ptr8))ptr{-# LINE114"GHC/ExecutionStack/Internal.hsc"#-}srcFile<-peekCStringPtr=<<((\hsc_ptr->peekByteOffhsc_ptr16))ptr{-# LINE115"GHC/ExecutionStack/Internal.hsc"#-}lineNo<-((\hsc_ptr->peekByteOffhsc_ptr24))ptr::IOWord32{-# LINE116"GHC/ExecutionStack/Internal.hsc"#-}colNo<-((\hsc_ptr->peekByteOffhsc_ptr28))ptr::IOWord32{-# LINE117"GHC/ExecutionStack/Internal.hsc"#-}let_srcLoc|nullsrcFile=Nothing|otherwise=Just$SrcLoc{sourceFile=srcFile,sourceLine=fromIntegrallineNo,sourceColumn=fromIntegralcolNo}returnLocation{objectName=objFile,functionName=function,srcLoc=_srcLoc}-- | The size in bytes of a 'locationSize'locationSize::IntlocationSize=(32){-# LINE131"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->PtrAddr->IO[Location]iterFrames0_=return[]iterFramesnframe=dopc<-peekframe::IOAddrmframe<-lookupFramepcrest<-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(PtrSession)foreignimportccallunsafe"&libdwPoolRelease"libdw_pool_release::FunPtr(PtrSession->IO())foreignimportccallunsafe"libdwPoolClear"libdw_pool_clear::IO()foreignimportccallunsafe"libdwLookupLocation"libdw_lookup_location::PtrSession->PtrLocation->Addr->IOCIntforeignimportccallunsafe"libdwGetBacktrace"libdw_get_backtrace::PtrSession->IO(PtrStackTrace)foreignimportccallunsafe"&backtraceFree"backtrace_free::FunPtr(PtrStackTrace->IO())-- | Get an execution stack.collectStackTrace::IO(MaybeStackTrace)collectStackTrace=fmapjoin$withSession$\sess->dost<-withForeignPtrsesslibdw_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)whereshowFrameloc=showString"    ".showLocationloc.showChar'\n'-- | Render a 'Location' as a stringshowLocation::Location->ShowSshowLocationloc=showString(functionNameloc).maybeidshowSrcLoc(srcLocloc).showString" in ".showString(objectNameloc)whereshowSrcLoc::SrcLoc->ShowSshowSrcLocsloc=showString" (".showString(sourceFilesloc).showString":".shows(sourceLinesloc).showString".".shows(sourceColumnsloc).showString")"