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