diff options
| -rw-r--r-- | EXTERN.h | 4 | ||||
| -rw-r--r-- | embed.h | 110 | ||||
| -rwxr-xr-x | embed.pl | 54 | ||||
| -rw-r--r-- | embedvar.h | 345 | ||||
| -rw-r--r-- | ext/Thread/Thread.xs | 1 | ||||
| -rw-r--r-- | global.sym | 112 | ||||
| -rw-r--r-- | miniperlmain.c | 8 | ||||
| -rw-r--r-- | perl.c | 9 | ||||
| -rw-r--r-- | perl.h | 46 | ||||
| -rw-r--r-- | perlvars.h | 289 | ||||
| -rw-r--r-- | pp_hot.c | 9 | ||||
| -rw-r--r-- | proto.h | 8 | ||||
| -rw-r--r-- | run.c | 8 | ||||
| -rw-r--r-- | util.c | 8 | ||||
| -rw-r--r-- | win32/Makefile | 11 | ||||
| -rw-r--r-- | win32/makedef.pl | 186 | ||||
| -rw-r--r-- | win32/makegcc.mk | 4 | ||||
| -rw-r--r-- | win32/perllib.c | 8 | ||||
| -rw-r--r-- | win32/win32.c | 13 | ||||
| -rw-r--r-- | win32/win32.h | 24 | ||||
| -rw-r--r-- | win32/win32iop.h | 159 | ||||
| -rw-r--r-- | win32/win32thread.c | 5 |
22 files changed, 828 insertions, 593 deletions
@@ -23,8 +23,8 @@ # define EXTCONST globalref # define dEXTCONST globaldef {"$GLOBAL_RO_VARS"} readonly #else -# if (defined(_MSC_VER) && defined(_WIN32)) || (defined(__BORLANDC__) && defined(__WIN32__)) -# ifdef PERL_CORE +# if defined(WIN32) && !defined(__GNUC__) +# ifdef PERLDLL # define EXT extern __declspec(dllexport) # define dEXT # define EXTCONST extern __declspec(dllexport) const @@ -29,8 +29,6 @@ #define add_ass_amg Perl_add_ass_amg #define additem Perl_additem #define amagic_call Perl_amagic_call -#define amagic_generation Perl_amagic_generation -#define an Perl_an #define append_elem Perl_append_elem #define append_list Perl_append_list #define apply Perl_apply @@ -72,8 +70,6 @@ #define bool__amg Perl_bool__amg #define boot_core_UNIVERSAL Perl_boot_core_UNIVERSAL #define bor_amg Perl_bor_amg -#define bufend Perl_bufend -#define bufptr Perl_bufptr #define bxor_amg Perl_bxor_amg #define call_list Perl_call_list #define cando Perl_cando @@ -116,29 +112,13 @@ #define ck_subr Perl_ck_subr #define ck_svconst Perl_ck_svconst #define ck_trunc Perl_ck_trunc -#define collation_ix Perl_collation_ix -#define collation_name Perl_collation_name -#define collation_standard Perl_collation_standard -#define collxfrm_base Perl_collxfrm_base -#define collxfrm_mult Perl_collxfrm_mult -#define compcv Perl_compcv -#define compiling Perl_compiling #define compl_amg Perl_compl_amg -#define comppad Perl_comppad -#define comppad_name Perl_comppad_name -#define comppad_name_fill Perl_comppad_name_fill -#define comppad_name_floor Perl_comppad_name_floor #define concat_amg Perl_concat_amg #define concat_ass_amg Perl_concat_ass_amg #define condpair_magic Perl_condpair_magic #define convert Perl_convert -#define cop_seqmax Perl_cop_seqmax #define cos_amg Perl_cos_amg #define croak Perl_croak -#define cryptseen Perl_cryptseen -#define cshlen Perl_cshlen -#define cshname Perl_cshname -#define curinterp Perl_curinterp #define cv_ckproto Perl_cv_ckproto #define cv_clone Perl_cv_clone #define cv_const_sv Perl_cv_const_sv @@ -152,7 +132,6 @@ #define debprofdump Perl_debprofdump #define debstack Perl_debstack #define debstackptrs Perl_debstackptrs -#define debug Perl_debug #define dec_amg Perl_dec_amg #define delimcpy Perl_delimcpy #define deprecate Perl_deprecate @@ -185,7 +164,6 @@ #define do_sysseek Perl_do_sysseek #define do_tell Perl_do_tell #define do_trans Perl_do_trans -#define do_undump Perl_do_undump #define do_vecset Perl_do_vecset #define do_vop Perl_do_vop #define dofindlabel Perl_dofindlabel @@ -203,16 +181,8 @@ #define dump_packsubs Perl_dump_packsubs #define dump_pm Perl_dump_pm #define dump_sub Perl_dump_sub -#define egid Perl_egid #define eq_amg Perl_eq_amg -#define error_count Perl_error_count -#define euid Perl_euid -#define eval_cond Perl_eval_cond -#define eval_mutex Perl_eval_mutex -#define eval_owner Perl_eval_owner -#define evalseq Perl_evalseq #define exp_amg Perl_exp_amg -#define expect Perl_expect #define expectterm Perl_expectterm #define fallback_amg Perl_fallback_amg #define fbm_compile Perl_fbm_compile @@ -235,7 +205,6 @@ #define freq Perl_freq #define ge_amg Perl_ge_amg #define gen_constant_list Perl_gen_constant_list -#define gid Perl_gid #define gp_free Perl_gp_free #define gp_ref Perl_gp_ref #define gt_amg Perl_gt_amg @@ -257,9 +226,7 @@ #define gv_stashpv Perl_gv_stashpv #define gv_stashpvn Perl_gv_stashpvn #define gv_stashsv Perl_gv_stashsv -#define he_root Perl_he_root #define hexdigit Perl_hexdigit -#define hints Perl_hints #define hv_clear Perl_hv_clear #define hv_delayfree_ent Perl_hv_delayfree_ent #define hv_delete Perl_hv_delete @@ -283,8 +250,6 @@ #define hv_undef Perl_hv_undef #define ibcmp Perl_ibcmp #define ibcmp_locale Perl_ibcmp_locale -#define in_my Perl_in_my -#define in_my_stash Perl_in_my_stash #define inc_amg Perl_inc_amg #define ingroup Perl_ingroup #define init_stacks Perl_init_stacks @@ -297,30 +262,10 @@ #define jmaybe Perl_jmaybe #define keyword Perl_keyword #define know_next Perl_know_next -#define last_lop Perl_last_lop -#define last_lop_op Perl_last_lop_op -#define last_uni Perl_last_uni #define le_amg Perl_le_amg #define leave_scope Perl_leave_scope -#define lex_brackets Perl_lex_brackets -#define lex_brackstack Perl_lex_brackstack -#define lex_casemods Perl_lex_casemods -#define lex_casestack Perl_lex_casestack -#define lex_defer Perl_lex_defer -#define lex_dojoin Perl_lex_dojoin #define lex_end Perl_lex_end -#define lex_expect Perl_lex_expect -#define lex_fakebrack Perl_lex_fakebrack -#define lex_formbrack Perl_lex_formbrack -#define lex_inpat Perl_lex_inpat -#define lex_inwhat Perl_lex_inwhat -#define lex_op Perl_lex_op -#define lex_repl Perl_lex_repl #define lex_start Perl_lex_start -#define lex_starts Perl_lex_starts -#define lex_state Perl_lex_state -#define lex_stuff Perl_lex_stuff -#define linestr Perl_linestr #define linklist Perl_linklist #define list Perl_list #define listkids Perl_listkids @@ -372,10 +317,7 @@ #define magic_setvec Perl_magic_setvec #define magic_wipepack Perl_magic_wipepack #define magicname Perl_magicname -#define malloc_mutex Perl_malloc_mutex #define markstack_grow Perl_markstack_grow -#define max_intro_pending Perl_max_intro_pending -#define maxo Perl_maxo #define mem_collxfrm Perl_mem_collxfrm #define mess Perl_mess #define mg_clear Perl_mg_clear @@ -386,7 +328,6 @@ #define mg_len Perl_mg_len #define mg_magical Perl_mg_magical #define mg_set Perl_mg_set -#define min_intro_pending Perl_min_intro_pending #define mod Perl_mod #define mod_amg Perl_mod_amg #define mod_ass_amg Perl_mod_ass_amg @@ -395,10 +336,6 @@ #define mstats Perl_mstats #define mult_amg Perl_mult_amg #define mult_ass_amg Perl_mult_ass_amg -#define multi_close Perl_multi_close -#define multi_end Perl_multi_end -#define multi_open Perl_multi_open -#define multi_start Perl_multi_start #define my Perl_my #define my_bcopy Perl_my_bcopy #define my_bzero Perl_my_bzero @@ -416,7 +353,6 @@ #define my_stat Perl_my_stat #define my_swap Perl_my_swap #define my_unexec Perl_my_unexec -#define na Perl_na #define ncmp_amg Perl_ncmp_amg #define ne_amg Perl_ne_amg #define neg_amg Perl_neg_amg @@ -467,11 +403,6 @@ #define newXSUB Perl_newXSUB #define new_struct_thread Perl_new_struct_thread #define nextargv Perl_nextargv -#define nexttoke Perl_nexttoke -#define nexttype Perl_nexttype -#define nextval Perl_nextval -#define nice_chunk Perl_nice_chunk -#define nice_chunk_size Perl_nice_chunk_size #define ninstr Perl_ninstr #define no_aelem Perl_no_aelem #define no_dir_func Perl_no_dir_func @@ -489,28 +420,16 @@ #define no_wrongref Perl_no_wrongref #define nointrp Perl_nointrp #define nomem Perl_nomem -#define nomemok Perl_nomemok #define nomethod_amg Perl_nomethod_amg #define not_amg Perl_not_amg -#define nthreads Perl_nthreads -#define nthreads_cond Perl_nthreads_cond #define numer_amg Perl_numer_amg -#define numeric_local Perl_numeric_local -#define numeric_name Perl_numeric_name -#define numeric_standard Perl_numeric_standard -#define oldbufptr Perl_oldbufptr -#define oldoldbufptr Perl_oldoldbufptr #define oopsAV Perl_oopsAV #define oopsCV Perl_oopsCV #define oopsHV Perl_oopsHV #define op_desc Perl_op_desc #define op_free Perl_op_free #define op_name Perl_op_name -#define op_seqmax Perl_op_seqmax #define opargs Perl_opargs -#define origalen Perl_origalen -#define origenviron Perl_origenviron -#define osname Perl_osname #define package Perl_package #define pad_alloc Perl_pad_alloc #define pad_allocmy Perl_pad_allocmy @@ -518,15 +437,11 @@ #define pad_free Perl_pad_free #define pad_leavemy Perl_pad_leavemy #define pad_reset Perl_pad_reset -#define pad_reset_pending Perl_pad_reset_pending #define pad_sv Perl_pad_sv #define pad_swipe Perl_pad_swipe -#define padix Perl_padix -#define padix_floor Perl_padix_floor #define patleave Perl_patleave #define peep Perl_peep #define pidgone Perl_pidgone -#define pidstatus Perl_pidstatus #define pmflag Perl_pmflag #define pmruntime Perl_pmruntime #define pmtrans Perl_pmtrans @@ -888,7 +803,6 @@ #define pregexec Perl_pregexec #define pregfree Perl_pregfree #define prepend_elem Perl_prepend_elem -#define profiledata Perl_profiledata #define psig_name Perl_psig_name #define psig_ptr Perl_psig_ptr #define push_return Perl_push_return @@ -907,15 +821,12 @@ #define repeat_ass_amg Perl_repeat_ass_amg #define repeatcpy Perl_repeatcpy #define rninstr Perl_rninstr -#define rsfp Perl_rsfp -#define rsfp_filters Perl_rsfp_filters #define rshift_amg Perl_rshift_amg #define rshift_ass_amg Perl_rshift_ass_amg #define rsignal Perl_rsignal #define rsignal_restore Perl_rsignal_restore #define rsignal_save Perl_rsignal_save #define rsignal_state Perl_rsignal_state -#define runops Perl_runops #define runops_debug Perl_runops_debug #define runops_standard Perl_runops_standard #define rxres_free Perl_rxres_free @@ -981,19 +892,16 @@ #define scmp_amg Perl_scmp_amg #define scope Perl_scope #define screaminstr Perl_screaminstr -#define scrgv Perl_scrgv #define seq_amg Perl_seq_amg #define setdefout Perl_setdefout #define setenv_getix Perl_setenv_getix #define sge_amg Perl_sge_amg #define sgt_amg Perl_sgt_amg -#define sh_path Perl_sh_path #define share_hek Perl_share_hek #define sharepvn Perl_sharepvn #define sig_name Perl_sig_name #define sig_num Perl_sig_num #define sighandler Perl_sighandler -#define sighandlerp Perl_sighandlerp #define simple Perl_simple #define sin_amg Perl_sin_amg #define skipspace Perl_skipspace @@ -1005,9 +913,6 @@ #define start_subparse Perl_start_subparse #define string_amg Perl_string_amg #define sub_crush_depth Perl_sub_crush_depth -#define sub_generation Perl_sub_generation -#define subline Perl_subline -#define subname Perl_subname #define subtr_amg Perl_subtr_amg #define subtr_ass_amg Perl_subtr_ass_amg #define sv_2bool Perl_sv_2bool @@ -1049,10 +954,8 @@ #define sv_len Perl_sv_len #define sv_magic Perl_sv_magic #define sv_mortalcopy Perl_sv_mortalcopy -#define sv_mutex Perl_sv_mutex #define sv_newmortal Perl_sv_newmortal #define sv_newref Perl_sv_newref -#define sv_no Perl_sv_no #define sv_nv Perl_sv_nv #define sv_peek Perl_sv_peek #define sv_pvn Perl_sv_pvn @@ -1078,7 +981,6 @@ #define sv_taint Perl_sv_taint #define sv_tainted Perl_sv_tainted #define sv_true Perl_sv_true -#define sv_undef Perl_sv_undef #define sv_unmagic Perl_sv_unmagic #define sv_unref Perl_sv_unref #define sv_untaint Perl_sv_untaint @@ -1087,17 +989,10 @@ #define sv_uv Perl_sv_uv #define sv_vcatpvfn Perl_sv_vcatpvfn #define sv_vsetpvfn Perl_sv_vsetpvfn -#define sv_yes Perl_sv_yes #define taint_env Perl_taint_env #define taint_proper Perl_taint_proper -#define thisexpr Perl_thisexpr -#define thr_key Perl_thr_key -#define threads_mutex Perl_threads_mutex -#define threadsv_names Perl_threadsv_names -#define tokenbuf Perl_tokenbuf #define too_few_arguments Perl_too_few_arguments #define too_many_arguments Perl_too_many_arguments -#define uid Perl_uid #define unlnk Perl_unlnk #define unlock_condpair Perl_unlock_condpair #define unshare_hek Perl_unshare_hek @@ -1144,11 +1039,6 @@ #define watchaddr Perl_watchaddr #define watchok Perl_watchok #define whichsig Perl_whichsig -#define xiv_arenaroot Perl_xiv_arenaroot -#define xiv_root Perl_xiv_root -#define xnv_root Perl_xnv_root -#define xpv_root Perl_xpv_root -#define xrv_root Perl_xrv_root #define yychar Perl_yychar #define yycheck Perl_yycheck #define yydebug Perl_yydebug @@ -29,7 +29,7 @@ sub readvars(\%$$) { while (<FILE>) { s/[ \t]*#.*//; # Delete comments. if (/PERLVARI?\($pre(\w+)/) { - $$syms{$1} = $pre; + $$syms{$1} = 1; } } close(FILE); @@ -40,7 +40,7 @@ my %thread; readvars %intrp, 'intrpvar.h','I'; readvars %thread, 'thrdvar.h','T'; -#readvars %global, 'perlvars.h',''; +readvars %globvar, 'perlvars.h','G'; foreach my $sym (sort keys %intrp) { @@ -52,6 +52,15 @@ foreach my $sym (sort keys %intrp) } } +foreach my $sym (sort keys %globvar) + { + if (exists $global{$sym}) + { + delete $global{$sym}; + warn "$sym in global.sym as well as perlvars.h\n"; + } + } + foreach my $sym (keys %interp) { warn "extra $sym in interp.sym\n" @@ -79,7 +88,7 @@ sub embed ($) { } sub multon ($$$) { my ($sym,$pre,$ptr) = @_; - hide($sym, "($ptr->$pre$sym)"); + hide($sym, "($ptr$pre$sym)"); } sub multoff ($$) { my ($sym,$pre) = @_; @@ -156,7 +165,7 @@ print EM <<'END'; END for $sym (sort keys %thread) { - print EM multon($sym,'T','curinterp'); + print EM multon($sym,'T','curinterp->'); } print EM <<'END'; @@ -168,7 +177,7 @@ print EM <<'END'; END for $sym (sort keys %intrp) { - print EM multon($sym,'I','curinterp'); + print EM multon($sym,'I','curinterp->'); } print EM <<'END'; @@ -228,13 +237,46 @@ print EM <<'END'; END for $sym (sort keys %thread) { - print EM multon($sym,'T','thr'); + print EM multon($sym,'T','thr->'); } print EM <<'END'; #endif /* USE_THREADS */ +#ifdef PERL_GLOBAL_STRUCT + +END + +for $sym (sort keys %globvar) { + print EM multon($sym,'G','Perl_Vars.'); +} + +print EM <<'END'; + +#else /* !PERL_GLOBAL_STRUCT */ + +END + +for $sym (sort keys %globvar) { + print EM multoff($sym,'G'); +} + +print EM <<'END'; + +#ifdef EMBED + +END + +for $sym (sort keys %globvar) { + print EM embed($sym); +} + +print EM <<'END'; + +#endif /* EMBED */ +#endif /* PERL_GLOBAL_STRUCT */ + END close(EM);
\ No newline at end of file diff --git a/embedvar.h b/embedvar.h index b68624ab69..8a3ea52b36 100644 --- a/embedvar.h +++ b/embedvar.h @@ -607,3 +607,348 @@ #endif /* USE_THREADS */ +#ifdef PERL_GLOBAL_STRUCT + +#define amagic_generation (Perl_Vars.Gamagic_generation) +#define an (Perl_Vars.Gan) +#define bufend (Perl_Vars.Gbufend) +#define bufptr (Perl_Vars.Gbufptr) +#define collation_ix (Perl_Vars.Gcollation_ix) +#define collation_name (Perl_Vars.Gcollation_name) +#define collation_standard (Perl_Vars.Gcollation_standard) +#define collxfrm_base (Perl_Vars.Gcollxfrm_base) +#define collxfrm_mult (Perl_Vars.Gcollxfrm_mult) +#define compcv (Perl_Vars.Gcompcv) +#define compiling (Perl_Vars.Gcompiling) +#define comppad (Perl_Vars.Gcomppad) +#define comppad_name (Perl_Vars.Gcomppad_name) +#define comppad_name_fill (Perl_Vars.Gcomppad_name_fill) +#define comppad_name_floor (Perl_Vars.Gcomppad_name_floor) +#define cop_seqmax (Perl_Vars.Gcop_seqmax) +#define cryptseen (Perl_Vars.Gcryptseen) +#define cshlen (Perl_Vars.Gcshlen) +#define cshname (Perl_Vars.Gcshname) +#define curinterp (Perl_Vars.Gcurinterp) +#define curthr (Perl_Vars.Gcurthr) +#define debug (Perl_Vars.Gdebug) +#define do_undump (Perl_Vars.Gdo_undump) +#define egid (Perl_Vars.Gegid) +#define error_count (Perl_Vars.Gerror_count) +#define euid (Perl_Vars.Geuid) +#define eval_cond (Perl_Vars.Geval_cond) +#define eval_mutex (Perl_Vars.Geval_mutex) +#define eval_owner (Perl_Vars.Geval_owner) +#define evalseq (Perl_Vars.Gevalseq) +#define expect (Perl_Vars.Gexpect) +#define gid (Perl_Vars.Ggid) +#define he_root (Perl_Vars.Ghe_root) +#define hints (Perl_Vars.Ghints) +#define in_my (Perl_Vars.Gin_my) +#define in_my_stash (Perl_Vars.Gin_my_stash) +#define last_lop (Perl_Vars.Glast_lop) +#define last_lop_op (Perl_Vars.Glast_lop_op) +#define last_uni (Perl_Vars.Glast_uni) +#define lex_brackets (Perl_Vars.Glex_brackets) +#define lex_brackstack (Perl_Vars.Glex_brackstack) +#define lex_casemods (Perl_Vars.Glex_casemods) +#define lex_casestack (Perl_Vars.Glex_casestack) +#define lex_defer (Perl_Vars.Glex_defer) +#define lex_dojoin (Perl_Vars.Glex_dojoin) +#define lex_expect (Perl_Vars.Glex_expect) +#define lex_fakebrack (Perl_Vars.Glex_fakebrack) +#define lex_formbrack (Perl_Vars.Glex_formbrack) +#define lex_inpat (Perl_Vars.Glex_inpat) +#define lex_inwhat (Perl_Vars.Glex_inwhat) +#define lex_op (Perl_Vars.Glex_op) +#define lex_repl (Perl_Vars.Glex_repl) +#define lex_starts (Perl_Vars.Glex_starts) +#define lex_state (Perl_Vars.Glex_state) +#define lex_stuff (Perl_Vars.Glex_stuff) +#define linestr (Perl_Vars.Glinestr) +#define malloc_mutex (Perl_Vars.Gmalloc_mutex) +#define max_intro_pending (Perl_Vars.Gmax_intro_pending) +#define maxo (Perl_Vars.Gmaxo) +#define min_intro_pending (Perl_Vars.Gmin_intro_pending) +#define multi_close (Perl_Vars.Gmulti_close) +#define multi_end (Perl_Vars.Gmulti_end) +#define multi_open (Perl_Vars.Gmulti_open) +#define multi_start (Perl_Vars.Gmulti_start) +#define na (Perl_Vars.Gna) +#define nexttoke (Perl_Vars.Gnexttoke) +#define nexttype (Perl_Vars.Gnexttype) +#define nextval (Perl_Vars.Gnextval) +#define nice_chunk (Perl_Vars.Gnice_chunk) +#define nice_chunk_size (Perl_Vars.Gnice_chunk_size) +#define nomemok (Perl_Vars.Gnomemok) +#define nthreads (Perl_Vars.Gnthreads) +#define nthreads_cond (Perl_Vars.Gnthreads_cond) +#define numeric_local (Perl_Vars.Gnumeric_local) +#define numeric_name (Perl_Vars.Gnumeric_name) +#define numeric_standard (Perl_Vars.Gnumeric_standard) +#define oldbufptr (Perl_Vars.Goldbufptr) +#define oldoldbufptr (Perl_Vars.Goldoldbufptr) +#define op_seqmax (Perl_Vars.Gop_seqmax) +#define origalen (Perl_Vars.Gorigalen) +#define origenviron (Perl_Vars.Gorigenviron) +#define osname (Perl_Vars.Gosname) +#define pad_reset_pending (Perl_Vars.Gpad_reset_pending) +#define padix (Perl_Vars.Gpadix) +#define padix_floor (Perl_Vars.Gpadix_floor) +#define pidstatus (Perl_Vars.Gpidstatus) +#define profiledata (Perl_Vars.Gprofiledata) +#define rsfp (Perl_Vars.Grsfp) +#define rsfp_filters (Perl_Vars.Grsfp_filters) +#define runops (Perl_Vars.Grunops) +#define scrgv (Perl_Vars.Gscrgv) +#define sh_path (Perl_Vars.Gsh_path) +#define sighandlerp (Perl_Vars.Gsighandlerp) +#define sub_generation (Perl_Vars.Gsub_generation) +#define subline (Perl_Vars.Gsubline) +#define subname (Perl_Vars.Gsubname) +#define sv_mutex (Perl_Vars.Gsv_mutex) +#define sv_no (Perl_Vars.Gsv_no) +#define sv_undef (Perl_Vars.Gsv_undef) +#define sv_yes (Perl_Vars.Gsv_yes) +#define thisexpr (Perl_Vars.Gthisexpr) +#define thr_key (Perl_Vars.Gthr_key) +#define threads_mutex (Perl_Vars.Gthreads_mutex) +#define threadsv_names (Perl_Vars.Gthreadsv_names) +#define tokenbuf (Perl_Vars.Gtokenbuf) +#define uid (Perl_Vars.Guid) +#define xiv_arenaroot (Perl_Vars.Gxiv_arenaroot) +#define xiv_root (Perl_Vars.Gxiv_root) +#define xnv_root (Perl_Vars.Gxnv_root) +#define xpv_root (Perl_Vars.Gxpv_root) +#define xrv_root (Perl_Vars.Gxrv_root) + +#else /* !PERL_GLOBAL_STRUCT */ + +#define Gamagic_generation amagic_generation +#define Gan an +#define Gbufend bufend +#define Gbufptr bufptr +#define Gcollation_ix collation_ix +#define Gcollation_name collation_name +#define Gcollation_standard collation_standard +#define Gcollxfrm_base collxfrm_base +#define Gcollxfrm_mult collxfrm_mult +#define Gcompcv compcv +#define Gcompiling compiling +#define Gcomppad comppad +#define Gcomppad_name comppad_name +#define Gcomppad_name_fill comppad_name_fill +#define Gcomppad_name_floor comppad_name_floor +#define Gcop_seqmax cop_seqmax +#define Gcryptseen cryptseen +#define Gcshlen cshlen +#define Gcshname cshname +#define Gcurinterp curinterp +#define Gcurthr curthr +#define Gdebug debug +#define Gdo_undump do_undump +#define Gegid egid +#define Gerror_count error_count +#define Geuid euid +#define Geval_cond eval_cond +#define Geval_mutex eval_mutex +#define Geval_owner eval_owner +#define Gevalseq evalseq +#define Gexpect expect +#define Ggid gid +#define Ghe_root he_root +#define Ghints hints +#define Gin_my in_my +#define Gin_my_stash in_my_stash +#define Glast_lop last_lop +#define Glast_lop_op last_lop_op +#define Glast_uni last_uni +#define Glex_brackets lex_brackets +#define Glex_brackstack lex_brackstack +#define Glex_casemods lex_casemods +#define Glex_casestack lex_casestack +#define Glex_defer lex_defer +#define Glex_dojoin lex_dojoin +#define Glex_expect lex_expect +#define Glex_fakebrack lex_fakebrack +#define Glex_formbrack lex_formbrack +#define Glex_inpat lex_inpat +#define Glex_inwhat lex_inwhat +#define Glex_op lex_op +#define Glex_repl lex_repl +#define Glex_starts lex_starts +#define Glex_state lex_state +#define Glex_stuff lex_stuff +#define Glinestr linestr +#define Gmalloc_mutex malloc_mutex +#define Gmax_intro_pending max_intro_pending +#define Gmaxo maxo +#define Gmin_intro_pending min_intro_pending +#define Gmulti_close multi_close +#define Gmulti_end multi_end +#define Gmulti_open multi_open +#define Gmulti_start multi_start +#define Gna na +#define Gnexttoke nexttoke +#define Gnexttype nexttype +#define Gnextval nextval +#define Gnice_chunk nice_chunk +#define Gnice_chunk_size nice_chunk_size +#define Gnomemok nomemok +#define Gnthreads nthreads +#define Gnthreads_cond nthreads_cond +#define Gnumeric_local numeric_local +#define Gnumeric_name numeric_name +#define Gnumeric_standard numeric_standard +#define Goldbufptr oldbufptr +#define Goldoldbufptr oldoldbufptr +#define Gop_seqmax op_seqmax +#define Gorigalen origalen +#define Gorigenviron origenviron +#define Gosname osname +#define Gpad_reset_pending pad_reset_pending +#define Gpadix padix +#define Gpadix_floor padix_floor +#define Gpidstatus pidstatus +#define Gprofiledata profiledata +#define Grsfp rsfp +#define Grsfp_filters rsfp_filters +#define Grunops runops +#define Gscrgv scrgv +#define Gsh_path sh_path +#define Gsighandlerp sighandlerp +#define Gsub_generation sub_generation +#define Gsubline subline +#define Gsubname subname +#define Gsv_mutex sv_mutex +#define Gsv_no sv_no +#define Gsv_undef sv_undef +#define Gsv_yes sv_yes +#define Gthisexpr thisexpr +#define Gthr_key thr_key +#define Gthreads_mutex threads_mutex +#define Gthreadsv_names threadsv_names +#define Gtokenbuf tokenbuf +#define Guid uid +#define Gxiv_arenaroot xiv_arenaroot +#define Gxiv_root xiv_root +#define Gxnv_root xnv_root +#define Gxpv_root xpv_root +#define Gxrv_root xrv_root + +#ifdef EMBED + +#define amagic_generation Perl_amagic_generation +#define an Perl_an +#define bufend Perl_bufend +#define bufptr Perl_bufptr +#define collation_ix Perl_collation_ix +#define collation_name Perl_collation_name +#define collation_standard Perl_collation_standard +#define collxfrm_base Perl_collxfrm_base +#define collxfrm_mult Perl_collxfrm_mult +#define compcv Perl_compcv +#define compiling Perl_compiling +#define comppad Perl_comppad +#define comppad_name Perl_comppad_name +#define comppad_name_fill Perl_comppad_name_fill +#define comppad_name_floor Perl_comppad_name_floor +#define cop_seqmax Perl_cop_seqmax +#define cryptseen Perl_cryptseen +#define cshlen Perl_cshlen +#define cshname Perl_cshname +#define curinterp Perl_curinterp +#define curthr Perl_curthr +#define debug Perl_debug +#define do_undump Perl_do_undump +#define egid Perl_egid +#define error_count Perl_error_count +#define euid Perl_euid +#define eval_cond Perl_eval_cond +#define eval_mutex Perl_eval_mutex +#define eval_owner Perl_eval_owner +#define evalseq Perl_evalseq +#define expect Perl_expect +#define gid Perl_gid +#define he_root Perl_he_root +#define hints Perl_hints +#define in_my Perl_in_my +#define in_my_stash Perl_in_my_stash +#define last_lop Perl_last_lop +#define last_lop_op Perl_last_lop_op +#define last_uni Perl_last_uni +#define lex_brackets Perl_lex_brackets +#define lex_brackstack Perl_lex_brackstack +#define lex_casemods Perl_lex_casemods +#define lex_casestack Perl_lex_casestack +#define lex_defer Perl_lex_defer +#define lex_dojoin Perl_lex_dojoin +#define lex_expect Perl_lex_expect +#define lex_fakebrack Perl_lex_fakebrack +#define lex_formbrack Perl_lex_formbrack +#define lex_inpat Perl_lex_inpat +#define lex_inwhat Perl_lex_inwhat +#define lex_op Perl_lex_op +#define lex_repl Perl_lex_repl +#define lex_starts Perl_lex_starts +#define lex_state Perl_lex_state +#define lex_stuff Perl_lex_stuff +#define linestr Perl_linestr +#define malloc_mutex Perl_malloc_mutex +#define max_intro_pending Perl_max_intro_pending +#define maxo Perl_maxo +#define min_intro_pending Perl_min_intro_pending +#define multi_close Perl_multi_close +#define multi_end Perl_multi_end +#define multi_open Perl_multi_open +#define multi_start Perl_multi_start +#define na Perl_na +#define nexttoke Perl_nexttoke +#define nexttype Perl_nexttype +#define nextval Perl_nextval +#define nice_chunk Perl_nice_chunk +#define nice_chunk_size Perl_nice_chunk_size +#define nomemok Perl_nomemok +#define nthreads Perl_nthreads +#define nthreads_cond Perl_nthreads_cond +#define numeric_local Perl_numeric_local +#define numeric_name Perl_numeric_name +#define numeric_standard Perl_numeric_standard +#define oldbufptr Perl_oldbufptr +#define oldoldbufptr Perl_oldoldbufptr +#define op_seqmax Perl_op_seqmax +#define origalen Perl_origalen +#define origenviron Perl_origenviron +#define osname Perl_osname +#define pad_reset_pending Perl_pad_reset_pending +#define padix Perl_padix +#define padix_floor Perl_padix_floor +#define pidstatus Perl_pidstatus +#define profiledata Perl_profiledata +#define rsfp Perl_rsfp +#define rsfp_filters Perl_rsfp_filters +#define runops Perl_runops +#define scrgv Perl_scrgv +#define sh_path Perl_sh_path +#define sighandlerp Perl_sighandlerp +#define sub_generation Perl_sub_generation +#define subline Perl_subline +#define subname Perl_subname +#define sv_mutex Perl_sv_mutex +#define sv_no Perl_sv_no +#define sv_undef Perl_sv_undef +#define sv_yes Perl_sv_yes +#define thisexpr Perl_thisexpr +#define thr_key Perl_thr_key +#define threads_mutex Perl_threads_mutex +#define threadsv_names Perl_threadsv_names +#define tokenbuf Perl_tokenbuf +#define uid Perl_uid +#define xiv_arenaroot Perl_xiv_arenaroot +#define xiv_root Perl_xiv_root +#define xnv_root Perl_xnv_root +#define xpv_root Perl_xpv_root +#define xrv_root Perl_xrv_root + +#endif /* EMBED */ +#endif /* PERL_GLOBAL_STRUCT */ + diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs index c0d551d612..c5adcb3eb7 100644 --- a/ext/Thread/Thread.xs +++ b/ext/Thread/Thread.xs @@ -16,7 +16,6 @@ static U32 threadnum = 0; static int sig_pipe[2]; #ifndef THREAD_RET_TYPE -typedef struct perl_thread *Thread; #define THREAD_RET_TYPE void * #define THREAD_RET_CAST(x) ((THREAD_RET_TYPE) x) #endif diff --git a/global.sym b/global.sym index 6e976600e6..4457a380ca 100644 --- a/global.sym +++ b/global.sym @@ -1,8 +1,6 @@ # Global symbols that need to be hidden in embedded applications. -# Variables -nthreads_cond -threads_mutex +# Variables - should not be here but in perlvars.h AMG_names Error @@ -12,52 +10,25 @@ abs_amg add_amg add_ass_amg additem -amagic_generation -an atan2_amg band_amg block_type bool__amg bor_amg -bufend -bufptr bxor_amg check -collation_ix -collation_name -collation_standard -collxfrm_base -collxfrm_mult -compcv -compiling compl_amg -comppad -comppad_name -comppad_name_fill -comppad_name_floor concat_amg concat_ass_amg -cop_seqmax cos_amg -cryptseen -cshlen -cshname -curinterp dc -debug dec_amg di div_amg div_ass_amg -do_undump ds -egid eq_amg -error_count -euid -evalseq exp_amg -expect expectterm fallback_amg find_threadsv @@ -65,62 +36,25 @@ fold fold_locale freq ge_amg -gid gt_amg hexdigit -hints init_thread_intern -in_my -in_my_stash inc_amg io_close know_next -last_lop -last_lop_op -last_uni le_amg -lex_brackets -lex_brackstack -lex_casemods -lex_casestack -lex_defer -lex_dojoin -lex_expect -lex_fakebrack -lex_formbrack -lex_inpat -lex_inwhat -lex_op -lex_repl -lex_starts -lex_state -lex_stuff -linestr log_amg lshift_amg lshift_ass_amg lt_amg -max_intro_pending -maxo -min_intro_pending mod_amg mod_ass_amg mult_amg mult_ass_amg -multi_close -multi_end -multi_open -multi_start -na ncmp_amg ne_amg neg_amg new_struct_thread -nexttoke -nexttype -nextval -nice_chunk -nice_chunk_size no_aelem no_dir_func no_func @@ -135,32 +69,16 @@ no_usym no_wrongref nointrp nomem -nomemok nomethod_amg not_amg -nthreads -numeric_local -numeric_name -numeric_standard numer_amg -oldbufptr -oldoldbufptr op_desc op_name -op_seqmax opargs -origalen -origenviron -osname -pad_reset_pending -padix -padix_floor patleave -pidstatus pow_amg pow_ass_amg ppaddr -profiledata psig_name psig_ptr rcsid @@ -172,20 +90,15 @@ regnext regprop repeat_amg repeat_ass_amg -rsfp -rsfp_filters rshift_amg rshift_ass_amg -runops runops_debug runops_standard saw_return scmp_amg -scrgv seq_amg sge_amg sgt_amg -sh_path sig_name sig_num simple @@ -195,19 +108,8 @@ slt_amg sne_amg sqrt_amg string_amg -sub_generation -subline -subname subtr_amg subtr_ass_amg -sv_no -sv_undef -sv_yes -thisexpr -threadsv_names -thr_key -tokenbuf -uid varies vert vivify_defelem @@ -406,9 +308,6 @@ dump_op dump_packsubs dump_pm dump_sub -eval_cond -eval_mutex -eval_owner fbm_compile fbm_instr fetch_gv @@ -444,7 +343,6 @@ gv_init gv_stashpv gv_stashpvn gv_stashsv -he_root hv_clear hv_delayfree_ent hv_delete @@ -526,7 +424,6 @@ magic_setvec magic_set_all_env magic_wipepack magicname -malloc_mutex markstack_grow mem_collxfrm mess @@ -1062,7 +959,6 @@ setenv_getix share_hek sharepvn sighandler -sighandlerp skipspace stack_grow start_subparse @@ -1105,7 +1001,6 @@ sv_isobject sv_len sv_magic sv_mortalcopy -sv_mutex sv_newmortal sv_newref sv_peek @@ -1151,11 +1046,6 @@ wait4pid warn watch whichsig -xiv_arenaroot -xiv_root -xnv_root -xpv_root -xrv_root yyerror yydestruct yylex diff --git a/miniperlmain.c b/miniperlmain.c index 27ad541fb4..9b45889419 100644 --- a/miniperlmain.c +++ b/miniperlmain.c @@ -25,6 +25,14 @@ char **env; { int exitstatus; +#ifdef PERL_GLOBAL_STRUCT +#define PERLVAR(var,type) /**/ +#define PERLVARI(var,type,init) Perl_Vars.var = init; +#include "perlvars.h" +#undef PERLVAR +#undef PERLVARI +#endif + PERL_SYS_INIT(&argc,&argv); perl_init_i18nl10n(1); @@ -1102,7 +1102,7 @@ perl_get_cv(char *name, I32 create) /* Be sure to refetch the stack pointer after calling these routines. */ I32 -perl_call_argv(char *subname, I32 flags, register char **argv) +perl_call_argv(char *sub_name, I32 flags, register char **argv) /* See G_* flags in cop.h */ /* null terminated arg list */ @@ -1117,15 +1117,15 @@ perl_call_argv(char *subname, I32 flags, register char **argv) } PUTBACK; } - return perl_call_pv(subname, flags); + return perl_call_pv(sub_name, flags); } I32 -perl_call_pv(char *subname, I32 flags) +perl_call_pv(char *sub_name, I32 flags) /* name of the subroutine */ /* See G_* flags in cop.h */ { - return perl_call_sv((SV*)perl_get_cv(subname, TRUE), flags); + return perl_call_sv((SV*)perl_get_cv(sub_name, TRUE), flags); } I32 @@ -2987,3 +2987,4 @@ my_exit_jump(void) } + @@ -1613,6 +1613,27 @@ typedef enum { #define RsSIMPLE(sv) (SvOK(sv) && SvCUR(sv)) #define RsPARA(sv) (SvOK(sv) && ! SvCUR(sv)) +/* Set up PERLVAR macros for populating structs */ +#define PERLVAR(var,type) type var; +#define PERLVARI(var,type,init) type var; + +#ifdef PERL_GLOBAL_STRUCT +struct perl_vars { +#include "perlvars.h" +}; + +#ifdef PERL_CORE +EXT struct perl_vars Perl_Vars; +EXT struct perl_vars *Perl_VarsPtr INIT(&Perl_Vars); +#else +#if !defined(__GNUC__) || !defined(WIN32) +EXT +#endif +struct perl_vars *Perl_VarsPtr; +#define Perl_Vars (*((Perl_VarsPtr) ? Perl_VarsPtr : (Perl_VarsPtr = Perl_GetVars()))) +#endif +#endif /* PERL_GLOBAL_STRUCT */ + #ifdef MULTIPLICITY /* If we have multiple interpreters define a struct holding variables which must be per-interpreter @@ -1620,9 +1641,6 @@ typedef enum { be per-thread is per-interpreter. */ -#define PERLVAR(var,type) type var; -#define PERLVARI(var,type,init) type var; - struct interpreter { #ifndef USE_THREADS #include "thrdvar.h" @@ -1630,9 +1648,6 @@ struct interpreter { #include "intrpvar.h" }; -#undef PERLVAR -#undef PERLVARI - #else struct interpreter { char broiled; @@ -1644,25 +1659,22 @@ struct interpreter { * that have to be per-thread */ -#define PERLVAR(var,type) type var; -#define PERLVARI(var,type,init) type var; struct perl_thread { #include "thrdvar.h" }; +#endif + +/* Done with PERLVAR macros for now ... */ #undef PERLVAR #undef PERLVARI -#endif typedef struct perl_thread *Thread; -#include "thread.h" +#include "thread.h" #include "pp.h" - -START_EXTERN_C #include "proto.h" -END_EXTERN_C #ifdef EMBED #define Perl_sv_setptrobj(rv,ptr,name) Perl_sv_setref_iv(rv,name,(IV)ptr) @@ -1684,16 +1696,20 @@ END_EXTERN_C #define PERLVAR(var,type) EXT type var; #define PERLVARI(var,type,init) EXT type var INIT(init); +#ifndef PERL_GLOBAL_STRUCT #include "perlvars.h" +#endif #ifndef MULTIPLICITY -#include "intrpvar.h" -#endif #ifndef USE_THREADS #include "thrdvar.h" #endif +#include "intrpvar.h" +#endif + + #undef PERLVAR #undef PERLVARI diff --git a/perlvars.h b/perlvars.h index e41423eb5b..b5488ab6a6 100644 --- a/perlvars.h +++ b/perlvars.h @@ -8,201 +8,152 @@ /****************/ /* global state */ -PERLVAR(curinterp, PerlInterpreter *) /* currently running interpreter */ +PERLVAR(Gcurinterp, PerlInterpreter *) /* currently running interpreter */ #ifdef USE_THREADS -PERLVAR(thr_key, perl_key) /* For per-thread struct perl_thread* */ -PERLVAR(sv_mutex, perl_mutex) /* Mutex for allocating SVs in sv.c */ -PERLVAR(malloc_mutex, perl_mutex) /* Mutex for malloc */ -PERLVAR(eval_mutex, perl_mutex) /* Mutex for doeval */ -PERLVAR(eval_cond, perl_cond) /* Condition variable for doeval */ -PERLVAR(eval_owner, struct perl_thread *) /* Owner thread for doeval */ -PERLVAR(nthreads, int) /* Number of threads currently */ -PERLVAR(threads_mutex, perl_mutex) /* Mutex for nthreads and thread list */ -PERLVAR(nthreads_cond, perl_cond) /* Condition variable for nthreads */ -PERLVARI(threadsv_names, char *, THREADSV_NAMES) +PERLVAR(Gthr_key, perl_key) /* For per-thread struct perl_thread* */ +PERLVAR(Gsv_mutex, perl_mutex) /* Mutex for allocating SVs in sv.c */ +PERLVAR(Gmalloc_mutex, perl_mutex) /* Mutex for malloc */ +PERLVAR(Geval_mutex, perl_mutex) /* Mutex for doeval */ +PERLVAR(Geval_cond, perl_cond) /* Condition variable for doeval */ +PERLVAR(Geval_owner, struct perl_thread *) /* Owner thread for doeval */ +PERLVAR(Gnthreads, int) /* Number of threads currently */ +PERLVAR(Gthreads_mutex, perl_mutex) /* Mutex for nthreads and thread list */ +PERLVAR(Gnthreads_cond, perl_cond) /* Condition variable for nthreads */ +PERLVARI(Gthreadsv_names, char *, THREADSV_NAMES) #ifdef FAKE_THREADS -PERLVAR(thr, struct perl_thread *) /* Currently executing (fake) thread */ +PERLVAR(Gcurthr, struct perl_thread *) /* Currently executing (fake) thread */ #endif #endif /* USE_THREADS */ -PERLVAR(uid, int) /* current real user id */ -PERLVAR(euid, int) /* current effective user id */ -PERLVAR(gid, int) /* current real group id */ -PERLVAR(egid, int) /* current effective group id */ -PERLVAR(nomemok, bool) /* let malloc context handle nomem */ -PERLVAR(an, U32) /* malloc sequence number */ -PERLVAR(cop_seqmax, U32) /* statement sequence number */ -PERLVAR(op_seqmax, U16) /* op sequence number */ -PERLVAR(evalseq, U32) /* eval sequence number */ -PERLVAR(sub_generation, U32) /* inc to force methods to be looked up again */ -PERLVAR(origenviron, char **) -PERLVAR(origalen, U32) -PERLVAR(pidstatus, HV *) /* pid-to-status mappings for waitpid */ -PERLVAR(profiledata, U32 *) -PERLVARI(maxo, int, MAXO) /* Number of ops */ -PERLVAR(osname, char *) /* operating system */ -PERLVARI(sh_path, char *, SH_PATH) /* full path of shell */ -PERLVAR(sighandlerp, Sighandler_t) - -PERLVAR(xiv_arenaroot, XPV*) /* list of allocated xiv areas */ -PERLVAR(xiv_root, IV **) /* free xiv list--shared by interpreters */ -PERLVAR(xnv_root, double *) /* free xnv list--shared by interpreters */ -PERLVAR(xrv_root, XRV *) /* free xrv list--shared by interpreters */ -PERLVAR(xpv_root, XPV *) /* free xpv list--shared by interpreters */ -PERLVAR(he_root, HE *) /* free he list--shared by interpreters */ -PERLVAR(nice_chunk, char *) /* a nice chunk of memory to reuse */ -PERLVAR(nice_chunk_size, U32) /* how nice the chunk of memory is */ - -PERLVARI(runops, runops_proc_t *, RUNOPS_DEFAULT) - -#ifndef USE_THREADS -/* Stack for currently executing thread--context switch must handle this. */ -PERLVAR(stack_base, SV **) /* stack->array_ary */ -PERLVAR(stack_sp, SV **) /* stack pointer now */ -PERLVAR(stack_max, SV **) /* stack->array_ary + stack->array_max */ - -/* likewise for these */ - -#ifdef OP_IN_REGISTER -PERLVAR(opsave, OP *) /* save current op register across longjmps */ -#else -PERLVAR(op, OP *) /* current op--when not in a global register */ -#endif - -PERLVAR(scopestack, I32 *) /* blocks we've entered */ -PERLVAR(scopestack_ix, I32) -PERLVAR(scopestack_max, I32) - -PERLVAR(savestack, ANY*) /* to save non-local values on */ -PERLVAR(savestack_ix, I32) -PERLVAR(savestack_max, I32) - -PERLVAR(retstack, OP **) /* returns we've pushed */ -PERLVAR(retstack_ix, I32) -PERLVAR(retstack_max, I32) - -PERLVAR(markstack, I32 *) /* stackmarks we're remembering */ -PERLVAR(markstack_ptr, I32 *) /* stackmarks we're remembering */ -PERLVAR(markstack_max, I32 *) /* stackmarks we're remembering */ - - - -PERLVAR(curpad, SV **) - -/* temp space */ -PERLVAR(Sv, SV *) -PERLVAR(Xpv, XPV *) - -PERLVAR(statbuf, struct stat) -#ifdef HAS_TIMES -PERLVAR(timesbuf, struct tms) -#endif - -#endif /* USE_THREADS */ - -PERLVAR(tokenbuf[256], char) -#if defined(WIN32) && defined(__GNUC__) -PERLVAR(na, static STRLEN) -#else -PERLVAR(na, STRLEN) /* for use in SvPV when length is Not Applicable */ -#endif - -PERLVAR(sv_undef, SV) -PERLVAR(sv_no, SV) -PERLVAR(sv_yes, SV) +PERLVAR(Guid, int) /* current real user id */ +PERLVAR(Geuid, int) /* current effective user id */ +PERLVAR(Ggid, int) /* current real group id */ +PERLVAR(Gegid, int) /* current effective group id */ +PERLVAR(Gnomemok, bool) /* let malloc context handle nomem */ +PERLVAR(Gan, U32) /* malloc sequence number */ +PERLVAR(Gcop_seqmax, U32) /* statement sequence number */ +PERLVAR(Gop_seqmax, U16) /* op sequence number */ +PERLVAR(Gevalseq, U32) /* eval sequence number */ +PERLVAR(Gsub_generation, U32) /* inc to force methods to be looked up again */ +PERLVAR(Gorigenviron, char **) +PERLVAR(Gorigalen, U32) +PERLVAR(Gpidstatus, HV *) /* pid-to-status mappings for waitpid */ +PERLVAR(Gprofiledata, U32 *) +PERLVARI(Gmaxo, int, MAXO) /* Number of ops */ +PERLVAR(Gosname, char *) /* operating system */ +PERLVARI(Gsh_path, char *, SH_PATH) /* full path of shell */ +PERLVAR(Gsighandlerp, Sighandler_t) + +PERLVAR(Gxiv_arenaroot, XPV*) /* list of allocated xiv areas */ +PERLVAR(Gxiv_root, IV **) /* free xiv list--shared by interpreters */ +PERLVAR(Gxnv_root, double *) /* free xnv list--shared by interpreters */ +PERLVAR(Gxrv_root, XRV *) /* free xrv list--shared by interpreters */ +PERLVAR(Gxpv_root, XPV *) /* free xpv list--shared by interpreters */ +PERLVAR(Ghe_root, HE *) /* free he list--shared by interpreters */ +PERLVAR(Gnice_chunk, char *) /* a nice chunk of memory to reuse */ +PERLVAR(Gnice_chunk_size, U32) /* how nice the chunk of memory is */ + +PERLVARI(Grunops, runops_proc_t *, RUNOPS_DEFAULT) + +PERLVAR(Gtokenbuf[256], char) +PERLVAR(Gna, STRLEN) /* for use in SvPV when length is Not Applicable */ + +PERLVAR(Gsv_undef, SV) +PERLVAR(Gsv_no, SV) +PERLVAR(Gsv_yes, SV) #ifdef CSH -PERLVARI(cshname, char *, CSH) -PERLVAR(cshlen, I32) +PERLVARI(Gcshname, char *, CSH) +PERLVAR(Gcshlen, I32) #endif -PERLVAR(lex_state, U32) /* next token is determined */ -PERLVAR(lex_defer, U32) /* state after determined token */ -PERLVAR(lex_expect, expectation) /* expect after determined token */ -PERLVAR(lex_brackets, I32) /* bracket count */ -PERLVAR(lex_formbrack, I32) /* bracket count at outer format level */ -PERLVAR(lex_fakebrack, I32) /* outer bracket is mere delimiter */ -PERLVAR(lex_casemods, I32) /* casemod count */ -PERLVAR(lex_dojoin, I32) /* doing an array interpolation */ -PERLVAR(lex_starts, I32) /* how many interps done on level */ -PERLVAR(lex_stuff, SV *) /* runtime pattern from m// or s/// */ -PERLVAR(lex_repl, SV *) /* runtime replacement from s/// */ -PERLVAR(lex_op, OP *) /* extra info to pass back on op */ -PERLVAR(lex_inpat, OP *) /* in pattern $) and $| are special */ -PERLVAR(lex_inwhat, I32) /* what kind of quoting are we in */ -PERLVAR(lex_brackstack, char *) /* what kind of brackets to pop */ -PERLVAR(lex_casestack, char *) /* what kind of case mods in effect */ +PERLVAR(Glex_state, U32) /* next token is determined */ +PERLVAR(Glex_defer, U32) /* state after determined token */ +PERLVAR(Glex_expect, expectation) /* expect after determined token */ +PERLVAR(Glex_brackets, I32) /* bracket count */ +PERLVAR(Glex_formbrack, I32) /* bracket count at outer format level */ +PERLVAR(Glex_fakebrack, I32) /* outer bracket is mere delimiter */ +PERLVAR(Glex_casemods, I32) /* casemod count */ +PERLVAR(Glex_dojoin, I32) /* doing an array interpolation */ +PERLVAR(Glex_starts, I32) /* how many interps done on level */ +PERLVAR(Glex_stuff, SV *) /* runtime pattern from m// or s/// */ +PERLVAR(Glex_repl, SV *) /* runtime replacement from s/// */ +PERLVAR(Glex_op, OP *) /* extra info to pass back on op */ +PERLVAR(Glex_inpat, OP *) /* in pattern $) and $| are special */ +PERLVAR(Glex_inwhat, I32) /* what kind of quoting are we in */ +PERLVAR(Glex_brackstack, char *) /* what kind of brackets to pop */ +PERLVAR(Glex_casestack, char *) /* what kind of case mods in effect */ /* What we know when we're in LEX_KNOWNEXT state. */ -PERLVAR(nextval[5], YYSTYPE) /* value of next token, if any */ -PERLVAR(nexttype[5], I32) /* type of next token */ -PERLVAR(nexttoke, I32) - -PERLVARI(rsfp, PerlIO * VOL, Nullfp) -PERLVAR(linestr, SV *) -PERLVAR(bufptr, char *) -PERLVAR(oldbufptr, char *) -PERLVAR(oldoldbufptr, char *) -PERLVAR(bufend, char *) -PERLVARI(expect, expectation, XSTATE) /* how to interpret ambiguous tokens */ -PERLVAR(rsfp_filters, AV *) - -PERLVAR(multi_start, I32) /* 1st line of multi-line string */ -PERLVAR(multi_end, I32) /* last line of multi-line string */ -PERLVAR(multi_open, I32) /* delimiter of said string */ -PERLVAR(multi_close, I32) /* delimiter of said string */ - -PERLVAR(scrgv, GV *) -PERLVAR(error_count, I32) /* how many errors so far, max 10 */ -PERLVAR(subline, I32) /* line this subroutine began on */ -PERLVAR(subname, SV *) /* name of current subroutine */ - -PERLVAR(compcv, CV *) /* currently compiling subroutine */ -PERLVAR(comppad, AV *) /* storage for lexically scoped temporaries */ -PERLVAR(comppad_name, AV *) /* variable names for "my" variables */ -PERLVAR(comppad_name_fill, I32) /* last "introduced" variable offset */ -PERLVAR(comppad_name_floor, I32) /* start of vars in innermost block */ -PERLVAR(min_intro_pending, I32) /* start of vars to introduce */ -PERLVAR(max_intro_pending, I32) /* end of vars to introduce */ -PERLVAR(padix, I32) /* max used index in current "register" pad */ -PERLVAR(padix_floor, I32) /* how low may inner block reset padix */ -PERLVAR(pad_reset_pending, I32) /* reset pad on next attempted alloc */ -PERLVAR(compiling, COP) - -PERLVAR(thisexpr, I32) /* name id for nothing_in_common() */ -PERLVAR(last_uni, char *) /* position of last named-unary operator */ -PERLVAR(last_lop, char *) /* position of last list operator */ -PERLVAR(last_lop_op, OPCODE) /* last list operator */ -PERLVAR(in_my, bool) /* we're compiling a "my" declaration */ -PERLVAR(in_my_stash, HV *) /* declared class of this "my" declaration */ +PERLVAR(Gnextval[5], YYSTYPE) /* value of next token, if any */ +PERLVAR(Gnexttype[5], I32) /* type of next token */ +PERLVAR(Gnexttoke, I32) + +PERLVARI(Grsfp, PerlIO * VOL, Nullfp) +PERLVAR(Glinestr, SV *) +PERLVAR(Gbufptr, char *) +PERLVAR(Goldbufptr, char *) +PERLVAR(Goldoldbufptr, char *) +PERLVAR(Gbufend, char *) +PERLVARI(Gexpect, expectation, XSTATE) /* how to interpret ambiguous tokens */ +PERLVAR(Grsfp_filters, AV *) + +PERLVAR(Gmulti_start, I32) /* 1st line of multi-line string */ +PERLVAR(Gmulti_end, I32) /* last line of multi-line string */ +PERLVAR(Gmulti_open, I32) /* delimiter of said string */ +PERLVAR(Gmulti_close, I32) /* delimiter of said string */ + +PERLVAR(Gscrgv, GV *) +PERLVAR(Gerror_count, I32) /* how many errors so far, max 10 */ +PERLVAR(Gsubline, I32) /* line this subroutine began on */ +PERLVAR(Gsubname, SV *) /* name of current subroutine */ + +PERLVAR(Gcompcv, CV *) /* currently compiling subroutine */ +PERLVAR(Gcomppad, AV *) /* storage for lexically scoped temporaries */ +PERLVAR(Gcomppad_name, AV *) /* variable names for "my" variables */ +PERLVAR(Gcomppad_name_fill, I32) /* last "introduced" variable offset */ +PERLVAR(Gcomppad_name_floor, I32) /* start of vars in innermost block */ +PERLVAR(Gmin_intro_pending, I32) /* start of vars to introduce */ +PERLVAR(Gmax_intro_pending, I32) /* end of vars to introduce */ +PERLVAR(Gpadix, I32) /* max used index in current "register" pad */ +PERLVAR(Gpadix_floor, I32) /* how low may inner block reset padix */ +PERLVAR(Gpad_reset_pending, I32) /* reset pad on next attempted alloc */ +PERLVAR(Gcompiling, COP) + +PERLVAR(Gthisexpr, I32) /* name id for nothing_in_common() */ +PERLVAR(Glast_uni, char *) /* position of last named-unary operator */ +PERLVAR(Glast_lop, char *) /* position of last list operator */ +PERLVAR(Glast_lop_op, OPCODE) /* last list operator */ +PERLVAR(Gin_my, bool) /* we're compiling a "my" declaration */ +PERLVAR(Gin_my_stash, HV *) /* declared class of this "my" declaration */ #ifdef FCRYPT -PERLVAR(cryptseen, I32) /* has fast crypt() been initialized? */ +PERLVAR(Gcryptseen, I32) /* has fast crypt() been initialized? */ #endif -PERLVAR(hints, U32) /* various compilation flags */ +PERLVAR(Ghints, U32) /* various compilation flags */ -PERLVAR(do_undump, bool) /* -u or dump seen? */ -PERLVAR(debug, VOL U32) +PERLVAR(Gdo_undump, bool) /* -u or dump seen? */ +PERLVAR(Gdebug, VOL U32) #ifdef OVERLOAD -PERLVAR(amagic_generation, long) +PERLVAR(Gamagic_generation, long) #endif #ifdef USE_LOCALE_COLLATE -PERLVAR(collation_ix, U32) /* Collation generation index */ -PERLVAR(collation_name, char *) /* Name of current collation */ -PERLVARI(collation_standard, bool, TRUE) /* Assume simple collation */ -PERLVAR(collxfrm_base, Size_t) /* Basic overhead in *xfrm() */ -PERLVARI(collxfrm_mult, Size_t, 2) /* Expansion factor in *xfrm() */ +PERLVAR(Gcollation_ix, U32) /* Collation generation index */ +PERLVAR(Gcollation_name, char *) /* Name of current collation */ +PERLVARI(Gcollation_standard, bool, TRUE) /* Assume simple collation */ +PERLVAR(Gcollxfrm_base, Size_t) /* Basic overhead in *xfrm() */ +PERLVARI(Gcollxfrm_mult, Size_t, 2) /* Expansion factor in *xfrm() */ #endif /* USE_LOCALE_COLLATE */ #ifdef USE_LOCALE_NUMERIC -PERLVAR(numeric_name, char *) /* Name of current numeric locale */ -PERLVARI(numeric_standard, bool, TRUE) /* Assume simple numerics */ -PERLVARI(numeric_local, bool, TRUE) /* Assume local numerics */ +PERLVAR(Gnumeric_name, char *) /* Name of current numeric locale */ +PERLVARI(Gnumeric_standard, bool, TRUE) /* Assume simple numerics */ +PERLVARI(Gnumeric_local, bool, TRUE) /* Assume local numerics */ #endif /* !USE_LOCALE_NUMERIC */ @@ -1840,7 +1840,7 @@ PP(pp_entersub) if (!CvROOT(cv) && !CvXSUB(cv)) { GV* autogv; - SV* subname; + SV* sub_name; /* anonymous or undef'd function leaves us no recourse */ if (CvANON(cv) || !(gv = CvGV(cv))) @@ -1858,9 +1858,9 @@ PP(pp_entersub) goto retry; } /* sorry */ - subname = sv_newmortal(); - gv_efullname3(subname, gv, Nullch); - DIE("Undefined subroutine &%s called", SvPVX(subname)); + sub_name = sv_newmortal(); + gv_efullname3(sub_name, gv, Nullch); + DIE("Undefined subroutine &%s called", SvPVX(sub_name)); } gimme = GIMME_V; @@ -2343,3 +2343,4 @@ PP(pp_method) SETs(isGV(gv) ? (SV*)GvCV(gv) : (SV*)gv); RETURN; } + @@ -1,3 +1,5 @@ +START_EXTERN_C + #ifndef NEXT30_NO_ATTRIBUTE #ifndef HASATTRIBUTE /* disable GNU-cc attribute checking? */ #ifdef __attribute__ /* Avoid possible redefinition errors */ @@ -581,3 +583,9 @@ Malloc_t safexcalloc _((I32 x, MEM_SIZE elements, MEM_SIZE size)); Malloc_t safexrealloc _((Malloc_t where, MEM_SIZE size)); void safexfree _((Malloc_t where)); #endif + +#ifdef PERL_GLOBAL_STRUCT +struct perl_vars *Perl_GetVars _((void)); +#endif + +END_EXTERN_C @@ -16,8 +16,6 @@ * know. Run now! Hope is in speed!" --Gandalf */ -dEXT char **watchaddr = 0; -dEXT char *watchok; int runops_standard(void) { @@ -30,6 +28,10 @@ runops_standard(void) { } #ifdef DEBUGGING + +dEXT char **watchaddr = 0; +dEXT char *watchok; + static void debprof _((OP*o)); int @@ -112,5 +114,5 @@ debprofdump(void) } } -#endif +#endif /* DEBUGGING */ @@ -2547,4 +2547,10 @@ Perl_huge(void) } #endif - +#ifdef PERL_GLOBAL_STRUCT +struct perl_vars * +Perl_GetVars(void) +{ + return &Perl_Vars; +} +#endif
\ No newline at end of file diff --git a/win32/Makefile b/win32/Makefile index 901a9f4978..2411ff42c5 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -11,9 +11,10 @@ # newly built perl. INST_DRV=c: INST_TOP=$(INST_DRV)\perl5004.5x -BUILDOPT=-DUSE_THREADS +#BUILDOPT=-DUSE_THREADS #BUILDOPT=-DMULTIPLICITY #BUILDOPT=-DMULTIPLICITY -DUSE_THREADS +BUILDOPT=-DPERL_GLOBAL_STRUCT -DMULTIPLICITY CORECCOPT= # @@ -54,7 +55,7 @@ RUNTIME = -MD INCLUDES = -I.\include -I. -I.. #PCHFLAGS = -Fp"$(INTDIR)/modules.pch" -YX DEFINES = -DWIN32 -D_CONSOLE $(BUILDOPT) -LOCDEFS = -DPERLDLL -DPERL_CORE $(CORECCOPT) +LOCDEFS = -DPERLDLL $(CORECCOPT) SUBSYS = console !IF "$(RUNTIME)" == "-MD" @@ -376,13 +377,13 @@ perl95.c : runperl.c copy runperl.c perl95.c perl95.obj : perl95.c - $(CC) $(CFLAGS) -MT -UPERLDLL -c perl95.c + $(CC) $(CFLAGS) -MT -UPERLDLL -DWIN95FIX -c perl95.c win32sckmt.obj : win32sck.c - $(CC) $(CFLAGS) -MT -UPERLDLL -c $(OBJOUT_FLAG)win32sckmt.obj win32sck.c + $(CC) $(CFLAGS) -MT -UPERLDLL -DWIN95FIX -c $(OBJOUT_FLAG)win32sckmt.obj win32sck.c win32mt.obj : win32.c - $(CC) $(CFLAGS) -MT -UPERLDLL -c $(OBJOUT_FLAG)win32mt.obj win32.c + $(CC) $(CFLAGS) -MT -UPERLDLL -DWIN95FIX -c $(OBJOUT_FLAG)win32mt.obj win32.c $(PERL95EXE): $(PERLDLL) $(CONFIGPM) $(PERL95_OBJ) $(LINK32) -subsystem:console -out:perl95.exe $(LINK_FLAGS) $(LIBFILES) \ diff --git a/win32/makedef.pl b/win32/makedef.pl index 91630d991d..9b6cfe308d 100644 --- a/win32/makedef.pl +++ b/win32/makedef.pl @@ -38,9 +38,37 @@ if ($CCTYPE ne 'GCC') print "CODE LOADONCALL\n"; print "DATA LOADONCALL NONSHARED MULTIPLE\n"; } +else + { + $define{'PERL_GLOBAL_STRUCT'} = 1; + $define{'MULTIPLICITY'} = 1; + } + print "EXPORTS\n"; -$skip_sym=<<'!END!OF!SKIP!'; +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_additem Perl_cast_ulong @@ -157,30 +185,26 @@ Perl_my_memset Perl_cshlen Perl_cshname Perl_opsave -!END!OF!SKIP! +)]; -if ($CCTYPE eq 'GCC') - { - $skip_sym .= "Perl_na\n"; - } if ($define{'MYMALLOC'}) { - $skip_sym .= <<'!END!OF!SKIP!'; -Perl_safefree -Perl_safemalloc -Perl_saferealloc -Perl_safecalloc -!END!OF!SKIP! - emit_symbol('Perl_malloc'); - emit_symbol('Perl_free'); - emit_symbol('Perl_realloc'); - emit_symbol('Perl_calloc'); + skip_symbols [qw( + Perl_safefree + Perl_safemalloc + Perl_saferealloc + Perl_safecalloc)]; + emit_symbols [qw( + Perl_malloc + Perl_free + Perl_realloc + Perl_calloc)]; } unless ($define{'USE_THREADS'}) { - $skip_sym .= <<'!END!OF!SKIP!'; + skip_symbols [qw( Perl_condpair_magic Perl_thr_key Perl_sv_mutex @@ -205,56 +229,63 @@ Perl_sv_nv Perl_sv_true Perl_sv_uv Perl_sv_pvn -Perl_newRV_noinc -!END!OF!SKIP! +Perl_newRV_noinc)]; } +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?\([IGT](\w+)/); + } + close(VARS); + return \@syms; +} + if ($define{'USE_THREADS'} || $define{'MULTIPLICITY'}) { - open(THREAD,"<../thrdvar.h") || die "Cannot open ../thrdvar.h:$!"; - while (<THREAD>) - { - if (/\bPERLVARI?\(T(\w+)/) - { - $skip_sym .= "Perl_".$1."\n"; - } - } - close(THREAD); + my $thrd = readvar("../thrdvar.h"); + skip_symbols $thrd; } if ($define{'MULTIPLICITY'}) { - open(THREAD,"<../intrpvar.h") || die "Cannot open ../intrpvar.h:$!"; - while (<THREAD>) - { - if (/\bPERLVARI?\(I(\w+)/) - { - $skip_sym .= "Perl_".$1."\n"; - } - } - close(THREAD); + 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_sym .= "Perl_runops_debug\n"; - $skip_sym .= "Perl_sv_peek\n"; + skip_symbols [qw( + Perl_runops_debug + Perl_sv_peek + Perl_watchaddr + Perl_watchok)]; } -# All symbols have a Perl_ prefix because that's what embed.h -# sticks in front of them. - - 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); -} +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 @@ -262,34 +293,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); - $symbol = "Perl_".$symbol if ($define{'USE_THISPTR'} - && $symbol =~ /^perl/); + 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 @@ -298,12 +336,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; @@ -453,3 +502,4 @@ Perl_init_os_extras Perl_getTHR Perl_setTHR RunPerl + diff --git a/win32/makegcc.mk b/win32/makegcc.mk index dfe372c935..56daeca918 100644 --- a/win32/makegcc.mk +++ b/win32/makegcc.mk @@ -11,7 +11,7 @@ # newly built perl. INST_DRV=c: INST_TOP=$(INST_DRV)\perl5004.5x -BUILDOPT=-DUSE_THREADS +BUILDOPT= # @@ -49,7 +49,7 @@ CCLIBDIR = $(CCHOME)\lib .USESHELL : -CC = gcc +CC = gcc -pipe LINK32 = gcc LIB32 = ar IMPLIB = dlltool diff --git a/win32/perllib.c b/win32/perllib.c index 848360698b..b1002ebb16 100644 --- a/win32/perllib.c +++ b/win32/perllib.c @@ -15,6 +15,14 @@ RunPerl(int argc, char **argv, char **env, void *iosubsystem) int exitstatus; PerlInterpreter *my_perl; +#ifdef PERL_GLOBAL_STRUCT +#define PERLVAR(var,type) /**/ +#define PERLVARI(var,type,init) Perl_Vars.var = init; +#include "perlvars.h" +#undef PERLVAR +#undef PERLVARI +#endif + PERL_SYS_INIT(&argc,&argv); perl_init_i18nl10n(1); diff --git a/win32/win32.c b/win32/win32.c index c4b8c3bb7c..dcdda533d6 100644 --- a/win32/win32.c +++ b/win32/win32.c @@ -545,15 +545,15 @@ getegid(void) } int -setuid(uid_t uid) +setuid(uid_t auid) { - return (uid == ROOT_UID ? 0 : -1); + return (auid == ROOT_UID ? 0 : -1); } int -setgid(gid_t gid) +setgid(gid_t agid) { - return (gid == ROOT_GID ? 0 : -1); + return (agid == ROOT_GID ? 0 : -1); } /* @@ -1131,9 +1131,9 @@ win32_abort(void) } DllExport int -win32_fstat(int fd,struct stat *bufptr) +win32_fstat(int fd,struct stat *sbufptr) { - return fstat(fd,bufptr); + return fstat(fd,sbufptr); } DllExport int @@ -1779,3 +1779,4 @@ win32_strip_return(SV *sv) + diff --git a/win32/win32.h b/win32/win32.h index db87a6dca8..9b53a9a4b5 100644 --- a/win32/win32.h +++ b/win32/win32.h @@ -10,11 +10,27 @@ #define _INC_WIN32_PERL5 #ifdef __GNUC__ -#define __declspec(x) typedef long long __int64; #define Win32_Winsock +/* GCC does not do __declspec() - render it a nop + * and turn on options to avoid importing data + */ +#define __declspec(x) +#define PERL_GLOBAL_STRUCT +#define MULTIPLICITY #endif +/* Define DllExport akin to perl's EXT, + * If we are in the DLL or mimicing the DLL for Win95 work round + * then Export the symbol, + * otherwise import it. + */ + +#if defined(PERLDLL) || defined(WIN95FIX) +#define DllExport __declspec(dllexport) +#else +#define DllExport __declspec(dllimport) +#endif #define WIN32_LEAN_AND_MEAN #include <windows.h> @@ -56,8 +72,6 @@ struct tms { #define STANDARD_C 1 #define DOSISH 1 /* no escaping our roots */ #define OP_BINARY O_BINARY /* mistake in in pp_sys.c? */ -#define DllExport __declspec(dllexport) -#define DllImport __declspec(dllimport) /* Define USE_SOCKETS_AS_HANDLES to enable emulation of windows sockets as * real filehandles. XXX Should always be defined (the other version is untested) */ @@ -133,8 +147,8 @@ extern void *sbrk(int need); #undef init_os_extras #define init_os_extras Perl_init_os_extras -EXT void Perl_win32_init(int *argcp, char ***argvp); -EXT void Perl_init_os_extras(void); +DllExport void Perl_win32_init(int *argcp, char ***argvp); +DllExport void Perl_init_os_extras(void); #ifndef USE_SOCKETS_AS_HANDLES extern FILE * my_fdopen(int, char *); diff --git a/win32/win32iop.h b/win32/win32iop.h index a2b318a558..78c90e1696 100644 --- a/win32/win32iop.h +++ b/win32/win32iop.h @@ -30,90 +30,90 @@ */ START_EXTERN_C -EXT int * win32_errno(void); -EXT char *** win32_environ(void); -EXT FILE* win32_stdin(void); -EXT FILE* win32_stdout(void); -EXT FILE* win32_stderr(void); -EXT int win32_ferror(FILE *fp); -EXT int win32_feof(FILE *fp); -EXT char* win32_strerror(int e); - -EXT int win32_fprintf(FILE *pf, const char *format, ...); -EXT int win32_printf(const char *format, ...); -EXT int win32_vfprintf(FILE *pf, const char *format, va_list arg); -EXT int win32_vprintf(const char *format, va_list arg); -EXT size_t win32_fread(void *buf, size_t size, size_t count, FILE *pf); -EXT size_t win32_fwrite(const void *buf, size_t size, size_t count, FILE *pf); -EXT FILE* win32_fopen(const char *path, const char *mode); -EXT FILE* win32_fdopen(int fh, const char *mode); -EXT FILE* win32_freopen(const char *path, const char *mode, FILE *pf); -EXT int win32_fclose(FILE *pf); -EXT int win32_fputs(const char *s,FILE *pf); -EXT int win32_fputc(int c,FILE *pf); -EXT int win32_ungetc(int c,FILE *pf); -EXT int win32_getc(FILE *pf); -EXT int win32_fileno(FILE *pf); -EXT void win32_clearerr(FILE *pf); -EXT int win32_fflush(FILE *pf); -EXT long win32_ftell(FILE *pf); -EXT int win32_fseek(FILE *pf,long offset,int origin); -EXT int win32_fgetpos(FILE *pf,fpos_t *p); -EXT int win32_fsetpos(FILE *pf,const fpos_t *p); -EXT void win32_rewind(FILE *pf); -EXT FILE* win32_tmpfile(void); -EXT void win32_abort(void); -EXT int win32_fstat(int fd,struct stat *bufptr); -EXT int win32_stat(const char *name,struct stat *bufptr); -EXT int win32_pipe( int *phandles, unsigned int psize, int textmode ); -EXT FILE* win32_popen( const char *command, const char *mode ); -EXT int win32_pclose( FILE *pf); -EXT int win32_setmode( int fd, int mode); -EXT long win32_lseek( int fd, long offset, int origin); -EXT long win32_tell( int fd); -EXT int win32_dup( int fd); -EXT int win32_dup2(int h1, int h2); -EXT int win32_open(const char *path, int oflag,...); -EXT int win32_close(int fd); -EXT int win32_eof(int fd); -EXT int win32_read(int fd, void *buf, unsigned int cnt); -EXT int win32_write(int fd, const void *buf, unsigned int cnt); -EXT int win32_spawnvp(int mode, const char *cmdname, +DllExport int * win32_errno(void); +DllExport char *** win32_environ(void); +DllExport FILE* win32_stdin(void); +DllExport FILE* win32_stdout(void); +DllExport FILE* win32_stderr(void); +DllExport int win32_ferror(FILE *fp); +DllExport int win32_feof(FILE *fp); +DllExport char* win32_strerror(int e); + +DllExport int win32_fprintf(FILE *pf, const char *format, ...); +DllExport int win32_printf(const char *format, ...); +DllExport int win32_vfprintf(FILE *pf, const char *format, va_list arg); +DllExport int win32_vprintf(const char *format, va_list arg); +DllExport size_t win32_fread(void *buf, size_t size, size_t count, FILE *pf); +DllExport size_t win32_fwrite(const void *buf, size_t size, size_t count, FILE *pf); +DllExport FILE* win32_fopen(const char *path, const char *mode); +DllExport FILE* win32_fdopen(int fh, const char *mode); +DllExport FILE* win32_freopen(const char *path, const char *mode, FILE *pf); +DllExport int win32_fclose(FILE *pf); +DllExport int win32_fputs(const char *s,FILE *pf); +DllExport int win32_fputc(int c,FILE *pf); +DllExport int win32_ungetc(int c,FILE *pf); +DllExport int win32_getc(FILE *pf); +DllExport int win32_fileno(FILE *pf); +DllExport void win32_clearerr(FILE *pf); +DllExport int win32_fflush(FILE *pf); +DllExport long win32_ftell(FILE *pf); +DllExport int win32_fseek(FILE *pf,long offset,int origin); +DllExport int win32_fgetpos(FILE *pf,fpos_t *p); +DllExport int win32_fsetpos(FILE *pf,const fpos_t *p); +DllExport void win32_rewind(FILE *pf); +DllExport FILE* win32_tmpfile(void); +DllExport void win32_abort(void); +DllExport int win32_fstat(int fd,struct stat *sbufptr); +DllExport int win32_stat(const char *name,struct stat *sbufptr); +DllExport int win32_pipe( int *phandles, unsigned int psize, int textmode ); +DllExport FILE* win32_popen( const char *command, const char *mode ); +DllExport int win32_pclose( FILE *pf); +DllExport int win32_setmode( int fd, int mode); +DllExport long win32_lseek( int fd, long offset, int origin); +DllExport long win32_tell( int fd); +DllExport int win32_dup( int fd); +DllExport int win32_dup2(int h1, int h2); +DllExport int win32_open(const char *path, int oflag,...); +DllExport int win32_close(int fd); +DllExport int win32_eof(int fd); +DllExport int win32_read(int fd, void *buf, unsigned int cnt); +DllExport int win32_write(int fd, const void *buf, unsigned int cnt); +DllExport int win32_spawnvp(int mode, const char *cmdname, const char *const *argv); -EXT int win32_mkdir(const char *dir, int mode); -EXT int win32_rmdir(const char *dir); -EXT int win32_chdir(const char *dir); -EXT int win32_flock(int fd, int oper); -EXT int win32_execvp(const char *cmdname, const char *const *argv); -EXT void win32_perror(const char *str); -EXT void win32_setbuf(FILE *pf, char *buf); -EXT int win32_setvbuf(FILE *pf, char *buf, int type, size_t size); -EXT int win32_flushall(void); -EXT int win32_fcloseall(void); -EXT char* win32_fgets(char *s, int n, FILE *pf); -EXT char* win32_gets(char *s); -EXT int win32_fgetc(FILE *pf); -EXT int win32_putc(int c, FILE *pf); -EXT int win32_puts(const char *s); -EXT int win32_getchar(void); -EXT int win32_putchar(int c); -EXT void* win32_malloc(size_t size); -EXT void* win32_calloc(size_t numitems, size_t size); -EXT void* win32_realloc(void *block, size_t size); -EXT void win32_free(void *block); - -EXT int win32_open_osfhandle(long handle, int flags); -EXT long win32_get_osfhandle(int fd); +DllExport int win32_mkdir(const char *dir, int mode); +DllExport int win32_rmdir(const char *dir); +DllExport int win32_chdir(const char *dir); +DllExport int win32_flock(int fd, int oper); +DllExport int win32_execvp(const char *cmdname, const char *const *argv); +DllExport void win32_perror(const char *str); +DllExport void win32_setbuf(FILE *pf, char *buf); +DllExport int win32_setvbuf(FILE *pf, char *buf, int type, size_t size); +DllExport int win32_flushall(void); +DllExport int win32_fcloseall(void); +DllExport char* win32_fgets(char *s, int n, FILE *pf); +DllExport char* win32_gets(char *s); +DllExport int win32_fgetc(FILE *pf); +DllExport int win32_putc(int c, FILE *pf); +DllExport int win32_puts(const char *s); +DllExport int win32_getchar(void); +DllExport int win32_putchar(int c); +DllExport void* win32_malloc(size_t size); +DllExport void* win32_calloc(size_t numitems, size_t size); +DllExport void* win32_realloc(void *block, size_t size); +DllExport void win32_free(void *block); + +DllExport int win32_open_osfhandle(long handle, int flags); +DllExport long win32_get_osfhandle(int fd); #ifndef USE_WIN32_RTL_ENV -EXT char* win32_getenv(const char *name); +DllExport char* win32_getenv(const char *name); #endif -EXT unsigned int win32_sleep(unsigned int); -EXT int win32_times(struct tms *timebuf); -EXT unsigned int win32_alarm(unsigned int sec); -EXT int win32_flock(int fd, int oper); -EXT int win32_stat(const char *path, struct stat *buf); +DllExport unsigned int win32_sleep(unsigned int); +DllExport int win32_times(struct tms *timebuf); +DllExport unsigned int win32_alarm(unsigned int sec); +DllExport int win32_flock(int fd, int oper); +DllExport int win32_stat(const char *path, struct stat *buf); END_EXTERN_C @@ -240,3 +240,4 @@ END_EXTERN_C #endif /* WIN32IO_IS_STDIO */ #endif /* WIN32IOP_H */ + diff --git a/win32/win32thread.c b/win32/win32thread.c index d3783f6857..3ea73c32a5 100644 --- a/win32/win32thread.c +++ b/win32/win32thread.c @@ -45,7 +45,7 @@ Perl_alloc_thread_key(void) } void -Perl_init_thread_intern(struct perl_thread *thr) +Perl_init_thread_intern(struct perl_thread *athr) { #ifdef USE_THREADS #ifndef USE_DECLSPEC_THREAD @@ -56,7 +56,7 @@ Perl_init_thread_intern(struct perl_thread *thr) * return values we don't _need_ to do anything but * this is good practice: */ - memset(&thr->i,0,sizeof(thr->i)); + memset(&athr->i,0,sizeof(athr->i)); #endif #endif @@ -95,3 +95,4 @@ Perl_thread_create(struct perl_thread *thr, thread_func_t *fn) return thr->self ? 0 : -1; } #endif + |