07dfa049424283ec1601ea16df9ceef959fb85ff
[p5sagit/p5-mst-13.2.git] / win32 / makedef.pl
1 #!../miniperl
2
3 # Written: 10 April 1996 Gary Ng (71564.1743@compuserve.com)
4
5 # Create the export list for perl.
6 # Needed by WIN32 for creating perl.dll
7 # based on perl_exp.SH in the main perl distribution directory
8
9 # This simple program relys on 'global.sym' being up to date
10 # with all of the global symbols that a dynamicly link library
11 # might want to access.
12
13 # There is some symbol defined in global.sym and interp.sym
14 # that does not present in the WIN32 port but there is no easy
15 # way to find them so I just put a exception list here
16
17 my $CCTYPE = "MSVC";    # default
18
19 while (@ARGV)
20  {
21   my $flag = shift;
22   $define{$1} = 1 if ($flag =~ /^-D(\w+)$/);
23   $CCTYPE = $1 if ($flag =~ /^CCTYPE=(\w+)$/);
24  } 
25
26 open(CFG,'config.h') || die "Cannot open config.h:$!";
27 while (<CFG>)
28  {
29   $define{$1} = 1 if /^\s*#\s*define\s+(MYMALLOC)\b/;
30   $define{$1} = 1 if /^\s*#\s*define\s+(USE_THREADS)\b/;
31  }
32 close(CFG);
33
34 warn join(' ',keys %define)."\n";
35
36 if ($CCTYPE ne 'GCC') 
37  {
38   print "LIBRARY Perl\n";
39   print "DESCRIPTION 'Perl interpreter, export autogenerated'\n";
40   print "CODE LOADONCALL\n";
41   print "DATA LOADONCALL NONSHARED MULTIPLE\n";
42  }
43 else
44  {
45   $define{'PERL_GLOBAL_STRUCT'} = 1;
46   $define{'MULTIPLICITY'} = 1;
47  }
48
49 print "EXPORTS\n";
50
51 my %skip;
52 my %export;
53
54 sub skip_symbols
55 {
56  my $list = shift;
57  foreach my $symbol (@$list)
58   {
59    $skip{$symbol} = 1;
60   }
61 }
62
63 sub emit_symbols
64 {
65  my $list = shift;
66  foreach my $symbol (@$list)
67   {
68    emit_symbol($symbol) unless exists $skip{$symbol};
69   }
70 }
71
72 skip_symbols [qw(
73 Perl_statusvalue_vms
74 Perl_archpat_auto
75 Perl_block_type
76 Perl_bostr
77 Perl_additem
78 Perl_cast_ulong
79 Perl_check_uni
80 Perl_checkcomma
81 Perl_chsize
82 Perl_ck_aelem
83 Perl_colors
84 Perl_colorset
85 Perl_cryptseen
86 Perl_cx_dump
87 Perl_DBcv
88 Perl_do_ipcctl
89 Perl_do_ipcget
90 Perl_do_msgrcv
91 Perl_do_msgsnd
92 Perl_do_semop
93 Perl_do_shmio
94 Perl_doeval
95 Perl_dofindlabel
96 Perl_dopoptoeval
97 Perl_dump_eval
98 Perl_dump_fds
99 Perl_dump_form
100 Perl_dump_gv
101 Perl_dump_mstats
102 Perl_dump_op
103 Perl_dump_packsubs
104 Perl_dump_pm
105 Perl_dump_sub
106 Perl_expectterm
107 Perl_error_no
108 Perl_extralen
109 Perl_fetch_gv
110 Perl_fetch_io
111 Perl_force_ident
112 Perl_force_next
113 Perl_force_word
114 Perl_generation
115 Perl_hv_stashpv
116 Perl_in_clean_all
117 Perl_in_clean_objs
118 Perl_intuit_more
119 Perl_init_thread_intern
120 Perl_know_next
121 Perl_lastgotoprobe
122 Perl_linestart
123 Perl_modcount
124 Perl_modkids
125 Perl_mstats
126 Perl_my_bzero
127 Perl_my_htonl
128 Perl_my_ntohl
129 Perl_my_swap
130 Perl_my_chsize
131 Perl_newXSUB
132 Perl_no_fh_allowed
133 Perl_no_op
134 Perl_nointrp
135 Perl_nomem
136 Perl_pending_ident
137 Perl_pp_cswitch
138 Perl_pp_entersubr
139 Perl_pp_evalonce
140 Perl_pp_interp
141 Perl_pp_map
142 Perl_pp_nswitch
143 Perl_q
144 Perl_rcsid
145 Perl_reall_srchlen
146 Perl_reg_eval_set
147 Perl_reg_flags
148 Perl_reg_start_tmp
149 Perl_reg_start_tmpl
150 Perl_regbol
151 Perl_regcc
152 Perl_regcode
153 Perl_regdata
154 Perl_regdummy
155 Perl_regdump
156 Perl_regfold
157 Perl_regendp
158 Perl_regeol
159 Perl_regflags
160 Perl_regindent
161 Perl_reginput
162 Perl_reglastparen
163 Perl_regmyendp
164 Perl_regmyp_size
165 Perl_regmystartp
166 Perl_regnarrate
167 Perl_regnaughty
168 Perl_regnpar
169 Perl_regparse
170 Perl_regprecomp
171 Perl_regprev
172 Perl_regprogram
173 Perl_regprop
174 Perl_regsawback
175 Perl_regseen
176 Perl_regsize
177 Perl_regstartp
178 Perl_regtill
179 Perl_regxend
180 Perl_rx
181 Perl_same_dirent
182 Perl_saw_return
183 Perl_scan_const
184 Perl_scan_formline
185 Perl_scan_heredoc
186 Perl_scan_ident
187 Perl_scan_inputsymbol
188 Perl_scan_pat
189 Perl_scan_prefix
190 Perl_scan_str
191 Perl_scan_subst
192 Perl_scan_trans
193 Perl_scan_word
194 Perl_seen_zerolen
195 Perl_setenv_getix
196 Perl_skipspace
197 Perl_sort_mutex
198 Perl_sortcxix
199 Perl_sublex_done
200 Perl_sublex_info
201 Perl_sublex_start
202 Perl_sv_ref
203 Perl_sv_setptrobj
204 Perl_timesbuf
205 Perl_too_few_arguments
206 Perl_too_many_arguments
207 Perl_unlnk
208 Perl_watch
209 Perl_yyname
210 Perl_yyrule
211 allgvs
212 curblock
213 curcsv
214 lastretstr
215 mystack_mark
216 perl_init_ext
217 perl_requirepv
218 stack
219 statusvalue_vms
220 Perl_safexcalloc
221 Perl_safexmalloc
222 Perl_safexfree
223 Perl_safexrealloc
224 Perl_my_memcmp
225 Perl_my_memset
226 Perl_cshlen
227 Perl_cshname
228 Perl_opsave
229 )];
230
231
232 if ($define{'MYMALLOC'})
233  {
234   skip_symbols [qw(
235     Perl_safefree
236     Perl_safemalloc
237     Perl_saferealloc
238     Perl_safecalloc)];
239   emit_symbols [qw(
240     Perl_malloc
241     Perl_free
242     Perl_realloc
243     Perl_calloc)];
244  }
245
246 unless ($define{'USE_THREADS'})
247  {
248   skip_symbols [qw(
249 Perl_condpair_magic
250 Perl_thr_key
251 Perl_sv_mutex
252 Perl_svref_mutex
253 Perl_malloc_mutex
254 Perl_eval_mutex
255 Perl_eval_cond
256 Perl_eval_owner
257 Perl_threads_mutex
258 Perl_new_struct_thread
259 Perl_nthreads
260 Perl_nthreads_cond
261 Perl_per_thread_magicals
262 Perl_thread_create
263 Perl_threadnum
264 Perl_find_threadsv
265 Perl_threadsv_names
266 Perl_thrsv
267 Perl_unlock_condpair
268 Perl_vtbl_mutex
269 Perl_magic_mutexfree
270 Perl_sv_iv
271 Perl_sv_nv
272 Perl_sv_true
273 Perl_sv_uv
274 Perl_sv_pvn
275 Perl_newRV_noinc)];
276  }
277
278 unless ($define{'FAKE_THREADS'})
279  {
280   skip_symbols [qw(Perl_curthr)];
281  }
282
283 sub readvar
284 {
285  my $file = shift;
286  open(VARS,$file) || die "Cannot open $file:$!";
287  my @syms;
288  while (<VARS>)
289   {
290    # All symbols have a Perl_ prefix because that's what embed.h
291    # sticks in front of them.
292    push(@syms,"Perl_".$1) if (/\bPERLVARI?C?\([IGT](\w+)/);
293   } 
294  close(VARS); 
295  return \@syms;
296 }
297
298 if ($define{'USE_THREADS'} || $define{'MULTIPLICITY'})
299  {
300   my $thrd = readvar("../thrdvar.h");
301   skip_symbols $thrd;
302  } 
303
304 if ($define{'MULTIPLICITY'})
305  {
306   my $interp = readvar("../intrpvar.h");
307   skip_symbols $interp;
308  } 
309
310 if ($define{'PERL_GLOBAL_STRUCT'})
311  {
312   my $global = readvar("../perlvars.h");
313   skip_symbols $global;
314  } 
315
316 unless ($define{'DEBUGGING'})
317  {
318   skip_symbols [qw(
319     Perl_deb
320     Perl_deb_growlevel
321     Perl_debop
322     Perl_debprofdump
323     Perl_debstack
324     Perl_debstackptrs
325     Perl_runops_debug
326     Perl_sv_peek
327     Perl_watchaddr
328     Perl_watchok)];
329  }
330
331 if ($define{'HAVE_DES_FCRYPT'})
332  {
333   emit_symbols [qw(win32_crypt)];
334  }
335
336 open (GLOBAL, "<../global.sym") || die "failed to open global.sym" . $!;
337 while (<GLOBAL>) 
338  {
339   next if (!/^[A-Za-z]/);
340   next if (/_amg[ \t]*$/);
341   # All symbols have a Perl_ prefix because that's what embed.h
342   # sticks in front of them.
343   chomp($_);
344   my $symbol = "Perl_$_";
345   emit_symbol($symbol) unless exists $skip{$symbol};
346  }
347 close(GLOBAL);
348
349 # also add symbols from interp.sym
350 # They are only needed if -DMULTIPLICITY is not set but it
351 # doesn't hurt to include them anyway.
352 # these don't have Perl prefix
353
354 if ($define{'PERL_GLOBAL_STRUCT'})
355  {
356   emit_symbol( ($CCTYPE eq 'GCC') ? 'Perl_GetVars' : 'Perl_VarsPtr')
357  }
358 else
359  {
360   my $glob = readvar("../perlvars.h");
361   emit_symbols $glob;
362  } 
363
364 unless ($define{'MULTIPLICITY'})
365  {
366   my $glob = readvar("../intrpvar.h");
367   emit_symbols $glob;
368  } 
369
370 unless ($define{'MULTIPLICITY'} || $define{'USE_THREADS'})
371  {
372   my $glob = readvar("../thrdvar.h");
373   emit_symbols $glob;
374  } 
375
376 while (<DATA>) {
377         my $symbol;
378         next if (!/^[A-Za-z]/);
379         next if (/^#/);
380         s/\r//g;
381         chomp($_);
382         $symbol = $_;
383         next if exists $skip{$symbol};
384         emit_symbol($symbol);
385 }
386
387 foreach my $symbol (sort keys %export)
388  {
389         if ($CCTYPE eq "BORLAND") {
390                 # workaround Borland quirk by exporting both the straight
391                 # name and a name with leading underscore.  Note the
392                 # alias *must* come after the symbol itself, if both
393                 # are to be exported. (Linker bug?)
394                 print "\t_$symbol\n";
395                 print "\t$symbol = _$symbol\n";
396         }
397         elsif ($CCTYPE eq 'GCC') {
398                 # Symbols have leading _ whole process is $%£"% slow
399                 # so skip aliases for now
400                 print "\t$symbol\n";
401         }
402         else {
403                 # for binary coexistence, export both the symbol and
404                 # alias with leading underscore
405                 print "\t$symbol\n";
406                 print "\t_$symbol = $symbol\n";
407         }
408  }
409
410 sub emit_symbol {
411         my $symbol = shift;
412         chomp($symbol); 
413         $export{$symbol} = 1;
414 }
415
416 1;
417 __DATA__
418 # extra globals not included above.
419 perl_init_i18nl10n
420 perl_init_ext
421 perl_alloc
422 perl_construct
423 perl_destruct
424 perl_free
425 perl_parse
426 perl_run
427 perl_get_sv
428 perl_get_av
429 perl_get_hv
430 perl_get_cv
431 perl_call_argv
432 perl_call_pv
433 perl_call_method
434 perl_call_sv
435 perl_require_pv
436 perl_eval_pv
437 perl_eval_sv
438 boot_DynaLoader
439 Perl_thread_create
440 win32_errno
441 win32_environ
442 win32_stdin
443 win32_stdout
444 win32_stderr
445 win32_ferror
446 win32_feof
447 win32_strerror
448 win32_fprintf
449 win32_printf
450 win32_vfprintf
451 win32_vprintf
452 win32_fread
453 win32_fwrite
454 win32_fopen
455 win32_fdopen
456 win32_freopen
457 win32_fclose
458 win32_fputs
459 win32_fputc
460 win32_ungetc
461 win32_getc
462 win32_fileno
463 win32_clearerr
464 win32_fflush
465 win32_ftell
466 win32_fseek
467 win32_fgetpos
468 win32_fsetpos
469 win32_rewind
470 win32_tmpfile
471 win32_abort
472 win32_fstat
473 win32_stat
474 win32_pipe
475 win32_popen
476 win32_pclose
477 win32_setmode
478 win32_lseek
479 win32_tell
480 win32_dup
481 win32_dup2
482 win32_open
483 win32_close
484 win32_eof
485 win32_read
486 win32_write
487 win32_spawnvp
488 win32_mkdir
489 win32_rmdir
490 win32_chdir
491 win32_flock
492 win32_execvp
493 win32_htons
494 win32_ntohs
495 win32_htonl
496 win32_ntohl
497 win32_inet_addr
498 win32_inet_ntoa
499 win32_socket
500 win32_bind
501 win32_listen
502 win32_accept
503 win32_connect
504 win32_send
505 win32_sendto
506 win32_recv
507 win32_recvfrom
508 win32_shutdown
509 win32_closesocket
510 win32_ioctlsocket
511 win32_setsockopt
512 win32_getsockopt
513 win32_getpeername
514 win32_getsockname
515 win32_gethostname
516 win32_gethostbyname
517 win32_gethostbyaddr
518 win32_getprotobyname
519 win32_getprotobynumber
520 win32_getservbyname
521 win32_getservbyport
522 win32_select
523 win32_endhostent
524 win32_endnetent
525 win32_endprotoent
526 win32_endservent
527 win32_getnetent
528 win32_getnetbyname
529 win32_getnetbyaddr
530 win32_getprotoent
531 win32_getservent
532 win32_sethostent
533 win32_setnetent
534 win32_setprotoent
535 win32_setservent
536 win32_getenv
537 win32_perror
538 win32_setbuf
539 win32_setvbuf
540 win32_flushall
541 win32_fcloseall
542 win32_fgets
543 win32_gets
544 win32_fgetc
545 win32_putc
546 win32_puts
547 win32_getchar
548 win32_putchar
549 win32_malloc
550 win32_calloc
551 win32_realloc
552 win32_free
553 win32_sleep
554 win32_times
555 win32_alarm
556 win32_open_osfhandle
557 win32_get_osfhandle
558 win32_ioctl
559 win32_utime
560 win32_wait
561 win32_str_os_error
562 Perl_win32_init
563 Perl_init_os_extras
564 Perl_getTHR
565 Perl_setTHR
566 RunPerl
567