X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=win32%2Fmakedef.pl;h=c366be4cddd12fc780563ac7ffde820bbe57f77f;hb=a5871d1a83cd3d5c7292135cbb30a336a8552ab0;hp=2ef1bb5dd0143deff7226d47e4853a47c9cfcc9d;hpb=059e4e88d1fa9d5d262346f1d85723e36d59494c;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/win32/makedef.pl b/win32/makedef.pl
index 2ef1bb5..c366be4 100644
--- a/win32/makedef.pl
+++ b/win32/makedef.pl
@@ -14,15 +14,64 @@
 # 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
 
-my $CCTYPE = shift || "MSVC";
+my $CCTYPE = "MSVC";	# default
 
-$skip_sym=<<'!END!OF!SKIP!';
-Perl_SvIV
-Perl_SvNV
-Perl_SvTRUE
-Perl_SvUV
+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 (<CFG>)
+ {
+  $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";
+
+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
@@ -31,12 +80,6 @@ Perl_chsize
 Perl_ck_aelem
 Perl_cryptseen
 Perl_cx_dump
-Perl_deb
-Perl_deb_growlevel
-Perl_debop
-Perl_debprofdump
-Perl_debstack
-Perl_debstackptrs
 Perl_do_ipcctl
 Perl_do_ipcget
 Perl_do_msgrcv
@@ -63,6 +106,7 @@ Perl_force_next
 Perl_force_word
 Perl_hv_stashpv
 Perl_intuit_more
+Perl_init_thread_intern
 Perl_know_next
 Perl_modkids
 Perl_mstats
@@ -83,6 +127,7 @@ Perl_pp_interp
 Perl_pp_map
 Perl_pp_nswitch
 Perl_q
+Perl_rcsid
 Perl_reall_srchlen
 Perl_regdump
 Perl_regfold
@@ -114,7 +159,6 @@ Perl_timesbuf
 Perl_too_few_arguments
 Perl_too_many_arguments
 Perl_unlnk
-Perl_wait4pid
 Perl_watch
 Perl_yyname
 Perl_yyrule
@@ -136,27 +180,126 @@ Perl_my_memset
 Perl_cshlen
 Perl_cshname
 Perl_opsave
-!END!OF!SKIP!
+)];
 
-# 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_getTHR
+Perl_setTHR
+Perl_condpair_magic
+Perl_thr_key
+Perl_sv_mutex
+Perl_svref_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_threadnum
+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)];
+ }
 
-open (GLOBAL, "<../global.sym") || die "failed to open global.sym" . $!;
-while (<GLOBAL>) {
-	my $symbol;
-	next if (!/^[A-Za-z]/);
-	next if (/_amg[ \t]*$/);
-	$symbol = "Perl_$_";
-    	next if ($skip_sym =~ m/$symbol/m);
-	emit_symbol($symbol);
+unless ($define{'FAKE_THREADS'})
+ {
+  skip_symbols [qw(Perl_curthr)];
+ }
+
+sub readvar
+{
+ my $file = shift;
+ open(VARS,$file) || die "Cannot open $file:$!";
+ my @syms;
+ while (<VARS>)
+  {
+   # 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_deb
+    Perl_deb_growlevel
+    Perl_debop
+    Perl_debprofdump
+    Perl_debstack
+    Perl_debstackptrs
+    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 (<GLOBAL>) 
+ {
+  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
@@ -164,31 +307,41 @@ 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 (<INTERP>) {
-	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);
-}
+if ($define{'PERL_GLOBAL_STRUCT'})
+ {
+  emit_symbol( ($CCTYPE eq 'GCC') ? 'Perl_GetVars' : 'Perl_VarsPtr')
+ }
+else
+ {
+  my $glob = readvar("../perlvars.h");
+  emit_symbols $glob;
+ } 
+
+unless ($define{'MULTIPLICITY'})
+ {
+  my $glob = readvar("../intrpvar.h");
+  emit_symbols $glob;
+ } 
 
-#close(INTERP);
+unless ($define{'MULTIPLICITY'} || $define{'USE_THREADS'})
+ {
+  my $glob = readvar("../thrdvar.h");
+  emit_symbols $glob;
+ } 
 
 while (<DATA>) {
 	my $symbol;
 	next if (!/^[A-Za-z]/);
 	next if (/^#/);
+        s/\r//g;
+        chomp($_);
 	$symbol = $_;
-    	next if ($skip_sym =~ m/^$symbol/m);
+    	next if exists $skip{$symbol};
 	emit_symbol($symbol);
 }
 
-sub emit_symbol {
-	my $symbol = shift;
-	chomp $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
@@ -197,12 +350,23 @@ sub emit_symbol {
 		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;
@@ -211,6 +375,7 @@ __DATA__
 perl_init_i18nl10n
 perl_init_ext
 perl_alloc
+perl_atexit
 perl_construct
 perl_destruct
 perl_free
@@ -227,7 +392,13 @@ 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
 win32_environ
 win32_stdin
@@ -297,6 +468,7 @@ win32_sendto
 win32_recv
 win32_recvfrom
 win32_shutdown
+win32_closesocket
 win32_ioctlsocket
 win32_setsockopt
 win32_getsockopt
@@ -340,8 +512,18 @@ 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_str_os_error
 Perl_win32_init
+Perl_init_os_extras
+Perl_getTHR
+Perl_setTHR
 RunPerl
-SetIOSubSystem
-GetIOSubSystem
+