La alegría de DTrace

[ARCHIVADO] Última actualización por Joe Schaefer en mié., 20 may. 2026    origen
 

Medir dos veces, cortar una vez, antes de embarcarse en un esfuerzo de optimización de código.

Nada facilita la medición del producto que DTrace.

Fuentes de vídeo

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

Optimización dirigida

Cada $dtlv class-method-call a continuación se realiza en tiempo de compilación por :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);
}