diff --git a/Basic/Core/Core.xs b/Basic/Core/Core.xs index ce2bcdc7c..0da3cf44e 100644 --- a/Basic/Core/Core.xs +++ b/Basic/Core/Core.xs @@ -78,13 +78,6 @@ trans_children(self) INCLUDE_COMMAND: $^X -e "require q{./Dev.pm}; PDL::Core::Dev::generate_core_flags()" -void -set_inplace(self,val) - pdl *self; - int val; - CODE: - setflag(self->state,PDL_INPLACE,val); - IV address(self) pdl *self; @@ -661,16 +654,6 @@ upd_data(self, keep_datasv=0) } PDLDEBUG_f(printf("upd_data end: "); pdl_dump(self)); -void -set_dataflow_f(self,value) - pdl *self; - int value; - CODE: - if(value) - self->state |= PDL_DATAFLOW_F; - else - self->state &= ~PDL_DATAFLOW_F; - int badflag(x,newval=0) pdl *x diff --git a/Basic/Core/Dev.pm b/Basic/Core/Dev.pm index 2bf4bc42a..51b8de214 100644 --- a/Basic/Core/Dev.pm +++ b/Basic/Core/Dev.pm @@ -482,9 +482,11 @@ prints on C XS text with core flags, for F. my %flags = ( hdrcpy => { set => 1 }, + set_dataflow_f => { FLAG => "DATAFLOW_F", noret => 1 }, fflows => { FLAG => "DATAFLOW_F" }, bflows => { FLAG => "DATAFLOW_B" }, is_inplace => { FLAG => "INPLACE", postset => 1 }, + set_inplace => { FLAG => "INPLACE", noret => 1 }, donttouch => { FLAG => "DONTTOUCHDATA" }, allocated => { }, vaffine => { FLAG => "OPT_VAFFTRANSOK" }, @@ -499,19 +501,24 @@ sub generate_core_flags { # to ndarray's state foreach my $name ( sort keys %flags ) { my $flag = "PDL_" . ($flags{$name}{FLAG} || uc($name)); - my $with_mode = $flags{$name}{set} || $flags{$name}{postset}; - printf <<'EOF', $name, $with_mode ? (",mode=0", "\n int mode") : ('', ''); -int + my $ref = $flags{$name}; + my $with_mode = grep $ref->{$_}, qw(set postset noret); + my $mode_dflt = (grep $ref->{$_}, qw(set postset)) ? "=0" : ""; + my @mode = $with_mode ? (",mode$mode_dflt", "\n int mode") : ('', ''); + printf <<'EOF', $ref->{noret} ? 'void' : 'int', $name, @mode; +%s %s(x%s) pdl *x%s CODE: EOF - my $set = " if (items>1) setflag(x->state,$flag,mode);\n"; + my $cond = $ref->{noret} ? "" : "if (items>1) "; + my $set = " ${cond}setflag(x->state,$flag,mode);\n"; my $ret = " RETVAL = ((x->state & $flag) > 0);\n"; - print $set if $flags{$name}{set}; - print $ret; - print $set if $flags{$name}{postset}; - print " OUTPUT:\n RETVAL\n\n"; + print $set if $ref->{set} || $ref->{noret}; + print $ret if !$ref->{noret}; + print $set if $ref->{postset}; + print " OUTPUT:\n RETVAL\n" if !$ref->{noret}; + print "\n"; } # foreach: keys %flags }