The Joy of DTrace

[DRAFT] Last updated by Joe Schaefer on Wed, 17 Apr 2024    source
 

Measure twice, cut once, before embarking on a code optimization effort.

Nothing makes measuring prod easier than DTrace.

Video sources

      alias perlfreq="dtrace -qZn 'sub-entry { @[strjoin(strjoin(copyinstr(arg3),\"::\"),copyinstr(arg0))] = count() } END {trunc(@, 10)}'"
      alias perlperf="dtrace -qFZn 'sub-entry { start[strjoin(strjoin(copyinstr(arg3),\"::\"),copyinstr(arg0))] = timestamp } sub-return { @[strjoin(strjoin(copyinstr(arg3),\"::\"),copyinstr(arg0))] = quantize((timestamp - start[strjoin(strjoin(copyinstr(arg3),\"::\"),copyinstr(arg0))])/1000); } END {trunc(@, 10)}'"
      alias perlop="dtrace -qZn 'sub-entry { self->fqn = strjoin(copyinstr(arg3), strjoin(\"::\", copyinstr(arg0))) } op-entry /self->fqn != \"\"/ { @[self->fqn] = count() } END { trunc(@, 3) }'"

Targeted optimization

Every $dtlv class-method-call below is done at compile time by :Sealed:


use Carp;
sub devar_var :Sealed {
        my Dotiac::DTL::Value $dtlv;
    my $name=shift;
        return $dtlv->safe(undef) unless defined $name;
    my $n=$name;
        my $param=shift;
    my $f=substr $name,0,1;
    my $l=substr $name,-1,1;
    my $escape=shift;
    #TODO
    confess $param unless ref $param;
    confess $escape unless defined $escape;
    #confess @_ unless @_;
    #TODO
        return $dtlv->safe(substr $name, 1, -1) if $f eq "'" and $l eq "'" or $f eq '"' and $l eq '"';
    return $dtlv->safe(descap(substr $name, 1, -1)) if $f eq "`" and $l eq "`";
    if ($name eq "block.super" and $param->{"block.super"}) {
        return $dtlv->safe($param->{"block.super"}->string($param,@_)) if Scalar::Util::blessed($param->{"block.super"});
        return $dtlv->safe($param->{"block.super"}->($param,@_)) if ref $param->{"block.super"} eq "CODE";
    }
    return $dtlv->new($param->{$name},!$escape) if exists $param->{$name};
    my @tree=split/\./,$name;
    $name=shift @tree;
    unless (exists $param->{$name}) {
        return $dtlv->safe($n) if $n!~/[^\d\-\.\,\e]/;
        if ($Dotiac::DTL::cycle{$name} and $Dotiac::DTL::cycle{$name}->[1]) {
            return $dtlv->safe("") if $Dotiac::DTL::included{"cycle_$name"}++;
            my $r=devar_raw($Dotiac::DTL::cycle{$name}->[2]->[$Dotiac::DTL::cycle{$name}->[0]-1 % $Dotiac::DTL::cycle{$name}->[1]],$param,$escape,@_);
            $Dotiac::DTL::included{"cycle_$name"}=0;
            return $r;
        }
        return $dtlv->safe(undef) ;
    }
    $param=$param->{$name};
    while (defined(my $name = shift @tree)) {
        my $r = reftype $param;
        if ($r) {
            if ($r eq "HASH") {
                if (not exists $param->{$name}) {
                    return $dtlv->safe(undef) unless blessed $param;
                }
                else {
                    $param=$param->{$name};
                    next;
                }
            }
            elsif ($r eq "ARRAY") {
                if ($name=~m/[^-\d]/) {
                    return $dtlv->safe(undef) unless blessed $param;
                }
                else {
                    if (not exists $param->[$name]) {
                        return $dtlv->safe(undef) unless blessed $param;
                    }
                    else {
                        $param=$param->[$name];
                        next;
                    }
                }
            }
        }
        if (blessed $param) {
            return $dtlv->safe(undef) unless $Dotiac::DTL::ALLOW_METHOD_CALLS;
            if ($param->can($name)) {
                $param=$param->$name();
                next;
            }
            elsif ($param->can("__getitem__")) {
                my $x;
                eval {
                    $x=$param->__getitem__($name);
                    1;
                } or return $dtlv->safe(undef);
                if (defined $x) {
                    $param=$x;
                    next;
                }
            }
            return $dtlv->safe(undef);
        }
        return $dtlv->safe($n) if $n!~/[^\d\-\.\,\e]/;
        return $dtlv->safe(undef);
    }
    return $dtlv->new($param,!$escape);
}