This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
make safesysmalloc() etc., always available; safemalloc() et al are
[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_additem
83 Perl_cast_ulong
84 Perl_check_uni
85 Perl_checkcomma
86 Perl_chsize
87 Perl_ck_aelem
88 Perl_cx_dump
89 Perl_do_ipcctl
90 Perl_do_ipcget
91 Perl_do_msgrcv
92 Perl_do_msgsnd
93 Perl_do_semop
94 Perl_do_shmio
95 Perl_doeval
96 Perl_dofindlabel
97 Perl_dopoptoeval
98 Perl_dump_eval
99 Perl_dump_fds
100 Perl_dump_form
101 Perl_dump_gv
102 Perl_dump_mstats
103 Perl_dump_op
104 Perl_dump_packsubs
105 Perl_dump_pm
106 Perl_dump_sub
107 Perl_expectterm
108 Perl_fetch_gv
109 Perl_fetch_io
110 Perl_force_ident
111 Perl_force_next
112 Perl_force_word
113 Perl_hv_stashpv
114 Perl_intuit_more
115 Perl_init_thread_intern
116 Perl_know_next
117 Perl_modkids
118 Perl_mstats
119 Perl_my_bzero
120 Perl_my_htonl
121 Perl_my_ntohl
122 Perl_my_swap
123 Perl_my_chsize
124 Perl_newXSUB
125 Perl_no_fh_allowed
126 Perl_no_op
127 Perl_nointrp
128 Perl_nomem
129 Perl_pp_cswitch
130 Perl_pp_entersubr
131 Perl_pp_evalonce
132 Perl_pp_interp
133 Perl_pp_map
134 Perl_pp_nswitch
135 Perl_reall_srchlen
136 Perl_same_dirent
137 Perl_saw_return
138 Perl_scan_const
139 Perl_scan_formline
140 Perl_scan_heredoc
141 Perl_scan_ident
142 Perl_scan_inputsymbol
143 Perl_scan_pat
144 Perl_scan_prefix
145 Perl_scan_str
146 Perl_scan_subst
147 Perl_scan_trans
148 Perl_scan_word
149 Perl_setenv_getix
150 Perl_skipspace
151 Perl_sort_mutex
152 Perl_sublex_done
153 Perl_sublex_start
154 Perl_sv_ref
155 Perl_sv_setptrobj
156 Perl_too_few_arguments
157 Perl_too_many_arguments
158 Perl_unlnk
159 Perl_watch
160 Perl_yyname
161 Perl_yyrule
162 allgvs
163 curblock
164 curcsv
165 lastretstr
166 mystack_mark
167 perl_init_ext
168 perl_requirepv
169 stack
170 Perl_safexcalloc
171 Perl_safexmalloc
172 Perl_safexfree
173 Perl_safexrealloc
174 Perl_my_memcmp
175 Perl_my_memset
176 PL_cshlen
177 PL_cshname
178 PL_opsave
179 )];
180
181
182 if ($define{'MYMALLOC'})
183  {
184   emit_symbols [qw(
185     Perl_malloc
186     Perl_mfree
187     Perl_realloc
188     Perl_calloc)];
189  }
190 else
191  {
192   skip_symbols [qw(
193     Perl_malloced_size)];
194  }
195
196 unless ($define{'USE_THREADS'})
197  {
198   skip_symbols [qw(
199 PL_thr_key
200 PL_sv_mutex
201 PL_strtab_mutex
202 PL_svref_mutex
203 PL_malloc_mutex
204 PL_cred_mutex
205 PL_eval_mutex
206 PL_eval_cond
207 PL_eval_owner
208 PL_threads_mutex
209 PL_nthreads
210 PL_nthreads_cond
211 PL_threadnum
212 PL_threadsv_names
213 PL_thrsv
214 PL_vtbl_mutex
215 Perl_getTHR
216 Perl_setTHR
217 Perl_condpair_magic
218 Perl_new_struct_thread
219 Perl_per_thread_magicals
220 Perl_thread_create
221 Perl_find_threadsv
222 Perl_unlock_condpair
223 Perl_magic_mutexfree
224 )];
225  }
226
227 unless ($define{'FAKE_THREADS'})
228  {
229   skip_symbols [qw(PL_curthr)];
230  }
231
232 sub readvar
233 {
234  my $file = shift;
235  open(VARS,$file) || die "Cannot open $file:$!";
236  my @syms;
237  while (<VARS>)
238   {
239    # All symbols have a Perl_ prefix because that's what embed.h
240    # sticks in front of them.
241    push(@syms,"PL_".$1) if (/\bPERLVARI?C?\([IGT](\w+)/);
242   } 
243  close(VARS); 
244  return \@syms;
245 }
246
247 if ($define{'USE_THREADS'} || $define{'MULTIPLICITY'})
248  {
249   my $thrd = readvar("../thrdvar.h");
250   skip_symbols $thrd;
251  } 
252
253 if ($define{'MULTIPLICITY'})
254  {
255   my $interp = readvar("../intrpvar.h");
256   skip_symbols $interp;
257  } 
258
259 if ($define{'PERL_GLOBAL_STRUCT'})
260  {
261   my $global = readvar("../perlvars.h");
262   skip_symbols $global;
263   emit_symbols [qw(Perl_GetVars)];
264   emit_symbols [qw(PL_Vars PL_VarsPtr)] unless $CCTYPE eq 'GCC';
265  } 
266
267 unless ($define{'DEBUGGING'})
268  {
269   skip_symbols [qw(
270     Perl_deb
271     Perl_deb_growlevel
272     Perl_debop
273     Perl_debprofdump
274     Perl_debstack
275     Perl_debstackptrs
276     Perl_runops_debug
277     Perl_sv_peek
278     PL_block_type
279     PL_watchaddr
280     PL_watchok)];
281  }
282
283 if ($define{'HAVE_DES_FCRYPT'})
284  {
285   emit_symbols [qw(win32_crypt)];
286  }
287
288 # functions from *.sym files
289
290 for my $syms ('../global.sym','../pp.sym', '../globvar.sym')
291  {
292   open (GLOBAL, "<$syms") || die "failed to open $syms" . $!;
293   while (<GLOBAL>) 
294    {
295     next if (!/^[A-Za-z]/);
296     # Functions have a Perl_ prefix
297     # Variables have a PL_ prefix
298     chomp($_);
299     my $symbol = ($syms =~ /var\.sym$/i ? "PL_" : "Perl_");
300     $symbol .= $_;
301     emit_symbol($symbol) unless exists $skip{$symbol};
302    }
303   close(GLOBAL);
304  }
305
306 # variables
307
308 unless ($define{'PERL_GLOBAL_STRUCT'})
309  {
310   my $glob = readvar("../perlvars.h");
311   emit_symbols $glob;
312  } 
313
314 unless ($define{'MULTIPLICITY'})
315  {
316   my $glob = readvar("../intrpvar.h");
317   emit_symbols $glob;
318  } 
319
320 unless ($define{'MULTIPLICITY'} || $define{'USE_THREADS'})
321  {
322   my $glob = readvar("../thrdvar.h");
323   emit_symbols $glob;
324  } 
325
326 while (<DATA>) {
327         my $symbol;
328         next if (!/^[A-Za-z]/);
329         next if (/^#/);
330         s/\r//g;
331         chomp($_);
332         $symbol = $_;
333         next if exists $skip{$symbol};
334         emit_symbol($symbol);
335 }
336
337 foreach my $symbol (sort keys %export)
338  {
339    output_symbol($symbol);
340  }
341
342 sub emit_symbol {
343         my $symbol = shift;
344         chomp($symbol); 
345         $export{$symbol} = 1;
346 }
347
348 sub output_symbol {
349     my $symbol = shift;
350     if ($CCTYPE eq "BORLAND") {
351             # workaround Borland quirk by exporting both the straight
352             # name and a name with leading underscore.  Note the
353             # alias *must* come after the symbol itself, if both
354             # are to be exported. (Linker bug?)
355             print "\t_$symbol\n";
356             print "\t$symbol = _$symbol\n";
357     }
358     elsif ($CCTYPE eq 'GCC') {
359             # Symbols have leading _ whole process is $%£"% slow
360             # so skip aliases for now
361             print "\t$symbol\n";
362     }
363     else {
364             # for binary coexistence, export both the symbol and
365             # alias with leading underscore
366             print "\t$symbol\n";
367             print "\t_$symbol = $symbol\n";
368     }
369 }
370
371 1;
372 __DATA__
373 # extra globals not included above.
374 perl_init_i18nl10n
375 perl_init_ext
376 perl_alloc
377 perl_atexit
378 perl_construct
379 perl_destruct
380 perl_free
381 perl_parse
382 perl_run
383 perl_get_sv
384 perl_get_av
385 perl_get_hv
386 perl_get_cv
387 perl_call_argv
388 perl_call_pv
389 perl_call_method
390 perl_call_sv
391 perl_require_pv
392 perl_eval_pv
393 perl_eval_sv
394 perl_new_ctype
395 perl_new_collate
396 perl_new_numeric
397 perl_set_numeric_standard
398 perl_set_numeric_local
399 boot_DynaLoader
400 Perl_thread_create
401 win32_errno
402 win32_environ
403 win32_stdin
404 win32_stdout
405 win32_stderr
406 win32_ferror
407 win32_feof
408 win32_strerror
409 win32_fprintf
410 win32_printf
411 win32_vfprintf
412 win32_vprintf
413 win32_fread
414 win32_fwrite
415 win32_fopen
416 win32_fdopen
417 win32_freopen
418 win32_fclose
419 win32_fputs
420 win32_fputc
421 win32_ungetc
422 win32_getc
423 win32_fileno
424 win32_clearerr
425 win32_fflush
426 win32_ftell
427 win32_fseek
428 win32_fgetpos
429 win32_fsetpos
430 win32_rewind
431 win32_tmpfile
432 win32_abort
433 win32_fstat
434 win32_stat
435 win32_pipe
436 win32_popen
437 win32_pclose
438 win32_rename
439 win32_setmode
440 win32_lseek
441 win32_tell
442 win32_dup
443 win32_dup2
444 win32_open
445 win32_close
446 win32_eof
447 win32_read
448 win32_write
449 win32_spawnvp
450 win32_mkdir
451 win32_rmdir
452 win32_chdir
453 win32_flock
454 win32_execv
455 win32_execvp
456 win32_htons
457 win32_ntohs
458 win32_htonl
459 win32_ntohl
460 win32_inet_addr
461 win32_inet_ntoa
462 win32_socket
463 win32_bind
464 win32_listen
465 win32_accept
466 win32_connect
467 win32_send
468 win32_sendto
469 win32_recv
470 win32_recvfrom
471 win32_shutdown
472 win32_closesocket
473 win32_ioctlsocket
474 win32_setsockopt
475 win32_getsockopt
476 win32_getpeername
477 win32_getsockname
478 win32_gethostname
479 win32_gethostbyname
480 win32_gethostbyaddr
481 win32_getprotobyname
482 win32_getprotobynumber
483 win32_getservbyname
484 win32_getservbyport
485 win32_select
486 win32_endhostent
487 win32_endnetent
488 win32_endprotoent
489 win32_endservent
490 win32_getnetent
491 win32_getnetbyname
492 win32_getnetbyaddr
493 win32_getprotoent
494 win32_getservent
495 win32_sethostent
496 win32_setnetent
497 win32_setprotoent
498 win32_setservent
499 win32_getenv
500 win32_perror
501 win32_setbuf
502 win32_setvbuf
503 win32_flushall
504 win32_fcloseall
505 win32_fgets
506 win32_gets
507 win32_fgetc
508 win32_putc
509 win32_puts
510 win32_getchar
511 win32_putchar
512 win32_malloc
513 win32_calloc
514 win32_realloc
515 win32_free
516 win32_sleep
517 win32_times
518 win32_alarm
519 win32_open_osfhandle
520 win32_get_osfhandle
521 win32_ioctl
522 win32_utime
523 win32_wait
524 win32_waitpid
525 win32_kill
526 win32_str_os_error
527 win32_opendir
528 win32_readdir
529 win32_telldir
530 win32_seekdir
531 win32_rewinddir
532 win32_closedir
533 Perl_win32_init
534 Perl_init_os_extras
535 Perl_getTHR
536 Perl_setTHR
537 RunPerl
538