perl5.git.perl.org Git - perl5.git/blame_incremental

... / ...

Commit	Line	Data
	1	#./perl -w
	2	#
	3	# Create the export list for perl.
	4	#
	5	# Needed by WIN32 and OS/2 for creating perl.dll,
	6	# and by AIX for creating libperl.a when -Duseshrplib is in effect,
	7	# and by VMS for creating perlshr.exe.
	8	#
	9	# Reads from information stored in
	10	#
	11	# %Config::Config (ie config.sh)
	12	# config.h
	13	# embed.fnc
	14	# globvar.sym
	15	# intrpvar.h
	16	# miniperl.map (on OS/2)
	17	# perl5.def (on OS/2; this is the old version of the file being made)
	18	# perlio.sym
	19	# perlvars.h
	20	# regen/opcodes
	21	#
	22	# plus long lists of function names hard-coded directly in this script.
	23	#
	24	# Writes the result to STDOUT.
	25	#
	26	# Normally this script is invoked from a makefile (e.g. win32/Makefile),
	27	# which redirects STDOUT to a suitable file, such as:
	28	#
	29	# perl5.def OS/2
	30	# perldll.def Windows
	31	# perl.exp AIX
	32	# perl.imp NetWare
	33	# makedef.lis VMS
	34
	35	my $fold;
	36	my %ARGS;
	37	my %define;
	38
	39	BEGIN {
	40	BEGIN { unshift @INC, "lib" }
	41	use Config;
	42	use strict;
	43
	44	%ARGS = (CCTYPE => 'MSVC', TARG_DIR => '');
	45
	46	sub process_cc_flags {
	47	foreach (map {split /\s+/, $_} @_) {
	48	$define{$1} = $2 // 1 if /^-D(\w+)(?:=(.+))?/;
	49	}
	50	}
	51
	52	while (@ARGV) {
	53	my $flag = shift;
	54	if ($flag =~ /^(?:CC_FLAGS=)?(-D\w.*)/) {
	55	process_cc_flags($1);
	56	} elsif ($flag =~ /^(CCTYPE\|FILETYPE\|PLATFORM\|TARG_DIR)=(.+)$/) {
	57	$ARGS{$1} = $2;
	58	} elsif ($flag eq '--sort-fold') {
	59	++$fold;
	60	}
	61	}
	62	my @PLATFORM = qw(aix win32 wince os2 netware vms test);
	63	my %PLATFORM;
	64	@PLATFORM{@PLATFORM} = ();
	65
	66	die "PLATFORM undefined, must be one of: @PLATFORM\n"
	67	unless defined $ARGS{PLATFORM};
	68	die "PLATFORM must be one of: @PLATFORM\n"
	69	unless exists $PLATFORM{$ARGS{PLATFORM}};
	70	}
	71	use constant PLATFORM => $ARGS{PLATFORM};
	72
	73	require "$ARGS{TARG_DIR}regen/embed_lib.pl";
	74
	75	# Is the following guard strictly necessary? Added during refactoring
	76	# to keep the same behaviour when merging other code into here.
	77	process_cc_flags(@Config{qw(ccflags optimize)})
	78	if $ARGS{PLATFORM} ne 'win32' && $ARGS{PLATFORM} ne 'wince'
	79	&& $ARGS{PLATFORM} ne 'netware';
	80
	81	# Add the compile-time options that miniperl was built with to %define.
	82	# On Win32 these are not the same options as perl itself will be built
	83	# with since miniperl is built with a canned config (one of the win32/
	84	# config_H.*) and none of the BUILDOPT's that are set in the makefiles,
	85	# but they do include some #define's that are hard-coded in various
	86	# source files and header files and don't include any BUILDOPT's that
	87	# the user might have chosen to disable because the canned configs are
	88	# minimal configs that don't include any of those options.
	89
	90	#don't use the host Perl's -V defines for the WinCE Perl
	91	if($ARGS{PLATFORM} ne 'wince') {
	92	my @options = sort(Config::bincompat_options(), Config::non_bincompat_options());
	93	print STDERR "Options: (@options)\n" unless $ARGS{PLATFORM} eq 'test';
	94	$define{$_} = 1 foreach @options;
	95	}
	96
	97	my %exportperlmalloc =
	98	(
	99	Perl_malloc => "malloc",
	100	Perl_mfree => "free",
	101	Perl_realloc => "realloc",
	102	Perl_calloc => "calloc",
	103	);
	104
	105	my $exportperlmalloc = $ARGS{PLATFORM} eq 'os2';
	106
	107	my $config_h = 'config.h';
	108	open(CFG, '<', $config_h) \|\| die "Cannot open $config_h: $!\n";
	109	while (<CFG>) {
	110	$define{$1} = 1 if /^\s\#\sdefine\s+(MYMALLOC\|MULTIPLICITY
	111	\|SPRINTF_RETURNS_STRLEN
	112	\|KILL_BY_SIGPRC
	113	\|(?:PERL\|USE\|HAS)_\w+)\b/x;
	114	}
	115	close(CFG);
	116
	117	# perl.h logic duplication begins
	118
	119	if ($define{USE_ITHREADS}) {
	120	if (!$define{MULTIPLICITY}) {
	121	$define{MULTIPLICITY} = 1;
	122	}
	123	}
	124
	125	$define{PERL_IMPLICIT_CONTEXT} \|\|=
	126	$define{USE_ITHREADS} \|\|
	127	$define{MULTIPLICITY} ;
	128
	129	if ($define{USE_ITHREADS} && $ARGS{PLATFORM} ne 'win32' && $^O ne 'darwin') {
	130	$define{USE_REENTRANT_API} = 1;
	131	}
	132
	133	# perl.h logic duplication ends
	134
	135	print STDERR "Defines: (" . join(' ', sort keys %define) . ")\n"
	136	unless $ARGS{PLATFORM} eq 'test';
	137
	138	my $sym_ord = 0;
	139	my %ordinal;
	140
	141	if ($ARGS{PLATFORM} eq 'os2') {
	142	if (open my $fh, '<', 'perl5.def') {
	143	while (<$fh>) {
	144	last if /^\s*EXPORTS\b/;
	145	}
	146	while (<$fh>) {
	147	$ordinal{$1} = $2 if /^\s"(\w+)"\s(?:=\s"\w+"\s)?\@(\d+)\s*$/;
	148	# This allows skipping ordinals which were used in older versions
	149	$sym_ord = $1 if /^\s;\sLAST_ORDINAL\s=\s(\d+)\s*$/;
	150	}
	151	$sym_ord < $_ and $sym_ord = $_ for values %ordinal; # Take the max
	152	}
	153	}
	154
	155	my %skip;
	156	# All platforms export boot_DynaLoader unconditionally.
	157	my %export = ( boot_DynaLoader => 1 );
	158
	159	sub try_symbols {
	160	foreach my $symbol (@_) {
	161	++$export{$symbol} unless exists $skip{$symbol};
	162	}
	163	}
	164
	165	sub readvar {
	166	# $hash is the hash that we're adding to. For one of our callers, it will
	167	# actually be the skip hash but that doesn't affect the intent of what
	168	# we're doing, as in that case we skip adding something to the skip hash
	169	# for the second time.
	170
	171	my $file = $ARGS{TARG_DIR} . shift;
	172	my $hash = shift;
	173	my $proc = shift;
	174	open my $vars, '<', $file or die die "Cannot open $file: $!\n";
	175
	176	while (<$vars>) {
	177	# All symbols have a Perl_ prefix because that's what embed.h sticks
	178	# in front of them. The A?I?S?C? is strictly speaking wrong.
	179	next unless /\bPERLVAR(A?I?S?C?)\(([IGT]),\s*(\w+)/;
	180
	181	my $var = "PL_$3";
	182	my $symbol = $proc ? &$proc($1,$2,$3) : $var;
	183	++$hash->{$symbol} unless exists $skip{$var};
	184	}
	185	}
	186
	187	if ($ARGS{PLATFORM} ne 'os2') {
	188	++$skip{$_} foreach qw(
	189	PL_cryptseen
	190	PL_opsave
	191	Perl_GetVars
	192	Perl_dump_fds
	193	Perl_my_bcopy
	194	Perl_my_bzero
	195	Perl_my_chsize
	196	Perl_my_htonl
	197	Perl_my_memcmp
	198	Perl_my_memset
	199	Perl_my_ntohl
	200	Perl_my_swap
	201	);
	202	if ($ARGS{PLATFORM} eq 'vms') {
	203	++$skip{PL_statusvalue_posix};
	204	# This is a wrapper if we have symlink, not a replacement
	205	# if we don't.
	206	++$skip{Perl_my_symlink} unless $Config{d_symlink};
	207	} else {
	208	++$skip{PL_statusvalue_vms};
	209	if ($ARGS{PLATFORM} ne 'aix') {
	210	++$skip{$_} foreach qw(
	211	PL_DBcv
	212	PL_generation
	213	PL_lastgotoprobe
	214	PL_modcount
	215	main
	216	);
	217	}
	218	}
	219	}
	220
	221	if ($ARGS{PLATFORM} ne 'vms') {
	222	# VMS does its own thing for these symbols.
	223	++$skip{$_} foreach qw(
	224	PL_sig_handlers_initted
	225	PL_sig_ignoring
	226	PL_sig_defaulting
	227	);
	228	if ($ARGS{PLATFORM} ne 'win32') {
	229	++$skip{$_} foreach qw(
	230	Perl_do_spawn
	231	Perl_do_spawn_nowait
	232	Perl_do_aspawn
	233	);
	234	}
	235	}
	236
	237	if ($ARGS{PLATFORM} ne 'win32') {
	238	++$skip{$_} foreach qw(
	239	Perl_my_setlocale
	240	);
	241	}
	242
	243	unless ($define{UNLINK_ALL_VERSIONS}) {
	244	++$skip{Perl_unlnk};
	245	}
	246
	247	unless ($define{'DEBUGGING'}) {
	248	++$skip{$_} foreach qw(
	249	Perl_debop
	250	Perl_debprofdump
	251	Perl_debstack
	252	Perl_debstackptrs
	253	Perl_pad_sv
	254	Perl_pad_setsv
	255	Perl__setlocale_debug_string
	256	Perl_set_padlist
	257	Perl_hv_assert
	258	PL_watchaddr
	259	PL_watchok
	260	PL_watch_pvx
	261	);
	262	}
	263
	264	if ($define{'PERL_IMPLICIT_SYS'}) {
	265	++$skip{$_} foreach qw(
	266	Perl_my_popen
	267	Perl_my_pclose
	268	);
	269	++$export{$_} foreach qw(perl_get_host_info perl_alloc_override);
	270	++$export{perl_clone_host} if $define{USE_ITHREADS};
	271	}
	272	else {
	273	++$skip{$_} foreach qw(
	274	PL_Mem
	275	PL_MemShared
	276	PL_MemParse
	277	PL_Env
	278	PL_StdIO
	279	PL_LIO
	280	PL_Dir
	281	PL_Sock
	282	PL_Proc
	283	perl_alloc_using
	284	perl_clone_using
	285	);
	286	}
	287
	288	if (!$define{'PERL_COPY_ON_WRITE'} \|\| $define{'PERL_NO_COW'}) {
	289	++$skip{Perl_sv_setsv_cow};
	290	}
	291
	292	unless ($define{PERL_SAWAMPERSAND}) {
	293	++$skip{PL_sawampersand};
	294	}
	295
	296	unless ($define{'USE_REENTRANT_API'}) {
	297	++$skip{PL_reentrant_buffer};
	298	}
	299
	300	if ($define{'MYMALLOC'}) {
	301	try_symbols(qw(
	302	Perl_dump_mstats
	303	Perl_get_mstats
	304	Perl_strdup
	305	Perl_putenv
	306	MallocCfg_ptr
	307	MallocCfgP_ptr
	308	));
	309	unless ($define{USE_ITHREADS}) {
	310	++$skip{PL_malloc_mutex}
	311	}
	312	}
	313	else {
	314	++$skip{$_} foreach qw(
	315	PL_malloc_mutex
	316	Perl_dump_mstats
	317	Perl_get_mstats
	318	MallocCfg_ptr
	319	MallocCfgP_ptr
	320	);
	321	}
	322
	323	if ($define{'PERL_USE_SAFE_PUTENV'}) {
	324	++$skip{PL_use_safe_putenv};
	325	}
	326
	327	unless ($define{'USE_ITHREADS'}) {
	328	++$skip{PL_thr_key};
	329	}
	330
	331	# USE_5005THREADS symbols. Kept as reference for easier removal
	332	++$skip{$_} foreach qw(
	333	PL_sv_mutex
	334	PL_strtab_mutex
	335	PL_svref_mutex
	336	PL_cred_mutex
	337	PL_eval_mutex
	338	PL_fdpid_mutex
	339	PL_sv_lock_mutex
	340	PL_eval_cond
	341	PL_eval_owner
	342	PL_threads_mutex
	343	PL_nthreads
	344	PL_nthreads_cond
	345	PL_threadnum
	346	PL_threadsv_names
	347	PL_thrsv
	348	PL_vtbl_mutex
	349	Perl_condpair_magic
	350	Perl_new_struct_thread
	351	Perl_per_thread_magicals
	352	Perl_thread_create
	353	Perl_find_threadsv
	354	Perl_unlock_condpair
	355	Perl_magic_mutexfree
	356	Perl_sv_lock
	357	);
	358
	359	unless ($define{'USE_ITHREADS'}) {
	360	++$skip{$_} foreach qw(
	361	PL_check_mutex
	362	PL_op_mutex
	363	PL_regex_pad
	364	PL_regex_padav
	365	PL_dollarzero_mutex
	366	PL_hints_mutex
	367	PL_locale_mutex
	368	PL_my_ctx_mutex
	369	PL_perlio_mutex
	370	PL_stashpad
	371	PL_stashpadix
	372	PL_stashpadmax
	373	Perl_alloccopstash
	374	Perl_allocfilegv
	375	Perl_clone_params_del
	376	Perl_clone_params_new
	377	Perl_parser_dup
	378	Perl_dirp_dup
	379	Perl_cx_dup
	380	Perl_si_dup
	381	Perl_any_dup
	382	Perl_ss_dup
	383	Perl_fp_dup
	384	Perl_gp_dup
	385	Perl_he_dup
	386	Perl_mg_dup
	387	Perl_re_dup_guts
	388	Perl_sv_dup
	389	Perl_sv_dup_inc
	390	Perl_rvpv_dup
	391	Perl_hek_dup
	392	Perl_sys_intern_dup
	393	perl_clone
	394	perl_clone_using
	395	Perl_stashpv_hvname_match
	396	Perl_regdupe_internal
	397	Perl_newPADOP
	398	);
	399	}
	400
	401	unless ($define{'PERL_IMPLICIT_CONTEXT'}) {
	402	++$skip{$_} foreach qw(
	403	PL_my_cxt_index
	404	PL_my_cxt_list
	405	PL_my_cxt_size
	406	PL_my_cxt_keys
	407	Perl_croak_nocontext
	408	Perl_die_nocontext
	409	Perl_deb_nocontext
	410	Perl_form_nocontext
	411	Perl_load_module_nocontext
	412	Perl_mess_nocontext
	413	Perl_warn_nocontext
	414	Perl_warner_nocontext
	415	Perl_newSVpvf_nocontext
	416	Perl_sv_catpvf_nocontext
	417	Perl_sv_setpvf_nocontext
	418	Perl_sv_catpvf_mg_nocontext
	419	Perl_sv_setpvf_mg_nocontext
	420	Perl_my_cxt_init
	421	Perl_my_cxt_index
	422	);
	423	}
	424
	425	unless ($define{'PERL_OP_PARENT'}) {
	426	++$skip{$_} foreach qw(
	427	Perl_op_parent
	428	);
	429	}
	430
	431	unless ($define{'USE_DTRACE'}) {
	432	++$skip{$_} foreach qw(
	433	Perl_dtrace_probe_call
	434	Perl_dtrace_probe_load
	435	Perl_dtrace_probe_op
	436	Perl_dtrace_probe_phase
	437	);
	438	}
	439
	440	if ($define{'NO_MATHOMS'}) {
	441	# win32 builds happen in the win32/ subdirectory, but vms builds happen
	442	# at the top level, so we need to look in two candidate locations for
	443	# the mathoms.c file.
	444	my ($file) = grep { -f } qw( mathoms.c ../mathoms.c )
	445	or die "No mathoms.c file found in . or ..\n";
	446	open my $mathoms, '<', $file
	447	or die "Cannot open $file: $!\n";
	448	while (<$mathoms>) {
	449	++$skip{$1} if /\A ( NATIVE_TO_NEED
	450	\| ASCII_TO_NEED
	451	\| Perl_\w+ ) \s* \( /axms;
	452	}
	453	}
	454
	455	unless ($define{'PERL_NEED_APPCTX'}) {
	456	++$skip{PL_appctx};
	457	}
	458
	459	unless ($define{'PERL_NEED_TIMESBASE'}) {
	460	++$skip{PL_timesbase};
	461	}
	462
	463	unless ($define{'DEBUG_LEAKING_SCALARS'}) {
	464	++$skip{PL_sv_serial};
	465	}
	466
	467	unless ($define{'DEBUG_LEAKING_SCALARS_FORK_DUMP'}) {
	468	++$skip{PL_dumper_fd};
	469	}
	470
	471	unless ($define{'PERL_DONT_CREATE_GVSV'}) {
	472	++$skip{Perl_gv_SVadd};
	473	}
	474
	475	if ($define{'SPRINTF_RETURNS_STRLEN'}) {
	476	++$skip{Perl_my_sprintf};
	477	}
	478
	479	unless ($define{'PERL_USES_PL_PIDSTATUS'}) {
	480	++$skip{PL_pidstatus};
	481	}
	482
	483	unless ($define{'PERL_TRACK_MEMPOOL'}) {
	484	++$skip{PL_memory_debug_header};
	485	}
	486
	487	unless ($define{'MULTIPLICITY'}) {
	488	++$skip{$_} foreach qw(
	489	PL_interp_size
	490	PL_interp_size_5_18_0
	491	);
	492	}
	493
	494	unless ($define{'PERL_GLOBAL_STRUCT'}) {
	495	++$skip{PL_global_struct_size};
	496	}
	497
	498	unless ($define{'PERL_GLOBAL_STRUCT_PRIVATE'}) {
	499	++$skip{$_} foreach qw(
	500	PL_my_cxt_keys
	501	Perl_my_cxt_index
	502	);
	503	}
	504
	505	unless ($define{HAS_MMAP}) {
	506	++$skip{PL_mmap_page_size};
	507	}
	508
	509	if ($define{HAS_SIGACTION}) {
	510	++$skip{PL_sig_trapped};
	511
	512	if ($ARGS{PLATFORM} eq 'vms') {
	513	# FAKE_PERSISTENT_SIGNAL_HANDLERS defined as !defined(HAS_SIGACTION)
	514	++$skip{PL_sig_ignoring};
	515	++$skip{PL_sig_handlers_initted} unless $define{KILL_BY_SIGPRC};
	516	}
	517	}
	518
	519	if ($ARGS{PLATFORM} eq 'vms' && !$define{KILL_BY_SIGPRC}) {
	520	# FAKE_DEFAULT_SIGNAL_HANDLERS defined as KILL_BY_SIGPRC
	521	++$skip{Perl_csighandler_init};
	522	++$skip{Perl_my_kill};
	523	++$skip{Perl_sig_to_vmscondition};
	524	++$skip{PL_sig_defaulting};
	525	++$skip{PL_sig_handlers_initted} unless !$define{HAS_SIGACTION};
	526	}
	527
	528	unless ($define{USE_LOCALE_COLLATE}) {
	529	++$skip{$_} foreach qw(
	530	PL_collation_ix
	531	PL_collation_name
	532	PL_collation_standard
	533	PL_collxfrm_base
	534	PL_collxfrm_mult
	535	Perl_sv_collxfrm
	536	Perl_sv_collxfrm_flags
	537	);
	538	}
	539
	540	unless ($define{USE_LOCALE_NUMERIC}) {
	541	++$skip{$_} foreach qw(
	542	PL_numeric_local
	543	PL_numeric_name
	544	PL_numeric_radix_sv
	545	PL_numeric_standard
	546	);
	547	}
	548
	549	unless ($define{'USE_C_BACKTRACE'}) {
	550	++$skip{Perl_get_c_backtrace_dump};
	551	++$skip{Perl_dump_c_backtrace};
	552	}
	553
	554	unless ($define{HAVE_INTERP_INTERN}) {
	555	++$skip{$_} foreach qw(
	556	Perl_sys_intern_clear
	557	Perl_sys_intern_dup
	558	Perl_sys_intern_init
	559	PL_sys_intern
	560	);
	561	}
	562
	563	if ($define{HAS_SIGNBIT}) {
	564	++$skip{Perl_signbit};
	565	}
	566
	567	if ($define{'PERL_GLOBAL_STRUCT'}) {
	568	readvar('perlvars.h', \%skip);
	569	# This seems like the least ugly way to cope with the fact that PL_sh_path
	570	# is mentioned in perlvar.h and globvar.sym, and always exported.
	571	delete $skip{PL_sh_path};
	572	++$export{Perl_GetVars};
	573	try_symbols(qw(PL_Vars PL_VarsPtr))
	574	unless $ARGS{CCTYPE} eq 'GCC' \|\| $define{PERL_GLOBAL_STRUCT_PRIVATE};
	575	} else {
	576	++$skip{$_} foreach qw(Perl_init_global_struct Perl_free_global_struct);
	577	}
	578
	579	++$skip{PL_op_exec_cnt}
	580	unless $define{PERL_TRACE_OPS};
	581
	582	# functions from *.sym files
	583
	584	my @syms = qw(globvar.sym);
	585
	586	# Symbols that are the public face of the PerlIO layers implementation
	587	# These are in _addition to_ the public face of the abstraction
	588	# and need to be exported to allow XS modules to implement layers
	589	my @layer_syms = qw(
	590	PerlIOBase_binmode
	591	PerlIOBase_clearerr
	592	PerlIOBase_close
	593	PerlIOBase_dup
	594	PerlIOBase_eof
	595	PerlIOBase_error
	596	PerlIOBase_fileno
	597	PerlIOBase_open
	598	PerlIOBase_noop_fail
	599	PerlIOBase_noop_ok
	600	PerlIOBase_popped
	601	PerlIOBase_pushed
	602	PerlIOBase_read
	603	PerlIOBase_setlinebuf
	604	PerlIOBase_unread
	605	PerlIOBuf_bufsiz
	606	PerlIOBuf_close
	607	PerlIOBuf_dup
	608	PerlIOBuf_fill
	609	PerlIOBuf_flush
	610	PerlIOBuf_get_base
	611	PerlIOBuf_get_cnt
	612	PerlIOBuf_get_ptr
	613	PerlIOBuf_open
	614	PerlIOBuf_popped
	615	PerlIOBuf_pushed
	616	PerlIOBuf_read
	617	PerlIOBuf_seek
	618	PerlIOBuf_set_ptrcnt
	619	PerlIOBuf_tell
	620	PerlIOBuf_unread
	621	PerlIOBuf_write
	622	PerlIO_allocate
	623	PerlIO_apply_layera
	624	PerlIO_apply_layers
	625	PerlIO_arg_fetch
	626	PerlIO_debug
	627	PerlIO_define_layer
	628	PerlIO_find_layer
	629	PerlIO_isutf8
	630	PerlIO_layer_fetch
	631	PerlIO_list_alloc
	632	PerlIO_list_free
	633	PerlIO_modestr
	634	PerlIO_parse_layers
	635	PerlIO_pending
	636	PerlIO_perlio
	637	PerlIO_pop
	638	PerlIO_push
	639	PerlIO_sv_dup
	640	Perl_PerlIO_clearerr
	641	Perl_PerlIO_close
	642	Perl_PerlIO_context_layers
	643	Perl_PerlIO_eof
	644	Perl_PerlIO_error
	645	Perl_PerlIO_fileno
	646	Perl_PerlIO_fill
	647	Perl_PerlIO_flush
	648	Perl_PerlIO_get_base
	649	Perl_PerlIO_get_bufsiz
	650	Perl_PerlIO_get_cnt
	651	Perl_PerlIO_get_ptr
	652	Perl_PerlIO_read
	653	Perl_PerlIO_restore_errno
	654	Perl_PerlIO_save_errno
	655	Perl_PerlIO_seek
	656	Perl_PerlIO_set_cnt
	657	Perl_PerlIO_set_ptrcnt
	658	Perl_PerlIO_setlinebuf
	659	Perl_PerlIO_stderr
	660	Perl_PerlIO_stdin
	661	Perl_PerlIO_stdout
	662	Perl_PerlIO_tell
	663	Perl_PerlIO_unread
	664	Perl_PerlIO_write
	665	);
	666	if ($ARGS{PLATFORM} eq 'netware') {
	667	push(@layer_syms,'PL_def_layerlist','PL_known_layers','PL_perlio');
	668	}
	669
	670	# Export the symbols that make up the PerlIO abstraction, regardless
	671	# of its implementation - read from a file
	672	push @syms, 'perlio.sym';
	673
	674	# PerlIO with layers - export implementation
	675	try_symbols(@layer_syms, 'perlsio_binmode');
	676
	677
	678	unless ($define{'USE_QUADMATH'}) {
	679	++$skip{Perl_quadmath_format_needed};
	680	++$skip{Perl_quadmath_format_single};
	681	}
	682
	683	###############################################################################
	684
	685	# At this point all skip lists should be completed, as we are about to test
	686	# many symbols against them.
	687
	688	{
	689	my %seen;
	690	my ($embed) = setup_embed($ARGS{TARG_DIR});
	691
	692	foreach (@$embed) {
	693	my ($flags, $retval, $func, @args) = @$_;
	694	next unless $func;
	695	if ($flags =~ /[AX]/ && $flags !~ /[xmi]/ \|\| $flags =~ /b/) {
	696	# public API, so export
	697
	698	# If a function is defined twice, for example before and after
	699	# an #else, only export its name once. Important to do this test
	700	# within the block, as the first definition may have flags which
	701	# mean "don't export"
	702	next if $seen{$func}++;
	703	# Should we also skip adding the Perl_ prefix if $flags =~ /o/ ?
	704	$func = "Perl_$func" if ($flags =~ /[pbX]/ && $func !~ /^Perl_/);
	705	++$export{$func} unless exists $skip{$func};
	706	}
	707	}
	708	}
	709
	710	foreach (@syms) {
	711	my $syms = $ARGS{TARG_DIR} . $_;
	712	open my $global, '<', $syms or die "failed to open $syms: $!\n";
	713	while (<$global>) {
	714	next unless /^([A-Za-z].*)/;
	715	my $symbol = "$1";
	716	++$export{$symbol} unless exists $skip{$symbol};
	717	}
	718	}
	719
	720	# variables
	721
	722	if ($define{'MULTIPLICITY'} && $define{PERL_GLOBAL_STRUCT}) {
	723	readvar('perlvars.h', \%export, sub { "Perl_" . $_[1] . $_[2] . "_ptr" });
	724	# XXX AIX seems to want the perlvars.h symbols, for some reason
	725	if ($ARGS{PLATFORM} eq 'aix' or $ARGS{PLATFORM} eq 'os2') { # OS/2 needs PL_thr_key
	726	readvar('perlvars.h', \%export);
	727	}
	728	}
	729	else {
	730	unless ($define{'PERL_GLOBAL_STRUCT'}) {
	731	readvar('perlvars.h', \%export);
	732	}
	733	unless ($define{MULTIPLICITY}) {
	734	readvar('intrpvar.h', \%export);
	735	}
	736	}
	737
	738	# Oddities from PerlIO
	739	# All have alternate implementations in perlio.c, so always exist.
	740	# Should they be considered to be part of the API?
	741	try_symbols(qw(
	742	PerlIO_binmode
	743	PerlIO_getpos
	744	PerlIO_init
	745	PerlIO_setpos
	746	PerlIO_tmpfile
	747	));
	748
	749	if ($ARGS{PLATFORM} eq 'win32') {
	750	try_symbols(qw(
	751	win32_free_childdir
	752	win32_free_childenv
	753	win32_get_childdir
	754	win32_get_childenv
	755	win32_spawnvp
	756	));
	757	}
	758
	759	if ($ARGS{PLATFORM} eq 'wince') {
	760	++$skip{'win32_isatty'}; # commit 4342f4d6df is win32-only
	761	}
	762
	763	if ($ARGS{PLATFORM} =~ /^win(?:32\|ce)$/) {
	764	try_symbols(qw(
	765	Perl_init_os_extras
	766	Perl_thread_create
	767	Perl_win32_init
	768	Perl_win32_term
	769	RunPerl
	770	win32_async_check
	771	win32_errno
	772	win32_environ
	773	win32_abort
	774	win32_fstat
	775	win32_stat
	776	win32_pipe
	777	win32_popen
	778	win32_pclose
	779	win32_rename
	780	win32_setmode
	781	win32_chsize
	782	win32_lseek
	783	win32_tell
	784	win32_dup
	785	win32_dup2
	786	win32_open
	787	win32_close
	788	win32_eof
	789	win32_isatty
	790	win32_read
	791	win32_write
	792	win32_mkdir
	793	win32_rmdir
	794	win32_chdir
	795	win32_flock
	796	win32_execv
	797	win32_execvp
	798	win32_htons
	799	win32_ntohs
	800	win32_htonl
	801	win32_ntohl
	802	win32_inet_addr
	803	win32_inet_ntoa
	804	win32_socket
	805	win32_bind
	806	win32_listen
	807	win32_accept
	808	win32_connect
	809	win32_send
	810	win32_sendto
	811	win32_recv
	812	win32_recvfrom
	813	win32_shutdown
	814	win32_closesocket
	815	win32_ioctlsocket
	816	win32_setsockopt
	817	win32_getsockopt
	818	win32_getpeername
	819	win32_getsockname
	820	win32_gethostname
	821	win32_gethostbyname
	822	win32_gethostbyaddr
	823	win32_getprotobyname
	824	win32_getprotobynumber
	825	win32_getservbyname
	826	win32_getservbyport
	827	win32_select
	828	win32_endhostent
	829	win32_endnetent
	830	win32_endprotoent
	831	win32_endservent
	832	win32_getnetent
	833	win32_getnetbyname
	834	win32_getnetbyaddr
	835	win32_getprotoent
	836	win32_getservent
	837	win32_sethostent
	838	win32_setnetent
	839	win32_setprotoent
	840	win32_setservent
	841	win32_getenv
	842	win32_putenv
	843	win32_perror
	844	win32_malloc
	845	win32_calloc
	846	win32_realloc
	847	win32_free
	848	win32_sleep
	849	win32_times
	850	win32_access
	851	win32_alarm
	852	win32_chmod
	853	win32_open_osfhandle
	854	win32_get_osfhandle
	855	win32_ioctl
	856	win32_link
	857	win32_unlink
	858	win32_utime
	859	win32_gettimeofday
	860	win32_uname
	861	win32_wait
	862	win32_waitpid
	863	win32_kill
	864	win32_str_os_error
	865	win32_opendir
	866	win32_readdir
	867	win32_telldir
	868	win32_seekdir
	869	win32_rewinddir
	870	win32_closedir
	871	win32_longpath
	872	win32_ansipath
	873	win32_os_id
	874	win32_getpid
	875	win32_crypt
	876	win32_dynaload
	877	win32_clearenv
	878	win32_stdin
	879	win32_stdout
	880	win32_stderr
	881	win32_ferror
	882	win32_feof
	883	win32_strerror
	884	win32_fprintf
	885	win32_printf
	886	win32_vfprintf
	887	win32_vprintf
	888	win32_fread
	889	win32_fwrite
	890	win32_fopen
	891	win32_fdopen
	892	win32_freopen
	893	win32_fclose
	894	win32_fputs
	895	win32_fputc
	896	win32_ungetc
	897	win32_getc
	898	win32_fileno
	899	win32_clearerr
	900	win32_fflush
	901	win32_ftell
	902	win32_fseek
	903	win32_fgetpos
	904	win32_fsetpos
	905	win32_rewind
	906	win32_tmpfile
	907	win32_setbuf
	908	win32_setvbuf
	909	win32_flushall
	910	win32_fcloseall
	911	win32_fgets
	912	win32_gets
	913	win32_fgetc
	914	win32_putc
	915	win32_puts
	916	win32_getchar
	917	win32_putchar
	918	));
	919	}
	920	elsif ($ARGS{PLATFORM} eq 'vms') {
	921	try_symbols(qw(
	922	Perl_cando
	923	Perl_cando_by_name
	924	Perl_closedir
	925	Perl_csighandler_init
	926	Perl_do_rmdir
	927	Perl_fileify_dirspec
	928	Perl_fileify_dirspec_ts
	929	Perl_fileify_dirspec_utf8
	930	Perl_fileify_dirspec_utf8_ts
	931	Perl_flex_fstat
	932	Perl_flex_lstat
	933	Perl_flex_stat
	934	Perl_kill_file
	935	Perl_my_chdir
	936	Perl_my_chmod
	937	Perl_my_crypt
	938	Perl_my_endpwent
	939	Perl_my_fclose
	940	Perl_my_fdopen
	941	Perl_my_fgetname
	942	Perl_my_flush
	943	Perl_my_fwrite
	944	Perl_my_gconvert
	945	Perl_my_getenv
	946	Perl_my_getenv_len
	947	Perl_my_getpwnam
	948	Perl_my_getpwuid
	949	Perl_my_gmtime
	950	Perl_my_kill
	951	Perl_my_killpg
	952	Perl_my_localtime
	953	Perl_my_mkdir
	954	Perl_my_sigaction
	955	Perl_my_symlink
	956	Perl_my_time
	957	Perl_my_tmpfile
	958	Perl_my_trnlnm
	959	Perl_my_utime
	960	Perl_my_waitpid
	961	Perl_opendir
	962	Perl_pathify_dirspec
	963	Perl_pathify_dirspec_ts
	964	Perl_pathify_dirspec_utf8
	965	Perl_pathify_dirspec_utf8_ts
	966	Perl_readdir
	967	Perl_readdir_r
	968	Perl_rename
	969	Perl_rmscopy
	970	Perl_rmsexpand
	971	Perl_rmsexpand_ts
	972	Perl_rmsexpand_utf8
	973	Perl_rmsexpand_utf8_ts
	974	Perl_seekdir
	975	Perl_sig_to_vmscondition
	976	Perl_telldir
	977	Perl_tounixpath
	978	Perl_tounixpath_ts
	979	Perl_tounixpath_utf8
	980	Perl_tounixpath_utf8_ts
	981	Perl_tounixspec
	982	Perl_tounixspec_ts
	983	Perl_tounixspec_utf8
	984	Perl_tounixspec_utf8_ts
	985	Perl_tovmspath
	986	Perl_tovmspath_ts
	987	Perl_tovmspath_utf8
	988	Perl_tovmspath_utf8_ts
	989	Perl_tovmsspec
	990	Perl_tovmsspec_ts
	991	Perl_tovmsspec_utf8
	992	Perl_tovmsspec_utf8_ts
	993	Perl_trim_unixpath
	994	Perl_vms_case_tolerant
	995	Perl_vms_do_aexec
	996	Perl_vms_do_exec
	997	Perl_vms_image_init
	998	Perl_vms_realpath
	999	Perl_vmssetenv
	1000	Perl_vmssetuserlnm
	1001	Perl_vmstrnenv
	1002	PerlIO_openn
	1003	));
	1004	}
	1005	elsif ($ARGS{PLATFORM} eq 'os2') {
	1006	try_symbols(qw(
	1007	ctermid
	1008	get_sysinfo
	1009	Perl_OS2_init
	1010	Perl_OS2_init3
	1011	Perl_OS2_term
	1012	OS2_Perl_data
	1013	dlopen
	1014	dlsym
	1015	dlerror
	1016	dlclose
	1017	dup2
	1018	dup
	1019	my_tmpfile
	1020	my_tmpnam
	1021	my_flock
	1022	my_rmdir
	1023	my_mkdir
	1024	my_getpwuid
	1025	my_getpwnam
	1026	my_getpwent
	1027	my_setpwent
	1028	my_endpwent
	1029	fork_with_resources
	1030	croak_with_os2error
	1031	setgrent
	1032	endgrent
	1033	getgrent
	1034	malloc_mutex
	1035	threads_mutex
	1036	nthreads
	1037	nthreads_cond
	1038	os2_cond_wait
	1039	os2_stat
	1040	os2_execname
	1041	async_mssleep
	1042	msCounter
	1043	InfoTable
	1044	pthread_join
	1045	pthread_create
	1046	pthread_detach
	1047	XS_Cwd_change_drive
	1048	XS_Cwd_current_drive
	1049	XS_Cwd_extLibpath
	1050	XS_Cwd_extLibpath_set
	1051	XS_Cwd_sys_abspath
	1052	XS_Cwd_sys_chdir
	1053	XS_Cwd_sys_cwd
	1054	XS_Cwd_sys_is_absolute
	1055	XS_Cwd_sys_is_relative
	1056	XS_Cwd_sys_is_rooted
	1057	XS_DynaLoader_mod2fname
	1058	XS_File__Copy_syscopy
	1059	Perl_Register_MQ
	1060	Perl_Deregister_MQ
	1061	Perl_Serve_Messages
	1062	Perl_Process_Messages
	1063	init_PMWIN_entries
	1064	PMWIN_entries
	1065	Perl_hab_GET
	1066	loadByOrdinal
	1067	pExtFCN
	1068	os2error
	1069	ResetWinError
	1070	CroakWinError
	1071	PL_do_undump
	1072	));
	1073	}
	1074	elsif ($ARGS{PLATFORM} eq 'netware') {
	1075	try_symbols(qw(
	1076	Perl_init_os_extras
	1077	Perl_thread_create
	1078	Perl_nw5_init
	1079	RunPerl
	1080	AllocStdPerl
	1081	FreeStdPerl
	1082	do_spawn2
	1083	do_aspawn
	1084	nw_uname
	1085	nw_stdin
	1086	nw_stdout
	1087	nw_stderr
	1088	nw_feof
	1089	nw_ferror
	1090	nw_fopen
	1091	nw_fclose
	1092	nw_clearerr
	1093	nw_getc
	1094	nw_fgets
	1095	nw_fputc
	1096	nw_fputs
	1097	nw_fflush
	1098	nw_ungetc
	1099	nw_fileno
	1100	nw_fdopen
	1101	nw_freopen
	1102	nw_fread
	1103	nw_fwrite
	1104	nw_setbuf
	1105	nw_setvbuf
	1106	nw_vfprintf
	1107	nw_ftell
	1108	nw_fseek
	1109	nw_rewind
	1110	nw_tmpfile
	1111	nw_fgetpos
	1112	nw_fsetpos
	1113	nw_dup
	1114	nw_access
	1115	nw_chmod
	1116	nw_chsize
	1117	nw_close
	1118	nw_dup2
	1119	nw_flock
	1120	nw_isatty
	1121	nw_link
	1122	nw_lseek
	1123	nw_stat
	1124	nw_mktemp
	1125	nw_open
	1126	nw_read
	1127	nw_rename
	1128	nw_setmode
	1129	nw_unlink
	1130	nw_utime
	1131	nw_write
	1132	nw_chdir
	1133	nw_rmdir
	1134	nw_closedir
	1135	nw_opendir
	1136	nw_readdir
	1137	nw_rewinddir
	1138	nw_seekdir
	1139	nw_telldir
	1140	nw_htonl
	1141	nw_htons
	1142	nw_ntohl
	1143	nw_ntohs
	1144	nw_accept
	1145	nw_bind
	1146	nw_connect
	1147	nw_endhostent
	1148	nw_endnetent
	1149	nw_endprotoent
	1150	nw_endservent
	1151	nw_gethostbyaddr
	1152	nw_gethostbyname
	1153	nw_gethostent
	1154	nw_gethostname
	1155	nw_getnetbyaddr
	1156	nw_getnetbyname
	1157	nw_getnetent
	1158	nw_getpeername
	1159	nw_getprotobyname
	1160	nw_getprotobynumber
	1161	nw_getprotoent
	1162	nw_getservbyname
	1163	nw_getservbyport
	1164	nw_getservent
	1165	nw_getsockname
	1166	nw_getsockopt
	1167	nw_inet_addr
	1168	nw_listen
	1169	nw_socket
	1170	nw_recv
	1171	nw_recvfrom
	1172	nw_select
	1173	nw_send
	1174	nw_sendto
	1175	nw_sethostent
	1176	nw_setnetent
	1177	nw_setprotoent
	1178	nw_setservent
	1179	nw_setsockopt
	1180	nw_inet_ntoa
	1181	nw_shutdown
	1182	nw_crypt
	1183	nw_execvp
	1184	nw_kill
	1185	nw_Popen
	1186	nw_Pclose
	1187	nw_Pipe
	1188	nw_times
	1189	nw_waitpid
	1190	nw_getpid
	1191	nw_spawnvp
	1192	nw_os_id
	1193	nw_open_osfhandle
	1194	nw_get_osfhandle
	1195	nw_abort
	1196	nw_sleep
	1197	nw_wait
	1198	nw_dynaload
	1199	nw_strerror
	1200	fnFpSetMode
	1201	fnInsertHashListAddrs
	1202	fnGetHashListAddrs
	1203	Perl_deb
	1204	Perl_sv_setsv
	1205	Perl_sv_catsv
	1206	Perl_sv_catpvn
	1207	Perl_sv_2pv
	1208	nw_freeenviron
	1209	Remove_Thread_Ctx
	1210	));
	1211	}
	1212
	1213	# When added this code was only run for Win32 and WinCE
	1214	# Currently only Win32 links static extensions into the shared library.
	1215	# The WinCE makefile doesn't appear to support static extensions, so this code
	1216	# can't have any effect there.
	1217	# The NetWare Makefile doesn't support static extensions (and hardcodes the
	1218	# list of dynamic extensions, and the rules to build them)
	1219	# For *nix (and presumably OS/2) with a shared libperl, Makefile.SH compiles
	1220	# static extensions with -fPIC, but links them to perl, not libperl.so
	1221	# The VMS build scripts don't yet implement static extensions at all.
	1222
	1223	if ($ARGS{PLATFORM} =~ /^win(?:32\|ce)$/) {
	1224	# records of type boot_module for statically linked modules (except Dynaloader)
	1225	my $static_ext = $Config{static_ext} // "";
	1226	$static_ext =~ s/\//__/g;
	1227	$static_ext =~ s/\bDynaLoader\b//;
	1228	try_symbols(map {"boot_$_"} grep {/\S/} split /\s+/, $static_ext);
	1229	try_symbols("init_Win32CORE") if $static_ext =~ /\bWin32CORE\b/;
	1230	}
	1231
	1232	if ($ARGS{PLATFORM} eq 'os2') {
	1233	my (%mapped, @missing);
	1234	open MAP, 'miniperl.map' or die 'Cannot read miniperl.map';
	1235	/^\s*[\da-f:]+\s+(\w+)/i and $mapped{$1}++ foreach <MAP>;
	1236	close MAP or die 'Cannot close miniperl.map';
	1237
	1238	@missing = grep { !exists $mapped{$_} }
	1239	keys %export;
	1240	@missing = grep { !exists $exportperlmalloc{$_} } @missing;
	1241	delete $export{$_} foreach @missing;
	1242	}
	1243
	1244	###############################################################################
	1245
	1246	# Now all symbols should be defined because next we are going to output them.
	1247
	1248	# Start with platform specific headers:
	1249
	1250	if ($ARGS{PLATFORM} =~ /^win(?:32\|ce)$/) {
	1251	my $dll = $define{PERL_DLL} ? $define{PERL_DLL} =~ s/\.dll$//ir
	1252	: "perl$Config{api_revision}$Config{api_version}";
	1253	print "LIBRARY $dll\n";
	1254	# The DESCRIPTION module definition file statement is not supported
	1255	# by VC7 onwards.
	1256	if ($ARGS{CCTYPE} =~ /^(?:MSVC60\|GCC)$/) {
	1257	print "DESCRIPTION 'Perl interpreter'\n";
	1258	}
	1259	print "EXPORTS\n";
	1260	}
	1261	elsif ($ARGS{PLATFORM} eq 'os2') {
	1262	(my $v = $]) =~ s/(\d\.\d\d\d)(\d\d)$/$1_$2/;
	1263	$v .= '-thread' if $Config{archname} =~ /-thread/;
	1264	(my $dll = $define{PERL_DLL}) =~ s/\.dll$//i;
	1265	$v .= "\@$Config{perl_patchlevel}" if $Config{perl_patchlevel};
	1266	my $d = "DESCRIPTION '\@#perl5-porters\@perl.org:$v#\@ Perl interpreter, configured as $Config{config_args}'";
	1267	$d = substr($d, 0, 249) . "...'" if length $d > 253;
	1268	print <<"---EOP---";
	1269	LIBRARY '$dll' INITINSTANCE TERMINSTANCE
	1270	$d
	1271	STACKSIZE 32768
	1272	CODE LOADONCALL
	1273	DATA LOADONCALL NONSHARED MULTIPLE
	1274	EXPORTS
	1275	---EOP---
	1276	}
	1277	elsif ($ARGS{PLATFORM} eq 'aix') {
	1278	my $OSVER = `uname -v`;
	1279	chop $OSVER;
	1280	my $OSREL = `uname -r`;
	1281	chop $OSREL;
	1282	if ($OSVER > 4 \|\| ($OSVER == 4 && $OSREL >= 3)) {
	1283	print "#! ..\n";
	1284	} else {
	1285	print "#!\n";
	1286	}
	1287	}
	1288	elsif ($ARGS{PLATFORM} eq 'netware') {
	1289	if ($ARGS{FILETYPE} eq 'def') {
	1290	print "LIBRARY perl$Config{api_revision}$Config{api_version}\n";
	1291	print "DESCRIPTION 'Perl interpreter for NetWare'\n";
	1292	print "EXPORTS\n";
	1293	}
	1294	}
	1295
	1296	# Then the symbols
	1297
	1298	my @symbols = $fold ? sort {lc $a cmp lc $b} keys %export : sort keys %export;
	1299	foreach my $symbol (@symbols) {
	1300	if (PLATFORM eq 'win32' \|\| PLATFORM eq 'wince') {
	1301	# Remembering the origin file of each symbol is an alternative to PL_ matching
	1302	if (substr($symbol, 0, 3) eq 'PL_') {
	1303	print "\t$symbol DATA\n";
	1304	}
	1305	else {
	1306	print "\t$symbol\n";
	1307	}
	1308	}
	1309	elsif (PLATFORM eq 'os2') {
	1310	printf qq( %-31s \@%s\n),
	1311	qq("$symbol"), $ordinal{$symbol} \|\| ++$sym_ord;
	1312	printf qq( %-31s \@%s\n),
	1313	qq("$exportperlmalloc{$symbol}" = "$symbol"),
	1314	$ordinal{$exportperlmalloc{$symbol}} \|\| ++$sym_ord
	1315	if $exportperlmalloc and exists $exportperlmalloc{$symbol};
	1316	}
	1317	elsif (PLATFORM eq 'netware') {
	1318	print "\t$symbol,\n";
	1319	} else {
	1320	print "$symbol\n";
	1321	}
	1322	}
	1323
	1324	# Then platform specific footers.
	1325
	1326	if ($ARGS{PLATFORM} eq 'os2') {
	1327	print <<EOP;
	1328	dll_perlmain=main
	1329	fill_extLibpath
	1330	dir_subst
	1331	Perl_OS2_handler_install
	1332
	1333	; LAST_ORDINAL=$sym_ord
	1334	EOP
	1335	}
	1336
	1337	1;