:Namespace profile ⎕IO←1 ⋄ ⎕ML←1 ⋄ ⎕WX←1 ⎕AVU[4]←13 ⍝ Until UNIX stops using 133 VERSION←'1.3.0' ⍝ Fixes issues listed in Mantis 9401: ⍝ 1) Reporting fails on machines which do not support ⎕WC ⍝ 2) -avg numbers sometimes out by 1000 ⍝ 3) File|Save crashes ⍝ 4) File|Open refused to open some valid files ⍝ 5) Changed threshold for switching to reporting seconds rather than ms from 10 to 100 seconds total time ⍝ 6) Various small corrections to some cases of output of the tree and data commands ⍝ --- UCMD Declarations --- ∇ r←List :Access Shared Public r←⎕NS¨1⍴⊂'' r.Name←,⊂'profile' r[1].Desc←'⎕PROFILE interface' r.Group←⊂'SysMon' ⍝ Parsing rules for each: r[1].Parse←'1S -expr= -timer= -pct= -avg -fn= -code -title= -bias= -exclusive -cumpct -outfile= -infile= -first= -decimal= -format=xml csv txt -separators= -var= -lines' ∇ ∇ r←Run(Cmd Args) :Access Shared Public :Select Cmd :Case 'profile' r←profile Args :EndSelect ∇ ∇ r←lev Help Cmd;nl :Access Shared Public :Select Cmd :Case 'profile' r←'This command has switches that only work with some of its arguments',nl←⎕UCS 13 r,←'Arguments: CALLS DASHBOARD DATA SUMMARY TREE',nl :If lev=0 ⋄ r,←'See ]??profile for details' :Else r,←nl,'There is a description of all the switches in the document titled',nl r,←'"Tuning Applications using the Profile User Command"',nl,nl r,←' ]PROFILE SUMMARY/CALLS/DATA',nl r,←'-expr= -infile= -bias= -title=',nl r,←'-var= -lines -decimal= -outfile= -format=txt xml csv',nl r,←'-pct= -avg -cumpct -first= -fn= -exclusive',nl,nl r,←' ]PROFILE SUMMARY/CALLS',nl r,←'-code',nl,nl r,←' ]PROFILE TREE',nl r,←'-expr= -infile= -bias= -title=',nl r,←'-var= -decimal= -outfile= -format=txt xml csv',nl,nl r,←' ]PROFILE /DASHBOARD',nl r,←'-expr= -infile= -bias= -title= -fn=',nl,nl r,←'Examples:',nl r,←' ⎕PROFILE ''start'' ⋄ RunMyProgram ⋄ ⎕PROFILE ''stop''',nl r,←' ]PROFILE',nl,nl r,←' ]profile summary -expr="Rain 93" -first=10',nl,nl r,←' ]profile calls -fn=#.ch.CH∆Q -first=5',nl,nl r,←' ]profile tree outfile=c:\temp\one.xml title="Testing"' :EndIf :EndSelect ∇ ⍝ --- main profile command handler --- ∇ treenames←treenames CombineNameLine tree ⍝ Combine name with lineno in [;3] treenames←treenames,¨{0≠⍴,⍵:'[',(⍕⍵),']' ⋄ ''}¨tree[;3] ⍝ tree[;3]←⊂⍬ ∇ ∇ tree←SeparateNameLine tree;p;names;z;i ⍝ Separate combined name and line in col[;1] p←(names←tree[;1])⍳¨'[' i←{⍵/⍳⍴⍵}(1⊃¨z←⎕VFI¨(p↓¨names)~¨']')∊⊂,1 ⍝ Exactly one number in there tree←names,(⊂⍬),0 1↓tree :If 0≠⍴i tree[i;1]←(p[i]-1)↑¨names[i] tree[i;2]←2 1∘⊃¨z[i] :EndIf ∇ ∇ (treenames tree r)←GetRootTree correctforbias;t;p;data;mode;b;title;n;nexec;depth;m;tn;facts;shape ⍝ Return root tree. Also set TITLE and bias. r←'' ⋄ tree←0 8⍴0 ⋄ treenames←0⍴⊂'' ⍝ All well :If 0≢args.infile :Trap 22 ⋄ t←⎕SE.UnicodeFile.ReadText args.infile :Else ⋄ r←'File not found: ',args.infile ⋄ →0 :EndTrap t←⎕XML t p←¯1+t[;2]⍳⊂'ProfileEntry' ⍝ Find first element data←p↓t ⋄ t←p↑t (title b mode)←t[t[;2]⍳'Title' 'TimerBias' 'Command';3] :If mode≢'tree' ⋄ r←'file does not contain data' ⋄ ∘ ⋄ →0 ⋄ :EndIf facts←'ProfileEntry' 'Depth' 'Element' 'Line' 'Calls' 'ExclusiveTime' 'InclusiveTime' ⍝ 'InclusiveTicks' 'ExclusiveTicks' :If ∧/facts∊(⍴facts)↑data[;2] n←⌈(1↑shape←⍴data)÷⍴facts data←(n,(⍴facts),¯1↑⍴data)⍴data :AndIf data[;;2]≡(n,⍴facts)⍴data[1;;2] data←shape⍴data[;facts⍳data[1;;2];] (TITLE bias)←title(getnum b) tree←(data[;1]=2)/data[;3] tree←(((1↑⍴tree)÷¯1+⍴facts),¯1+⍴facts)⍴tree tree[;1 3 4 5 6]←{0=⍴⍵:¯1 ⋄ ⊃getnum ⍵}¨tree[;1 3 4 5 6] treenames←∪tree[;2] ⋄ tree[;2]←treenames⍳tree[;2] :If args.bias≢0 ⋄ bias←⊃getnum args.bias ⋄ :EndIf ⍝ :If correctforbias ⋄ tree[;5 6]←tree[;5 6]-tree[;7 8]×bias ⋄ :EndIf ⍝ Bias correction :Else r←'Invalid XML format found in file ',args.infile :EndIf :Else :Trap 2 ⋄ treenames←⊃(,2)⎕PROFILE'tree' ⋄ :EndTrap :If 0=⎕NC'treenames' ⍝ No Dyadic ⎕PROFILE :If 0<1↑⍴tree←⎕PROFILE'tree' n←+/∧\0=tree[;4] ⍝ Leading uncompleted lines and functions :If n≠0 ⋄ n←2×⌊(1+tree[n;1])÷2 ⋄ :EndIf ⍝ Only drop COMPLETE pairs of function and line levels tree←(tree[;1]≥n)⌿tree ⍝ Drop these leading levels treenames←∪tree[;2] ⍝ Remove duplicate function names tree[;2]←treenames⍳tree[;2] ⍝ Point to fn names tree[(tree[;3]∊⊂⍬)/⍳1↑⍴tree;3]←¯1 ⍝ Entire Function represented as ¯1 to keep data simple tree[;1]-←⌊/tree[;1] ⍝ Make the lowest level = 0 tree[;4]←1⌈tree[;4] ⍝ Correct any 0 hit counts to 1 tree[;5 6]←⌊1000×tree[;5 6] ⍝ Round off to microseconds :If correctforbias ⋄ tree[;5 6]-←⌊tree[;7 8]×bias×1000 ⋄ :EndIf ⍝ Bias correction :EndIf :Else ⍝ Dyadic ⎕PROFILE is available :If 0<⍴treenames n←+/∧\0=nexec←⊃(,4)⎕PROFILE'tree' ⍝ Leading uncompleted lines and functions depth←⊃(,1)⎕PROFILE'tree' :If n≠0 ⋄ n←2×⌊(1+n⊃depth)÷2 ⍝ Only drop COMPLETE pairs of function and line levels m←depth≥n ⍝ Drop these leading levels :Else m←(⍴depth)⍴1 :EndIf tree←(6,+/m)⍴0 tree[1;]←{⍵-⌊/⍵}m/depth ⋄ depth←⍬ ⍝ Lowest level=0 tn←∪treenames tree[2;]←m/tn⍳treenames ⍝ de-duplicate tree[3;]←m/⊃(,3)⎕PROFILE'tree' tree[4;]←1⌈m/nexec ⋄ nexec←⍬ ⍝ Correct all 0 hitcounts to 1 tree[5;]←⌊1000×m/⊃(,5)⎕PROFILE'tree' ⍝ Round off to tree[6;]←⌊1000×m/⊃(,6)⎕PROFILE'tree' ⍝ ... microseconds :If correctforbias tree[5;]-←⌊(bias×1000)×m/⊃(,7)⎕PROFILE'tree' tree[6;]-←⌊(bias×1000)×m/⊃(,8)⎕PROFILE'tree' :EndIf ⍝ Bias correction treenames←tn tree←⍉tree :EndIf :EndIf :EndIf ∇ ∇ r←getnum rightarg r←2⊃⎕VFI rightarg ∇ ∇ r←NAMES GetCode LINES;i;t;codeline ⍝ Find source for LINES in functions r←(⍴NAMES)⍴⊂'(source not found)' :For i :In ⍳⍴NAMES :If (1+i⊃LINES)≤1↑⍴t←QCR i⊃NAMES codeline←t[1+i⊃LINES;] codeline←(~∧\' '=codeline)/codeline codeline←⌽(~∧\' '=⌽codeline)/⌽codeline (i⊃r)←codeline :EndIf :EndFor ∇ ∇ r←profile args;SU;timer;cmd;invalid;bad;qprofilestate;data;state;bias;sumdata;tottime;cumtime;exetime;posn;bin;fns;depths;old;piestart;nrrows;c;row;piesize;colors;ralign;decimal;first;checkswitches;mask;Screen;labelname;outputdata;Msg;m;TITLE;DECIMAL;DATA;TOTCPU;longestfnsnam;LINES;header;NAMES;SELCPU;msec;pct;calls;avg;facts;XMLTITLE;eis;fn;tree;FACTS;titlefacts;xmlfacts;origtree;drill;selected;fndata;linedata;seltime;filter;commands;switches;allow;i;outfile;tofile;t;colwidth;DEPTH;cumpct;units;format;CODE;timercost;granularity;nl;comma;dot;GUI;treenames;items Path←(⌽∨\(⌽'\'=⎕WSID))/⎕WSID SU←⎕SE.SALTUtils nl←⎕UCS 13 ⍝ /// Should be ⎕UCS 13 eis←{(,∘⊂∘,⍣(1=≡,⍵))⍵} ⍝ Enclose if simple invalid←{((0≢¨args.SwD[;2])/args.SwD[;1])~eis ⍵} ⍝ return any invalid switches checkswitches←{bad←invalid(eis ⍵),⊂'expr' ⋄ 0∊⍴bad:'' ⋄ 'invalid switch',(2×1=⍴bad)↓'es for "',⍺,'" command:',∊' ',¨bad} :If 0≢args.separators ⋄ (dot comma)←2↑args.separators ⋄ :Else ⋄ (dot comma)←'.,' ⋄ :EndIf CSVfmt←{0 2∊⍨10|⎕DR ⍵:'"',⍵,'"' ⋄ t←⍕⍵ ⋄ t[(t='.')/⍳⍴t]←dot ⋄ t} toCSV←{⊃,/{1↓⊃,/⍵}¨↓(comma,¨CSVfmt¨⍵),⊂⎕UCS 13 10} allow←{t←switches[i←commands⍳eis ⍺] ⋄ switches[i]←t,¨⊂eis ⍵} ⍝ ⎕PROFILE 'data' --> 'Name' 'Line' 'Executions' 'TimeExc' 'TimeInc' 'TicksExc' 'TicksInc' units←'msec' titlefacts←'Depth' 'Name' 'Line'units'%' '%(cum)' 'Calls' 'Avg' xmlfacts←'Depth' 'Element' 'Line' 'Time' 'PctOfTot' 'CumPct' 'Calls' 'AvgTime' titlefacts,←(units,'(inc)')(units,'(exc)')'ticks(inc)' 'ticks(exc)' xmlfacts,←'InclusiveTime' 'ExclusiveTime' 'InclusiveTicks' 'ExclusiveTicks' commands←'dashboard' 'summary' 'calls' 'data' 'tree' 'state' switches←(⍴commands)⍴⊂⍬ ⍝ -expr= -timer= -pct= -fn= -title= -bias= -exclusive -cumpct ⍝ -outfile= -infile= -first= -decimal= -format=xml csv txt -var= -lines 'dashboard' 'summary' 'calls' 'data' 'tree'allow'expr' 'infile' 'bias' 'title' 'summary' 'calls' 'data' 'tree'allow'var' 'decimal' 'lines' 'outfile' 'format' 'separators' 'tree'allow'var' 'decimal' 'outfile' 'format' 'separators' 'summary' 'calls' 'data'allow'pct' 'avg' 'cumpct' 'first' 'fn' 'exclusive' 'summary' 'calls'allow'code' 'dashboard'allow'fn' :If 0=⍴args.Arguments ⍝ If ]profile GUI←1 :Trap 0 'guicheck'⎕WC'Form'('Visible' 0)('Active' 0) font←1⊃'⎕SE'⎕WG'Font' ⎕EX'guicheck' :Else GUI←0 :EndTrap ⍝ default is dashboard(with GUI) or summary(non-GUI) :If GUI=1 ⋄ args.Arguments←,⊂'dashboard' :Else ⋄ args.Arguments←,⊂'summary' :EndIf :EndIf :If args.code≢0 ⋄ args.lines←args.code ⋄ :EndIf cmd←SU.lCase 1⊃args.Arguments :If (⍴commands) calls summary tree dashboard' →0 :EndSelect ∇ ∇ (OUTstate OUTbias OUTdecimal OUTfirst OUTfile OUTtitle OUTformat)←Initialise(INbias INdecimal INfirst INfile INtitle INformat);t :If INdecimal≡0 ⍝ If decimal switch is not defined OUTdecimal←1 ⍝ Assign default value :Else OUTdecimal←⊃getnum INdecimal ⍝ Assign userdefined value :EndIf :If INformat≡0 ⋄ OUTformat←'xml' ⍝ If format switch is not defined :Else ⋄ OUTformat←INformat ⋄ :EndIf :If INtitle≡0 ⍝ If first switch is not defined OUTtitle←((0≢Args.expr)/Args.expr,' '),,⎕SE.SALTUtils.fmtDate ⎕TS ⍝ Assign default value :Else OUTtitle←INtitle ⍝ Assign userdefined value :EndIf :If INfile≡0 ⍝ If file switch is not defined t←OUTtitle t[((t=' ')+(t=':')+(t='/'))/⍳⍴t]←'-' OUTfile←Path,t,'.',OUTformat ⍝ Assign default value :Else OUTfile←INfile ⍝ Assign userdefined value :EndIf :If INfirst≡0 ⍝ If first switch is not defined OUTfirst←20 ⍝ Assign default value :Else OUTfirst←⊃getnum INfirst ⍝ Assign userdefined value :EndIf OUTstate←1⊃⎕PROFILE'state' :If INbias≢0 ⍝ If bias switch has been defined by user OUTbias←⊃getnum INbias ⍝ Assign bias the userdefined value :Else OUTbias←3⊃⎕PROFILE'state' ⍝ If bias switch is not used, just return 'state' msg and bias from ⎕PROFILE 'state' :EndIf ∇ ∇ r←ProfileToXML(data facts title cmd tottime seltime);body;t;cols;rows;m;set;i (rows cols)←⍴data body←2,((rows×cols)⍴facts),[1.5],data m←((cols+1)×1↑⍴data)⍴(cols+1)↑1 body←(~m)⍀body body[m/⍳⍴m;]←((1↑⍴data),3)⍴1 'ProfileEntry' '' set←2,'Version' 'Title' 'TimerBias' 'Command' 'TotalTime' 'SelectedTime',[1.5]VERSION title(3⊃⎕PROFILE'state')cmd(⍕tottime)(⍕seltime) set←1 'ProfileSettings' ''⍪set t←0 'ProfileData' ''⍪set⍪body t[(t[;3]∊⊂⍬)/⍳1↑⍴t;3]←⊂'' r←⎕XML t ∇ ∇ r←ReportCalls fn;tree;ancestry;selected ⍝ Return data for ]profile calls -fn= tree←⎕PROFILE'tree' Filter(,⊂'↑',fn)⍬ tree[;2]←tree[;2],¨{0≠⍴,⍵:'[',(⍕⍵),']' ⋄ ''}¨tree[;3] tree[;3]←⊂⍬ tree←DBAggregate tree tree←(1⊃tree),2⊃tree r←tree[;1 2],¯9↑¨(args.decimal⌈1)⍕¨tree[;3] r←'Function[Line]' 'Calls' 'TotalTime'⍪r ∇ ∇ {r}←Filter(drill filter);levels;names;lines;l;t;indirect;line;fn;m;i;p;previous;fns ⍝ Filter the result of ⎕PROFILE 'tree' according to ⍝ drill: calling tree structure, e.g. '*foo' 'goo[7]' ⍝ leading * means call need not be direct ⍝ filter: list of functions [currently ignored] r←'' ⍝ OK ancestry←0 :If 0=⍴drill ⋄ selected←⍳1↑⍴tree :Else (levels fns lines)←↓[1]tree[;1 2 3] selected←⍳1↑⍴tree ⍝ track original lines previous←⍬ :For l :In ⍳⍴drill :If 0≠1↑0⍴t←l⊃drill :If ancestry←'↑'=1↑t p←(⌽m←(fns∊treenames⍳⊂1↓t)∧~2|levels)⊂⌽levels i←(p<⊃¨p)⍳¨1 ⍝ data for our fn i←1+(⌽+\⌽⊃∘⍴¨p)-i ⍝ row which called t :If 0=1↑⍴tree←tree[m/selected;] selected←⍬ r←'No data available with current filter' ⋄ →0 :EndIf tree[;1 2 3]←↑[0.5](⊂i)∘⌷¨levels fns lines ⍝ but register it under the lines which CALLED it tree←1,0 1↓tree[⍋tree[;2];] p←1,2≢/tree[;2] t←(0,(p/tree[;2]),[1.5]¯1),↑+⌿¨p⊂[1]0 3↓tree tree←{⍵[⍒⍵[;2];]}t⍪tree selected←⍳1↑⍴tree levels←tree[;1] m←(⍴selected)⍴1 :Else t←(indirect←'*'=1↑t)↓t ⍝ may call be indirect? fn←(¯1+p←t⍳'[')↑t ⍝ function name line←⊃(getnum ¯1↓p↓t),¯1 ⍝ line number (or empty) m←(fns∊treenames⍳⊂fn)∧(2|levels)=line≠¯1 ⍝ Select fn row or fn line rows :If line≠¯1 ⍝ Drilling down on an entire function m←m∧lines=line :EndIf :If ~indirect :If 0=⍴previous ⋄ m←m∧levels∊0 1 ⍝ Top-level calls :Else ∘ ⍝ Direct calls only - now wot? :EndIf :EndIf :EndIf previous←m/⍳⍴m ⍝ We'll may refer to these the next time round i←(levels Below previous)/⍳⍴selected (selected levels fns lines)←(⊂i)∘⌷¨selected levels fns lines :If 0=⍴selected ⋄ :Leave ⋄ :EndIf :EndIf :EndFor :EndIf ∇ ∇ r←tree Below nodes;m ⍝ Return a mask showing which nodes of a tree which are "below" the selected nodes ⍝ TODO: Convert to use pandscan... Following thanks to Brian: ⍝ n∆←{⍵ ⍺⍺ ¯1↓(⍺⍺/⍬),⍵} ⍝ pandscan←{~≠\(⍵≤⍺)\≠ n∆~(⍵≤⍺)/⍵} ⍝ pandscan2←{⍵{~≠\⍵\≠ n∆ ~⍵/⍺}⍵≤⍺} :If (,nodes)≡,⎕IO-1 ⋄ r←(⍴tree)⍴1 :Else m←(⍴tree)⍴0 ⋄ m[nodes]←1 r←((¯1+m⍳1)⍴0),∊1,¨∧\¨1↓¨(m⊂tree)>tree[nodes] :EndIf ∇ ∇ r←names DBAggregate tree;p;g;n;u;i ⍝ Aggregate tree data within names :If 0=1↑⍴tree r←⍬(0 4⍴0) :Else ⍝ ↓↓↓ This code a little obfuscated to avoid WS FULL g←((⍳⍴names)=names⍳names)/names g←⍋g⍳names tree←tree[g;] names←names[g] p←(2≢/names),1 ⍝ Ends of partitions names←p/names tree←+⍀tree tree←p⌿tree g←p←'' :For i :In ⍳2⊃⍴tree tree[;i]←tree[;i]-¯1↓0,tree[;i] :EndFor r←names tree :EndIf ∇ ∇ DBCallBack msg;event;fn;menuitem;object;mode;items;df;nos;data;t;pct;m;fm;h;line;index (object event fn menuitem)←4↑msg →((1↑fn)=¯1)⍴0 ⍝ Click in title row (mode items)←object.##.(DBMode DBItems) df←object.##.B ⍝ Details form (fn line)←{fn←(¯1+⍵⍳'[')↑⍵ ⋄ fn((⍴fn)↓⍵)}((1+⍴items)⌊⊃fn)⊃items,⊂'' →(0=⍴fn)⍴0 ⍝ Selected "other" :Select event :CaseList 'MouseDown' 'CellDown' ⍝ Click on a function or line ⍝ Should put function body into details :If '.T'≡¯2↑⍕object ⍝ In the top quadrant only :If 0=1↑⍴t←QCR fn df.(⎕EX ⎕NL 9) 'L1'df.⎕WC'Text' 'Function source not found'(10 10) :Else df.⎕EX'L1' :If 9≠⎕NC'df.CB1' ⍝ If the checkbox not already there 'df.CB1'⎕WC'Button' 'Lines not called'(5,¯100+2⊃df.Size)('Style' 'Check')('State' 0)('Event' 'Select' 'DBSelectZeros')('BCol' ¯16)topright 'df.CB2'⎕WC'Button' 'Blanks/Comments'(5,¯210+2⊃df.Size)('Style' 'Check')('State' 0)('Event' 'Select' 'DBSelectZeros')('BCol' ¯16)topright :EndIf 'df.L1'⎕WC'Label'('∇',fn)(5 10)topleft('Font'font 15 1 0 0 800)('BCol' ¯16) nos←'[',¨(⍕¨¯1+⍳1↑⍴t),¨']' m←(1⊃linedata)∊fn∘,¨nos data←(m/1⊃linedata),(m⌿2⊃linedata)[;(1+show),1] data←((⊂fn,'[0]'),((1⊃fndata)∊⊂fn)⌿(2⊃fndata)[;(1+show),1])⍪data data[1;2]←data[1;2]-+/1↓data[;2] ⍝ CPU unaccounted for data[;2]←data[;2]÷scale data←(data⍪0)[((⍴fn)↓¨data[;1])⍳nos;] pct←data[;2]÷+/data[;2] data←data[;2],(100×pct),data[;,3],↓t :If ~df.CB1.State ⍝ Compress out zero rows m←data[;3]≠0 data←m⌿data ⋄ nos←m/nos ⋄ pct←m/pct :EndIf :If ~df.CB2.State ⍝ Compress out blanks and comments m←~({⊃⍵~' '}¨data[;4])∊' ⍝' data←m⌿data ⋄ nos←m/nos ⋄ pct←m/pct :EndIf data[;4]←↓{(0,-+/∧\⌽' '∧.=⍵)↓⍵}↑data[;4] ⍝ Delete trailing blank columns df.DBFunction←fn index←(1⌈¯2+(0≠⍴line)×(nos⍳⊂line)),1 h←(1+ancestry)⊃'hits' 'calls' (df(30 10)(df.Size-40 20))DrawGrid data nos(units'%'h'code')(30×pct÷⌈/pct)('nothing' 'yet')'DBCallBack'(3 3 4 2)index :EndIf :EndIf :CaseList 'MouseDblClick' 'CellDblClick' ⍝ Double-Click = Drill Down →(ancestry∨1=⍴items)⍴0 ⍝ Disabled if we're doing ancestry or only one item drill,←⊂'*',fn →Update :Case 'Select' ⍝ Menu Item Select :Select ⊃menuitem+ancestry :Case 1 ⍝ Drill Down (not in ancestry mode) drill,←⊂'*',fn :Case 2 ⍝ Select as Root drill←,⊂'*',fn :Case 3 ⍝ View by Caller :If ancestry ⋄ (¯1↑drill)←⊂'↑',fn ⍝ Already in ancestry mode :Else ⋄ drill,←⊂'↑',fn ⋄ :EndIf :Case 4 ⍝ Reset drill←start :Case 5 ⍝ Up 1 drill←(1⌈¯1+⍴drill)↑drill :EndSelect Update: fm←df.##.##.## DBSelectData fm DBUpdate fm DBUpdateData fm :Else :EndSelect ∇ ∇ DBMenuCB msg;item;mb;object;event;sfs;size;poss;i;facts;r;MSG;z;dir;names (object event)←2↑msg item←{(1-(⌽⍵)⍳'.')↑⍵}object sfs←f.SF.(S L.S R.S) ⍝ Subforms size←⊂f.SF.Size poss←1 2⍴'fns'((0 1)(0.7 0)(0.7 0)×size) poss⍪←'fnd'((0 1)(0 0)(0 0)×size) poss⍪←'lines'((0 0)(0.7 0)(0.7 0)×size) poss⍪←'lnd'((0 0)(0 0)(0 0)×size) :If event≡'MouseDblClick' ⍝ Fake a Window menu selection? :If (1↑⍴poss)≥i←poss[;2]⍳⊂sfs.Posn ⍝ A known position? sfs.Posn←winrestore ⋄ DBUpdateData f ⋄ →0 :Else winrestore←sfs.Posn item←⊃poss['L.T' 'L.B' 'R.T' 'R.B'⍳⊂¯3↑object;1] :EndIf :EndIf :If (⊂event)∊'Configure' 'EndSplit' DBUpdateData f ⋄ →0 :EndIf :Select item :Case 'about' ⋄ 'mb'⎕WC'MsgBox' ']profile dashboard'('Version: ',VERSION)'Info' ⋄ ⎕DQ'mb' :Case 'open' ⍝ File|Open dir←(1-⌊/(⌽outfile)⍳'/\')↓outfile 'Browse'⎕WC'FileBox' 'Save As'dir'*.xml' ''('FileMode' 'Read')('Event' 'FileBoxOk' 1) →(0=⍴⎕DQ'Browse')⍴0 args.infile←Browse.(Directory,File) (treenames tree r)←GetRootTree 1 :If 0=⍴r InitTree r←'Profile data loaded from ',args.infile :EndIf 'Report'⎕WC'MsgBox' 'File Load'r ⎕DQ'Report' :Case 'save' ⍝ File|Save (not currently supported) dir←(1-⌊/(⌽outfile)⍳'/\')↓outfile 'Browse'⎕WC'FileBox' 'Save As'dir'*.xml'((⍴dir)↓outfile)('FileMode' 'Write')('Event' 'FileBoxOk' 1) →(0=⍴⎕DQ'Browse')⍴0 outfile←Browse.(Directory,File) facts←'Depth' 'Element' 'Line' 'Calls' 'InclusiveTime' 'ExclusiveTime' ⍝ 'InclusiveTicks' 'ExclusiveTicks' r←2⊃origtree ⋄ r[;2]←(1⊃origtree)[r[;2]] r←ProfileToXML(r facts TITLE'tree'tottime seltime) ⎕SE.UnicodeFile.Write outfile r r←'Data written to: ',outfile 'Report'⎕WC'MsgBox' 'Save successful'r ⎕DQ'Report' :Case 'reset' ⍝ File|Reset drill←start DBSelectData f DBUpdate f DBUpdateData f :Case 'winrst' ⋄ ⍝ Windows|Reset sfs.Posn←(0 0.5)(0.7 0)(0.7 0)×⊂f.SF.Size ⋄ DBUpdateData f :CaseList poss[;1] ⍝ Maximise a window winrestore←sfs.Posn sfs.Posn←⊃poss[poss[;1]⍳⊂item;2] DBUpdateData f :Case 'exit' ⎕EX'f' :EndSelect ∇ ∇ DBMakeMenu f;e e←'Event'('Select' 'DBMenuCB') 'f.mb'⎕WC'MenuBar' 'f.mb.file'⎕WC'Menu' '&File' 'f.mb.file.open'⎕WC'MenuItem' '&Open'e 'f.mb.file.save'⎕WC'MenuItem' '&Save'e 'f.mb.file.savas'⎕WC'MenuItem' 'Save &As'e 'f.mb.file.reset'⎕WC'MenuItem' '&Reset'e 'f.mb.file.exit'⎕WC'MenuItem' '&Exit'e 'f.mb.win'⎕WC'Menu' '&Windows' 'f.mb.win.winrst'⎕WC'MenuItem' '&Reset'e 'f.mb.win.fns'⎕WC'MenuItem' '&Functions'e 'f.mb.win.fnd'⎕WC'MenuItem' 'Function &Details'e 'f.mb.win.lines'⎕WC'MenuItem' '&Lines'e 'f.mb.win.lnd'⎕WC'MenuItem' 'Line D&etails'e 'f.mb.help'⎕WC'Menu' '&Help' 'f.mb.help.about'⎕WC'MenuItem' '&About'e ∇ ∇ f←DBMake(posn size);scol;sf;bottom;top;height;width;edge;sz;e (height width)←size scol←¯16 top bottom←60 0 'f'⎕WC'Form'(']profile DashBoard: ',TITLE)posn size('Coord' 'Pixel')('Event' 'Configure' 'DBMenuCB')('Font' 'Arial' 14)('Moveable' 1)('Sizeable' 1) DBMakeMenu f 'f.tip'⎕WC'TipField' f.TipObj←f.tip 'f.l1'⎕WC'Label' 'Showing:'(33,width-215)(⍬ 120)('Justify' 'Right')topright 'f.show'⎕WC'Combo'showopts''(33,width-90)(⍬ 80)('SelItems'((⍴showopts)↑1))topright('Event' 'Select' 'DBSelectOptions') 'f.l2'⎕WC'Label' 'Pcts of:'(10,width-215)(⍬ 120)('Justify' 'Right')topright 'f.pcts'⎕WC'Combo'('Total' 'Selection')'All'(11,width-90)(⍬ 80)('SelItems'(1 0))topright('Event' 'Select' 'DBSelectOptions') 'f.calltree'⎕WC'Static'(5 0)(70(width-200))('Attach' 'Top' 'Left' 'Top' 'Right')('BCol' ¯16)('Border' 0)('Font'font 14) sf←'SubForm'('BCol' ¯16)('EdgeStyle' 'Recess')('Border' 1)('Event'('MouseDblClick' 'DBMenuCB')) 'f.SF'⎕WC'SubForm' ''(top 2)(sz←size-(top+bottom)4)botright 'f.SF.L'⎕WC'SubForm' 'f.SF.R'⎕WC'SubForm' 'f.SF.S'⎕WC'Splitter' 'f.SF.L' 'f.SF.R'(⌈sz×0 0.6)(⍬ 3)'Vert'('BCol'scol)('Event' 'EndSplit' 'DBMenuCB') 'f.SF.L.T'⎕WC sf 'f.SF.L.B'⎕WC sf 'f.SF.L.S'⎕WC'Splitter' 'f.SF.L.T' 'f.SF.L.B'(⌈sz×0.7 0)(3 ⍬)'Horz'('BCol'scol)('Event' 'EndSplit' 'DBMenuCB') 'f.SF.R.T'⎕WC sf 'f.SF.R.B'⎕WC sf 'f.SF.R.S'⎕WC'Splitter' 'f.SF.R.T' 'f.SF.R.B'(⌈sz×0.7 0)(3 ⍬)'Horz'('BCol'scol)('Event' 'EndSplit' 'DBMenuCB') winrestore←f.SF.(S L.S R.S).Posn ∇ ∇ DBSelectBreadCrumb msg;object;n ⍝ Clicked on a breadcrumb object←1⊃msg n←{1⊃getnum(⍵∊⎕D)/⍵}object drill←n↑drill DBSelectData f DBUpdate f DBUpdateData f ∇ ∇ {r}←DBSelectData f;m;g;z ⍝ Process new selection - create semi-globals: ⍝ selected: indices into rows of tree ⍝ data: selected rows of tree ⍝ fndata: data aggregated by function ⍝ linedata: data aggregated by distinct line of code ⍝ tottime: total msecs for all ⎕profile data ⍝ seltime: msecs consumed by selected items ⍝ units: 'sec' or, if total time less than 100 secs 'msec' ⍝ scale: scale factor, corresponding to units (treenames tree)←origtree r←Filter drill filter ⍝ Apply selections and filters :If 0≠1↑⍴data←tree[selected;] ⍝ Try to avoid WS FULL on very large data g←⍋z←data[;2 3] ⍝ Function Index and Line Number m←∨/z≠¯1⊖z←z[g;] ⋄ m[1]←1 ⍝ Distinct items z←m⌿z z←treenames[z[;1]]{¯1≠⍵:⍺,'[',(⍕⍵),']' ⋄ ⍺}¨z[;2] datanames←(⍴g)⍴⊂'' ⋄ datanames[g]←z[+\m] :Else datanames←0⍴⊂'' :EndIf m←2|data[;1] ⍝ data pertaining to lines? data←data[;4 5 6] linedata←(m/datanames)DBAggregate m⌿data ⍝ rows pertaining to lines fndata←((~m)/datanames)DBAggregate(~m)⌿data ⍝ rows pertaining to functions seltime←tottime←+/0,(tree[;1]=0)⌿tree[;6] ⍝ Root level inclusive :If (⍴selected)≠1↑⍴tree seltime←+/(2⊃linedata)[;2] ⍝ Total exclusive time :EndIf :If ancestry tottime←+/{(⍵[;1]=0)/⍵[;6]}2⊃origtree :EndIf units←'sec' ⋄ scale←1000000 :If tottime<100000000 ⋄ scale←1000 ⋄ units←'msec' ⋄ :EndIf ∇ ∇ DBSelectOptions msg;object ⍝ Change to selection of Percentages :Select ¯5↑object←1⊃msg :Case '.pcts' pcttot←(⊃object ⎕WG'SelItems') :Case '.show' show←(object ⎕WG'SelItems')⍳1 :EndSelect DBUpdate f DBUpdateData f ∇ ∇ DBSelectPie msg;object;i ⍝ Select Pie or Table object←1⊃msg i←'LR'⍳(1+2⍳⍨+\object='.')⊃object pies[i]←'Pie'≡object ⎕WG'Text' DBUpdateData f ∇ ∇ DBSelectZeros msg;object;df;items ⍝ Call DBCallBack again to redraw selection object←⊃msg df←(⍎object).## items←df.##.DBItems DBCallBack df'MouseDown'(items⍳⊂df.DBFunction)'' ∇ ∇ DBUpdate f;d;indirect;i;sz;t;hpos;vpos;ct;newlineq;crumbcols;crumbcol ⍝ drill: drill-down stack ⍝ ancestry: number of levels to look UP the stack ⍝ pcttot: 1 if percentages should be of total, 0 for selection ⍝ show: 1=Calls, 2=Exclusive, 3=Inclusive, 4=avg time f.show.Text←show⊃showopts f.pcts.Text←(1+pcttot)⊃'Selection' 'All' crumbcols←(200 255 200)(255 200 200)(200 200 255) ct←f.calltree ct.(⎕EX ⎕NL 9) ⍝ Clear call tree (vpos hpos)←5 5 newlineq←{(2⊃ct.Size)¯36+1↑Size) ⍝ Scrollbar required ref.drawngrid.Index←Index :EndIf nrrows←⍳1⊃⍴DataMat Heights←ref.drawngrid.CellHeights Startheight←0 WidestBar←⌈/bardata :For row :In nrrows Points←(Startheight+0.08×Heights[row]),0,(0.8×Heights[row]),(bardata[row]) rectname←((⍕ref.drawngrid),'.r',⍕row) rectname ⎕WC'Rect'(Points[1 2])(Points[3 4])('FCol' 0 0 255)('FillCol' 0 255 0)('BCol' 255 0 0)('FStyle' 0) Startheight←Startheight+Heights[row] :EndFor {ref.drawngrid.SetColSize ⍵ ¯3}¨0,1+⍳¯2+⍴ColTitles ref.drawngrid.CellWidths[1,⍴ColTitles]←(⌈WidestBar×1.2)0 ref.drawngrid.CurCell←Items,⍴ColTitles ref.drawngrid.Input.SelText←⊂0 0 ∇ ∇ r←leftarg DrawPie(DataMat MenuItems Callback Piestart);ref;pos;diameter;piestart;nrrows;time_pct;colors;row;piesize;piename;polyname;polystart;polyend;labelsize;labeladjust;pull;polylength;staticname;textname;sizematrix;staticarea;i;polydirection;refsize;posdiffstart;stuck;fontsize;bigstuck;quadrant ref pos diameter←leftarg nrrows←⍳1⊃⍴DataMat time_pct←DataMat[;2]÷+/DataMat[;2] colors←(0 255 255)(255 69 0)(50 205 50)(95 158 160)(219 112 147)(60 179 113) colors,←(100 149 237)(188 143 143)(255 255 0)(30 144 255)(205 133 63)(128 255 128) colors,←(32 178 170)(250 128 114)(128 255 250) ⍝ colors←(255 245 238)(255 239 213)(245 255 250)(255 250 205)(255 250 240) ⍝ colors←(55 155 0)(155 55 0)(0 55 155)(0 155 55)(55 0 155)(155 0 55)(55 155 255)(155 55 25)(25 55 155)(25 155 55)(55 25 155)(155 25 55) refsize←ref ⎕WG'Size' fontsize←(+/1,(1⊃refsize)>400 600 800)⊃(12 14 16 20) ⍝ 'sf'ref.⎕WC'Subform' ''(0 0)refsize('Attach'('Top' 'Left' 'Top' 'Left'))('Font'(font fontsize)) ⍝ ref←ref.sf bigstuck←0 quadrant←⌈4×(0.5×time_pct)++\¯1↓0,time_pct Start: ref.⎕EX,'cspl'(∘.,)⍕¨⍳11 bigstuck+←1 ⋄ :If bigstuck>5 ⋄ 'ref.p1'⎕WC'Text' 'Insufficient space to draw pie'pos('HAlign' 1) ⋄ →0 ⋄ :EndIf sizematrix←1 4⍴1000000 1000000 0 0 piestart←Piestart :For row :In nrrows stuck←0 polylength←1 polydirection←0.5 piesize←(○2)×row⊃time_pct piename←('c',⍕row) staticname←('s',⍕row) textname←('s',(⍕row),'.t') polyname←('p',⍕row) ('ref.',piename)⎕WC'circle'(⌈(¯1 1×DataMat[row;4]×1 2○piestart+0.5×piesize)+pos)diameter(colors[1+(⍴colors)|row])(0 0 0)piestart(piestart+piesize)2('FStyle' 0)('Coord' 'Pixel')('Event' 'MouseDblClick' 'PieMouse'(Callback MenuItems ref pos row))('Event' 'MouseDown' 'PieMouse'(Callback MenuItems ref pos row)) ('ref.l',,1↓piename)⎕WC'circle'(⌈(¯1 1×DataMat[row;4]×1 2○piestart+0.5×piesize)+pos)(diameter)(0 0 0)(0 0 0)piestart(piestart+piesize)2('FStyle' ¯1)('Coord' 'Pixel')('LStyle' 0)('LWidth' 1) polystart←((¯1 1×(DataMat[row;4]+diameter×0.95)×1 2○(piestart+0.5×piesize))+pos) Draw: stuck+←1 :If stuck>30 ⋄ diameter×←0.9 ⋄ →Start ⋄ :EndIf polyend←((¯1 1×(DataMat[row;4]+diameter×1+(polylength×0.15))×1 2○(piestart+polydirection×piesize))+pos) ('ref.',polyname)⎕WC'poly'((1⊃¨polystart polyend)(2⊃¨polystart polyend))('Coord' 'Pixel')('FCol'(⊃colors[1+(⍴colors)|row]))('BCol'(0 0 0))('LWidth' 2) ('ref.',staticname)⎕WC'label'(⊃DataMat[row;1])('Font'(font fontsize)) labelsize←¯5 ¯2+('ref.',staticname)⎕WG'Size' ('ref.',staticname)⎕WC'static'polyend labelsize('Border' 1)('Tip'(⊃DataMat[row;3]))('BCol'(⊃colors[1+(⍴colors)|row]))('FCol'(0 0 0)) labeladjust←(1++/(piestart+0.5×piesize)>(○0.5 1 1.5))⊃(¯1 0)(¯1 ¯1)(0 ¯1)(0 0) ('ref.',staticname)⎕WS('posn'(polyend+labeladjust×labelsize))('Event' 'MouseDblClick' 'PieMouse'(Callback MenuItems ref pos row))('Event' 'MouseDown' 'PieMouse'(Callback MenuItems ref pos row)) ('ref.',textname)⎕WC'text'(⊃DataMat[row;1])(1 3)('Font'(font fontsize)) :For i :In (⌽⍳row) staticarea←(staticname ref.⎕WG'Posn'),(staticname ref.⎕WG'Size') posdiffstart←|sizematrix[i;1 2]-staticarea[1 2] :If (1<+/(2 2+sizematrix[i;3 4]⌈staticarea[3 4])≥posdiffstart) ⍝ If collision with other label? polylength+←0.25 ⍝ Move away from circle →Draw :EndIf ⍝:If (0<+/refsize<2 2+staticarea[1 2]+staticarea[3 4])∨(0<+/2>staticarea[1 2])∨(0<+/2>staticarea[1 2]+staticarea[3 4]) ⍝ If outside subform ⍝ polylength←1 ⍝ polydirection←¯1+3|1+polydirection+0.75 ⍝ →Draw ⍝:EndIf stuck←0 :EndFor staticarea←(staticname ref.⎕WG'Posn'),(staticname ref.⎕WG'Size') sizematrix⍪←staticarea piestart+←piesize :EndFor ∇ ∇ data DrawPieOrGrid(sf pie dbmode);pct;menuitems;t;total;disp;tit;h;minslice;names;g ⍝ Draw a Pie or a Grid (names data)←data sf.(⎕EX ⎕NL 9) :If 0∊⍴data 'sf.title'⎕WC'Text' '(No Data)'(15,0.5×2⊃sf.Size)('HAlign' 1)('Font' 'Arial' 22) →0 :EndIf data[;2 3]÷←scale total←((1+pcttot)⊃seltime tottime)÷scale :If ancestry ⋄ menuitems←'Make Root' 'Show Calls' 'Reset',(1<⍴drill)/⊂'Up 1 level' :Else ⋄ menuitems←'Drill Down' 'Make Root' 'Show Calls' 'Reset',(1<⍴drill)/⊂'Up 1 level' :EndIf :If pie data←data[;2 1] ⍝ Exclusive time, Calls data←data[g←⍒data[;1];] ⍝ Sort by descending exclusive time names←names[g] minslice←0.01×(1++/300 450 700<1⊃sf.Size)⊃5 2 1.5 1 ⍝ Minimun pie slice size disp←(data[;1]÷seltime÷scale)>minslice :If (+/disp)<(⍴disp)-5 ⍝ More than 5 pies too small to show? data←(disp⌿data)⍪+⌿(~disp)⌿data names←(disp/names),⊂'[',(⍕+/~disp),' others]' data←data[g←⍒data[;1];] names←names[g] :EndIf data[;2]←{(⍕⍵[2]),' calls -',(1⍕100×⍵[1]÷total),'%'}¨↓data ⍝ [;3] Tips data←names,data,0 ⍝ [;4] How far to pull segments out :If ~ancestry ⋄ 'sf.title'⎕WC'Text' 'Exclusive Time'(15,0.5×2⊃sf.Size)('HAlign' 1)('Font' 'Arial' 22) ⋄ :EndIf (sf(0.5 0.425×sf.Size)(0.25×1⊃sf.Size))DrawPie data menuitems'DBCallBack'(○÷4) :Else ⍝ Table data←data[;(2/1+show),1 1] data←data[g←⍒data[;1];] names←names[g] data[;2]←100×data[;2]÷total ⍝ % :If ~∧/disp←data[;2]>0.5 ⍝ Some rows too small to show data←(disp⌿data)⍪+⌿(~disp)⌿data names←(disp/names),⊂'[',(⍕+/~disp),' others]' :EndIf data[;4]←data[;2]÷data[;3] ⍝ avg :If ~ancestry tit←'Showing ',(show⊃showopts),' time',((~pcttot)∧seltime≠tottime)/' (% of selection)' 'sf.title'⎕WC'Text'tit(15,0.5×2⊃sf.Size)('HAlign' 1)('Font' 'Arial' 18) :EndIf h←(1+ancestry)⊃'hits' 'calls' (sf(50 10)(0⌈sf.Size-50 20))DrawGrid data names(units'%'h'avg')(30×data[;2]÷⌈/data[;2])menuitems'DBCallBack'(3 3 4 3)(1 1) :EndIf 'sf.LMode'⎕WC'Label'dbmode(10 10)('Font' 'Arial' 22)('BCol'sf.BCol)topright t←'Table' 'Pie' ⋄ 'sf.LDisplay'⎕WC'Combo't((1+pie)⊃t)(10,¯65+2⊃sf.Size)(⍬ 55)('SelItems'(pie=0 1))('Event' 'Select' 'DBSelectPie')topright sf.##.DBMode←dbmode sf.##.DBItems←names ⍝ Center in middle, radius 30% of height ∇ ∇ GridFocus EventMsg;ref ref←⍎1⊃EventMsg ref.SelText←(0 0) ∇ ∇ z←leftarg GridMouse right;obj;event;mouseY;button;shift;cellrow;cellcol;titleindex;mouseX;ref;menuitems;callback;menu;items_amt;item;selected callback menuitems ref←leftarg obj event mouseY mouseX button shift cellrow cellcol titleindex←right :Select event :Case 'CellDblClick' z←ref event(cellrow cellcol)¯1 :Case 'CellDown' :Select button :Case 1 z←ref event(cellrow cellcol)¯1 :Case 2 →(0=⍴menuitems)⍴0 menu←(⍕ref),'.menu' menu ⎕WC'Menu' 'Menu'('Coord' 'Pixel') items_amt←⍳⍴menuitems :For item :In items_amt (menu,'.mi',⍕item)⎕WC'MenuItem'(item⊃menuitems)('Event' 'Select' 1)('Data'item) :EndFor selected←⎕DQ menu :If 0≠⍴selected item←⍎(1⊃selected),'.Data' z←ref'Select'(cellrow cellcol)item :Else ⍝ ref.drawngrid.Input.SelText←(⍴ref.drawngrid.Input)⍴⊂(0 0) →0 :EndIf :EndSelect :EndSelect (⍎callback)z ∇ ∇ leftarg PieMouse EventMsg;menuitems;callback;ref;items_amt;item;pos;labelposn;label;menu;z;button;shift;mouseX;mouseY;event;obj;selected;segment callback menuitems ref pos segment←leftarg obj event mouseY mouseX button shift←EventMsg :Select button :Case 1 z←ref event segment ¯1 :Case 2 →(0=⍴menuitems)⍴0 menu←(⍕ref),'.menu' menu ⎕WC'Menu' 'Menu'('Coord' 'Pixel') items_amt←⍳⍴menuitems :For item :In items_amt (menu,'.mi',⍕item)⎕WC'MenuItem'(item⊃menuitems)('Event' 'Select' 1)('Data'item) :EndFor selected←⎕DQ menu :If 0≠⍴selected item←⍎(1⊃selected),'.Data' z←ref'Select'segment item :Else →0 :EndIf :EndSelect (⍎callback)z ∇ ∇ r←QCR name;classname;ct ⍝ Get the ⎕CR of a function, even if it is in a class :If 0∊⍴r←⎕CR name ⍝ Didn't get anything? :AndIf 0∊⍴r←{11::⍬ ⋄ 180⌶⍵}name :If 9.4=⎕NC⊂classname←(-(⌽name)⍳'.')↓name :Trap 0 :If 0=⎕NC'callingTree' ⋄ ⎕SE.SALT.Load'tools\code\callingTree' ⋄ :EndIf r←↑(⎕NEW callingTree(⍎classname)).QNR(1+⍴classname)↓name :Else ⍝ Anything wrong in callingTree => no source available r←0 0⍴' ' :EndTrap :EndIf :EndIf ∇ ∇ (posn size)←ScreenProps;⎕USING;wa :Trap 0 ⎕USING←'System.Windows.Forms,System.Windows.Forms.dll' wa←Screen.PrimaryScreen.WorkingArea posn←wa.Location.(X Y)+0,SystemInformation.FrameBorderSize.Width size←wa.(Height Width)-SystemInformation.(FrameBorderSize.(2×Width Height)+2↑CaptionHeight+MenuHeight) :Else posn←20 10 size←1⊃'.'⎕WG'DevCaps' :EndTrap size←size⌊800 1200 ∇ :EndNamespace