ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/cvsroot/staticperl/perl/makedef.pl
Revision: 1.1
Committed: Thu Jun 30 14:26:41 2005 UTC (21 years, 3 months ago) by root
Content type: text/plain
Branch: MAIN
CVS Tags: PERL-5-8-7, HEAD
Branch point for: PERL
Log Message:
*** empty log message ***

File Contents

# User Rev Content
1 root 1.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     # and by MacOS Classic.
7     #
8     # reads global.sym, pp.sym, perlvars.h, intrpvar.h, thrdvar.h, config.h
9     # On OS/2 reads miniperl.map and the previous version of perl5.def as well
10    
11     my $PLATFORM;
12     my $CCTYPE;
13    
14     while (@ARGV) {
15     my $flag = shift;
16     if ($flag =~ s/^CC_FLAGS=/ /) {
17     for my $fflag ($flag =~ /(?:^|\s)-D(\S+)/g) {
18     $fflag .= '=1' unless $fflag =~ /^(\w+)=/;
19     $define{$1} = $2 if $fflag =~ /^(\w+)=(.+)$/;
20     }
21     next;
22     }
23     $define{$1} = 1 if ($flag =~ /^-D(\w+)$/);
24     $define{$1} = $2 if ($flag =~ /^-D(\w+)=(.+)$/);
25     $CCTYPE = $1 if ($flag =~ /^CCTYPE=(\w+)$/);
26     $PLATFORM = $1 if ($flag =~ /^PLATFORM=(\w+)$/);
27     if ($PLATFORM eq 'netware') {
28     $FILETYPE = $1 if ($flag =~ /^FILETYPE=(\w+)$/);
29     }
30     }
31    
32     my @PLATFORM = qw(aix win32 wince os2 MacOS netware);
33     my %PLATFORM;
34     @PLATFORM{@PLATFORM} = ();
35    
36     defined $PLATFORM || die "PLATFORM undefined, must be one of: @PLATFORM\n";
37     exists $PLATFORM{$PLATFORM} || die "PLATFORM must be one of: @PLATFORM\n";
38    
39     my %exportperlmalloc =
40     (
41     Perl_malloc => "malloc",
42     Perl_mfree => "free",
43     Perl_realloc => "realloc",
44     Perl_calloc => "calloc",
45     );
46    
47     my $exportperlmalloc = $PLATFORM eq 'os2';
48    
49     my $config_sh = "config.sh";
50     my $config_h = "config.h";
51     my $thrdvar_h = "thrdvar.h";
52     my $intrpvar_h = "intrpvar.h";
53     my $perlvars_h = "perlvars.h";
54     my $global_sym = "global.sym";
55     my $pp_sym = "pp.sym";
56     my $globvar_sym = "globvar.sym";
57     my $perlio_sym = "perlio.sym";
58     my $static_ext = "";
59    
60     if ($PLATFORM eq 'aix') {
61     # Nothing for now.
62     }
63     elsif ($PLATFORM =~ /^win(?:32|ce)$/ || $PLATFORM eq 'netware') {
64     $CCTYPE = "MSVC" unless defined $CCTYPE;
65     foreach ($thrdvar_h, $intrpvar_h, $perlvars_h, $global_sym,
66     $pp_sym, $globvar_sym, $perlio_sym) {
67     s!^!..\\!;
68     }
69     }
70     elsif ($PLATFORM eq 'MacOS') {
71     foreach ($thrdvar_h, $intrpvar_h, $perlvars_h, $global_sym,
72     $pp_sym, $globvar_sym, $perlio_sym) {
73     s!^!::!;
74     }
75     }
76    
77     unless ($PLATFORM eq 'win32' || $PLATFORM eq 'wince' || $PLATFORM eq 'MacOS' || $PLATFORM eq 'netware') {
78     open(CFG,$config_sh) || die "Cannot open $config_sh: $!\n";
79     while (<CFG>) {
80     if (/^(?:ccflags|optimize)='(.+)'$/) {
81     $_ = $1;
82     $define{$1} = 1 while /-D(\w+)/g;
83     }
84     if ($PLATFORM eq 'os2') {
85     $CONFIG_ARGS = $1 if /^config_args='(.+)'$/;
86     $ARCHNAME = $1 if /^archname='(.+)'$/;
87     $PATCHLEVEL = $1 if /^perl_patchlevel='(.+)'$/;
88     }
89     }
90     close(CFG);
91     }
92     if ($PLATFORM eq 'win32' || $PLATFORM eq 'wince') {
93     open(CFG,"<..\\$config_sh") || die "Cannot open ..\\$config_sh: $!\n";
94     if ((join '', <CFG>) =~ /^static_ext='(.*)'$/m) {
95     $static_ext = $1;
96     }
97     close(CFG);
98     }
99    
100     open(CFG,$config_h) || die "Cannot open $config_h: $!\n";
101     while (<CFG>) {
102     $define{$1} = 1 if /^\s*#\s*define\s+(MYMALLOC)\b/;
103     $define{$1} = 1 if /^\s*#\s*define\s+(MULTIPLICITY)\b/;
104     $define{$1} = 1 if /^\s*#\s*define\s+(PERL_\w+)\b/;
105     $define{$1} = 1 if /^\s*#\s*define\s+(USE_\w+)\b/;
106     }
107     close(CFG);
108    
109     # perl.h logic duplication begins
110    
111     if ($define{PERL_IMPLICIT_SYS}) {
112     $define{PL_OP_SLAB_ALLOC} = 1;
113     }
114    
115     if ($define{USE_ITHREADS}) {
116     if (!$define{MULTIPLICITY}) {
117     $define{MULTIPLICITY} = 1;
118     }
119     }
120    
121     $define{PERL_IMPLICIT_CONTEXT} ||=
122     $define{USE_ITHREADS} ||
123     $define{USE_5005THREADS} ||
124     $define{MULTIPLICITY} ;
125    
126     if ($define{USE_ITHREADS} && $PLATFORM ne 'win32' && $^O ne 'darwin') {
127     $define{USE_REENTRANT_API} = 1;
128     }
129    
130     # perl.h logic duplication ends
131    
132     my $sym_ord = 0;
133    
134     if ($PLATFORM =~ /^win(?:32|ce)$/) {
135     warn join(' ',keys %define)."\n";
136     ($dll = ($define{PERL_DLL} || "perl58")) =~ s/\.dll$//i;
137     print "LIBRARY $dll\n";
138     print "DESCRIPTION 'Perl interpreter'\n";
139     print "EXPORTS\n";
140     if ($define{PERL_IMPLICIT_SYS}) {
141     output_symbol("perl_get_host_info");
142     output_symbol("perl_alloc_override");
143     }
144     if ($define{USE_ITHREADS} and $define{PERL_IMPLICIT_SYS}) {
145     output_symbol("perl_clone_host");
146     }
147     }
148     elsif ($PLATFORM eq 'os2') {
149     if (open my $fh, '<', 'perl5.def') {
150     while (<$fh>) {
151     last if /^\s*EXPORTS\b/;
152     }
153     while (<$fh>) {
154     $ordinal{$1} = $2 if /^\s*"(\w+)"\s*(?:=\s*"\w+"\s*)?\@(\d+)\s*$/;
155     # This allows skipping ordinals which were used in older versions
156     $sym_ord = $1 if /^\s*;\s*LAST_ORDINAL\s*=\s*(\d+)\s*$/;
157     }
158     $sym_ord < $_ and $sym_ord = $_ for values %ordinal; # Take the max
159     }
160     ($v = $]) =~ s/(\d\.\d\d\d)(\d\d)$/$1_$2/;
161     $v .= '-thread' if $ARCHNAME =~ /-thread/;
162     ($dll = $define{PERL_DLL}) =~ s/\.dll$//i;
163     $v .= "\@$PATCHLEVEL" if $PATCHLEVEL;
164     $d = "DESCRIPTION '\@#perl5-porters\@perl.org:$v#\@ Perl interpreter, configured as $CONFIG_ARGS'";
165     $d = substr($d, 0, 249) . "...'" if length $d > 253;
166     print <<"---EOP---";
167     LIBRARY '$dll' INITINSTANCE TERMINSTANCE
168     $d
169     STACKSIZE 32768
170     CODE LOADONCALL
171     DATA LOADONCALL NONSHARED MULTIPLE
172     EXPORTS
173     ---EOP---
174     }
175     elsif ($PLATFORM eq 'aix') {
176     $OSVER = `uname -v`;
177     chop $OSVER;
178     $OSREL = `uname -r`;
179     chop $OSREL;
180     if ($OSVER > 4 || ($OSVER == 4 && $OSREL >= 3)) {
181     print "#! ..\n";
182     } else {
183     print "#!\n";
184     }
185     }
186     elsif ($PLATFORM eq 'netware') {
187     if ($FILETYPE eq 'def') {
188     print "LIBRARY perl58\n";
189     print "DESCRIPTION 'Perl interpreter for NetWare'\n";
190     print "EXPORTS\n";
191     }
192     if ($define{PERL_IMPLICIT_SYS}) {
193     output_symbol("perl_get_host_info");
194     output_symbol("perl_alloc_override");
195     output_symbol("perl_clone_host");
196     }
197     }
198    
199     my %skip;
200     my %export;
201    
202     sub skip_symbols {
203     my $list = shift;
204     foreach my $symbol (@$list) {
205     $skip{$symbol} = 1;
206     }
207     }
208    
209     sub emit_symbols {
210     my $list = shift;
211     foreach my $symbol (@$list) {
212     my $skipsym = $symbol;
213     # XXX hack
214     if ($define{MULTIPLICITY}) {
215     $skipsym =~ s/^Perl_[GIT](\w+)_ptr$/PL_$1/;
216     }
217     emit_symbol($symbol) unless exists $skip{$skipsym};
218     }
219     }
220    
221     if ($PLATFORM eq 'win32') {
222     skip_symbols [qw(
223     PL_statusvalue_vms
224     PL_archpat_auto
225     PL_cryptseen
226     PL_DBcv
227     PL_generation
228     PL_lastgotoprobe
229     PL_linestart
230     PL_modcount
231     PL_pending_ident
232     PL_sortcxix
233     PL_sublex_info
234     PL_timesbuf
235     main
236     Perl_ErrorNo
237     Perl_GetVars
238     Perl_do_exec3
239     Perl_do_ipcctl
240     Perl_do_ipcget
241     Perl_do_msgrcv
242     Perl_do_msgsnd
243     Perl_do_semop
244     Perl_do_shmio
245     Perl_dump_fds
246     Perl_init_thread_intern
247     Perl_my_bzero
248     Perl_my_bcopy
249     Perl_my_htonl
250     Perl_my_ntohl
251     Perl_my_swap
252     Perl_my_chsize
253     Perl_same_dirent
254     Perl_setenv_getix
255     Perl_unlnk
256     Perl_watch
257     Perl_safexcalloc
258     Perl_safexmalloc
259     Perl_safexfree
260     Perl_safexrealloc
261     Perl_my_memcmp
262     Perl_my_memset
263     PL_cshlen
264     PL_cshname
265     PL_opsave
266     Perl_do_exec
267     Perl_getenv_len
268     Perl_my_pclose
269     Perl_my_popen
270     )];
271     }
272     else {
273     skip_symbols [qw(
274     Perl_do_spawn
275     Perl_do_spawn_nowait
276     Perl_do_aspawn
277     )];
278     }
279     if ($PLATFORM eq 'wince') {
280     skip_symbols [qw(
281     PL_statusvalue_vms
282     PL_archpat_auto
283     PL_cryptseen
284     PL_DBcv
285     PL_generation
286     PL_lastgotoprobe
287     PL_linestart
288     PL_modcount
289     PL_pending_ident
290     PL_sortcxix
291     PL_sublex_info
292     PL_timesbuf
293     PL_collation_ix
294     PL_collation_name
295     PL_collation_standard
296     PL_collxfrm_base
297     PL_collxfrm_mult
298     PL_numeric_compat1
299     PL_numeric_local
300     PL_numeric_name
301     PL_numeric_radix_sv
302     PL_numeric_standard
303     PL_vtbl_collxfrm
304     Perl_sv_collxfrm
305     setgid
306     setuid
307     win32_free_childdir
308     win32_free_childenv
309     win32_get_childdir
310     win32_get_childenv
311     win32_spawnvp
312     main
313     Perl_ErrorNo
314     Perl_GetVars
315     Perl_do_exec3
316     Perl_do_ipcctl
317     Perl_do_ipcget
318     Perl_do_msgrcv
319     Perl_do_msgsnd
320     Perl_do_semop
321     Perl_do_shmio
322     Perl_dump_fds
323     Perl_init_thread_intern
324     Perl_my_bzero
325     Perl_my_bcopy
326     Perl_my_htonl
327     Perl_my_ntohl
328     Perl_my_swap
329     Perl_my_chsize
330     Perl_same_dirent
331     Perl_setenv_getix
332     Perl_unlnk
333     Perl_watch
334     Perl_safexcalloc
335     Perl_safexmalloc
336     Perl_safexfree
337     Perl_safexrealloc
338     Perl_my_memcmp
339     Perl_my_memset
340     PL_cshlen
341     PL_cshname
342     PL_opsave
343     Perl_do_exec
344     Perl_getenv_len
345     Perl_my_pclose
346     Perl_my_popen
347     )];
348     }
349     elsif ($PLATFORM eq 'aix') {
350     skip_symbols([qw(
351     Perl_dump_fds
352     Perl_ErrorNo
353     Perl_GetVars
354     Perl_my_bcopy
355     Perl_my_bzero
356     Perl_my_chsize
357     Perl_my_htonl
358     Perl_my_memcmp
359     Perl_my_memset
360     Perl_my_ntohl
361     Perl_my_swap
362     Perl_safexcalloc
363     Perl_safexfree
364     Perl_safexmalloc
365     Perl_safexrealloc
366     Perl_same_dirent
367     Perl_unlnk
368     Perl_sys_intern_clear
369     Perl_sys_intern_dup
370     Perl_sys_intern_init
371     PL_cryptseen
372     PL_opsave
373     PL_statusvalue_vms
374     PL_sys_intern
375     )]);
376     }
377     elsif ($PLATFORM eq 'os2') {
378     emit_symbols([qw(
379     ctermid
380     get_sysinfo
381     Perl_OS2_init
382     Perl_OS2_init3
383     Perl_OS2_term
384     OS2_Perl_data
385     dlopen
386     dlsym
387     dlerror
388     dlclose
389     dup2
390     dup
391     my_tmpfile
392     my_tmpnam
393     my_flock
394     my_rmdir
395     my_mkdir
396     my_getpwuid
397     my_getpwnam
398     my_getpwent
399     my_setpwent
400     my_endpwent
401     fork_with_resources
402     croak_with_os2error
403     setgrent
404     endgrent
405     getgrent
406     malloc_mutex
407     threads_mutex
408     nthreads
409     nthreads_cond
410     os2_cond_wait
411     os2_stat
412     os2_execname
413     async_mssleep
414     msCounter
415     InfoTable
416     pthread_join
417     pthread_create
418     pthread_detach
419     XS_Cwd_change_drive
420     XS_Cwd_current_drive
421     XS_Cwd_extLibpath
422     XS_Cwd_extLibpath_set
423     XS_Cwd_sys_abspath
424     XS_Cwd_sys_chdir
425     XS_Cwd_sys_cwd
426     XS_Cwd_sys_is_absolute
427     XS_Cwd_sys_is_relative
428     XS_Cwd_sys_is_rooted
429     XS_DynaLoader_mod2fname
430     XS_File__Copy_syscopy
431     Perl_Register_MQ
432     Perl_Deregister_MQ
433     Perl_Serve_Messages
434     Perl_Process_Messages
435     init_PMWIN_entries
436     PMWIN_entries
437     Perl_hab_GET
438     loadByOrdinal
439     pExtFCN
440     os2error
441     ResetWinError
442     CroakWinError
443     PL_do_undump
444     )]);
445     emit_symbols([qw(os2_cond_wait
446     pthread_join
447     pthread_create
448     pthread_detach
449     )])
450     if $define{'USE_5005THREADS'} or $define{'USE_ITHREADS'};
451     }
452     elsif ($PLATFORM eq 'MacOS') {
453     skip_symbols [qw(
454     Perl_GetVars
455     PL_cryptseen
456     PL_cshlen
457     PL_cshname
458     PL_statusvalue_vms
459     PL_sys_intern
460     PL_opsave
461     PL_timesbuf
462     Perl_dump_fds
463     Perl_my_bcopy
464     Perl_my_bzero
465     Perl_my_chsize
466     Perl_my_htonl
467     Perl_my_memcmp
468     Perl_my_memset
469     Perl_my_ntohl
470     Perl_my_swap
471     Perl_safexcalloc
472     Perl_safexfree
473     Perl_safexmalloc
474     Perl_safexrealloc
475     Perl_unlnk
476     Perl_sys_intern_clear
477     Perl_sys_intern_init
478     )];
479     }
480     elsif ($PLATFORM eq 'netware') {
481     skip_symbols [qw(
482     PL_statusvalue_vms
483     PL_archpat_auto
484     PL_cryptseen
485     PL_DBcv
486     PL_generation
487     PL_lastgotoprobe
488     PL_linestart
489     PL_modcount
490     PL_pending_ident
491     PL_sortcxix
492     PL_sublex_info
493     PL_timesbuf
494     main
495     Perl_ErrorNo
496     Perl_GetVars
497     Perl_do_exec3
498     Perl_do_ipcctl
499     Perl_do_ipcget
500     Perl_do_msgrcv
501     Perl_do_msgsnd
502     Perl_do_semop
503     Perl_do_shmio
504     Perl_dump_fds
505     Perl_init_thread_intern
506     Perl_my_bzero
507     Perl_my_htonl
508     Perl_my_ntohl
509     Perl_my_swap
510     Perl_my_chsize
511     Perl_same_dirent
512     Perl_setenv_getix
513     Perl_unlnk
514     Perl_watch
515     Perl_safexcalloc
516     Perl_safexmalloc
517     Perl_safexfree
518     Perl_safexrealloc
519     Perl_my_memcmp
520     Perl_my_memset
521     PL_cshlen
522     PL_cshname
523     PL_opsave
524     Perl_do_exec
525     Perl_getenv_len
526     Perl_my_pclose
527     Perl_my_popen
528     Perl_sys_intern_init
529     Perl_sys_intern_dup
530     Perl_sys_intern_clear
531     Perl_my_bcopy
532     Perl_PerlIO_write
533     Perl_PerlIO_unread
534     Perl_PerlIO_tell
535     Perl_PerlIO_stdout
536     Perl_PerlIO_stdin
537     Perl_PerlIO_stderr
538     Perl_PerlIO_setlinebuf
539     Perl_PerlIO_set_ptrcnt
540     Perl_PerlIO_set_cnt
541     Perl_PerlIO_seek
542     Perl_PerlIO_read
543     Perl_PerlIO_get_ptr
544     Perl_PerlIO_get_cnt
545     Perl_PerlIO_get_bufsiz
546     Perl_PerlIO_get_base
547     Perl_PerlIO_flush
548     Perl_PerlIO_fill
549     Perl_PerlIO_fileno
550     Perl_PerlIO_error
551     Perl_PerlIO_eof
552     Perl_PerlIO_close
553     Perl_PerlIO_clearerr
554     PerlIO_perlio
555     )];
556     }
557    
558     unless ($define{'DEBUGGING'}) {
559     skip_symbols [qw(
560     Perl_deb_growlevel
561     Perl_debop
562     Perl_debprofdump
563     Perl_debstack
564     Perl_debstackptrs
565     Perl_sv_peek
566     PL_block_type
567     PL_watchaddr
568     PL_watchok
569     )];
570     }
571    
572     if ($define{'PERL_IMPLICIT_SYS'}) {
573     skip_symbols [qw(
574     Perl_getenv_len
575     Perl_my_popen
576     Perl_my_pclose
577     )];
578     }
579     else {
580     skip_symbols [qw(
581     PL_Mem
582     PL_MemShared
583     PL_MemParse
584     PL_Env
585     PL_StdIO
586     PL_LIO
587     PL_Dir
588     PL_Sock
589     PL_Proc
590     )];
591     }
592    
593     unless ($define{'PERL_FLEXIBLE_EXCEPTIONS'}) {
594     skip_symbols [qw(
595     PL_protect
596     Perl_default_protect
597     Perl_vdefault_protect
598     )];
599     }
600    
601     unless ($define{'USE_REENTRANT_API'}) {
602     skip_symbols [qw(
603     PL_reentrant_buffer
604     )];
605     }
606    
607     if ($define{'MYMALLOC'}) {
608     emit_symbols [qw(
609     Perl_dump_mstats
610     Perl_get_mstats
611     Perl_strdup
612     Perl_putenv
613     MallocCfg_ptr
614     MallocCfgP_ptr
615     )];
616     if ($define{'USE_5005THREADS'} || $define{'USE_ITHREADS'}) {
617     emit_symbols [qw(
618     PL_malloc_mutex
619     )];
620     }
621     else {
622     skip_symbols [qw(
623     PL_malloc_mutex
624     )];
625     }
626     }
627     else {
628     skip_symbols [qw(
629     PL_malloc_mutex
630     Perl_dump_mstats
631     Perl_get_mstats
632     Perl_malloced_size
633     MallocCfg_ptr
634     MallocCfgP_ptr
635     )];
636     }
637    
638     if ($define{'PERL_MALLOC_WRAP'}) {
639     emit_symbols [qw(
640     PL_memory_wrap
641     )];
642     }
643    
644     unless ($define{'USE_5005THREADS'} || $define{'USE_ITHREADS'}) {
645     skip_symbols [qw(
646     PL_thr_key
647     )];
648     }
649    
650     unless ($define{'USE_5005THREADS'}) {
651     skip_symbols [qw(
652     PL_sv_mutex
653     PL_strtab_mutex
654     PL_svref_mutex
655     PL_cred_mutex
656     PL_eval_mutex
657     PL_fdpid_mutex
658     PL_sv_lock_mutex
659     PL_eval_cond
660     PL_eval_owner
661     PL_threads_mutex
662     PL_nthreads
663     PL_nthreads_cond
664     PL_threadnum
665     PL_threadsv_names
666     PL_thrsv
667     PL_vtbl_mutex
668     Perl_condpair_magic
669     Perl_new_struct_thread
670     Perl_per_thread_magicals
671     Perl_thread_create
672     Perl_find_threadsv
673     Perl_unlock_condpair
674     Perl_magic_mutexfree
675     Perl_sv_lock
676     )];
677     }
678    
679     unless ($define{'USE_ITHREADS'}) {
680     skip_symbols [qw(
681     PL_ptr_table
682     PL_pte_root
683     PL_pte_arenaroot
684     PL_op_mutex
685     PL_regex_pad
686     PL_regex_padav
687     PL_sharedsv_space
688     PL_sharedsv_space_mutex
689     PL_dollarzero_mutex
690     Perl_dirp_dup
691     Perl_cx_dup
692     Perl_si_dup
693     Perl_any_dup
694     Perl_ss_dup
695     Perl_fp_dup
696     Perl_gp_dup
697     Perl_he_dup
698     Perl_mg_dup
699     Perl_re_dup
700     Perl_sv_dup
701     Perl_sys_intern_dup
702     Perl_ptr_table_clear
703     Perl_ptr_table_fetch
704     Perl_ptr_table_free
705     Perl_ptr_table_new
706     Perl_ptr_table_clear
707     Perl_ptr_table_free
708     Perl_ptr_table_split
709     Perl_ptr_table_store
710     perl_clone
711     perl_clone_using
712     Perl_sharedsv_find
713     Perl_sharedsv_init
714     Perl_sharedsv_lock
715     Perl_sharedsv_new
716     Perl_sharedsv_thrcnt_dec
717     Perl_sharedsv_thrcnt_inc
718     Perl_sharedsv_unlock
719     )];
720     }
721    
722     unless ($define{'PERL_IMPLICIT_CONTEXT'}) {
723     skip_symbols [qw(
724     Perl_croak_nocontext
725     Perl_die_nocontext
726     Perl_deb_nocontext
727     Perl_form_nocontext
728     Perl_load_module_nocontext
729     Perl_mess_nocontext
730     Perl_warn_nocontext
731     Perl_warner_nocontext
732     Perl_newSVpvf_nocontext
733     Perl_sv_catpvf_nocontext
734     Perl_sv_setpvf_nocontext
735     Perl_sv_catpvf_mg_nocontext
736     Perl_sv_setpvf_mg_nocontext
737     )];
738     }
739    
740     unless ($define{'PERL_IMPLICIT_SYS'}) {
741     skip_symbols [qw(
742     perl_alloc_using
743     perl_clone_using
744     )];
745     }
746    
747     unless ($define{'FAKE_THREADS'}) {
748     skip_symbols [qw(PL_curthr)];
749     }
750    
751     unless ($define{'PL_OP_SLAB_ALLOC'}) {
752     skip_symbols [qw(
753     PL_OpPtr
754     PL_OpSlab
755     PL_OpSpace
756     Perl_Slab_Alloc
757     Perl_Slab_Free
758     )];
759     }
760    
761     unless ($define{'THREADS_HAVE_PIDS'}) {
762     skip_symbols [qw(PL_ppid)];
763     }
764    
765     sub readvar {
766     my $file = shift;
767     my $proc = shift || sub { "PL_$_[2]" };
768     open(VARS,$file) || die "Cannot open $file: $!\n";
769     my @syms;
770     while (<VARS>) {
771     # All symbols have a Perl_ prefix because that's what embed.h
772     # sticks in front of them.
773     push(@syms, &$proc($1,$2,$3)) if (/\bPERLVAR(A?I?C?)\(([IGT])(\w+)/);
774     }
775     close(VARS);
776     return \@syms;
777     }
778    
779     if ($define{'USE_5005THREADS'}) {
780     my $thrd = readvar($thrdvar_h);
781     skip_symbols $thrd;
782     }
783    
784     if ($define{'PERL_GLOBAL_STRUCT'}) {
785     my $global = readvar($perlvars_h);
786     skip_symbols $global;
787     emit_symbol('Perl_GetVars');
788     emit_symbols [qw(PL_Vars PL_VarsPtr)] unless $CCTYPE eq 'GCC';
789     }
790    
791     # functions from *.sym files
792    
793     my @syms = ($global_sym, $globvar_sym); # $pp_sym is not part of the API
794    
795     # Symbols that are the public face of the PerlIO layers implementation
796     # These are in _addition to_ the public face of the abstraction
797     # and need to be exported to allow XS modules to implement layers
798     my @layer_syms = qw(
799     PerlIOBase_binmode
800     PerlIOBase_clearerr
801     PerlIOBase_close
802     PerlIOBase_dup
803     PerlIOBase_eof
804     PerlIOBase_error
805     PerlIOBase_fileno
806     PerlIOBase_noop_fail
807     PerlIOBase_noop_ok
808     PerlIOBase_popped
809     PerlIOBase_pushed
810     PerlIOBase_read
811     PerlIOBase_setlinebuf
812     PerlIOBase_unread
813     PerlIOBuf_bufsiz
814     PerlIOBuf_close
815     PerlIOBuf_dup
816     PerlIOBuf_fill
817     PerlIOBuf_flush
818     PerlIOBuf_get_base
819     PerlIOBuf_get_cnt
820     PerlIOBuf_get_ptr
821     PerlIOBuf_open
822     PerlIOBuf_popped
823     PerlIOBuf_pushed
824     PerlIOBuf_read
825     PerlIOBuf_seek
826     PerlIOBuf_set_ptrcnt
827     PerlIOBuf_tell
828     PerlIOBuf_unread
829     PerlIOBuf_write
830     PerlIO_allocate
831     PerlIO_apply_layera
832     PerlIO_apply_layers
833     PerlIO_arg_fetch
834     PerlIO_debug
835     PerlIO_define_layer
836     PerlIO_isutf8
837     PerlIO_layer_fetch
838     PerlIO_list_free
839     PerlIO_modestr
840     PerlIO_parse_layers
841     PerlIO_pending
842     PerlIO_perlio
843     PerlIO_pop
844     PerlIO_push
845     PerlIO_sv_dup
846     Perl_PerlIO_clearerr
847     Perl_PerlIO_close
848     Perl_PerlIO_eof
849     Perl_PerlIO_error
850     Perl_PerlIO_fileno
851     Perl_PerlIO_fill
852     Perl_PerlIO_flush
853     Perl_PerlIO_get_base
854     Perl_PerlIO_get_bufsiz
855     Perl_PerlIO_get_cnt
856     Perl_PerlIO_get_ptr
857     Perl_PerlIO_read
858     Perl_PerlIO_seek
859     Perl_PerlIO_set_cnt
860     Perl_PerlIO_set_ptrcnt
861     Perl_PerlIO_setlinebuf
862     Perl_PerlIO_stderr
863     Perl_PerlIO_stdin
864     Perl_PerlIO_stdout
865     Perl_PerlIO_tell
866     Perl_PerlIO_unread
867     Perl_PerlIO_write
868     );
869     if ($PLATFORM eq 'netware') {
870     push(@layer_syms,'PL_def_layerlist','PL_known_layers','PL_perlio');
871     }
872    
873     if ($define{'USE_PERLIO'}) {
874     # Export the symols that make up the PerlIO abstraction, regardless
875     # of its implementation - read from a file
876     push @syms, $perlio_sym;
877    
878     # This part is then dependent on how the abstraction is implemented
879     if ($define{'USE_SFIO'}) {
880     # Old legacy non-stdio "PerlIO"
881     skip_symbols \@layer_syms;
882     # SFIO defines most of the PerlIO routines as macros
883     # So undo most of what $perlio_sym has just done - d'oh !
884     # Perhaps it would be better to list the ones which do exist
885     # And emit them
886     skip_symbols [qw(
887     PerlIO_canset_cnt
888     PerlIO_clearerr
889     PerlIO_close
890     PerlIO_eof
891     PerlIO_error
892     PerlIO_exportFILE
893     PerlIO_fast_gets
894     PerlIO_fdopen
895     PerlIO_fileno
896     PerlIO_findFILE
897     PerlIO_flush
898     PerlIO_get_base
899     PerlIO_get_bufsiz
900     PerlIO_get_cnt
901     PerlIO_get_ptr
902     PerlIO_getc
903     PerlIO_getname
904     PerlIO_has_base
905     PerlIO_has_cntptr
906     PerlIO_importFILE
907     PerlIO_open
908     PerlIO_printf
909     PerlIO_putc
910     PerlIO_puts
911     PerlIO_read
912     PerlIO_releaseFILE
913     PerlIO_reopen
914     PerlIO_rewind
915     PerlIO_seek
916     PerlIO_set_cnt
917     PerlIO_set_ptrcnt
918     PerlIO_setlinebuf
919     PerlIO_sprintf
920     PerlIO_stderr
921     PerlIO_stdin
922     PerlIO_stdout
923     PerlIO_stdoutf
924     PerlIO_tell
925     PerlIO_ungetc
926     PerlIO_vprintf
927     PerlIO_write
928     PerlIO_perlio
929     Perl_PerlIO_clearerr
930     Perl_PerlIO_close
931     Perl_PerlIO_eof
932     Perl_PerlIO_error
933     Perl_PerlIO_fileno
934     Perl_PerlIO_fill
935     Perl_PerlIO_flush
936     Perl_PerlIO_get_base
937     Perl_PerlIO_get_bufsiz
938     Perl_PerlIO_get_cnt
939     Perl_PerlIO_get_ptr
940     Perl_PerlIO_read
941     Perl_PerlIO_seek
942     Perl_PerlIO_set_cnt
943     Perl_PerlIO_set_ptrcnt
944     Perl_PerlIO_setlinebuf
945     Perl_PerlIO_stderr
946     Perl_PerlIO_stdin
947     Perl_PerlIO_stdout
948     Perl_PerlIO_tell
949     Perl_PerlIO_unread
950     Perl_PerlIO_write
951     PL_def_layerlist
952     PL_known_layers
953     PL_perlio
954     )];
955     }
956     else {
957     # PerlIO with layers - export implementation
958     emit_symbols \@layer_syms;
959     }
960     } else {
961     # -Uuseperlio
962     # Skip the PerlIO layer symbols - although
963     # nothing should have exported them any way
964     skip_symbols \@layer_syms;
965     skip_symbols [qw(PL_def_layerlist PL_known_layers PL_perlio)];
966    
967     # Also do NOT add abstraction symbols from $perlio_sym
968     # abstraction is done as #define to stdio
969     # Remaining remnants that _may_ be functions
970     # are handled in <DATA>
971     }
972    
973     for my $syms (@syms) {
974     open (GLOBAL, "<$syms") || die "failed to open $syms: $!\n";
975     while (<GLOBAL>) {
976     next if (!/^[A-Za-z]/);
977     # Functions have a Perl_ prefix
978     # Variables have a PL_ prefix
979     chomp($_);
980     my $symbol = ($syms =~ /var\.sym$/i ? "PL_" : "");
981     $symbol .= $_;
982     emit_symbol($symbol) unless exists $skip{$symbol};
983     }
984     close(GLOBAL);
985     }
986    
987     # variables
988    
989     if ($define{'MULTIPLICITY'}) {
990     for my $f ($perlvars_h, $intrpvar_h, $thrdvar_h) {
991     my $glob = readvar($f, sub { "Perl_" . $_[1] . $_[2] . "_ptr" });
992     emit_symbols $glob;
993     }
994     # XXX AIX seems to want the perlvars.h symbols, for some reason
995     if ($PLATFORM eq 'aix' or $PLATFORM eq 'os2') { # OS/2 needs PL_thr_key
996     my $glob = readvar($perlvars_h);
997     emit_symbols $glob;
998     }
999     }
1000     else {
1001     unless ($define{'PERL_GLOBAL_STRUCT'}) {
1002     my $glob = readvar($perlvars_h);
1003     emit_symbols $glob;
1004     }
1005     unless ($define{'MULTIPLICITY'}) {
1006     my $glob = readvar($intrpvar_h);
1007     emit_symbols $glob;
1008     }
1009     unless ($define{'MULTIPLICITY'} || $define{'USE_5005THREADS'}) {
1010     my $glob = readvar($thrdvar_h);
1011     emit_symbols $glob;
1012     }
1013     }
1014    
1015     sub try_symbol {
1016     my $symbol = shift;
1017    
1018     return if $symbol !~ /^[A-Za-z_]/;
1019     return if $symbol =~ /^\#/;
1020     $symbol =~s/\r//g;
1021     chomp($symbol);
1022     return if exists $skip{$symbol};
1023     emit_symbol($symbol);
1024     }
1025    
1026     while (<DATA>) {
1027     try_symbol($_);
1028     }
1029    
1030     if ($PLATFORM =~ /^win(?:32|ce)$/) {
1031     foreach my $symbol (qw(
1032     setuid
1033     setgid
1034     boot_DynaLoader
1035     Perl_init_os_extras
1036     Perl_thread_create
1037     Perl_win32_init
1038     Perl_win32_term
1039     RunPerl
1040     win32_async_check
1041     win32_errno
1042     win32_environ
1043     win32_abort
1044     win32_fstat
1045     win32_stat
1046     win32_pipe
1047     win32_popen
1048     win32_pclose
1049     win32_rename
1050     win32_setmode
1051     win32_chsize
1052     win32_lseek
1053     win32_tell
1054     win32_dup
1055     win32_dup2
1056     win32_open
1057     win32_close
1058     win32_eof
1059     win32_read
1060     win32_write
1061     win32_spawnvp
1062     win32_mkdir
1063     win32_rmdir
1064     win32_chdir
1065     win32_flock
1066     win32_execv
1067     win32_execvp
1068     win32_htons
1069     win32_ntohs
1070     win32_htonl
1071     win32_ntohl
1072     win32_inet_addr
1073     win32_inet_ntoa
1074     win32_socket
1075     win32_bind
1076     win32_listen
1077     win32_accept
1078     win32_connect
1079     win32_send
1080     win32_sendto
1081     win32_recv
1082     win32_recvfrom
1083     win32_shutdown
1084     win32_closesocket
1085     win32_ioctlsocket
1086     win32_setsockopt
1087     win32_getsockopt
1088     win32_getpeername
1089     win32_getsockname
1090     win32_gethostname
1091     win32_gethostbyname
1092     win32_gethostbyaddr
1093     win32_getprotobyname
1094     win32_getprotobynumber
1095     win32_getservbyname
1096     win32_getservbyport
1097     win32_select
1098     win32_endhostent
1099     win32_endnetent
1100     win32_endprotoent
1101     win32_endservent
1102     win32_getnetent
1103     win32_getnetbyname
1104     win32_getnetbyaddr
1105     win32_getprotoent
1106     win32_getservent
1107     win32_sethostent
1108     win32_setnetent
1109     win32_setprotoent
1110     win32_setservent
1111     win32_getenv
1112     win32_putenv
1113     win32_perror
1114     win32_malloc
1115     win32_calloc
1116     win32_realloc
1117     win32_free
1118     win32_sleep
1119     win32_times
1120     win32_access
1121     win32_alarm
1122     win32_chmod
1123     win32_open_osfhandle
1124     win32_get_osfhandle
1125     win32_ioctl
1126     win32_link
1127     win32_unlink
1128     win32_utime
1129     win32_gettimeofday
1130     win32_uname
1131     win32_wait
1132     win32_waitpid
1133     win32_kill
1134     win32_str_os_error
1135     win32_opendir
1136     win32_readdir
1137     win32_telldir
1138     win32_seekdir
1139     win32_rewinddir
1140     win32_closedir
1141     win32_longpath
1142     win32_os_id
1143     win32_getpid
1144     win32_crypt
1145     win32_dynaload
1146     win32_get_childenv
1147     win32_free_childenv
1148     win32_clearenv
1149     win32_get_childdir
1150     win32_free_childdir
1151     win32_stdin
1152     win32_stdout
1153     win32_stderr
1154     win32_ferror
1155     win32_feof
1156     win32_strerror
1157     win32_fprintf
1158     win32_printf
1159     win32_vfprintf
1160     win32_vprintf
1161     win32_fread
1162     win32_fwrite
1163     win32_fopen
1164     win32_fdopen
1165     win32_freopen
1166     win32_fclose
1167     win32_fputs
1168     win32_fputc
1169     win32_ungetc
1170     win32_getc
1171     win32_fileno
1172     win32_clearerr
1173     win32_fflush
1174     win32_ftell
1175     win32_fseek
1176     win32_fgetpos
1177     win32_fsetpos
1178     win32_rewind
1179     win32_tmpfile
1180     win32_setbuf
1181     win32_setvbuf
1182     win32_flushall
1183     win32_fcloseall
1184     win32_fgets
1185     win32_gets
1186     win32_fgetc
1187     win32_putc
1188     win32_puts
1189     win32_getchar
1190     win32_putchar
1191     ))
1192     {
1193     try_symbol($symbol);
1194     }
1195     }
1196     elsif ($PLATFORM eq 'os2') {
1197     open MAP, 'miniperl.map' or die 'Cannot read miniperl.map';
1198     /^\s*[\da-f:]+\s+(\w+)/i and $mapped{$1}++ foreach <MAP>;
1199     close MAP or die 'Cannot close miniperl.map';
1200    
1201     @missing = grep { !exists $mapped{$_} }
1202     keys %export;
1203     @missing = grep { !exists $exportperlmalloc{$_} } @missing;
1204     delete $export{$_} foreach @missing;
1205     }
1206     elsif ($PLATFORM eq 'MacOS') {
1207     open MACSYMS, 'macperl.sym' or die 'Cannot read macperl.sym';
1208    
1209     while (<MACSYMS>) {
1210     try_symbol($_);
1211     }
1212    
1213     close MACSYMS;
1214     }
1215     elsif ($PLATFORM eq 'netware') {
1216     foreach my $symbol (qw(
1217     boot_DynaLoader
1218     Perl_init_os_extras
1219     Perl_thread_create
1220     Perl_nw5_init
1221     RunPerl
1222     AllocStdPerl
1223     FreeStdPerl
1224     do_spawn2
1225     do_aspawn
1226     nw_uname
1227     nw_stdin
1228     nw_stdout
1229     nw_stderr
1230     nw_feof
1231     nw_ferror
1232     nw_fopen
1233     nw_fclose
1234     nw_clearerr
1235     nw_getc
1236     nw_fgets
1237     nw_fputc
1238     nw_fputs
1239     nw_fflush
1240     nw_ungetc
1241     nw_fileno
1242     nw_fdopen
1243     nw_freopen
1244     nw_fread
1245     nw_fwrite
1246     nw_setbuf
1247     nw_setvbuf
1248     nw_vfprintf
1249     nw_ftell
1250     nw_fseek
1251     nw_rewind
1252     nw_tmpfile
1253     nw_fgetpos
1254     nw_fsetpos
1255     nw_dup
1256     nw_access
1257     nw_chmod
1258     nw_chsize
1259     nw_close
1260     nw_dup2
1261     nw_flock
1262     nw_isatty
1263     nw_link
1264     nw_lseek
1265     nw_stat
1266     nw_mktemp
1267     nw_open
1268     nw_read
1269     nw_rename
1270     nw_setmode
1271     nw_unlink
1272     nw_utime
1273     nw_write
1274     nw_chdir
1275     nw_rmdir
1276     nw_closedir
1277     nw_opendir
1278     nw_readdir
1279     nw_rewinddir
1280     nw_seekdir
1281     nw_telldir
1282     nw_htonl
1283     nw_htons
1284     nw_ntohl
1285     nw_ntohs
1286     nw_accept
1287     nw_bind
1288     nw_connect
1289     nw_endhostent
1290     nw_endnetent
1291     nw_endprotoent
1292     nw_endservent
1293     nw_gethostbyaddr
1294     nw_gethostbyname
1295     nw_gethostent
1296     nw_gethostname
1297     nw_getnetbyaddr
1298     nw_getnetbyname
1299     nw_getnetent
1300     nw_getpeername
1301     nw_getprotobyname
1302     nw_getprotobynumber
1303     nw_getprotoent
1304     nw_getservbyname
1305     nw_getservbyport
1306     nw_getservent
1307     nw_getsockname
1308     nw_getsockopt
1309     nw_inet_addr
1310     nw_listen
1311     nw_socket
1312     nw_recv
1313     nw_recvfrom
1314     nw_select
1315     nw_send
1316     nw_sendto
1317     nw_sethostent
1318     nw_setnetent
1319     nw_setprotoent
1320     nw_setservent
1321     nw_setsockopt
1322     nw_inet_ntoa
1323     nw_shutdown
1324     nw_crypt
1325     nw_execvp
1326     nw_kill
1327     nw_Popen
1328     nw_Pclose
1329     nw_Pipe
1330     nw_times
1331     nw_waitpid
1332     nw_getpid
1333     nw_spawnvp
1334     nw_os_id
1335     nw_open_osfhandle
1336     nw_get_osfhandle
1337     nw_abort
1338     nw_sleep
1339     nw_wait
1340     nw_dynaload
1341     nw_strerror
1342     fnFpSetMode
1343     fnInsertHashListAddrs
1344     fnGetHashListAddrs
1345     Perl_deb
1346     Perl_sv_setsv
1347     Perl_sv_catsv
1348     Perl_sv_catpvn
1349     Perl_sv_2pv
1350     nw_freeenviron
1351     Remove_Thread_Ctx
1352     ))
1353     {
1354     try_symbol($symbol);
1355     }
1356     }
1357    
1358     # records of type boot_module for statically linked modules (except Dynaloader)
1359     $static_ext =~ s/\//__/g;
1360     $static_ext =~ s/\bDynaLoader\b//;
1361     my @stat_mods = map {"boot_$_"} grep {/\S/} split /\s+/, $static_ext;
1362     foreach my $symbol (@stat_mods)
1363     {
1364     try_symbol($symbol);
1365     }
1366    
1367     # Now all symbols should be defined because
1368     # next we are going to output them.
1369    
1370     foreach my $symbol (sort keys %export) {
1371     output_symbol($symbol);
1372     }
1373    
1374     if ($PLATFORM eq 'os2') {
1375     print <<EOP;
1376     dll_perlmain=main
1377     fill_extLibpath
1378     dir_subst
1379     Perl_OS2_handler_install
1380    
1381     ; LAST_ORDINAL=$sym_ord
1382     EOP
1383     }
1384    
1385     sub emit_symbol {
1386     my $symbol = shift;
1387     chomp($symbol);
1388     $export{$symbol} = 1;
1389     }
1390    
1391     sub output_symbol {
1392     my $symbol = shift;
1393     if ($PLATFORM =~ /^win(?:32|ce)$/) {
1394     $symbol = "_$symbol" if $CCTYPE eq 'BORLAND';
1395     print "\t$symbol\n";
1396     # XXX: binary compatibility between compilers is an exercise
1397     # in frustration :-(
1398     # if ($CCTYPE eq "BORLAND") {
1399     # # workaround Borland quirk by exporting both the straight
1400     # # name and a name with leading underscore. Note the
1401     # # alias *must* come after the symbol itself, if both
1402     # # are to be exported. (Linker bug?)
1403     # print "\t_$symbol\n";
1404     # print "\t$symbol = _$symbol\n";
1405     # }
1406     # elsif ($CCTYPE eq 'GCC') {
1407     # # Symbols have leading _ whole process is $%@"% slow
1408     # # so skip aliases for now
1409     # nprint "\t$symbol\n";
1410     # }
1411     # else {
1412     # # for binary coexistence, export both the symbol and
1413     # # alias with leading underscore
1414     # print "\t$symbol\n";
1415     # print "\t_$symbol = $symbol\n";
1416     # }
1417     }
1418     elsif ($PLATFORM eq 'os2') {
1419     printf qq( %-31s \@%s\n),
1420     qq("$symbol"), $ordinal{$symbol} || ++$sym_ord;
1421     printf qq( %-31s \@%s\n),
1422     qq("$exportperlmalloc{$symbol}" = "$symbol"),
1423     $ordinal{$exportperlmalloc{$symbol}} || ++$sym_ord
1424     if $exportperlmalloc and exists $exportperlmalloc{$symbol};
1425     }
1426     elsif ($PLATFORM eq 'aix' || $PLATFORM eq 'MacOS') {
1427     print "$symbol\n";
1428     }
1429     elsif ($PLATFORM eq 'netware') {
1430     print "\t$symbol,\n";
1431     }
1432     }
1433    
1434     1;
1435     __DATA__
1436     # extra globals not included above.
1437     Perl_cxinc
1438     perl_alloc
1439     perl_alloc_using
1440     perl_clone
1441     perl_clone_using
1442     perl_construct
1443     perl_destruct
1444     perl_free
1445     perl_parse
1446     perl_run
1447     # Oddities from PerlIO
1448     PerlIO_binmode
1449     PerlIO_getpos
1450     PerlIO_init
1451     PerlIO_setpos
1452     PerlIO_sprintf
1453     PerlIO_sv_dup
1454     PerlIO_tmpfile
1455     PerlIO_vsprintf
1456     perlsio_binmode