X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=win32%2Fmakedef.pl;h=059fc4927d276b19d991078731475fcc599a70d0;hb=a29cdaf07aa5601e42ae4955cc0f168e91a7c385;hp=e39874211a6f8dfe8d7cc7f2f6c63e2fae662078;hpb=32f822de0a58c2cc8f1a23844b97246c433bb418;p=p5sagit%2Fp5-mst-13.2.git diff --git a/win32/makedef.pl b/win32/makedef.pl index e398742..059fc49 100644 --- a/win32/makedef.pl +++ b/win32/makedef.pl @@ -14,32 +14,83 @@ # that does not present in the WIN32 port but there is no easy # way to find them so I just put a exception list here -while (@ARGV && $ARGV[0] =~ /^-/) +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/; + $define{$1} = 1 if /^\s*#\s*define\s+(USE_THREADS)\b/; + } +close(CFG); + warn join(' ',keys %define)."\n"; -my $CCTYPE = shift || "MSVC"; +if ($define{PERL_OBJECT}) { + print "LIBRARY PerlCore\n"; + print "DESCRIPTION 'Perl interpreter'\n"; + print "EXPORTS\n"; + output_symbol("perl_alloc"); + exit(0); +} + +if ($CCTYPE ne 'GCC') + { + print "LIBRARY Perl\n"; + print "DESCRIPTION 'Perl interpreter, export autogenerated'\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_sym=<<'!END!OF!SKIP!'; +skip_symbols [qw( +Perl_statusvalue_vms +Perl_archpat_auto Perl_block_type +Perl_bostr Perl_additem Perl_cast_ulong Perl_check_uni Perl_checkcomma Perl_chsize Perl_ck_aelem +Perl_colors +Perl_colorset Perl_cryptseen Perl_cx_dump -Perl_deb -Perl_deb_growlevel -Perl_debop -Perl_debprofdump -Perl_debstack -Perl_debstackptrs +Perl_DBcv Perl_do_ipcctl Perl_do_ipcget Perl_do_msgrcv @@ -59,15 +110,22 @@ Perl_dump_packsubs Perl_dump_pm Perl_dump_sub Perl_expectterm +Perl_extralen Perl_fetch_gv Perl_fetch_io Perl_force_ident Perl_force_next Perl_force_word +Perl_generation Perl_hv_stashpv +Perl_in_clean_all +Perl_in_clean_objs Perl_intuit_more Perl_init_thread_intern Perl_know_next +Perl_lastgotoprobe +Perl_linestart +Perl_modcount Perl_modkids Perl_mstats Perl_my_bzero @@ -80,6 +138,7 @@ Perl_no_fh_allowed Perl_no_op Perl_nointrp Perl_nomem +Perl_pending_ident Perl_pp_cswitch Perl_pp_entersubr Perl_pp_evalonce @@ -89,13 +148,41 @@ Perl_pp_nswitch Perl_q Perl_rcsid Perl_reall_srchlen +Perl_reg_eval_set +Perl_reg_flags +Perl_reg_start_tmp +Perl_reg_start_tmpl +Perl_regbol +Perl_regcc +Perl_regcode +Perl_regdata +Perl_regdummy Perl_regdump Perl_regfold +Perl_regendp +Perl_regeol +Perl_regflags +Perl_regindent +Perl_reginput +Perl_reglastparen Perl_regmyendp Perl_regmyp_size Perl_regmystartp Perl_regnarrate +Perl_regnaughty +Perl_regnpar +Perl_regcomp_parse +Perl_regprecomp +Perl_regprev +Perl_regprogram Perl_regprop +Perl_regsawback +Perl_regseen +Perl_regsize +Perl_regstartp +Perl_regtill +Perl_regxend +Perl_regcomp_rx Perl_same_dirent Perl_saw_return Perl_scan_const @@ -109,9 +196,13 @@ Perl_scan_str Perl_scan_subst Perl_scan_trans Perl_scan_word +Perl_seen_zerolen Perl_setenv_getix Perl_skipspace +Perl_sort_mutex +Perl_sortcxix Perl_sublex_done +Perl_sublex_info Perl_sublex_start Perl_sv_ref Perl_sv_setptrobj @@ -119,7 +210,6 @@ Perl_timesbuf Perl_too_few_arguments Perl_too_many_arguments Perl_unlnk -Perl_wait4pid Perl_watch Perl_yyname Perl_yyrule @@ -141,14 +231,32 @@ Perl_my_memset Perl_cshlen Perl_cshname Perl_opsave -!END!OF!SKIP! +)]; + + +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)]; + } unless ($define{'USE_THREADS'}) { - $skip_sym .= <<'!END!OF!SKIP!'; + skip_symbols [qw( +Perl_getTHR +Perl_setTHR Perl_condpair_magic Perl_thr_key Perl_sv_mutex +Perl_svref_mutex Perl_malloc_mutex Perl_eval_mutex Perl_eval_cond @@ -158,6 +266,10 @@ Perl_new_struct_thread Perl_nthreads Perl_nthreads_cond Perl_per_thread_magicals +Perl_thread_create +Perl_threadnum +Perl_find_threadsv +Perl_threadsv_names Perl_thrsv Perl_unlock_condpair Perl_vtbl_mutex @@ -167,47 +279,80 @@ Perl_sv_nv Perl_sv_true Perl_sv_uv Perl_sv_pvn -Perl_newRV_noinc -!END!OF!SKIP! +Perl_newRV_noinc)]; } -if ($define{'USE_THISPTR'} || $define{'USE_THREADS'}) +unless ($define{'FAKE_THREADS'}) { - open(THREAD,"<../thread.sym") || die "Cannot open thread.sym:$!"; - while () - { - next if (!/^[A-Za-z]/); - next if (/_amg[ \t]*$/); - $skip_sym .= "Perl_".$_; - } - close(THREAD); - $skip_sym .= "Perl_op\n"; + 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; } -unless ($define{'USE_THREADS'}) +if ($define{'MULTIPLICITY'}) { - $skip_sym .= "Perl_thread_create\n"; - } + my $interp = readvar("../intrpvar.h"); + skip_symbols $interp; + } -# All symbols have a Perl_ prefix because that's what embed.h -# sticks in front of them. +if ($define{'PERL_GLOBAL_STRUCT'}) + { + my $global = readvar("../perlvars.h"); + skip_symbols $global; + emit_symbols [qw(Perl_GetVars)]; + emit_symbols [qw(Perl_Vars Perl_VarsPtr)] unless $CCTYPE eq 'GCC'; + } +unless ($define{'DEBUGGING'}) + { + skip_symbols [qw( + Perl_deb + Perl_deb_growlevel + Perl_debop + Perl_debprofdump + Perl_debstack + Perl_debstackptrs + Perl_runops_debug + Perl_sv_peek + Perl_watchaddr + Perl_watchok)]; + } -print "LIBRARY Perl\n"; -print "DESCRIPTION 'Perl interpreter, export autogenerated'\n"; -print "CODE LOADONCALL\n"; -print "DATA LOADONCALL NONSHARED MULTIPLE\n"; -print "EXPORTS\n"; +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); - emit_symbol($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 @@ -215,47 +360,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"; - emit_symbol("Perl_" . $symbol); -} +unless ($define{'PERL_GLOBAL_STRUCT'}) + { + 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); - $symbol = "Perl_".$symbol if ($define{'USE_THISPTR'} - && $symbol =~ /^perl/); + next if exists $skip{$symbol}; emit_symbol($symbol); } +foreach my $symbol (sort keys %export) + { + output_symbol($symbol); + } + sub emit_symbol { my $symbol = shift; - chomp $symbol; - 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"; - } - else { - # for binary coexistence, export both the symbol and - # alias with leading underscore - print "\t$symbol\n"; - print "\t_$symbol = $symbol\n"; - } + chomp($symbol); + $export{$symbol} = 1; +} + +sub output_symbol { + my $symbol = shift; + 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"; + } } 1; @@ -264,6 +429,7 @@ __DATA__ perl_init_i18nl10n perl_init_ext perl_alloc +perl_atexit perl_construct perl_destruct perl_free @@ -280,6 +446,11 @@ perl_call_sv perl_require_pv perl_eval_pv perl_eval_sv +perl_new_ctype +perl_new_collate +perl_new_numeric +perl_set_numeric_standard +perl_set_numeric_local boot_DynaLoader Perl_thread_create win32_errno @@ -334,6 +505,7 @@ win32_mkdir win32_rmdir win32_chdir win32_flock +win32_execv win32_execvp win32_htons win32_ntohs @@ -351,6 +523,7 @@ win32_sendto win32_recv win32_recvfrom win32_shutdown +win32_closesocket win32_ioctlsocket win32_setsockopt win32_getsockopt @@ -394,8 +567,20 @@ win32_malloc win32_calloc win32_realloc win32_free -win32stdio +win32_sleep +win32_times +win32_alarm +win32_open_osfhandle +win32_get_osfhandle +win32_ioctl +win32_utime +win32_wait +win32_waitpid +win32_kill +win32_str_os_error Perl_win32_init +Perl_init_os_extras +Perl_getTHR +Perl_setTHR RunPerl -SetIOSubSystem -GetIOSubSystem +