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