This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
xsubpp enhancements ($CPAN/authors/id/ILYAZ/patches/diff_xsubpp_65), a
authorIlya Zakharevich <ilya@math.berkeley.edu>
Sat, 13 Dec 1997 07:31:02 +0000 (02:31 -0500)
committerGurusamy Sarathy <gsar@cpan.org>
Wed, 10 Jun 1998 05:07:04 +0000 (05:07 +0000)
variant of:
Message-Id: <199712131231.HAA04125@monk.mps.ohio-state.edu>
Subject: 5.004_55: xsubpp: new keywords INTERFACE C_ARGS

p4raw-id: //depot/perl@1083

XSUB.h
lib/ExtUtils/xsubpp
pod/perlxs.pod

diff --git a/XSUB.h b/XSUB.h
index 06dc023..cd8a732 100644 (file)
--- a/XSUB.h
+++ b/XSUB.h
 
 #define dXSI32 I32 ix = XSANY.any_i32
 
+#ifdef __cplusplus
+#  define XSINTERFACE_CVT(ret,name) ret (*name)(...)
+#else
+#  define XSINTERFACE_CVT(ret,name) ret (*name)()
+#endif
+#define dXSFUNCTION(ret)               XSINTERFACE_CVT(ret,XSFUNCTION)
+#define XSINTERFACE_FUNC(ret,cv,f)     ((XSINTERFACE_CVT(ret,))(f))
+#define XSINTERFACE_FUNC_SET(cv,f)     \
+               CvXSUBANY(cv).any_dptr = (void (*) _((void*)))(f)
+
 #define XSRETURN(off)                                  \
     STMT_START {                                       \
        stack_sp = stack_base + ax + ((off) - 1);       \
index 8e253ff..378e481 100755 (executable)
@@ -93,7 +93,7 @@ sub Q ;
 
 # Global Constants
 
-$XSUBPP_version = "1.9506";
+$XSUBPP_version = "1.9507";
 
 my ($Is_VMS, $SymSet);
 if ($^O eq 'VMS') {
@@ -243,7 +243,7 @@ $END = "!End!\n\n";         # "impossible" keyword (multiple newline)
 $BLOCK_re= '\s*(' . join('|', qw(
        REQUIRE BOOT CASE PREINIT INPUT INIT CODE PPCODE OUTPUT 
        CLEANUP ALIAS PROTOTYPES PROTOTYPE VERSIONCHECK INCLUDE
-       SCOPE
+       SCOPE INTERFACE INTERFACE_MACRO C_ARGS
        )) . "|$END)\\s*:";
 
 # Input:  ($_, @line) == unparsed input.
@@ -310,6 +310,20 @@ sub print_section {
     print "$xsubpp::counter::SECTION_END_MARKER\n" if $WantLineNumbers;
 }
 
+sub merge_section {
+    my $in = '';
+  
+    while (!/\S/ && @line) {
+        $_ = shift(@line);
+    }
+    
+    for (;  defined($_) && !/^$BLOCK_re/o;  $_ = shift(@line)) {
+       $in .= "$_\n";
+    }
+    chomp $in;
+    return $in;
+}
+
 sub process_keyword($)
 {
     my($pattern) = @_ ;
@@ -407,6 +421,42 @@ sub OUTPUT_handler {
     }
 }
 
+sub C_ARGS_handler() {
+    my $in = merge_section();
+  
+    TrimWhitespace($in);
+    $func_args = $in;
+} 
+
+sub INTERFACE_MACRO_handler() {
+    my $in = merge_section();
+  
+    TrimWhitespace($in);
+    if ($in =~ /\s/) {         # two
+        ($interface_macro, $interface_macro_set) = split ' ', $in;
+    } else {
+        $interface_macro = $in;
+       $interface_macro_set = 'UNKNOWN_CVT'; # catch later
+    }
+    $interface = 1;            # local
+    $Interfaces = 1;           # global
+}
+
+sub INTERFACE_handler() {
+    my $in = merge_section();
+  
+    TrimWhitespace($in);
+    
+    foreach (split /[\s,]+/, $in) {
+        $Interfaces{$_} = $_;
+    }
+    print Q<<"EOF";
+#      XSFUNCTION = $interface_macro($ret_type,cv,XSANY.any_dptr);
+EOF
+    $interface = 1;            # local
+    $Interfaces = 1;           # global
+}
+
 sub CLEANUP_handler() { print_section() } 
 sub PREINIT_handler() { print_section() } 
 sub INIT_handler()    { print_section() } 
@@ -731,6 +781,8 @@ while (<$FH>) {
 }
 &Exit unless defined $_;
 
+print "$xsubpp::counter::SECTION_END_MARKER\n" if $WantLineNumbers;
+
 $lastline    = $_;
 $lastline_no = $.;
 
@@ -847,6 +899,9 @@ while (fetch_para()) {
     undef(@proto_arg) ;
     undef($proto_in_this_xsub) ;
     undef($scope_in_this_xsub) ;
+    undef($interface);
+    $interface_macro = 'XSINTERFACE_FUNC' ;
+    $interface_macro_set = 'XSINTERFACE_FUNC_SET' ;
     $ProtoThisXSUB = $WantPrototypes ;
     $ScopeThisXSUB = 0;
 
@@ -867,7 +922,7 @@ while (fetch_para()) {
 
 
     # extract return type, function name and arguments
-    my($ret_type) = TidyType($_);
+    ($ret_type) = TidyType($_);
 
     # a function definition needs at least 2 lines
     blurt ("Error: Function definition too short '$ret_type'"), next PARAGRAPH
@@ -892,7 +947,7 @@ while (fetch_para()) {
        last;
     }
     $XSStack[$XSS_work_idx]{functions}{$Full_func_name} ++ ;
-    %XsubAliases = %XsubAliasValues = ();
+    %XsubAliases = %XsubAliasValues = %Interfaces = ();
     $DoSetMagic = 1;
 
     @args = split(/\s*,\s*/, $orig_args);
@@ -935,6 +990,7 @@ while (fetch_para()) {
     $EXPLICIT_RETURN = ($CODE &&
                ("@line" =~ /(\bST\s*\([^;]*=) | (\bXST_m\w+\s*\()/x ));
     $ALIAS  = grep(/^\s*ALIAS\s*:/,  @line);
+    $INTERFACE  = grep(/^\s*INTERFACE\s*:/,  @line);
 
     # print function header
     print Q<<"EOF";
@@ -945,6 +1001,9 @@ EOF
     print Q<<"EOF" if $ALIAS ;
 #    dXSI32;
 EOF
+    print Q<<"EOF" if $INTERFACE ;
+#    dXSFUNCTION($ret_type);
+EOF
     if ($elipsis) {
        $cond = ($min_args ? qq(items < $min_args) : 0);
     }
@@ -997,7 +1056,7 @@ EOF
         $gotRETVAL = 0;
 
        INPUT_handler() ;
-       process_keyword("INPUT|PREINIT|ALIAS|PROTOTYPE|SCOPE") ;
+       process_keyword("INPUT|PREINIT|INTERFACE_MACRO|C_ARGS|ALIAS|PROTOTYPE|SCOPE") ;
 
        print Q<<"EOF" if $ScopeThisXSUB;
 #   ENTER;
@@ -1031,7 +1090,7 @@ EOF
 
                print $deferred;
 
-        process_keyword("INIT|ALIAS|PROTOTYPE") ;
+        process_keyword("INIT|ALIAS|PROTOTYPE|INTERFACE_MACRO|INTERFACE|C_ARGS") ;
 
                if (check_keyword("PPCODE")) {
                        print_section();
@@ -1064,6 +1123,7 @@ EOF
                        }
                        $func_name =~ s/^($spat)//
                            if defined($spat);
+                       $func_name = 'XSFUNCTION' if $interface;
                        print "$func_name($func_args);\n";
                }
        }
@@ -1172,6 +1232,18 @@ EOF
 #        sv_setpv((SV*)cv$proto) ;
 EOF
         }
+    } 
+    elsif ($interface) {
+       while ( ($name, $value) = each %Interfaces) {
+           $name = "$Package\::$name" unless $name =~ /::/;
+           push(@InitFileCode, Q<<"EOF");
+#        cv = newXS(\"$name\", XS_$Full_func_name, file);
+#        $interface_macro_set(cv,$value) ;
+EOF
+           push(@InitFileCode, Q<<"EOF") if $proto;
+#        sv_setpv((SV*)cv$proto) ;
+EOF
+        }
     }
     else {
        push(@InitFileCode,
@@ -1210,7 +1282,7 @@ print Q<<"EOF" if $WantVersionChk ;
 #
 EOF
 
-print Q<<"EOF" if defined $XsubAliases ;
+print Q<<"EOF" if defined $XsubAliases or defined $Interfaces ;
 #    {
 #        CV * cv ;
 #
@@ -1218,7 +1290,7 @@ EOF
 
 print @InitFileCode;
 
-print Q<<"EOF" if defined $XsubAliases ;
+print Q<<"EOF" if defined $XsubAliases or defined $Interfaces ;
 #    }
 EOF
 
index 2f4be67..c4a064d 100644 (file)
@@ -541,6 +541,32 @@ The XS code, with ellipsis, follows.
           timep
           RETVAL
 
+=head2 The C_ARGS: Keyword
+
+The C_ARGS: keyword allows creating of XSUBS which have different
+calling sequence from Perl than from C, without a need to write
+CODE: or CPPCODE: section.  The contents of the C_ARGS: paragraph is
+put as the argument to the called C function without any change.
+
+For example, suppose that C function is declared as
+
+    symbolic nth_derivative(int n, symbolic function, int flags);
+
+and that the default flags are kept in a global C variable
+C<default_flags>.  Suppose that you want to create an interface which
+is called as
+
+    $second_deriv = $function->nth_derivative(2);
+
+To do this, declare the XSUB as
+
+    symbolic
+    nth_derivative(function, n)
+       symbolic        function
+       int             n
+    C_ARGS:
+       n, function, default_flags
+
 =head2 The PPCODE: Keyword
 
 The PPCODE: keyword is an alternate form of the CODE: keyword and is used
@@ -750,7 +776,7 @@ prototypes.
 
 =head2 The ALIAS: Keyword
 
-The ALIAS: keyword allows an XSUB to have two more unique Perl names
+The ALIAS: keyword allows an XSUB to have two or more unique Perl names
 and to know which of those names was used when it was invoked.  The Perl
 names may be fully-qualified with package names.  Each alias is given an
 index.  The compiler will setup a variable called C<ix> which contain the
@@ -772,6 +798,77 @@ C<BAR::getit()> for this function.
           OUTPUT:
           timep
 
+=head2 The INTERFACE: Keyword
+
+This keyword declares the current XSUB as a keeper of the given
+calling signature.  If some text follows this keyword, it is
+considered as a list of functions which have this signature, and
+should be attached to XSUBs.
+
+Say, if you have 4 functions multiply(), divide(), add(), subtract() all
+having the signature
+
+    symbolic f(symbolic, symbolic);
+
+you code them all by using XSUB
+
+    symbolic
+    interface_s_ss(arg1, arg2)  
+       symbolic        arg1
+       symbolic        arg2
+    INTERFACE:
+       multiply divide 
+       add subtract
+
+The advantage of this approach comparing to ALIAS: keyword is that one
+can attach an extra function remainder() at runtime by using
+    
+    CV *mycv = newXSproto("Symbolic::remainder", 
+                         XS_Symbolic_interface_s_ss, __FILE__, "$$");
+    XSINTERFACE_FUNC_SET(mycv, remainder);
+
+(This example supposes that there was no INTERFACE_MACRO: section,
+otherwise one needs to use something else instead of
+C<XSINTERFACE_FUNC_SET>.)
+
+=head2 The INTERFACE_MACRO: Keyword
+
+This keyword allows one to define an INTERFACE using a different way
+to extract a function pointer from an XSUB.  The text which follows
+this keyword should give the name of macros which would extract/set a
+function pointer.  The extractor macro is given return type, C<CV*>,
+and C<XSANY.any_dptr> for this C<CV*>.  The setter macro is given cv,
+and the function pointer.
+
+The default value is C<XSINTERFACE_FUNC> and C<XSINTERFACE_FUNC_SET>.
+An INTERFACE keyword with an empty list of functions can be omitted if
+INTERFACE_MACRO keyword is used.
+
+Suppose that in the previous example functions pointers for 
+multiply(), divide(), add(), subtract() are kept in a global C array
+C<fp[]> with offsets being C<multiply_off>, C<divide_off>, C<add_off>,
+C<subtract_off>.  Then one can use 
+
+    #define XSINTERFACE_FUNC_BYOFFSET(ret,cv,f) \
+       ((XSINTERFACE_CVT(ret,))fp[CvXSUBANY(cv).any_i32])
+    #define XSINTERFACE_FUNC_BYOFFSET_set(cv,f) \
+       CvXSUBANY(cv).any_i32 = CAT2( f, _off )
+
+in C section,
+
+    symbolic
+    interface_s_ss(arg1, arg2)  
+       symbolic        arg1
+       symbolic        arg2
+    INTERFACE_MACRO: 
+       XSINTERFACE_FUNC_BYOFFSET
+       XSINTERFACE_FUNC_BYOFFSET_set
+    INTERFACE:
+       multiply divide 
+       add subtract
+
+in XSUB section.
+
 =head2 The INCLUDE: Keyword
 
 This keyword can be used to pull other files into the XS module.  The other