SOM

 view release on metacpan or  search on metacpan

SOM.xs  view on Meta::CPAN

int
PSOM_Dispatch0(obj, meth)
    SOMObject *obj;
    char *meth;

int
PSOM_Dispatch_templ(obj, meth, templ, ...)
    SOMObject *obj;
    char *meth;
    char *templ;
PPCODE:
  {
    union { short s; unsigned short us; long l; unsigned long ul;
	    char c; unsigned char uc; float f; double d; char *cp; void *vp;
	    SOMObject *op;
    } ret_buffer, par_buffer;
    va_list start_val;
    MYsomVaBuf vb;
    somToken *ret = 0;
    char *t = templ;
    int is_oidl = 0;

utils/xsubpp  view on Meta::CPAN

	     ( (?p{ $size }) )?			# Possible sizeof set-from
	     \) \s* ; \s* $
	  ]x);
    $targetable{$key} = [$t, $with_size, $arg, $sarg] if $t;
}

$END = "!End!\n\n";		# "impossible" keyword (multiple newline)

# Match an XS keyword
$BLOCK_re= '\s*(' . join('|', qw(
	REQUIRE BOOT CASE PREINIT INPUT INIT CODE PPCODE OUTPUT 
	CLEANUP ALIAS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE
	SCOPE INTERFACE INTERFACE_MACRO C_ARGS POSTCALL
	)) . "|$END)\\s*:";

# Input:  ($_, @line) == unparsed input.
# Output: ($_, @line) == (rest of line, following lines).
# Return: the matched keyword if found, otherwise 0
sub check_keyword {
	$_ = shift(@line) while !/\S/ && @line;
	s/^(\s*)($_[0])\s*:\s*(?:#.*)?/$1/s && $2;

utils/xsubpp  view on Meta::CPAN

    $report_args =~ s/^,\s+//;
    my @func_args = @args;
    shift @func_args if defined($class);

    for (@func_args) {
	s/^/&/ if $in_out{$_};
    }
    $func_args = join(", ", @func_args);
    @args_match{@args} = @args_num;

    $PPCODE = grep(/^\s*PPCODE\s*:/, @line);
    $CODE = grep(/^\s*CODE\s*:/, @line);
    # Detect CODE: blocks which use ST(n)= or XST_m*(n,v)
    #   to set explicit return values.
    $EXPLICIT_RETURN = ($CODE &&
		("@line" =~ /(\bST\s*\([^;]*=) | (\bXST_m\w+\s*\()/x ));
    $ALIAS  = grep(/^\s*ALIAS\s*:/,  @line);
    $INTERFACE  = grep(/^\s*INTERFACE\s*:/,  @line);

    $xsreturn = 1 if $EXPLICIT_RETURN;

utils/xsubpp  view on Meta::CPAN

      { print Q<<"EOF" if $cond }
#    if ($cond)
#       Perl_croak(aTHX_ "Usage: %s($report_args)", GvNAME(CvGV(cv)));
EOF
    else 
      { print Q<<"EOF" if $cond }
#    if ($cond)
#	Perl_croak(aTHX_ "Usage: $pname($report_args)");
EOF

    print Q<<"EOF" if $PPCODE;
#    SP -= items;
EOF

    # Now do a block of some sort.

    $condnum = 0;
    $cond = '';			# last CASE: condidional
    push(@line, "$END:");
    push(@line_no, $line_no[-1]);
    $_ = '';

utils/xsubpp  view on Meta::CPAN

		if (@arg_with_types) {
		    unshift @line, @arg_with_types, $_;
		    $_ = "";
		    $processing_arg_with_types = 1;
		    INPUT_handler() ;
		}
		print $deferred;

        process_keyword("INIT|ALIAS|PROTOTYPE|INTERFACE_MACRO|INTERFACE|C_ARGS") ;

		if (check_keyword("PPCODE")) {
			print_section();
			death ("PPCODE must be last thing") if @line;
			print "\tLEAVE;\n" if $ScopeThisXSUB;
			print "\tPUTBACK;\n\treturn;\n";
		} elsif (check_keyword("CODE")) {
			print_section() ;
		} elsif (defined($class) and $func_name eq "DESTROY") {
			print "\n\t";
			print "delete THIS;\n";
		} else {
			print "\n\t";
			if ($ret_type ne "void") {

utils/xsubpp  view on Meta::CPAN

	print "\tEXTEND(SP,$c);\n" if $c;
	$xsreturn += $c;
	generate_output($var_types{$_}, $num++, $_, 0, 1) for @in_out;

	# do cleanup
	process_keyword("CLEANUP|ALIAS|PROTOTYPE") ;

	print Q<<"EOF" if $ScopeThisXSUB;
#   ]]
EOF
	print Q<<"EOF" if $ScopeThisXSUB and not $PPCODE;
#   LEAVE;
EOF

	# print function trailer
	print Q<<EOF;
#    ]]
EOF
	print Q<<EOF if $except;
#    BEGHANDLERS
#    CATCHALL

utils/xsubpp  view on Meta::CPAN

	last if $_ eq "$END:";
	death(/^$BLOCK_re/o ? "Misplaced `$1:'" : "Junk at end of function");
    }

    print Q<<EOF if $except;
#    if (errbuf[0])
#	Perl_croak(aTHX_ errbuf);
EOF

    if ($xsreturn) {
        print Q<<EOF unless $PPCODE;
#    XSRETURN($xsreturn);
EOF
    } else {
        print Q<<EOF unless $PPCODE;
#    XSRETURN_EMPTY;
EOF
    }

    print Q<<EOF;
#]]
#
EOF

    my $newXS = "newXS" ;