win32/makedef.pl

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