sub modifyKernel()

in maxas/MaxAs/Cubin.pm [443:556]

• 97 lines of code
• 18 McCabe index (conditional complexity)

sub modifyKernel
{
    my ($cubin, %params) = @_;

    my $kernelSec    = $params{Kernel};
    my $newReg       = $params{RegCnt};
    my $newBar       = $params{BarCnt};
    my $exitOffsets  = $params{ExitOffsets};
    my $ctaidOffsets = $params{CTAIDOffsets};
    my $ctaidzUsed   = $params{CTAIDZUsed};
    my $newData      = $params{KernelData};
    my $newSize      = @$newData * 8;

    die "255 register max" if $newReg > 255;
    die "new kernel size must be multiple of 8 instructions (64 bytes)" if $newSize & 63;
    die "16 is max barrier count" if $newBar > 16;

    my $paramSec    = $kernelSec->{ParamSec};
    my $kernelName  = $kernelSec->{SymbolEnt}{Name};
    my $maxregCount = $paramSec->{MAXREG_COUNT};
    my $stackSize   = $paramSec->{STACKSIZE};

    # update the kernel
    $kernelSec->{KernelData} = $newData;
    $kernelSec->{Data}       = unpack "H*", pack "Q*", @$newData;

    if ($newReg != $kernelSec->{RegCnt})
    {
        print "Modified $kernelName RegCnt: $kernelSec->{RegCnt} => $newReg\n";
        $kernelSec->{RegCnt} = $newReg;
        $kernelSec->{info}  &= ~0xff000000;
        $kernelSec->{info}  |= $newReg << 24;
    }
    if ($newBar != $kernelSec->{BarCnt})
    {
        print "Modified $kernelName BarCnt: $kernelSec->{BarCnt} => $newBar\n";
        $kernelSec->{BarCnt} = $newBar;
        $kernelSec->{flags} &= ~0x01f00000;
        $kernelSec->{flags} |=  $newBar << 20;
    }

    my @paramData = @{$paramSec->{StaticParams}};

    if (defined $maxregCount)
    {
        push @paramData, ($maxregCount << 16) | 0x1b03;
    }

    my $newCTAIDs = join ',', map { sprintf '%04x', $_ } @$ctaidOffsets;
    my $oldCTAIDs = join ',', map { sprintf '%04x', $_ } @{$paramSec->{CTAIDOffsets}};

    if ($newCTAIDs ne $oldCTAIDs)
    {
        print "Modified $kernelName CTAID Offsets: '$oldCTAIDs' => '$newCTAIDs'\n";
    }
    if (@$ctaidOffsets)
    {
        push @paramData, (scalar(@$ctaidOffsets) << 18) | 0x1d04;
        push @paramData, @$ctaidOffsets;
    }

    my $newExits = join ',', map { sprintf '%04x', $_ } @$exitOffsets;
    my $oldExits = join ',', map { sprintf '%04x', $_ } @{$paramSec->{ExitOffsets}};

    if ($newExits ne $oldExits)
    {
        print "Modified $kernelName Exit Offsets: '$oldExits' => '$newExits'\n";
    }
    if (@$exitOffsets)
    {
        push @paramData, (scalar(@$exitOffsets) << 18) | 0x1c04;
        push @paramData, @$exitOffsets;
    }

    if ($ctaidzUsed != $paramSec->{CTAIDZUsed})
    {
        print "Modified $kernelName CTAID.Z Used: '$paramSec->{CTAIDZUsed}' => '$ctaidzUsed'\n";
    }
    if ($ctaidzUsed)
    {
        push @paramData, 0x0401;
    }

    if (@{$paramSec->{REQNTID}})
    {
        push @paramData, (scalar(@{$paramSec->{REQNTID}}) << 18) | 0x1004;
        push @paramData, @{$paramSec->{REQNTID}};
    }
    if (@{$paramSec->{MAXNTID}})
    {
        push @paramData, (scalar(@{$paramSec->{MAXNTID}}) << 18) | 0x0504;
        push @paramData, @{$paramSec->{MAXNTID}};
    }

    if (@$stackSize)
    {
        push @paramData, (scalar(@$stackSize) << 18) | 0x1e04;
        push @paramData, @$stackSize;
    }

    my $newParamSize  = scalar(@paramData)*4;
    $paramSec->{Data} = unpack "H*", pack "L*", @paramData;
    if ($newParamSize != $paramSec->{size})
    {
        print "Modified $kernelName ParamSecSize: $paramSec->{size} => $newParamSize\n";
        $cubin->updateSize($paramSec, $newParamSize);
    }

    if ($newSize != $kernelSec->{size})
    {
        print "Modified $kernelName KernelSize: $kernelSec->{size} => $newSize\n";
        $cubin->updateSize($kernelSec, $newSize, 1);
    }
}