La joie de DTrace

[ARCHIVÉ] Dernière mise à jour par Joe Schaefer sur mer., 20 mai 2026    source
 

Mesurez deux fois, coupez une fois, avant de vous lancer dans un effort d’optimisation du code.

Rien ne facilite la mesure du produit que DTrace.

Sources vidéo

      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) }'"

Optimisation ciblée

Chaque $dtlv class-method-call ci-dessous est effectué lors de la compilation par :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);
}