This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
remove bogus symbols from global.sym
[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_ipcctl
83 Perl_do_ipcget
84 Perl_do_msgrcv
85 Perl_do_msgsnd
86 Perl_do_semop
87 Perl_do_shmio
88 Perl_dump_fds
89 Perl_dump_mstats
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_malloc
116     Perl_mfree
117     Perl_realloc
118     Perl_calloc)];
119  }
120 else
121  {
122   skip_symbols [qw(
123     Perl_malloced_size)];
124  }
125
126 unless ($define{'USE_THREADS'})
127  {
128   skip_symbols [qw(
129 PL_thr_key
130 PL_sv_mutex
131 PL_strtab_mutex
132 PL_svref_mutex
133 PL_malloc_mutex
134 PL_cred_mutex
135 PL_eval_mutex
136 PL_eval_cond
137 PL_eval_owner
138 PL_threads_mutex
139 PL_nthreads
140 PL_nthreads_cond
141 PL_threadnum
142 PL_threadsv_names
143 PL_thrsv
144 PL_vtbl_mutex
145 Perl_getTHR
146 Perl_setTHR
147 Perl_condpair_magic
148 Perl_new_struct_thread
149 Perl_per_thread_magicals
150 Perl_thread_create
151 Perl_find_threadsv
152 Perl_unlock_condpair
153 Perl_magic_mutexfree
154 )];
155  }
156
157 unless ($define{'FAKE_THREADS'})
158  {
159   skip_symbols [qw(PL_curthr)];
160  }
161
162 sub readvar
163 {
164  my $file = shift;
165  open(VARS,$file) || die "Cannot open $file:$!";
166  my @syms;
167  while (<VARS>)
168   {
169    # All symbols have a Perl_ prefix because that's what embed.h
170    # sticks in front of them.
171    push(@syms,"PL_".$1) if (/\bPERLVARI?C?\([IGT](\w+)/);
172   } 
173  close(VARS); 
174  return \@syms;
175 }
176
177 if ($define{'USE_THREADS'} || $define{'MULTIPLICITY'})
178  {
179   my $thrd = readvar("../thrdvar.h");
180   skip_symbols $thrd;
181  } 
182
183 if ($define{'MULTIPLICITY'})
184  {
185   my $interp = readvar("../intrpvar.h");
186   skip_symbols $interp;
187  } 
188
189 if ($define{'PERL_GLOBAL_STRUCT'})
190  {
191   my $global = readvar("../perlvars.h");
192   skip_symbols $global;
193   emit_symbols [qw(Perl_GetVars)];
194   emit_symbols [qw(PL_Vars PL_VarsPtr)] unless $CCTYPE eq 'GCC';
195  } 
196
197 unless ($define{'DEBUGGING'})
198  {
199   skip_symbols [qw(
200     Perl_deb
201     Perl_deb_growlevel
202     Perl_debop
203     Perl_debprofdump
204     Perl_debstack
205     Perl_debstackptrs
206     Perl_runops_debug
207     Perl_sv_peek
208     PL_block_type
209     PL_watchaddr
210     PL_watchok)];
211  }
212
213 if ($define{'HAVE_DES_FCRYPT'})
214  {
215   emit_symbols [qw(win32_crypt)];
216  }
217
218 # functions from *.sym files
219
220 for my $syms ('../global.sym','../pp.sym', '../globvar.sym')
221  {
222   open (GLOBAL, "<$syms") || die "failed to open $syms" . $!;
223   while (<GLOBAL>) 
224    {
225     next if (!/^[A-Za-z]/);
226     # Functions have a Perl_ prefix
227     # Variables have a PL_ prefix
228     chomp($_);
229     my $symbol = ($syms =~ /var\.sym$/i ? "PL_" : "Perl_");
230     $symbol .= $_;
231     emit_symbol($symbol) unless exists $skip{$symbol};
232    }
233   close(GLOBAL);
234  }
235
236 # variables
237
238 unless ($define{'PERL_GLOBAL_STRUCT'})
239  {
240   my $glob = readvar("../perlvars.h");
241   emit_symbols $glob;
242  } 
243
244 unless ($define{'MULTIPLICITY'})
245  {
246   my $glob = readvar("../intrpvar.h");
247   emit_symbols $glob;
248  } 
249
250 unless ($define{'MULTIPLICITY'} || $define{'USE_THREADS'})
251  {
252   my $glob = readvar("../thrdvar.h");
253   emit_symbols $glob;
254  } 
255
256 while (<DATA>) {
257         my $symbol;
258         next if (!/^[A-Za-z]/);
259         next if (/^#/);
260         s/\r//g;
261         chomp($_);
262         $symbol = $_;
263         next if exists $skip{$symbol};
264         emit_symbol($symbol);
265 }
266
267 foreach my $symbol (sort keys %export)
268  {
269    output_symbol($symbol);
270  }
271
272 sub emit_symbol {
273         my $symbol = shift;
274         chomp($symbol); 
275         $export{$symbol} = 1;
276 }
277
278 sub output_symbol {
279     my $symbol = shift;
280     if ($CCTYPE eq "BORLAND") {
281             # workaround Borland quirk by exporting both the straight
282             # name and a name with leading underscore.  Note the
283             # alias *must* come after the symbol itself, if both
284             # are to be exported. (Linker bug?)
285             print "\t_$symbol\n";
286             print "\t$symbol = _$symbol\n";
287     }
288     elsif ($CCTYPE eq 'GCC') {
289             # Symbols have leading _ whole process is $%£"% slow
290             # so skip aliases for now
291             print "\t$symbol\n";
292     }
293     else {
294             # for binary coexistence, export both the symbol and
295             # alias with leading underscore
296             print "\t$symbol\n";
297             print "\t_$symbol = $symbol\n";
298     }
299 }
300
301 1;
302 __DATA__
303 # extra globals not included above.
304 perl_init_i18nl10n
305 perl_init_ext
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_wait
455 win32_waitpid
456 win32_kill
457 win32_str_os_error
458 win32_opendir
459 win32_readdir
460 win32_telldir
461 win32_seekdir
462 win32_rewinddir
463 win32_closedir
464 Perl_win32_init
465 Perl_init_os_extras
466 Perl_getTHR
467 Perl_setTHR
468 RunPerl
469