view release on metacpan or  search on metacpan

Basic/Gen/PP/PdlParObj.pm  view on Meta::CPAN

	my($this,$fromsub,$tosub) = @_;
	join '',map {
		my $iname = $this->get_incname($_);
		&$fromsub($iname)."=".&$tosub($iname).";";
	} (0..$#{$this->{IndObjs}})
}

sub get_incsets {
	my($this,$str) = @_;
	my $no=0;
	(join '',map {
               "if($str->ndims <= $_ || $str->dims[$_] <= 1)
		  \$PRIV(".($this->get_incname($_)).") = 0; else
		 \$PRIV(".($this->get_incname($_)).
			") = ".($this->{FlagPhys}?
				   "$str->dimincs[$_];" :
				   "PDLA_REPRINC($str,$_);");
	} (0..$#{$this->{IndObjs}}) )
}

# Print an access part.
sub do_access {
	my($this,$inds,$context) = @_;
	my $pdl = $this->{Name};
# Parse substitutions into hash
	my %subst = map
	 {/^\s*(\w+)\s*=>\s*(\S*)\s*$/ or confess "Invalid subst $_\n"; ($1,$2)}
	 	splitprotected ',',$inds;
# Generate the text
	my $text;
	$text = "(${pdl}_datap)"."[";
	$text .= join '+','0',map {
		$this->do_indterm($pdl,$_,\%subst,$context);
	} (0..$#{$this->{IndObjs}});
	$text .= "]";
# If not all substitutions made, the user probably made a spelling
# error. Barf.
	if(scalar(keys %subst) != 0) {
		confess("Substitutions left: ".(join ',',keys %subst)."\n");
	}
       return "$text PDLA_COMMENT(\"ACCESS($access)\") ";
}

sub has_dim {
	my($this,$ind) = @_;
	my $h = 0;
	for(@{$this->{IndObjs}}) {
		$h++ if $_->name eq $ind;
	}
	return $h;
}

sub do_resize {
	my($this,$ind,$size) = @_;
	my @c;my $index = 0;
	for(@{$this->{IndObjs}}) {
		push @c,$index if $_->name eq $ind; $index ++;
	}
	my $pdl = $this->get_nname;
	return (join '',map {"$pdl->dims[$_] = $size;\n"} @c).
		"PDLA->resize_defaultincs($pdl);PDLA->allocdata($pdl);".
		$this->get_xsdatapdecl(undef,1);
}

sub do_pdlaccess {
	my($this) = @_;
	return '$PRIV(pdls['.$this->{Number}.'])';

}

sub do_pointeraccess {
	my($this) = @_;
	return $this->{Name}."_datap";
}

sub do_physpointeraccess {
	my($this) = @_;
	return $this->{Name}."_physdatap";
}

sub do_indterm { my($this,$pdl,$ind,$subst,$context) = @_;
# Get informed
	my $indname = $this->{IndObjs}[$ind]->name;
	my $indno = $this->{IndCounts}[$ind];
	my $indtot = $this->{IndTotCounts}[$ind];
# See if substitutions
	my $substname = ($indtot>1 ? $indname.$indno : $indname);
	my $incname = $indname.($indtot>1 ? $indno : "");
	my $index;
	if(defined $subst->{$substname}) {$index = delete $subst->{$substname};}
	else {
# No => get the one from the nearest context.
		for(reverse @$context) {
			if($_->[0] eq $indname) {$index = $_->[1]; last;}
		}
	}
	if(!defined $index) {confess "Access Index not found: $pdl, $ind, $indname
		On stack:".(join ' ',map {"($_->[0],$_->[1])"} @$context)."\n" ;}
#	return "\$PRIV(".($this->get_incname($ind))."*". $index .")";
# Now we have them in register variables -> no PRIV
       return ("(".($this->get_incname($ind))."*".
               "PP_INDTERM(".$this->{IndObjs}[$ind]->get_size().", $index))");
}

# XXX hacked to create a variable containing the bad value for 
# this piddle. 
# This is a HACK (Doug Burke 07/08/00)
# XXX
#
sub get_xsdatapdecl { 
    my($this,$genlooptype,$asgnonly) = @_;
    my $type; 
    my $pdl = $this->get_nname; 
    my $flag = $this->get_nnflag;
    my $name = $this->{Name};
    $type = $this->ctype($genlooptype) if defined $genlooptype;
    my $declini = ($asgnonly ? "" : "\t$type *");
    my $cast = ($type ? "($type *)" : "");
# ThreadLoop does this for us.
#	return "$declini ${name}_datap = ($cast((${_})->data)) + (${_})->offs;\n";