pprof 174 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230523152325233523452355236523752385239524052415242524352445245524652475248524952505251525252535254525552565257525852595260526152625263526452655266526752685269527052715272527352745275527652775278527952805281528252835284528552865287528852895290529152925293529452955296529752985299530053015302530353045305530653075308530953105311531253135314531553165317531853195320532153225323532453255326532753285329533053315332533353345335533653375338533953405341534253435344534553465347534853495350535153525353535453555356535753585359536053615362536353645365536653675368536953705371537253735374537553765377537853795380538153825383538453855386538753885389539053915392539353945395539653975398539954005401540254035404540554065407540854095410541154125413541454155416541754185419542054215422542354245425542654275428542954305431543254335434543554365437543854395440544154425443544454455446544754485449545054515452545354545455545654575458545954605461546254635464546554665467546854695470547154725473547454755476547754785479548054815482548354845485548654875488548954905491549254935494549554965497549854995500550155025503550455055506550755085509551055115512551355145515551655175518551955205521552255235524552555265527552855295530553155325533553455355536553755385539554055415542554355445545554655475548554955505551555255535554555555565557555855595560556155625563556455655566556755685569557055715572557355745575557655775578557955805581558255835584558555865587558855895590
  1. #! /usr/bin/env perl
  2. # Copyright (c) 1998-2007, Google Inc.
  3. # All rights reserved.
  4. #
  5. # Redistribution and use in source and binary forms, with or without
  6. # modification, are permitted provided that the following conditions are
  7. # met:
  8. #
  9. # * Redistributions of source code must retain the above copyright
  10. # notice, this list of conditions and the following disclaimer.
  11. # * Redistributions in binary form must reproduce the above
  12. # copyright notice, this list of conditions and the following disclaimer
  13. # in the documentation and/or other materials provided with the
  14. # distribution.
  15. # * Neither the name of Google Inc. nor the names of its
  16. # contributors may be used to endorse or promote products derived from
  17. # this software without specific prior written permission.
  18. #
  19. # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
  20. # "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
  21. # LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
  22. # A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
  23. # OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
  24. # SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
  25. # LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
  26. # DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
  27. # THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
  28. # (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
  29. # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  30. # ---
  31. # Program for printing the profile generated by common/profiler.cc,
  32. # or by the heap profiler (common/debugallocation.cc)
  33. #
  34. # The profile contains a sequence of entries of the form:
  35. # <count> <stack trace>
  36. # This program parses the profile, and generates user-readable
  37. # output.
  38. #
  39. # Examples:
  40. #
  41. # % tools/pprof "program" "profile"
  42. # Enters "interactive" mode
  43. #
  44. # % tools/pprof --text "program" "profile"
  45. # Generates one line per procedure
  46. #
  47. # % tools/pprof --gv "program" "profile"
  48. # Generates annotated call-graph and displays via "gv"
  49. #
  50. # % tools/pprof --gv --focus=Mutex "program" "profile"
  51. # Restrict to code paths that involve an entry that matches "Mutex"
  52. #
  53. # % tools/pprof --gv --focus=Mutex --ignore=string "program" "profile"
  54. # Restrict to code paths that involve an entry that matches "Mutex"
  55. # and does not match "string"
  56. #
  57. # % tools/pprof --list=IBF_CheckDocid "program" "profile"
  58. # Generates disassembly listing of all routines with at least one
  59. # sample that match the --list=<regexp> pattern. The listing is
  60. # annotated with the flat and cumulative sample counts at each line.
  61. #
  62. # % tools/pprof --disasm=IBF_CheckDocid "program" "profile"
  63. # Generates disassembly listing of all routines with at least one
  64. # sample that match the --disasm=<regexp> pattern. The listing is
  65. # annotated with the flat and cumulative sample counts at each PC value.
  66. #
  67. # TODO: Use color to indicate files?
  68. use strict;
  69. use warnings;
  70. use Getopt::Long;
  71. use Cwd;
  72. use POSIX;
  73. my $PPROF_VERSION = "2.0";
  74. # These are the object tools we use which can come from a
  75. # user-specified location using --tools, from the PPROF_TOOLS
  76. # environment variable, or from the environment.
  77. my %obj_tool_map = (
  78. "objdump" => "objdump",
  79. "nm" => "nm",
  80. "addr2line" => "addr2line",
  81. "c++filt" => "c++filt",
  82. ## ConfigureObjTools may add architecture-specific entries:
  83. #"nm_pdb" => "nm-pdb", # for reading windows (PDB-format) executables
  84. #"addr2line_pdb" => "addr2line-pdb", # ditto
  85. #"otool" => "otool", # equivalent of objdump on OS X
  86. );
  87. # NOTE: these are lists, so you can put in commandline flags if you want.
  88. my @DOT = ("dot"); # leave non-absolute, since it may be in /usr/local
  89. my @GV = ("gv");
  90. my @EVINCE = ("evince"); # could also be xpdf or perhaps acroread
  91. my @KCACHEGRIND = ("kcachegrind");
  92. my @PS2PDF = ("ps2pdf");
  93. # These are used for dynamic profiles
  94. my @URL_FETCHER = ("curl", "-s");
  95. # These are the web pages that servers need to support for dynamic profiles
  96. my $HEAP_PAGE = "/pprof/heap";
  97. my $PROFILE_PAGE = "/pprof/profile"; # must support cgi-param "?seconds=#"
  98. my $PMUPROFILE_PAGE = "/pprof/pmuprofile(?:\\?.*)?"; # must support cgi-param
  99. # ?seconds=#&event=x&period=n
  100. my $GROWTH_PAGE = "/pprof/growth";
  101. my $CONTENTION_PAGE = "/pprof/contention";
  102. my $WALL_PAGE = "/pprof/wall(?:\\?.*)?"; # accepts options like namefilter
  103. my $FILTEREDPROFILE_PAGE = "/pprof/filteredprofile(?:\\?.*)?";
  104. my $CENSUSPROFILE_PAGE = "/pprof/censusprofile(?:\\?.*)?"; # must support cgi-param
  105. # "?seconds=#",
  106. # "?tags_regexp=#" and
  107. # "?type=#".
  108. my $SYMBOL_PAGE = "/pprof/symbol"; # must support symbol lookup via POST
  109. my $PROGRAM_NAME_PAGE = "/pprof/cmdline";
  110. # These are the web pages that can be named on the command line.
  111. # All the alternatives must begin with /.
  112. my $PROFILES = "($HEAP_PAGE|$PROFILE_PAGE|$PMUPROFILE_PAGE|" .
  113. "$GROWTH_PAGE|$CONTENTION_PAGE|$WALL_PAGE|" .
  114. "$FILTEREDPROFILE_PAGE|$CENSUSPROFILE_PAGE)";
  115. # default binary name
  116. my $UNKNOWN_BINARY = "(unknown)";
  117. # There is a pervasive dependency on the length (in hex characters,
  118. # i.e., nibbles) of an address, distinguishing between 32-bit and
  119. # 64-bit profiles. To err on the safe size, default to 64-bit here:
  120. my $address_length = 16;
  121. my $dev_null = "/dev/null";
  122. if (! -e $dev_null && $^O =~ /MSWin/) { # $^O is the OS perl was built for
  123. $dev_null = "nul";
  124. }
  125. # A list of paths to search for shared object files
  126. my @prefix_list = ();
  127. # Special routine name that should not have any symbols.
  128. # Used as separator to parse "addr2line -i" output.
  129. my $sep_symbol = '_fini';
  130. my $sep_address = undef;
  131. my @stackTraces;
  132. ##### Argument parsing #####
  133. sub usage_string {
  134. return <<EOF;
  135. Usage:
  136. $0 [options] <program> <profiles>
  137. <profiles> is a space separated list of profile names.
  138. $0 [options] <symbolized-profiles>
  139. <symbolized-profiles> is a list of profile files where each file contains
  140. the necessary symbol mappings as well as profile data (likely generated
  141. with --raw).
  142. $0 [options] <profile>
  143. <profile> is a remote form. Symbols are obtained from host:port$SYMBOL_PAGE
  144. Each name can be:
  145. /path/to/profile - a path to a profile file
  146. host:port[/<service>] - a location of a service to get profile from
  147. The /<service> can be $HEAP_PAGE, $PROFILE_PAGE, /pprof/pmuprofile,
  148. $GROWTH_PAGE, $CONTENTION_PAGE, /pprof/wall,
  149. $CENSUSPROFILE_PAGE, or /pprof/filteredprofile.
  150. For instance:
  151. $0 http://myserver.com:80$HEAP_PAGE
  152. If /<service> is omitted, the service defaults to $PROFILE_PAGE (cpu profiling).
  153. $0 --symbols <program>
  154. Maps addresses to symbol names. In this mode, stdin should be a
  155. list of library mappings, in the same format as is found in the heap-
  156. and cpu-profile files (this loosely matches that of /proc/self/maps
  157. on linux), followed by a list of hex addresses to map, one per line.
  158. For more help with querying remote servers, including how to add the
  159. necessary server-side support code, see this filename (or one like it):
  160. /usr/doc/gperftools-$PPROF_VERSION/pprof_remote_servers.html
  161. Options:
  162. --cum Sort by cumulative data
  163. --base=<base> Subtract <base> from <profile> before display
  164. --interactive Run in interactive mode (interactive "help" gives help) [default]
  165. --seconds=<n> Length of time for dynamic profiles [default=30 secs]
  166. --add_lib=<file> Read additional symbols and line info from the given library
  167. --lib_prefix=<dir> Comma separated list of library path prefixes
  168. --no_strip_temp Do not strip template arguments from function names
  169. Reporting Granularity:
  170. --addresses Report at address level
  171. --lines Report at source line level
  172. --functions Report at function level [default]
  173. --files Report at source file level
  174. Output type:
  175. --text Generate text report
  176. --stacks Generate stack traces similar to the heap profiler (requires --text)
  177. --callgrind Generate callgrind format to stdout
  178. --gv Generate Postscript and display
  179. --evince Generate PDF and display
  180. --web Generate SVG and display
  181. --list=<regexp> Generate source listing of matching routines
  182. --disasm=<regexp> Generate disassembly of matching routines
  183. --symbols Print demangled symbol names found at given addresses
  184. --dot Generate DOT file to stdout
  185. --ps Generate Postcript to stdout
  186. --pdf Generate PDF to stdout
  187. --svg Generate SVG to stdout
  188. --gif Generate GIF to stdout
  189. --raw Generate symbolized pprof data (useful with remote fetch)
  190. --collapsed Generate collapsed stacks for building flame graphs
  191. (see http://www.brendangregg.com/flamegraphs.html)
  192. Heap-Profile Options:
  193. --inuse_space Display in-use (mega)bytes [default]
  194. --inuse_objects Display in-use objects
  195. --alloc_space Display allocated (mega)bytes
  196. --alloc_objects Display allocated objects
  197. --show_bytes Display space in bytes
  198. --drop_negative Ignore negative differences
  199. Contention-profile options:
  200. --total_delay Display total delay at each region [default]
  201. --contentions Display number of delays at each region
  202. --mean_delay Display mean delay at each region
  203. Call-graph Options:
  204. --nodecount=<n> Show at most so many nodes [default=80]
  205. --nodefraction=<f> Hide nodes below <f>*total [default=.005]
  206. --edgefraction=<f> Hide edges below <f>*total [default=.001]
  207. --maxdegree=<n> Max incoming/outgoing edges per node [default=8]
  208. --focus=<regexp> Focus on nodes matching <regexp>
  209. --ignore=<regexp> Ignore nodes matching <regexp>
  210. --scale=<n> Set GV scaling [default=0]
  211. --heapcheck Make nodes with non-0 object counts
  212. (i.e. direct leak generators) more visible
  213. Miscellaneous:
  214. --no-auto-signal-frm Automatically drop 2nd frame that is always same (cpu-only)
  215. (assuming that it is artifact of bad stack captures
  216. which include signal handler frames)
  217. --show_addresses Always show addresses when applicable
  218. --tools=<prefix or binary:fullpath>[,...] \$PATH for object tool pathnames
  219. --test Run unit tests
  220. --help This message
  221. --version Version information
  222. Environment Variables:
  223. PPROF_TMPDIR Profiles directory. Defaults to \$HOME/pprof
  224. PPROF_TOOLS Prefix for object tools pathnames
  225. Examples:
  226. $0 /bin/ls ls.prof
  227. Enters "interactive" mode
  228. $0 --text /bin/ls ls.prof
  229. Outputs one line per procedure
  230. $0 --web /bin/ls ls.prof
  231. Displays annotated call-graph in web browser
  232. $0 --gv /bin/ls ls.prof
  233. Displays annotated call-graph via 'gv'
  234. $0 --gv --focus=Mutex /bin/ls ls.prof
  235. Restricts to code paths including a .*Mutex.* entry
  236. $0 --gv --focus=Mutex --ignore=string /bin/ls ls.prof
  237. Code paths including Mutex but not string
  238. $0 --list=getdir /bin/ls ls.prof
  239. (Per-line) annotated source listing for getdir()
  240. $0 --disasm=getdir /bin/ls ls.prof
  241. (Per-PC) annotated disassembly for getdir()
  242. $0 http://localhost:1234/
  243. Enters "interactive" mode
  244. $0 --text localhost:1234
  245. Outputs one line per procedure for localhost:1234
  246. $0 --raw localhost:1234 > ./local.raw
  247. $0 --text ./local.raw
  248. Fetches a remote profile for later analysis and then
  249. analyzes it in text mode.
  250. EOF
  251. }
  252. sub version_string {
  253. return <<EOF
  254. pprof (part of gperftools $PPROF_VERSION)
  255. Copyright 1998-2007 Google Inc.
  256. This is BSD licensed software; see the source for copying conditions
  257. and license information.
  258. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A
  259. PARTICULAR PURPOSE.
  260. EOF
  261. }
  262. sub usage {
  263. my $msg = shift;
  264. print STDERR "$msg\n\n";
  265. print STDERR usage_string();
  266. exit(1);
  267. }
  268. sub Init() {
  269. # Setup tmp-file name and handler to clean it up.
  270. # We do this in the very beginning so that we can use
  271. # error() and cleanup() function anytime here after.
  272. $main::tmpfile_sym = "/tmp/pprof$$.sym";
  273. $main::tmpfile_ps = "/tmp/pprof$$";
  274. $main::next_tmpfile = 0;
  275. $SIG{'INT'} = \&sighandler;
  276. # Cache from filename/linenumber to source code
  277. $main::source_cache = ();
  278. $main::opt_help = 0;
  279. $main::opt_version = 0;
  280. $main::opt_show_addresses = 0;
  281. $main::opt_no_auto_signal_frames = 0;
  282. $main::opt_cum = 0;
  283. $main::opt_base = '';
  284. $main::opt_addresses = 0;
  285. $main::opt_lines = 0;
  286. $main::opt_functions = 0;
  287. $main::opt_files = 0;
  288. $main::opt_lib_prefix = "";
  289. $main::opt_text = 0;
  290. $main::opt_stacks = 0;
  291. $main::opt_callgrind = 0;
  292. $main::opt_list = "";
  293. $main::opt_disasm = "";
  294. $main::opt_symbols = 0;
  295. $main::opt_gv = 0;
  296. $main::opt_evince = 0;
  297. $main::opt_web = 0;
  298. $main::opt_dot = 0;
  299. $main::opt_ps = 0;
  300. $main::opt_pdf = 0;
  301. $main::opt_gif = 0;
  302. $main::opt_svg = 0;
  303. $main::opt_raw = 0;
  304. $main::opt_collapsed = 0;
  305. $main::opt_nodecount = 80;
  306. $main::opt_nodefraction = 0.005;
  307. $main::opt_edgefraction = 0.001;
  308. $main::opt_maxdegree = 8;
  309. $main::opt_focus = '';
  310. $main::opt_ignore = '';
  311. $main::opt_scale = 0;
  312. $main::opt_heapcheck = 0;
  313. $main::opt_seconds = 30;
  314. $main::opt_lib = "";
  315. $main::opt_inuse_space = 0;
  316. $main::opt_inuse_objects = 0;
  317. $main::opt_alloc_space = 0;
  318. $main::opt_alloc_objects = 0;
  319. $main::opt_show_bytes = 0;
  320. $main::opt_drop_negative = 0;
  321. $main::opt_interactive = 0;
  322. $main::opt_total_delay = 0;
  323. $main::opt_contentions = 0;
  324. $main::opt_mean_delay = 0;
  325. $main::opt_tools = "";
  326. $main::opt_debug = 0;
  327. $main::opt_test = 0;
  328. # Do not strip template argument in function names
  329. $main::opt_no_strip_temp = 0;
  330. # These are undocumented flags used only by unittests.
  331. $main::opt_test_stride = 0;
  332. # Are we using $SYMBOL_PAGE?
  333. $main::use_symbol_page = 0;
  334. # Files returned by TempName.
  335. %main::tempnames = ();
  336. # Type of profile we are dealing with
  337. # Supported types:
  338. # cpu
  339. # heap
  340. # growth
  341. # contention
  342. $main::profile_type = ''; # Empty type means "unknown"
  343. GetOptions("help!" => \$main::opt_help,
  344. "version!" => \$main::opt_version,
  345. "show_addresses!"=> \$main::opt_show_addresses,
  346. "no-auto-signal-frm!"=> \$main::opt_no_auto_signal_frames,
  347. "cum!" => \$main::opt_cum,
  348. "base=s" => \$main::opt_base,
  349. "seconds=i" => \$main::opt_seconds,
  350. "add_lib=s" => \$main::opt_lib,
  351. "lib_prefix=s" => \$main::opt_lib_prefix,
  352. "functions!" => \$main::opt_functions,
  353. "lines!" => \$main::opt_lines,
  354. "addresses!" => \$main::opt_addresses,
  355. "files!" => \$main::opt_files,
  356. "text!" => \$main::opt_text,
  357. "stacks!" => \$main::opt_stacks,
  358. "callgrind!" => \$main::opt_callgrind,
  359. "list=s" => \$main::opt_list,
  360. "disasm=s" => \$main::opt_disasm,
  361. "symbols!" => \$main::opt_symbols,
  362. "gv!" => \$main::opt_gv,
  363. "evince!" => \$main::opt_evince,
  364. "web!" => \$main::opt_web,
  365. "dot!" => \$main::opt_dot,
  366. "ps!" => \$main::opt_ps,
  367. "pdf!" => \$main::opt_pdf,
  368. "svg!" => \$main::opt_svg,
  369. "gif!" => \$main::opt_gif,
  370. "raw!" => \$main::opt_raw,
  371. "collapsed!" => \$main::opt_collapsed,
  372. "interactive!" => \$main::opt_interactive,
  373. "nodecount=i" => \$main::opt_nodecount,
  374. "nodefraction=f" => \$main::opt_nodefraction,
  375. "edgefraction=f" => \$main::opt_edgefraction,
  376. "maxdegree=i" => \$main::opt_maxdegree,
  377. "focus=s" => \$main::opt_focus,
  378. "ignore=s" => \$main::opt_ignore,
  379. "scale=i" => \$main::opt_scale,
  380. "heapcheck" => \$main::opt_heapcheck,
  381. "inuse_space!" => \$main::opt_inuse_space,
  382. "inuse_objects!" => \$main::opt_inuse_objects,
  383. "alloc_space!" => \$main::opt_alloc_space,
  384. "alloc_objects!" => \$main::opt_alloc_objects,
  385. "show_bytes!" => \$main::opt_show_bytes,
  386. "drop_negative!" => \$main::opt_drop_negative,
  387. "total_delay!" => \$main::opt_total_delay,
  388. "contentions!" => \$main::opt_contentions,
  389. "mean_delay!" => \$main::opt_mean_delay,
  390. "tools=s" => \$main::opt_tools,
  391. "no_strip_temp!" => \$main::opt_no_strip_temp,
  392. "test!" => \$main::opt_test,
  393. "debug!" => \$main::opt_debug,
  394. # Undocumented flags used only by unittests:
  395. "test_stride=i" => \$main::opt_test_stride,
  396. ) || usage("Invalid option(s)");
  397. # Deal with the standard --help and --version
  398. if ($main::opt_help) {
  399. print usage_string();
  400. exit(0);
  401. }
  402. if ($main::opt_version) {
  403. print version_string();
  404. exit(0);
  405. }
  406. # Disassembly/listing/symbols mode requires address-level info
  407. if ($main::opt_disasm || $main::opt_list || $main::opt_symbols) {
  408. $main::opt_functions = 0;
  409. $main::opt_lines = 0;
  410. $main::opt_addresses = 1;
  411. $main::opt_files = 0;
  412. }
  413. # Check heap-profiling flags
  414. if ($main::opt_inuse_space +
  415. $main::opt_inuse_objects +
  416. $main::opt_alloc_space +
  417. $main::opt_alloc_objects > 1) {
  418. usage("Specify at most on of --inuse/--alloc options");
  419. }
  420. # Check output granularities
  421. my $grains =
  422. $main::opt_functions +
  423. $main::opt_lines +
  424. $main::opt_addresses +
  425. $main::opt_files +
  426. 0;
  427. if ($grains > 1) {
  428. usage("Only specify one output granularity option");
  429. }
  430. if ($grains == 0) {
  431. $main::opt_functions = 1;
  432. }
  433. # Check output modes
  434. my $modes =
  435. $main::opt_text +
  436. $main::opt_callgrind +
  437. ($main::opt_list eq '' ? 0 : 1) +
  438. ($main::opt_disasm eq '' ? 0 : 1) +
  439. ($main::opt_symbols == 0 ? 0 : 1) +
  440. $main::opt_gv +
  441. $main::opt_evince +
  442. $main::opt_web +
  443. $main::opt_dot +
  444. $main::opt_ps +
  445. $main::opt_pdf +
  446. $main::opt_svg +
  447. $main::opt_gif +
  448. $main::opt_raw +
  449. $main::opt_collapsed +
  450. $main::opt_interactive +
  451. 0;
  452. if ($modes > 1) {
  453. usage("Only specify one output mode");
  454. }
  455. if ($modes == 0) {
  456. if (-t STDOUT) { # If STDOUT is a tty, activate interactive mode
  457. $main::opt_interactive = 1;
  458. } else {
  459. $main::opt_text = 1;
  460. }
  461. }
  462. if ($main::opt_test) {
  463. RunUnitTests();
  464. # Should not return
  465. exit(1);
  466. }
  467. # Binary name and profile arguments list
  468. $main::prog = "";
  469. @main::pfile_args = ();
  470. # Remote profiling without a binary (using $SYMBOL_PAGE instead)
  471. if (@ARGV > 0) {
  472. if (IsProfileURL($ARGV[0])) {
  473. printf STDERR "Using remote profile at $ARGV[0].\n";
  474. $main::use_symbol_page = 1;
  475. } elsif (IsSymbolizedProfileFile($ARGV[0])) {
  476. $main::use_symbolized_profile = 1;
  477. $main::prog = $UNKNOWN_BINARY; # will be set later from the profile file
  478. }
  479. }
  480. if ($main::use_symbol_page || $main::use_symbolized_profile) {
  481. # We don't need a binary!
  482. my %disabled = ('--lines' => $main::opt_lines,
  483. '--disasm' => $main::opt_disasm);
  484. for my $option (keys %disabled) {
  485. usage("$option cannot be used without a binary") if $disabled{$option};
  486. }
  487. # Set $main::prog later...
  488. scalar(@ARGV) || usage("Did not specify profile file");
  489. } elsif ($main::opt_symbols) {
  490. # --symbols needs a binary-name (to run nm on, etc) but not profiles
  491. $main::prog = shift(@ARGV) || usage("Did not specify program");
  492. } else {
  493. $main::prog = shift(@ARGV) || usage("Did not specify program");
  494. scalar(@ARGV) || usage("Did not specify profile file");
  495. }
  496. # Parse profile file/location arguments
  497. foreach my $farg (@ARGV) {
  498. if ($farg =~ m/(.*)\@([0-9]+)(|\/.*)$/ ) {
  499. my $machine = $1;
  500. my $num_machines = $2;
  501. my $path = $3;
  502. for (my $i = 0; $i < $num_machines; $i++) {
  503. unshift(@main::pfile_args, "$i.$machine$path");
  504. }
  505. } else {
  506. unshift(@main::pfile_args, $farg);
  507. }
  508. }
  509. if ($main::use_symbol_page) {
  510. unless (IsProfileURL($main::pfile_args[0])) {
  511. error("The first profile should be a remote form to use $SYMBOL_PAGE\n");
  512. }
  513. CheckSymbolPage();
  514. $main::prog = FetchProgramName();
  515. } elsif (!$main::use_symbolized_profile) { # may not need objtools!
  516. ConfigureObjTools($main::prog)
  517. }
  518. # Break the opt_lib_prefix into the prefix_list array
  519. @prefix_list = split (',', $main::opt_lib_prefix);
  520. # Remove trailing / from the prefixes, in the list to prevent
  521. # searching things like /my/path//lib/mylib.so
  522. foreach (@prefix_list) {
  523. s|/+$||;
  524. }
  525. }
  526. sub Main() {
  527. Init();
  528. $main::collected_profile = undef;
  529. @main::profile_files = ();
  530. $main::op_time = time();
  531. # Printing symbols is special and requires a lot less info that most.
  532. if ($main::opt_symbols) {
  533. PrintSymbols(*STDIN); # Get /proc/maps and symbols output from stdin
  534. return;
  535. }
  536. # Fetch all profile data
  537. FetchDynamicProfiles();
  538. # this will hold symbols that we read from the profile files
  539. my $symbol_map = {};
  540. # Read one profile, pick the last item on the list
  541. my $data = ReadProfile($main::prog, pop(@main::profile_files));
  542. my $profile = $data->{profile};
  543. my $pcs = $data->{pcs};
  544. my $libs = $data->{libs}; # Info about main program and shared libraries
  545. $symbol_map = MergeSymbols($symbol_map, $data->{symbols});
  546. # Add additional profiles, if available.
  547. if (scalar(@main::profile_files) > 0) {
  548. foreach my $pname (@main::profile_files) {
  549. my $data2 = ReadProfile($main::prog, $pname);
  550. $profile = AddProfile($profile, $data2->{profile});
  551. $pcs = AddPcs($pcs, $data2->{pcs});
  552. $symbol_map = MergeSymbols($symbol_map, $data2->{symbols});
  553. }
  554. }
  555. # Subtract base from profile, if specified
  556. if ($main::opt_base ne '') {
  557. my $base = ReadProfile($main::prog, $main::opt_base);
  558. $profile = SubtractProfile($profile, $base->{profile});
  559. $pcs = AddPcs($pcs, $base->{pcs});
  560. $symbol_map = MergeSymbols($symbol_map, $base->{symbols});
  561. }
  562. # Get total data in profile
  563. my $total = TotalProfile($profile);
  564. # Collect symbols
  565. my $symbols;
  566. if ($main::use_symbolized_profile) {
  567. $symbols = FetchSymbols($pcs, $symbol_map);
  568. } elsif ($main::use_symbol_page) {
  569. $symbols = FetchSymbols($pcs);
  570. } else {
  571. # TODO(csilvers): $libs uses the /proc/self/maps data from profile1,
  572. # which may differ from the data from subsequent profiles, especially
  573. # if they were run on different machines. Use appropriate libs for
  574. # each pc somehow.
  575. $symbols = ExtractSymbols($libs, $pcs);
  576. }
  577. # Remove uniniteresting stack items
  578. $profile = RemoveUninterestingFrames($symbols, $profile);
  579. # Focus?
  580. if ($main::opt_focus ne '') {
  581. $profile = FocusProfile($symbols, $profile, $main::opt_focus);
  582. }
  583. # Ignore?
  584. if ($main::opt_ignore ne '') {
  585. $profile = IgnoreProfile($symbols, $profile, $main::opt_ignore);
  586. }
  587. my $calls = ExtractCalls($symbols, $profile);
  588. # Reduce profiles to required output granularity, and also clean
  589. # each stack trace so a given entry exists at most once.
  590. my $reduced = ReduceProfile($symbols, $profile);
  591. # Get derived profiles
  592. my $flat = FlatProfile($reduced);
  593. my $cumulative = CumulativeProfile($reduced);
  594. # Print
  595. if (!$main::opt_interactive) {
  596. if ($main::opt_disasm) {
  597. PrintDisassembly($libs, $flat, $cumulative, $main::opt_disasm);
  598. } elsif ($main::opt_list) {
  599. PrintListing($total, $libs, $flat, $cumulative, $main::opt_list, 0);
  600. } elsif ($main::opt_text) {
  601. # Make sure the output is empty when have nothing to report
  602. # (only matters when --heapcheck is given but we must be
  603. # compatible with old branches that did not pass --heapcheck always):
  604. if ($total != 0) {
  605. printf("Total: %s %s\n", Unparse($total), Units());
  606. }
  607. if ($main::opt_stacks) {
  608. printf("Stacks:\n\n");
  609. PrintStacksForText($symbols, $profile);
  610. }
  611. PrintText($symbols, $flat, $cumulative, -1);
  612. } elsif ($main::opt_raw) {
  613. PrintSymbolizedProfile($symbols, $profile, $main::prog);
  614. } elsif ($main::opt_collapsed) {
  615. PrintCollapsedStacks($symbols, $profile);
  616. } elsif ($main::opt_callgrind) {
  617. PrintCallgrind($calls);
  618. } else {
  619. if (PrintDot($main::prog, $symbols, $profile, $flat, $cumulative, $total)) {
  620. if ($main::opt_gv) {
  621. RunGV(TempName($main::next_tmpfile, "ps"), "");
  622. } elsif ($main::opt_evince) {
  623. RunEvince(TempName($main::next_tmpfile, "pdf"), "");
  624. } elsif ($main::opt_web) {
  625. my $tmp = TempName($main::next_tmpfile, "svg");
  626. RunWeb($tmp);
  627. # The command we run might hand the file name off
  628. # to an already running browser instance and then exit.
  629. # Normally, we'd remove $tmp on exit (right now),
  630. # but fork a child to remove $tmp a little later, so that the
  631. # browser has time to load it first.
  632. delete $main::tempnames{$tmp};
  633. if (fork() == 0) {
  634. sleep 5;
  635. unlink($tmp);
  636. exit(0);
  637. }
  638. }
  639. } else {
  640. cleanup();
  641. exit(1);
  642. }
  643. }
  644. } else {
  645. InteractiveMode($profile, $symbols, $libs, $total);
  646. }
  647. cleanup();
  648. exit(0);
  649. }
  650. ##### Entry Point #####
  651. Main();
  652. # Temporary code to detect if we're running on a Goobuntu system.
  653. # These systems don't have the right stuff installed for the special
  654. # Readline libraries to work, so as a temporary workaround, we default
  655. # to using the normal stdio code, rather than the fancier readline-based
  656. # code
  657. sub ReadlineMightFail {
  658. if (-e '/lib/libtermcap.so.2') {
  659. return 0; # libtermcap exists, so readline should be okay
  660. } else {
  661. return 1;
  662. }
  663. }
  664. sub RunGV {
  665. my $fname = shift;
  666. my $bg = shift; # "" or " &" if we should run in background
  667. if (!system(ShellEscape(@GV, "--version") . " >$dev_null 2>&1")) {
  668. # Options using double dash are supported by this gv version.
  669. # Also, turn on noantialias to better handle bug in gv for
  670. # postscript files with large dimensions.
  671. # TODO: Maybe we should not pass the --noantialias flag
  672. # if the gv version is known to work properly without the flag.
  673. system(ShellEscape(@GV, "--scale=$main::opt_scale", "--noantialias", $fname)
  674. . $bg);
  675. } else {
  676. # Old gv version - only supports options that use single dash.
  677. print STDERR ShellEscape(@GV, "-scale", $main::opt_scale) . "\n";
  678. system(ShellEscape(@GV, "-scale", "$main::opt_scale", $fname) . $bg);
  679. }
  680. }
  681. sub RunEvince {
  682. my $fname = shift;
  683. my $bg = shift; # "" or " &" if we should run in background
  684. system(ShellEscape(@EVINCE, $fname) . $bg);
  685. }
  686. sub RunWeb {
  687. my $fname = shift;
  688. print STDERR "Loading web page file:///$fname\n";
  689. if (`uname` =~ /Darwin/) {
  690. # OS X: open will use standard preference for SVG files.
  691. system("/usr/bin/open", $fname);
  692. return;
  693. }
  694. if (`uname` =~ /MINGW/) {
  695. # Windows(MinGW): open will use standard preference for SVG files.
  696. system("cmd", "/c", "start", $fname);
  697. return;
  698. }
  699. # Some kind of Unix; try generic symlinks, then specific browsers.
  700. # (Stop once we find one.)
  701. # Works best if the browser is already running.
  702. my @alt = (
  703. "/etc/alternatives/gnome-www-browser",
  704. "/etc/alternatives/x-www-browser",
  705. "google-chrome",
  706. "firefox",
  707. );
  708. foreach my $b (@alt) {
  709. if (system($b, $fname) == 0) {
  710. return;
  711. }
  712. }
  713. print STDERR "Could not load web browser.\n";
  714. }
  715. sub RunKcachegrind {
  716. my $fname = shift;
  717. my $bg = shift; # "" or " &" if we should run in background
  718. print STDERR "Starting '@KCACHEGRIND " . $fname . $bg . "'\n";
  719. system(ShellEscape(@KCACHEGRIND, $fname) . $bg);
  720. }
  721. ##### Interactive helper routines #####
  722. sub InteractiveMode {
  723. $| = 1; # Make output unbuffered for interactive mode
  724. my ($orig_profile, $symbols, $libs, $total) = @_;
  725. print STDERR "Welcome to pprof! For help, type 'help'.\n";
  726. # Use ReadLine if it's installed and input comes from a console.
  727. if ( -t STDIN &&
  728. !ReadlineMightFail() &&
  729. defined(eval {require Term::ReadLine}) ) {
  730. my $term = new Term::ReadLine 'pprof';
  731. while ( defined ($_ = $term->readline('(pprof) '))) {
  732. $term->addhistory($_) if /\S/;
  733. if (!InteractiveCommand($orig_profile, $symbols, $libs, $total, $_)) {
  734. last; # exit when we get an interactive command to quit
  735. }
  736. }
  737. } else { # don't have readline
  738. while (1) {
  739. print STDERR "(pprof) ";
  740. $_ = <STDIN>;
  741. last if ! defined $_ ;
  742. s/\r//g; # turn windows-looking lines into unix-looking lines
  743. # Save some flags that might be reset by InteractiveCommand()
  744. my $save_opt_lines = $main::opt_lines;
  745. if (!InteractiveCommand($orig_profile, $symbols, $libs, $total, $_)) {
  746. last; # exit when we get an interactive command to quit
  747. }
  748. # Restore flags
  749. $main::opt_lines = $save_opt_lines;
  750. }
  751. }
  752. }
  753. # Takes two args: orig profile, and command to run.
  754. # Returns 1 if we should keep going, or 0 if we were asked to quit
  755. sub InteractiveCommand {
  756. my($orig_profile, $symbols, $libs, $total, $command) = @_;
  757. $_ = $command; # just to make future m//'s easier
  758. if (!defined($_)) {
  759. print STDERR "\n";
  760. return 0;
  761. }
  762. if (m/^\s*quit/) {
  763. return 0;
  764. }
  765. if (m/^\s*help/) {
  766. InteractiveHelpMessage();
  767. return 1;
  768. }
  769. # Clear all the mode options -- mode is controlled by "$command"
  770. $main::opt_text = 0;
  771. $main::opt_callgrind = 0;
  772. $main::opt_disasm = 0;
  773. $main::opt_list = 0;
  774. $main::opt_gv = 0;
  775. $main::opt_evince = 0;
  776. $main::opt_cum = 0;
  777. if (m/^\s*(text|top)(\d*)\s*(.*)/) {
  778. $main::opt_text = 1;
  779. my $line_limit = ($2 ne "") ? int($2) : 10;
  780. my $routine;
  781. my $ignore;
  782. ($routine, $ignore) = ParseInteractiveArgs($3);
  783. my $profile = ProcessProfile($total, $orig_profile, $symbols, "", $ignore);
  784. my $reduced = ReduceProfile($symbols, $profile);
  785. # Get derived profiles
  786. my $flat = FlatProfile($reduced);
  787. my $cumulative = CumulativeProfile($reduced);
  788. PrintText($symbols, $flat, $cumulative, $line_limit);
  789. return 1;
  790. }
  791. if (m/^\s*callgrind\s*([^ \n]*)/) {
  792. $main::opt_callgrind = 1;
  793. # Get derived profiles
  794. my $calls = ExtractCalls($symbols, $orig_profile);
  795. my $filename = $1;
  796. if ( $1 eq '' ) {
  797. $filename = TempName($main::next_tmpfile, "callgrind");
  798. }
  799. PrintCallgrind($calls, $filename);
  800. if ( $1 eq '' ) {
  801. RunKcachegrind($filename, " & ");
  802. $main::next_tmpfile++;
  803. }
  804. return 1;
  805. }
  806. if (m/^\s*(web)?list\s*(.+)/) {
  807. my $html = (defined($1) && ($1 eq "web"));
  808. $main::opt_list = 1;
  809. my $routine;
  810. my $ignore;
  811. ($routine, $ignore) = ParseInteractiveArgs($2);
  812. my $profile = ProcessProfile($total, $orig_profile, $symbols, "", $ignore);
  813. my $reduced = ReduceProfile($symbols, $profile);
  814. # Get derived profiles
  815. my $flat = FlatProfile($reduced);
  816. my $cumulative = CumulativeProfile($reduced);
  817. PrintListing($total, $libs, $flat, $cumulative, $routine, $html);
  818. return 1;
  819. }
  820. if (m/^\s*disasm\s*(.+)/) {
  821. $main::opt_disasm = 1;
  822. my $routine;
  823. my $ignore;
  824. ($routine, $ignore) = ParseInteractiveArgs($1);
  825. # Process current profile to account for various settings
  826. my $profile = ProcessProfile($total, $orig_profile, $symbols, "", $ignore);
  827. my $reduced = ReduceProfile($symbols, $profile);
  828. # Get derived profiles
  829. my $flat = FlatProfile($reduced);
  830. my $cumulative = CumulativeProfile($reduced);
  831. PrintDisassembly($libs, $flat, $cumulative, $routine);
  832. return 1;
  833. }
  834. if (m/^\s*(gv|web|evince)\s*(.*)/) {
  835. $main::opt_gv = 0;
  836. $main::opt_evince = 0;
  837. $main::opt_web = 0;
  838. if ($1 eq "gv") {
  839. $main::opt_gv = 1;
  840. } elsif ($1 eq "evince") {
  841. $main::opt_evince = 1;
  842. } elsif ($1 eq "web") {
  843. $main::opt_web = 1;
  844. }
  845. my $focus;
  846. my $ignore;
  847. ($focus, $ignore) = ParseInteractiveArgs($2);
  848. # Process current profile to account for various settings
  849. my $profile = ProcessProfile($total, $orig_profile, $symbols,
  850. $focus, $ignore);
  851. my $reduced = ReduceProfile($symbols, $profile);
  852. # Get derived profiles
  853. my $flat = FlatProfile($reduced);
  854. my $cumulative = CumulativeProfile($reduced);
  855. if (PrintDot($main::prog, $symbols, $profile, $flat, $cumulative, $total)) {
  856. if ($main::opt_gv) {
  857. RunGV(TempName($main::next_tmpfile, "ps"), " &");
  858. } elsif ($main::opt_evince) {
  859. RunEvince(TempName($main::next_tmpfile, "pdf"), " &");
  860. } elsif ($main::opt_web) {
  861. RunWeb(TempName($main::next_tmpfile, "svg"));
  862. }
  863. $main::next_tmpfile++;
  864. }
  865. return 1;
  866. }
  867. if (m/^\s*$/) {
  868. return 1;
  869. }
  870. print STDERR "Unknown command: try 'help'.\n";
  871. return 1;
  872. }
  873. sub ProcessProfile {
  874. my $total_count = shift;
  875. my $orig_profile = shift;
  876. my $symbols = shift;
  877. my $focus = shift;
  878. my $ignore = shift;
  879. # Process current profile to account for various settings
  880. my $profile = $orig_profile;
  881. printf("Total: %s %s\n", Unparse($total_count), Units());
  882. if ($focus ne '') {
  883. $profile = FocusProfile($symbols, $profile, $focus);
  884. my $focus_count = TotalProfile($profile);
  885. printf("After focusing on '%s': %s %s of %s (%0.1f%%)\n",
  886. $focus,
  887. Unparse($focus_count), Units(),
  888. Unparse($total_count), ($focus_count*100.0) / $total_count);
  889. }
  890. if ($ignore ne '') {
  891. $profile = IgnoreProfile($symbols, $profile, $ignore);
  892. my $ignore_count = TotalProfile($profile);
  893. printf("After ignoring '%s': %s %s of %s (%0.1f%%)\n",
  894. $ignore,
  895. Unparse($ignore_count), Units(),
  896. Unparse($total_count),
  897. ($ignore_count*100.0) / $total_count);
  898. }
  899. return $profile;
  900. }
  901. sub InteractiveHelpMessage {
  902. print STDERR <<ENDOFHELP;
  903. Interactive pprof mode
  904. Commands:
  905. gv
  906. gv [focus] [-ignore1] [-ignore2]
  907. Show graphical hierarchical display of current profile. Without
  908. any arguments, shows all samples in the profile. With the optional
  909. "focus" argument, restricts the samples shown to just those where
  910. the "focus" regular expression matches a routine name on the stack
  911. trace.
  912. web
  913. web [focus] [-ignore1] [-ignore2]
  914. Like GV, but displays profile in your web browser instead of using
  915. Ghostview. Works best if your web browser is already running.
  916. To change the browser that gets used:
  917. On Linux, set the /etc/alternatives/gnome-www-browser symlink.
  918. On OS X, change the Finder association for SVG files.
  919. list [routine_regexp] [-ignore1] [-ignore2]
  920. Show source listing of routines whose names match "routine_regexp"
  921. weblist [routine_regexp] [-ignore1] [-ignore2]
  922. Displays a source listing of routines whose names match "routine_regexp"
  923. in a web browser. You can click on source lines to view the
  924. corresponding disassembly.
  925. top [--cum] [-ignore1] [-ignore2]
  926. top20 [--cum] [-ignore1] [-ignore2]
  927. top37 [--cum] [-ignore1] [-ignore2]
  928. Show top lines ordered by flat profile count, or cumulative count
  929. if --cum is specified. If a number is present after 'top', the
  930. top K routines will be shown (defaults to showing the top 10)
  931. disasm [routine_regexp] [-ignore1] [-ignore2]
  932. Show disassembly of routines whose names match "routine_regexp",
  933. annotated with sample counts.
  934. callgrind
  935. callgrind [filename]
  936. Generates callgrind file. If no filename is given, kcachegrind is called.
  937. help - This listing
  938. quit or ^D - End pprof
  939. For commands that accept optional -ignore tags, samples where any routine in
  940. the stack trace matches the regular expression in any of the -ignore
  941. parameters will be ignored.
  942. Further pprof details are available at this location (or one similar):
  943. /usr/doc/gperftools-$PPROF_VERSION/cpu_profiler.html
  944. /usr/doc/gperftools-$PPROF_VERSION/heap_profiler.html
  945. ENDOFHELP
  946. }
  947. sub ParseInteractiveArgs {
  948. my $args = shift;
  949. my $focus = "";
  950. my $ignore = "";
  951. my @x = split(/ +/, $args);
  952. foreach $a (@x) {
  953. if ($a =~ m/^(--|-)lines$/) {
  954. $main::opt_lines = 1;
  955. } elsif ($a =~ m/^(--|-)cum$/) {
  956. $main::opt_cum = 1;
  957. } elsif ($a =~ m/^-(.*)/) {
  958. $ignore .= (($ignore ne "") ? "|" : "" ) . $1;
  959. } else {
  960. $focus .= (($focus ne "") ? "|" : "" ) . $a;
  961. }
  962. }
  963. if ($ignore ne "") {
  964. print STDERR "Ignoring samples in call stacks that match '$ignore'\n";
  965. }
  966. return ($focus, $ignore);
  967. }
  968. ##### Output code #####
  969. sub TempName {
  970. my $fnum = shift;
  971. my $ext = shift;
  972. my $file = "$main::tmpfile_ps.$fnum.$ext";
  973. $main::tempnames{$file} = 1;
  974. return $file;
  975. }
  976. # Print profile data in packed binary format (64-bit) to standard out
  977. sub PrintProfileData {
  978. my $profile = shift;
  979. my $big_endian = pack("L", 1) eq pack("N", 1);
  980. # print header (64-bit style)
  981. # (zero) (header-size) (version) (sample-period) (zero)
  982. if ($big_endian) {
  983. print pack('L*', 0, 0, 0, 3, 0, 0, 0, 1, 0, 0);
  984. }
  985. else {
  986. print pack('L*', 0, 0, 3, 0, 0, 0, 1, 0, 0, 0);
  987. }
  988. foreach my $k (keys(%{$profile})) {
  989. my $count = $profile->{$k};
  990. my @addrs = split(/\n/, $k);
  991. if ($#addrs >= 0) {
  992. my $depth = $#addrs + 1;
  993. # int(foo / 2**32) is the only reliable way to get rid of bottom
  994. # 32 bits on both 32- and 64-bit systems.
  995. if ($big_endian) {
  996. print pack('L*', int($count / 2**32), $count & 0xFFFFFFFF);
  997. print pack('L*', int($depth / 2**32), $depth & 0xFFFFFFFF);
  998. }
  999. else {
  1000. print pack('L*', $count & 0xFFFFFFFF, int($count / 2**32));
  1001. print pack('L*', $depth & 0xFFFFFFFF, int($depth / 2**32));
  1002. }
  1003. foreach my $full_addr (@addrs) {
  1004. my $addr = $full_addr;
  1005. $addr =~ s/0x0*//; # strip off leading 0x, zeroes
  1006. if (length($addr) > 16) {
  1007. print STDERR "Invalid address in profile: $full_addr\n";
  1008. next;
  1009. }
  1010. my $low_addr = substr($addr, -8); # get last 8 hex chars
  1011. my $high_addr = substr($addr, -16, 8); # get up to 8 more hex chars
  1012. if ($big_endian) {
  1013. print pack('L*', hex('0x' . $high_addr), hex('0x' . $low_addr));
  1014. }
  1015. else {
  1016. print pack('L*', hex('0x' . $low_addr), hex('0x' . $high_addr));
  1017. }
  1018. }
  1019. }
  1020. }
  1021. }
  1022. # Print symbols and profile data
  1023. sub PrintSymbolizedProfile {
  1024. my $symbols = shift;
  1025. my $profile = shift;
  1026. my $prog = shift;
  1027. $SYMBOL_PAGE =~ m,[^/]+$,; # matches everything after the last slash
  1028. my $symbol_marker = $&;
  1029. print '--- ', $symbol_marker, "\n";
  1030. if (defined($prog)) {
  1031. print 'binary=', $prog, "\n";
  1032. }
  1033. while (my ($pc, $name) = each(%{$symbols})) {
  1034. my $sep = ' ';
  1035. print '0x', $pc;
  1036. # We have a list of function names, which include the inlined
  1037. # calls. They are separated (and terminated) by --, which is
  1038. # illegal in function names.
  1039. for (my $j = 2; $j <= $#{$name}; $j += 3) {
  1040. print $sep, $name->[$j];
  1041. $sep = '--';
  1042. }
  1043. print "\n";
  1044. }
  1045. print '---', "\n";
  1046. $PROFILE_PAGE =~ m,[^/]+$,; # matches everything after the last slash
  1047. my $profile_marker = $&;
  1048. print '--- ', $profile_marker, "\n";
  1049. if (defined($main::collected_profile)) {
  1050. # if used with remote fetch, simply dump the collected profile to output.
  1051. open(SRC, "<$main::collected_profile");
  1052. while (<SRC>) {
  1053. print $_;
  1054. }
  1055. close(SRC);
  1056. } else {
  1057. # dump a cpu-format profile to standard out
  1058. PrintProfileData($profile);
  1059. }
  1060. }
  1061. # Print text output
  1062. sub PrintText {
  1063. my $symbols = shift;
  1064. my $flat = shift;
  1065. my $cumulative = shift;
  1066. my $line_limit = shift;
  1067. if ($main::opt_stacks && @stackTraces) {
  1068. foreach (sort { (split " ", $b)[1] <=> (split " ", $a)[1]; } @stackTraces) {
  1069. print "$_\n" if $main::opt_debug;
  1070. my ($n1, $s1, $n2, $s2, @addrs) = split;
  1071. print "Leak of $s1 bytes in $n1 objects allocated from:\n";
  1072. foreach my $pcstr (@addrs) {
  1073. $pcstr =~ s/^0x//;
  1074. my $sym;
  1075. if (! defined $symbols->{$pcstr}) {
  1076. $sym = "unknown";
  1077. } else {
  1078. $sym = "$symbols->{$pcstr}[0] $symbols->{$pcstr}[1]";
  1079. }
  1080. print "\t@ $pcstr $sym\n";
  1081. }
  1082. }
  1083. print "\n";
  1084. }
  1085. my $total = TotalProfile($flat);
  1086. # Which profile to sort by?
  1087. my $s = $main::opt_cum ? $cumulative : $flat;
  1088. my $running_sum = 0;
  1089. my $lines = 0;
  1090. foreach my $k (sort { GetEntry($s, $b) <=> GetEntry($s, $a) || $a cmp $b }
  1091. keys(%{$cumulative})) {
  1092. my $f = GetEntry($flat, $k);
  1093. my $c = GetEntry($cumulative, $k);
  1094. $running_sum += $f;
  1095. my $sym = $k;
  1096. if (exists($symbols->{$k})) {
  1097. $sym = $symbols->{$k}->[0] . " " . $symbols->{$k}->[1];
  1098. if ($main::opt_addresses) {
  1099. $sym = $k . " " . $sym;
  1100. }
  1101. }
  1102. if ($f != 0 || $c != 0) {
  1103. printf("%8s %6s %6s %8s %6s %s\n",
  1104. Unparse($f),
  1105. Percent($f, $total),
  1106. Percent($running_sum, $total),
  1107. Unparse($c),
  1108. Percent($c, $total),
  1109. $sym);
  1110. }
  1111. $lines++;
  1112. last if ($line_limit >= 0 && $lines >= $line_limit);
  1113. }
  1114. }
  1115. # Callgrind format has a compression for repeated function and file
  1116. # names. You show the name the first time, and just use its number
  1117. # subsequently. This can cut down the file to about a third or a
  1118. # quarter of its uncompressed size. $key and $val are the key/value
  1119. # pair that would normally be printed by callgrind; $map is a map from
  1120. # value to number.
  1121. sub CompressedCGName {
  1122. my($key, $val, $map) = @_;
  1123. my $idx = $map->{$val};
  1124. # For very short keys, providing an index hurts rather than helps.
  1125. if (length($val) <= 3) {
  1126. return "$key=$val\n";
  1127. } elsif (defined($idx)) {
  1128. return "$key=($idx)\n";
  1129. } else {
  1130. # scalar(keys $map) gives the number of items in the map.
  1131. $idx = scalar(keys(%{$map})) + 1;
  1132. $map->{$val} = $idx;
  1133. return "$key=($idx) $val\n";
  1134. }
  1135. }
  1136. # Print the call graph in a way that's suiteable for callgrind.
  1137. sub PrintCallgrind {
  1138. my $calls = shift;
  1139. my $filename;
  1140. my %filename_to_index_map;
  1141. my %fnname_to_index_map;
  1142. if ($main::opt_interactive) {
  1143. $filename = shift;
  1144. print STDERR "Writing callgrind file to '$filename'.\n"
  1145. } else {
  1146. $filename = "&STDOUT";
  1147. }
  1148. open(CG, ">$filename");
  1149. print CG ("events: Hits\n\n");
  1150. foreach my $call ( map { $_->[0] }
  1151. sort { $a->[1] cmp $b ->[1] ||
  1152. $a->[2] <=> $b->[2] }
  1153. map { /([^:]+):(\d+):([^ ]+)( -> ([^:]+):(\d+):(.+))?/;
  1154. [$_, $1, $2] }
  1155. keys %$calls ) {
  1156. my $count = int($calls->{$call});
  1157. $call =~ /([^:]+):(\d+):([^ ]+)( -> ([^:]+):(\d+):(.+))?/;
  1158. my ( $caller_file, $caller_line, $caller_function,
  1159. $callee_file, $callee_line, $callee_function ) =
  1160. ( $1, $2, $3, $5, $6, $7 );
  1161. # TODO(csilvers): for better compression, collect all the
  1162. # caller/callee_files and functions first, before printing
  1163. # anything, and only compress those referenced more than once.
  1164. print CG CompressedCGName("fl", $caller_file, \%filename_to_index_map);
  1165. print CG CompressedCGName("fn", $caller_function, \%fnname_to_index_map);
  1166. if (defined $6) {
  1167. print CG CompressedCGName("cfl", $callee_file, \%filename_to_index_map);
  1168. print CG CompressedCGName("cfn", $callee_function, \%fnname_to_index_map);
  1169. print CG ("calls=$count $callee_line\n");
  1170. }
  1171. print CG ("$caller_line $count\n\n");
  1172. }
  1173. }
  1174. # Print disassembly for all all routines that match $main::opt_disasm
  1175. sub PrintDisassembly {
  1176. my $libs = shift;
  1177. my $flat = shift;
  1178. my $cumulative = shift;
  1179. my $disasm_opts = shift;
  1180. my $total = TotalProfile($flat);
  1181. foreach my $lib (@{$libs}) {
  1182. my $symbol_table = GetProcedureBoundaries($lib->[0], $disasm_opts);
  1183. my $offset = AddressSub($lib->[1], $lib->[3]);
  1184. foreach my $routine (sort ByName keys(%{$symbol_table})) {
  1185. my $start_addr = $symbol_table->{$routine}->[0];
  1186. my $end_addr = $symbol_table->{$routine}->[1];
  1187. # See if there are any samples in this routine
  1188. my $length = hex(AddressSub($end_addr, $start_addr));
  1189. my $addr = AddressAdd($start_addr, $offset);
  1190. for (my $i = 0; $i < $length; $i++) {
  1191. if (defined($cumulative->{$addr})) {
  1192. PrintDisassembledFunction($lib->[0], $offset,
  1193. $routine, $flat, $cumulative,
  1194. $start_addr, $end_addr, $total);
  1195. last;
  1196. }
  1197. $addr = AddressInc($addr);
  1198. }
  1199. }
  1200. }
  1201. }
  1202. # Return reference to array of tuples of the form:
  1203. # [start_address, filename, linenumber, instruction, limit_address]
  1204. # E.g.,
  1205. # ["0x806c43d", "/foo/bar.cc", 131, "ret", "0x806c440"]
  1206. sub Disassemble {
  1207. my $prog = shift;
  1208. my $offset = shift;
  1209. my $start_addr = shift;
  1210. my $end_addr = shift;
  1211. my $objdump = $obj_tool_map{"objdump"};
  1212. my $cmd = ShellEscape($objdump, "-C", "-d", "-l", "--no-show-raw-insn",
  1213. "--start-address=0x$start_addr",
  1214. "--stop-address=0x$end_addr", $prog);
  1215. open(OBJDUMP, "$cmd |") || error("$cmd: $!\n");
  1216. my @result = ();
  1217. my $filename = "";
  1218. my $linenumber = -1;
  1219. my $last = ["", "", "", ""];
  1220. while (<OBJDUMP>) {
  1221. s/\r//g; # turn windows-looking lines into unix-looking lines
  1222. chop;
  1223. if (m|\s*([^:\s]+):(\d+)\s*$|) {
  1224. # Location line of the form:
  1225. # <filename>:<linenumber>
  1226. $filename = $1;
  1227. $linenumber = $2;
  1228. } elsif (m/^ +([0-9a-f]+):\s*(.*)/) {
  1229. # Disassembly line -- zero-extend address to full length
  1230. my $addr = HexExtend($1);
  1231. my $k = AddressAdd($addr, $offset);
  1232. $last->[4] = $k; # Store ending address for previous instruction
  1233. $last = [$k, $filename, $linenumber, $2, $end_addr];
  1234. push(@result, $last);
  1235. }
  1236. }
  1237. close(OBJDUMP);
  1238. return @result;
  1239. }
  1240. # The input file should contain lines of the form /proc/maps-like
  1241. # output (same format as expected from the profiles) or that looks
  1242. # like hex addresses (like "0xDEADBEEF"). We will parse all
  1243. # /proc/maps output, and for all the hex addresses, we will output
  1244. # "short" symbol names, one per line, in the same order as the input.
  1245. sub PrintSymbols {
  1246. my $maps_and_symbols_file = shift;
  1247. # ParseLibraries expects pcs to be in a set. Fine by us...
  1248. my @pclist = (); # pcs in sorted order
  1249. my $pcs = {};
  1250. my $map = "";
  1251. foreach my $line (<$maps_and_symbols_file>) {
  1252. $line =~ s/\r//g; # turn windows-looking lines into unix-looking lines
  1253. if ($line =~ /\b(0x[0-9a-f]+)\b/i) {
  1254. push(@pclist, HexExtend($1));
  1255. $pcs->{$pclist[-1]} = 1;
  1256. } else {
  1257. $map .= $line;
  1258. }
  1259. }
  1260. my $libs = ParseLibraries($main::prog, $map, $pcs);
  1261. my $symbols = ExtractSymbols($libs, $pcs);
  1262. foreach my $pc (@pclist) {
  1263. # ->[0] is the shortname, ->[2] is the full name
  1264. print(($symbols->{$pc}->[0] || "??") . "\n");
  1265. }
  1266. }
  1267. # For sorting functions by name
  1268. sub ByName {
  1269. return ShortFunctionName($a) cmp ShortFunctionName($b);
  1270. }
  1271. # Print source-listing for all all routines that match $list_opts
  1272. sub PrintListing {
  1273. my $total = shift;
  1274. my $libs = shift;
  1275. my $flat = shift;
  1276. my $cumulative = shift;
  1277. my $list_opts = shift;
  1278. my $html = shift;
  1279. my $output = \*STDOUT;
  1280. my $fname = "";
  1281. if ($html) {
  1282. # Arrange to write the output to a temporary file
  1283. $fname = TempName($main::next_tmpfile, "html");
  1284. $main::next_tmpfile++;
  1285. if (!open(TEMP, ">$fname")) {
  1286. print STDERR "$fname: $!\n";
  1287. return;
  1288. }
  1289. $output = \*TEMP;
  1290. print $output HtmlListingHeader();
  1291. printf $output ("<div class=\"legend\">%s<br>Total: %s %s</div>\n",
  1292. $main::prog, Unparse($total), Units());
  1293. }
  1294. my $listed = 0;
  1295. foreach my $lib (@{$libs}) {
  1296. my $symbol_table = GetProcedureBoundaries($lib->[0], $list_opts);
  1297. my $offset = AddressSub($lib->[1], $lib->[3]);
  1298. foreach my $routine (sort ByName keys(%{$symbol_table})) {
  1299. # Print if there are any samples in this routine
  1300. my $start_addr = $symbol_table->{$routine}->[0];
  1301. my $end_addr = $symbol_table->{$routine}->[1];
  1302. my $length = hex(AddressSub($end_addr, $start_addr));
  1303. my $addr = AddressAdd($start_addr, $offset);
  1304. for (my $i = 0; $i < $length; $i++) {
  1305. if (defined($cumulative->{$addr})) {
  1306. $listed += PrintSource(
  1307. $lib->[0], $offset,
  1308. $routine, $flat, $cumulative,
  1309. $start_addr, $end_addr,
  1310. $html,
  1311. $output);
  1312. last;
  1313. }
  1314. $addr = AddressInc($addr);
  1315. }
  1316. }
  1317. }
  1318. if ($html) {
  1319. if ($listed > 0) {
  1320. print $output HtmlListingFooter();
  1321. close($output);
  1322. RunWeb($fname);
  1323. } else {
  1324. close($output);
  1325. unlink($fname);
  1326. }
  1327. }
  1328. }
  1329. sub HtmlListingHeader {
  1330. return <<'EOF';
  1331. <DOCTYPE html>
  1332. <html>
  1333. <head>
  1334. <title>Pprof listing</title>
  1335. <style type="text/css">
  1336. body {
  1337. font-family: sans-serif;
  1338. }
  1339. h1 {
  1340. font-size: 1.5em;
  1341. margin-bottom: 4px;
  1342. }
  1343. .legend {
  1344. font-size: 1.25em;
  1345. }
  1346. .line {
  1347. color: #aaaaaa;
  1348. }
  1349. .nop {
  1350. color: #aaaaaa;
  1351. }
  1352. .unimportant {
  1353. color: #cccccc;
  1354. }
  1355. .disasmloc {
  1356. color: #000000;
  1357. }
  1358. .deadsrc {
  1359. cursor: pointer;
  1360. }
  1361. .deadsrc:hover {
  1362. background-color: #eeeeee;
  1363. }
  1364. .livesrc {
  1365. color: #0000ff;
  1366. cursor: pointer;
  1367. }
  1368. .livesrc:hover {
  1369. background-color: #eeeeee;
  1370. }
  1371. .asm {
  1372. color: #008800;
  1373. display: none;
  1374. }
  1375. </style>
  1376. <script type="text/javascript">
  1377. function pprof_toggle_asm(e) {
  1378. var target;
  1379. if (!e) e = window.event;
  1380. if (e.target) target = e.target;
  1381. else if (e.srcElement) target = e.srcElement;
  1382. if (target) {
  1383. var asm = target.nextSibling;
  1384. if (asm && asm.className == "asm") {
  1385. asm.style.display = (asm.style.display == "block" ? "" : "block");
  1386. e.preventDefault();
  1387. return false;
  1388. }
  1389. }
  1390. }
  1391. </script>
  1392. </head>
  1393. <body>
  1394. EOF
  1395. }
  1396. sub HtmlListingFooter {
  1397. return <<'EOF';
  1398. </body>
  1399. </html>
  1400. EOF
  1401. }
  1402. sub HtmlEscape {
  1403. my $text = shift;
  1404. $text =~ s/&/&amp;/g;
  1405. $text =~ s/</&lt;/g;
  1406. $text =~ s/>/&gt;/g;
  1407. return $text;
  1408. }
  1409. # Returns the indentation of the line, if it has any non-whitespace
  1410. # characters. Otherwise, returns -1.
  1411. sub Indentation {
  1412. my $line = shift;
  1413. if (m/^(\s*)\S/) {
  1414. return length($1);
  1415. } else {
  1416. return -1;
  1417. }
  1418. }
  1419. # If the symbol table contains inlining info, Disassemble() may tag an
  1420. # instruction with a location inside an inlined function. But for
  1421. # source listings, we prefer to use the location in the function we
  1422. # are listing. So use MapToSymbols() to fetch full location
  1423. # information for each instruction and then pick out the first
  1424. # location from a location list (location list contains callers before
  1425. # callees in case of inlining).
  1426. #
  1427. # After this routine has run, each entry in $instructions contains:
  1428. # [0] start address
  1429. # [1] filename for function we are listing
  1430. # [2] line number for function we are listing
  1431. # [3] disassembly
  1432. # [4] limit address
  1433. # [5] most specific filename (may be different from [1] due to inlining)
  1434. # [6] most specific line number (may be different from [2] due to inlining)
  1435. sub GetTopLevelLineNumbers {
  1436. my ($lib, $offset, $instructions) = @_;
  1437. my $pcs = [];
  1438. for (my $i = 0; $i <= $#{$instructions}; $i++) {
  1439. push(@{$pcs}, $instructions->[$i]->[0]);
  1440. }
  1441. my $symbols = {};
  1442. MapToSymbols($lib, $offset, $pcs, $symbols);
  1443. for (my $i = 0; $i <= $#{$instructions}; $i++) {
  1444. my $e = $instructions->[$i];
  1445. push(@{$e}, $e->[1]);
  1446. push(@{$e}, $e->[2]);
  1447. my $addr = $e->[0];
  1448. my $sym = $symbols->{$addr};
  1449. if (defined($sym)) {
  1450. if ($#{$sym} >= 2 && $sym->[1] =~ m/^(.*):(\d+)$/) {
  1451. $e->[1] = $1; # File name
  1452. $e->[2] = $2; # Line number
  1453. }
  1454. }
  1455. }
  1456. }
  1457. # Print source-listing for one routine
  1458. sub PrintSource {
  1459. my $prog = shift;
  1460. my $offset = shift;
  1461. my $routine = shift;
  1462. my $flat = shift;
  1463. my $cumulative = shift;
  1464. my $start_addr = shift;
  1465. my $end_addr = shift;
  1466. my $html = shift;
  1467. my $output = shift;
  1468. # Disassemble all instructions (just to get line numbers)
  1469. my @instructions = Disassemble($prog, $offset, $start_addr, $end_addr);
  1470. GetTopLevelLineNumbers($prog, $offset, \@instructions);
  1471. # Hack 1: assume that the first source file encountered in the
  1472. # disassembly contains the routine
  1473. my $filename = undef;
  1474. for (my $i = 0; $i <= $#instructions; $i++) {
  1475. if ($instructions[$i]->[2] >= 0) {
  1476. $filename = $instructions[$i]->[1];
  1477. last;
  1478. }
  1479. }
  1480. if (!defined($filename)) {
  1481. print STDERR "no filename found in $routine\n";
  1482. return 0;
  1483. }
  1484. # Hack 2: assume that the largest line number from $filename is the
  1485. # end of the procedure. This is typically safe since if P1 contains
  1486. # an inlined call to P2, then P2 usually occurs earlier in the
  1487. # source file. If this does not work, we might have to compute a
  1488. # density profile or just print all regions we find.
  1489. my $lastline = 0;
  1490. for (my $i = 0; $i <= $#instructions; $i++) {
  1491. my $f = $instructions[$i]->[1];
  1492. my $l = $instructions[$i]->[2];
  1493. if (($f eq $filename) && ($l > $lastline)) {
  1494. $lastline = $l;
  1495. }
  1496. }
  1497. # Hack 3: assume the first source location from "filename" is the start of
  1498. # the source code.
  1499. my $firstline = 1;
  1500. for (my $i = 0; $i <= $#instructions; $i++) {
  1501. if ($instructions[$i]->[1] eq $filename) {
  1502. $firstline = $instructions[$i]->[2];
  1503. last;
  1504. }
  1505. }
  1506. # Hack 4: Extend last line forward until its indentation is less than
  1507. # the indentation we saw on $firstline
  1508. my $oldlastline = $lastline;
  1509. {
  1510. if (!open(FILE, "<$filename")) {
  1511. print STDERR "$filename: $!\n";
  1512. return 0;
  1513. }
  1514. my $l = 0;
  1515. my $first_indentation = -1;
  1516. while (<FILE>) {
  1517. s/\r//g; # turn windows-looking lines into unix-looking lines
  1518. $l++;
  1519. my $indent = Indentation($_);
  1520. if ($l >= $firstline) {
  1521. if ($first_indentation < 0 && $indent >= 0) {
  1522. $first_indentation = $indent;
  1523. last if ($first_indentation == 0);
  1524. }
  1525. }
  1526. if ($l >= $lastline && $indent >= 0) {
  1527. if ($indent >= $first_indentation) {
  1528. $lastline = $l+1;
  1529. } else {
  1530. last;
  1531. }
  1532. }
  1533. }
  1534. close(FILE);
  1535. }
  1536. # Assign all samples to the range $firstline,$lastline,
  1537. # Hack 4: If an instruction does not occur in the range, its samples
  1538. # are moved to the next instruction that occurs in the range.
  1539. my $samples1 = {}; # Map from line number to flat count
  1540. my $samples2 = {}; # Map from line number to cumulative count
  1541. my $running1 = 0; # Unassigned flat counts
  1542. my $running2 = 0; # Unassigned cumulative counts
  1543. my $total1 = 0; # Total flat counts
  1544. my $total2 = 0; # Total cumulative counts
  1545. my %disasm = (); # Map from line number to disassembly
  1546. my $running_disasm = ""; # Unassigned disassembly
  1547. my $skip_marker = "---\n";
  1548. if ($html) {
  1549. $skip_marker = "";
  1550. for (my $l = $firstline; $l <= $lastline; $l++) {
  1551. $disasm{$l} = "";
  1552. }
  1553. }
  1554. my $last_dis_filename = '';
  1555. my $last_dis_linenum = -1;
  1556. my $last_touched_line = -1; # To detect gaps in disassembly for a line
  1557. foreach my $e (@instructions) {
  1558. # Add up counts for all address that fall inside this instruction
  1559. my $c1 = 0;
  1560. my $c2 = 0;
  1561. for (my $a = $e->[0]; $a lt $e->[4]; $a = AddressInc($a)) {
  1562. $c1 += GetEntry($flat, $a);
  1563. $c2 += GetEntry($cumulative, $a);
  1564. }
  1565. if ($html) {
  1566. my $dis = sprintf(" %6s %6s \t\t%8s: %s ",
  1567. HtmlPrintNumber($c1),
  1568. HtmlPrintNumber($c2),
  1569. UnparseAddress($offset, $e->[0]),
  1570. CleanDisassembly($e->[3]));
  1571. # Append the most specific source line associated with this instruction
  1572. if (length($dis) < 80) { $dis .= (' ' x (80 - length($dis))) };
  1573. $dis = HtmlEscape($dis);
  1574. my $f = $e->[5];
  1575. my $l = $e->[6];
  1576. if ($f ne $last_dis_filename) {
  1577. $dis .= sprintf("<span class=disasmloc>%s:%d</span>",
  1578. HtmlEscape(CleanFileName($f)), $l);
  1579. } elsif ($l ne $last_dis_linenum) {
  1580. # De-emphasize the unchanged file name portion
  1581. $dis .= sprintf("<span class=unimportant>%s</span>" .
  1582. "<span class=disasmloc>:%d</span>",
  1583. HtmlEscape(CleanFileName($f)), $l);
  1584. } else {
  1585. # De-emphasize the entire location
  1586. $dis .= sprintf("<span class=unimportant>%s:%d</span>",
  1587. HtmlEscape(CleanFileName($f)), $l);
  1588. }
  1589. $last_dis_filename = $f;
  1590. $last_dis_linenum = $l;
  1591. $running_disasm .= $dis;
  1592. $running_disasm .= "\n";
  1593. }
  1594. $running1 += $c1;
  1595. $running2 += $c2;
  1596. $total1 += $c1;
  1597. $total2 += $c2;
  1598. my $file = $e->[1];
  1599. my $line = $e->[2];
  1600. if (($file eq $filename) &&
  1601. ($line >= $firstline) &&
  1602. ($line <= $lastline)) {
  1603. # Assign all accumulated samples to this line
  1604. AddEntry($samples1, $line, $running1);
  1605. AddEntry($samples2, $line, $running2);
  1606. $running1 = 0;
  1607. $running2 = 0;
  1608. if ($html) {
  1609. if ($line != $last_touched_line && $disasm{$line} ne '') {
  1610. $disasm{$line} .= "\n";
  1611. }
  1612. $disasm{$line} .= $running_disasm;
  1613. $running_disasm = '';
  1614. $last_touched_line = $line;
  1615. }
  1616. }
  1617. }
  1618. # Assign any leftover samples to $lastline
  1619. AddEntry($samples1, $lastline, $running1);
  1620. AddEntry($samples2, $lastline, $running2);
  1621. if ($html) {
  1622. if ($lastline != $last_touched_line && $disasm{$lastline} ne '') {
  1623. $disasm{$lastline} .= "\n";
  1624. }
  1625. $disasm{$lastline} .= $running_disasm;
  1626. }
  1627. if ($html) {
  1628. printf $output (
  1629. "<h1>%s</h1>%s\n<pre onClick=\"pprof_toggle_asm()\">\n" .
  1630. "Total:%6s %6s (flat / cumulative %s)\n",
  1631. HtmlEscape(ShortFunctionName($routine)),
  1632. HtmlEscape(CleanFileName($filename)),
  1633. Unparse($total1),
  1634. Unparse($total2),
  1635. Units());
  1636. } else {
  1637. printf $output (
  1638. "ROUTINE ====================== %s in %s\n" .
  1639. "%6s %6s Total %s (flat / cumulative)\n",
  1640. ShortFunctionName($routine),
  1641. CleanFileName($filename),
  1642. Unparse($total1),
  1643. Unparse($total2),
  1644. Units());
  1645. }
  1646. if (!open(FILE, "<$filename")) {
  1647. print STDERR "$filename: $!\n";
  1648. return 0;
  1649. }
  1650. my $l = 0;
  1651. while (<FILE>) {
  1652. s/\r//g; # turn windows-looking lines into unix-looking lines
  1653. $l++;
  1654. if ($l >= $firstline - 5 &&
  1655. (($l <= $oldlastline + 5) || ($l <= $lastline))) {
  1656. chop;
  1657. my $text = $_;
  1658. if ($l == $firstline) { print $output $skip_marker; }
  1659. my $n1 = GetEntry($samples1, $l);
  1660. my $n2 = GetEntry($samples2, $l);
  1661. if ($html) {
  1662. # Emit a span that has one of the following classes:
  1663. # livesrc -- has samples
  1664. # deadsrc -- has disassembly, but with no samples
  1665. # nop -- has no matching disasembly
  1666. # Also emit an optional span containing disassembly.
  1667. my $dis = $disasm{$l};
  1668. my $asm = "";
  1669. if (defined($dis) && $dis ne '') {
  1670. $asm = "<span class=\"asm\">" . $dis . "</span>";
  1671. }
  1672. my $source_class = (($n1 + $n2 > 0)
  1673. ? "livesrc"
  1674. : (($asm ne "") ? "deadsrc" : "nop"));
  1675. printf $output (
  1676. "<span class=\"line\">%5d</span> " .
  1677. "<span class=\"%s\">%6s %6s %s</span>%s\n",
  1678. $l, $source_class,
  1679. HtmlPrintNumber($n1),
  1680. HtmlPrintNumber($n2),
  1681. HtmlEscape($text),
  1682. $asm);
  1683. } else {
  1684. printf $output(
  1685. "%6s %6s %4d: %s\n",
  1686. UnparseAlt($n1),
  1687. UnparseAlt($n2),
  1688. $l,
  1689. $text);
  1690. }
  1691. if ($l == $lastline) { print $output $skip_marker; }
  1692. };
  1693. }
  1694. close(FILE);
  1695. if ($html) {
  1696. print $output "</pre>\n";
  1697. }
  1698. return 1;
  1699. }
  1700. # Return the source line for the specified file/linenumber.
  1701. # Returns undef if not found.
  1702. sub SourceLine {
  1703. my $file = shift;
  1704. my $line = shift;
  1705. # Look in cache
  1706. if (!defined($main::source_cache{$file})) {
  1707. if (100 < scalar keys(%main::source_cache)) {
  1708. # Clear the cache when it gets too big
  1709. $main::source_cache = ();
  1710. }
  1711. # Read all lines from the file
  1712. if (!open(FILE, "<$file")) {
  1713. print STDERR "$file: $!\n";
  1714. $main::source_cache{$file} = []; # Cache the negative result
  1715. return undef;
  1716. }
  1717. my $lines = [];
  1718. push(@{$lines}, ""); # So we can use 1-based line numbers as indices
  1719. while (<FILE>) {
  1720. push(@{$lines}, $_);
  1721. }
  1722. close(FILE);
  1723. # Save the lines in the cache
  1724. $main::source_cache{$file} = $lines;
  1725. }
  1726. my $lines = $main::source_cache{$file};
  1727. if (($line < 0) || ($line > $#{$lines})) {
  1728. return undef;
  1729. } else {
  1730. return $lines->[$line];
  1731. }
  1732. }
  1733. # Print disassembly for one routine with interspersed source if available
  1734. sub PrintDisassembledFunction {
  1735. my $prog = shift;
  1736. my $offset = shift;
  1737. my $routine = shift;
  1738. my $flat = shift;
  1739. my $cumulative = shift;
  1740. my $start_addr = shift;
  1741. my $end_addr = shift;
  1742. my $total = shift;
  1743. # Disassemble all instructions
  1744. my @instructions = Disassemble($prog, $offset, $start_addr, $end_addr);
  1745. # Make array of counts per instruction
  1746. my @flat_count = ();
  1747. my @cum_count = ();
  1748. my $flat_total = 0;
  1749. my $cum_total = 0;
  1750. foreach my $e (@instructions) {
  1751. # Add up counts for all address that fall inside this instruction
  1752. my $c1 = 0;
  1753. my $c2 = 0;
  1754. for (my $a = $e->[0]; $a lt $e->[4]; $a = AddressInc($a)) {
  1755. $c1 += GetEntry($flat, $a);
  1756. $c2 += GetEntry($cumulative, $a);
  1757. }
  1758. push(@flat_count, $c1);
  1759. push(@cum_count, $c2);
  1760. $flat_total += $c1;
  1761. $cum_total += $c2;
  1762. }
  1763. # Print header with total counts
  1764. printf("ROUTINE ====================== %s\n" .
  1765. "%6s %6s %s (flat, cumulative) %.1f%% of total\n",
  1766. ShortFunctionName($routine),
  1767. Unparse($flat_total),
  1768. Unparse($cum_total),
  1769. Units(),
  1770. ($cum_total * 100.0) / $total);
  1771. # Process instructions in order
  1772. my $current_file = "";
  1773. for (my $i = 0; $i <= $#instructions; ) {
  1774. my $e = $instructions[$i];
  1775. # Print the new file name whenever we switch files
  1776. if ($e->[1] ne $current_file) {
  1777. $current_file = $e->[1];
  1778. my $fname = $current_file;
  1779. $fname =~ s|^\./||; # Trim leading "./"
  1780. # Shorten long file names
  1781. if (length($fname) >= 58) {
  1782. $fname = "..." . substr($fname, -55);
  1783. }
  1784. printf("-------------------- %s\n", $fname);
  1785. }
  1786. # TODO: Compute range of lines to print together to deal with
  1787. # small reorderings.
  1788. my $first_line = $e->[2];
  1789. my $last_line = $first_line;
  1790. my %flat_sum = ();
  1791. my %cum_sum = ();
  1792. for (my $l = $first_line; $l <= $last_line; $l++) {
  1793. $flat_sum{$l} = 0;
  1794. $cum_sum{$l} = 0;
  1795. }
  1796. # Find run of instructions for this range of source lines
  1797. my $first_inst = $i;
  1798. while (($i <= $#instructions) &&
  1799. ($instructions[$i]->[2] >= $first_line) &&
  1800. ($instructions[$i]->[2] <= $last_line)) {
  1801. $e = $instructions[$i];
  1802. $flat_sum{$e->[2]} += $flat_count[$i];
  1803. $cum_sum{$e->[2]} += $cum_count[$i];
  1804. $i++;
  1805. }
  1806. my $last_inst = $i - 1;
  1807. # Print source lines
  1808. for (my $l = $first_line; $l <= $last_line; $l++) {
  1809. my $line = SourceLine($current_file, $l);
  1810. if (!defined($line)) {
  1811. $line = "?\n";
  1812. next;
  1813. } else {
  1814. $line =~ s/^\s+//;
  1815. }
  1816. printf("%6s %6s %5d: %s",
  1817. UnparseAlt($flat_sum{$l}),
  1818. UnparseAlt($cum_sum{$l}),
  1819. $l,
  1820. $line);
  1821. }
  1822. # Print disassembly
  1823. for (my $x = $first_inst; $x <= $last_inst; $x++) {
  1824. my $e = $instructions[$x];
  1825. printf("%6s %6s %8s: %6s\n",
  1826. UnparseAlt($flat_count[$x]),
  1827. UnparseAlt($cum_count[$x]),
  1828. UnparseAddress($offset, $e->[0]),
  1829. CleanDisassembly($e->[3]));
  1830. }
  1831. }
  1832. }
  1833. # Print DOT graph
  1834. sub PrintDot {
  1835. my $prog = shift;
  1836. my $symbols = shift;
  1837. my $raw = shift;
  1838. my $flat = shift;
  1839. my $cumulative = shift;
  1840. my $overall_total = shift;
  1841. # Get total
  1842. my $local_total = TotalProfile($flat);
  1843. my $nodelimit = int($main::opt_nodefraction * $local_total);
  1844. my $edgelimit = int($main::opt_edgefraction * $local_total);
  1845. my $nodecount = $main::opt_nodecount;
  1846. # Find nodes to include
  1847. my @list = (sort { abs(GetEntry($cumulative, $b)) <=>
  1848. abs(GetEntry($cumulative, $a))
  1849. || $a cmp $b }
  1850. keys(%{$cumulative}));
  1851. my $last = $nodecount - 1;
  1852. if ($last > $#list) {
  1853. $last = $#list;
  1854. }
  1855. while (($last >= 0) &&
  1856. (abs(GetEntry($cumulative, $list[$last])) <= $nodelimit)) {
  1857. $last--;
  1858. }
  1859. if ($last < 0) {
  1860. print STDERR "No nodes to print\n";
  1861. return 0;
  1862. }
  1863. if ($nodelimit > 0 || $edgelimit > 0) {
  1864. printf STDERR ("Dropping nodes with <= %s %s; edges with <= %s abs(%s)\n",
  1865. Unparse($nodelimit), Units(),
  1866. Unparse($edgelimit), Units());
  1867. }
  1868. # Open DOT output file
  1869. my $output;
  1870. my $escaped_dot = ShellEscape(@DOT);
  1871. my $escaped_ps2pdf = ShellEscape(@PS2PDF);
  1872. if ($main::opt_gv) {
  1873. my $escaped_outfile = ShellEscape(TempName($main::next_tmpfile, "ps"));
  1874. $output = "| $escaped_dot -Tps2 >$escaped_outfile";
  1875. } elsif ($main::opt_evince) {
  1876. my $escaped_outfile = ShellEscape(TempName($main::next_tmpfile, "pdf"));
  1877. $output = "| $escaped_dot -Tps2 | $escaped_ps2pdf - $escaped_outfile";
  1878. } elsif ($main::opt_ps) {
  1879. $output = "| $escaped_dot -Tps2";
  1880. } elsif ($main::opt_pdf) {
  1881. $output = "| $escaped_dot -Tps2 | $escaped_ps2pdf - -";
  1882. } elsif ($main::opt_web || $main::opt_svg) {
  1883. # We need to post-process the SVG, so write to a temporary file always.
  1884. my $escaped_outfile = ShellEscape(TempName($main::next_tmpfile, "svg"));
  1885. $output = "| $escaped_dot -Tsvg >$escaped_outfile";
  1886. } elsif ($main::opt_gif) {
  1887. $output = "| $escaped_dot -Tgif";
  1888. } else {
  1889. $output = ">&STDOUT";
  1890. }
  1891. open(DOT, $output) || error("$output: $!\n");
  1892. # Title
  1893. printf DOT ("digraph \"%s; %s %s\" {\n",
  1894. $prog,
  1895. Unparse($overall_total),
  1896. Units());
  1897. if ($main::opt_pdf) {
  1898. # The output is more printable if we set the page size for dot.
  1899. printf DOT ("size=\"8,11\"\n");
  1900. }
  1901. printf DOT ("node [width=0.375,height=0.25];\n");
  1902. # Print legend
  1903. printf DOT ("Legend [shape=box,fontsize=24,shape=plaintext," .
  1904. "label=\"%s\\l%s\\l%s\\l%s\\l%s\\l\"];\n",
  1905. $prog,
  1906. sprintf("Total %s: %s", Units(), Unparse($overall_total)),
  1907. sprintf("Focusing on: %s", Unparse($local_total)),
  1908. sprintf("Dropped nodes with <= %s abs(%s)",
  1909. Unparse($nodelimit), Units()),
  1910. sprintf("Dropped edges with <= %s %s",
  1911. Unparse($edgelimit), Units())
  1912. );
  1913. # Print nodes
  1914. my %node = ();
  1915. my $nextnode = 1;
  1916. foreach my $a (@list[0..$last]) {
  1917. # Pick font size
  1918. my $f = GetEntry($flat, $a);
  1919. my $c = GetEntry($cumulative, $a);
  1920. my $fs = 8;
  1921. if ($local_total > 0) {
  1922. $fs = 8 + (50.0 * sqrt(abs($f * 1.0 / $local_total)));
  1923. }
  1924. $node{$a} = $nextnode++;
  1925. my $sym = $a;
  1926. $sym =~ s/\s+/\\n/g;
  1927. $sym =~ s/::/\\n/g;
  1928. # Extra cumulative info to print for non-leaves
  1929. my $extra = "";
  1930. if ($f != $c) {
  1931. $extra = sprintf("\\rof %s (%s)",
  1932. Unparse($c),
  1933. Percent($c, $local_total));
  1934. }
  1935. my $style = "";
  1936. if ($main::opt_heapcheck) {
  1937. if ($f > 0) {
  1938. # make leak-causing nodes more visible (add a background)
  1939. $style = ",style=filled,fillcolor=gray"
  1940. } elsif ($f < 0) {
  1941. # make anti-leak-causing nodes (which almost never occur)
  1942. # stand out as well (triple border)
  1943. $style = ",peripheries=3"
  1944. }
  1945. }
  1946. printf DOT ("N%d [label=\"%s\\n%s (%s)%s\\r" .
  1947. "\",shape=box,fontsize=%.1f%s];\n",
  1948. $node{$a},
  1949. $sym,
  1950. Unparse($f),
  1951. Percent($f, $local_total),
  1952. $extra,
  1953. $fs,
  1954. $style,
  1955. );
  1956. }
  1957. # Get edges and counts per edge
  1958. my %edge = ();
  1959. my $n;
  1960. my $fullname_to_shortname_map = {};
  1961. FillFullnameToShortnameMap($symbols, $fullname_to_shortname_map);
  1962. foreach my $k (keys(%{$raw})) {
  1963. # TODO: omit low %age edges
  1964. $n = $raw->{$k};
  1965. my @translated = TranslateStack($symbols, $fullname_to_shortname_map, $k);
  1966. for (my $i = 1; $i <= $#translated; $i++) {
  1967. my $src = $translated[$i];
  1968. my $dst = $translated[$i-1];
  1969. #next if ($src eq $dst); # Avoid self-edges?
  1970. if (exists($node{$src}) && exists($node{$dst})) {
  1971. my $edge_label = "$src\001$dst";
  1972. if (!exists($edge{$edge_label})) {
  1973. $edge{$edge_label} = 0;
  1974. }
  1975. $edge{$edge_label} += $n;
  1976. }
  1977. }
  1978. }
  1979. # Print edges (process in order of decreasing counts)
  1980. my %indegree = (); # Number of incoming edges added per node so far
  1981. my %outdegree = (); # Number of outgoing edges added per node so far
  1982. foreach my $e (sort { $edge{$b} <=> $edge{$a} } keys(%edge)) {
  1983. my @x = split(/\001/, $e);
  1984. $n = $edge{$e};
  1985. # Initialize degree of kept incoming and outgoing edges if necessary
  1986. my $src = $x[0];
  1987. my $dst = $x[1];
  1988. if (!exists($outdegree{$src})) { $outdegree{$src} = 0; }
  1989. if (!exists($indegree{$dst})) { $indegree{$dst} = 0; }
  1990. my $keep;
  1991. if ($indegree{$dst} == 0) {
  1992. # Keep edge if needed for reachability
  1993. $keep = 1;
  1994. } elsif (abs($n) <= $edgelimit) {
  1995. # Drop if we are below --edgefraction
  1996. $keep = 0;
  1997. } elsif ($outdegree{$src} >= $main::opt_maxdegree ||
  1998. $indegree{$dst} >= $main::opt_maxdegree) {
  1999. # Keep limited number of in/out edges per node
  2000. $keep = 0;
  2001. } else {
  2002. $keep = 1;
  2003. }
  2004. if ($keep) {
  2005. $outdegree{$src}++;
  2006. $indegree{$dst}++;
  2007. # Compute line width based on edge count
  2008. my $fraction = abs($local_total ? (3 * ($n / $local_total)) : 0);
  2009. if ($fraction > 1) { $fraction = 1; }
  2010. my $w = $fraction * 2;
  2011. if ($w < 1 && ($main::opt_web || $main::opt_svg)) {
  2012. # SVG output treats line widths < 1 poorly.
  2013. $w = 1;
  2014. }
  2015. # Dot sometimes segfaults if given edge weights that are too large, so
  2016. # we cap the weights at a large value
  2017. my $edgeweight = abs($n) ** 0.7;
  2018. if ($edgeweight > 100000) { $edgeweight = 100000; }
  2019. $edgeweight = int($edgeweight);
  2020. my $style = sprintf("setlinewidth(%f)", $w);
  2021. if ($x[1] =~ m/\(inline\)/) {
  2022. $style .= ",dashed";
  2023. }
  2024. # Use a slightly squashed function of the edge count as the weight
  2025. printf DOT ("N%s -> N%s [label=%s, weight=%d, style=\"%s\"];\n",
  2026. $node{$x[0]},
  2027. $node{$x[1]},
  2028. Unparse($n),
  2029. $edgeweight,
  2030. $style);
  2031. }
  2032. }
  2033. print DOT ("}\n");
  2034. close(DOT);
  2035. if ($main::opt_web || $main::opt_svg) {
  2036. # Rewrite SVG to be more usable inside web browser.
  2037. RewriteSvg(TempName($main::next_tmpfile, "svg"));
  2038. }
  2039. return 1;
  2040. }
  2041. sub RewriteSvg {
  2042. my $svgfile = shift;
  2043. open(SVG, $svgfile) || die "open temp svg: $!";
  2044. my @svg = <SVG>;
  2045. close(SVG);
  2046. unlink $svgfile;
  2047. my $svg = join('', @svg);
  2048. # Dot's SVG output is
  2049. #
  2050. # <svg width="___" height="___"
  2051. # viewBox="___" xmlns=...>
  2052. # <g id="graph0" transform="...">
  2053. # ...
  2054. # </g>
  2055. # </svg>
  2056. #
  2057. # Change it to
  2058. #
  2059. # <svg width="100%" height="100%"
  2060. # xmlns=...>
  2061. # $svg_javascript
  2062. # <g id="viewport" transform="translate(0,0)">
  2063. # <g id="graph0" transform="...">
  2064. # ...
  2065. # </g>
  2066. # </g>
  2067. # </svg>
  2068. # Fix width, height; drop viewBox.
  2069. $svg =~ s/(?s)<svg width="[^"]+" height="[^"]+"(.*?)viewBox="[^"]+"/<svg width="100%" height="100%"$1/;
  2070. # Insert script, viewport <g> above first <g>
  2071. my $svg_javascript = SvgJavascript();
  2072. my $viewport = "<g id=\"viewport\" transform=\"translate(0,0)\">\n";
  2073. $svg =~ s/<g id="graph\d"/$svg_javascript$viewport$&/;
  2074. # Insert final </g> above </svg>.
  2075. $svg =~ s/(.*)(<\/svg>)/$1<\/g>$2/;
  2076. $svg =~ s/<g id="graph\d"(.*?)/<g id="viewport"$1/;
  2077. if ($main::opt_svg) {
  2078. # --svg: write to standard output.
  2079. print $svg;
  2080. } else {
  2081. # Write back to temporary file.
  2082. open(SVG, ">$svgfile") || die "open $svgfile: $!";
  2083. print SVG $svg;
  2084. close(SVG);
  2085. }
  2086. }
  2087. sub SvgJavascript {
  2088. return <<'EOF';
  2089. <script type="text/ecmascript"><![CDATA[
  2090. // SVGPan
  2091. // http://www.cyberz.org/blog/2009/12/08/svgpan-a-javascript-svg-panzoomdrag-library/
  2092. // Local modification: if(true || ...) below to force panning, never moving.
  2093. /**
  2094. * SVGPan library 1.2
  2095. * ====================
  2096. *
  2097. * Given an unique existing element with id "viewport", including the
  2098. * the library into any SVG adds the following capabilities:
  2099. *
  2100. * - Mouse panning
  2101. * - Mouse zooming (using the wheel)
  2102. * - Object dargging
  2103. *
  2104. * Known issues:
  2105. *
  2106. * - Zooming (while panning) on Safari has still some issues
  2107. *
  2108. * Releases:
  2109. *
  2110. * 1.2, Sat Mar 20 08:42:50 GMT 2010, Zeng Xiaohui
  2111. * Fixed a bug with browser mouse handler interaction
  2112. *
  2113. * 1.1, Wed Feb 3 17:39:33 GMT 2010, Zeng Xiaohui
  2114. * Updated the zoom code to support the mouse wheel on Safari/Chrome
  2115. *
  2116. * 1.0, Andrea Leofreddi
  2117. * First release
  2118. *
  2119. * This code is licensed under the following BSD license:
  2120. *
  2121. * Copyright 2009-2010 Andrea Leofreddi <a.leofreddi@itcharm.com>. All rights reserved.
  2122. *
  2123. * Redistribution and use in source and binary forms, with or without modification, are
  2124. * permitted provided that the following conditions are met:
  2125. *
  2126. * 1. Redistributions of source code must retain the above copyright notice, this list of
  2127. * conditions and the following disclaimer.
  2128. *
  2129. * 2. Redistributions in binary form must reproduce the above copyright notice, this list
  2130. * of conditions and the following disclaimer in the documentation and/or other materials
  2131. * provided with the distribution.
  2132. *
  2133. * THIS SOFTWARE IS PROVIDED BY Andrea Leofreddi ``AS IS'' AND ANY EXPRESS OR IMPLIED
  2134. * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
  2135. * FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL Andrea Leofreddi OR
  2136. * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  2137. * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
  2138. * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
  2139. * ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
  2140. * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
  2141. * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  2142. *
  2143. * The views and conclusions contained in the software and documentation are those of the
  2144. * authors and should not be interpreted as representing official policies, either expressed
  2145. * or implied, of Andrea Leofreddi.
  2146. */
  2147. var root = document.documentElement;
  2148. var state = 'none', stateTarget, stateOrigin, stateTf;
  2149. setupHandlers(root);
  2150. /**
  2151. * Register handlers
  2152. */
  2153. function setupHandlers(root){
  2154. setAttributes(root, {
  2155. "onmouseup" : "add(evt)",
  2156. "onmousedown" : "handleMouseDown(evt)",
  2157. "onmousemove" : "handleMouseMove(evt)",
  2158. "onmouseup" : "handleMouseUp(evt)",
  2159. //"onmouseout" : "handleMouseUp(evt)", // Decomment this to stop the pan functionality when dragging out of the SVG element
  2160. });
  2161. if(navigator.userAgent.toLowerCase().indexOf('webkit') >= 0)
  2162. window.addEventListener('mousewheel', handleMouseWheel, false); // Chrome/Safari
  2163. else
  2164. window.addEventListener('DOMMouseScroll', handleMouseWheel, false); // Others
  2165. var g = svgDoc.getElementById("svg");
  2166. g.width = "100%";
  2167. g.height = "100%";
  2168. }
  2169. /**
  2170. * Instance an SVGPoint object with given event coordinates.
  2171. */
  2172. function getEventPoint(evt) {
  2173. var p = root.createSVGPoint();
  2174. p.x = evt.clientX;
  2175. p.y = evt.clientY;
  2176. return p;
  2177. }
  2178. /**
  2179. * Sets the current transform matrix of an element.
  2180. */
  2181. function setCTM(element, matrix) {
  2182. var s = "matrix(" + matrix.a + "," + matrix.b + "," + matrix.c + "," + matrix.d + "," + matrix.e + "," + matrix.f + ")";
  2183. element.setAttribute("transform", s);
  2184. }
  2185. /**
  2186. * Dumps a matrix to a string (useful for debug).
  2187. */
  2188. function dumpMatrix(matrix) {
  2189. var s = "[ " + matrix.a + ", " + matrix.c + ", " + matrix.e + "\n " + matrix.b + ", " + matrix.d + ", " + matrix.f + "\n 0, 0, 1 ]";
  2190. return s;
  2191. }
  2192. /**
  2193. * Sets attributes of an element.
  2194. */
  2195. function setAttributes(element, attributes){
  2196. for (i in attributes)
  2197. element.setAttributeNS(null, i, attributes[i]);
  2198. }
  2199. /**
  2200. * Handle mouse move event.
  2201. */
  2202. function handleMouseWheel(evt) {
  2203. if(evt.preventDefault)
  2204. evt.preventDefault();
  2205. evt.returnValue = false;
  2206. var svgDoc = evt.target.ownerDocument;
  2207. var delta;
  2208. if(evt.wheelDelta)
  2209. delta = evt.wheelDelta / 3600; // Chrome/Safari
  2210. else
  2211. delta = evt.detail / -90; // Mozilla
  2212. var z = 1 + delta; // Zoom factor: 0.9/1.1
  2213. var g = svgDoc.getElementById("viewport");
  2214. var p = getEventPoint(evt);
  2215. p = p.matrixTransform(g.getCTM().inverse());
  2216. // Compute new scale matrix in current mouse position
  2217. var k = root.createSVGMatrix().translate(p.x, p.y).scale(z).translate(-p.x, -p.y);
  2218. setCTM(g, g.getCTM().multiply(k));
  2219. stateTf = stateTf.multiply(k.inverse());
  2220. }
  2221. /**
  2222. * Handle mouse move event.
  2223. */
  2224. function handleMouseMove(evt) {
  2225. if(evt.preventDefault)
  2226. evt.preventDefault();
  2227. evt.returnValue = false;
  2228. var svgDoc = evt.target.ownerDocument;
  2229. var g = svgDoc.getElementById("viewport");
  2230. if(state == 'pan') {
  2231. // Pan mode
  2232. var p = getEventPoint(evt).matrixTransform(stateTf);
  2233. setCTM(g, stateTf.inverse().translate(p.x - stateOrigin.x, p.y - stateOrigin.y));
  2234. } else if(state == 'move') {
  2235. // Move mode
  2236. var p = getEventPoint(evt).matrixTransform(g.getCTM().inverse());
  2237. setCTM(stateTarget, root.createSVGMatrix().translate(p.x - stateOrigin.x, p.y - stateOrigin.y).multiply(g.getCTM().inverse()).multiply(stateTarget.getCTM()));
  2238. stateOrigin = p;
  2239. }
  2240. }
  2241. /**
  2242. * Handle click event.
  2243. */
  2244. function handleMouseDown(evt) {
  2245. if(evt.preventDefault)
  2246. evt.preventDefault();
  2247. evt.returnValue = false;
  2248. var svgDoc = evt.target.ownerDocument;
  2249. var g = svgDoc.getElementById("viewport");
  2250. if(true || evt.target.tagName == "svg") {
  2251. // Pan mode
  2252. state = 'pan';
  2253. stateTf = g.getCTM().inverse();
  2254. stateOrigin = getEventPoint(evt).matrixTransform(stateTf);
  2255. } else {
  2256. // Move mode
  2257. state = 'move';
  2258. stateTarget = evt.target;
  2259. stateTf = g.getCTM().inverse();
  2260. stateOrigin = getEventPoint(evt).matrixTransform(stateTf);
  2261. }
  2262. }
  2263. /**
  2264. * Handle mouse button release event.
  2265. */
  2266. function handleMouseUp(evt) {
  2267. if(evt.preventDefault)
  2268. evt.preventDefault();
  2269. evt.returnValue = false;
  2270. var svgDoc = evt.target.ownerDocument;
  2271. if(state == 'pan' || state == 'move') {
  2272. // Quit pan mode
  2273. state = '';
  2274. }
  2275. }
  2276. ]]></script>
  2277. EOF
  2278. }
  2279. # Provides a map from fullname to shortname for cases where the
  2280. # shortname is ambiguous. The symlist has both the fullname and
  2281. # shortname for all symbols, which is usually fine, but sometimes --
  2282. # such as overloaded functions -- two different fullnames can map to
  2283. # the same shortname. In that case, we use the address of the
  2284. # function to disambiguate the two. This function fills in a map that
  2285. # maps fullnames to modified shortnames in such cases. If a fullname
  2286. # is not present in the map, the 'normal' shortname provided by the
  2287. # symlist is the appropriate one to use.
  2288. sub FillFullnameToShortnameMap {
  2289. my $symbols = shift;
  2290. my $fullname_to_shortname_map = shift;
  2291. my $shortnames_seen_once = {};
  2292. my $shortnames_seen_more_than_once = {};
  2293. foreach my $symlist (values(%{$symbols})) {
  2294. # TODO(csilvers): deal with inlined symbols too.
  2295. my $shortname = $symlist->[0];
  2296. my $fullname = $symlist->[2];
  2297. if ($fullname !~ /<[0-9a-fA-F]+>$/) { # fullname doesn't end in an address
  2298. next; # the only collisions we care about are when addresses differ
  2299. }
  2300. if (defined($shortnames_seen_once->{$shortname}) &&
  2301. $shortnames_seen_once->{$shortname} ne $fullname) {
  2302. $shortnames_seen_more_than_once->{$shortname} = 1;
  2303. } else {
  2304. $shortnames_seen_once->{$shortname} = $fullname;
  2305. }
  2306. }
  2307. foreach my $symlist (values(%{$symbols})) {
  2308. my $shortname = $symlist->[0];
  2309. my $fullname = $symlist->[2];
  2310. # TODO(csilvers): take in a list of addresses we care about, and only
  2311. # store in the map if $symlist->[1] is in that list. Saves space.
  2312. next if defined($fullname_to_shortname_map->{$fullname});
  2313. if (defined($shortnames_seen_more_than_once->{$shortname})) {
  2314. if ($fullname =~ /<0*([^>]*)>$/) { # fullname has address at end of it
  2315. $fullname_to_shortname_map->{$fullname} = "$shortname\@$1";
  2316. }
  2317. }
  2318. }
  2319. }
  2320. # Return a small number that identifies the argument.
  2321. # Multiple calls with the same argument will return the same number.
  2322. # Calls with different arguments will return different numbers.
  2323. sub ShortIdFor {
  2324. my $key = shift;
  2325. my $id = $main::uniqueid{$key};
  2326. if (!defined($id)) {
  2327. $id = keys(%main::uniqueid) + 1;
  2328. $main::uniqueid{$key} = $id;
  2329. }
  2330. return $id;
  2331. }
  2332. # Translate a stack of addresses into a stack of symbols
  2333. sub TranslateStack {
  2334. my $symbols = shift;
  2335. my $fullname_to_shortname_map = shift;
  2336. my $k = shift;
  2337. my @addrs = split(/\n/, $k);
  2338. my @result = ();
  2339. for (my $i = 0; $i <= $#addrs; $i++) {
  2340. my $a = $addrs[$i];
  2341. # Skip large addresses since they sometimes show up as fake entries on RH9
  2342. if (length($a) > 8 && $a gt "7fffffffffffffff") {
  2343. next;
  2344. }
  2345. if ($main::opt_disasm || $main::opt_list) {
  2346. # We want just the address for the key
  2347. push(@result, $a);
  2348. next;
  2349. }
  2350. my $symlist = $symbols->{$a};
  2351. if (!defined($symlist)) {
  2352. $symlist = [$a, "", $a];
  2353. }
  2354. # We can have a sequence of symbols for a particular entry
  2355. # (more than one symbol in the case of inlining). Callers
  2356. # come before callees in symlist, so walk backwards since
  2357. # the translated stack should contain callees before callers.
  2358. for (my $j = $#{$symlist}; $j >= 2; $j -= 3) {
  2359. my $func = $symlist->[$j-2];
  2360. my $fileline = $symlist->[$j-1];
  2361. my $fullfunc = $symlist->[$j];
  2362. if (defined($fullname_to_shortname_map->{$fullfunc})) {
  2363. $func = $fullname_to_shortname_map->{$fullfunc};
  2364. }
  2365. if ($j > 2) {
  2366. $func = "$func (inline)";
  2367. }
  2368. # Do not merge nodes corresponding to Callback::Run since that
  2369. # causes confusing cycles in dot display. Instead, we synthesize
  2370. # a unique name for this frame per caller.
  2371. if ($func =~ m/Callback.*::Run$/) {
  2372. my $caller = ($i > 0) ? $addrs[$i-1] : 0;
  2373. $func = "Run#" . ShortIdFor($caller);
  2374. }
  2375. if ($main::opt_addresses) {
  2376. push(@result, "$a $func $fileline");
  2377. } elsif ($main::opt_lines) {
  2378. if ($func eq '??' && $fileline eq '??:0') {
  2379. push(@result, "$a");
  2380. } elsif (!$main::opt_show_addresses) {
  2381. push(@result, "$func $fileline");
  2382. } else {
  2383. push(@result, "$func $fileline ($a)");
  2384. }
  2385. } elsif ($main::opt_functions) {
  2386. if ($func eq '??') {
  2387. push(@result, "$a");
  2388. } elsif (!$main::opt_show_addresses) {
  2389. push(@result, $func);
  2390. } else {
  2391. push(@result, "$func ($a)");
  2392. }
  2393. } elsif ($main::opt_files) {
  2394. if ($fileline eq '??:0' || $fileline eq '') {
  2395. push(@result, "$a");
  2396. } else {
  2397. my $f = $fileline;
  2398. $f =~ s/:\d+$//;
  2399. push(@result, $f);
  2400. }
  2401. } else {
  2402. push(@result, $a);
  2403. last; # Do not print inlined info
  2404. }
  2405. }
  2406. }
  2407. # print join(",", @addrs), " => ", join(",", @result), "\n";
  2408. return @result;
  2409. }
  2410. # Generate percent string for a number and a total
  2411. sub Percent {
  2412. my $num = shift;
  2413. my $tot = shift;
  2414. if ($tot != 0) {
  2415. return sprintf("%.1f%%", $num * 100.0 / $tot);
  2416. } else {
  2417. return ($num == 0) ? "nan" : (($num > 0) ? "+inf" : "-inf");
  2418. }
  2419. }
  2420. # Generate pretty-printed form of number
  2421. sub Unparse {
  2422. my $num = shift;
  2423. if ($main::profile_type eq 'heap' || $main::profile_type eq 'growth') {
  2424. if ($main::opt_inuse_objects || $main::opt_alloc_objects) {
  2425. return sprintf("%d", $num);
  2426. } else {
  2427. if ($main::opt_show_bytes) {
  2428. return sprintf("%d", $num);
  2429. } else {
  2430. return sprintf("%.1f", $num / 1048576.0);
  2431. }
  2432. }
  2433. } elsif ($main::profile_type eq 'contention' && !$main::opt_contentions) {
  2434. return sprintf("%.3f", $num / 1e9); # Convert nanoseconds to seconds
  2435. } else {
  2436. return sprintf("%d", $num);
  2437. }
  2438. }
  2439. # Alternate pretty-printed form: 0 maps to "."
  2440. sub UnparseAlt {
  2441. my $num = shift;
  2442. if ($num == 0) {
  2443. return ".";
  2444. } else {
  2445. return Unparse($num);
  2446. }
  2447. }
  2448. # Alternate pretty-printed form: 0 maps to ""
  2449. sub HtmlPrintNumber {
  2450. my $num = shift;
  2451. if ($num == 0) {
  2452. return "";
  2453. } else {
  2454. return Unparse($num);
  2455. }
  2456. }
  2457. # Return output units
  2458. sub Units {
  2459. if ($main::profile_type eq 'heap' || $main::profile_type eq 'growth') {
  2460. if ($main::opt_inuse_objects || $main::opt_alloc_objects) {
  2461. return "objects";
  2462. } else {
  2463. if ($main::opt_show_bytes) {
  2464. return "B";
  2465. } else {
  2466. return "MB";
  2467. }
  2468. }
  2469. } elsif ($main::profile_type eq 'contention' && !$main::opt_contentions) {
  2470. return "seconds";
  2471. } else {
  2472. return "samples";
  2473. }
  2474. }
  2475. ##### Profile manipulation code #####
  2476. # Generate flattened profile:
  2477. # If count is charged to stack [a,b,c,d], in generated profile,
  2478. # it will be charged to [a]
  2479. sub FlatProfile {
  2480. my $profile = shift;
  2481. my $result = {};
  2482. foreach my $k (keys(%{$profile})) {
  2483. my $count = $profile->{$k};
  2484. my @addrs = split(/\n/, $k);
  2485. if ($#addrs >= 0) {
  2486. AddEntry($result, $addrs[0], $count);
  2487. }
  2488. }
  2489. return $result;
  2490. }
  2491. # Generate cumulative profile:
  2492. # If count is charged to stack [a,b,c,d], in generated profile,
  2493. # it will be charged to [a], [b], [c], [d]
  2494. sub CumulativeProfile {
  2495. my $profile = shift;
  2496. my $result = {};
  2497. foreach my $k (keys(%{$profile})) {
  2498. my $count = $profile->{$k};
  2499. my @addrs = split(/\n/, $k);
  2500. foreach my $a (@addrs) {
  2501. AddEntry($result, $a, $count);
  2502. }
  2503. }
  2504. return $result;
  2505. }
  2506. # If the second-youngest PC on the stack is always the same, returns
  2507. # that pc. Otherwise, returns undef.
  2508. sub IsSecondPcAlwaysTheSame {
  2509. my $profile = shift;
  2510. my $second_pc = undef;
  2511. foreach my $k (keys(%{$profile})) {
  2512. my @addrs = split(/\n/, $k);
  2513. if ($#addrs < 1) {
  2514. return undef;
  2515. }
  2516. if (not defined $second_pc) {
  2517. $second_pc = $addrs[1];
  2518. } else {
  2519. if ($second_pc ne $addrs[1]) {
  2520. return undef;
  2521. }
  2522. }
  2523. }
  2524. return $second_pc;
  2525. }
  2526. sub ExtractSymbolLocationInlineStack {
  2527. my $symbols = shift;
  2528. my $address = shift;
  2529. my $stack = shift;
  2530. # 'addr2line' outputs "??:0" for unknown locations; we do the
  2531. # same to be consistent.
  2532. if (exists $symbols->{$address}) {
  2533. my @localinlinestack = @{$symbols->{$address}};
  2534. for (my $i = $#localinlinestack; $i > 0; $i-=3) {
  2535. my $file = $localinlinestack[$i-1];
  2536. my $fn = $localinlinestack[$i-2];
  2537. if ($file eq "?" || $file eq ":0") {
  2538. $file = "??:0";
  2539. }
  2540. my $suffix = "[inline]";
  2541. if ($i == 2) {
  2542. $suffix = "";
  2543. }
  2544. push (@$stack, $file.":".$fn.$suffix);
  2545. }
  2546. }
  2547. else {
  2548. push (@$stack, "??:0:unknown");
  2549. }
  2550. }
  2551. sub ExtractSymbolNameInlineStack {
  2552. my $symbols = shift;
  2553. my $address = shift;
  2554. my @stack = ();
  2555. if (exists $symbols->{$address}) {
  2556. my @localinlinestack = @{$symbols->{$address}};
  2557. for (my $i = $#localinlinestack; $i > 0; $i-=3) {
  2558. my $file = $localinlinestack[$i-1];
  2559. my $fn = $localinlinestack[$i-0];
  2560. if ($file eq "?" || $file eq ":0") {
  2561. $file = "??:0";
  2562. }
  2563. if ($fn eq '??') {
  2564. # If we can't get the symbol name, at least use the file information.
  2565. $fn = $file;
  2566. }
  2567. my $suffix = "[inline]";
  2568. if ($i == 2) {
  2569. $suffix = "";
  2570. }
  2571. push (@stack, $fn.$suffix);
  2572. }
  2573. }
  2574. else {
  2575. # If we can't get a symbol name, at least fill in the address.
  2576. push (@stack, $address);
  2577. }
  2578. return @stack;
  2579. }
  2580. sub ExtractSymbolLocation {
  2581. my $symbols = shift;
  2582. my $address = shift;
  2583. # 'addr2line' outputs "??:0" for unknown locations; we do the
  2584. # same to be consistent.
  2585. my $location = "??:0:unknown";
  2586. if (exists $symbols->{$address}) {
  2587. my $file = $symbols->{$address}->[1];
  2588. if ($file eq "?" || $file eq ":0") {
  2589. $file = "??:0"
  2590. }
  2591. $location = $file . ":" . $symbols->{$address}->[0];
  2592. }
  2593. return $location;
  2594. }
  2595. # Extracts a graph of calls.
  2596. sub ExtractCalls {
  2597. my $symbols = shift;
  2598. my $profile = shift;
  2599. my $calls = {};
  2600. while( my ($stack_trace, $count) = each %$profile ) {
  2601. my @address = split(/\n/, $stack_trace);
  2602. my @stack = ();
  2603. ExtractSymbolLocationInlineStack($symbols, $address[0], \@stack);
  2604. for (my $i = 1; $i <= $#address; $i++) {
  2605. ExtractSymbolLocationInlineStack($symbols, $address[$i], \@stack);
  2606. }
  2607. AddEntry($calls, $stack[0], $count);
  2608. for (my $i = 1; $i < $#address; $i++) {
  2609. AddEntry($calls, "$stack[$i] -> $stack[$i-1]", $count);
  2610. }
  2611. }
  2612. return $calls;
  2613. }
  2614. sub PrintStacksForText {
  2615. my $symbols = shift;
  2616. my $profile = shift;
  2617. while (my ($stack_trace, $count) = each %$profile) {
  2618. my @address = split(/\n/, $stack_trace);
  2619. for (my $i = 0; $i <= $#address; $i++) {
  2620. $address[$i] = sprintf("(%s) %s", $address[$i], ExtractSymbolLocation($symbols, $address[$i]));
  2621. }
  2622. printf("%-8d %s\n\n", $count, join("\n ", @address));
  2623. }
  2624. }
  2625. sub PrintCollapsedStacks {
  2626. my $symbols = shift;
  2627. my $profile = shift;
  2628. while (my ($stack_trace, $count) = each %$profile) {
  2629. my @address = split(/\n/, $stack_trace);
  2630. my @names = reverse ( map { ExtractSymbolNameInlineStack($symbols, $_) } @address );
  2631. printf("%s %d\n", join(";", @names), $count);
  2632. }
  2633. }
  2634. sub RemoveUninterestingFrames {
  2635. my $symbols = shift;
  2636. my $profile = shift;
  2637. # List of function names to skip
  2638. my %skip = ();
  2639. my $skip_regexp = 'NOMATCH';
  2640. if ($main::profile_type eq 'heap' || $main::profile_type eq 'growth') {
  2641. foreach my $name ('calloc',
  2642. 'cfree',
  2643. 'malloc',
  2644. 'free',
  2645. 'memalign',
  2646. 'posix_memalign',
  2647. 'pvalloc',
  2648. 'valloc',
  2649. 'realloc',
  2650. 'tc_calloc',
  2651. 'tc_cfree',
  2652. 'tc_malloc',
  2653. 'tc_free',
  2654. 'tc_memalign',
  2655. 'tc_posix_memalign',
  2656. 'tc_pvalloc',
  2657. 'tc_valloc',
  2658. 'tc_realloc',
  2659. 'tc_new',
  2660. 'tc_delete',
  2661. 'tc_newarray',
  2662. 'tc_deletearray',
  2663. 'tc_new_nothrow',
  2664. 'tc_newarray_nothrow',
  2665. 'do_malloc',
  2666. '::do_malloc', # new name -- got moved to an unnamed ns
  2667. '::do_malloc_or_cpp_alloc',
  2668. 'DoSampledAllocation',
  2669. 'simple_alloc::allocate',
  2670. '__malloc_alloc_template::allocate',
  2671. '__builtin_delete',
  2672. '__builtin_new',
  2673. '__builtin_vec_delete',
  2674. '__builtin_vec_new',
  2675. 'operator new',
  2676. 'operator new[]',
  2677. # The entry to our memory-allocation routines on OS X
  2678. 'malloc_zone_malloc',
  2679. 'malloc_zone_calloc',
  2680. 'malloc_zone_valloc',
  2681. 'malloc_zone_realloc',
  2682. 'malloc_zone_memalign',
  2683. 'malloc_zone_free',
  2684. # These mark the beginning/end of our custom sections
  2685. '__start_google_malloc',
  2686. '__stop_google_malloc',
  2687. '__start_malloc_hook',
  2688. '__stop_malloc_hook') {
  2689. $skip{$name} = 1;
  2690. $skip{"_" . $name} = 1; # Mach (OS X) adds a _ prefix to everything
  2691. }
  2692. # TODO: Remove TCMalloc once everything has been
  2693. # moved into the tcmalloc:: namespace and we have flushed
  2694. # old code out of the system.
  2695. $skip_regexp = "TCMalloc|^tcmalloc::";
  2696. } elsif ($main::profile_type eq 'contention') {
  2697. foreach my $vname ('base::RecordLockProfileData',
  2698. 'base::SubmitMutexProfileData',
  2699. 'base::SubmitSpinLockProfileData',
  2700. 'Mutex::Unlock',
  2701. 'Mutex::UnlockSlow',
  2702. 'Mutex::ReaderUnlock',
  2703. 'MutexLock::~MutexLock',
  2704. 'SpinLock::Unlock',
  2705. 'SpinLock::SlowUnlock',
  2706. 'SpinLockHolder::~SpinLockHolder') {
  2707. $skip{$vname} = 1;
  2708. }
  2709. } elsif ($main::profile_type eq 'cpu' && !$main::opt_no_auto_signal_frames) {
  2710. # Drop signal handlers used for CPU profile collection
  2711. # TODO(dpeng): this should not be necessary; it's taken
  2712. # care of by the general 2nd-pc mechanism below.
  2713. foreach my $name ('ProfileData::Add', # historical
  2714. 'ProfileData::prof_handler', # historical
  2715. 'CpuProfiler::prof_handler',
  2716. '__FRAME_END__',
  2717. '__pthread_sighandler',
  2718. '__restore') {
  2719. $skip{$name} = 1;
  2720. }
  2721. } else {
  2722. # Nothing skipped for unknown types
  2723. }
  2724. if ($main::profile_type eq 'cpu') {
  2725. # If all the second-youngest program counters are the same,
  2726. # this STRONGLY suggests that it is an artifact of measurement,
  2727. # i.e., stack frames pushed by the CPU profiler signal handler.
  2728. # Hence, we delete them.
  2729. # (The topmost PC is read from the signal structure, not from
  2730. # the stack, so it does not get involved.)
  2731. while (my $second_pc = IsSecondPcAlwaysTheSame($profile)) {
  2732. my $result = {};
  2733. my $func = '';
  2734. if (exists($symbols->{$second_pc})) {
  2735. $second_pc = $symbols->{$second_pc}->[0];
  2736. }
  2737. if ($main::opt_no_auto_signal_frames) {
  2738. print STDERR "All second stack frames are same: `$second_pc'.\nMight be stack trace capturing bug.\n";
  2739. last;
  2740. }
  2741. print STDERR "Removing $second_pc from all stack traces.\n";
  2742. foreach my $k (keys(%{$profile})) {
  2743. my $count = $profile->{$k};
  2744. my @addrs = split(/\n/, $k);
  2745. my $topaddr = POSIX::strtoul($addrs[0], 16);
  2746. splice @addrs, 1, 1;
  2747. if ($#addrs > 1) {
  2748. my $subtopaddr = POSIX::strtoul($addrs[1], 16);
  2749. if ($subtopaddr + 1 == $topaddr) {
  2750. splice @addrs, 1, 1;
  2751. }
  2752. }
  2753. my $reduced_path = join("\n", @addrs);
  2754. AddEntry($result, $reduced_path, $count);
  2755. }
  2756. $profile = $result;
  2757. }
  2758. }
  2759. my $result = {};
  2760. foreach my $k (keys(%{$profile})) {
  2761. my $count = $profile->{$k};
  2762. my @addrs = split(/\n/, $k);
  2763. my @path = ();
  2764. foreach my $a (@addrs) {
  2765. if (exists($symbols->{$a})) {
  2766. my $func = $symbols->{$a}->[0];
  2767. if ($skip{$func} || ($func =~ m/$skip_regexp/)) {
  2768. next;
  2769. }
  2770. }
  2771. push(@path, $a);
  2772. }
  2773. my $reduced_path = join("\n", @path);
  2774. AddEntry($result, $reduced_path, $count);
  2775. }
  2776. return $result;
  2777. }
  2778. # Reduce profile to granularity given by user
  2779. sub ReduceProfile {
  2780. my $symbols = shift;
  2781. my $profile = shift;
  2782. my $result = {};
  2783. my $fullname_to_shortname_map = {};
  2784. FillFullnameToShortnameMap($symbols, $fullname_to_shortname_map);
  2785. foreach my $k (keys(%{$profile})) {
  2786. my $count = $profile->{$k};
  2787. my @translated = TranslateStack($symbols, $fullname_to_shortname_map, $k);
  2788. my @path = ();
  2789. my %seen = ();
  2790. $seen{''} = 1; # So that empty keys are skipped
  2791. foreach my $e (@translated) {
  2792. # To avoid double-counting due to recursion, skip a stack-trace
  2793. # entry if it has already been seen
  2794. if (!$seen{$e}) {
  2795. $seen{$e} = 1;
  2796. push(@path, $e);
  2797. }
  2798. }
  2799. my $reduced_path = join("\n", @path);
  2800. AddEntry($result, $reduced_path, $count);
  2801. }
  2802. return $result;
  2803. }
  2804. # Does the specified symbol array match the regexp?
  2805. sub SymbolMatches {
  2806. my $sym = shift;
  2807. my $re = shift;
  2808. if (defined($sym)) {
  2809. for (my $i = 0; $i < $#{$sym}; $i += 3) {
  2810. if ($sym->[$i] =~ m/$re/ || $sym->[$i+1] =~ m/$re/) {
  2811. return 1;
  2812. }
  2813. }
  2814. }
  2815. return 0;
  2816. }
  2817. # Focus only on paths involving specified regexps
  2818. sub FocusProfile {
  2819. my $symbols = shift;
  2820. my $profile = shift;
  2821. my $focus = shift;
  2822. my $result = {};
  2823. foreach my $k (keys(%{$profile})) {
  2824. my $count = $profile->{$k};
  2825. my @addrs = split(/\n/, $k);
  2826. foreach my $a (@addrs) {
  2827. # Reply if it matches either the address/shortname/fileline
  2828. if (($a =~ m/$focus/) || SymbolMatches($symbols->{$a}, $focus)) {
  2829. AddEntry($result, $k, $count);
  2830. last;
  2831. }
  2832. }
  2833. }
  2834. return $result;
  2835. }
  2836. # Focus only on paths not involving specified regexps
  2837. sub IgnoreProfile {
  2838. my $symbols = shift;
  2839. my $profile = shift;
  2840. my $ignore = shift;
  2841. my $result = {};
  2842. foreach my $k (keys(%{$profile})) {
  2843. my $count = $profile->{$k};
  2844. my @addrs = split(/\n/, $k);
  2845. my $matched = 0;
  2846. foreach my $a (@addrs) {
  2847. # Reply if it matches either the address/shortname/fileline
  2848. if (($a =~ m/$ignore/) || SymbolMatches($symbols->{$a}, $ignore)) {
  2849. $matched = 1;
  2850. last;
  2851. }
  2852. }
  2853. if (!$matched) {
  2854. AddEntry($result, $k, $count);
  2855. }
  2856. }
  2857. return $result;
  2858. }
  2859. # Get total count in profile
  2860. sub TotalProfile {
  2861. my $profile = shift;
  2862. my $result = 0;
  2863. foreach my $k (keys(%{$profile})) {
  2864. $result += $profile->{$k};
  2865. }
  2866. return $result;
  2867. }
  2868. # Add A to B
  2869. sub AddProfile {
  2870. my $A = shift;
  2871. my $B = shift;
  2872. my $R = {};
  2873. # add all keys in A
  2874. foreach my $k (keys(%{$A})) {
  2875. my $v = $A->{$k};
  2876. AddEntry($R, $k, $v);
  2877. }
  2878. # add all keys in B
  2879. foreach my $k (keys(%{$B})) {
  2880. my $v = $B->{$k};
  2881. AddEntry($R, $k, $v);
  2882. }
  2883. return $R;
  2884. }
  2885. # Merges symbol maps
  2886. sub MergeSymbols {
  2887. my $A = shift;
  2888. my $B = shift;
  2889. my $R = {};
  2890. foreach my $k (keys(%{$A})) {
  2891. $R->{$k} = $A->{$k};
  2892. }
  2893. if (defined($B)) {
  2894. foreach my $k (keys(%{$B})) {
  2895. $R->{$k} = $B->{$k};
  2896. }
  2897. }
  2898. return $R;
  2899. }
  2900. # Add A to B
  2901. sub AddPcs {
  2902. my $A = shift;
  2903. my $B = shift;
  2904. my $R = {};
  2905. # add all keys in A
  2906. foreach my $k (keys(%{$A})) {
  2907. $R->{$k} = 1
  2908. }
  2909. # add all keys in B
  2910. foreach my $k (keys(%{$B})) {
  2911. $R->{$k} = 1
  2912. }
  2913. return $R;
  2914. }
  2915. # Subtract B from A
  2916. sub SubtractProfile {
  2917. my $A = shift;
  2918. my $B = shift;
  2919. my $R = {};
  2920. foreach my $k (keys(%{$A})) {
  2921. my $v = $A->{$k} - GetEntry($B, $k);
  2922. if ($v < 0 && $main::opt_drop_negative) {
  2923. $v = 0;
  2924. }
  2925. AddEntry($R, $k, $v);
  2926. }
  2927. if (!$main::opt_drop_negative) {
  2928. # Take care of when subtracted profile has more entries
  2929. foreach my $k (keys(%{$B})) {
  2930. if (!exists($A->{$k})) {
  2931. AddEntry($R, $k, 0 - $B->{$k});
  2932. }
  2933. }
  2934. }
  2935. return $R;
  2936. }
  2937. # Get entry from profile; zero if not present
  2938. sub GetEntry {
  2939. my $profile = shift;
  2940. my $k = shift;
  2941. if (exists($profile->{$k})) {
  2942. return $profile->{$k};
  2943. } else {
  2944. return 0;
  2945. }
  2946. }
  2947. # Add entry to specified profile
  2948. sub AddEntry {
  2949. my $profile = shift;
  2950. my $k = shift;
  2951. my $n = shift;
  2952. if (!exists($profile->{$k})) {
  2953. $profile->{$k} = 0;
  2954. }
  2955. $profile->{$k} += $n;
  2956. }
  2957. # Add a stack of entries to specified profile, and add them to the $pcs
  2958. # list.
  2959. sub AddEntries {
  2960. my $profile = shift;
  2961. my $pcs = shift;
  2962. my $stack = shift;
  2963. my $count = shift;
  2964. my @k = ();
  2965. foreach my $e (split(/\s+/, $stack)) {
  2966. my $pc = HexExtend($e);
  2967. $pcs->{$pc} = 1;
  2968. push @k, $pc;
  2969. }
  2970. AddEntry($profile, (join "\n", @k), $count);
  2971. }
  2972. ##### Code to profile a server dynamically #####
  2973. sub CheckSymbolPage {
  2974. my $url = SymbolPageURL();
  2975. my $command = ShellEscape(@URL_FETCHER, $url);
  2976. open(SYMBOL, "$command |") or error($command);
  2977. my $line = <SYMBOL>;
  2978. $line =~ s/\r//g; # turn windows-looking lines into unix-looking lines
  2979. close(SYMBOL);
  2980. unless (defined($line)) {
  2981. error("$url doesn't exist\n");
  2982. }
  2983. if ($line =~ /^num_symbols:\s+(\d+)$/) {
  2984. if ($1 == 0) {
  2985. error("Stripped binary. No symbols available.\n");
  2986. }
  2987. } else {
  2988. error("Failed to get the number of symbols from $url\n");
  2989. }
  2990. }
  2991. sub IsProfileURL {
  2992. my $profile_name = shift;
  2993. if (-f $profile_name) {
  2994. printf STDERR "Using local file $profile_name.\n";
  2995. return 0;
  2996. }
  2997. return 1;
  2998. }
  2999. sub ParseProfileURL {
  3000. my $profile_name = shift;
  3001. if (!defined($profile_name) || $profile_name eq "") {
  3002. return ();
  3003. }
  3004. # Split profile URL - matches all non-empty strings, so no test.
  3005. $profile_name =~ m,^(https?://)?([^/]+)(.*?)(/|$PROFILES)?$,;
  3006. my $proto = $1 || "http://";
  3007. my $hostport = $2;
  3008. my $prefix = $3;
  3009. my $profile = $4 || "/";
  3010. my $host = $hostport;
  3011. $host =~ s/:.*//;
  3012. my $baseurl = "$proto$hostport$prefix";
  3013. return ($host, $baseurl, $profile);
  3014. }
  3015. # We fetch symbols from the first profile argument.
  3016. sub SymbolPageURL {
  3017. my ($host, $baseURL, $path) = ParseProfileURL($main::pfile_args[0]);
  3018. return "$baseURL$SYMBOL_PAGE";
  3019. }
  3020. sub FetchProgramName() {
  3021. my ($host, $baseURL, $path) = ParseProfileURL($main::pfile_args[0]);
  3022. my $url = "$baseURL$PROGRAM_NAME_PAGE";
  3023. my $command_line = ShellEscape(@URL_FETCHER, $url);
  3024. open(CMDLINE, "$command_line |") or error($command_line);
  3025. my $cmdline = <CMDLINE>;
  3026. $cmdline =~ s/\r//g; # turn windows-looking lines into unix-looking lines
  3027. close(CMDLINE);
  3028. error("Failed to get program name from $url\n") unless defined($cmdline);
  3029. $cmdline =~ s/\x00.+//; # Remove argv[1] and latters.
  3030. $cmdline =~ s!\n!!g; # Remove LFs.
  3031. return $cmdline;
  3032. }
  3033. # Gee, curl's -L (--location) option isn't reliable at least
  3034. # with its 7.12.3 version. Curl will forget to post data if
  3035. # there is a redirection. This function is a workaround for
  3036. # curl. Redirection happens on borg hosts.
  3037. sub ResolveRedirectionForCurl {
  3038. my $url = shift;
  3039. my $command_line = ShellEscape(@URL_FETCHER, "--head", $url);
  3040. open(CMDLINE, "$command_line |") or error($command_line);
  3041. while (<CMDLINE>) {
  3042. s/\r//g; # turn windows-looking lines into unix-looking lines
  3043. if (/^Location: (.*)/) {
  3044. $url = $1;
  3045. }
  3046. }
  3047. close(CMDLINE);
  3048. return $url;
  3049. }
  3050. # Add a timeout flat to URL_FETCHER. Returns a new list.
  3051. sub AddFetchTimeout {
  3052. my $timeout = shift;
  3053. my @fetcher = @_;
  3054. if (defined($timeout)) {
  3055. if (join(" ", @fetcher) =~ m/\bcurl -s/) {
  3056. push(@fetcher, "--max-time", sprintf("%d", $timeout));
  3057. } elsif (join(" ", @fetcher) =~ m/\brpcget\b/) {
  3058. push(@fetcher, sprintf("--deadline=%d", $timeout));
  3059. }
  3060. }
  3061. return @fetcher;
  3062. }
  3063. # Reads a symbol map from the file handle name given as $1, returning
  3064. # the resulting symbol map. Also processes variables relating to symbols.
  3065. # Currently, the only variable processed is 'binary=<value>' which updates
  3066. # $main::prog to have the correct program name.
  3067. sub ReadSymbols {
  3068. my $in = shift;
  3069. my $map = {};
  3070. while (<$in>) {
  3071. s/\r//g; # turn windows-looking lines into unix-looking lines
  3072. # Removes all the leading zeroes from the symbols, see comment below.
  3073. if (m/^0x0*([0-9a-f]+)\s+(.+)/) {
  3074. $map->{$1} = $2;
  3075. } elsif (m/^---/) {
  3076. last;
  3077. } elsif (m/^([a-z][^=]*)=(.*)$/ ) {
  3078. my ($variable, $value) = ($1, $2);
  3079. for ($variable, $value) {
  3080. s/^\s+//;
  3081. s/\s+$//;
  3082. }
  3083. if ($variable eq "binary") {
  3084. if ($main::prog ne $UNKNOWN_BINARY && $main::prog ne $value) {
  3085. printf STDERR ("Warning: Mismatched binary name '%s', using '%s'.\n",
  3086. $main::prog, $value);
  3087. }
  3088. $main::prog = $value;
  3089. } else {
  3090. printf STDERR ("Ignoring unknown variable in symbols list: " .
  3091. "'%s' = '%s'\n", $variable, $value);
  3092. }
  3093. }
  3094. }
  3095. return $map;
  3096. }
  3097. # Fetches and processes symbols to prepare them for use in the profile output
  3098. # code. If the optional 'symbol_map' arg is not given, fetches symbols from
  3099. # $SYMBOL_PAGE for all PC values found in profile. Otherwise, the raw symbols
  3100. # are assumed to have already been fetched into 'symbol_map' and are simply
  3101. # extracted and processed.
  3102. sub FetchSymbols {
  3103. my $pcset = shift;
  3104. my $symbol_map = shift;
  3105. my %seen = ();
  3106. my @pcs = grep { !$seen{$_}++ } keys(%$pcset); # uniq
  3107. if (!defined($symbol_map)) {
  3108. my $post_data = join("+", sort((map {"0x" . "$_"} @pcs)));
  3109. open(POSTFILE, ">$main::tmpfile_sym");
  3110. print POSTFILE $post_data;
  3111. close(POSTFILE);
  3112. my $url = SymbolPageURL();
  3113. my $command_line;
  3114. if (join(" ", @URL_FETCHER) =~ m/\bcurl -s/) {
  3115. $url = ResolveRedirectionForCurl($url);
  3116. $command_line = ShellEscape(@URL_FETCHER, "-d", "\@$main::tmpfile_sym",
  3117. $url);
  3118. } else {
  3119. $command_line = (ShellEscape(@URL_FETCHER, "--post", $url)
  3120. . " < " . ShellEscape($main::tmpfile_sym));
  3121. }
  3122. # We use c++filt in case $SYMBOL_PAGE gives us mangled symbols.
  3123. my $escaped_cppfilt = ShellEscape($obj_tool_map{"c++filt"});
  3124. open(SYMBOL, "$command_line | $escaped_cppfilt |") or error($command_line);
  3125. $symbol_map = ReadSymbols(*SYMBOL{IO});
  3126. close(SYMBOL);
  3127. }
  3128. my $symbols = {};
  3129. foreach my $pc (@pcs) {
  3130. my $fullname;
  3131. # For 64 bits binaries, symbols are extracted with 8 leading zeroes.
  3132. # Then /symbol reads the long symbols in as uint64, and outputs
  3133. # the result with a "0x%08llx" format which get rid of the zeroes.
  3134. # By removing all the leading zeroes in both $pc and the symbols from
  3135. # /symbol, the symbols match and are retrievable from the map.
  3136. my $shortpc = $pc;
  3137. $shortpc =~ s/^0*//;
  3138. # Each line may have a list of names, which includes the function
  3139. # and also other functions it has inlined. They are separated (in
  3140. # PrintSymbolizedProfile), by --, which is illegal in function names.
  3141. my $fullnames;
  3142. if (defined($symbol_map->{$shortpc})) {
  3143. $fullnames = $symbol_map->{$shortpc};
  3144. } else {
  3145. $fullnames = "0x" . $pc; # Just use addresses
  3146. }
  3147. my $sym = [];
  3148. $symbols->{$pc} = $sym;
  3149. foreach my $fullname (split("--", $fullnames)) {
  3150. my $name = ShortFunctionName($fullname);
  3151. push(@{$sym}, $name, "?", $fullname);
  3152. }
  3153. }
  3154. return $symbols;
  3155. }
  3156. sub BaseName {
  3157. my $file_name = shift;
  3158. $file_name =~ s!^.*/!!; # Remove directory name
  3159. return $file_name;
  3160. }
  3161. sub MakeProfileBaseName {
  3162. my ($binary_name, $profile_name) = @_;
  3163. my ($host, $baseURL, $path) = ParseProfileURL($profile_name);
  3164. my $binary_shortname = BaseName($binary_name);
  3165. return sprintf("%s.%s.%s",
  3166. $binary_shortname, $main::op_time, $host);
  3167. }
  3168. sub FetchDynamicProfile {
  3169. my $binary_name = shift;
  3170. my $profile_name = shift;
  3171. my $fetch_name_only = shift;
  3172. my $encourage_patience = shift;
  3173. if (!IsProfileURL($profile_name)) {
  3174. return $profile_name;
  3175. } else {
  3176. my ($host, $baseURL, $path) = ParseProfileURL($profile_name);
  3177. if ($path eq "" || $path eq "/") {
  3178. # Missing type specifier defaults to cpu-profile
  3179. $path = $PROFILE_PAGE;
  3180. }
  3181. my $profile_file = MakeProfileBaseName($binary_name, $profile_name);
  3182. my $url = "$baseURL$path";
  3183. my $fetch_timeout = undef;
  3184. if ($path =~ m/$PROFILE_PAGE|$PMUPROFILE_PAGE/) {
  3185. if ($path =~ m/[?]/) {
  3186. $url .= "&";
  3187. } else {
  3188. $url .= "?";
  3189. }
  3190. $url .= sprintf("seconds=%d", $main::opt_seconds);
  3191. $fetch_timeout = $main::opt_seconds * 1.01 + 60;
  3192. } else {
  3193. # For non-CPU profiles, we add a type-extension to
  3194. # the target profile file name.
  3195. my $suffix = $path;
  3196. $suffix =~ s,/,.,g;
  3197. $profile_file .= $suffix;
  3198. }
  3199. my $profile_dir = $ENV{"PPROF_TMPDIR"} || ($ENV{HOME} . "/pprof");
  3200. if (! -d $profile_dir) {
  3201. mkdir($profile_dir)
  3202. || die("Unable to create profile directory $profile_dir: $!\n");
  3203. }
  3204. my $tmp_profile = "$profile_dir/.tmp.$profile_file";
  3205. my $real_profile = "$profile_dir/$profile_file";
  3206. if ($fetch_name_only > 0) {
  3207. return $real_profile;
  3208. }
  3209. my @fetcher = AddFetchTimeout($fetch_timeout, @URL_FETCHER);
  3210. my $cmd = ShellEscape(@fetcher, $url) . " > " . ShellEscape($tmp_profile);
  3211. if ($path =~ m/$PROFILE_PAGE|$PMUPROFILE_PAGE|$CENSUSPROFILE_PAGE/){
  3212. print STDERR "Gathering CPU profile from $url for $main::opt_seconds seconds to\n ${real_profile}\n";
  3213. if ($encourage_patience) {
  3214. print STDERR "Be patient...\n";
  3215. }
  3216. } else {
  3217. print STDERR "Fetching $path profile from $url to\n ${real_profile}\n";
  3218. }
  3219. (system($cmd) == 0) || error("Failed to get profile: $cmd: $!\n");
  3220. (system("mv", $tmp_profile, $real_profile) == 0) || error("Unable to rename profile\n");
  3221. print STDERR "Wrote profile to $real_profile\n";
  3222. $main::collected_profile = $real_profile;
  3223. return $main::collected_profile;
  3224. }
  3225. }
  3226. # Collect profiles in parallel
  3227. sub FetchDynamicProfiles {
  3228. my $items = scalar(@main::pfile_args);
  3229. my $levels = log($items) / log(2);
  3230. if ($items == 1) {
  3231. $main::profile_files[0] = FetchDynamicProfile($main::prog, $main::pfile_args[0], 0, 1);
  3232. } else {
  3233. # math rounding issues
  3234. if ((2 ** $levels) < $items) {
  3235. $levels++;
  3236. }
  3237. my $count = scalar(@main::pfile_args);
  3238. for (my $i = 0; $i < $count; $i++) {
  3239. $main::profile_files[$i] = FetchDynamicProfile($main::prog, $main::pfile_args[$i], 1, 0);
  3240. }
  3241. print STDERR "Fetching $count profiles, Be patient...\n";
  3242. FetchDynamicProfilesRecurse($levels, 0, 0);
  3243. $main::collected_profile = join(" \\\n ", @main::profile_files);
  3244. }
  3245. }
  3246. # Recursively fork a process to get enough processes
  3247. # collecting profiles
  3248. sub FetchDynamicProfilesRecurse {
  3249. my $maxlevel = shift;
  3250. my $level = shift;
  3251. my $position = shift;
  3252. if (my $pid = fork()) {
  3253. $position = 0 | ($position << 1);
  3254. TryCollectProfile($maxlevel, $level, $position);
  3255. wait;
  3256. } else {
  3257. $position = 1 | ($position << 1);
  3258. TryCollectProfile($maxlevel, $level, $position);
  3259. cleanup();
  3260. exit(0);
  3261. }
  3262. }
  3263. # Collect a single profile
  3264. sub TryCollectProfile {
  3265. my $maxlevel = shift;
  3266. my $level = shift;
  3267. my $position = shift;
  3268. if ($level >= ($maxlevel - 1)) {
  3269. if ($position < scalar(@main::pfile_args)) {
  3270. FetchDynamicProfile($main::prog, $main::pfile_args[$position], 0, 0);
  3271. }
  3272. } else {
  3273. FetchDynamicProfilesRecurse($maxlevel, $level+1, $position);
  3274. }
  3275. }
  3276. ##### Parsing code #####
  3277. # Provide a small streaming-read module to handle very large
  3278. # cpu-profile files. Stream in chunks along a sliding window.
  3279. # Provides an interface to get one 'slot', correctly handling
  3280. # endian-ness differences. A slot is one 32-bit or 64-bit word
  3281. # (depending on the input profile). We tell endianness and bit-size
  3282. # for the profile by looking at the first 8 bytes: in cpu profiles,
  3283. # the second slot is always 3 (we'll accept anything that's not 0).
  3284. BEGIN {
  3285. package CpuProfileStream;
  3286. sub new {
  3287. my ($class, $file, $fname) = @_;
  3288. my $self = { file => $file,
  3289. base => 0,
  3290. stride => 512 * 1024, # must be a multiple of bitsize/8
  3291. slots => [],
  3292. unpack_code => "", # N for big-endian, V for little
  3293. perl_is_64bit => 1, # matters if profile is 64-bit
  3294. };
  3295. bless $self, $class;
  3296. # Let unittests adjust the stride
  3297. if ($main::opt_test_stride > 0) {
  3298. $self->{stride} = $main::opt_test_stride;
  3299. }
  3300. # Read the first two slots to figure out bitsize and endianness.
  3301. my $slots = $self->{slots};
  3302. my $str;
  3303. read($self->{file}, $str, 8);
  3304. # Set the global $address_length based on what we see here.
  3305. # 8 is 32-bit (8 hexadecimal chars); 16 is 64-bit (16 hexadecimal chars).
  3306. $address_length = ($str eq (chr(0)x8)) ? 16 : 8;
  3307. if ($address_length == 8) {
  3308. if (substr($str, 6, 2) eq chr(0)x2) {
  3309. $self->{unpack_code} = 'V'; # Little-endian.
  3310. } elsif (substr($str, 4, 2) eq chr(0)x2) {
  3311. $self->{unpack_code} = 'N'; # Big-endian
  3312. } else {
  3313. ::error("$fname: header size >= 2**16\n");
  3314. }
  3315. @$slots = unpack($self->{unpack_code} . "*", $str);
  3316. } else {
  3317. # If we're a 64-bit profile, check if we're a 64-bit-capable
  3318. # perl. Otherwise, each slot will be represented as a float
  3319. # instead of an int64, losing precision and making all the
  3320. # 64-bit addresses wrong. We won't complain yet, but will
  3321. # later if we ever see a value that doesn't fit in 32 bits.
  3322. my $has_q = 0;
  3323. eval { $has_q = pack("Q", "1") ? 1 : 1; };
  3324. if (!$has_q) {
  3325. $self->{perl_is_64bit} = 0;
  3326. }
  3327. read($self->{file}, $str, 8);
  3328. if (substr($str, 4, 4) eq chr(0)x4) {
  3329. # We'd love to use 'Q', but it's a) not universal, b) not endian-proof.
  3330. $self->{unpack_code} = 'V'; # Little-endian.
  3331. } elsif (substr($str, 0, 4) eq chr(0)x4) {
  3332. $self->{unpack_code} = 'N'; # Big-endian
  3333. } else {
  3334. ::error("$fname: header size >= 2**32\n");
  3335. }
  3336. my @pair = unpack($self->{unpack_code} . "*", $str);
  3337. # Since we know one of the pair is 0, it's fine to just add them.
  3338. @$slots = (0, $pair[0] + $pair[1]);
  3339. }
  3340. return $self;
  3341. }
  3342. # Load more data when we access slots->get(X) which is not yet in memory.
  3343. sub overflow {
  3344. my ($self) = @_;
  3345. my $slots = $self->{slots};
  3346. $self->{base} += $#$slots + 1; # skip over data we're replacing
  3347. my $str;
  3348. read($self->{file}, $str, $self->{stride});
  3349. if ($address_length == 8) { # the 32-bit case
  3350. # This is the easy case: unpack provides 32-bit unpacking primitives.
  3351. @$slots = unpack($self->{unpack_code} . "*", $str);
  3352. } else {
  3353. # We need to unpack 32 bits at a time and combine.
  3354. my @b32_values = unpack($self->{unpack_code} . "*", $str);
  3355. my @b64_values = ();
  3356. for (my $i = 0; $i < $#b32_values; $i += 2) {
  3357. # TODO(csilvers): if this is a 32-bit perl, the math below
  3358. # could end up in a too-large int, which perl will promote
  3359. # to a double, losing necessary precision. Deal with that.
  3360. # Right now, we just die.
  3361. my ($lo, $hi) = ($b32_values[$i], $b32_values[$i+1]);
  3362. if ($self->{unpack_code} eq 'N') { # big-endian
  3363. ($lo, $hi) = ($hi, $lo);
  3364. }
  3365. my $value = $lo + $hi * (2**32);
  3366. if (!$self->{perl_is_64bit} && # check value is exactly represented
  3367. (($value % (2**32)) != $lo || int($value / (2**32)) != $hi)) {
  3368. ::error("Need a 64-bit perl to process this 64-bit profile.\n");
  3369. }
  3370. push(@b64_values, $value);
  3371. }
  3372. @$slots = @b64_values;
  3373. }
  3374. }
  3375. # Access the i-th long in the file (logically), or -1 at EOF.
  3376. sub get {
  3377. my ($self, $idx) = @_;
  3378. my $slots = $self->{slots};
  3379. while ($#$slots >= 0) {
  3380. if ($idx < $self->{base}) {
  3381. # The only time we expect a reference to $slots[$i - something]
  3382. # after referencing $slots[$i] is reading the very first header.
  3383. # Since $stride > |header|, that shouldn't cause any lookback
  3384. # errors. And everything after the header is sequential.
  3385. print STDERR "Unexpected look-back reading CPU profile";
  3386. return -1; # shrug, don't know what better to return
  3387. } elsif ($idx > $self->{base} + $#$slots) {
  3388. $self->overflow();
  3389. } else {
  3390. return $slots->[$idx - $self->{base}];
  3391. }
  3392. }
  3393. # If we get here, $slots is [], which means we've reached EOF
  3394. return -1; # unique since slots is supposed to hold unsigned numbers
  3395. }
  3396. }
  3397. # Reads the top, 'header' section of a profile, and returns the last
  3398. # line of the header, commonly called a 'header line'. The header
  3399. # section of a profile consists of zero or more 'command' lines that
  3400. # are instructions to pprof, which pprof executes when reading the
  3401. # header. All 'command' lines start with a %. After the command
  3402. # lines is the 'header line', which is a profile-specific line that
  3403. # indicates what type of profile it is, and perhaps other global
  3404. # information about the profile. For instance, here's a header line
  3405. # for a heap profile:
  3406. # heap profile: 53: 38236 [ 5525: 1284029] @ heapprofile
  3407. # For historical reasons, the CPU profile does not contain a text-
  3408. # readable header line. If the profile looks like a CPU profile,
  3409. # this function returns "". If no header line could be found, this
  3410. # function returns undef.
  3411. #
  3412. # The following commands are recognized:
  3413. # %warn -- emit the rest of this line to stderr, prefixed by 'WARNING:'
  3414. #
  3415. # The input file should be in binmode.
  3416. sub ReadProfileHeader {
  3417. local *PROFILE = shift;
  3418. my $firstchar = "";
  3419. my $line = "";
  3420. read(PROFILE, $firstchar, 1);
  3421. seek(PROFILE, -1, 1); # unread the firstchar
  3422. if ($firstchar !~ /[[:print:]]/) { # is not a text character
  3423. return "";
  3424. }
  3425. while (defined($line = <PROFILE>)) {
  3426. $line =~ s/\r//g; # turn windows-looking lines into unix-looking lines
  3427. if ($line =~ /^%warn\s+(.*)/) { # 'warn' command
  3428. # Note this matches both '%warn blah\n' and '%warn\n'.
  3429. print STDERR "WARNING: $1\n"; # print the rest of the line
  3430. } elsif ($line =~ /^%/) {
  3431. print STDERR "Ignoring unknown command from profile header: $line";
  3432. } else {
  3433. # End of commands, must be the header line.
  3434. return $line;
  3435. }
  3436. }
  3437. return undef; # got to EOF without seeing a header line
  3438. }
  3439. sub IsSymbolizedProfileFile {
  3440. my $file_name = shift;
  3441. if (!(-e $file_name) || !(-r $file_name)) {
  3442. return 0;
  3443. }
  3444. # Check if the file contains a symbol-section marker.
  3445. open(TFILE, "<$file_name");
  3446. binmode TFILE;
  3447. my $firstline = ReadProfileHeader(*TFILE);
  3448. close(TFILE);
  3449. if (!$firstline) {
  3450. return 0;
  3451. }
  3452. $SYMBOL_PAGE =~ m,[^/]+$,; # matches everything after the last slash
  3453. my $symbol_marker = $&;
  3454. return $firstline =~ /^--- *$symbol_marker/;
  3455. }
  3456. # Parse profile generated by common/profiler.cc and return a reference
  3457. # to a map:
  3458. # $result->{version} Version number of profile file
  3459. # $result->{period} Sampling period (in microseconds)
  3460. # $result->{profile} Profile object
  3461. # $result->{map} Memory map info from profile
  3462. # $result->{pcs} Hash of all PC values seen, key is hex address
  3463. sub ReadProfile {
  3464. my $prog = shift;
  3465. my $fname = shift;
  3466. my $result; # return value
  3467. $CONTENTION_PAGE =~ m,[^/]+$,; # matches everything after the last slash
  3468. my $contention_marker = $&;
  3469. $GROWTH_PAGE =~ m,[^/]+$,; # matches everything after the last slash
  3470. my $growth_marker = $&;
  3471. $SYMBOL_PAGE =~ m,[^/]+$,; # matches everything after the last slash
  3472. my $symbol_marker = $&;
  3473. $PROFILE_PAGE =~ m,[^/]+$,; # matches everything after the last slash
  3474. my $profile_marker = $&;
  3475. # Look at first line to see if it is a heap or a CPU profile.
  3476. # CPU profile may start with no header at all, and just binary data
  3477. # (starting with \0\0\0\0) -- in that case, don't try to read the
  3478. # whole firstline, since it may be gigabytes(!) of data.
  3479. open(PROFILE, "<$fname") || error("$fname: $!\n");
  3480. binmode PROFILE; # New perls do UTF-8 processing
  3481. my $header = ReadProfileHeader(*PROFILE);
  3482. if (!defined($header)) { # means "at EOF"
  3483. error("Profile is empty.\n");
  3484. }
  3485. my $symbols;
  3486. if ($header =~ m/^--- *$symbol_marker/o) {
  3487. # Verify that the user asked for a symbolized profile
  3488. if (!$main::use_symbolized_profile) {
  3489. # we have both a binary and symbolized profiles, abort
  3490. error("FATAL ERROR: Symbolized profile\n $fname\ncannot be used with " .
  3491. "a binary arg. Try again without passing\n $prog\n");
  3492. }
  3493. # Read the symbol section of the symbolized profile file.
  3494. $symbols = ReadSymbols(*PROFILE{IO});
  3495. # Read the next line to get the header for the remaining profile.
  3496. $header = ReadProfileHeader(*PROFILE) || "";
  3497. }
  3498. $main::profile_type = '';
  3499. if ($header =~ m/^heap profile:.*$growth_marker/o) {
  3500. $main::profile_type = 'growth';
  3501. $result = ReadHeapProfile($prog, *PROFILE, $header);
  3502. } elsif ($header =~ m/^heap profile:/) {
  3503. $main::profile_type = 'heap';
  3504. $result = ReadHeapProfile($prog, *PROFILE, $header);
  3505. } elsif ($header =~ m/^--- *$contention_marker/o) {
  3506. $main::profile_type = 'contention';
  3507. $result = ReadSynchProfile($prog, *PROFILE);
  3508. } elsif ($header =~ m/^--- *Stacks:/) {
  3509. print STDERR
  3510. "Old format contention profile: mistakenly reports " .
  3511. "condition variable signals as lock contentions.\n";
  3512. $main::profile_type = 'contention';
  3513. $result = ReadSynchProfile($prog, *PROFILE);
  3514. } elsif ($header =~ m/^--- *$profile_marker/) {
  3515. # the binary cpu profile data starts immediately after this line
  3516. $main::profile_type = 'cpu';
  3517. $result = ReadCPUProfile($prog, $fname, *PROFILE);
  3518. } else {
  3519. if (defined($symbols)) {
  3520. # a symbolized profile contains a format we don't recognize, bail out
  3521. error("$fname: Cannot recognize profile section after symbols.\n");
  3522. }
  3523. # no ascii header present -- must be a CPU profile
  3524. $main::profile_type = 'cpu';
  3525. $result = ReadCPUProfile($prog, $fname, *PROFILE);
  3526. }
  3527. close(PROFILE);
  3528. # if we got symbols along with the profile, return those as well
  3529. if (defined($symbols)) {
  3530. $result->{symbols} = $symbols;
  3531. }
  3532. return $result;
  3533. }
  3534. # Subtract one from caller pc so we map back to call instr.
  3535. # However, don't do this if we're reading a symbolized profile
  3536. # file, in which case the subtract-one was done when the file
  3537. # was written.
  3538. #
  3539. # We apply the same logic to all readers, though ReadCPUProfile uses an
  3540. # independent implementation.
  3541. sub FixCallerAddresses {
  3542. my $stack = shift;
  3543. if ($main::use_symbolized_profile) {
  3544. return $stack;
  3545. } else {
  3546. $stack =~ /(\s)/;
  3547. my $delimiter = $1;
  3548. my @addrs = split(' ', $stack);
  3549. my @fixedaddrs;
  3550. $#fixedaddrs = $#addrs;
  3551. if ($#addrs >= 0) {
  3552. $fixedaddrs[0] = $addrs[0];
  3553. }
  3554. for (my $i = 1; $i <= $#addrs; $i++) {
  3555. $fixedaddrs[$i] = AddressSub($addrs[$i], "0x1");
  3556. }
  3557. return join $delimiter, @fixedaddrs;
  3558. }
  3559. }
  3560. # CPU profile reader
  3561. sub ReadCPUProfile {
  3562. my $prog = shift;
  3563. my $fname = shift; # just used for logging
  3564. local *PROFILE = shift;
  3565. my $version;
  3566. my $period;
  3567. my $i;
  3568. my $profile = {};
  3569. my $pcs = {};
  3570. # Parse string into array of slots.
  3571. my $slots = CpuProfileStream->new(*PROFILE, $fname);
  3572. # Read header. The current header version is a 5-element structure
  3573. # containing:
  3574. # 0: header count (always 0)
  3575. # 1: header "words" (after this one: 3)
  3576. # 2: format version (0)
  3577. # 3: sampling period (usec)
  3578. # 4: unused padding (always 0)
  3579. if ($slots->get(0) != 0 ) {
  3580. error("$fname: not a profile file, or old format profile file\n");
  3581. }
  3582. $i = 2 + $slots->get(1);
  3583. $version = $slots->get(2);
  3584. $period = $slots->get(3);
  3585. # Do some sanity checking on these header values.
  3586. if ($version > (2**32) || $period > (2**32) || $i > (2**32) || $i < 5) {
  3587. error("$fname: not a profile file, or corrupted profile file\n");
  3588. }
  3589. # Parse profile
  3590. while ($slots->get($i) != -1) {
  3591. my $n = $slots->get($i++);
  3592. my $d = $slots->get($i++);
  3593. if ($d > (2**16)) { # TODO(csilvers): what's a reasonable max-stack-depth?
  3594. my $addr = sprintf("0%o", $i * ($address_length == 8 ? 4 : 8));
  3595. print STDERR "At index $i (address $addr):\n";
  3596. error("$fname: stack trace depth >= 2**32\n");
  3597. }
  3598. if ($slots->get($i) == 0) {
  3599. # End of profile data marker
  3600. $i += $d;
  3601. last;
  3602. }
  3603. # Make key out of the stack entries
  3604. my @k = ();
  3605. for (my $j = 0; $j < $d; $j++) {
  3606. my $pc = $slots->get($i+$j);
  3607. # Subtract one from caller pc so we map back to call instr.
  3608. # However, don't do this if we're reading a symbolized profile
  3609. # file, in which case the subtract-one was done when the file
  3610. # was written.
  3611. if ($j > 0 && !$main::use_symbolized_profile) {
  3612. $pc--;
  3613. }
  3614. $pc = sprintf("%0*x", $address_length, $pc);
  3615. $pcs->{$pc} = 1;
  3616. push @k, $pc;
  3617. }
  3618. AddEntry($profile, (join "\n", @k), $n);
  3619. $i += $d;
  3620. }
  3621. # Parse map
  3622. my $map = '';
  3623. seek(PROFILE, $i * ($address_length / 2), 0);
  3624. read(PROFILE, $map, (stat PROFILE)[7]);
  3625. my $r = {};
  3626. $r->{version} = $version;
  3627. $r->{period} = $period;
  3628. $r->{profile} = $profile;
  3629. $r->{libs} = ParseLibraries($prog, $map, $pcs);
  3630. $r->{pcs} = $pcs;
  3631. return $r;
  3632. }
  3633. sub ReadHeapProfile {
  3634. my $prog = shift;
  3635. local *PROFILE = shift;
  3636. my $header = shift;
  3637. my $index = 1;
  3638. if ($main::opt_inuse_space) {
  3639. $index = 1;
  3640. } elsif ($main::opt_inuse_objects) {
  3641. $index = 0;
  3642. } elsif ($main::opt_alloc_space) {
  3643. $index = 3;
  3644. } elsif ($main::opt_alloc_objects) {
  3645. $index = 2;
  3646. }
  3647. # Find the type of this profile. The header line looks like:
  3648. # heap profile: 1246: 8800744 [ 1246: 8800744] @ <heap-url>/266053
  3649. # There are two pairs <count: size>, the first inuse objects/space, and the
  3650. # second allocated objects/space. This is followed optionally by a profile
  3651. # type, and if that is present, optionally by a sampling frequency.
  3652. # For remote heap profiles (v1):
  3653. # The interpretation of the sampling frequency is that the profiler, for
  3654. # each sample, calculates a uniformly distributed random integer less than
  3655. # the given value, and records the next sample after that many bytes have
  3656. # been allocated. Therefore, the expected sample interval is half of the
  3657. # given frequency. By default, if not specified, the expected sample
  3658. # interval is 128KB. Only remote-heap-page profiles are adjusted for
  3659. # sample size.
  3660. # For remote heap profiles (v2):
  3661. # The sampling frequency is the rate of a Poisson process. This means that
  3662. # the probability of sampling an allocation of size X with sampling rate Y
  3663. # is 1 - exp(-X/Y)
  3664. # For version 2, a typical header line might look like this:
  3665. # heap profile: 1922: 127792360 [ 1922: 127792360] @ <heap-url>_v2/524288
  3666. # the trailing number (524288) is the sampling rate. (Version 1 showed
  3667. # double the 'rate' here)
  3668. my $sampling_algorithm = 0;
  3669. my $sample_adjustment = 0;
  3670. chomp($header);
  3671. my $type = "unknown";
  3672. if ($header =~ m"^heap profile:\s*(\d+):\s+(\d+)\s+\[\s*(\d+):\s+(\d+)\](\s*@\s*([^/]*)(/(\d+))?)?") {
  3673. if (defined($6) && ($6 ne '')) {
  3674. $type = $6;
  3675. my $sample_period = $8;
  3676. # $type is "heapprofile" for profiles generated by the
  3677. # heap-profiler, and either "heap" or "heap_v2" for profiles
  3678. # generated by sampling directly within tcmalloc. It can also
  3679. # be "growth" for heap-growth profiles. The first is typically
  3680. # found for profiles generated locally, and the others for
  3681. # remote profiles.
  3682. if (($type eq "heapprofile") || ($type !~ /heap/) ) {
  3683. # No need to adjust for the sampling rate with heap-profiler-derived data
  3684. $sampling_algorithm = 0;
  3685. } elsif ($type =~ /_v2/) {
  3686. $sampling_algorithm = 2; # version 2 sampling
  3687. if (defined($sample_period) && ($sample_period ne '')) {
  3688. $sample_adjustment = int($sample_period);
  3689. }
  3690. } else {
  3691. $sampling_algorithm = 1; # version 1 sampling
  3692. if (defined($sample_period) && ($sample_period ne '')) {
  3693. $sample_adjustment = int($sample_period)/2;
  3694. }
  3695. }
  3696. } else {
  3697. # We detect whether or not this is a remote-heap profile by checking
  3698. # that the total-allocated stats ($n2,$s2) are exactly the
  3699. # same as the in-use stats ($n1,$s1). It is remotely conceivable
  3700. # that a non-remote-heap profile may pass this check, but it is hard
  3701. # to imagine how that could happen.
  3702. # In this case it's so old it's guaranteed to be remote-heap version 1.
  3703. my ($n1, $s1, $n2, $s2) = ($1, $2, $3, $4);
  3704. if (($n1 == $n2) && ($s1 == $s2)) {
  3705. # This is likely to be a remote-heap based sample profile
  3706. $sampling_algorithm = 1;
  3707. }
  3708. }
  3709. }
  3710. if ($sampling_algorithm > 0) {
  3711. # For remote-heap generated profiles, adjust the counts and sizes to
  3712. # account for the sample rate (we sample once every 128KB by default).
  3713. if ($sample_adjustment == 0) {
  3714. # Turn on profile adjustment.
  3715. $sample_adjustment = 128*1024;
  3716. print STDERR "Adjusting heap profiles for 1-in-128KB sampling rate\n";
  3717. } else {
  3718. printf STDERR ("Adjusting heap profiles for 1-in-%d sampling rate\n",
  3719. $sample_adjustment);
  3720. }
  3721. if ($sampling_algorithm > 1) {
  3722. # We don't bother printing anything for the original version (version 1)
  3723. printf STDERR "Heap version $sampling_algorithm\n";
  3724. }
  3725. }
  3726. my $profile = {};
  3727. my $pcs = {};
  3728. my $map = "";
  3729. while (<PROFILE>) {
  3730. s/\r//g; # turn windows-looking lines into unix-looking lines
  3731. if (/^MAPPED_LIBRARIES:/) {
  3732. # Read the /proc/self/maps data
  3733. while (<PROFILE>) {
  3734. s/\r//g; # turn windows-looking lines into unix-looking lines
  3735. $map .= $_;
  3736. }
  3737. last;
  3738. }
  3739. if (/^--- Memory map:/) {
  3740. # Read /proc/self/maps data as formatted by DumpAddressMap()
  3741. my $buildvar = "";
  3742. while (<PROFILE>) {
  3743. s/\r//g; # turn windows-looking lines into unix-looking lines
  3744. # Parse "build=<dir>" specification if supplied
  3745. if (m/^\s*build=(.*)\n/) {
  3746. $buildvar = $1;
  3747. }
  3748. # Expand "$build" variable if available
  3749. $_ =~ s/\$build\b/$buildvar/g;
  3750. $map .= $_;
  3751. }
  3752. last;
  3753. }
  3754. # Read entry of the form:
  3755. # <count1>: <bytes1> [<count2>: <bytes2>] @ a1 a2 a3 ... an
  3756. s/^\s*//;
  3757. s/\s*$//;
  3758. if (m/^\s*(\d+):\s+(\d+)\s+\[\s*(\d+):\s+(\d+)\]\s+@\s+(.*)$/) {
  3759. my $stack = $5;
  3760. my ($n1, $s1, $n2, $s2) = ($1, $2, $3, $4);
  3761. if ($sample_adjustment) {
  3762. if ($sampling_algorithm == 2) {
  3763. # Remote-heap version 2
  3764. # The sampling frequency is the rate of a Poisson process.
  3765. # This means that the probability of sampling an allocation of
  3766. # size X with sampling rate Y is 1 - exp(-X/Y)
  3767. if ($n1 != 0) {
  3768. my $ratio = (($s1*1.0)/$n1)/($sample_adjustment);
  3769. my $scale_factor = 1/(1 - exp(-$ratio));
  3770. $n1 *= $scale_factor;
  3771. $s1 *= $scale_factor;
  3772. }
  3773. if ($n2 != 0) {
  3774. my $ratio = (($s2*1.0)/$n2)/($sample_adjustment);
  3775. my $scale_factor = 1/(1 - exp(-$ratio));
  3776. $n2 *= $scale_factor;
  3777. $s2 *= $scale_factor;
  3778. }
  3779. } else {
  3780. # Remote-heap version 1
  3781. my $ratio;
  3782. $ratio = (($s1*1.0)/$n1)/($sample_adjustment);
  3783. if ($ratio < 1) {
  3784. $n1 /= $ratio;
  3785. $s1 /= $ratio;
  3786. }
  3787. $ratio = (($s2*1.0)/$n2)/($sample_adjustment);
  3788. if ($ratio < 1) {
  3789. $n2 /= $ratio;
  3790. $s2 /= $ratio;
  3791. }
  3792. }
  3793. }
  3794. my @counts = ($n1, $s1, $n2, $s2);
  3795. $stack = FixCallerAddresses($stack);
  3796. push @stackTraces, "$n1 $s1 $n2 $s2 $stack";
  3797. AddEntries($profile, $pcs, $stack, $counts[$index]);
  3798. }
  3799. }
  3800. my $r = {};
  3801. $r->{version} = "heap";
  3802. $r->{period} = 1;
  3803. $r->{profile} = $profile;
  3804. $r->{libs} = ParseLibraries($prog, $map, $pcs);
  3805. $r->{pcs} = $pcs;
  3806. return $r;
  3807. }
  3808. sub ReadSynchProfile {
  3809. my $prog = shift;
  3810. local *PROFILE = shift;
  3811. my $header = shift;
  3812. my $map = '';
  3813. my $profile = {};
  3814. my $pcs = {};
  3815. my $sampling_period = 1;
  3816. my $cyclespernanosec = 2.8; # Default assumption for old binaries
  3817. my $seen_clockrate = 0;
  3818. my $line;
  3819. my $index = 0;
  3820. if ($main::opt_total_delay) {
  3821. $index = 0;
  3822. } elsif ($main::opt_contentions) {
  3823. $index = 1;
  3824. } elsif ($main::opt_mean_delay) {
  3825. $index = 2;
  3826. }
  3827. while ( $line = <PROFILE> ) {
  3828. $line =~ s/\r//g; # turn windows-looking lines into unix-looking lines
  3829. if ( $line =~ /^\s*(\d+)\s+(\d+) \@\s*(.*?)\s*$/ ) {
  3830. my ($cycles, $count, $stack) = ($1, $2, $3);
  3831. # Convert cycles to nanoseconds
  3832. $cycles /= $cyclespernanosec;
  3833. # Adjust for sampling done by application
  3834. $cycles *= $sampling_period;
  3835. $count *= $sampling_period;
  3836. my @values = ($cycles, $count, $cycles / $count);
  3837. AddEntries($profile, $pcs, FixCallerAddresses($stack), $values[$index]);
  3838. } elsif ( $line =~ /^(slow release).*thread \d+ \@\s*(.*?)\s*$/ ||
  3839. $line =~ /^\s*(\d+) \@\s*(.*?)\s*$/ ) {
  3840. my ($cycles, $stack) = ($1, $2);
  3841. if ($cycles !~ /^\d+$/) {
  3842. next;
  3843. }
  3844. # Convert cycles to nanoseconds
  3845. $cycles /= $cyclespernanosec;
  3846. # Adjust for sampling done by application
  3847. $cycles *= $sampling_period;
  3848. AddEntries($profile, $pcs, FixCallerAddresses($stack), $cycles);
  3849. } elsif ( $line =~ m/^([a-z][^=]*)=(.*)$/ ) {
  3850. my ($variable, $value) = ($1,$2);
  3851. for ($variable, $value) {
  3852. s/^\s+//;
  3853. s/\s+$//;
  3854. }
  3855. if ($variable eq "cycles/second") {
  3856. $cyclespernanosec = $value / 1e9;
  3857. $seen_clockrate = 1;
  3858. } elsif ($variable eq "sampling period") {
  3859. $sampling_period = $value;
  3860. } elsif ($variable eq "ms since reset") {
  3861. # Currently nothing is done with this value in pprof
  3862. # So we just silently ignore it for now
  3863. } elsif ($variable eq "discarded samples") {
  3864. # Currently nothing is done with this value in pprof
  3865. # So we just silently ignore it for now
  3866. } else {
  3867. printf STDERR ("Ignoring unnknown variable in /contention output: " .
  3868. "'%s' = '%s'\n",$variable,$value);
  3869. }
  3870. } else {
  3871. # Memory map entry
  3872. $map .= $line;
  3873. }
  3874. }
  3875. if (!$seen_clockrate) {
  3876. printf STDERR ("No cycles/second entry in profile; Guessing %.1f GHz\n",
  3877. $cyclespernanosec);
  3878. }
  3879. my $r = {};
  3880. $r->{version} = 0;
  3881. $r->{period} = $sampling_period;
  3882. $r->{profile} = $profile;
  3883. $r->{libs} = ParseLibraries($prog, $map, $pcs);
  3884. $r->{pcs} = $pcs;
  3885. return $r;
  3886. }
  3887. # Given a hex value in the form "0x1abcd" or "1abcd", return either
  3888. # "0001abcd" or "000000000001abcd", depending on the current (global)
  3889. # address length.
  3890. sub HexExtend {
  3891. my $addr = shift;
  3892. $addr =~ s/^(0x)?0*//;
  3893. my $zeros_needed = $address_length - length($addr);
  3894. if ($zeros_needed < 0) {
  3895. printf STDERR "Warning: address $addr is longer than address length $address_length\n";
  3896. return $addr;
  3897. }
  3898. return ("0" x $zeros_needed) . $addr;
  3899. }
  3900. ##### Symbol extraction #####
  3901. # Aggressively search the lib_prefix values for the given library
  3902. # If all else fails, just return the name of the library unmodified.
  3903. # If the lib_prefix is "/my/path,/other/path" and $file is "/lib/dir/mylib.so"
  3904. # it will search the following locations in this order, until it finds a file:
  3905. # /my/path/lib/dir/mylib.so
  3906. # /other/path/lib/dir/mylib.so
  3907. # /my/path/dir/mylib.so
  3908. # /other/path/dir/mylib.so
  3909. # /my/path/mylib.so
  3910. # /other/path/mylib.so
  3911. # /lib/dir/mylib.so (returned as last resort)
  3912. sub FindLibrary {
  3913. my $file = shift;
  3914. my $suffix = $file;
  3915. # Search for the library as described above
  3916. do {
  3917. foreach my $prefix (@prefix_list) {
  3918. my $fullpath = $prefix . $suffix;
  3919. if (-e $fullpath) {
  3920. return $fullpath;
  3921. }
  3922. }
  3923. } while ($suffix =~ s|^/[^/]+/|/|);
  3924. return $file;
  3925. }
  3926. # Return path to library with debugging symbols.
  3927. # For libc libraries, the copy in /usr/lib/debug contains debugging symbols
  3928. sub DebuggingLibrary {
  3929. my $file = shift;
  3930. if ($file =~ m|^/| && -f "/usr/lib/debug$file") {
  3931. return "/usr/lib/debug$file";
  3932. }
  3933. if ($file =~ m|^/| && -f "/usr/lib/debug$file.debug") {
  3934. return "/usr/lib/debug$file.debug";
  3935. }
  3936. return undef;
  3937. }
  3938. # Parse text section header of a library using objdump
  3939. sub ParseTextSectionHeaderFromObjdump {
  3940. my $lib = shift;
  3941. my $size = undef;
  3942. my $vma;
  3943. my $file_offset;
  3944. # Get objdump output from the library file to figure out how to
  3945. # map between mapped addresses and addresses in the library.
  3946. my $cmd = ShellEscape($obj_tool_map{"objdump"}, "-h", $lib);
  3947. open(OBJDUMP, "$cmd |") || error("$cmd: $!\n");
  3948. while (<OBJDUMP>) {
  3949. s/\r//g; # turn windows-looking lines into unix-looking lines
  3950. # Idx Name Size VMA LMA File off Algn
  3951. # 10 .text 00104b2c 420156f0 420156f0 000156f0 2**4
  3952. # For 64-bit objects, VMA and LMA will be 16 hex digits, size and file
  3953. # offset may still be 8. But AddressSub below will still handle that.
  3954. my @x = split;
  3955. if (($#x >= 6) && ($x[1] eq '.text')) {
  3956. $size = $x[2];
  3957. $vma = $x[3];
  3958. $file_offset = $x[5];
  3959. last;
  3960. }
  3961. }
  3962. close(OBJDUMP);
  3963. if (!defined($size)) {
  3964. return undef;
  3965. }
  3966. my $r = {};
  3967. $r->{size} = $size;
  3968. $r->{vma} = $vma;
  3969. $r->{file_offset} = $file_offset;
  3970. return $r;
  3971. }
  3972. # Parse text section header of a library using otool (on OS X)
  3973. sub ParseTextSectionHeaderFromOtool {
  3974. my $lib = shift;
  3975. my $size = undef;
  3976. my $vma = undef;
  3977. my $file_offset = undef;
  3978. # Get otool output from the library file to figure out how to
  3979. # map between mapped addresses and addresses in the library.
  3980. my $command = ShellEscape($obj_tool_map{"otool"}, "-l", $lib);
  3981. open(OTOOL, "$command |") || error("$command: $!\n");
  3982. my $cmd = "";
  3983. my $sectname = "";
  3984. my $segname = "";
  3985. foreach my $line (<OTOOL>) {
  3986. $line =~ s/\r//g; # turn windows-looking lines into unix-looking lines
  3987. # Load command <#>
  3988. # cmd LC_SEGMENT
  3989. # [...]
  3990. # Section
  3991. # sectname __text
  3992. # segname __TEXT
  3993. # addr 0x000009f8
  3994. # size 0x00018b9e
  3995. # offset 2552
  3996. # align 2^2 (4)
  3997. # We will need to strip off the leading 0x from the hex addresses,
  3998. # and convert the offset into hex.
  3999. if ($line =~ /Load command/) {
  4000. $cmd = "";
  4001. $sectname = "";
  4002. $segname = "";
  4003. } elsif ($line =~ /Section/) {
  4004. $sectname = "";
  4005. $segname = "";
  4006. } elsif ($line =~ /cmd (\w+)/) {
  4007. $cmd = $1;
  4008. } elsif ($line =~ /sectname (\w+)/) {
  4009. $sectname = $1;
  4010. } elsif ($line =~ /segname (\w+)/) {
  4011. $segname = $1;
  4012. } elsif (!(($cmd eq "LC_SEGMENT" || $cmd eq "LC_SEGMENT_64") &&
  4013. $sectname eq "__text" &&
  4014. $segname eq "__TEXT")) {
  4015. next;
  4016. } elsif ($line =~ /\baddr 0x([0-9a-fA-F]+)/) {
  4017. $vma = $1;
  4018. } elsif ($line =~ /\bsize 0x([0-9a-fA-F]+)/) {
  4019. $size = $1;
  4020. } elsif ($line =~ /\boffset ([0-9]+)/) {
  4021. $file_offset = sprintf("%016x", $1);
  4022. }
  4023. if (defined($vma) && defined($size) && defined($file_offset)) {
  4024. last;
  4025. }
  4026. }
  4027. close(OTOOL);
  4028. if (!defined($vma) || !defined($size) || !defined($file_offset)) {
  4029. return undef;
  4030. }
  4031. my $r = {};
  4032. $r->{size} = $size;
  4033. $r->{vma} = $vma;
  4034. $r->{file_offset} = $file_offset;
  4035. return $r;
  4036. }
  4037. sub ParseTextSectionHeader {
  4038. # obj_tool_map("otool") is only defined if we're in a Mach-O environment
  4039. if (defined($obj_tool_map{"otool"})) {
  4040. my $r = ParseTextSectionHeaderFromOtool(@_);
  4041. if (defined($r)){
  4042. return $r;
  4043. }
  4044. }
  4045. # If otool doesn't work, or we don't have it, fall back to objdump
  4046. return ParseTextSectionHeaderFromObjdump(@_);
  4047. }
  4048. # Split /proc/pid/maps dump into a list of libraries
  4049. sub ParseLibraries {
  4050. return if $main::use_symbol_page; # We don't need libraries info.
  4051. my $prog = Cwd::abs_path(shift);
  4052. my $map = shift;
  4053. my $pcs = shift;
  4054. my $result = [];
  4055. my $h = "[a-f0-9]+";
  4056. my $zero_offset = HexExtend("0");
  4057. my $buildvar = "";
  4058. my $priorlib = "";
  4059. foreach my $l (split("\n", $map)) {
  4060. if ($l =~ m/^\s*build=(.*)$/) {
  4061. $buildvar = $1;
  4062. }
  4063. my $start;
  4064. my $finish;
  4065. my $offset;
  4066. my $lib;
  4067. if ($l =~ /^($h)-($h)\s+..x.\s+($h)\s+\S+:\S+\s+\d+\s+(.+\.(so|dll|dylib|bundle)((\.\d+)+\w*(\.\d+){0,3})?)$/i) {
  4068. # Full line from /proc/self/maps. Example:
  4069. # 40000000-40015000 r-xp 00000000 03:01 12845071 /lib/ld-2.3.2.so
  4070. $start = HexExtend($1);
  4071. $finish = HexExtend($2);
  4072. $offset = HexExtend($3);
  4073. $lib = $4;
  4074. $lib =~ s|\\|/|g; # turn windows-style paths into unix-style paths
  4075. } elsif ($l =~ /^\s*($h)-($h):\s*(\S+\.so(\.\d+)*)/) {
  4076. # Cooked line from DumpAddressMap. Example:
  4077. # 40000000-40015000: /lib/ld-2.3.2.so
  4078. $start = HexExtend($1);
  4079. $finish = HexExtend($2);
  4080. $offset = $zero_offset;
  4081. $lib = $3;
  4082. } elsif (($l =~ /^($h)-($h)\s+..x.\s+($h)\s+\S+:\S+\s+\d+\s+(\S+)$/i) && ($4 eq $prog)) {
  4083. # PIEs and address space randomization do not play well with our
  4084. # default assumption that main executable is at lowest
  4085. # addresses. So we're detecting main executable in
  4086. # /proc/self/maps as well.
  4087. $start = HexExtend($1);
  4088. $finish = HexExtend($2);
  4089. $offset = HexExtend($3);
  4090. $lib = $4;
  4091. $lib =~ s|\\|/|g; # turn windows-style paths into unix-style paths
  4092. } else {
  4093. next;
  4094. }
  4095. # Expand "$build" variable if available
  4096. $lib =~ s/\$build\b/$buildvar/g;
  4097. $lib = FindLibrary($lib);
  4098. # Check for pre-relocated libraries, which use pre-relocated symbol tables
  4099. # and thus require adjusting the offset that we'll use to translate
  4100. # VM addresses into symbol table addresses.
  4101. # Only do this if we're not going to fetch the symbol table from a
  4102. # debugging copy of the library.
  4103. if (!DebuggingLibrary($lib)) {
  4104. my $text = ParseTextSectionHeader($lib);
  4105. if (defined($text)) {
  4106. my $vma_offset = AddressSub($text->{vma}, $text->{file_offset});
  4107. $offset = AddressAdd($offset, $vma_offset);
  4108. }
  4109. }
  4110. # If we find multiple executable segments for a single library, merge them
  4111. # into a single entry that spans the complete address range.
  4112. if ($lib eq $priorlib) {
  4113. my $prior = pop(@{$result});
  4114. $start = @$prior[1];
  4115. # TODO $offset may be wrong if .text is not in the final segment.
  4116. }
  4117. push(@{$result}, [$lib, $start, $finish, $offset]);
  4118. $priorlib = $lib;
  4119. }
  4120. # Append special entry for additional library (not relocated)
  4121. if ($main::opt_lib ne "") {
  4122. my $text = ParseTextSectionHeader($main::opt_lib);
  4123. if (defined($text)) {
  4124. my $start = $text->{vma};
  4125. my $finish = AddressAdd($start, $text->{size});
  4126. push(@{$result}, [$main::opt_lib, $start, $finish, $start]);
  4127. }
  4128. }
  4129. # Append special entry for the main program. This covers
  4130. # 0..max_pc_value_seen, so that we assume pc values not found in one
  4131. # of the library ranges will be treated as coming from the main
  4132. # program binary.
  4133. my $min_pc = HexExtend("0");
  4134. my $max_pc = $min_pc; # find the maximal PC value in any sample
  4135. foreach my $pc (keys(%{$pcs})) {
  4136. if (HexExtend($pc) gt $max_pc) { $max_pc = HexExtend($pc); }
  4137. }
  4138. push(@{$result}, [$prog, $min_pc, $max_pc, $zero_offset]);
  4139. return $result;
  4140. }
  4141. # Add two hex addresses of length $address_length.
  4142. # Run pprof --test for unit test if this is changed.
  4143. sub AddressAdd {
  4144. my $addr1 = shift;
  4145. my $addr2 = shift;
  4146. my $sum;
  4147. if ($address_length == 8) {
  4148. # Perl doesn't cope with wraparound arithmetic, so do it explicitly:
  4149. $sum = (hex($addr1)+hex($addr2)) % (0x10000000 * 16);
  4150. return sprintf("%08x", $sum);
  4151. } else {
  4152. # Do the addition in 7-nibble chunks to trivialize carry handling.
  4153. if ($main::opt_debug and $main::opt_test) {
  4154. print STDERR "AddressAdd $addr1 + $addr2 = ";
  4155. }
  4156. my $a1 = substr($addr1,-7);
  4157. $addr1 = substr($addr1,0,-7);
  4158. my $a2 = substr($addr2,-7);
  4159. $addr2 = substr($addr2,0,-7);
  4160. $sum = hex($a1) + hex($a2);
  4161. my $c = 0;
  4162. if ($sum > 0xfffffff) {
  4163. $c = 1;
  4164. $sum -= 0x10000000;
  4165. }
  4166. my $r = sprintf("%07x", $sum);
  4167. $a1 = substr($addr1,-7);
  4168. $addr1 = substr($addr1,0,-7);
  4169. $a2 = substr($addr2,-7);
  4170. $addr2 = substr($addr2,0,-7);
  4171. $sum = hex($a1) + hex($a2) + $c;
  4172. $c = 0;
  4173. if ($sum > 0xfffffff) {
  4174. $c = 1;
  4175. $sum -= 0x10000000;
  4176. }
  4177. $r = sprintf("%07x", $sum) . $r;
  4178. $sum = hex($addr1) + hex($addr2) + $c;
  4179. if ($sum > 0xff) { $sum -= 0x100; }
  4180. $r = sprintf("%02x", $sum) . $r;
  4181. if ($main::opt_debug and $main::opt_test) { print STDERR "$r\n"; }
  4182. return $r;
  4183. }
  4184. }
  4185. # Subtract two hex addresses of length $address_length.
  4186. # Run pprof --test for unit test if this is changed.
  4187. sub AddressSub {
  4188. my $addr1 = shift;
  4189. my $addr2 = shift;
  4190. my $diff;
  4191. if ($address_length == 8) {
  4192. # Perl doesn't cope with wraparound arithmetic, so do it explicitly:
  4193. $diff = (hex($addr1)-hex($addr2)) % (0x10000000 * 16);
  4194. return sprintf("%08x", $diff);
  4195. } else {
  4196. # Do the addition in 7-nibble chunks to trivialize borrow handling.
  4197. # if ($main::opt_debug) { print STDERR "AddressSub $addr1 - $addr2 = "; }
  4198. my $a1 = hex(substr($addr1,-7));
  4199. $addr1 = substr($addr1,0,-7);
  4200. my $a2 = hex(substr($addr2,-7));
  4201. $addr2 = substr($addr2,0,-7);
  4202. my $b = 0;
  4203. if ($a2 > $a1) {
  4204. $b = 1;
  4205. $a1 += 0x10000000;
  4206. }
  4207. $diff = $a1 - $a2;
  4208. my $r = sprintf("%07x", $diff);
  4209. $a1 = hex(substr($addr1,-7));
  4210. $addr1 = substr($addr1,0,-7);
  4211. $a2 = hex(substr($addr2,-7)) + $b;
  4212. $addr2 = substr($addr2,0,-7);
  4213. $b = 0;
  4214. if ($a2 > $a1) {
  4215. $b = 1;
  4216. $a1 += 0x10000000;
  4217. }
  4218. $diff = $a1 - $a2;
  4219. $r = sprintf("%07x", $diff) . $r;
  4220. $a1 = hex($addr1);
  4221. $a2 = hex($addr2) + $b;
  4222. if ($a2 > $a1) { $a1 += 0x100; }
  4223. $diff = $a1 - $a2;
  4224. $r = sprintf("%02x", $diff) . $r;
  4225. # if ($main::opt_debug) { print STDERR "$r\n"; }
  4226. return $r;
  4227. }
  4228. }
  4229. # Increment a hex addresses of length $address_length.
  4230. # Run pprof --test for unit test if this is changed.
  4231. sub AddressInc {
  4232. my $addr = shift;
  4233. my $sum;
  4234. if ($address_length == 8) {
  4235. # Perl doesn't cope with wraparound arithmetic, so do it explicitly:
  4236. $sum = (hex($addr)+1) % (0x10000000 * 16);
  4237. return sprintf("%08x", $sum);
  4238. } else {
  4239. # Do the addition in 7-nibble chunks to trivialize carry handling.
  4240. # We are always doing this to step through the addresses in a function,
  4241. # and will almost never overflow the first chunk, so we check for this
  4242. # case and exit early.
  4243. # if ($main::opt_debug) { print STDERR "AddressInc $addr1 = "; }
  4244. my $a1 = substr($addr,-7);
  4245. $addr = substr($addr,0,-7);
  4246. $sum = hex($a1) + 1;
  4247. my $r = sprintf("%07x", $sum);
  4248. if ($sum <= 0xfffffff) {
  4249. $r = $addr . $r;
  4250. # if ($main::opt_debug) { print STDERR "$r\n"; }
  4251. return HexExtend($r);
  4252. } else {
  4253. $r = "0000000";
  4254. }
  4255. $a1 = substr($addr,-7);
  4256. $addr = substr($addr,0,-7);
  4257. $sum = hex($a1) + 1;
  4258. $r = sprintf("%07x", $sum) . $r;
  4259. if ($sum <= 0xfffffff) {
  4260. $r = $addr . $r;
  4261. # if ($main::opt_debug) { print STDERR "$r\n"; }
  4262. return HexExtend($r);
  4263. } else {
  4264. $r = "00000000000000";
  4265. }
  4266. $sum = hex($addr) + 1;
  4267. if ($sum > 0xff) { $sum -= 0x100; }
  4268. $r = sprintf("%02x", $sum) . $r;
  4269. # if ($main::opt_debug) { print STDERR "$r\n"; }
  4270. return $r;
  4271. }
  4272. }
  4273. # Extract symbols for all PC values found in profile
  4274. sub ExtractSymbols {
  4275. my $libs = shift;
  4276. my $pcset = shift;
  4277. my $symbols = {};
  4278. # Map each PC value to the containing library. To make this faster,
  4279. # we sort libraries by their starting pc value (highest first), and
  4280. # advance through the libraries as we advance the pc. Sometimes the
  4281. # addresses of libraries may overlap with the addresses of the main
  4282. # binary, so to make sure the libraries 'win', we iterate over the
  4283. # libraries in reverse order (which assumes the binary doesn't start
  4284. # in the middle of a library, which seems a fair assumption).
  4285. my @pcs = (sort { $a cmp $b } keys(%{$pcset})); # pcset is 0-extended strings
  4286. foreach my $lib (sort {$b->[1] cmp $a->[1]} @{$libs}) {
  4287. my $libname = $lib->[0];
  4288. my $start = $lib->[1];
  4289. my $finish = $lib->[2];
  4290. my $offset = $lib->[3];
  4291. # Get list of pcs that belong in this library.
  4292. my $contained = [];
  4293. my ($start_pc_index, $finish_pc_index);
  4294. # Find smallest finish_pc_index such that $finish < $pc[$finish_pc_index].
  4295. for ($finish_pc_index = $#pcs + 1; $finish_pc_index > 0;
  4296. $finish_pc_index--) {
  4297. last if $pcs[$finish_pc_index - 1] le $finish;
  4298. }
  4299. # Find smallest start_pc_index such that $start <= $pc[$start_pc_index].
  4300. for ($start_pc_index = $finish_pc_index; $start_pc_index > 0;
  4301. $start_pc_index--) {
  4302. last if $pcs[$start_pc_index - 1] lt $start;
  4303. }
  4304. # This keeps PC values higher than $pc[$finish_pc_index] in @pcs,
  4305. # in case there are overlaps in libraries and the main binary.
  4306. @{$contained} = splice(@pcs, $start_pc_index,
  4307. $finish_pc_index - $start_pc_index);
  4308. # Map to symbols
  4309. MapToSymbols($libname, AddressSub($start, $offset), $contained, $symbols);
  4310. }
  4311. return $symbols;
  4312. }
  4313. # Map list of PC values to symbols for a given image
  4314. sub MapToSymbols {
  4315. my $image = shift;
  4316. my $offset = shift;
  4317. my $pclist = shift;
  4318. my $symbols = shift;
  4319. my $debug = 0;
  4320. # For libc (and other) libraries, the copy in /usr/lib/debug contains debugging symbols
  4321. my $debugging = DebuggingLibrary($image);
  4322. if ($debugging) {
  4323. $image = $debugging;
  4324. }
  4325. # Ignore empty binaries
  4326. if ($#{$pclist} < 0) { return; }
  4327. # Figure out the addr2line command to use
  4328. my $addr2line = $obj_tool_map{"addr2line"};
  4329. my $cmd = ShellEscape($addr2line, "-f", "-C", "-e", $image);
  4330. if (exists $obj_tool_map{"addr2line_pdb"}) {
  4331. $addr2line = $obj_tool_map{"addr2line_pdb"};
  4332. $cmd = ShellEscape($addr2line, "--demangle", "-f", "-C", "-e", $image);
  4333. }
  4334. # If "addr2line" isn't installed on the system at all, just use
  4335. # nm to get what info we can (function names, but not line numbers).
  4336. if (system(ShellEscape($addr2line, "--help") . " >$dev_null 2>&1") != 0) {
  4337. MapSymbolsWithNM($image, $offset, $pclist, $symbols);
  4338. return;
  4339. }
  4340. # "addr2line -i" can produce a variable number of lines per input
  4341. # address, with no separator that allows us to tell when data for
  4342. # the next address starts. So we find the address for a special
  4343. # symbol (_fini) and interleave this address between all real
  4344. # addresses passed to addr2line. The name of this special symbol
  4345. # can then be used as a separator.
  4346. $sep_address = undef; # May be filled in by MapSymbolsWithNM()
  4347. my $nm_symbols = {};
  4348. MapSymbolsWithNM($image, $offset, $pclist, $nm_symbols);
  4349. if (defined($sep_address)) {
  4350. # Only add " -i" to addr2line if the binary supports it.
  4351. # addr2line --help returns 0, but not if it sees an unknown flag first.
  4352. if (system("$cmd -i --help >$dev_null 2>&1") == 0) {
  4353. $cmd .= " -i";
  4354. } else {
  4355. $sep_address = undef; # no need for sep_address if we don't support -i
  4356. }
  4357. }
  4358. # Make file with all PC values with intervening 'sep_address' so
  4359. # that we can reliably detect the end of inlined function list
  4360. open(ADDRESSES, ">$main::tmpfile_sym") || error("$main::tmpfile_sym: $!\n");
  4361. if ($debug) { print("---- $image ---\n"); }
  4362. for (my $i = 0; $i <= $#{$pclist}; $i++) {
  4363. # addr2line always reads hex addresses, and does not need '0x' prefix.
  4364. if ($debug) { printf STDERR ("%s\n", $pclist->[$i]); }
  4365. printf ADDRESSES ("%s\n", AddressSub($pclist->[$i], $offset));
  4366. if (defined($sep_address)) {
  4367. printf ADDRESSES ("%s\n", $sep_address);
  4368. }
  4369. }
  4370. close(ADDRESSES);
  4371. if ($debug) {
  4372. print("----\n");
  4373. system("cat", $main::tmpfile_sym);
  4374. print("---- $cmd ---\n");
  4375. system("$cmd < " . ShellEscape($main::tmpfile_sym));
  4376. print("----\n");
  4377. }
  4378. open(SYMBOLS, "$cmd <" . ShellEscape($main::tmpfile_sym) . " |")
  4379. || error("$cmd: $!\n");
  4380. my $count = 0; # Index in pclist
  4381. while (<SYMBOLS>) {
  4382. # Read fullfunction and filelineinfo from next pair of lines
  4383. s/\r?\n$//g;
  4384. my $fullfunction = $_;
  4385. $_ = <SYMBOLS>;
  4386. s/\r?\n$//g;
  4387. my $filelinenum = $_;
  4388. if (defined($sep_address) && $fullfunction eq $sep_symbol) {
  4389. # Terminating marker for data for this address
  4390. $count++;
  4391. next;
  4392. }
  4393. $filelinenum =~ s|\\|/|g; # turn windows-style paths into unix-style paths
  4394. # Remove discriminator markers as this comes after the line number and
  4395. # confuses the rest of this script.
  4396. $filelinenum =~ s/ \(discriminator \d+\)$//;
  4397. # Convert unknown line numbers into line 0.
  4398. $filelinenum =~ s/:\?$/:0/;
  4399. my $pcstr = $pclist->[$count];
  4400. my $function = ShortFunctionName($fullfunction);
  4401. my $nms = $nm_symbols->{$pcstr};
  4402. if (defined($nms)) {
  4403. if ($fullfunction eq '??') {
  4404. # nm found a symbol for us.
  4405. $function = $nms->[0];
  4406. $fullfunction = $nms->[2];
  4407. } else {
  4408. # MapSymbolsWithNM tags each routine with its starting address,
  4409. # useful in case the image has multiple occurrences of this
  4410. # routine. (It uses a syntax that resembles template paramters,
  4411. # that are automatically stripped out by ShortFunctionName().)
  4412. # addr2line does not provide the same information. So we check
  4413. # if nm disambiguated our symbol, and if so take the annotated
  4414. # (nm) version of the routine-name. TODO(csilvers): this won't
  4415. # catch overloaded, inlined symbols, which nm doesn't see.
  4416. # Better would be to do a check similar to nm's, in this fn.
  4417. if ($nms->[2] =~ m/^\Q$function\E/) { # sanity check it's the right fn
  4418. $function = $nms->[0];
  4419. $fullfunction = $nms->[2];
  4420. }
  4421. }
  4422. }
  4423. # Prepend to accumulated symbols for pcstr
  4424. # (so that caller comes before callee)
  4425. my $sym = $symbols->{$pcstr};
  4426. if (!defined($sym)) {
  4427. $sym = [];
  4428. $symbols->{$pcstr} = $sym;
  4429. }
  4430. unshift(@{$sym}, $function, $filelinenum, $fullfunction);
  4431. if ($debug) { printf STDERR ("%s => [%s]\n", $pcstr, join(" ", @{$sym})); }
  4432. if (!defined($sep_address)) {
  4433. # Inlining is off, so this entry ends immediately
  4434. $count++;
  4435. }
  4436. }
  4437. close(SYMBOLS);
  4438. }
  4439. # Use nm to map the list of referenced PCs to symbols. Return true iff we
  4440. # are able to read procedure information via nm.
  4441. sub MapSymbolsWithNM {
  4442. my $image = shift;
  4443. my $offset = shift;
  4444. my $pclist = shift;
  4445. my $symbols = shift;
  4446. # Get nm output sorted by increasing address
  4447. my $symbol_table = GetProcedureBoundaries($image, ".");
  4448. if (!%{$symbol_table}) {
  4449. return 0;
  4450. }
  4451. # Start addresses are already the right length (8 or 16 hex digits).
  4452. my @names = sort { $symbol_table->{$a}->[0] cmp $symbol_table->{$b}->[0] }
  4453. keys(%{$symbol_table});
  4454. if ($#names < 0) {
  4455. # No symbols: just use addresses
  4456. foreach my $pc (@{$pclist}) {
  4457. my $pcstr = "0x" . $pc;
  4458. $symbols->{$pc} = [$pcstr, "?", $pcstr];
  4459. }
  4460. return 0;
  4461. }
  4462. # Sort addresses so we can do a join against nm output
  4463. my $index = 0;
  4464. my $fullname = $names[0];
  4465. my $name = ShortFunctionName($fullname);
  4466. foreach my $pc (sort { $a cmp $b } @{$pclist}) {
  4467. # Adjust for mapped offset
  4468. my $mpc = AddressSub($pc, $offset);
  4469. while (($index < $#names) && ($mpc ge $symbol_table->{$fullname}->[1])){
  4470. $index++;
  4471. $fullname = $names[$index];
  4472. $name = ShortFunctionName($fullname);
  4473. }
  4474. if ($mpc lt $symbol_table->{$fullname}->[1]) {
  4475. $symbols->{$pc} = [$name, "?", $fullname];
  4476. } else {
  4477. my $pcstr = "0x" . $pc;
  4478. $symbols->{$pc} = [$pcstr, "?", $pcstr];
  4479. }
  4480. }
  4481. return 1;
  4482. }
  4483. sub ShortFunctionName {
  4484. my $function = shift;
  4485. while ($function =~ s/\([^()]*\)(\s*const)?//g) { } # Argument types
  4486. $function =~ s/<[0-9a-f]*>$//g; # Remove Address
  4487. if (!$main::opt_no_strip_temp) {
  4488. while ($function =~ s/<[^<>]*>//g) { } # Remove template arguments
  4489. }
  4490. $function =~ s/^.*\s+(\w+::)/$1/; # Remove leading type
  4491. return $function;
  4492. }
  4493. # Trim overly long symbols found in disassembler output
  4494. sub CleanDisassembly {
  4495. my $d = shift;
  4496. while ($d =~ s/\([^()%]*\)(\s*const)?//g) { } # Argument types, not (%rax)
  4497. while ($d =~ s/(\w+)<[^<>]*>/$1/g) { } # Remove template arguments
  4498. return $d;
  4499. }
  4500. # Clean file name for display
  4501. sub CleanFileName {
  4502. my ($f) = @_;
  4503. $f =~ s|^/proc/self/cwd/||;
  4504. $f =~ s|^\./||;
  4505. return $f;
  4506. }
  4507. # Make address relative to section and clean up for display
  4508. sub UnparseAddress {
  4509. my ($offset, $address) = @_;
  4510. $address = AddressSub($address, $offset);
  4511. $address =~ s/^0x//;
  4512. $address =~ s/^0*//;
  4513. return $address;
  4514. }
  4515. ##### Miscellaneous #####
  4516. # Find the right versions of the above object tools to use. The
  4517. # argument is the program file being analyzed, and should be an ELF
  4518. # 32-bit or ELF 64-bit executable file. The location of the tools
  4519. # is determined by considering the following options in this order:
  4520. # 1) --tools option, if set
  4521. # 2) PPROF_TOOLS environment variable, if set
  4522. # 3) the environment
  4523. sub ConfigureObjTools {
  4524. my $prog_file = shift;
  4525. # Check for the existence of $prog_file because /usr/bin/file does not
  4526. # predictably return error status in prod.
  4527. (-e $prog_file) || error("$prog_file does not exist.\n");
  4528. my $file_type = undef;
  4529. if (-e "/usr/bin/file") {
  4530. # Follow symlinks (at least for systems where "file" supports that).
  4531. my $escaped_prog_file = ShellEscape($prog_file);
  4532. $file_type = `/usr/bin/file -L $escaped_prog_file 2>$dev_null ||
  4533. /usr/bin/file $escaped_prog_file`;
  4534. } elsif ($^O == "MSWin32") {
  4535. $file_type = "MS Windows";
  4536. } else {
  4537. print STDERR "WARNING: Can't determine the file type of $prog_file";
  4538. }
  4539. if ($file_type =~ /64-bit/) {
  4540. # Change $address_length to 16 if the program file is ELF 64-bit.
  4541. # We can't detect this from many (most?) heap or lock contention
  4542. # profiles, since the actual addresses referenced are generally in low
  4543. # memory even for 64-bit programs.
  4544. $address_length = 16;
  4545. }
  4546. if ($file_type =~ /MS Windows/) {
  4547. # For windows, we provide a version of nm and addr2line as part of
  4548. # the opensource release, which is capable of parsing
  4549. # Windows-style PDB executables. It should live in the path, or
  4550. # in the same directory as pprof.
  4551. $obj_tool_map{"nm_pdb"} = "nm-pdb";
  4552. $obj_tool_map{"addr2line_pdb"} = "addr2line-pdb";
  4553. }
  4554. if ($file_type =~ /Mach-O/) {
  4555. # OS X uses otool to examine Mach-O files, rather than objdump.
  4556. $obj_tool_map{"otool"} = "otool";
  4557. $obj_tool_map{"addr2line"} = "false"; # no addr2line
  4558. $obj_tool_map{"objdump"} = "false"; # no objdump
  4559. }
  4560. # Go fill in %obj_tool_map with the pathnames to use:
  4561. foreach my $tool (keys %obj_tool_map) {
  4562. $obj_tool_map{$tool} = ConfigureTool($obj_tool_map{$tool});
  4563. }
  4564. }
  4565. # Returns the path of a caller-specified object tool. If --tools or
  4566. # PPROF_TOOLS are specified, then returns the full path to the tool
  4567. # with that prefix. Otherwise, returns the path unmodified (which
  4568. # means we will look for it on PATH).
  4569. sub ConfigureTool {
  4570. my $tool = shift;
  4571. my $path;
  4572. # --tools (or $PPROF_TOOLS) is a comma separated list, where each
  4573. # item is either a) a pathname prefix, or b) a map of the form
  4574. # <tool>:<path>. First we look for an entry of type (b) for our
  4575. # tool. If one is found, we use it. Otherwise, we consider all the
  4576. # pathname prefixes in turn, until one yields an existing file. If
  4577. # none does, we use a default path.
  4578. my $tools = $main::opt_tools || $ENV{"PPROF_TOOLS"} || "";
  4579. if ($tools =~ m/(,|^)\Q$tool\E:([^,]*)/) {
  4580. $path = $2;
  4581. # TODO(csilvers): sanity-check that $path exists? Hard if it's relative.
  4582. } elsif ($tools ne '') {
  4583. foreach my $prefix (split(',', $tools)) {
  4584. next if ($prefix =~ /:/); # ignore "tool:fullpath" entries in the list
  4585. if (-x $prefix . $tool) {
  4586. $path = $prefix . $tool;
  4587. last;
  4588. }
  4589. }
  4590. if (!$path) {
  4591. error("No '$tool' found with prefix specified by " .
  4592. "--tools (or \$PPROF_TOOLS) '$tools'\n");
  4593. }
  4594. } else {
  4595. # ... otherwise use the version that exists in the same directory as
  4596. # pprof. If there's nothing there, use $PATH.
  4597. $0 =~ m,[^/]*$,; # this is everything after the last slash
  4598. my $dirname = $`; # this is everything up to and including the last slash
  4599. if (-x "$dirname$tool") {
  4600. $path = "$dirname$tool";
  4601. } else {
  4602. $path = $tool;
  4603. }
  4604. }
  4605. if ($main::opt_debug) { print STDERR "Using '$path' for '$tool'.\n"; }
  4606. return $path;
  4607. }
  4608. sub ShellEscape {
  4609. my @escaped_words = ();
  4610. foreach my $word (@_) {
  4611. my $escaped_word = $word;
  4612. if ($word =~ m![^a-zA-Z0-9/.,_=-]!) { # check for anything not in whitelist
  4613. $escaped_word =~ s/'/'\\''/;
  4614. $escaped_word = "'$escaped_word'";
  4615. }
  4616. push(@escaped_words, $escaped_word);
  4617. }
  4618. return join(" ", @escaped_words);
  4619. }
  4620. sub cleanup {
  4621. unlink($main::tmpfile_sym);
  4622. unlink(keys %main::tempnames);
  4623. # We leave any collected profiles in $HOME/pprof in case the user wants
  4624. # to look at them later. We print a message informing them of this.
  4625. if ((scalar(@main::profile_files) > 0) &&
  4626. defined($main::collected_profile)) {
  4627. if (scalar(@main::profile_files) == 1) {
  4628. print STDERR "Dynamically gathered profile is in $main::collected_profile\n";
  4629. }
  4630. print STDERR "If you want to investigate this profile further, you can do:\n";
  4631. print STDERR "\n";
  4632. print STDERR " $0 \\\n";
  4633. print STDERR " $main::prog \\\n";
  4634. print STDERR " $main::collected_profile\n";
  4635. print STDERR "\n";
  4636. }
  4637. }
  4638. sub sighandler {
  4639. cleanup();
  4640. exit(1);
  4641. }
  4642. sub error {
  4643. my $msg = shift;
  4644. print STDERR $msg;
  4645. cleanup();
  4646. exit(1);
  4647. }
  4648. # Run $nm_command and get all the resulting procedure boundaries whose
  4649. # names match "$regexp" and returns them in a hashtable mapping from
  4650. # procedure name to a two-element vector of [start address, end address]
  4651. sub GetProcedureBoundariesViaNm {
  4652. my $escaped_nm_command = shift; # shell-escaped
  4653. my $regexp = shift;
  4654. my $image = shift;
  4655. my $symbol_table = {};
  4656. open(NM, "$escaped_nm_command |") || error("$escaped_nm_command: $!\n");
  4657. my $last_start = "0";
  4658. my $routine = "";
  4659. while (<NM>) {
  4660. s/\r//g; # turn windows-looking lines into unix-looking lines
  4661. if (m/^\s*([0-9a-f]+) (.) (..*)/) {
  4662. my $start_val = $1;
  4663. my $type = $2;
  4664. my $this_routine = $3;
  4665. # It's possible for two symbols to share the same address, if
  4666. # one is a zero-length variable (like __start_google_malloc) or
  4667. # one symbol is a weak alias to another (like __libc_malloc).
  4668. # In such cases, we want to ignore all values except for the
  4669. # actual symbol, which in nm-speak has type "T". The logic
  4670. # below does this, though it's a bit tricky: what happens when
  4671. # we have a series of lines with the same address, is the first
  4672. # one gets queued up to be processed. However, it won't
  4673. # *actually* be processed until later, when we read a line with
  4674. # a different address. That means that as long as we're reading
  4675. # lines with the same address, we have a chance to replace that
  4676. # item in the queue, which we do whenever we see a 'T' entry --
  4677. # that is, a line with type 'T'. If we never see a 'T' entry,
  4678. # we'll just go ahead and process the first entry (which never
  4679. # got touched in the queue), and ignore the others.
  4680. if ($start_val eq $last_start && $type =~ /t/i) {
  4681. # We are the 'T' symbol at this address, replace previous symbol.
  4682. $routine = $this_routine;
  4683. next;
  4684. } elsif ($start_val eq $last_start) {
  4685. # We're not the 'T' symbol at this address, so ignore us.
  4686. next;
  4687. }
  4688. if ($this_routine eq $sep_symbol) {
  4689. $sep_address = HexExtend($start_val);
  4690. }
  4691. # Tag this routine with the starting address in case the image
  4692. # has multiple occurrences of this routine. We use a syntax
  4693. # that resembles template paramters that are automatically
  4694. # stripped out by ShortFunctionName()
  4695. $this_routine .= "<$start_val>";
  4696. if (defined($routine) && $routine =~ m/$regexp/) {
  4697. $symbol_table->{$routine} = [HexExtend($last_start),
  4698. HexExtend($start_val)];
  4699. }
  4700. $last_start = $start_val;
  4701. $routine = $this_routine;
  4702. } elsif (m/^Loaded image name: (.+)/) {
  4703. # The win32 nm workalike emits information about the binary it is using.
  4704. if ($main::opt_debug) { print STDERR "Using Image $1\n"; }
  4705. } elsif (m/^PDB file name: (.+)/) {
  4706. # The win32 nm workalike emits information about the pdb it is using.
  4707. if ($main::opt_debug) { print STDERR "Using PDB $1\n"; }
  4708. }
  4709. }
  4710. close(NM);
  4711. # Handle the last line in the nm output. Unfortunately, we don't know
  4712. # how big this last symbol is, because we don't know how big the file
  4713. # is. For now, we just give it a size of 0.
  4714. # TODO(csilvers): do better here.
  4715. if (defined($routine) && $routine =~ m/$regexp/) {
  4716. $symbol_table->{$routine} = [HexExtend($last_start),
  4717. HexExtend($last_start)];
  4718. }
  4719. # Verify if addr2line can find the $sep_symbol. If not, we use objdump
  4720. # to find the address for the $sep_symbol on code section which addr2line
  4721. # can find.
  4722. if (defined($sep_address)){
  4723. my $start_val = $sep_address;
  4724. my $addr2line = $obj_tool_map{"addr2line"};
  4725. my $cmd = ShellEscape($addr2line, "-f", "-C", "-e", $image, "-i");
  4726. open(FINI, "echo $start_val | $cmd |")
  4727. || error("echo $start_val | $cmd: $!\n");
  4728. $_ = <FINI>;
  4729. s/\r?\n$//g;
  4730. my $fini = $_;
  4731. close(FINI);
  4732. if ($fini ne $sep_symbol){
  4733. my $objdump = $obj_tool_map{"objdump"};
  4734. $cmd = ShellEscape($objdump, "-d", $image);
  4735. my $grep = ShellEscape("grep", $sep_symbol);
  4736. my $tail = ShellEscape("tail", "-n", "1");
  4737. open(FINI, "$cmd | $grep | $tail |")
  4738. || error("$cmd | $grep | $tail: $!\n");
  4739. s/\r//g; # turn windows-looking lines into unix-looking lines
  4740. my $data = <FINI>;
  4741. if (defined($data)){
  4742. ($start_val, $fini) = split(/ </,$data);
  4743. }
  4744. close(FINI);
  4745. }
  4746. $sep_address = HexExtend($start_val);
  4747. }
  4748. return $symbol_table;
  4749. }
  4750. # Gets the procedure boundaries for all routines in "$image" whose names
  4751. # match "$regexp" and returns them in a hashtable mapping from procedure
  4752. # name to a two-element vector of [start address, end address].
  4753. # Will return an empty map if nm is not installed or not working properly.
  4754. sub GetProcedureBoundaries {
  4755. my $image = shift;
  4756. my $regexp = shift;
  4757. # If $image doesn't start with /, then put ./ in front of it. This works
  4758. # around an obnoxious bug in our probing of nm -f behavior.
  4759. # "nm -f $image" is supposed to fail on GNU nm, but if:
  4760. #
  4761. # a. $image starts with [BbSsPp] (for example, bin/foo/bar), AND
  4762. # b. you have a.out in your current directory (a not uncommon occurrence)
  4763. #
  4764. # then "nm -f $image" succeeds because -f only looks at the first letter of
  4765. # the argument, which looks valid because it's [BbSsPp], and then since
  4766. # there's no image provided, it looks for a.out and finds it.
  4767. #
  4768. # This regex makes sure that $image starts with . or /, forcing the -f
  4769. # parsing to fail since . and / are not valid formats.
  4770. $image =~ s#^[^/]#./$&#;
  4771. # For libc libraries, the copy in /usr/lib/debug contains debugging symbols
  4772. my $debugging = DebuggingLibrary($image);
  4773. if ($debugging) {
  4774. $image = $debugging;
  4775. }
  4776. my $nm = $obj_tool_map{"nm"};
  4777. my $cppfilt = $obj_tool_map{"c++filt"};
  4778. # nm can fail for two reasons: 1) $image isn't a debug library; 2) nm
  4779. # binary doesn't support --demangle. In addition, for OS X we need
  4780. # to use the -f flag to get 'flat' nm output (otherwise we don't sort
  4781. # properly and get incorrect results). Unfortunately, GNU nm uses -f
  4782. # in an incompatible way. So first we test whether our nm supports
  4783. # --demangle and -f.
  4784. my $demangle_flag = "";
  4785. my $cppfilt_flag = "";
  4786. my $to_devnull = ">$dev_null 2>&1";
  4787. if (system(ShellEscape($nm, "--demangle", "image") . $to_devnull) == 0) {
  4788. # In this mode, we do "nm --demangle <foo>"
  4789. $demangle_flag = "--demangle";
  4790. $cppfilt_flag = "";
  4791. } elsif (system(ShellEscape($cppfilt, $image) . $to_devnull) == 0) {
  4792. # In this mode, we do "nm <foo> | c++filt"
  4793. $cppfilt_flag = " | " . ShellEscape($cppfilt);
  4794. };
  4795. my $flatten_flag = "";
  4796. if (system(ShellEscape($nm, "-f", $image) . $to_devnull) == 0) {
  4797. $flatten_flag = "-f";
  4798. }
  4799. # Finally, in the case $imagie isn't a debug library, we try again with
  4800. # -D to at least get *exported* symbols. If we can't use --demangle,
  4801. # we use c++filt instead, if it exists on this system.
  4802. my @nm_commands = (ShellEscape($nm, "-n", $flatten_flag, $demangle_flag,
  4803. $image) . " 2>$dev_null $cppfilt_flag",
  4804. ShellEscape($nm, "-D", "-n", $flatten_flag, $demangle_flag,
  4805. $image) . " 2>$dev_null $cppfilt_flag",
  4806. # 6nm is for Go binaries
  4807. ShellEscape("6nm", "$image") . " 2>$dev_null | sort",
  4808. );
  4809. # If the executable is an MS Windows PDB-format executable, we'll
  4810. # have set up obj_tool_map("nm_pdb"). In this case, we actually
  4811. # want to use both unix nm and windows-specific nm_pdb, since
  4812. # PDB-format executables can apparently include dwarf .o files.
  4813. if (exists $obj_tool_map{"nm_pdb"}) {
  4814. push(@nm_commands,
  4815. ShellEscape($obj_tool_map{"nm_pdb"}, "--demangle", $image)
  4816. . " 2>$dev_null");
  4817. }
  4818. foreach my $nm_command (@nm_commands) {
  4819. my $symbol_table = GetProcedureBoundariesViaNm($nm_command, $regexp, $image);
  4820. return $symbol_table if (%{$symbol_table});
  4821. }
  4822. my $symbol_table = {};
  4823. return $symbol_table;
  4824. }
  4825. # The test vectors for AddressAdd/Sub/Inc are 8-16-nibble hex strings.
  4826. # To make them more readable, we add underscores at interesting places.
  4827. # This routine removes the underscores, producing the canonical representation
  4828. # used by pprof to represent addresses, particularly in the tested routines.
  4829. sub CanonicalHex {
  4830. my $arg = shift;
  4831. return join '', (split '_',$arg);
  4832. }
  4833. # Unit test for AddressAdd:
  4834. sub AddressAddUnitTest {
  4835. my $test_data_8 = shift;
  4836. my $test_data_16 = shift;
  4837. my $error_count = 0;
  4838. my $fail_count = 0;
  4839. my $pass_count = 0;
  4840. # print STDERR "AddressAddUnitTest: ", 1+$#{$test_data_8}, " tests\n";
  4841. # First a few 8-nibble addresses. Note that this implementation uses
  4842. # plain old arithmetic, so a quick sanity check along with verifying what
  4843. # happens to overflow (we want it to wrap):
  4844. $address_length = 8;
  4845. foreach my $row (@{$test_data_8}) {
  4846. if ($main::opt_debug and $main::opt_test) { print STDERR "@{$row}\n"; }
  4847. my $sum = AddressAdd ($row->[0], $row->[1]);
  4848. if ($sum ne $row->[2]) {
  4849. printf STDERR "ERROR: %s != %s + %s = %s\n", $sum,
  4850. $row->[0], $row->[1], $row->[2];
  4851. ++$fail_count;
  4852. } else {
  4853. ++$pass_count;
  4854. }
  4855. }
  4856. printf STDERR "AddressAdd 32-bit tests: %d passes, %d failures\n",
  4857. $pass_count, $fail_count;
  4858. $error_count = $fail_count;
  4859. $fail_count = 0;
  4860. $pass_count = 0;
  4861. # Now 16-nibble addresses.
  4862. $address_length = 16;
  4863. foreach my $row (@{$test_data_16}) {
  4864. if ($main::opt_debug and $main::opt_test) { print STDERR "@{$row}\n"; }
  4865. my $sum = AddressAdd (CanonicalHex($row->[0]), CanonicalHex($row->[1]));
  4866. my $expected = join '', (split '_',$row->[2]);
  4867. if ($sum ne CanonicalHex($row->[2])) {
  4868. printf STDERR "ERROR: %s != %s + %s = %s\n", $sum,
  4869. $row->[0], $row->[1], $row->[2];
  4870. ++$fail_count;
  4871. } else {
  4872. ++$pass_count;
  4873. }
  4874. }
  4875. printf STDERR "AddressAdd 64-bit tests: %d passes, %d failures\n",
  4876. $pass_count, $fail_count;
  4877. $error_count += $fail_count;
  4878. return $error_count;
  4879. }
  4880. # Unit test for AddressSub:
  4881. sub AddressSubUnitTest {
  4882. my $test_data_8 = shift;
  4883. my $test_data_16 = shift;
  4884. my $error_count = 0;
  4885. my $fail_count = 0;
  4886. my $pass_count = 0;
  4887. # print STDERR "AddressSubUnitTest: ", 1+$#{$test_data_8}, " tests\n";
  4888. # First a few 8-nibble addresses. Note that this implementation uses
  4889. # plain old arithmetic, so a quick sanity check along with verifying what
  4890. # happens to overflow (we want it to wrap):
  4891. $address_length = 8;
  4892. foreach my $row (@{$test_data_8}) {
  4893. if ($main::opt_debug and $main::opt_test) { print STDERR "@{$row}\n"; }
  4894. my $sum = AddressSub ($row->[0], $row->[1]);
  4895. if ($sum ne $row->[3]) {
  4896. printf STDERR "ERROR: %s != %s - %s = %s\n", $sum,
  4897. $row->[0], $row->[1], $row->[3];
  4898. ++$fail_count;
  4899. } else {
  4900. ++$pass_count;
  4901. }
  4902. }
  4903. printf STDERR "AddressSub 32-bit tests: %d passes, %d failures\n",
  4904. $pass_count, $fail_count;
  4905. $error_count = $fail_count;
  4906. $fail_count = 0;
  4907. $pass_count = 0;
  4908. # Now 16-nibble addresses.
  4909. $address_length = 16;
  4910. foreach my $row (@{$test_data_16}) {
  4911. if ($main::opt_debug and $main::opt_test) { print STDERR "@{$row}\n"; }
  4912. my $sum = AddressSub (CanonicalHex($row->[0]), CanonicalHex($row->[1]));
  4913. if ($sum ne CanonicalHex($row->[3])) {
  4914. printf STDERR "ERROR: %s != %s - %s = %s\n", $sum,
  4915. $row->[0], $row->[1], $row->[3];
  4916. ++$fail_count;
  4917. } else {
  4918. ++$pass_count;
  4919. }
  4920. }
  4921. printf STDERR "AddressSub 64-bit tests: %d passes, %d failures\n",
  4922. $pass_count, $fail_count;
  4923. $error_count += $fail_count;
  4924. return $error_count;
  4925. }
  4926. # Unit test for AddressInc:
  4927. sub AddressIncUnitTest {
  4928. my $test_data_8 = shift;
  4929. my $test_data_16 = shift;
  4930. my $error_count = 0;
  4931. my $fail_count = 0;
  4932. my $pass_count = 0;
  4933. # print STDERR "AddressIncUnitTest: ", 1+$#{$test_data_8}, " tests\n";
  4934. # First a few 8-nibble addresses. Note that this implementation uses
  4935. # plain old arithmetic, so a quick sanity check along with verifying what
  4936. # happens to overflow (we want it to wrap):
  4937. $address_length = 8;
  4938. foreach my $row (@{$test_data_8}) {
  4939. if ($main::opt_debug and $main::opt_test) { print STDERR "@{$row}\n"; }
  4940. my $sum = AddressInc ($row->[0]);
  4941. if ($sum ne $row->[4]) {
  4942. printf STDERR "ERROR: %s != %s + 1 = %s\n", $sum,
  4943. $row->[0], $row->[4];
  4944. ++$fail_count;
  4945. } else {
  4946. ++$pass_count;
  4947. }
  4948. }
  4949. printf STDERR "AddressInc 32-bit tests: %d passes, %d failures\n",
  4950. $pass_count, $fail_count;
  4951. $error_count = $fail_count;
  4952. $fail_count = 0;
  4953. $pass_count = 0;
  4954. # Now 16-nibble addresses.
  4955. $address_length = 16;
  4956. foreach my $row (@{$test_data_16}) {
  4957. if ($main::opt_debug and $main::opt_test) { print STDERR "@{$row}\n"; }
  4958. my $sum = AddressInc (CanonicalHex($row->[0]));
  4959. if ($sum ne CanonicalHex($row->[4])) {
  4960. printf STDERR "ERROR: %s != %s + 1 = %s\n", $sum,
  4961. $row->[0], $row->[4];
  4962. ++$fail_count;
  4963. } else {
  4964. ++$pass_count;
  4965. }
  4966. }
  4967. printf STDERR "AddressInc 64-bit tests: %d passes, %d failures\n",
  4968. $pass_count, $fail_count;
  4969. $error_count += $fail_count;
  4970. return $error_count;
  4971. }
  4972. # Driver for unit tests.
  4973. # Currently just the address add/subtract/increment routines for 64-bit.
  4974. sub RunUnitTests {
  4975. my $error_count = 0;
  4976. # This is a list of tuples [a, b, a+b, a-b, a+1]
  4977. my $unit_test_data_8 = [
  4978. [qw(aaaaaaaa 50505050 fafafafa 5a5a5a5a aaaaaaab)],
  4979. [qw(50505050 aaaaaaaa fafafafa a5a5a5a6 50505051)],
  4980. [qw(ffffffff aaaaaaaa aaaaaaa9 55555555 00000000)],
  4981. [qw(00000001 ffffffff 00000000 00000002 00000002)],
  4982. [qw(00000001 fffffff0 fffffff1 00000011 00000002)],
  4983. ];
  4984. my $unit_test_data_16 = [
  4985. # The implementation handles data in 7-nibble chunks, so those are the
  4986. # interesting boundaries.
  4987. [qw(aaaaaaaa 50505050
  4988. 00_000000f_afafafa 00_0000005_a5a5a5a 00_000000a_aaaaaab)],
  4989. [qw(50505050 aaaaaaaa
  4990. 00_000000f_afafafa ff_ffffffa_5a5a5a6 00_0000005_0505051)],
  4991. [qw(ffffffff aaaaaaaa
  4992. 00_000001a_aaaaaa9 00_0000005_5555555 00_0000010_0000000)],
  4993. [qw(00000001 ffffffff
  4994. 00_0000010_0000000 ff_ffffff0_0000002 00_0000000_0000002)],
  4995. [qw(00000001 fffffff0
  4996. 00_000000f_ffffff1 ff_ffffff0_0000011 00_0000000_0000002)],
  4997. [qw(00_a00000a_aaaaaaa 50505050
  4998. 00_a00000f_afafafa 00_a000005_a5a5a5a 00_a00000a_aaaaaab)],
  4999. [qw(0f_fff0005_0505050 aaaaaaaa
  5000. 0f_fff000f_afafafa 0f_ffefffa_5a5a5a6 0f_fff0005_0505051)],
  5001. [qw(00_000000f_fffffff 01_800000a_aaaaaaa
  5002. 01_800001a_aaaaaa9 fe_8000005_5555555 00_0000010_0000000)],
  5003. [qw(00_0000000_0000001 ff_fffffff_fffffff
  5004. 00_0000000_0000000 00_0000000_0000002 00_0000000_0000002)],
  5005. [qw(00_0000000_0000001 ff_fffffff_ffffff0
  5006. ff_fffffff_ffffff1 00_0000000_0000011 00_0000000_0000002)],
  5007. ];
  5008. $error_count += AddressAddUnitTest($unit_test_data_8, $unit_test_data_16);
  5009. $error_count += AddressSubUnitTest($unit_test_data_8, $unit_test_data_16);
  5010. $error_count += AddressIncUnitTest($unit_test_data_8, $unit_test_data_16);
  5011. if ($error_count > 0) {
  5012. print STDERR $error_count, " errors: FAILED\n";
  5013. } else {
  5014. print STDERR "PASS\n";
  5015. }
  5016. exit ($error_count);
  5017. }