Context Navigation

source: trunk/third/perl/makedef.pl @ 17035

Visit:

Revision 17035, 19.9 KB checked in by zacheiss, 22 years ago (diff)
This commit was generated by cvs2svn to compensate for changes in r17034, which included commits to RCS files with non-trunk default branches.

Line
1	#
2	# Create the export list for perl.
3	#
4	# Needed by WIN32 and OS/2 for creating perl.dll
5	# and by AIX for creating libperl.a when -Dusershrplib is in effect.
6	#
7	# reads global.sym, pp.sym, perlvars.h, intrpvar.h, thrdvar.h, config.h
8	# On OS/2 reads miniperl.map as well
9
10	my $PLATFORM;
11	my $CCTYPE;
12
13	my %bincompat5005 =
14	(
15	Perl_call_atexit => "perl_atexit",
16	Perl_eval_sv => "perl_eval_sv",
17	Perl_eval_pv => "perl_eval_pv",
18	Perl_call_argv => "perl_call_argv",
19	Perl_call_method => "perl_call_method",
20	Perl_call_pv => "perl_call_pv",
21	Perl_call_sv => "perl_call_sv",
22	Perl_get_av => "perl_get_av",
23	Perl_get_cv => "perl_get_cv",
24	Perl_get_hv => "perl_get_hv",
25	Perl_get_sv => "perl_get_sv",
26	Perl_init_i18nl10n => "perl_init_i18nl10n",
27	Perl_init_i18nl14n => "perl_init_i18nl14n",
28	Perl_new_collate => "perl_new_collate",
29	Perl_new_ctype => "perl_new_ctype",
30	Perl_new_numeric => "perl_new_numeric",
31	Perl_require_pv => "perl_require_pv",
32	Perl_safesyscalloc => "Perl_safecalloc",
33	Perl_safesysfree => "Perl_safefree",
34	Perl_safesysmalloc => "Perl_safemalloc",
35	Perl_safesysrealloc => "Perl_saferealloc",
36	Perl_set_numeric_local => "perl_set_numeric_local",
37	Perl_set_numeric_standard => "perl_set_numeric_standard",
38	Perl_malloc => "malloc",
39	Perl_mfree => "free",
40	Perl_realloc => "realloc",
41	Perl_calloc => "calloc",
42	);
43
44	my $bincompat5005 = join("\|", keys %bincompat5005);
45
46	while (@ARGV) {
47	my $flag = shift;
48	$define{$1} = 1 if ($flag =~ /^-D(\w+)$/);
49	$define{$1} = $2 if ($flag =~ /^-D(\w+)=(.+)$/);
50	$CCTYPE = $1 if ($flag =~ /^CCTYPE=(\w+)$/);
51	$PLATFORM = $1 if ($flag =~ /^PLATFORM=(\w+)$/);
52	}
53
54	my @PLATFORM = qw(aix win32 os2 MacOS);
55	my %PLATFORM;
56	@PLATFORM{@PLATFORM} = ();
57
58	defined $PLATFORM \|\| die "PLATFORM undefined, must be one of: @PLATFORM\n";
59	exists $PLATFORM{$PLATFORM} \|\| die "PLATFORM must be one of: @PLATFORM\n";
60
61	my $config_sh = "config.sh";
62	my $config_h = "config.h";
63	my $thrdvar_h = "thrdvar.h";
64	my $intrpvar_h = "intrpvar.h";
65	my $perlvars_h = "perlvars.h";
66	my $global_sym = "global.sym";
67	my $pp_sym = "pp.sym";
68	my $globvar_sym = "globvar.sym";
69	my $perlio_sym = "perlio.sym";
70
71	if ($PLATFORM eq 'aix') {
72	# Nothing for now.
73	}
74	elsif ($PLATFORM eq 'win32') {
75	$CCTYPE = "MSVC" unless defined $CCTYPE;
76	foreach ($thrdvar_h, $intrpvar_h, $perlvars_h, $global_sym, $pp_sym, $globvar_sym) {
77	s!^!..\\!;
78	}
79	}
80	elsif ($PLATFORM eq 'MacOS') {
81	foreach ($thrdvar_h, $intrpvar_h, $perlvars_h, $global_sym,
82	$pp_sym, $globvar_sym, $perlio_sym) {
83	s!^!::!;
84	}
85	}
86
87	unless ($PLATFORM eq 'win32' \|\| $PLATFORM eq 'MacOS') {
88	open(CFG,$config_sh) \|\| die "Cannot open $config_sh: $!\n";
89	while (<CFG>) {
90	if (/^(?:ccflags\|optimize)='(.+)'$/) {
91	$_ = $1;
92	$define{$1} = 1 while /-D(\w+)/g;
93	}
94	if ($PLATFORM eq 'os2') {
95	$CONFIG_ARGS = $1 if /^(?:config_args)='(.+)'$/;
96	$ARCHNAME = $1 if /^(?:archname)='(.+)'$/;
97	}
98	}
99	close(CFG);
100	}
101
102	open(CFG,$config_h) \|\| die "Cannot open $config_h: $!\n";
103	while (<CFG>) {
104	$define{$1} = 1 if /^\s#\sdefine\s+(MYMALLOC)\b/;
105	$define{$1} = 1 if /^\s#\sdefine\s+(USE_5005THREADS)\b/;
106	$define{$1} = 1 if /^\s#\sdefine\s+(USE_ITHREADS)\b/;
107	$define{$1} = 1 if /^\s#\sdefine\s+(USE_PERLIO)\b/;
108	$define{$1} = 1 if /^\s#\sdefine\s+(USE_SFIO)\b/;
109	$define{$1} = 1 if /^\s#\sdefine\s+(MULTIPLICITY)\b/;
110	$define{$1} = 1 if /^\s#\sdefine\s+(PERL_IMPLICIT_SYS)\b/;
111	$define{$1} = 1 if /^\s#\sdefine\s+(PERL_BINCOMPAT_5005)\b/;
112	}
113	close(CFG);
114
115	# perl.h logic duplication begins
116
117	if ($define{USE_ITHREADS}) {
118	if (!$define{MULTIPLICITY} && !$define{PERL_OBJECT}) {
119	$define{MULTIPLICITY} = 1;
120	}
121	}
122
123	$define{PERL_IMPLICIT_CONTEXT} \|\|=
124	$define{USE_ITHREADS} \|\|
125	$define{USE_5005THREADS} \|\|
126	$define{MULTIPLICITY} ;
127
128	if ($define{PERL_CAPI}) {
129	delete $define{PERL_OBJECT};
130	$define{MULTIPLICITY} = 1;
131	$define{PERL_IMPLICIT_CONTEXT} = 1;
132	$define{PERL_IMPLICIT_SYS} = 1;
133	}
134
135	if ($define{PERL_OBJECT}) {
136	$define{PERL_IMPLICIT_CONTEXT} = 1;
137	$define{PERL_IMPLICIT_SYS} = 1;
138	}
139
140	# perl.h logic duplication ends
141
142	if ($PLATFORM eq 'win32') {
143	warn join(' ',keys %define)."\n";
144	print "LIBRARY Perl56\n";
145	print "DESCRIPTION 'Perl interpreter'\n";
146	print "EXPORTS\n";
147	if ($define{PERL_IMPLICIT_SYS}) {
148	output_symbol("perl_get_host_info");
149	output_symbol("perl_alloc_override");
150	}
151	}
152	elsif ($PLATFORM eq 'os2') {
153	($v = $]) =~ s/(\d\.\d\d\d)(\d\d)$/$1_$2/;
154	$v .= '-thread' if $ARCHNAME =~ /-thread/;
155	#$sum = 0;
156	#for (split //, $v) {
157	# $sum = ($sum * 33) + ord;
158	# $sum &= 0xffffff;
159	#}
160	#$sum += $sum >> 5;
161	#$sum &= 0xffff;
162	#$sum = printf '%X', $sum;
163	($dll = $define{PERL_DLL}) =~ s/\.dll$//i;
164	# print STDERR "'$dll' <= '$define{PERL_DLL}'\n";
165	print <<"---EOP---";
166	LIBRARY '$dll' INITINSTANCE TERMINSTANCE
167	DESCRIPTION '\@#perl5-porters\@perl.org:$v#\@ Perl interpreter'
168	STACKSIZE 32768
169	CODE LOADONCALL
170	DATA LOADONCALL NONSHARED MULTIPLE
171	EXPORTS
172	---EOP---
173	}
174	elsif ($PLATFORM eq 'aix') {
175	print "#!\n";
176	}
177
178	my %skip;
179	my %export;
180
181	sub skip_symbols {
182	my $list = shift;
183	foreach my $symbol (@$list) {
184	$skip{$symbol} = 1;
185	}
186	}
187
188	sub emit_symbols {
189	my $list = shift;
190	foreach my $symbol (@$list) {
191	my $skipsym = $symbol;
192	# XXX hack
193	if ($define{PERL_OBJECT} \|\| $define{MULTIPLICITY}) {
194	$skipsym =~ s/^Perl_[GIT](\w+)_ptr$/PL_$1/;
195	}
196	emit_symbol($symbol) unless exists $skip{$skipsym};
197	}
198	}
199
200	if ($PLATFORM eq 'win32') {
201	skip_symbols [qw(
202	PL_statusvalue_vms
203	PL_archpat_auto
204	PL_cryptseen
205	PL_DBcv
206	PL_generation
207	PL_lastgotoprobe
208	PL_linestart
209	PL_modcount
210	PL_pending_ident
211	PL_sortcxix
212	PL_sublex_info
213	PL_timesbuf
214	main
215	Perl_ErrorNo
216	Perl_GetVars
217	Perl_do_exec3
218	Perl_do_ipcctl
219	Perl_do_ipcget
220	Perl_do_msgrcv
221	Perl_do_msgsnd
222	Perl_do_semop
223	Perl_do_shmio
224	Perl_dump_fds
225	Perl_init_thread_intern
226	Perl_my_bzero
227	Perl_my_htonl
228	Perl_my_ntohl
229	Perl_my_swap
230	Perl_my_chsize
231	Perl_same_dirent
232	Perl_setenv_getix
233	Perl_unlnk
234	Perl_watch
235	Perl_safexcalloc
236	Perl_safexmalloc
237	Perl_safexfree
238	Perl_safexrealloc
239	Perl_my_memcmp
240	Perl_my_memset
241	PL_cshlen
242	PL_cshname
243	PL_opsave
244	Perl_do_exec
245	Perl_getenv_len
246	Perl_my_pclose
247	Perl_my_popen
248	)];
249	}
250	elsif ($PLATFORM eq 'aix') {
251	skip_symbols([qw(
252	Perl_dump_fds
253	Perl_ErrorNo
254	Perl_GetVars
255	Perl_my_bcopy
256	Perl_my_bzero
257	Perl_my_chsize
258	Perl_my_htonl
259	Perl_my_memcmp
260	Perl_my_memset
261	Perl_my_ntohl
262	Perl_my_swap
263	Perl_safexcalloc
264	Perl_safexfree
265	Perl_safexmalloc
266	Perl_safexrealloc
267	Perl_same_dirent
268	Perl_unlnk
269	Perl_sys_intern_clear
270	Perl_sys_intern_dup
271	Perl_sys_intern_init
272	PL_cryptseen
273	PL_opsave
274	PL_statusvalue_vms
275	PL_sys_intern
276	)]);
277	}
278	elsif ($PLATFORM eq 'os2') {
279	emit_symbols([qw(
280	ctermid
281	get_sysinfo
282	Perl_OS2_init
283	OS2_Perl_data
284	dlopen
285	dlsym
286	dlerror
287	dlclose
288	my_tmpfile
289	my_tmpnam
290	my_flock
291	my_rmdir
292	my_mkdir
293	malloc_mutex
294	threads_mutex
295	nthreads
296	nthreads_cond
297	os2_cond_wait
298	os2_stat
299	pthread_join
300	pthread_create
301	pthread_detach
302	XS_Cwd_change_drive
303	XS_Cwd_current_drive
304	XS_Cwd_extLibpath
305	XS_Cwd_extLibpath_set
306	XS_Cwd_sys_abspath
307	XS_Cwd_sys_chdir
308	XS_Cwd_sys_cwd
309	XS_Cwd_sys_is_absolute
310	XS_Cwd_sys_is_relative
311	XS_Cwd_sys_is_rooted
312	XS_DynaLoader_mod2fname
313	XS_File__Copy_syscopy
314	Perl_Register_MQ
315	Perl_Deregister_MQ
316	Perl_Serve_Messages
317	Perl_Process_Messages
318	init_PMWIN_entries
319	PMWIN_entries
320	Perl_hab_GET
321	)]);
322	}
323	elsif ($PLATFORM eq 'MacOS') {
324	skip_symbols [qw(
325	Perl_GetVars
326	PL_cryptseen
327	PL_cshlen
328	PL_cshname
329	PL_statusvalue_vms
330	PL_sys_intern
331	PL_opsave
332	PL_timesbuf
333	Perl_dump_fds
334	Perl_my_bcopy
335	Perl_my_bzero
336	Perl_my_chsize
337	Perl_my_htonl
338	Perl_my_memcmp
339	Perl_my_memset
340	Perl_my_ntohl
341	Perl_my_swap
342	Perl_safexcalloc
343	Perl_safexfree
344	Perl_safexmalloc
345	Perl_safexrealloc
346	Perl_unlnk
347	Perl_sys_intern_clear
348	Perl_sys_intern_init
349	)];
350	}
351
352
353	unless ($define{'DEBUGGING'}) {
354	skip_symbols [qw(
355	Perl_deb_growlevel
356	Perl_debop
357	Perl_debprofdump
358	Perl_debstack
359	Perl_debstackptrs
360	Perl_runops_debug
361	Perl_sv_peek
362	PL_block_type
363	PL_watchaddr
364	PL_watchok
365	)];
366	}
367
368	if ($define{'PERL_IMPLICIT_SYS'}) {
369	skip_symbols [qw(
370	Perl_getenv_len
371	Perl_my_popen
372	Perl_my_pclose
373	)];
374	}
375	else {
376	skip_symbols [qw(
377	PL_Mem
378	PL_MemShared
379	PL_MemParse
380	PL_Env
381	PL_StdIO
382	PL_LIO
383	PL_Dir
384	PL_Sock
385	PL_Proc
386	)];
387	}
388
389	unless ($define{'PERL_FLEXIBLE_EXCEPTIONS'}) {
390	skip_symbols [qw(
391	PL_protect
392	Perl_default_protect
393	Perl_vdefault_protect
394	)];
395	}
396
397	if ($define{'MYMALLOC'}) {
398	emit_symbols [qw(
399	Perl_dump_mstats
400	Perl_get_mstats
401	Perl_malloc
402	Perl_mfree
403	Perl_realloc
404	Perl_calloc
405	Perl_strdup
406	Perl_putenv
407	)];
408	if ($define{'USE_5005THREADS'} \|\| $define{'USE_ITHREADS'}) {
409	emit_symbols [qw(
410	PL_malloc_mutex
411	)];
412	}
413	else {
414	skip_symbols [qw(
415	PL_malloc_mutex
416	)];
417	}
418	}
419	else {
420	skip_symbols [qw(
421	PL_malloc_mutex
422	Perl_dump_mstats
423	Perl_get_mstats
424	Perl_malloc
425	Perl_mfree
426	Perl_realloc
427	Perl_calloc
428	Perl_malloced_size
429	)];
430	}
431
432	unless ($define{'USE_5005THREADS'} \|\| $define{'USE_ITHREADS'}) {
433	skip_symbols [qw(
434	PL_thr_key
435	)];
436	}
437
438	unless ($define{'USE_5005THREADS'}) {
439	skip_symbols [qw(
440	PL_sv_mutex
441	PL_strtab_mutex
442	PL_svref_mutex
443	PL_cred_mutex
444	PL_eval_mutex
445	PL_fdpid_mutex
446	PL_sv_lock_mutex
447	PL_eval_cond
448	PL_eval_owner
449	PL_threads_mutex
450	PL_nthreads
451	PL_nthreads_cond
452	PL_threadnum
453	PL_threadsv_names
454	PL_thrsv
455	PL_vtbl_mutex
456	Perl_condpair_magic
457	Perl_new_struct_thread
458	Perl_per_thread_magicals
459	Perl_thread_create
460	Perl_find_threadsv
461	Perl_unlock_condpair
462	Perl_magic_mutexfree
463	Perl_sv_lock
464	)];
465	}
466
467	unless ($define{'USE_ITHREADS'}) {
468	skip_symbols [qw(
469	PL_ptr_table
470	PL_op_mutex
471	Perl_dirp_dup
472	Perl_cx_dup
473	Perl_si_dup
474	Perl_any_dup
475	Perl_ss_dup
476	Perl_fp_dup
477	Perl_gp_dup
478	Perl_he_dup
479	Perl_mg_dup
480	Perl_re_dup
481	Perl_sv_dup
482	Perl_sys_intern_dup
483	Perl_ptr_table_fetch
484	Perl_ptr_table_new
485	Perl_ptr_table_split
486	Perl_ptr_table_store
487	Perl_ptr_table_clear
488	Perl_ptr_table_free
489	perl_clone
490	perl_clone_using
491	)];
492	}
493
494	unless ($define{'PERL_IMPLICIT_CONTEXT'}) {
495	skip_symbols [qw(
496	Perl_croak_nocontext
497	Perl_die_nocontext
498	Perl_deb_nocontext
499	Perl_form_nocontext
500	Perl_load_module_nocontext
501	Perl_mess_nocontext
502	Perl_warn_nocontext
503	Perl_warner_nocontext
504	Perl_newSVpvf_nocontext
505	Perl_sv_catpvf_nocontext
506	Perl_sv_setpvf_nocontext
507	Perl_sv_catpvf_mg_nocontext
508	Perl_sv_setpvf_mg_nocontext
509	)];
510	}
511
512	unless ($define{'PERL_IMPLICIT_SYS'}) {
513	skip_symbols [qw(
514	perl_alloc_using
515	perl_clone_using
516	)];
517	}
518
519	unless ($define{'FAKE_THREADS'}) {
520	skip_symbols [qw(PL_curthr)];
521	}
522
523	sub readvar {
524	my $file = shift;
525	my $proc = shift \|\| sub { "PL_$_[2]" };
526	open(VARS,$file) \|\| die "Cannot open $file: $!\n";
527	my @syms;
528	while (<VARS>) {
529	# All symbols have a Perl_ prefix because that's what embed.h
530	# sticks in front of them.
531	push(@syms, &$proc($1,$2,$3)) if (/\bPERLVAR(A?I?C?)\(([IGT])(\w+)/);
532	}
533	close(VARS);
534	return \@syms;
535	}
536
537	if ($define{'USE_5005THREADS'}) {
538	my $thrd = readvar($thrdvar_h);
539	skip_symbols $thrd;
540	}
541
542	if ($define{'PERL_GLOBAL_STRUCT'}) {
543	my $global = readvar($perlvars_h);
544	skip_symbols $global;
545	emit_symbol('Perl_GetVars');
546	emit_symbols [qw(PL_Vars PL_VarsPtr)] unless $CCTYPE eq 'GCC';
547	}
548
549	# functions from *.sym files
550
551	my @syms = ($global_sym, $globvar_sym); # $pp_sym is not part of the API
552
553	if ($define{'USE_PERLIO'}) {
554	push @syms, $perlio_sym;
555	if ($define{'USE_SFIO'}) {
556	# SFIO defines most of the PerlIO routines as macros
557	skip_symbols [qw(
558	PerlIO_canset_cnt
559	PerlIO_clearerr
560	PerlIO_close
561	PerlIO_eof
562	PerlIO_error
563	PerlIO_exportFILE
564	PerlIO_fast_gets
565	PerlIO_fdopen
566	PerlIO_fileno
567	PerlIO_findFILE
568	PerlIO_flush
569	PerlIO_get_base
570	PerlIO_get_bufsiz
571	PerlIO_get_cnt
572	PerlIO_get_ptr
573	PerlIO_getc
574	PerlIO_getname
575	PerlIO_has_base
576	PerlIO_has_cntptr
577	PerlIO_importFILE
578	PerlIO_open
579	PerlIO_printf
580	PerlIO_putc
581	PerlIO_puts
582	PerlIO_read
583	PerlIO_releaseFILE
584	PerlIO_reopen
585	PerlIO_rewind
586	PerlIO_seek
587	PerlIO_set_cnt
588	PerlIO_set_ptrcnt
589	PerlIO_setlinebuf
590	PerlIO_sprintf
591	PerlIO_stderr
592	PerlIO_stdin
593	PerlIO_stdout
594	PerlIO_stdoutf
595	PerlIO_tell
596	PerlIO_ungetc
597	PerlIO_vprintf
598	PerlIO_write
599	)];
600	}
601	}
602
603	for my $syms (@syms) {
604	open (GLOBAL, "<$syms") \|\| die "failed to open $syms: $!\n";
605	while (<GLOBAL>) {
606	next if (!/^[A-Za-z]/);
607	# Functions have a Perl_ prefix
608	# Variables have a PL_ prefix
609	chomp($_);
610	my $symbol = ($syms =~ /var\.sym$/i ? "PL_" : "");
611	$symbol .= $_;
612	emit_symbol($symbol) unless exists $skip{$symbol};
613	}
614	close(GLOBAL);
615	}
616
617	# variables
618
619	if ($define{'PERL_OBJECT'} \|\| $define{'MULTIPLICITY'}) {
620	for my $f ($perlvars_h, $intrpvar_h, $thrdvar_h) {
621	my $glob = readvar($f, sub { "Perl_" . $_[1] . $_[2] . "_ptr" });
622	emit_symbols $glob;
623	}
624	# XXX AIX seems to want the perlvars.h symbols, for some reason
625	if ($PLATFORM eq 'aix') {
626	my $glob = readvar($perlvars_h);
627	emit_symbols $glob;
628	}
629	}
630	else {
631	unless ($define{'PERL_GLOBAL_STRUCT'}) {
632	my $glob = readvar($perlvars_h);
633	emit_symbols $glob;
634	}
635	unless ($define{'MULTIPLICITY'}) {
636	my $glob = readvar($intrpvar_h);
637	emit_symbols $glob;
638	}
639	unless ($define{'MULTIPLICITY'} \|\| $define{'USE_5005THREADS'}) {
640	my $glob = readvar($thrdvar_h);
641	emit_symbols $glob;
642	}
643	}
644
645	sub try_symbol {
646	my $symbol = shift;
647
648	return if $symbol !~ /^[A-Za-z]/;
649	return if $symbol =~ /^\#/;
650	$symbol =~s/\r//g;
651	chomp($symbol);
652	return if exists $skip{$symbol};
653	emit_symbol($symbol);
654	}
655
656	while (<DATA>) {
657	try_symbol($_);
658	}
659
660	if ($PLATFORM eq 'win32') {
661	foreach my $symbol (qw(
662	boot_DynaLoader
663	Perl_init_os_extras
664	Perl_thread_create
665	Perl_win32_init
666	RunPerl
667	win32_errno
668	win32_environ
669	win32_stdin
670	win32_stdout
671	win32_stderr
672	win32_ferror
673	win32_feof
674	win32_strerror
675	win32_fprintf
676	win32_printf
677	win32_vfprintf
678	win32_vprintf
679	win32_fread
680	win32_fwrite
681	win32_fopen
682	win32_fdopen
683	win32_freopen
684	win32_fclose
685	win32_fputs
686	win32_fputc
687	win32_ungetc
688	win32_getc
689	win32_fileno
690	win32_clearerr
691	win32_fflush
692	win32_ftell
693	win32_fseek
694	win32_fgetpos
695	win32_fsetpos
696	win32_rewind
697	win32_tmpfile
698	win32_abort
699	win32_fstat
700	win32_stat
701	win32_pipe
702	win32_popen
703	win32_pclose
704	win32_rename
705	win32_setmode
706	win32_lseek
707	win32_tell
708	win32_dup
709	win32_dup2
710	win32_open
711	win32_close
712	win32_eof
713	win32_read
714	win32_write
715	win32_spawnvp
716	win32_mkdir
717	win32_rmdir
718	win32_chdir
719	win32_flock
720	win32_execv
721	win32_execvp
722	win32_htons
723	win32_ntohs
724	win32_htonl
725	win32_ntohl
726	win32_inet_addr
727	win32_inet_ntoa
728	win32_socket
729	win32_bind
730	win32_listen
731	win32_accept
732	win32_connect
733	win32_send
734	win32_sendto
735	win32_recv
736	win32_recvfrom
737	win32_shutdown
738	win32_closesocket
739	win32_ioctlsocket
740	win32_setsockopt
741	win32_getsockopt
742	win32_getpeername
743	win32_getsockname
744	win32_gethostname
745	win32_gethostbyname
746	win32_gethostbyaddr
747	win32_getprotobyname
748	win32_getprotobynumber
749	win32_getservbyname
750	win32_getservbyport
751	win32_select
752	win32_endhostent
753	win32_endnetent
754	win32_endprotoent
755	win32_endservent
756	win32_getnetent
757	win32_getnetbyname
758	win32_getnetbyaddr
759	win32_getprotoent
760	win32_getservent
761	win32_sethostent
762	win32_setnetent
763	win32_setprotoent
764	win32_setservent
765	win32_getenv
766	win32_putenv
767	win32_perror
768	win32_setbuf
769	win32_setvbuf
770	win32_flushall
771	win32_fcloseall
772	win32_fgets
773	win32_gets
774	win32_fgetc
775	win32_putc
776	win32_puts
777	win32_getchar
778	win32_putchar
779	win32_malloc
780	win32_calloc
781	win32_realloc
782	win32_free
783	win32_sleep
784	win32_times
785	win32_access
786	win32_alarm
787	win32_chmod
788	win32_open_osfhandle
789	win32_get_osfhandle
790	win32_ioctl
791	win32_link
792	win32_unlink
793	win32_utime
794	win32_uname
795	win32_wait
796	win32_waitpid
797	win32_kill
798	win32_str_os_error
799	win32_opendir
800	win32_readdir
801	win32_telldir
802	win32_seekdir
803	win32_rewinddir
804	win32_closedir
805	win32_longpath
806	win32_os_id
807	win32_getpid
808	win32_crypt
809	win32_dynaload
810	))
811	{
812	try_symbol($symbol);
813	}
814	}
815	elsif ($PLATFORM eq 'os2') {
816	open MAP, 'miniperl.map' or die 'Cannot read miniperl.map';
817	/^\s*[\da-f:]+\s+(\w+)/i and $mapped{$1}++ foreach <MAP>;
818	close MAP or die 'Cannot close miniperl.map';
819
820	@missing = grep { !exists $mapped{$_} and !exists $bincompat5005{$_} }
821	keys %export;
822	delete $export{$_} foreach @missing;
823	}
824	elsif ($PLATFORM eq 'MacOS') {
825	open MACSYMS, 'macperl.sym' or die 'Cannot read macperl.sym';
826
827	while (<MACSYMS>) {
828	try_symbol($_);
829	}
830
831	close MACSYMS;
832	}
833
834	# Now all symbols should be defined because
835	# next we are going to output them.
836
837	foreach my $symbol (sort keys %export) {
838	output_symbol($symbol);
839	}
840
841	sub emit_symbol {
842	my $symbol = shift;
843	chomp($symbol);
844	$export{$symbol} = 1;
845	}
846
847	sub output_symbol {
848	my $symbol = shift;
849	$symbol = $bincompat5005{$symbol}
850	if $define{PERL_BINCOMPAT_5005} and $symbol =~ /^($bincompat5005)$/;
851	if ($PLATFORM eq 'win32') {
852	$symbol = "_$symbol" if $CCTYPE eq 'BORLAND';
853	print "\t$symbol\n";
854	# XXX: binary compatibility between compilers is an exercise
855	# in frustration :-(
856	# if ($CCTYPE eq "BORLAND") {
857	# # workaround Borland quirk by exporting both the straight
858	# # name and a name with leading underscore. Note the
859	# # alias must come after the symbol itself, if both
860	# # are to be exported. (Linker bug?)
861	# print "\t_$symbol\n";
862	# print "\t$symbol = _$symbol\n";
863	# }
864	# elsif ($CCTYPE eq 'GCC') {
865	# # Symbols have leading _ whole process is $%@"% slow
866	# # so skip aliases for now
867	# nprint "\t$symbol\n";
868	# }
869	# else {
870	# # for binary coexistence, export both the symbol and
871	# # alias with leading underscore
872	# print "\t$symbol\n";
873	# print "\t_$symbol = $symbol\n";
874	# }
875	}
876	elsif ($PLATFORM eq 'os2') {
877	print qq( "$symbol"\n);
878	}
879	elsif ($PLATFORM eq 'aix' \|\| $PLATFORM eq 'MacOS') {
880	print "$symbol\n";
881	}
882	}
883
884	1;
885	__DATA__
886	# extra globals not included above.
887	perl_alloc
888	perl_alloc_using
889	perl_clone
890	perl_clone_using
891	perl_construct
892	perl_destruct
893	perl_free
894	perl_parse
895	perl_run

Note: See TracBrowser for help on using the repository browser.

Download in other formats: