This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
regen/embed.pl: flag 'i' didn't work with 'n'
[perl5.git] / regen / embed.pl
CommitLineData
5f05dabc 1#!/usr/bin/perl -w
6294c161
DM
2#
3# Regenerate (overwriting only if changed):
4#
5# embed.h
6# embedvar.h
6294c161
DM
7# perlapi.c
8# perlapi.h
9# proto.h
10#
11# from information stored in
12#
13# embed.fnc
14# intrpvar.h
15# perlvars.h
897d3989 16# regen/opcodes
6294c161 17#
6294c161
DM
18# Accepts the standard regen_lib -q and -v args.
19#
20# This script is normally invoked from regen.pl.
e50aee73 21
916e4025 22require 5.004; # keep this compatible, an old perl is all we may have before
954c1994 23 # we build the new one
5f05dabc 24
88e01c9d
AL
25use strict;
26
36bb303b
NC
27BEGIN {
28 # Get function prototypes
af001346 29 require 'regen/regen_lib.pl';
cdde42af 30 require 'regen/embed_lib.pl';
36bb303b
NC
31}
32
88e01c9d 33my $SPLINT = 0; # Turn true for experimental splint support http://www.splint.org
916e4025 34my $unflagged_pointers;
88e01c9d 35
cea2e8a9 36#
346f75ff 37# See database of global and static function prototypes in embed.fnc
cea2e8a9
GS
38# This is used to generate prototype headers under various configurations,
39# export symbols lists for different platforms, and macros to provide an
40# implicit interpreter context argument.
41#
42
5f8dc073 43sub open_print_header {
56fd1190 44 my ($file, $quote) = @_;
4373e329 45
5f8dc073
NC
46 return open_new($file, '>',
47 { file => $file, style => '*', by => 'regen/embed.pl',
48 from => ['data in embed.fnc', 'regen/embed.pl',
49 'regen/opcodes', 'intrpvar.h', 'perlvars.h'],
50 final => "\nEdit those files and run 'make regen_headers' to effect changes.\n",
51 copyright => [1993 .. 2009], quote => $quote });
52}
7f1be197 53
5ccbf88e
NC
54my ($embed, $core, $ext, $api) = setup_embed();
55
cea2e8a9 56# generate proto.h
9516dc40 57{
5f8dc073
NC
58 my $pr = open_print_header("proto.h");
59 print $pr "START_EXTERN_C\n";
f8394530 60 my $ret;
9516dc40 61
5ccbf88e 62 foreach (@$embed) {
9516dc40
NC
63 if (@$_ == 1) {
64 print $pr "$_->[0]\n";
65 next;
66 }
67
68 my ($flags,$retval,$plain_func,@args) = @$_;
4373e329
AL
69 my @nonnull;
70 my $has_context = ( $flags !~ /n/ );
88e01c9d
AL
71 my $never_returns = ( $flags =~ /r/ );
72 my $commented_out = ( $flags =~ /m/ );
aa4ca557 73 my $binarycompat = ( $flags =~ /b/ );
88e01c9d
AL
74 my $is_malloc = ( $flags =~ /a/ );
75 my $can_ignore = ( $flags !~ /R/ ) && !$is_malloc;
7918f24d
NC
76 my @names_of_nn;
77 my $func;
88e01c9d
AL
78
79 my $splint_flags = "";
80 if ( $SPLINT && !$commented_out ) {
81 $splint_flags .= '/*@noreturn@*/ ' if $never_returns;
82 if ($can_ignore && ($retval ne 'void') && ($retval !~ /\*/)) {
83 $retval .= " /*\@alt void\@*/";
84 }
85 }
86
71556506 87 if ($flags =~ /([si])/) {
98c015b7
DD
88 my $type;
89 if ($never_returns) {
90 $type = $1 eq 's' ? "PERL_STATIC_NO_RET" : "PERL_STATIC_INLINE_NO_RET";
91 }
92 else {
93 $type = $1 eq 's' ? "STATIC" : "PERL_STATIC_INLINE";
94 }
33e8a813 95 warn "$plain_func: i and s flags are mutually exclusive"
71556506
KW
96 if $flags =~ /s/ && $flags =~ /i/;
97 $retval = "$type $splint_flags$retval";
7918f24d 98 $func = "S_$plain_func";
cea2e8a9 99 }
0cb96387 100 else {
718fae11
JD
101 if ($never_returns) {
102 $retval = "PERL_CALLCONV_NO_RET $splint_flags$retval";
103 }
104 else {
105 $retval = "PERL_CALLCONV $splint_flags$retval";
106 }
107 if ($flags =~ /[bp]/) {
7918f24d 108 $func = "Perl_$plain_func";
718fae11
JD
109 }
110 else {
7918f24d 111 $func = $plain_func;
0cb96387 112 }
cea2e8a9 113 }
f8394530 114 $ret = "$retval\t$func(";
4373e329
AL
115 if ( $has_context ) {
116 $ret .= @args ? "pTHX_ " : "pTHX";
cea2e8a9
GS
117 }
118 if (@args) {
4373e329
AL
119 my $n;
120 for my $arg ( @args ) {
121 ++$n;
7827dc65
AL
122 if ( $arg =~ /\*/ && $arg !~ /\b(NN|NULLOK)\b/ ) {
123 warn "$func: $arg needs NN or NULLOK\n";
7827dc65
AL
124 ++$unflagged_pointers;
125 }
88e01c9d
AL
126 my $nn = ( $arg =~ s/\s*\bNN\b\s+// );
127 push( @nonnull, $n ) if $nn;
128
129 my $nullok = ( $arg =~ s/\s*\bNULLOK\b\s+// ); # strip NULLOK with no effect
c48640ec
AL
130
131 # Make sure each arg has at least a type and a var name.
132 # An arg of "int" is valid C, but want it to be "int foo".
133 my $temp_arg = $arg;
134 $temp_arg =~ s/\*//g;
135 $temp_arg =~ s/\s*\bstruct\b\s*/ /g;
7918f24d
NC
136 if ( ($temp_arg ne "...")
137 && ($temp_arg !~ /\w+\s+(\w+)(?:\[\d+\])?\s*$/) ) {
138 warn "$func: $arg ($n) doesn't have a name\n";
c48640ec 139 }
88e01c9d
AL
140 if ( $SPLINT && $nullok && !$commented_out ) {
141 $arg = '/*@null@*/ ' . $arg;
142 }
aa4ca557 143 if (defined $1 && $nn && !($commented_out && !$binarycompat)) {
7918f24d
NC
144 push @names_of_nn, $1;
145 }
4373e329 146 }
cea2e8a9
GS
147 $ret .= join ", ", @args;
148 }
149 else {
4373e329 150 $ret .= "void" if !$has_context;
cea2e8a9
GS
151 }
152 $ret .= ")";
f54cb97a
AL
153 my @attrs;
154 if ( $flags =~ /r/ ) {
abb2c242 155 push @attrs, "__attribute__noreturn__";
f54cb97a 156 }
a5c26493
RGS
157 if ( $flags =~ /D/ ) {
158 push @attrs, "__attribute__deprecated__";
159 }
88e01c9d 160 if ( $is_malloc ) {
abb2c242 161 push @attrs, "__attribute__malloc__";
f54cb97a 162 }
88e01c9d 163 if ( !$can_ignore ) {
abb2c242 164 push @attrs, "__attribute__warn_unused_result__";
f54cb97a
AL
165 }
166 if ( $flags =~ /P/ ) {
abb2c242 167 push @attrs, "__attribute__pure__";
f54cb97a 168 }
1c846c1f 169 if( $flags =~ /f/ ) {
cdfeb707
RB
170 my $prefix = $has_context ? 'pTHX_' : '';
171 my $args = scalar @args;
172 my $pat = $args - 1;
173 my $macro = @nonnull && $nonnull[-1] == $pat
174 ? '__attribute__format__'
175 : '__attribute__format__null_ok__';
176 push @attrs, sprintf "%s(__printf__,%s%d,%s%d)", $macro,
177 $prefix, $pat, $prefix, $args;
894356b3 178 }
4373e329 179 if ( @nonnull ) {
3d42dc86 180 my @pos = map { $has_context ? "pTHX_$_" : $_ } @nonnull;
abb2c242 181 push @attrs, map { sprintf( "__attribute__nonnull__(%s)", $_ ) } @pos;
f54cb97a
AL
182 }
183 if ( @attrs ) {
184 $ret .= "\n";
185 $ret .= join( "\n", map { "\t\t\t$_" } @attrs );
4373e329 186 }
af3c7592 187 $ret .= ";";
88e01c9d 188 $ret = "/* $ret */" if $commented_out;
7918f24d
NC
189 if (@names_of_nn) {
190 $ret .= "\n#define PERL_ARGS_ASSERT_\U$plain_func\E\t\\\n\t"
191 . join '; ', map "assert($_)", @names_of_nn;
192 }
f54cb97a 193 $ret .= @attrs ? "\n\n" : "\n";
9516dc40
NC
194
195 print $pr $ret;
cea2e8a9 196 }
9516dc40 197
897d3989
NC
198 print $pr <<'EOF';
199#ifdef PERL_CORE
200# include "pp_proto.h"
201#endif
202END_EXTERN_C
897d3989 203EOF
9516dc40 204
ce716c52 205 read_only_bottom_close_and_rename($pr);
cea2e8a9
GS
206}
207
7827dc65 208warn "$unflagged_pointers pointer arguments to clean up\n" if $unflagged_pointers;
cea2e8a9 209
adf34b4b
NC
210sub readvars {
211 my ($file, $pre) = @_;
d4cce5f1 212 local (*FILE, $_);
adf34b4b 213 my %seen;
d4cce5f1
NIS
214 open(FILE, "< $file")
215 or die "embed.pl: Can't open $file: $!\n";
216 while (<FILE>) {
217 s/[ \t]*#.*//; # Delete comments.
115ff745 218 if (/PERLVARA?I?C?\($pre,\s*(\w+)/) {
adf34b4b
NC
219 warn "duplicate symbol $1 while processing $file line $.\n"
220 if $seen{$1}++;
d4cce5f1
NIS
221 }
222 }
223 close(FILE);
adf34b4b 224 return sort keys %seen;
d4cce5f1
NIS
225}
226
adf34b4b
NC
227my @intrp = readvars 'intrpvar.h','I';
228my @globvar = readvars 'perlvars.h','G';
d4cce5f1 229
125218eb
NC
230sub hide {
231 my ($from, $to, $indent) = @_;
232 $indent = '' unless defined $indent;
233 my $t = int(length("$indent$from") / 8);
234 "#${indent}define $from" . "\t" x ($t < 3 ? 3 - $t : 1) . "$to\n";
5f05dabc 235}
c6af7a1a 236
d4cce5f1
NIS
237sub multon ($$$) {
238 my ($sym,$pre,$ptr) = @_;
3280af22 239 hide("PL_$sym", "($ptr$pre$sym)");
5f05dabc 240}
54aff467 241
5f8dc073 242my $em = open_print_header('embed.h');
e50aee73 243
5f8dc073 244print $em <<'END';
e50aee73
AD
245/* (Doing namespace management portably in C is really gross.) */
246
d51482e4
JH
247/* By defining PERL_NO_SHORT_NAMES (not done by default) the short forms
248 * (like warn instead of Perl_warn) for the API are not defined.
249 * Not defining the short forms is a good thing for cleaner embedding. */
250
251#ifndef PERL_NO_SHORT_NAMES
820c3be9 252
22c35a8c 253/* Hide global symbols */
5f05dabc 254
e50aee73
AD
255END
256
cea2e8a9
GS
257my @az = ('a'..'z');
258
e8a67806
NC
259sub embed_h {
260 my ($guard, $funcs) = @_;
261 print $em "$guard\n" if $guard;
262
2a4d8072 263 my $lines;
e8a67806
NC
264 foreach (@$funcs) {
265 if (@$_ == 1) {
266 my $cond = $_->[0];
267 # Indent the conditionals if we are wrapped in an #if/#endif pair.
268 $cond =~ s/#(.*)/# $1/ if $guard;
2a4d8072 269 $lines .= "$cond\n";
e8a67806
NC
270 next;
271 }
272 my $ret = "";
273 my ($flags,$retval,$func,@args) = @$_;
af3c7592 274 unless ($flags =~ /[om]/) {
cea2e8a9 275 my $args = scalar @args;
7a5a24f7 276 if ($flags =~ /n/) {
457a9a82 277 if ($flags =~ /[si]/) {
f8394530 278 $ret = hide($func,"S_$func");
cea2e8a9
GS
279 }
280 elsif ($flags =~ /p/) {
f8394530 281 $ret = hide($func,"Perl_$func");
cea2e8a9
GS
282 }
283 }
7a5a24f7 284 elsif ($args and $args[$args-1] =~ /\.\.\./) {
e64ca59f
NC
285 if ($flags =~ /p/) {
286 # we're out of luck for varargs functions under CPP
287 # So we can only do these macros for no implicit context:
288 $ret = "#ifndef PERL_IMPLICIT_CONTEXT\n"
289 . hide($func,"Perl_$func") . "#endif\n";
290 }
7a5a24f7 291 }
cea2e8a9
GS
292 else {
293 my $alist = join(",", @az[0..$args-1]);
294 $ret = "#define $func($alist)";
295 my $t = int(length($ret) / 8);
296 $ret .= "\t" x ($t < 4 ? 4 - $t : 1);
71556506 297 if ($flags =~ /[si]/) {
cea2e8a9
GS
298 $ret .= "S_$func(aTHX";
299 }
300 elsif ($flags =~ /p/) {
301 $ret .= "Perl_$func(aTHX";
302 }
303 $ret .= "_ " if $alist;
304 $ret .= $alist . ")\n";
305 }
306 }
2a4d8072 307 $lines .= $ret;
cea2e8a9 308 }
2a4d8072
NC
309 # Prune empty #if/#endif pairs.
310 while ($lines =~ s/#\s*if[^\n]+\n#\s*endif\n//) {
311 }
b2e549c0
NC
312 # Merge adjacent blocks.
313 while ($lines =~ s/(#ifndef PERL_IMPLICIT_CONTEXT
314[^\n]+
315)#endif
316#ifndef PERL_IMPLICIT_CONTEXT
317/$1/) {
318 }
319
2a4d8072 320 print $em $lines;
e8a67806 321 print $em "#endif\n" if $guard;
da4ddda1
NC
322}
323
5ccbf88e
NC
324embed_h('', $api);
325embed_h('#if defined(PERL_CORE) || defined(PERL_EXT)', $ext);
326embed_h('#ifdef PERL_CORE', $core);
e8a67806 327
424a4936 328print $em <<'END';
e50aee73 329
d51482e4 330#endif /* #ifndef PERL_NO_SHORT_NAMES */
35209cc8 331
cea2e8a9
GS
332/* Compatibility stubs. Compile extensions with -DPERL_NOCOMPAT to
333 disable them.
334 */
335
538feb02 336#if !defined(PERL_CORE)
5bc28da9 337# define sv_setptrobj(rv,ptr,name) sv_setref_iv(rv,name,PTR2IV(ptr))
a0714e2c 338# define sv_setptrref(rv,ptr) sv_setref_iv(rv,NULL,PTR2IV(ptr))
538feb02 339#endif
cea2e8a9 340
08e5223a 341#if !defined(PERL_CORE) && !defined(PERL_NOCOMPAT)
cea2e8a9
GS
342
343/* Compatibility for various misnamed functions. All functions
344 in the API that begin with "perl_" (not "Perl_") take an explicit
345 interpreter context pointer.
346 The following are not like that, but since they had a "perl_"
347 prefix in previous versions, we provide compatibility macros.
348 */
65cec589 349# define perl_atexit(a,b) call_atexit(a,b)
7b53c8ee
NC
350END
351
3a54c8e7
NC
352foreach (@$embed) {
353 my ($flags, $retval, $func, @args) = @$_;
354 next unless $func;
355 next unless $flags =~ /O/;
7b53c8ee
NC
356
357 my $alist = join ",", @az[0..$#args];
358 my $ret = "# define perl_$func($alist)";
359 my $t = (length $ret) >> 3;
360 $ret .= "\t" x ($t < 5 ? 5 - $t : 1);
3a54c8e7
NC
361 print $em "$ret$func($alist)\n";
362}
7b53c8ee 363
eacd26c2
NC
364my @nocontext;
365{
366 my (%has_va, %has_nocontext);
5ccbf88e 367 foreach (@$embed) {
eacd26c2
NC
368 next unless @$_ > 1;
369 ++$has_va{$_->[2]} if $_->[-1] =~ /\.\.\./;
370 ++$has_nocontext{$1} if $_->[2] =~ /(.*)_nocontext/;
371 }
372
373 @nocontext = sort grep {
374 $has_nocontext{$_}
375 && !/printf/ # Not clear to me why these are skipped but they are.
376 } keys %has_va;
377}
378
7b53c8ee 379print $em <<'END';
cea2e8a9
GS
380
381/* varargs functions can't be handled with CPP macros. :-(
382 This provides a set of compatibility functions that don't take
383 an extra argument but grab the context pointer using the macro
384 dTHX.
385 */
d51482e4 386#if defined(PERL_IMPLICIT_CONTEXT) && !defined(PERL_NO_SHORT_NAMES)
125218eb
NC
387END
388
eacd26c2 389foreach (@nocontext) {
125218eb
NC
390 print $em hide($_, "Perl_${_}_nocontext", " ");
391}
392
393print $em <<'END';
cea2e8a9
GS
394#endif
395
396#endif /* !defined(PERL_CORE) && !defined(PERL_NOCOMPAT) */
397
398#if !defined(PERL_IMPLICIT_CONTEXT)
399/* undefined symbols, point them back at the usual ones */
125218eb
NC
400END
401
eacd26c2 402foreach (@nocontext) {
125218eb
NC
403 print $em hide("Perl_${_}_nocontext", "Perl_$_", " ");
404}
405
406print $em <<'END';
cea2e8a9 407#endif
d4cce5f1
NIS
408END
409
ce716c52 410read_only_bottom_close_and_rename($em);
d4cce5f1 411
5f8dc073 412$em = open_print_header('embedvar.h');
d4cce5f1 413
5f8dc073 414print $em <<'END';
d4cce5f1
NIS
415/* (Doing namespace management portably in C is really gross.) */
416
54aff467 417/*
3db8f154
MB
418 The following combinations of MULTIPLICITY and PERL_IMPLICIT_CONTEXT
419 are supported:
54aff467
GS
420 1) none
421 2) MULTIPLICITY # supported for compatibility
422 3) MULTIPLICITY && PERL_IMPLICIT_CONTEXT
54aff467
GS
423
424 All other combinations of these flags are errors.
425
3db8f154 426 only #3 is supported directly, while #2 is a special
54aff467
GS
427 case of #3 (supported by redefining vTHX appropriately).
428*/
cea2e8a9 429
54aff467 430#if defined(MULTIPLICITY)
3db8f154 431/* cases 2 and 3 above */
cea2e8a9 432
54aff467
GS
433# if defined(PERL_IMPLICIT_CONTEXT)
434# define vTHX aTHX
435# else
436# define vTHX PERL_GET_INTERP
437# endif
cea2e8a9 438
e50aee73
AD
439END
440
adf34b4b
NC
441my $sym;
442
443for $sym (@intrp) {
424a4936 444 print $em multon($sym,'I','vTHX->');
d4cce5f1
NIS
445}
446
424a4936 447print $em <<'END';
d4cce5f1 448
54aff467 449#endif /* MULTIPLICITY */
d4cce5f1 450
54aff467 451#if defined(PERL_GLOBAL_STRUCT)
22239a37
NIS
452
453END
454
adf34b4b 455for $sym (@globvar) {
0447859b 456 print $em "#ifdef OS2\n" if $sym eq 'sh_path';
424a4936
NC
457 print $em multon($sym, 'G','my_vars->');
458 print $em multon("G$sym",'', 'my_vars->');
0447859b 459 print $em "#endif\n" if $sym eq 'sh_path';
22239a37
NIS
460}
461
424a4936 462print $em <<'END';
22239a37 463
22239a37 464#endif /* PERL_GLOBAL_STRUCT */
84fee439
NIS
465END
466
ce716c52 467read_only_bottom_close_and_rename($em);
c6af7a1a 468
5f8dc073 469my $capih = open_print_header('perlapi.h');
51371543 470
5f8dc073 471print $capih <<'EOT';
51371543 472/* declare accessor functions for Perl variables */
6f4183fe
GS
473#ifndef __perlapi_h__
474#define __perlapi_h__
51371543 475
87b9e160 476#if defined (MULTIPLICITY) && defined (PERL_GLOBAL_STRUCT)
c5be433b 477
51371543
GS
478START_EXTERN_C
479
480#undef PERLVAR
481#undef PERLVARA
482#undef PERLVARI
483#undef PERLVARIC
115ff745
NC
484#define PERLVAR(p,v,t) EXTERN_C t* Perl_##p##v##_ptr(pTHX);
485#define PERLVARA(p,v,n,t) typedef t PL_##v##_t[n]; \
486 EXTERN_C PL_##v##_t* Perl_##p##v##_ptr(pTHX);
487#define PERLVARI(p,v,t,i) PERLVAR(p,v,t)
488#define PERLVARIC(p,v,t,i) PERLVAR(p,v, const t)
51371543 489
51371543
GS
490#include "perlvars.h"
491
492#undef PERLVAR
493#undef PERLVARA
494#undef PERLVARI
495#undef PERLVARIC
27da23d5 496
51371543
GS
497END_EXTERN_C
498
682fc664 499#if defined(PERL_CORE)
6f4183fe 500
87b9e160 501/* accessor functions for Perl "global" variables */
682fc664
GS
502
503/* these need to be mentioned here, or most linkers won't put them in
504 the perl executable */
505
506#ifndef PERL_NO_FORCE_LINK
507
508START_EXTERN_C
509
510#ifndef DOINIT
27da23d5 511EXTCONST void * const PL_force_link_funcs[];
682fc664 512#else
27da23d5 513EXTCONST void * const PL_force_link_funcs[] = {
682fc664
GS
514#undef PERLVAR
515#undef PERLVARA
516#undef PERLVARI
517#undef PERLVARIC
115ff745
NC
518#define PERLVAR(p,v,t) (void*)Perl_##p##v##_ptr,
519#define PERLVARA(p,v,n,t) PERLVAR(p,v,t)
520#define PERLVARI(p,v,t,i) PERLVAR(p,v,t)
521#define PERLVARIC(p,v,t,i) PERLVAR(p,v,t)
682fc664 522
3c0f78ca
JH
523/* In Tru64 (__DEC && __osf__) the cc option -std1 causes that one
524 * cannot cast between void pointers and function pointers without
525 * info level warnings. The PL_force_link_funcs[] would cause a few
526 * hundred of those warnings. In code one can circumnavigate this by using
527 * unions that overlay the different pointers, but in declarations one
528 * cannot use this trick. Therefore we just disable the warning here
529 * for the duration of the PL_force_link_funcs[] declaration. */
530
531#if defined(__DECC) && defined(__osf__)
532#pragma message save
533#pragma message disable (nonstandcast)
534#endif
535
682fc664
GS
536#include "perlvars.h"
537
3c0f78ca
JH
538#if defined(__DECC) && defined(__osf__)
539#pragma message restore
540#endif
541
682fc664
GS
542#undef PERLVAR
543#undef PERLVARA
544#undef PERLVARI
545#undef PERLVARIC
546};
547#endif /* DOINIT */
548
acfe0abc 549END_EXTERN_C
682fc664
GS
550
551#endif /* PERL_NO_FORCE_LINK */
552
553#else /* !PERL_CORE */
51371543
GS
554
555EOT
556
adf34b4b 557foreach $sym (@globvar) {
5f9c6535
NC
558 print $capih
559 "#undef PL_$sym\n" . hide("PL_$sym", "(*Perl_G${sym}_ptr(NULL))");
6f4183fe
GS
560}
561
424a4936 562print $capih <<'EOT';
6f4183fe
GS
563
564#endif /* !PERL_CORE */
87b9e160 565#endif /* MULTIPLICITY && PERL_GLOBAL_STRUCT */
6f4183fe
GS
566
567#endif /* __perlapi_h__ */
6f4183fe 568EOT
ce716c52
NC
569
570read_only_bottom_close_and_rename($capih);
51371543 571
5f8dc073 572my $capi = open_print_header('perlapi.c', <<'EOQ');
56fd1190 573 *
892eaa71
NC
574 *
575 * Up to the threshold of the door there mounted a flight of twenty-seven
576 * broad stairs, hewn by some unknown art of the same black stone. This
577 * was the only entrance to the tower; ...
578 *
579 * [p.577 of _The Lord of the Rings_, III/x: "The Voice of Saruman"]
580 *
581 */
56fd1190 582EOQ
892eaa71 583
5f8dc073 584print $capi <<'EOT';
51371543
GS
585#include "EXTERN.h"
586#include "perl.h"
587#include "perlapi.h"
588
87b9e160 589#if defined (MULTIPLICITY) && defined (PERL_GLOBAL_STRUCT)
51371543 590
87b9e160 591/* accessor functions for Perl "global" variables */
51371543
GS
592START_EXTERN_C
593
51371543 594#undef PERLVARI
115ff745 595#define PERLVARI(p,v,t,i) PERLVAR(p,v,t)
c5be433b
GS
596
597#undef PERLVAR
598#undef PERLVARA
115ff745 599#define PERLVAR(p,v,t) t* Perl_##p##v##_ptr(pTHX) \
96a5add6 600 { dVAR; PERL_UNUSED_CONTEXT; return &(PL_##v); }
115ff745 601#define PERLVARA(p,v,n,t) PL_##v##_t* Perl_##p##v##_ptr(pTHX) \
96a5add6 602 { dVAR; PERL_UNUSED_CONTEXT; return &(PL_##v); }
34f7a5fe 603#undef PERLVARIC
115ff745
NC
604#define PERLVARIC(p,v,t,i) \
605 const t* Perl_##p##v##_ptr(pTHX) \
96a5add6 606 { PERL_UNUSED_CONTEXT; return (const t *)&(PL_##v); }
51371543
GS
607#include "perlvars.h"
608
609#undef PERLVAR
610#undef PERLVARA
611#undef PERLVARI
612#undef PERLVARIC
27da23d5 613
acfe0abc 614END_EXTERN_C
6f4183fe 615
87b9e160 616#endif /* MULTIPLICITY && PERL_GLOBAL_STRUCT */
51371543
GS
617EOT
618
ce716c52 619read_only_bottom_close_and_rename($capi);
acfe0abc 620
1b6737cc 621# ex: set ts=8 sts=4 sw=4 noet: