X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=win32%2Fmakedef.pl;h=b4097d5c235779872b78b4a5205bc57b7667e100;hb=76e3520e1f6b7df33cd381a2cf4f1fce3d69c8a4;hp=dfd507a8658a25f76b02d8a49cd2edcb7d7da91d;hpb=68dc074516a6859e3424b48d1647bcb08b1a1a7d;p=p5sagit%2Fp5-mst-13.2.git diff --git a/win32/makedef.pl b/win32/makedef.pl index dfd507a..b4097d5 100644 --- a/win32/makedef.pl +++ b/win32/makedef.pl @@ -12,15 +12,65 @@ # There is some symbol defined in global.sym and interp.sym # that does not present in the WIN32 port but there is no easy -# way to find them so I just put a exeception list here +# way to find them so I just put a exception list here -$skip_sym=<<'!END!OF!SKIP!'; -Perl_SvIV -Perl_SvNV -Perl_SvTRUE -Perl_SvUV +my $CCTYPE = "MSVC"; # default + +while (@ARGV) + { + my $flag = shift; + $define{$1} = 1 if ($flag =~ /^-D(\w+)$/); + $CCTYPE = $1 if ($flag =~ /^CCTYPE=(\w+)$/); + } + +open(CFG,'config.h') || die "Cannot open config.h:$!"; +while () + { + $define{$1} = 1 if /^\s*#\s*define\s+(MYMALLOC)\b/; + } +close(CFG); + +warn join(' ',keys %define)."\n"; + +if ($CCTYPE ne 'GCC') + { + print "LIBRARY Perl\n"; + print "DESCRIPTION 'Perl interpreter, export autogenerated'\n"; + print "CODE LOADONCALL\n"; + print "DATA LOADONCALL NONSHARED MULTIPLE\n"; + } +else + { + $define{'PERL_GLOBAL_STRUCT'} = 1; + $define{'MULTIPLICITY'} = 1; + } + +print "EXPORTS\n"; + +my %skip; +my %export; + +sub skip_symbols +{ + my $list = shift; + foreach my $symbol (@$list) + { + $skip{$symbol} = 1; + } +} + +sub emit_symbols +{ + my $list = shift; + foreach my $symbol (@$list) + { + emit_symbol($symbol) unless exists $skip{$symbol}; + } +} + +skip_symbols [qw( +Perl_statusvalue_vms Perl_block_type -Perl_sv_pvn Perl_additem Perl_cast_ulong Perl_check_uni @@ -54,6 +104,7 @@ Perl_dump_packsubs Perl_dump_pm Perl_dump_sub Perl_expectterm +Perl_error_no Perl_fetch_gv Perl_fetch_io Perl_force_ident @@ -61,6 +112,7 @@ Perl_force_next Perl_force_word Perl_hv_stashpv Perl_intuit_more +Perl_init_thread_intern Perl_know_next Perl_modkids Perl_mstats @@ -81,6 +133,7 @@ Perl_pp_interp Perl_pp_map Perl_pp_nswitch Perl_q +Perl_rcsid Perl_reall_srchlen Perl_regdump Perl_regfold @@ -104,9 +157,9 @@ Perl_scan_trans Perl_scan_word Perl_setenv_getix Perl_skipspace +Perl_sort_mutex Perl_sublex_done Perl_sublex_start -Perl_sv_peek Perl_sv_ref Perl_sv_setptrobj Perl_timesbuf @@ -119,46 +172,132 @@ Perl_yyname Perl_yyrule allgvs curblock -curcop -curcopdb curcsv -envgv lastretstr mystack_mark perl_init_ext perl_requirepv -siggv stack statusvalue_vms -tainting Perl_safexcalloc Perl_safexmalloc Perl_safexfree Perl_safexrealloc Perl_my_memcmp +Perl_my_memset Perl_cshlen Perl_cshname -!END!OF!SKIP! +Perl_opsave +)]; -# All symbols have a Perl_ prefix because that's what embed.h -# sticks in front of them. +if ($define{'MYMALLOC'}) + { + skip_symbols [qw( + Perl_safefree + Perl_safemalloc + Perl_saferealloc + Perl_safecalloc)]; + emit_symbols [qw( + Perl_malloc + Perl_free + Perl_realloc + Perl_calloc)]; + } -print "LIBRARY Perl\n"; -print "DESCRIPTION 'Perl interpreter, export autogenerated'\n"; -print "CODE LOADONCALL\n"; -print "DATA LOADONCALL NONSHARED MULTIPLE\n"; -print "EXPORTS\n"; +unless ($define{'USE_THREADS'}) + { + skip_symbols [qw( +Perl_condpair_magic +Perl_thr_key +Perl_sv_mutex +Perl_malloc_mutex +Perl_eval_mutex +Perl_eval_cond +Perl_eval_owner +Perl_threads_mutex +Perl_new_struct_thread +Perl_nthreads +Perl_nthreads_cond +Perl_per_thread_magicals +Perl_thread_create +Perl_find_threadsv +Perl_threadsv_names +Perl_thrsv +Perl_unlock_condpair +Perl_vtbl_mutex +Perl_magic_mutexfree +Perl_sv_iv +Perl_sv_nv +Perl_sv_true +Perl_sv_uv +Perl_sv_pvn +Perl_newRV_noinc)]; + } + +unless ($define{'FAKE_THREADS'}) + { + skip_symbols [qw(Perl_curthr)]; + } + +sub readvar +{ + my $file = shift; + open(VARS,$file) || die "Cannot open $file:$!"; + my @syms; + while () + { + # All symbols have a Perl_ prefix because that's what embed.h + # sticks in front of them. + push(@syms,"Perl_".$1) if (/\bPERLVARI?C?\([IGT](\w+)/); + } + close(VARS); + return \@syms; +} + +if ($define{'USE_THREADS'} || $define{'MULTIPLICITY'}) + { + my $thrd = readvar("../thrdvar.h"); + skip_symbols $thrd; + } + +if ($define{'MULTIPLICITY'}) + { + my $interp = readvar("../intrpvar.h"); + skip_symbols $interp; + } + +if ($define{'PERL_GLOBAL_STRUCT'}) + { + my $global = readvar("../perlvars.h"); + skip_symbols $global; + } + +unless ($define{'DEBUGGING'}) + { + skip_symbols [qw( + Perl_runops_debug + Perl_sv_peek + Perl_watchaddr + Perl_watchok)]; + } + +if ($define{'HAVE_DES_FCRYPT'}) + { + emit_symbols [qw(win32_crypt)]; + } open (GLOBAL, "<../global.sym") || die "failed to open global.sym" . $!; -while () { - my $symbol; - next if (!/^[A-Za-z]/); - next if (/_amg[ \t]*$/); - $symbol = "Perl_$_"; - next if ($skip_sym =~ m/$symbol/m); - print "\t$symbol"; - }; +while () + { + next if (!/^[A-Za-z]/); + next if (/_amg[ \t]*$/); + # All symbols have a Perl_ prefix because that's what embed.h + # sticks in front of them. + chomp($_); + my $symbol = "Perl_$_"; + emit_symbol($symbol) unless exists $skip{$symbol}; + } close(GLOBAL); # also add symbols from interp.sym @@ -166,27 +305,67 @@ close(GLOBAL); # doesn't hurt to include them anyway. # these don't have Perl prefix -open (INTERP, "<../interp.sym") || die "failed to open interp.sym" . $!; -while () { - my $symbol; - next if (!/^[A-Za-z]/); - next if (/_amg[ \t]*$/); - $symbol = $_; - next if ($skip_sym =~ m/$symbol/m); - #print "\t$symbol"; - print "\tPerl_$symbol"; - }; +if ($define{'PERL_GLOBAL_STRUCT'}) + { + emit_symbol( ($CCTYPE eq 'GCC') ? 'Perl_GetVars' : 'Perl_VarsPtr') + } +else + { + my $glob = readvar("../perlvars.h"); + emit_symbols $glob; + } -#close(INTERP); +unless ($define{'MULTIPLICITY'}) + { + my $glob = readvar("../intrpvar.h"); + emit_symbols $glob; + } + +unless ($define{'MULTIPLICITY'} || $define{'USE_THREADS'}) + { + my $glob = readvar("../thrdvar.h"); + emit_symbols $glob; + } while () { my $symbol; next if (!/^[A-Za-z]/); next if (/^#/); + s/\r//g; + chomp($_); $symbol = $_; - next if ($skip_sym =~ m/^$symbol/m); - print "\t$symbol"; - }; + next if exists $skip{$symbol}; + emit_symbol($symbol); +} + +foreach my $symbol (sort keys %export) + { + if ($CCTYPE eq "BORLAND") { + # workaround Borland quirk by exporting both the straight + # name and a name with leading underscore. Note the + # alias *must* come after the symbol itself, if both + # are to be exported. (Linker bug?) + print "\t_$symbol\n"; + print "\t$symbol = _$symbol\n"; + } + elsif ($CCTYPE eq 'GCC') { + # Symbols have leading _ whole process is $%£"% slow + # so skip aliases for now + print "\t$symbol\n"; + } + else { + # for binary coexistence, export both the symbol and + # alias with leading underscore + print "\t$symbol\n"; + print "\t_$symbol = $symbol\n"; + } + } + +sub emit_symbol { + my $symbol = shift; + chomp($symbol); + $export{$symbol} = 1; +} 1; __DATA__ @@ -207,24 +386,23 @@ perl_call_argv perl_call_pv perl_call_method perl_call_sv -perl_requirepv -win32_inet_addr -win32_gethostbyname -win32_inet_ntoa -win32_htons -win32_ntohs -win32_htonl -win32_stat +perl_require_pv +perl_eval_pv +perl_eval_sv +boot_DynaLoader +Perl_thread_create win32_errno -win32_stderr +win32_environ win32_stdin win32_stdout +win32_stderr win32_ferror win32_feof win32_strerror win32_fprintf win32_printf win32_vfprintf +win32_vprintf win32_fread win32_fwrite win32_fopen @@ -246,15 +424,97 @@ win32_rewind win32_tmpfile win32_abort win32_fstat +win32_stat win32_pipe win32_popen win32_pclose win32_setmode -win32_open -win32_close +win32_lseek +win32_tell win32_dup win32_dup2 +win32_open +win32_close +win32_eof win32_read win32_write -win32_spawnvpe -win32_spawnle +win32_spawnvp +win32_mkdir +win32_rmdir +win32_chdir +win32_flock +win32_execvp +win32_htons +win32_ntohs +win32_htonl +win32_ntohl +win32_inet_addr +win32_inet_ntoa +win32_socket +win32_bind +win32_listen +win32_accept +win32_connect +win32_send +win32_sendto +win32_recv +win32_recvfrom +win32_shutdown +win32_closesocket +win32_ioctlsocket +win32_setsockopt +win32_getsockopt +win32_getpeername +win32_getsockname +win32_gethostname +win32_gethostbyname +win32_gethostbyaddr +win32_getprotobyname +win32_getprotobynumber +win32_getservbyname +win32_getservbyport +win32_select +win32_endhostent +win32_endnetent +win32_endprotoent +win32_endservent +win32_getnetent +win32_getnetbyname +win32_getnetbyaddr +win32_getprotoent +win32_getservent +win32_sethostent +win32_setnetent +win32_setprotoent +win32_setservent +win32_getenv +win32_perror +win32_setbuf +win32_setvbuf +win32_flushall +win32_fcloseall +win32_fgets +win32_gets +win32_fgetc +win32_putc +win32_puts +win32_getchar +win32_putchar +win32_malloc +win32_calloc +win32_realloc +win32_free +win32_sleep +win32_times +win32_alarm +win32_open_osfhandle +win32_get_osfhandle +win32_ioctl +win32_wait +win32_str_os_error +Perl_win32_init +Perl_init_os_extras +Perl_getTHR +Perl_setTHR +RunPerl +