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