This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
50cbcbb00ccd5e002f96f31f81e2d8b94fea1446
[perl5.git] / makedef.pl
1 #
2 # Create the export list for perl.
3 #
4 # Needed by WIN32 for creating perl.dll and by AIX for creating libperl.a
5 # when -Dusershrplib is in effect.
6 #
7 # reads global.sym, pp.sym, perlvars.h, intrpvar.h, thrdvar.h, config.h
8
9 my $PLATFORM;
10 my $CCTYPE;
11
12 while (@ARGV)
13  {
14   my $flag = shift;
15   $define{$1} = 1 if ($flag =~ /^-D(\w+)$/);
16   $CCTYPE   = $1 if ($flag =~ /^CCTYPE=(\w+)$/);
17   $PLATFORM = $1 if ($flag =~ /^PLATFORM=(\w+)$/);
18  } 
19
20 my @PLATFORM = qw(aix win32);
21 my %PLATFORM;
22 @PLATFORM{@PLATFORM} = ();
23
24 defined $PLATFORM || die "PLATFORM undefined, must be one of: @PLATFORM\n";
25 exists $PLATFORM{$PLATFORM} || die "PLATFORM must be one of: @PLATFORM\n"; 
26
27 my $config_sh   = "config.sh";
28 my $config_h    = "config.h";
29 my $thrdvar_h   = "thrdvar.h";
30 my $intrpvar_h  = "intrpvar.h";
31 my $perlvars_h  = "perlvars.h";
32 my $global_sym  = "global.sym";
33 my $pp_sym      = "pp.sym";
34 my $globvar_sym = "globvar.sym";
35 my $perlio_sym  = "perlio.sym";
36
37 if ($PLATFORM eq 'aix') { 
38     # Nothing for now.
39 } elsif ($PLATFORM eq 'win32') {
40     $CCTYPE = "MSVC" unless defined $CCTYPE;
41     foreach ($thrdvar_h, $intrpvar_h, $perlvars_h, $global_sym, $pp_sym, $globvar_sym) {
42         s!^!..\\!;
43     }
44 }
45
46 unless ($PLATFORM eq 'win32') {
47     open(CFG,$config_sh) || die "Cannot open $config_sh: $!\n";
48     while (<CFG>)
49     {
50         if (/^(?:ccflags|optimize)='(.+)'$/) {
51             $_ = $1;
52             $define{$1} = 1 while /-D(\w+)/g;
53         }
54     }
55     close(CFG);
56 }
57
58 open(CFG,$config_h) || die "Cannot open $config_h: $!\n";
59 while (<CFG>)
60  {
61   $define{$1} = 1 if /^\s*#\s*define\s+(MYMALLOC)\b/;
62   $define{$1} = 1 if /^\s*#\s*define\s+(USE_THREADS)\b/;
63   $define{$1} = 1 if /^\s*#\s*define\s+(USE_PERLIO)\b/;
64   $define{$1} = 1 if /^\s*#\s*define\s+(MULTIPLICITY)\b/;
65  }
66 close(CFG);
67
68 if ($PLATFORM eq 'win32') {
69     warn join(' ',keys %define)."\n";
70     if ($define{PERL_OBJECT}) {
71         print "LIBRARY PerlCore\n";
72         print "DESCRIPTION 'Perl interpreter'\n";
73         print "EXPORTS\n";
74 #    output_symbol("perl_alloc");
75         output_symbol("perl_get_host_info");
76         output_symbol("perl_alloc_using");
77 #    output_symbol("perl_construct");
78 #    output_symbol("perl_destruct");
79 #    output_symbol("perl_free");
80 #    output_symbol("perl_parse");
81 #    output_symbol("perl_run");
82 #    output_symbol("RunPerl");
83 #    exit(0);
84     }
85     else {
86         if ($CCTYPE ne 'GCC') {
87             print "LIBRARY Perl\n";
88             print "DESCRIPTION 'Perl interpreter, export autogenerated'\n";
89         }
90         else {
91             $define{'PERL_GLOBAL_STRUCT'} = 1;
92             $define{'MULTIPLICITY'} = 1;
93         }
94         print "EXPORTS\n";
95     } 
96 } elsif ($PLATFORM eq 'aix') {
97     print "#!\n";
98 }
99
100 my %skip;
101 my %export;
102
103 sub skip_symbols {
104     my $list = shift;
105     foreach my $symbol (@$list) {
106         $skip{$symbol} = 1;
107     }
108 }
109
110 sub emit_symbols {
111     my $list = shift;
112     foreach my $symbol (@$list) {
113         my $skipsym = $symbol;
114         # XXX hack
115         if ($define{PERL_OBJECT}) {
116             $skipsym =~ s/^Perl_[GIT](\w+)_ptr$/PL_$1/;
117         }
118         emit_symbol($symbol) unless exists $skip{$skipsym};
119     }
120 }
121
122 if ($PLATFORM eq 'win32') {
123 skip_symbols [qw(
124 PL_statusvalue_vms
125 PL_archpat_auto
126 PL_cryptseen
127 PL_DBcv
128 PL_generation
129 PL_lastgotoprobe
130 PL_linestart
131 PL_modcount
132 PL_pending_ident
133 PL_sortcxix
134 PL_sublex_info
135 PL_timesbuf
136 main
137 Perl_ErrorNo
138 Perl_GetVars
139 Perl_do_exec3
140 Perl_do_ipcctl
141 Perl_do_ipcget
142 Perl_do_msgrcv
143 Perl_do_msgsnd
144 Perl_do_semop
145 Perl_do_shmio
146 Perl_dump_fds
147 Perl_init_thread_intern
148 Perl_my_bzero
149 Perl_my_htonl
150 Perl_my_ntohl
151 Perl_my_swap
152 Perl_my_chsize
153 Perl_same_dirent
154 Perl_setenv_getix
155 Perl_unlnk
156 Perl_watch
157 Perl_safexcalloc
158 Perl_safexmalloc
159 Perl_safexfree
160 Perl_safexrealloc
161 Perl_my_memcmp
162 Perl_my_memset
163 PL_cshlen
164 PL_cshname
165 PL_opsave
166 )];
167 } elsif ($PLATFORM eq 'aix') {
168     skip_symbols([qw(
169 Perl_dump_fds
170 Perl_ErrorNo
171 Perl_GetVars
172 Perl_my_bcopy
173 Perl_my_bzero
174 Perl_my_chsize
175 Perl_my_htonl
176 Perl_my_memcmp
177 Perl_my_memset
178 Perl_my_ntohl
179 Perl_my_swap
180 Perl_safexcalloc
181 Perl_safexfree
182 Perl_safexmalloc
183 Perl_safexrealloc
184 Perl_same_dirent
185 Perl_unlnk
186 PL_cryptseen
187 PL_opsave
188 PL_statusvalue_vms
189 PL_sys_intern
190 )]);
191 }
192
193 if ($define{'PERL_OBJECT'}) {
194   skip_symbols [qw(
195     Perl_getenv_len
196     Perl_my_popen
197     Perl_my_pclose
198     )];
199 }
200 else {
201   skip_symbols [qw(
202     PL_Dir
203     PL_Env
204     PL_LIO
205     PL_Mem
206     PL_Proc
207     PL_Sock
208     PL_StdIO
209     )];
210 }
211
212 if ($define{'MYMALLOC'})
213  {
214   emit_symbols [qw(
215     Perl_dump_mstats
216     Perl_malloc
217     Perl_mfree
218     Perl_realloc
219     Perl_calloc)];
220  }
221 else
222  {
223   skip_symbols [qw(
224     Perl_dump_mstats
225     Perl_malloc
226     Perl_mfree
227     Perl_realloc
228     Perl_calloc
229     Perl_malloced_size)];
230  }
231
232 unless ($define{'USE_THREADS'})
233  {
234   skip_symbols [qw(
235 PL_thr_key
236 PL_sv_mutex
237 PL_strtab_mutex
238 PL_svref_mutex
239 PL_malloc_mutex
240 PL_cred_mutex
241 PL_eval_mutex
242 PL_eval_cond
243 PL_eval_owner
244 PL_threads_mutex
245 PL_nthreads
246 PL_nthreads_cond
247 PL_threadnum
248 PL_threadsv_names
249 PL_thrsv
250 PL_vtbl_mutex
251 Perl_getTHR
252 Perl_setTHR
253 Perl_condpair_magic
254 Perl_new_struct_thread
255 Perl_per_thread_magicals
256 Perl_thread_create
257 Perl_find_threadsv
258 Perl_unlock_condpair
259 Perl_magic_mutexfree
260 )];
261  }
262 unless ($define{'USE_THREADS'} or $define{'PERL_IMPLICIT_CONTEXT'}
263         or $define{'PERL_OBJECT'})
264 {
265   skip_symbols [qw(
266                    Perl_croak_nocontext
267                    Perl_die_nocontext
268                    Perl_deb_nocontext
269                    Perl_form_nocontext
270                    Perl_warn_nocontext
271                    Perl_warner_nocontext
272                    Perl_newSVpvf_nocontext
273                    Perl_sv_catpvf_nocontext
274                    Perl_sv_setpvf_nocontext
275                    Perl_sv_catpvf_mg_nocontext
276                    Perl_sv_setpvf_mg_nocontext
277                    )];
278  }
279
280 unless ($define{'FAKE_THREADS'})
281  {
282   skip_symbols [qw(PL_curthr)];
283  }
284
285 sub readvar
286 {
287  my $file = shift;
288  my $proc = shift || sub { "PL_$_[2]" };
289  open(VARS,$file) || die "Cannot open $file: $!\n";
290  my @syms;
291  while (<VARS>)
292   {
293    # All symbols have a Perl_ prefix because that's what embed.h
294    # sticks in front of them.
295    push(@syms, &$proc($1,$2,$3)) if (/\bPERLVAR(A?I?C?)\(([IGT])(\w+)/);
296   } 
297  close(VARS); 
298  return \@syms;
299 }
300
301 if ($define{'USE_THREADS'} || $define{'MULTIPLICITY'})
302  {
303   my $thrd = readvar($thrdvar_h);
304   skip_symbols $thrd;
305  } 
306
307 if ($define{'MULTIPLICITY'})
308  {
309   my $interp = readvar($intrpvar_h);
310   skip_symbols $interp;
311  } 
312
313 if ($define{'PERL_GLOBAL_STRUCT'})
314  {
315   my $global = readvar($perlvars_h);
316   skip_symbols $global;
317   emit_symbols [qw(Perl_GetVars)];
318   emit_symbols [qw(PL_Vars PL_VarsPtr)] unless $CCTYPE eq 'GCC';
319  } 
320
321 unless ($define{'DEBUGGING'})
322  {
323   skip_symbols [qw(
324     Perl_deb
325     Perl_deb_growlevel
326     Perl_debop
327     Perl_debprofdump
328     Perl_debstack
329     Perl_debstackptrs
330     Perl_runops_debug
331     Perl_sv_peek
332     PL_block_type
333     PL_watchaddr
334     PL_watchok)];
335  }
336
337 if ($PLATFORM eq 'win32' && $define{'HAVE_DES_FCRYPT'})
338  {
339   emit_symbols [qw(win32_crypt)];
340  }
341
342 # functions from *.sym files
343
344 my @syms = ($global_sym, $pp_sym, $globvar_sym);
345
346 if ($define{'USE_PERLIO'})
347  {
348      push @syms, $perlio_sym;
349  }
350
351 for my $syms (@syms)
352  {
353   open (GLOBAL, "<$syms") || die "failed to open $syms: $!\n";
354   while (<GLOBAL>) 
355    {
356     next if (!/^[A-Za-z]/);
357     # Functions have a Perl_ prefix
358     # Variables have a PL_ prefix
359     chomp($_);
360     my $symbol = ($syms =~ /var\.sym$/i ? "PL_" : "");
361     $symbol .= $_;
362     emit_symbol($symbol) unless exists $skip{$symbol};
363    }
364   close(GLOBAL);
365  }
366
367 # variables
368
369 if ($define{'PERL_OBJECT'}) {
370     for my $f ($perlvars_h, $intrpvar_h, $thrdvar_h) {
371         my $glob = readvar($f, sub { "Perl_" . $_[1] . $_[2] . "_ptr" });
372         emit_symbols $glob;
373     }
374 }
375 else {
376     unless ($define{'PERL_GLOBAL_STRUCT'}) {
377         my $glob = readvar($perlvars_h);
378         emit_symbols $glob;
379     } 
380     unless ($define{'MULTIPLICITY'}) {
381         my $glob = readvar($intrpvar_h);
382         emit_symbols $glob;
383     } 
384
385     unless ($define{'MULTIPLICITY'} || $define{'USE_THREADS'}) {
386         my $glob = readvar($thrdvar_h);
387         emit_symbols $glob;
388     } 
389 }
390
391 sub try_symbol {
392     my $symbol = shift;
393
394     return if $symbol !~ /^[A-Za-z]/;
395     return if $symbol =~ /^\#/;
396     $symbol =~s/\r//g;
397     chomp($symbol);
398     return if exists $skip{$symbol};
399     emit_symbol($symbol);
400 }
401
402 while (<DATA>) {
403     try_symbol($_);
404 }
405
406 if ($PLATFORM eq 'win32') {
407     foreach my $symbol (qw(
408 boot_DynaLoader
409 Perl_getTHR
410 Perl_init_os_extras
411 Perl_setTHR
412 Perl_thread_create
413 Perl_win32_init
414 RunPerl
415 GetPerlInterpreter
416 SetPerlInterpreter
417 win32_errno
418 win32_environ
419 win32_stdin
420 win32_stdout
421 win32_stderr
422 win32_ferror
423 win32_feof
424 win32_strerror
425 win32_fprintf
426 win32_printf
427 win32_vfprintf
428 win32_vprintf
429 win32_fread
430 win32_fwrite
431 win32_fopen
432 win32_fdopen
433 win32_freopen
434 win32_fclose
435 win32_fputs
436 win32_fputc
437 win32_ungetc
438 win32_getc
439 win32_fileno
440 win32_clearerr
441 win32_fflush
442 win32_ftell
443 win32_fseek
444 win32_fgetpos
445 win32_fsetpos
446 win32_rewind
447 win32_tmpfile
448 win32_abort
449 win32_fstat
450 win32_stat
451 win32_pipe
452 win32_popen
453 win32_pclose
454 win32_rename
455 win32_setmode
456 win32_lseek
457 win32_tell
458 win32_dup
459 win32_dup2
460 win32_open
461 win32_close
462 win32_eof
463 win32_read
464 win32_write
465 win32_spawnvp
466 win32_mkdir
467 win32_rmdir
468 win32_chdir
469 win32_flock
470 win32_execv
471 win32_execvp
472 win32_htons
473 win32_ntohs
474 win32_htonl
475 win32_ntohl
476 win32_inet_addr
477 win32_inet_ntoa
478 win32_socket
479 win32_bind
480 win32_listen
481 win32_accept
482 win32_connect
483 win32_send
484 win32_sendto
485 win32_recv
486 win32_recvfrom
487 win32_shutdown
488 win32_closesocket
489 win32_ioctlsocket
490 win32_setsockopt
491 win32_getsockopt
492 win32_getpeername
493 win32_getsockname
494 win32_gethostname
495 win32_gethostbyname
496 win32_gethostbyaddr
497 win32_getprotobyname
498 win32_getprotobynumber
499 win32_getservbyname
500 win32_getservbyport
501 win32_select
502 win32_endhostent
503 win32_endnetent
504 win32_endprotoent
505 win32_endservent
506 win32_getnetent
507 win32_getnetbyname
508 win32_getnetbyaddr
509 win32_getprotoent
510 win32_getservent
511 win32_sethostent
512 win32_setnetent
513 win32_setprotoent
514 win32_setservent
515 win32_getenv
516 win32_putenv
517 win32_perror
518 win32_setbuf
519 win32_setvbuf
520 win32_flushall
521 win32_fcloseall
522 win32_fgets
523 win32_gets
524 win32_fgetc
525 win32_putc
526 win32_puts
527 win32_getchar
528 win32_putchar
529 win32_malloc
530 win32_calloc
531 win32_realloc
532 win32_free
533 win32_sleep
534 win32_times
535 win32_alarm
536 win32_open_osfhandle
537 win32_get_osfhandle
538 win32_ioctl
539 win32_utime
540 win32_uname
541 win32_wait
542 win32_waitpid
543 win32_kill
544 win32_str_os_error
545 win32_opendir
546 win32_readdir
547 win32_telldir
548 win32_seekdir
549 win32_rewinddir
550 win32_closedir
551 win32_longpath
552 win32_os_id
553                            )) {
554         try_symbol($symbol);
555     }
556 }
557
558 # Now all symbols should be defined because
559 # next we are going to output them.
560
561 foreach my $symbol (sort keys %export)
562  {
563    output_symbol($symbol);
564  }
565
566 sub emit_symbol {
567         my $symbol = shift;
568         chomp($symbol); 
569         $export{$symbol} = 1;
570 }
571
572 sub output_symbol {
573     my $symbol = shift;
574     if ($PLATFORM eq 'win32') {
575         print "\t$symbol\n";
576         $symbol = "_$symbol" if $CCTYPE eq 'BORLAND';
577 # XXX: binary compatibility between compilers is an exercise
578 # in frustration :-(
579 #        if ($CCTYPE eq "BORLAND") {
580 #           # workaround Borland quirk by exporting both the straight
581 #           # name and a name with leading underscore.  Note the
582 #           # alias *must* come after the symbol itself, if both
583 #           # are to be exported. (Linker bug?)
584 #           print "\t_$symbol\n";
585 #           print "\t$symbol = _$symbol\n";
586 #       }
587 #       elsif ($CCTYPE eq 'GCC') {
588 #           # Symbols have leading _ whole process is $%@"% slow
589 #           # so skip aliases for now
590 #           nprint "\t$symbol\n";
591 #       }
592 #       else {
593 #           # for binary coexistence, export both the symbol and
594 #           # alias with leading underscore
595 #           print "\t$symbol\n";
596 #           print "\t_$symbol = $symbol\n";
597 #       }
598     } elsif ($PLATFORM eq 'aix') {
599         print "$symbol\n";
600     }
601 }
602
603 1;
604 __DATA__
605 # extra globals not included above.
606 perl_alloc
607 perl_construct
608 perl_destruct
609 perl_free
610 perl_parse
611 perl_run