Alt-Acme-Math-XS-CPP

 view release on metacpan or  search on metacpan

inc/Inline/C.pm  view on Meta::CPAN

            unless -T $typemap;
        open(TYPEMAP, $typemap)
            or warn ("Warning: could not open typemap file '$typemap': $!\n"),
            next;
        my $mode = 'Typemap';
        my $junk = "";
        my $current = \$junk;
        while (<TYPEMAP>) {
            next if /^\s*\#/;
            my $line_no = $. + 1;
            if (/^INPUT\s*$/)   {$mode = 'Input';   $current = \$junk;  next}
            if (/^OUTPUT\s*$/)  {$mode = 'Output';  $current = \$junk;  next}
            if (/^TYPEMAP\s*$/) {$mode = 'Typemap'; $current = \$junk;  next}
            if ($mode eq 'Typemap') {
                chomp;
                my $line = $_;
                TrimWhitespace($_);
                # skip blank lines and comment lines
                next if /^$/ or /^\#/;
                my ($type,$kind, $proto) =
                    /^\s*(.*?\S)\s+(\S+)\s*($proto_re*)\s*$/ or
                    warn("Warning: File '$typemap' Line $. '$line' TYPEMAP entry needs 2 or 3 columns\n"), next;

inc/Inline/C.pm  view on Meta::CPAN

            }
        }
        elsif ($listargs) {
            $XS .= <<END;
        PREINIT:
        I32* temp;
        CODE:
        temp = PL_markstack_ptr++;
        RETVAL = $function($arg_name_list);
        PL_markstack_ptr = temp;
        OUTPUT:
        RETVAL
END
        }
    }
    $XS .= "\n";
    return $XS;
}

#==============================================================================
# Generate the INLINE.h file.

inc/Inline/C.pm  view on Meta::CPAN

    open HEADER, "> ".File::Spec->catfile($o->{API}{build_dir},"INLINE.h")
        or croak;

    print HEADER <<'END';
#define Inline_Stack_Vars dXSARGS
#define Inline_Stack_Items items
#define Inline_Stack_Item(x) ST(x)
#define Inline_Stack_Reset sp = mark
#define Inline_Stack_Push(x) XPUSHs(x)
#define Inline_Stack_Done PUTBACK
#define Inline_Stack_Return(x) XSRETURN(x)
#define Inline_Stack_Void XSRETURN(0)

#define INLINE_STACK_VARS Inline_Stack_Vars
#define INLINE_STACK_ITEMS Inline_Stack_Items
#define INLINE_STACK_ITEM(x) Inline_Stack_Item(x)
#define INLINE_STACK_RESET Inline_Stack_Reset
#define INLINE_STACK_PUSH(x) Inline_Stack_Push(x)
#define INLINE_STACK_DONE Inline_Stack_Done
#define INLINE_STACK_RETURN(x) Inline_Stack_Return(x)

inc/Inline/C.pm  view on Meta::CPAN

    ($cmd) = $cmd =~ /(.*)/ if $o->UNTAINT;
    system($cmd) == 0
        or croak($o->build_error_message($cmd, $output_file, $build_noisy));
}

sub build_error_message {
    my ($o, $cmd, $output_file, $build_noisy) = @_;
    my $build_dir = $o->{API}{build_dir};
    my $output = '';
    if (not $build_noisy and
        open(OUTPUT, $output_file)
    ) {
        local $/;
        $output = <OUTPUT>;
        close OUTPUT;
    }

    my $errcode = $? >> 8;
    $output .= <<END;

A problem was encountered while attempting to compile and install your Inline
$o->{API}{language} code. The command that failed was:
  \"$cmd\" with error code $errcode

The build directory was:

inc/Inline/CPP.pm  view on Meta::CPAN

  elsif ($ellipsis) {
    push @CODE, "\tPL_markstack_ptr = __temp_markstack_ptr;\n";
  }

  # The actual function:
  local $" = q{};
  push @XS, "${t}PREINIT:\n@PREINIT" if @PREINIT;
  push @XS, $t;
  push @XS, 'PP' if $void and @CODE;
  push @XS, "CODE:\n@CODE" if @CODE;
  push @XS, "${t}OUTPUT:\nRETVAL\n" if @CODE and not $void;
  push @XS, "\n";
  return "@XS";
}


sub _map_subnames_cpp_to_perl {
  my ($thing, $name, $class) = @_;
  my ($XS, $ctor, $dtor) = (q{}, 0, 0);

  if ($name eq $class) {    # ctor

inc/Inline/CPP.pm  view on Meta::CPAN

  my $filename  = "$o->{API}{build_dir}/CPP.map";
  my $type_kind = $o->{ILSM}{typeconv}{type_kind};
  my $typemap   = q{};
  $typemap .= $_ . "\t" x 2 . $TYPEMAP_KIND . "\n"
    for grep { $type_kind->{$_} eq $TYPEMAP_KIND } keys %{$type_kind};
  return unless length $typemap;

  my $tm_output = <<"END";
TYPEMAP
$typemap
OUTPUT
$TYPEMAP_KIND
$o->{ILSM}{typeconv}{output_expr}{$TYPEMAP_KIND}
INPUT
$TYPEMAP_KIND
$o->{ILSM}{typeconv}{input_expr}{$TYPEMAP_KIND}
END


  # Open an output file, create if necessary, then lock, then truncate.
  # This replaces the following, which wasn't lock-safe:

  sysopen(my $TYPEMAP_FH, $filename, O_WRONLY | O_CREAT)
    or croak "Error: Can't write to $filename: $!";

inc/Inline/CPP/Parser/RecDescent.pm  view on Meta::CPAN

# functions declared after a class to return or accept class objects as
# parameters.
#============================================================================
$TYPEMAP_KIND = 'O_Inline_CPP_Class';

sub typemap {
  my ($parser, $typename) = @_;

#    print "Inline::CPP::Parser::RecDescent::typemap(): typename=$typename\n";

  my ($TYPEMAP, $INPUT, $OUTPUT);
  $TYPEMAP = "$typename *\t\t$TYPEMAP_KIND\n";
  $INPUT   = <<"END";
    if (sv_isobject(\$arg) && (SvTYPE(SvRV(\$arg)) == SVt_PVMG)) {
        \$var = (\$type)SvIV((SV*)SvRV( \$arg ));
    }
    else {
        warn ( \\"\${Package}::\$func_name() -- \$var is not a blessed reference\\" );
        XSRETURN_UNDEF;
    }
END
  $OUTPUT = <<"END";
    sv_setref_pv( \$arg, CLASS, (void*)\$var );
END

  my $ctypename = $typename . ' *';
  $parser->{data}{typeconv}{input_expr}{$TYPEMAP_KIND}  ||= $INPUT;
  $parser->{data}{typeconv}{output_expr}{$TYPEMAP_KIND} ||= $OUTPUT;
  $parser->{data}{typeconv}{type_kind}{$ctypename} = $TYPEMAP_KIND;
  $parser->{data}{typeconv}{valid_types}{$ctypename}++;
  $parser->{data}{typeconv}{valid_rtypes}{$ctypename}++;
  return;
}

#============================================================================
# Default action is to strip ellipses from the C++ code. This allows having
# _only_ a '...' in the code, just like XS. It is the default.
#============================================================================