467 ]. |
467 ]. |
468 |
468 |
469 "Modified: / 04-07-2010 / 09:45:28 / cg" |
469 "Modified: / 04-07-2010 / 09:45:28 / cg" |
470 ! |
470 ! |
471 |
471 |
|
472 count:aContext leafsOnly:leafsOnly |
|
473 "entered whenever the probed block gets interrupted; |
|
474 look where it is, and remember in the calling tree or on the leaf-probe set" |
|
475 |
|
476 "{ Pragma: +optSpeed }" |
|
477 |
|
478 |chain| |
|
479 |
|
480 leafsOnly ifTrue:[ |
|
481 self countLeaf:aContext. |
|
482 ^ self. |
|
483 ]. |
|
484 |
|
485 chain := CallChain |
|
486 callChainTo:aContext |
|
487 stopAtCallerForWhich:[:con | |
|
488 (con receiver == self) and:[con selector == #execute] |
|
489 ]. |
|
490 |
|
491 "add chain to the tree" |
|
492 |
|
493 chain notNil ifTrue:[ |
|
494 ntally := ntally + 1. |
|
495 tree addChain:chain |
|
496 ]. |
|
497 |
|
498 "Created: / 28-05-2019 / 06:50:13 / Claus Gittinger" |
|
499 ! |
|
500 |
472 countLeaf:aContext |
501 countLeaf:aContext |
473 "entered whenever the probed block gets interrupted; |
502 "entered whenever the probed block gets interrupted; |
474 look where it is, and remember in the flat profile" |
503 look where it is, and remember in the flat profile" |
475 |
504 |
476 "{ Pragma: +optSpeed }" |
505 "{ Pragma: +optSpeed }" |
532 spyLeafOn:aBlock interval:ms |
561 spyLeafOn:aBlock interval:ms |
533 "spy on execution time; generate information on leaf nodes only |
562 "spy on execution time; generate information on leaf nodes only |
534 (which generates slightly less sampling overhead) |
563 (which generates slightly less sampling overhead) |
535 Return the value from aBlock." |
564 Return the value from aBlock." |
536 |
565 |
537 |probing delay probingProcess probedProcess retVal| |
566 ^ self spyOn:aBlock interval:ms leafsOnly:true |
538 |
567 |
539 theBlock := aBlock. |
568 "Created: / 20-03-1997 / 20:15:07 / cg" |
540 |
569 "Modified: / 22-03-1997 / 16:46:42 / cg" |
541 Processor activeProcess withPriority:(Processor userInterruptPriority-1) do:[ |
570 "Modified: / 28-05-2019 / 06:51:49 / Claus Gittinger" |
542 |
|
543 probingProcess := [ |
|
544 |p| |
|
545 |
|
546 p := probedProcess. |
|
547 [probing] whileTrue:[ |
|
548 delay wait. |
|
549 executing ifTrue:[ |
|
550 self countLeaf:p suspendedContext |
|
551 ] |
|
552 ]. |
|
553 ] newProcess. |
|
554 |
|
555 probingProcess priority:(Processor userInterruptPriority+1). |
|
556 |
|
557 delay := (Delay forMilliseconds:ms). |
|
558 ntally := 0. |
|
559 probes := Set new:200. |
|
560 |
|
561 probedProcess := Processor activeProcess. |
|
562 |
|
563 executing := false. |
|
564 probing := true. |
|
565 probingProcess resume. |
|
566 |
|
567 [ |
|
568 startTime := OperatingSystem getMillisecondTime. |
|
569 retVal := self execute. |
|
570 ] ensure:[ |
|
571 probing := executing := false. |
|
572 theBlock := nil. |
|
573 endTime := OperatingSystem getMillisecondTime. |
|
574 ]. |
|
575 ]. |
|
576 ^ retVal |
|
577 |
|
578 "Created: 20.3.1997 / 20:15:07 / cg" |
|
579 "Modified: 22.3.1997 / 16:46:42 / cg" |
|
580 ! |
571 ! |
581 |
572 |
582 spyOn:aBlock interval:ms |
573 spyOn:aBlock interval:ms |
583 "spy on execution time, generate a hierarchical call information on the output stream. |
574 "spy on execution time, generate a hierarchical call information on the output stream. |
584 Return the value from aBlock." |
575 Return the value from aBlock." |
585 |
576 |
586 |probing delay probingProcess probedProcess retVal runPrio probePrio| |
577 ^ self spyOn:aBlock interval:ms leafsOnly:false |
|
578 |
|
579 "Created: / 20-03-1997 / 20:14:44 / cg" |
|
580 "Modified: / 22-03-1997 / 16:45:42 / cg" |
|
581 "Modified: / 28-05-2019 / 06:52:00 / Claus Gittinger" |
|
582 ! |
|
583 |
|
584 spyOn:aBlock interval:ms leafsOnly:spyOnLeafsOnly |
|
585 "spy on execution time, wither generate a hierarchical call information, |
|
586 or leaf-node information. |
|
587 Return the value from aBlock." |
|
588 |
|
589 |retVal runPrio probePrio| |
587 |
590 |
588 theBlock := aBlock. |
591 theBlock := aBlock. |
589 runPrio := (Processor activePriority-1 "userInterruptPriority-1"). |
592 runPrio := (Processor activePriority-1 "userInterruptPriority-1"). |
590 probePrio := (Processor activePriority"+1" "Processor userInterruptPriority+1"). |
593 probePrio := (Processor activePriority"+1" "Processor userInterruptPriority+1"). |
591 |
594 |
592 Processor activeProcess |
595 Processor activeProcess |
593 withPriority:runPrio |
596 withPriority:runPrio |
594 do:[ |
597 do:[ |
595 |
598 |delay probing probingProcess probedProcess | |
|
599 |
|
600 delay := (Delay forMilliseconds:ms). |
|
601 |
596 probingProcess := [ |
602 probingProcess := [ |
597 |p| |
603 |p| |
598 |
604 |
599 p := probedProcess. |
605 p := probedProcess. |
600 [probing] whileTrue:[ |
606 [probing] whileTrue:[ |
601 delay wait. |
607 delay wait. |
602 executing ifTrue:[ |
608 executing ifTrue:[ |
603 self count:p suspendedContext |
609 self count:(p suspendedContext) leafsOnly:spyOnLeafsOnly |
604 ] |
610 ]. |
|
611 probedProcess isDead ifTrue:[probing := false]. |
605 ]. |
612 ]. |
606 ] newProcess. |
613 ] newProcess. |
607 |
614 |
608 probingProcess priority:probePrio. |
615 probingProcess priority:probePrio. |
609 |
616 |
610 delay := (Delay forMilliseconds:ms). |
|
611 ntally := 0. |
617 ntally := 0. |
612 |
618 |
613 tree := ProfileTree new. |
619 spyOnLeafsOnly ifTrue:[ |
614 tree |
620 probes := Set new:200. |
615 receiver:MessageTally |
621 ] ifFalse:[ |
616 selector:#execute |
622 tree := ProfileTree new. |
617 class:MessageTally |
623 tree |
618 isBlock:false. |
624 receiver:MessageTally |
619 |
625 selector:#execute |
|
626 class:MessageTally |
|
627 isBlock:false. |
|
628 ]. |
|
629 |
620 probedProcess := Processor activeProcess. |
630 probedProcess := Processor activeProcess. |
621 |
631 |
622 executing := false. |
632 executing := false. |
623 probing := true. |
633 probing := true. |
624 probingProcess resume. |
634 probingProcess resume. |