⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 ch26.htm

📁 《Perl 5 Unreleased》
💻 HTM
📖 第 1 页 / 共 5 页
字号:
<H2><A NAME="UsingSCALARContext"><B><FONT SIZE=5 COLOR=#FF0000>Using

</FONT></B><TT><B><FONT SIZE=5 COLOR=#FF0000 FACE="Courier">SCALAR</FONT></B></TT><B><FONT SIZE=5 COLOR=#FF0000>

Context</FONT></B></A></H2>

<P>

Here is an example of how to call a Perl function that takes three

arguments and returns an integer. This is an example of using

a function in a scalar context because it returns a scalar value.

The code is shown in Listing 26.6.

<HR>

<BLOCKQUOTE>

<B>Listing 26.6. A function used in a scalar context.<BR>

</B>

</BLOCKQUOTE>

<BLOCKQUOTE>

<TT><FONT FACE="Courier">&nbsp;1 /* How to call a Perl subroutine

from C */<BR>

&nbsp;2 #include &lt;stdio.h&gt;<BR>

&nbsp;3 #include &lt;EXTERN.h&gt;<BR>

&nbsp;4 #include &lt;perl.h&gt;<BR>

&nbsp;5<BR>

&nbsp;6&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;static int getSeconds(int

s, int m, int h);<BR>

&nbsp;7&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;static PerlInterpreter *my_perl;

<BR>

&nbsp;8<BR>

&nbsp;9&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;int main(int argc, char **argv,

char **env)<BR>

10&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;{<BR>

11&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my_perl

= perl_alloc();<BR>

12&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;perl_construct(my_perl);

<BR>

13<BR>

14&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;perl_parse(my_perl,

NULL, argc, argv, env);<BR>

15&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;getSeconds(10,30,4);&nbsp;&nbsp;

/* TIME = 10:30:04 AM */<BR>

16&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;perl_destruct(my_perl);

<BR>

17&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;perl_free(my_perl);

<BR>

18&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}<BR>

19<BR>

20&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;static int getSeconds(int s, int

m, int h)<BR>

21&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;{<BR>

22&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;dSP ;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;/*

init stack pointer */<BR>

23&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;int count

;&nbsp;&nbsp;&nbsp;&nbsp;/* keep return value&nbsp;&nbsp;*/<BR>

24&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;ENTER

;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;/* start

temporary area */<BR>

25&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;SAVETMPS;

<BR>

26&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;PUSHMARK(sp)

;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;/* push mark

for last argument. */<BR>

27&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;XPUSHs(sv_2mortal(newSViv(s)));

/* leftmost argument */<BR>

28&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;XPUSHs(sv_2mortal(newSViv(m)));

/* go from left to right */<BR>

29&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;XPUSHs(sv_2mortal(newSViv(h)));

/* rightmost argument */<BR>

30&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;PUTBACK

;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;/*

make stack pointer available */<BR>

31&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;count

= perl_call_pv(&quot;seconds&quot;, G_SCALAR); /* call */<BR>

32&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;SPAGAIN

;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;/* reset stack pointer

*/<BR>

33&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;if (count

!= 1)&nbsp;&nbsp;&nbsp;&nbsp;/* check return value */<BR>

34&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;croak(&quot;Whoa

Nelly! This is wrong\n&quot;) ;<BR>

35&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;printf

(&quot;The number of seconds so far = %f for&nbsp;&nbsp;%d:%d:%d\n&quot;,

<BR>

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;POPi,h,m,s) ;<BR>

36&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;PUTBACK

;&nbsp;&nbsp;/* put the popped value on stack again */<BR>

37&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;FREETMPS

;&nbsp;/* free up temporary variables (NOT count) */<BR>

38&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;LEAVE

;&nbsp;&nbsp;&nbsp;&nbsp;/* get out and clean up stack */<BR>

39&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}</FONT></TT>

</BLOCKQUOTE>

<HR>

<P>

Lines 2 through 4 declare the mandatory headers. At line 7 we

declare the prototype for the function we are going to call. You

can declare the function here instead if you like. The call to

this function, <TT><FONT FACE="Courier">getSeconds</FONT></TT>,

is made at line 15. The function itself is declared static to

prevent unlikely confusion with any predefined functions in the

Perl libraries.

<P>

At line 22, the call to the <TT><FONT FACE="Courier">dSP</FONT></TT>

macro initializes the stack. At line 23, the <TT><FONT FACE="Courier">count</FONT></TT>

variable is declared to be a nontemporary variable on the stack.

The <TT><FONT FACE="Courier">ENTER</FONT></TT> and <TT><FONT FACE="Courier">SAVETMPS</FONT></TT>

macros at lines 24 and 25 start the temporary variable area. A

marker to this stack location is pushed on at line 26.

<P>

The <TT><FONT FACE="Courier">ENTER/SAVETMPS</FONT></TT> pair creates

the start of code for all temporary variables that will be destroyed

on the return from the C function. The <TT><FONT FACE="Courier">FREETMPS/LEAVE</FONT></TT>

pair will be used to clean up and destroy the space allocated

on the calling stack for these temporary variables.

<P>

Now the parameters to the Perl subroutine are pushed onto the

stack one at a time from the leftmost parameter to the rightmost

parameter. Remember this order because the Perl function expecting

these parameters will be declared as this:

<BLOCKQUOTE>

<TT><FONT FACE="Courier">sub seconds {<BR>

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my($h, $m, $s)

= @_ ;<BR>

&nbsp;&nbsp;&nbsp;&nbsp;my $t;<BR>

&nbsp;&nbsp;&nbsp;&nbsp;$t = $s + $m * 60 + $h * 3600;<BR>

&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;return

$t<BR>

&nbsp;&nbsp;&nbsp;&nbsp;}</FONT></TT>

</BLOCKQUOTE>

<P>

The stack pointer is made into a globally available value with

the <TT><FONT FACE="Courier">PUTBACK</FONT></TT> macro in line

30. The actual call to the subroutine is made in line 31 with

the <TT><FONT FACE="Courier">G_SCALAR</FONT></TT> flag. On return

from the subroutine, we have to reset the stack pointer with the

<TT><FONT FACE="Courier">SPAGAIN</FONT></TT> (stack pointer again)

macro. The count must be <TT><FONT FACE="Courier">1</FONT></TT>,

or else we have an error.

<P>

The returned value is in <TT><FONT FACE="Courier">POPi</FONT></TT>.

The called function returned an integer value. To get other types

of values, you can use one of the following macros:

<UL>

<LI><TT><FONT FACE="Courier">POPs</FONT></TT> for an <TT><FONT FACE="Courier">SV</FONT></TT>

<LI><TT><FONT FACE="Courier">POPp</FONT></TT> for a pointer (such

as a pointer to a string)

<LI><TT><FONT FACE="Courier">POPn</FONT></TT> for a double

<LI><TT><FONT FACE="Courier">POPi</FONT></TT> for an integer

<LI><TT><FONT FACE="Courier">POPl</FONT></TT> for a long

</UL>

<P>

The <TT><FONT FACE="Courier">PUTBACK</FONT></TT> macro is used

to reset the Perl stack back to a consistent state just before

exiting the function. The <TT><FONT FACE="Courier">POPi</FONT></TT>

macro call only updated the local copy of the stack pointer. We

have to set the global value on the stack, too. All parameters

pushed onto the stack must be bracketed by the <TT><FONT FACE="Courier">PUSHMARK</FONT></TT>

and <TT><FONT FACE="Courier">PUTBACK</FONT></TT> macros. These

macros count the number of parameters being pushed and hence let

Perl know how to size the <TT><FONT FACE="Courier">@_</FONT></TT>

array. The <TT><FONT FACE="Courier">PUSHMARK</FONT></TT> macro

tells Perl to mark the stack pointer and must be specified even

if you are using no parameters. The <TT><FONT FACE="Courier">PUTBACK</FONT></TT>

macro sets the global copy of the stack pointer to the value of

the local copy of the stack pointer.

<P>

Here's another example of how to use a returned string from a

function using the <TT><FONT FACE="Courier">POPp</FONT></TT> macro.

(See Listing 26.7.) Look at lines 23 through 25 to see how strings

and integers are pushed onto the stack with the <TT><FONT FACE="Courier">XPUSHs(sv_2mortal(newSVpv(str,offset)));</FONT></TT>

and <TT><FONT FACE="Courier">XPUSHs(sv_2mortal(newSViv(offset)));</FONT></TT>

functions. The returned value from the actual call to the Perl

function is retrieved with the <TT><FONT FACE="Courier">POPp</FONT></TT>

macro.

<HR>

<BLOCKQUOTE>

<B>Listing 26.7. Using a returned string value.<BR>

</B>

</BLOCKQUOTE>

<BLOCKQUOTE>

<TT><FONT FACE="Courier">&nbsp;1 /* Using returned strings from

functions */<BR>

&nbsp;2 #include &lt;stdio.h&gt;<BR>

&nbsp;3 #include &lt;EXTERN.h&gt;<BR>

&nbsp;4 #include &lt;perl.h&gt;<BR>

&nbsp;5<BR>

&nbsp;6&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;static int MySubString(char

*a, int offset, int len);<BR>

&nbsp;7&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;static PerlInterpreter *my_perl;

<BR>

&nbsp;8<BR>

&nbsp;9&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;int main(int argc, char **argv,

char **env)<BR>

10&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;{<BR>

11&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;my_perl

= perl_alloc();<BR>

12&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;perl_construct(my_perl);

<BR>

13&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;perl_parse(my_perl,

NULL, argc, argv, env);<BR>

14&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;MySubString(&quot;Kamran

Was Here&quot;,7,3); /* return 'Was' */<BR>

15&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;perl_destruct(my_perl);

<BR>

16&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;perl_free(my_perl);

<BR>

17&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}<BR>

18<BR>

19&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;static int MySubString(char *a,

int offset, int len)<BR>

20&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;{<BR>

21&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;dSP ;

<BR>

22&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;PUSHMARK(sp)

;<BR>

23&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;XPUSHs(sv_2mortal(newSVpv(a,

0)));<BR>

24&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;XPUSHs(sv_2mortal(newSViv(offset)));

<BR>

25&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;XPUSHs(sv_2mortal(newSViv(len)));

<BR>

26&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;PUTBACK

;<BR>

27&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;perl_call_pv(&quot;Csubstr&quot;,

G_SCALAR);<BR>

28&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;SPAGAIN

;<BR>

29&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;printf

(&quot;The substring is %s\n&quot;,(char *)POPp) ;<BR>

30&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;PUTBACK

;<BR>

31&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;FREETMPS

;<BR>

32&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;LEAVE

;<BR>

33&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;}</FONT></TT>

</BLOCKQUOTE>

<HR>

<P>

The function <TT><FONT FACE="Courier">Csubstr</FONT></TT> calls

the Perl <TT><FONT FACE="Courier">substr()</FONT></TT> as shown

here:

<BLOCKQUOTE>

<TT><FONT FACE="Courier">sub Csubstr {<BR>

&nbsp;&nbsp;&nbsp;&nbsp;my ($s,$o,$l) = @_;<BR>

&nbsp;&nbsp;&nbsp;&nbsp;return substr($s,$o,$l);<BR>

&nbsp;&nbsp;&nbsp;&nbsp;}</FONT></TT>

</BLOCKQUOTE>

<P>

The value of the <TT><FONT FACE="Courier">substr()</FONT></TT>

function call is returned back from the subroutine call. It's

this returned value that is used in the C program.

<H2><A NAME="ReturningListsfromSubroutines"><B><FONT SIZE=5 COLOR=#FF0000>Returning

Lists from Subroutines</FONT></B></A></H2>

<P>

Many Perl functions return lists as their results. C programs

can retrieve these values as well. Here's a simple Perl function

that returns the ratio of two numbers. (See Listing 26.8.) The

C program to call this function is shown in Listing 26.9.

<HR>

<BLOCKQUOTE>

<B>Listing 26.8. Ratio of numbers in a Perl function.<BR>

</B>

</BLOCKQUOTE>

<BLOCKQUOTE>

<TT><FONT FACE="Courier">&nbsp;1 sub GetRatio<BR>

&nbsp;2 {<BR>

&nbsp;3&nbsp;&nbsp;&nbsp;&nbsp;my($a, $b) = @_ ;<BR>

&nbsp;4 my $c, $d;<BR>

&nbsp;5 if ($a == 0) { $c = 1; $d = 0; }<BR>

&nbsp;6 elsif ($b == 0) { $c = 0; $d = 1; }<BR>

&nbsp;7 else {<BR>

&nbsp;8&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$c = $a/$b;<BR>

&nbsp;9&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;$d = $b/$a; 

<BR>

10&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;} <BR>

11 ($c,$d);<BR>

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -