[ PATCH ] mymalloc on HP-UX
[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_popped
742                          PerlIOBase_read
743                          PerlIOBase_setlinebuf
744                          PerlIOBase_unread
745                          PerlIOBuf_bufsiz
746                          PerlIOBuf_fill
747                          PerlIOBuf_flush
748                          PerlIOBuf_get_base
749                          PerlIOBuf_get_cnt
750                          PerlIOBuf_get_ptr
751                          PerlIOBuf_open
752                          PerlIOBuf_pushed
753                          PerlIOBuf_popped
754                          PerlIOBuf_read
755                          PerlIOBuf_seek
756                          PerlIOBuf_set_ptrcnt
757                          PerlIOBuf_tell
758                          PerlIOBuf_unread
759                          PerlIOBuf_write
760                          PerlIO_debug
761                          PerlIO_allocate
762                          PerlIO_apply_layera
763                          PerlIO_apply_layers
764                          PerlIO_arg_fetch
765                          PerlIO_define_layer
766                          PerlIO_modestr
767                          PerlIO_parse_layers
768                          PerlIO_layer_fetch
769                          PerlIO_list_free
770                          PerlIO_apply_layera
771                          PerlIO_pending
772                          PerlIO_push
773                          PerlIO_sv_dup
774                          PerlIO_perlio
775
776 Perl_PerlIO_clearerr
777 Perl_PerlIO_close
778 Perl_PerlIO_eof
779 Perl_PerlIO_error
780 Perl_PerlIO_fileno
781 Perl_PerlIO_fill
782 Perl_PerlIO_flush
783 Perl_PerlIO_get_base
784 Perl_PerlIO_get_bufsiz
785 Perl_PerlIO_get_cnt
786 Perl_PerlIO_get_ptr
787 Perl_PerlIO_read
788 Perl_PerlIO_seek
789 Perl_PerlIO_set_cnt
790 Perl_PerlIO_set_ptrcnt
791 Perl_PerlIO_setlinebuf
792 Perl_PerlIO_stderr
793 Perl_PerlIO_stdin
794 Perl_PerlIO_stdout
795 Perl_PerlIO_tell
796 Perl_PerlIO_unread
797 Perl_PerlIO_write
798
799 );
800 if ($PLATFORM eq 'netware') {
801     push(@layer_syms,'PL_def_layerlist','PL_known_layers','PL_perlio');
802 }
803
804 if ($define{'USE_PERLIO'}) {
805     # Export the symols that make up the PerlIO abstraction, regardless
806     # of its implementation - read from a file
807     push @syms, $perlio_sym;
808
809     # This part is then dependent on how the abstraction is implemented
810     if ($define{'USE_SFIO'}) {
811         # Old legacy non-stdio "PerlIO"
812         skip_symbols \@layer_syms;
813         # SFIO defines most of the PerlIO routines as macros
814         # So undo most of what $perlio_sym has just done - d'oh !
815         # Perhaps it would be better to list the ones which do exist
816         # And emit them
817         skip_symbols [qw(
818                          PerlIO_canset_cnt
819                          PerlIO_clearerr
820                          PerlIO_close
821                          PerlIO_eof
822                          PerlIO_error
823                          PerlIO_exportFILE
824                          PerlIO_fast_gets
825                          PerlIO_fdopen
826                          PerlIO_fileno
827                          PerlIO_findFILE
828                          PerlIO_flush
829                          PerlIO_get_base
830                          PerlIO_get_bufsiz
831                          PerlIO_get_cnt
832                          PerlIO_get_ptr
833                          PerlIO_getc
834                          PerlIO_getname
835                          PerlIO_has_base
836                          PerlIO_has_cntptr
837                          PerlIO_importFILE
838                          PerlIO_open
839                          PerlIO_printf
840                          PerlIO_putc
841                          PerlIO_puts
842                          PerlIO_read
843                          PerlIO_releaseFILE
844                          PerlIO_reopen
845                          PerlIO_rewind
846                          PerlIO_seek
847                          PerlIO_set_cnt
848                          PerlIO_set_ptrcnt
849                          PerlIO_setlinebuf
850                          PerlIO_sprintf
851                          PerlIO_stderr
852                          PerlIO_stdin
853                          PerlIO_stdout
854                          PerlIO_stdoutf
855                          PerlIO_tell
856                          PerlIO_ungetc
857                          PerlIO_vprintf
858                          PerlIO_write
859                          PerlIO_perlio
860                          Perl_PerlIO_clearerr
861                          Perl_PerlIO_close
862                          Perl_PerlIO_eof
863                          Perl_PerlIO_error
864                          Perl_PerlIO_fileno
865                          Perl_PerlIO_fill
866                          Perl_PerlIO_flush
867                          Perl_PerlIO_get_base
868                          Perl_PerlIO_get_bufsiz
869                          Perl_PerlIO_get_cnt
870                          Perl_PerlIO_get_ptr
871                          Perl_PerlIO_read
872                          Perl_PerlIO_seek
873                          Perl_PerlIO_set_cnt
874                          Perl_PerlIO_set_ptrcnt
875                          Perl_PerlIO_setlinebuf
876                          Perl_PerlIO_stderr
877                          Perl_PerlIO_stdin
878                          Perl_PerlIO_stdout
879                          Perl_PerlIO_tell
880                          Perl_PerlIO_unread
881                          Perl_PerlIO_write
882                          PL_def_layerlist
883                          PL_known_layers
884                          PL_perlio
885                          )];
886     }
887     else {
888         # PerlIO with layers - export implementation
889         emit_symbols \@layer_syms;
890     }
891 } else {
892         # -Uuseperlio
893         # Skip the PerlIO layer symbols - although
894         # nothing should have exported them any way
895         skip_symbols \@layer_syms;
896         skip_symbols [qw(PL_def_layerlist PL_known_layers PL_perlio)];
897
898         # Also do NOT add abstraction symbols from $perlio_sym
899         # abstraction is done as #define to stdio
900         # Remaining remnants that _may_ be functions
901         # are handled in <DATA>
902 }
903
904 for my $syms (@syms) {
905     open (GLOBAL, "<$syms") || die "failed to open $syms: $!\n";
906     while (<GLOBAL>) {
907         next if (!/^[A-Za-z]/);
908         # Functions have a Perl_ prefix
909         # Variables have a PL_ prefix
910         chomp($_);
911         my $symbol = ($syms =~ /var\.sym$/i ? "PL_" : "");
912         $symbol .= $_;
913         emit_symbol($symbol) unless exists $skip{$symbol};
914     }
915     close(GLOBAL);
916 }
917
918 # variables
919
920 if ($define{'MULTIPLICITY'}) {
921     for my $f ($perlvars_h, $intrpvar_h, $thrdvar_h) {
922         my $glob = readvar($f, sub { "Perl_" . $_[1] . $_[2] . "_ptr" });
923         emit_symbols $glob;
924     }
925     # XXX AIX seems to want the perlvars.h symbols, for some reason
926     if ($PLATFORM eq 'aix') {
927         my $glob = readvar($perlvars_h);
928         emit_symbols $glob;
929     }
930 }
931 else {
932     unless ($define{'PERL_GLOBAL_STRUCT'}) {
933         my $glob = readvar($perlvars_h);
934         emit_symbols $glob;
935     }
936     unless ($define{'MULTIPLICITY'}) {
937         my $glob = readvar($intrpvar_h);
938         emit_symbols $glob;
939     }
940     unless ($define{'MULTIPLICITY'} || $define{'USE_5005THREADS'}) {
941         my $glob = readvar($thrdvar_h);
942         emit_symbols $glob;
943     }
944 }
945
946 sub try_symbol {
947     my $symbol = shift;
948
949     return if $symbol !~ /^[A-Za-z_]/;
950     return if $symbol =~ /^\#/;
951     $symbol =~s/\r//g;
952     chomp($symbol);
953     return if exists $skip{$symbol};
954     emit_symbol($symbol);
955 }
956
957 while (<DATA>) {
958     try_symbol($_);
959 }
960
961 if ($PLATFORM =~ /^win(?:32|ce)$/) {
962     foreach my $symbol (qw(
963                             setuid
964                             setgid
965                             boot_DynaLoader
966                             Perl_init_os_extras
967                             Perl_thread_create
968                             Perl_win32_init
969                             RunPerl
970                             win32_async_check
971                             win32_errno
972                             win32_environ
973                             win32_abort
974                             win32_fstat
975                             win32_stat
976                             win32_pipe
977                             win32_popen
978                             win32_pclose
979                             win32_rename
980                             win32_setmode
981                             win32_lseek
982                             win32_tell
983                             win32_dup
984                             win32_dup2
985                             win32_open
986                             win32_close
987                             win32_eof
988                             win32_read
989                             win32_write
990                             win32_spawnvp
991                             win32_mkdir
992                             win32_rmdir
993                             win32_chdir
994                             win32_flock
995                             win32_execv
996                             win32_execvp
997                             win32_htons
998                             win32_ntohs
999                             win32_htonl
1000                             win32_ntohl
1001                             win32_inet_addr
1002                             win32_inet_ntoa
1003                             win32_socket
1004                             win32_bind
1005                             win32_listen
1006                             win32_accept
1007                             win32_connect
1008                             win32_send
1009                             win32_sendto
1010                             win32_recv
1011                             win32_recvfrom
1012                             win32_shutdown
1013                             win32_closesocket
1014                             win32_ioctlsocket
1015                             win32_setsockopt
1016                             win32_getsockopt
1017                             win32_getpeername
1018                             win32_getsockname
1019                             win32_gethostname
1020                             win32_gethostbyname
1021                             win32_gethostbyaddr
1022                             win32_getprotobyname
1023                             win32_getprotobynumber
1024                             win32_getservbyname
1025                             win32_getservbyport
1026                             win32_select
1027                             win32_endhostent
1028                             win32_endnetent
1029                             win32_endprotoent
1030                             win32_endservent
1031                             win32_getnetent
1032                             win32_getnetbyname
1033                             win32_getnetbyaddr
1034                             win32_getprotoent
1035                             win32_getservent
1036                             win32_sethostent
1037                             win32_setnetent
1038                             win32_setprotoent
1039                             win32_setservent
1040                             win32_getenv
1041                             win32_putenv
1042                             win32_perror
1043                             win32_malloc
1044                             win32_calloc
1045                             win32_realloc
1046                             win32_free
1047                             win32_sleep
1048                             win32_times
1049                             win32_access
1050                             win32_alarm
1051                             win32_chmod
1052                             win32_open_osfhandle
1053                             win32_get_osfhandle
1054                             win32_ioctl
1055                             win32_link
1056                             win32_unlink
1057                             win32_utime
1058                             win32_gettimeofday
1059                             win32_uname
1060                             win32_wait
1061                             win32_waitpid
1062                             win32_kill
1063                             win32_str_os_error
1064                             win32_opendir
1065                             win32_readdir
1066                             win32_telldir
1067                             win32_seekdir
1068                             win32_rewinddir
1069                             win32_closedir
1070                             win32_longpath
1071                             win32_os_id
1072                             win32_getpid
1073                             win32_crypt
1074                             win32_dynaload
1075                             win32_get_childenv
1076                             win32_free_childenv
1077                             win32_clearenv
1078                             win32_get_childdir
1079                             win32_free_childdir
1080                             win32_stdin
1081                             win32_stdout
1082                             win32_stderr
1083                             win32_ferror
1084                             win32_feof
1085                             win32_strerror
1086                             win32_fprintf
1087                             win32_printf
1088                             win32_vfprintf
1089                             win32_vprintf
1090                             win32_fread
1091                             win32_fwrite
1092                             win32_fopen
1093                             win32_fdopen
1094                             win32_freopen
1095                             win32_fclose
1096                             win32_fputs
1097                             win32_fputc
1098                             win32_ungetc
1099                             win32_getc
1100                             win32_fileno
1101                             win32_clearerr
1102                             win32_fflush
1103                             win32_ftell
1104                             win32_fseek
1105                             win32_fgetpos
1106                             win32_fsetpos
1107                             win32_rewind
1108                             win32_tmpfile
1109                             win32_setbuf
1110                             win32_setvbuf
1111                             win32_flushall
1112                             win32_fcloseall
1113                             win32_fgets
1114                             win32_gets
1115                             win32_fgetc
1116                             win32_putc
1117                             win32_puts
1118                             win32_getchar
1119                             win32_putchar
1120                            ))
1121     {
1122         try_symbol($symbol);
1123     }
1124 }
1125 elsif ($PLATFORM eq 'os2') {
1126     open MAP, 'miniperl.map' or die 'Cannot read miniperl.map';
1127     /^\s*[\da-f:]+\s+(\w+)/i and $mapped{$1}++ foreach <MAP>;
1128     close MAP or die 'Cannot close miniperl.map';
1129
1130     @missing = grep { !exists $mapped{$_} }
1131                     keys %export;
1132     delete $export{$_} foreach @missing;
1133 }
1134 elsif ($PLATFORM eq 'MacOS') {
1135     open MACSYMS, 'macperl.sym' or die 'Cannot read macperl.sym';
1136
1137     while (<MACSYMS>) {
1138         try_symbol($_);
1139     }
1140
1141     close MACSYMS;
1142 }
1143 elsif ($PLATFORM eq 'netware') {
1144 foreach my $symbol (qw(
1145                         boot_DynaLoader
1146                         Perl_init_os_extras
1147                         Perl_thread_create
1148                         Perl_nw5_init
1149                         RunPerl
1150                         AllocStdPerl
1151                         FreeStdPerl
1152                         do_spawn2
1153                         do_aspawn
1154                         nw_uname
1155                         nw_stdin
1156                         nw_stdout
1157                         nw_stderr
1158                         nw_feof
1159                         nw_ferror
1160                         nw_fopen
1161                         nw_fclose
1162                         nw_clearerr
1163                         nw_getc
1164                         nw_fgets
1165                         nw_fputc
1166                         nw_fputs
1167                         nw_fflush
1168                         nw_ungetc
1169                         nw_fileno
1170                         nw_fdopen
1171                         nw_freopen
1172                         nw_fread
1173                         nw_fwrite
1174                         nw_setbuf
1175                         nw_setvbuf
1176                         nw_vfprintf
1177                         nw_ftell
1178                         nw_fseek
1179                         nw_rewind
1180                         nw_tmpfile
1181                         nw_fgetpos
1182                         nw_fsetpos
1183                         nw_dup
1184                         nw_access
1185                         nw_chmod
1186                         nw_chsize
1187                         nw_close
1188                         nw_dup2
1189                         nw_flock
1190                         nw_isatty
1191                         nw_link
1192                         nw_lseek
1193                         nw_stat
1194                         nw_mktemp
1195                         nw_open
1196                         nw_read
1197                         nw_rename
1198                         nw_setmode
1199                         nw_unlink
1200                         nw_utime
1201                         nw_write
1202                         nw_chdir
1203                         nw_rmdir
1204                         nw_closedir
1205                         nw_opendir
1206                         nw_readdir
1207                         nw_rewinddir
1208                         nw_seekdir
1209                         nw_telldir
1210                         nw_htonl
1211                         nw_htons
1212                         nw_ntohl
1213                         nw_ntohs
1214                         nw_accept
1215                         nw_bind
1216                         nw_connect
1217                         nw_endhostent
1218                         nw_endnetent
1219                         nw_endprotoent
1220                         nw_endservent
1221                         nw_gethostbyaddr
1222                         nw_gethostbyname
1223                         nw_gethostent
1224                         nw_gethostname
1225                         nw_getnetbyaddr
1226                         nw_getnetbyname
1227                         nw_getnetent
1228                         nw_getpeername
1229                         nw_getprotobyname
1230                         nw_getprotobynumber
1231                         nw_getprotoent
1232                         nw_getservbyname
1233                         nw_getservbyport
1234                         nw_getservent
1235                         nw_getsockname
1236                         nw_getsockopt
1237                         nw_inet_addr
1238                         nw_listen
1239                         nw_socket
1240                         nw_recv
1241                         nw_recvfrom
1242                         nw_select
1243                         nw_send
1244                         nw_sendto
1245                         nw_sethostent
1246                         nw_setnetent
1247                         nw_setprotoent
1248                         nw_setservent
1249                         nw_setsockopt
1250                         nw_inet_ntoa
1251                         nw_shutdown
1252                         nw_crypt
1253                         nw_execvp
1254                         nw_kill
1255                         nw_Popen
1256                         nw_Pclose
1257                         nw_Pipe
1258                         nw_times
1259                         nw_waitpid
1260                         nw_getpid
1261                         nw_spawnvp
1262                         nw_os_id
1263                         nw_open_osfhandle
1264                         nw_get_osfhandle
1265                         nw_abort
1266                         nw_sleep
1267                         nw_wait
1268                         nw_dynaload
1269                         nw_strerror
1270                         fnFpSetMode
1271                         fnInsertHashListAddrs
1272                         fnGetHashListAddrs
1273                         Perl_deb
1274                         Perl_sv_setsv
1275                         Perl_sv_catsv
1276                         Perl_sv_catpvn
1277                         Perl_sv_2pv
1278                         nw_freeenviron
1279                         Remove_Thread_Ctx
1280                            ))
1281     {
1282         try_symbol($symbol);
1283     }
1284 }
1285
1286 # Now all symbols should be defined because
1287 # next we are going to output them.
1288
1289 foreach my $symbol (sort keys %export) {
1290     output_symbol($symbol);
1291 }
1292
1293 if ($PLATFORM eq 'os2') {
1294         print "; LAST_ORDINAL=$sym_ord\n";
1295 }
1296
1297 sub emit_symbol {
1298     my $symbol = shift;
1299     chomp($symbol);
1300     $export{$symbol} = 1;
1301 }
1302
1303 sub output_symbol {
1304     my $symbol = shift;
1305     if ($PLATFORM =~ /^win(?:32|ce)$/) {
1306         $symbol = "_$symbol" if $CCTYPE eq 'BORLAND';
1307         print "\t$symbol\n";
1308 # XXX: binary compatibility between compilers is an exercise
1309 # in frustration :-(
1310 #        if ($CCTYPE eq "BORLAND") {
1311 #           # workaround Borland quirk by exporting both the straight
1312 #           # name and a name with leading underscore.  Note the
1313 #           # alias *must* come after the symbol itself, if both
1314 #           # are to be exported. (Linker bug?)
1315 #           print "\t_$symbol\n";
1316 #           print "\t$symbol = _$symbol\n";
1317 #       }
1318 #       elsif ($CCTYPE eq 'GCC') {
1319 #           # Symbols have leading _ whole process is $%@"% slow
1320 #           # so skip aliases for now
1321 #           nprint "\t$symbol\n";
1322 #       }
1323 #       else {
1324 #           # for binary coexistence, export both the symbol and
1325 #           # alias with leading underscore
1326 #           print "\t$symbol\n";
1327 #           print "\t_$symbol = $symbol\n";
1328 #       }
1329     }
1330     elsif ($PLATFORM eq 'os2') {
1331         printf qq(    %-31s \@%s\n),
1332           qq("$symbol"), $ordinal{$symbol} || ++$sym_ord;
1333     }
1334     elsif ($PLATFORM eq 'aix' || $PLATFORM eq 'MacOS') {
1335         print "$symbol\n";
1336     }
1337         elsif ($PLATFORM eq 'netware') {
1338         print "\t$symbol,\n";
1339         }
1340 }
1341
1342 1;
1343 __DATA__
1344 # extra globals not included above.
1345 Perl_cxinc
1346 perl_alloc
1347 perl_alloc_using
1348 perl_clone
1349 perl_clone_using
1350 perl_construct
1351 perl_destruct
1352 perl_free
1353 perl_parse
1354 perl_run
1355 # Oddities from PerlIO
1356 PerlIO_binmode
1357 PerlIO_getpos
1358 PerlIO_init
1359 PerlIO_setpos
1360 PerlIO_sprintf
1361 PerlIO_sv_dup
1362 PerlIO_tmpfile
1363 PerlIO_vsprintf
1364 perlsio_binmode