Commit | Line | Data |
2304df62 |
1 | #!./miniperl |
a0d0e21e |
2 | 'di '; |
3 | 'ds 00 \"'; |
4 | 'ig 00 '; |
93a17b20 |
5 | # $Header$ |
6 | |
a0d0e21e |
7 | $usage = "Usage: xsubpp [-C++] [-except] [-typemap typemap] file.xs\n"; |
93a17b20 |
8 | |
8990e307 |
9 | SWITCH: while ($ARGV[0] =~ s/^-//) { |
93a17b20 |
10 | $flag = shift @ARGV; |
8990e307 |
11 | $spat = shift, next SWITCH if $flag eq 's'; |
12 | $cplusplus = 1, next SWITCH if $flag eq 'C++'; |
13 | $except = 1, next SWITCH if $flag eq 'except'; |
14 | push(@tm,shift), next SWITCH if $flag eq 'typemap'; |
93a17b20 |
15 | die $usage; |
16 | } |
8990e307 |
17 | @ARGV == 1 or die $usage; |
18 | chop($pwd = `pwd`); |
19 | ($dir, $filename) = @ARGV[0] =~ m#(.*)/(.*)# |
a0d0e21e |
20 | or ($dir, $filename) = @ARGV[0] =~ m#(.*[>\]])(.*)# |
8990e307 |
21 | or ($dir, $filename) = ('.', $ARGV[0]); |
22 | chdir($dir); |
93a17b20 |
23 | |
24 | $typemap = shift @ARGV; |
8990e307 |
25 | foreach $typemap (@tm) { |
26 | die "Can't find $typemap in $pwd\n" unless -r $typemap; |
93a17b20 |
27 | } |
8990e307 |
28 | unshift @tm, qw(../../../typemap ../../typemap ../typemap typemap); |
29 | foreach $typemap (@tm) { |
30 | open(TYPEMAP, $typemap) || next; |
31 | $mode = Typemap; |
32 | $current = \$junk; |
33 | while (<TYPEMAP>) { |
34 | next if /^#/; |
35 | if (/^INPUT\s*$/) { $mode = Input, next } |
36 | if (/^OUTPUT\s*$/) { $mode = Output, next } |
37 | if (/^TYPEMAP\s*$/) { $mode = Typemap, next } |
38 | if ($mode eq Typemap) { |
39 | chop; |
40 | ($typename, $kind) = split(/\t+/, $_, 2); |
41 | $type_kind{$typename} = $kind if $kind ne ''; |
463ee0b2 |
42 | } |
8990e307 |
43 | elsif ($mode eq Input) { |
44 | if (/^\s/) { |
45 | $$current .= $_; |
46 | } |
47 | else { |
48 | s/\s*$//; |
a0d0e21e |
49 | $input_expr{$_} = ''; |
8990e307 |
50 | $current = \$input_expr{$_}; |
51 | } |
93a17b20 |
52 | } |
8990e307 |
53 | else { |
54 | if (/^\s/) { |
55 | $$current .= $_; |
56 | } |
57 | else { |
58 | s/\s*$//; |
a0d0e21e |
59 | $output_expr{$_} = ''; |
8990e307 |
60 | $current = \$output_expr{$_}; |
61 | } |
93a17b20 |
62 | } |
8990e307 |
63 | } |
64 | close(TYPEMAP); |
65 | } |
93a17b20 |
66 | |
8990e307 |
67 | foreach $key (keys %input_expr) { |
68 | $input_expr{$key} =~ s/\n+$//; |
69 | } |
93a17b20 |
70 | |
8990e307 |
71 | sub Q { |
72 | local $text = shift; |
73 | $text =~ tr/#//d; |
2304df62 |
74 | $text =~ s/\[\[/{/g; |
75 | $text =~ s/\]\]/}/g; |
8990e307 |
76 | $text; |
93a17b20 |
77 | } |
78 | |
8990e307 |
79 | open(F, $filename) || die "cannot open $filename\n"; |
80 | |
93a17b20 |
81 | while (<F>) { |
a0d0e21e |
82 | last if ($Module, $foo, $Package, $foo1, $Prefix) = |
83 | /^MODULE\s*=\s*([\w:]+)(\s+PACKAGE\s*=\s*([\w:]+))?(\s+PREFIX\s*=\s*(\S+))?\s*$/; |
84 | print $_; |
93a17b20 |
85 | } |
2304df62 |
86 | exit 0 if $_ eq ""; |
87 | $lastline = $_; |
93a17b20 |
88 | |
2304df62 |
89 | sub fetch_para { |
90 | # parse paragraph |
91 | @line = (); |
92 | if ($lastline ne "") { |
93 | if ($lastline =~ |
a0d0e21e |
94 | /^MODULE\s*=\s*([\w:]+)(\s+PACKAGE\s*=\s*([\w:]+))?(\s+PREFIX\s*=\s*(\S+))?\s*$/) { |
2304df62 |
95 | $Module = $1; |
96 | $foo = $2; |
97 | $Package = $3; |
98 | $foo1 = $4; |
99 | $Prefix = $5; |
a0d0e21e |
100 | ($Module_cname = $Module) =~ s/\W/_/g; |
2304df62 |
101 | ($Packid = $Package) =~ s/:/_/g; |
102 | $Packprefix = $Package; |
103 | $Packprefix .= "::" if defined $Packprefix && $Packprefix ne ""; |
104 | while (<F>) { |
105 | chop; |
a0d0e21e |
106 | next if /^#/ && |
107 | !/^#[ \t]*(if|ifdef|ifndef|else|elif|endif|define|undef)\b/; |
2304df62 |
108 | last if /^\S/; |
109 | } |
110 | push(@line, $_) if $_ ne ""; |
93a17b20 |
111 | } |
2304df62 |
112 | else { |
113 | push(@line, $lastline); |
93a17b20 |
114 | } |
2304df62 |
115 | $lastline = ""; |
116 | while (<F>) { |
a0d0e21e |
117 | next if /^#/ && |
118 | !/^#[ \t]*(if|ifdef|ifndef|else|elif|endif|define|undef)\b/; |
2304df62 |
119 | chop; |
120 | if (/^\S/ && @line && $line[-1] eq "") { |
121 | $lastline = $_; |
122 | last; |
123 | } |
124 | else { |
125 | push(@line, $_); |
126 | } |
93a17b20 |
127 | } |
a0d0e21e |
128 | pop(@line) while @line && $line[-1] =~ /^\s*$/; |
2304df62 |
129 | } |
a0d0e21e |
130 | $PPCODE = grep(/PPCODE:/, @line); |
2304df62 |
131 | scalar @line; |
132 | } |
93a17b20 |
133 | |
2304df62 |
134 | while (&fetch_para) { |
135 | # initialize info arrays |
136 | undef(%args_match); |
137 | undef(%var_types); |
138 | undef(%var_addr); |
139 | undef(%defaults); |
140 | undef($class); |
141 | undef($static); |
142 | undef($elipsis); |
143 | |
144 | # extract return type, function name and arguments |
145 | $ret_type = shift(@line); |
a0d0e21e |
146 | if ($ret_type =~ /^BOOT:/) { |
147 | push (@BootCode, @line, "", "") ; |
148 | next ; |
149 | } |
2304df62 |
150 | if ($ret_type =~ /^static\s+(.*)$/) { |
151 | $static = 1; |
152 | $ret_type = $1; |
153 | } |
154 | $func_header = shift(@line); |
155 | ($func_name, $orig_args) = $func_header =~ /^([\w:]+)\s*\((.*)\)$/; |
156 | if ($func_name =~ /(.*)::(.*)/) { |
157 | $class = $1; |
158 | $func_name = $2; |
159 | } |
160 | ($pname = $func_name) =~ s/^($Prefix)?/$Packprefix/; |
161 | push(@Func_name, "${Packid}_$func_name"); |
162 | push(@Func_pname, $pname); |
163 | @args = split(/\s*,\s*/, $orig_args); |
a0d0e21e |
164 | if (defined($class)) { |
165 | if (defined($static)) { |
166 | unshift(@args, "CLASS"); |
167 | $orig_args = "CLASS, $orig_args"; |
168 | $orig_args =~ s/^CLASS, $/CLASS/; |
169 | } |
170 | else { |
2304df62 |
171 | unshift(@args, "THIS"); |
172 | $orig_args = "THIS, $orig_args"; |
173 | $orig_args =~ s/^THIS, $/THIS/; |
a0d0e21e |
174 | } |
2304df62 |
175 | } |
176 | $orig_args =~ s/"/\\"/g; |
177 | $min_args = $num_args = @args; |
178 | foreach $i (0..$num_args-1) { |
179 | if ($args[$i] =~ s/\.\.\.//) { |
180 | $elipsis = 1; |
181 | $min_args--; |
182 | if ($args[i] eq '' && $i == $num_args - 1) { |
183 | pop(@args); |
184 | last; |
185 | } |
186 | } |
187 | if ($args[$i] =~ /([^=]*\S)\s*=\s*(.*)/) { |
188 | $min_args--; |
189 | $args[$i] = $1; |
190 | $defaults{$args[$i]} = $2; |
191 | $defaults{$args[$i]} =~ s/"/\\"/g; |
192 | } |
193 | } |
a0d0e21e |
194 | if (defined($class)) { |
2304df62 |
195 | $func_args = join(", ", @args[1..$#args]); |
196 | } else { |
197 | $func_args = join(", ", @args); |
198 | } |
199 | @args_match{@args} = 1..@args; |
200 | |
201 | # print function header |
a0d0e21e |
202 | print Q<<"EOF"; |
203 | #XS(XS_${Packid}_$func_name) |
2304df62 |
204 | #[[ |
a0d0e21e |
205 | # dXSARGS; |
93a17b20 |
206 | EOF |
2304df62 |
207 | if ($elipsis) { |
208 | $cond = qq(items < $min_args); |
209 | } |
210 | elsif ($min_args == $num_args) { |
211 | $cond = qq(items != $min_args); |
212 | } |
213 | else { |
214 | $cond = qq(items < $min_args || items > $num_args); |
215 | } |
8990e307 |
216 | |
2304df62 |
217 | print Q<<"EOF" if $except; |
218 | # char errbuf[1024]; |
219 | # *errbuf = '\0'; |
220 | EOF |
221 | |
222 | print Q<<"EOF"; |
8990e307 |
223 | # if ($cond) { |
224 | # croak("Usage: $pname($orig_args)"); |
225 | # } |
93a17b20 |
226 | EOF |
227 | |
a0d0e21e |
228 | print Q<<"EOF" if $PPCODE; |
229 | # SP -= items; |
230 | EOF |
231 | |
2304df62 |
232 | # Now do a block of some sort. |
93a17b20 |
233 | |
2304df62 |
234 | $condnum = 0; |
235 | if (!@line) { |
236 | @line = "CLEANUP:"; |
237 | } |
238 | while (@line) { |
93a17b20 |
239 | if ($_[0] =~ s/^\s*CASE\s*:\s*//) { |
2304df62 |
240 | $cond = shift(@line); |
241 | if ($condnum == 0) { |
242 | print " if ($cond)\n"; |
243 | } |
244 | elsif ($cond ne '') { |
245 | print " else if ($cond)\n"; |
246 | } |
247 | else { |
248 | print " else\n"; |
249 | } |
250 | $condnum++; |
93a17b20 |
251 | } |
252 | |
8990e307 |
253 | if ($except) { |
254 | print Q<<"EOF"; |
2304df62 |
255 | # TRY [[ |
93a17b20 |
256 | EOF |
8990e307 |
257 | } |
258 | else { |
259 | print Q<<"EOF"; |
2304df62 |
260 | # [[ |
93a17b20 |
261 | EOF |
8990e307 |
262 | } |
93a17b20 |
263 | |
264 | # do initialization of input variables |
265 | $thisdone = 0; |
266 | $retvaldone = 0; |
463ee0b2 |
267 | $deferred = ""; |
2304df62 |
268 | while (@line) { |
269 | $_ = shift(@line); |
93a17b20 |
270 | last if /^\s*NOT_IMPLEMENTED_YET/; |
2304df62 |
271 | last if /^\s*(PPCODE|CODE|OUTPUT|CLEANUP|CASE)\s*:/; |
a0d0e21e |
272 | # Catch common error. Much more error checking required here. |
273 | blurt("Error: no tab in $pname argument declaration '$_'\n") |
274 | unless (m/\S+\s*\t\s*\S+/); |
93a17b20 |
275 | ($var_type, $var_name, $var_init) = |
276 | /\s*([^\t]+)\s*([^\s=]+)\s*(=.*)?/; |
277 | if ($var_name =~ /^&/) { |
278 | $var_name =~ s/^&//; |
279 | $var_addr{$var_name} = 1; |
280 | } |
281 | $thisdone |= $var_name eq "THIS"; |
282 | $retvaldone |= $var_name eq "RETVAL"; |
283 | $var_types{$var_name} = $var_type; |
284 | print "\t" . &map_type($var_type); |
285 | $var_num = $args_match{$var_name}; |
286 | if ($var_addr{$var_name}) { |
287 | $func_args =~ s/\b($var_name)\b/&\1/; |
288 | } |
289 | if ($var_init !~ /^=\s*NO_INIT\s*$/) { |
290 | if ($var_init !~ /^\s*$/) { |
291 | &output_init($var_type, $var_num, |
292 | "$var_name $var_init"); |
293 | } elsif ($var_num) { |
294 | # generate initialization code |
295 | &generate_init($var_type, $var_num, $var_name); |
296 | } else { |
297 | print ";\n"; |
298 | } |
299 | } else { |
300 | print "\t$var_name;\n"; |
301 | } |
302 | } |
a0d0e21e |
303 | if (!$thisdone && defined($class)) { |
304 | if (defined($static)) { |
305 | print "\tchar *"; |
306 | $var_types{"CLASS"} = "char *"; |
307 | &generate_init("char *", 1, "CLASS"); |
308 | } |
309 | else { |
93a17b20 |
310 | print "\t$class *"; |
311 | $var_types{"THIS"} = "$class *"; |
312 | &generate_init("$class *", 1, "THIS"); |
a0d0e21e |
313 | } |
93a17b20 |
314 | } |
315 | |
316 | # do code |
317 | if (/^\s*NOT_IMPLEMENTED_YET/) { |
463ee0b2 |
318 | print "\ncroak(\"$pname: not implemented yet\");\n"; |
93a17b20 |
319 | } else { |
320 | if ($ret_type ne "void") { |
321 | print "\t" . &map_type($ret_type) . "\tRETVAL;\n" |
322 | if !$retvaldone; |
323 | $args_match{"RETVAL"} = 0; |
324 | $var_types{"RETVAL"} = $ret_type; |
325 | } |
2304df62 |
326 | if (/^\s*PPCODE:/) { |
2304df62 |
327 | print $deferred; |
328 | while (@line) { |
329 | $_ = shift(@line); |
a0d0e21e |
330 | die "PPCODE must be last thing" |
331 | if /^\s*(OUTPUT|CLEANUP|CASE)\s*:/; |
2304df62 |
332 | print "$_\n"; |
333 | } |
a0d0e21e |
334 | print "\tPUTBACK;\n\treturn;\n"; |
2304df62 |
335 | } elsif (/^\s*CODE:/) { |
336 | print $deferred; |
337 | while (@line) { |
338 | $_ = shift(@line); |
93a17b20 |
339 | last if /^\s*(OUTPUT|CLEANUP|CASE)\s*:/; |
340 | print "$_\n"; |
341 | } |
a0d0e21e |
342 | } elsif ($func_name eq "DESTROY") { |
343 | print $deferred; |
344 | print "\n\t"; |
345 | print "delete THIS;\n" |
93a17b20 |
346 | } else { |
2304df62 |
347 | print $deferred; |
93a17b20 |
348 | print "\n\t"; |
349 | if ($ret_type ne "void") { |
463ee0b2 |
350 | print "RETVAL = "; |
93a17b20 |
351 | } |
352 | if (defined($static)) { |
a0d0e21e |
353 | if ($func_name =~ /^new/) { |
354 | $func_name = "$class"; |
355 | } |
356 | else { |
93a17b20 |
357 | print "$class::"; |
a0d0e21e |
358 | } |
93a17b20 |
359 | } elsif (defined($class)) { |
360 | print "THIS->"; |
361 | } |
362 | if (defined($spat) && $func_name =~ /^($spat)(.*)$/) { |
363 | $func_name = $2; |
364 | } |
365 | print "$func_name($func_args);\n"; |
366 | &generate_output($ret_type, 0, "RETVAL") |
367 | unless $ret_type eq "void"; |
368 | } |
369 | } |
370 | |
371 | # do output variables |
372 | if (/^\s*OUTPUT\s*:/) { |
2304df62 |
373 | while (@line) { |
374 | $_ = shift(@line); |
93a17b20 |
375 | last if /^\s*CLEANUP\s*:/; |
376 | s/^\s+//; |
377 | ($outarg, $outcode) = split(/\t+/); |
378 | if ($outcode) { |
a0d0e21e |
379 | print "\t$outcode\n"; |
93a17b20 |
380 | } else { |
381 | die "$outarg not an argument" |
382 | unless defined($args_match{$outarg}); |
383 | $var_num = $args_match{$outarg}; |
384 | &generate_output($var_types{$outarg}, $var_num, |
385 | $outarg); |
386 | } |
387 | } |
388 | } |
389 | # do cleanup |
390 | if (/^\s*CLEANUP\s*:/) { |
2304df62 |
391 | while (@line) { |
392 | $_ = shift(@line); |
93a17b20 |
393 | last if /^\s*CASE\s*:/; |
394 | print "$_\n"; |
395 | } |
396 | } |
397 | # print function trailer |
8990e307 |
398 | if ($except) { |
399 | print Q<<EOF; |
2304df62 |
400 | # ]] |
8990e307 |
401 | # BEGHANDLERS |
402 | # CATCHALL |
403 | # sprintf(errbuf, "%s: %s\\tpropagated", Xname, Xreason); |
404 | # ENDHANDLERS |
93a17b20 |
405 | EOF |
8990e307 |
406 | } |
407 | else { |
408 | print Q<<EOF; |
2304df62 |
409 | # ]] |
93a17b20 |
410 | EOF |
8990e307 |
411 | } |
93a17b20 |
412 | if (/^\s*CASE\s*:/) { |
8990e307 |
413 | unshift(@line, $_); |
93a17b20 |
414 | } |
2304df62 |
415 | } |
a0d0e21e |
416 | |
2304df62 |
417 | print Q<<EOF if $except; |
418 | # if (errbuf[0]) |
419 | # croak(errbuf); |
420 | EOF |
a0d0e21e |
421 | |
422 | print Q<<EOF unless $PPCODE; |
423 | # XSRETURN(1); |
424 | EOF |
425 | |
2304df62 |
426 | print Q<<EOF; |
2304df62 |
427 | #]] |
8990e307 |
428 | # |
93a17b20 |
429 | EOF |
430 | } |
431 | |
432 | # print initialization routine |
8990e307 |
433 | print qq/extern "C"\n/ if $cplusplus; |
434 | print Q<<"EOF"; |
a0d0e21e |
435 | #XS(boot_$Module_cname) |
2304df62 |
436 | #[[ |
a0d0e21e |
437 | # dXSARGS; |
8990e307 |
438 | # char* file = __FILE__; |
439 | # |
93a17b20 |
440 | EOF |
441 | |
442 | for (@Func_name) { |
2304df62 |
443 | $pname = shift(@Func_pname); |
a0d0e21e |
444 | print " newXS(\"$pname\", XS_$_, file);\n"; |
445 | } |
446 | |
447 | if (@BootCode) |
448 | { |
449 | print "\n /* Initialisation Section */\n\n" ; |
450 | print grep (s/$/\n/, @BootCode) ; |
451 | print " /* End of Initialisation Section */\n\n" ; |
93a17b20 |
452 | } |
a0d0e21e |
453 | |
454 | print " ST(0) = &sv_yes;\n"; |
455 | print " XSRETURN(1);\n"; |
93a17b20 |
456 | print "}\n"; |
457 | |
458 | sub output_init { |
2304df62 |
459 | local($type, $num, $init) = @_; |
a0d0e21e |
460 | local($arg) = "ST(" . ($num - 1) . ")"; |
93a17b20 |
461 | |
2304df62 |
462 | eval qq/print " $init\\\n"/; |
93a17b20 |
463 | } |
464 | |
8990e307 |
465 | sub blurt { warn @_; $errors++ } |
466 | |
93a17b20 |
467 | sub generate_init { |
2304df62 |
468 | local($type, $num, $var) = @_; |
a0d0e21e |
469 | local($arg) = "ST(" . ($num - 1) . ")"; |
2304df62 |
470 | local($argoff) = $num - 1; |
471 | local($ntype); |
472 | local($tk); |
93a17b20 |
473 | |
2304df62 |
474 | blurt("$type not in typemap"), return unless defined($type_kind{$type}); |
475 | ($ntype = $type) =~ s/\s*\*/Ptr/g; |
476 | $subtype = $ntype; |
477 | $subtype =~ s/Ptr$//; |
478 | $subtype =~ s/Array$//; |
479 | $tk = $type_kind{$type}; |
480 | $tk =~ s/OBJ$/REF/ if $func_name =~ /DESTROY$/; |
481 | $type =~ s/:/_/g; |
482 | $expr = $input_expr{$tk}; |
483 | if ($expr =~ /DO_ARRAY_ELEM/) { |
484 | $subexpr = $input_expr{$type_kind{$subtype}}; |
485 | $subexpr =~ s/ntype/subtype/g; |
486 | $subexpr =~ s/\$arg/ST(ix_$var)/g; |
487 | $subexpr =~ s/\n\t/\n\t\t/g; |
488 | $subexpr =~ s/is not of (.*")/[arg %d] is not of $1, ix_$var + 1/g; |
a0d0e21e |
489 | $subexpr =~ s/\$var/${var}[ix_$var - $argoff]/; |
2304df62 |
490 | $expr =~ s/DO_ARRAY_ELEM/$subexpr/; |
491 | } |
492 | if (defined($defaults{$var})) { |
493 | $expr =~ s/(\t+)/$1 /g; |
494 | $expr =~ s/ /\t/g; |
495 | eval qq/print "\\t$var;\\n"/; |
496 | $deferred .= eval qq/"\\n\\tif (items < $num)\\n\\t $var = $defaults{$var};\\n\\telse {\\n$expr;\\n\\t}\\n"/; |
497 | } elsif ($expr !~ /^\t\$var =/) { |
498 | eval qq/print "\\t$var;\\n"/; |
499 | $deferred .= eval qq/"\\n$expr;\\n"/; |
500 | } else { |
501 | eval qq/print "$expr;\\n"/; |
502 | } |
93a17b20 |
503 | } |
504 | |
505 | sub generate_output { |
2304df62 |
506 | local($type, $num, $var) = @_; |
a0d0e21e |
507 | local($arg) = "ST(" . ($num - ($num != 0)) . ")"; |
2304df62 |
508 | local($argoff) = $num - 1; |
509 | local($ntype); |
93a17b20 |
510 | |
2304df62 |
511 | if ($type =~ /^array\(([^,]*),(.*)\)/) { |
512 | print "\tsv_setpvn($arg, (char *)$var, $2 * sizeof($1)), XFree((char *)$var);\n"; |
513 | } else { |
514 | blurt("$type not in typemap"), return |
515 | unless defined($type_kind{$type}); |
516 | ($ntype = $type) =~ s/\s*\*/Ptr/g; |
517 | $ntype =~ s/\(\)//g; |
518 | $subtype = $ntype; |
519 | $subtype =~ s/Ptr$//; |
520 | $subtype =~ s/Array$//; |
521 | $expr = $output_expr{$type_kind{$type}}; |
522 | if ($expr =~ /DO_ARRAY_ELEM/) { |
523 | $subexpr = $output_expr{$type_kind{$subtype}}; |
524 | $subexpr =~ s/ntype/subtype/g; |
525 | $subexpr =~ s/\$arg/ST(ix_$var)/g; |
526 | $subexpr =~ s/\$var/${var}[ix_$var]/g; |
527 | $subexpr =~ s/\n\t/\n\t\t/g; |
528 | $expr =~ s/DO_ARRAY_ELEM\n/$subexpr/; |
a0d0e21e |
529 | eval "print qq\a$expr\a"; |
2304df62 |
530 | } |
a0d0e21e |
531 | elsif ($var eq 'RETVAL') { |
2304df62 |
532 | if ($expr =~ /^\t\$arg = /) { |
a0d0e21e |
533 | eval "print qq\a$expr\a"; |
2304df62 |
534 | print "\tsv_2mortal(ST(0));\n"; |
93a17b20 |
535 | } |
2304df62 |
536 | else { |
8990e307 |
537 | print "\tST(0) = sv_newmortal();\n"; |
a0d0e21e |
538 | eval "print qq\a$expr\a"; |
463ee0b2 |
539 | } |
2304df62 |
540 | } |
a0d0e21e |
541 | elsif ($arg =~ /^ST\(\d+\)$/) { |
542 | eval "print qq\a$expr\a"; |
543 | } |
544 | elsif ($arg =~ /^ST\(\d+\)$/) { |
545 | eval "print qq\a$expr\a"; |
546 | } |
547 | elsif ($arg =~ /^ST\(\d+\)$/) { |
548 | eval "print qq\a$expr\a"; |
549 | } |
2304df62 |
550 | } |
93a17b20 |
551 | } |
552 | |
553 | sub map_type { |
2304df62 |
554 | local($type) = @_; |
93a17b20 |
555 | |
2304df62 |
556 | $type =~ s/:/_/g; |
557 | if ($type =~ /^array\(([^,]*),(.*)\)/) { |
558 | return "$1 *"; |
559 | } else { |
560 | return $type; |
561 | } |
93a17b20 |
562 | } |
8990e307 |
563 | |
564 | exit $errors; |
a0d0e21e |
565 | |
566 | ############################################################################## |
567 | |
568 | # These next few lines are legal in both Perl and nroff. |
569 | |
570 | .00 ; # finish .ig |
571 | |
572 | 'di \" finish diversion--previous line must be blank |
573 | .nr nl 0-1 \" fake up transition to first page again |
574 | .nr % 0 \" start at page 1 |
575 | '; __END__ ############# From here on it's a standard manual page ############ |
576 | .TH XSUBPP 1 "August 9, 1994" |
577 | .AT 3 |
578 | .SH NAME |
579 | xsubpp \- compiler to convert Perl XS code into C code |
580 | .SH SYNOPSIS |
581 | .B xsubpp [-C++] [-except] [-typemap typemap] file.xs |
582 | .SH DESCRIPTION |
583 | .I xsubpp |
584 | will compile XS code into C code by embedding the constructs necessary to |
585 | let C functions manipulate Perl values and creates the glue necessary to let |
586 | Perl access those functions. The compiler uses typemaps to determine how |
587 | to map C function parameters and variables to Perl values. |
588 | .PP |
589 | The compiler will search for typemap files called |
590 | .I typemap. |
591 | It will use the following search path to find default typemaps, with the |
592 | rightmost typemap taking precedence. |
593 | .br |
594 | .nf |
595 | ../../../typemap:../../typemap:../typemap:typemap |
596 | .fi |
597 | .SH OPTIONS |
598 | .TP |
599 | .B \-C++ |
600 | .br |
601 | Adds ``extern "C"'' to the C code. |
602 | .TP |
603 | .B \-except |
604 | Adds exception handling stubs to the C code. |
605 | .TP |
606 | .B \-typemap typemap |
607 | Indicates that a user-supplied typemap should take precedence over the |
608 | default typemaps. This option may be used multiple times, with the last |
609 | typemap having the highest precedence. |
610 | .SH ENVIRONMENT |
611 | No environment variables are used. |
612 | .SH AUTHOR |
613 | Larry Wall |
614 | .SH "SEE ALSO" |
615 | perl(1) |
616 | .ex |